Synchro Stones

[bmorris]

Hi all. Over a week ago, I had a dream of a concept for a puzzle game, and today, I've knocked up a demo. It's a bird's-eye-view board game where you need to navigate to an escape tile (cf. Creeping Angels!) where the board contains "stones", some of which can move, others of which can't. The movable ones attempt to move in the same direction the player did, and it would be possible to have some that do the exact opposite. Anyway, here's the WIP demo:

PlayBASIC Code: [Select]

; PROJECT : synchrostones
; AUTHOR  : Bobby Morris
; CREATED : 19/06/2013
; EDITED  : 19/06/2013
; ---------------------------------------------------------------------

rem To do:
rem tiny delay between player and stone movement
rem red stones (which move in the opposite direction)

constant IMMOVS    = 33
constant BLUES     = 22
constant REDS      = 0
constant MAX_TURNS = 500

dim grid$(MAX_TURNS,40,30)
global Turn = 0

randomize 1

openscreen 1024,768,32,2

rem Crudely set up a level randomly

for t = 0 to MAX_TURNS - 1
   for gy = 0 to 29
      for gx = 0 to 39
         grid$(t,gx,gy) = "N"   
      next gx
   next gy   
next t   
for r = 0 to REDS - 1
   grid$(Turn,rnd(39),rnd(29)) = "R"
next r
for b = 0 to BLUES - 1
   grid$(0,rnd(39),rnd(29)) = "B"
next b
for i = 0 to IMMOVS - 1
   ix = rnd(39)
   iy = rnd(29)
   for t = 0 to MAX_TURNS - 1
      grid$(t,ix,iy) = "I"
   next t
next i
ex = rnd(38) + 1 `hmm...
ey = rnd(28) + 1
for t = 0 to MAX_TURNS - 1   
   grid$(t,ex,ey) = "E"
next t   
grid$(Turn,rnd(39),rnd(29)) = "P"

Draw_grid()

do
   moved$ = "No"
   waitkey
   select upper$(inkey$())
      case "W"
         flushkeys
         for gx = 0 to 39
            if grid$(Turn,gx,0) = "P" then continue
         next gx
         for gy = 1 to 29
            for gx = 0 to 39
               if grid$(Turn,gx,gy) = "P"
                  if upper$(grid$(Turn,gx,gy - 1)) = "E"
                     grid$(Turn + 1,gx,gy - 1) = "PE"
                     grid$(Turn + 1,gx,gy) = "N"
                     moved$ = "Yes"
                     won$ = "Yes"
                  elseif grid$(Turn,gx,gy - 1) = "N"
                     grid$(Turn + 1,gx,gy - 1) = "P"
                     grid$(Turn + 1,gx,gy) = "N"
                     grid$(Turn,gx,gy) = "p"
                     moved$ = "Yes"         
                  endif
               endif   
            next gx
         next gy
         if moved$ = "Yes"
            for gy = 1 to 29
               for gx = 0 to 39   
                  if grid$(Turn,gx,gy) = "B" or grid$(Turn,gx,gy) = "BE"
                     if upper$(grid$(Turn,gx,gy - 1)) = "N" or grid$(Turn,gx,gy - 1) = "p"
                        grid$(Turn + 1,gx,gy - 1) = "B"
                        if grid$(Turn,gx,gy) = "BE"
                           grid$(Turn + 1,gx,gy) = "E"
                           grid$(Turn,gx,gy) = "e"
                        else
                           grid$(Turn + 1,gx,gy) = "N"   
                           grid$(Turn,gx,gy) = "n"                  
                        endif   
                     elseif upper$(grid$(Turn,gx,gy - 1)) = "E"
                        grid$(Turn + 1,gx,gy - 1) = "BE"
                        grid$(Turn + 1,gx,gy) = "N"
                        grid$(Turn,gx,gy) = "n"                           
                     else
                        grid$(Turn + 1,gx,gy) = "B"
                     endif               
                  endif
               next gx   
            next gy
            for gx = 0 to 39
               if grid$(Turn,gx,0) = "B" then grid$(Turn + 1,gx,0) = "B"
            next gx   
         endif
      case "S"
         flushkeys
         for gx = 0 to 39
            if grid$(Turn,gx,29) = "P" then continue
         next gx
         for gy = 0 to 28
            for gx = 0 to 39
               if grid$(Turn,gx,gy) = "P"
                  if upper$(grid$(Turn,gx,gy + 1)) = "E"
                     grid$(Turn + 1,gx,gy + 1) = "PE"
                     grid$(Turn + 1,gx,gy) = "N"
                     moved$ = "Yes"
                     won$ = "Yes"
                  elseif grid$(Turn,gx,gy + 1) = "N"
                     grid$(Turn + 1,gx,gy + 1) = "P"
                     grid$(Turn + 1,gx,gy) = "N"
                     grid$(Turn,gx,gy) = "p"
                     moved$ = "Yes"         
                  endif
               endif   
            next gx
         next gy
         if moved$ = "Yes"   
            for gy = 28 to 0 step -1
               for gx = 0 to 39   
                  if grid$(Turn,gx,gy) = "B" or grid$(Turn,gx,gy) = "BE"
                     if upper$(grid$(Turn,gx,gy + 1)) = "N" or grid$(Turn,gx,gy + 1) = "p"
                        grid$(Turn + 1,gx,gy + 1) = "B"
                        if grid$(Turn,gx,gy) = "BE"
                           grid$(Turn + 1,gx,gy) = "E"
                           grid$(Turn,gx,gy) = "e"
                        else
                           grid$(Turn + 1,gx,gy) = "N"   
                           grid$(Turn,gx,gy) = "n"                  
                        endif                     
                     elseif upper$(grid$(Turn,gx,gy + 1)) = "E"
                        grid$(Turn + 1,gx,gy + 1) = "BE"
                        grid$(Turn + 1,gx,gy) = "N"
                        grid$(Turn,gx,gy) = "n"
                     else
                        grid$(Turn + 1,gx,gy) = "B"
                     endif               
                  endif

Login required to view complete source code

The controls are WASD for movement, U for undo, and Q to quit. You can change the random seed and also the numbers of stones.

Thus far, I've given almost no thought to level design, and what I want to know is, do you think there's anything in this? Are worthwhile, playable levels possible, or is this just a curiosity? And do you know of any similar games?

Edit: replaced code tags with PBcode tags

[BlinkOk]

i'm prolly missing something but the w key is not working for me.
ok i figured it out.
nice work

after playing a bit i think it might be a bit too easy

[kevin]

Haven't given this much play time, but there does seem to be something in the idea.    The implementation however has a few dodgy ideas in it.   Probably the main one is the use a string array where an integer is better fit. 

Init routine here is running through and creating and copying almost 640,000 strings, now on my old desk top, this takes almost seconds on it's own.   You could edit the array manually and get around this, but a much easier and faster approach is to store the ASC values rather than the string. 

So this stuff,

PlayBASIC Code: [Select]

constant IMMOVS    = 33
constant BLUES     = 22
constant REDS      = 0
constant MAX_TURNS = 500

dim grid$(MAX_TURNS,40,30)
global Turn = 0

randomize 1


rem Crudely set up a level randomly

for t = 0 to MAX_TURNS - 1
   for gy = 0 to 29
      for gx = 0 to 39
         grid$(t,gx,gy) = "N"   
      next gx
   next gy   
next t   

   Could be represented as,

PlayBASIC Code: [Select]

constant IMMOVS    = 33
constant BLUES     = 22
constant REDS      = 0
constant MAX_TURNS = 500

dim grid(MAX_TURNS,40,30)
global Turn = 0

randomize 1


rem Crudely set up a level randomly

for t = 0 to MAX_TURNS - 1
   for gy = 0 to 29
      for gx = 0 to 39
         grid(t,gx,gy) = asc("N")
      next gx
   next gy   
next t   

    This executes in about 135 milliseconds, but we can do better by using the ClearArray command like this,

PlayBASIC Code: [Select]

So nested 3d stuff

/*
for t = 0 to MAX_TURNS - 1
   for gy = 0 to 29
      for gx = 0 to 39
         grid(t,gx,gy) = asc("N")
      next gx
   next gy   
next t   
*/


 ; can be become this,
ClearArray grid(),asc("N")

    Which executes in about 9 milliseconds here. 

    Same goes for the other bits, so rather than write strings we write the ASCII values

PlayBASIC Code: [Select]

for r = 0 to REDS - 1
   grid(Turn,rnd(39),rnd(29)) = asc("R")
next r

For b = 0 to BLUES - 1
   grid(0,rnd(39),rnd(29)) = asc("B")
next b

For i = 0 to IMMOVS - 1
   ix = rnd(39)
   iy = rnd(29)
   for t = 0 to MAX_TURNS - 1
      grid$(t,ix,iy) = asc("I")
   next t
next i

ex = rnd(38) + 1 `hmm...
ey = rnd(28) + 1
for t = 0 to MAX_TURNS - 1   
   grid(t,ex,ey) = asc("E")
next t   

grid(Turn,rnd(39),rnd(29)) = asc("P")

     If a grid item can have two characters in it, we just take the ASC() of both and mult the left one by 256, creating a 16bit representation of the character pair.  In fact it's almost identical to the string, without the over head.

PlayBASIC Code: [Select]

   grid(t,gx,gy)   = (asc("A")*256)+Asc("Z")  

    etc etc


   then in some loop,

   For .....

      ThisChr=  grid(t,gx,gy)

      Select ThisChr

             case asc("A") 

             case (asc("A")*256)+Asc("Z")  

 etc

      EndSelect

   
   The PlayBASIC compiler will pre-solve the ASC() statements and any mults and additions (subs/divides), so the case is comparing the ThisCHR variable with a end value, rather than the computing the result each time.

[BlinkOk]

ok i got an idea; why not have a pattern of circles (make it look like something so it's interesting), some posts (grey dots) and blue dots. you gotta move the blue dots in such a way as to place them over the circles.

you could setup the stage by starting with all the blue dots over the circles and them randomly moving them a few times to mix them up. <--- ps: i just realized that this setup method wouldn't work.

kinna like this; (i think the grid and moving one cell at a time rather than one pixel will make it easier to determine when the puzzle is solved)

[bmorris]

Thanks for the array improvement, Kevin (I didn't realise it was under-efficient before). I actually originally wanted to have arrays for each board item, and the one-array-for-everything method that I did use is kinda out of laziness (or you could call it simplicity).

Interesting, Blink; that could be called "Synchro Sokoban", and you know, I've got a nagging feeling that I've played a vaguely similar game before, on Kongregate perhaps. Or maybe I'm just thinking of Sokoban itself. NB, the demo in this thread is a concept demo only, and presumably a carefully designed level would offer harder/better gameplay.

[bmorris]

I forgot to say in the OP that because of how hard I imagine it would be to design good levels for this game, I'm interested in the notion of writing an algorithm to do that. There would have to be a way of specifying the layout (easy) and a way of judging the quality of any given level (non-trivial), but that's all there'd be to it. I know that many Sokoban levels have already been generated this way, and by Jove, some of them are tough cookies.

[bmorris]

Okay, here's an improved demo, including optional red stones that move in the opposite direction to the player. Regarding the taxing array of strings, I've actually opted to use the ac() function instead of asc().

PlayBASIC Code: [Select]

; PROJECT : synchrostones
; AUTHOR  : Bobby Morris
; CREATED : 19/06/2013
; EDITED  : 20/06/2013
; ---------------------------------------------------------------------

rem Tiny delay between player and stone movement?

constant IMMOVS    = 30
constant BLUES     = 15
constant REDS      = 15
constant ESCAPES   = 3
constant MAX_TURNS = 500

constant N  = ac(1) `nothing (floor)
constant B  = ac(1) `blue stone
constant R  = ac(1) `red stone
constant I  = ac(1) `immovable stone
constant P  = ac(1) `player
constant E  = ac(1) `escape tile
constant PE = ac(1) `player on escape tile
constant BE = ac(1) `blue stone on escape tile
constant RE = ac(1) `red stone on escape tile
constant P2 = ac(1) `tile vacated by player
constant B2 = ac(1) `floor tile vacated by blue stone
constant R2 = ac(1) `floor tile vacated by red stone
constant E2 = ac(1) `escape tile vacated by blue stone
constant E3 = ac(1) `escape tile vacated by red stone

dim grid(MAX_TURNS,40,30)
global Turn = 0

randomize 1

openscreen 1024,768,32,2

rem Crudely set up a level randomly
cleararray grid(),N
for rs = 0 to REDS - 1
   grid(Turn,rnd(39),rnd(29)) = R
next rs
for bs = 0 to BLUES - 1
   grid(0,rnd(39),rnd(29)) = B
next bs
for is = 0 to IMMOVS - 1
   ix = rnd(39)
   iy = rnd(29)
   for t = 0 to MAX_TURNS - 1
      grid(t,ix,iy) = I
   next t
next is
for es = 0 to ESCAPES - 1
   ex = rnd(39)
   ey = rnd(29)
   for t = 0 to MAX_TURNS - 1   
      grid(t,ex,ey) = E
   next t
next es
grid(Turn,rnd(39),rnd(29)) = P

Draw_grid()

do
   moved$ = "No"
   waitkey
   select upper$(inkey$())
      case "W"
         flushkeys
         rem Player up
         for gx = 0 to 39
            if grid(Turn,gx,0) = P then continue
         next gx
         for gy = 1 to 29
            for gx = 0 to 39
               if grid(Turn,gx,gy) = P
                  select grid(Turn,gx,gy - 1)
                     case E,E2,E3
                        grid(Turn + 1,gx,gy - 1) = PE
                        grid(Turn + 1,gx,gy) = N
                        moved$ = "Yes"
                        won$ = "Yes"
                     case N
                        grid(Turn + 1,gx,gy - 1) = P
                        grid(Turn + 1,gx,gy) = N
                        grid(Turn,gx,gy) = P2
                        moved$ = "Yes"         
                  endselect
               endif   
            next gx
         next gy
         if moved$ = "Yes"
            rem Blue stones up
            for gy = 1 to 29
               for gx = 0 to 39   
                  if grid(Turn,gx,gy) = B or grid(Turn,gx,gy) = BE
                     select grid(Turn,gx,gy - 1)
                        case N,B2,P2,E,E2
                           if grid(Turn,gx,gy) = BE
                              grid(Turn + 1,gx,gy) = E
                              grid(Turn,gx,gy) = E2
                           else
                              grid(Turn + 1,gx,gy) = N   
                              grid(Turn,gx,gy) = B2
                           endif
                           contcase   
                        case N,B2,P2
                           grid(Turn + 1,gx,gy - 1) = B
                        case E,E2
                           grid(Turn + 1,gx,gy - 1) = BE
                        default
                           grid(Turn + 1,gx,gy) = B
                     endselect            
                  endif
               next gx   
            next gy
            for gx = 0 to 39
               if grid(Turn,gx,0) = B or grid(Turn,gx,0) = BE
                  grid(Turn + 1,gx,0) = grid(Turn,gx,0)
               endif
            next gx
            rem Red stones down
            for gy = 28 to 0 step -1
               for gx = 0 to 39   
                  if grid(Turn,gx,gy) = R or grid(Turn,gx,gy) = RE
                     if grid(Turn+1,gx,gy+1) = N or grid(Turn+1,gx,gy+1) = E
                        select grid(Turn,gx,gy + 1)
                           case N,B2,P2,R2,E,E2,E3
                              if grid(Turn,gx,gy) = RE
                                 grid(Turn + 1,gx,gy) = E
                                 grid(Turn,gx,gy) = E3
                              else
                                 grid(Turn + 1,gx,gy) = N   
                                 grid(Turn,gx,gy) = R2            
                              endif
                              contcase
                           case N,B2,P2,R2
                              grid(Turn + 1,gx,gy + 1) = R                  
                           case E,E2,E3
                              grid(Turn + 1,gx,gy + 1) = RE
                           default
                              grid(Turn + 1,gx,gy) = R
                        endselect
                     else
                        grid(Turn + 1,gx,gy) = R
                     endif   
                  endif
               next gx   
            next gy
            for gx = 0 to 39

Login required to view complete source code

[kevin]

I've actually opted to use the ac() function instead of asc().

  They're functionality the same in this case as a literal ASC() statement creates a constant.