( SokoED                     )
( The SokoACE map editor     )

( (c) 2006  by Ricardo Fernandes Lopes )
( under the GNU General Public License )

( ------------ How to Use it -------------)
( Load the SokoACE map editor with:       )
(  LOAD SOKOED                            )
(                                         )
( Create a new map 123 from scratch using:)
(  123 NEW                                )
(                                         )
( or load an existing map to edit with:   )
(  MAP BLOAD mapname ED                   )
(                                         )
( When finished, quit editor with Q       )
( then save map to tape using:            )
(  MAP BSAVE mapname                      )
( ----------------------------------------)

( Graphic characters )
CREATE T 56 ALLOT
: GR 8 * T + DUP 8 + SWAP DO I C! LOOP ;
16 BASE C!
00 00 00 00 00 00 00 00 00 GR ( Not used     )
00 00 00 18 18 00 00 00 01 GR ( Target       )
3C 42 81 FF 99 99 7E 3C 02 GR ( Soko         )
3C 42 BD FF BD 99 7E 3C 03 GR ( Soko + Target)
00 7E 42 42 42 42 7E 00 04 GR ( Box          )
00 7E 42 5A 5A 42 7E 00 05 GR ( Box + Target )
FF AB D5 AB D5 AB D5 FF 06 GR ( Wall         )
DECIMAL
: SETGR 56 0 DO T I + C@ 10240 I + C! LOOP ;

( Screen elements)
01 CONSTANT TARGET
02 CONSTANT SOKO
04 CONSTANT BOX
06 CONSTANT WALL
32 CONSTANT BL

: KEY ( -- c , wait for keypress)
  BEGIN INKEY 0= UNTIL
  BEGIN INKEY ?DUP UNTIL ;

: >UPPER ( c1 -- c2 , convert to uppercase)
  DUP 96 > IF 223 AND THEN ;

: +! ( n adr -- )  SWAP OVER @ + SWAP ! ;

   1 VARIABLE MAP#    ( Map number     )
9546 VARIABLE CURSOR  ( Cursor address )

( Movement directions)
-32 CONSTANT UP
 32 CONSTANT DOWN
 -1 CONSTANT LEFT
  1 CONSTANT RIGHT

( Displaying cursor)
: CURSOR-ON   CURSOR @ DUP C@ 128  OR SWAP C! ;
: CURSOR-OFF  CURSOR @ DUP C@ 127 AND SWAP C! ;

: GO ( dir -- , move cursor to given direction)
  CURSOR @ SWAP OVER +              ( Calc new cursor position)
  DUP 31 AND 20 < IF SWAP THEN DROP ( horizontal limit)
  9280 MAX 9907 MIN                 ( vertical limit )
  CURSOR ! ;


: WALK ( c -- c , Move cursor )
  DUP ASCII I = IF    UP GO ELSE
  DUP ASCII K = IF  DOWN GO ELSE
  DUP ASCII J = IF  LEFT GO ELSE
  DUP ASCII L = IF RIGHT GO
  THEN THEN THEN THEN ;

( Place a character at cursor position )
: SET ( c -- )   CURSOR @ C! ;

: DRAW ( c -- c )
  DUP ASCII X = IF            BL SET ELSE
  DUP ASCII T = IF        TARGET SET ELSE
  DUP ASCII B = IF           BOX SET ELSE
  DUP ASCII O = IF  BOX TARGET + SET ELSE
  DUP ASCII S = IF          SOKO SET ELSE
  DUP ASCII Z = IF SOKO TARGET + SET ELSE
  DUP ASCII W = IF          WALL SET
  THEN THEN THEN THEN THEN THEN THEN ;

: .MAP#  1 0 AT ." MAP " MAP# @ . SPACE ;

: .FRAME
   0  0 AT ." _SokoACE Map Editor_ version 1.0"
   2 21 AT ." I Up"
   3 21 AT ." K Down"
   4 21 AT ." J Left"
   5 21 AT ." L Right"
   7 21 AT ." S Soko"
   8 21 AT ." Z Soko+Trgt"
   9 21 AT ." B Box"
  10 21 AT ." O Box+Trgt"
  11 21 AT ." T Target"
  12 21 AT ." W Wall"
  13 21 AT ." X Clr Cell"
  15 21 AT ." C Clr Map"
  16 21 AT ." N Map + 1"
  17 21 AT ." P Map - 1"
  18 21 AT ." M Map ?"
  20 21 AT ." Q quit"
  22  0 AT ." _by Ricardo F Lopes_   c 2006"
  .MAP# ;

: #IN ( -- n , get a number from the user)
  QUERY NUMBER DUP
  IF
    4181 =
    IF DROP DROP 0 THEN ( avoid float numbers )
  THEN ;

: PLAY ( c -- )
  WALK DRAW
  DUP ASCII C = IF  CLS .FRAME        ELSE
  DUP ASCII N = IF    1 MAP# +! .MAP# ELSE
  DUP ASCII P = IF   -1 MAP# +! .MAP# ELSE
  DUP ASCII M = IF  #IN MAP# !  .MAP#
  THEN THEN THEN THEN DROP ;

21 20 * CONSTANT MAPSIZE
CREATE BUF MAPSIZE ALLOT
: MAP ( adr n -- )   BUF MAPSIZE ;

( Copy Map on screen to buffer for saving)
: SCR>BUF
  8224 BUF ( src dst )
  21 0     ( 21 lines )
  DO
    20 0   ( 20 chars per line )
    DO
      OVER I + @ OVER I + !
      2
    +LOOP
    20 + SWAP
    32 + SWAP
  LOOP ;

( Copy Map on buffer to screen for editing)
: BUF>SCR
  1 0 AT
  BUF 21 0
  DO DUP 20 TYPE CR 20 + LOOP DROP ;

: ED ( Edit map on screen)
  INVIS CLS SETGR
  BUF>SCR .FRAME
  9546 CURSOR !
  BEGIN
    CURSOR-ON KEY >UPPER CURSOR-OFF
    DUP ASCII Q = 0=
  WHILE
    PLAY
  REPEAT 
  DROP SCR>BUF ; ( save screen to buffer for saving )

( create a new map )
: NEW ( n -- , Start new map n)
  MAP# ! CLS .MAP# SCR>BUF ED ;