To run online, click here: RUN ONLINE
Code:
' PROGRAM Klotski
' (c) ZarSoft 2022 Pascalated BASIC
' (c) ZarSoft 2023 Pascalated Boriel ZX BASIC
' Written by Ze Oliveira
' Pascalated Sinclair BASIC (c) 1987 by ZarSoft
' Pascalated BASIC Converter (c) 2021 by Zarsoft
' Pascalated Boriel (c) 2023 by ZarSoft
' ZX BASIC Compiler (c) 2008 by Boriel
#include <input.bas> ' number = VAL INPUT(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas> ' ATTR function
'--- Pascalated Boriel ---
#define PROGRAM REM
#define BEGIN REM
'#define CONST CONST
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define CHAR STRING
'#define STRING STRING
#define BOOLEAN UBYTE
#define TYPE AS
'#define WHILE WHILE
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
PROGRAM Klotski
' CONSTant declarations
REM CONSTant declarations
CONST black = 0
CONST blue = 1
CONST red = 2
CONST magenta = 3
CONST green = 4
CONST cyan = 5
CONST yellow = 6
CONST white = 7
CONST ScreenLin =6
CONST ScreenCol =8
CONST dl =3: REM 4
CONST dc =3: REM 8
CONST MaxM = 199
CONST MinM = 83
' VAR - Global variables
VAR Board$(4) TYPE STRING ' board
VAR Coord(9,2,2) TYPE INTEGER ' coordinates of objects
VAR Sprite$(9,6) TYPE STRING ' photo of objects
VAR PositionLin,PositionCol TYPE INTEGER
VAR Nmove TYPE INTEGER
VAR grabbed TYPE BOOLEAN
VAR abort TYPE BOOLEAN
PROCEDURE TRON (m TYPE STRING)
PRINT AT 23,0;m;
PAUSE 0
END PROCEDURE
PROCEDURE TraceBoard
PRINT AT 11,0;Board$(1);AT 12,0;Board$(2);AT 13,0;Board$(3);AT 14,0;;Board$(4)
END PROCEDURE
PROCEDURE finalization
PRINT AT 2,0;"###**=- CONGRATULATIONS! -=**###"
: FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
PRINT AT 23,0;INK magenta;" ";TAB 9;"Press any key";TAB 32;
PAUSE 0:
BEEP .1,5
END PROCEDURE
FUNCTION GetObjectAtCursor TYPE INTEGER
VAR ob TYPE INTEGER
LET ob = VAL Board$(PositionLin)(PositionCol)
RETURN ob
END FUNCTION
PROCEDURE EraseObject (ob TYPE INTEGER)
VAR PosLin, PosCol TYPE INTEGER
LET PosLin = ScreenLin+(Coord(ob,1,1)-1)*dl
LET PosCol = ScreenCol+(Coord(ob,1,2)-1)*dc
FOR l = 1 TO 6
PRINT AT PosLin+l,PosCol;OVER 1;Sprite$(ob,l);
NEXT l
END PROCEDURE
PROCEDURE EraseObjectAtCursor
VAR ob TYPE INTEGER
LET ob = GetObjectAtCursor
EraseObject(ob)
END PROCEDURE
PROCEDURE PrintObject (ob TYPE INTEGER)
VAR PosLin, PosCol TYPE INTEGER
LET PosLin = ScreenLin+(Coord(ob,1,1)-1)*dl
LET PosCol = ScreenCol+(Coord(ob,1,2)-1)*dc
FOR l = 1 TO 6
PRINT AT PosLin+l,PosCol;OVER 1;Sprite$(ob,l);
NEXT l
END PROCEDURE
PROCEDURE MoveObject (key$ TYPE STRING)
VAR ob TYPE INTEGER
ob = GetObjectAtCursor
EraseObjectAtCursor
FOR l = Coord(ob,1,1) TO Coord(ob,2,1)
FOR c = Coord(ob,1,2) TO Coord(ob,2,2)
LET Board$(l)(c) = "0"
NEXT c
NEXT l
IF key$ ="Q"
LET Coord(ob,1,1) = Coord(ob,1,1)-1: LET Coord(ob,2,1) = Coord(ob,2,1)-1:
LET PositionLin = PositionLin-1:
ELSEIF key$="A"
LET Coord(ob,1,1) = Coord(ob,1,1)+1: LET Coord(ob,2,1) = Coord(ob,2,1)+1:
LET PositionLin = PositionLin+1:
ELSEIF key$="O"
LET Coord(ob,1,2) = Coord(ob,1,2)-1: LET Coord(ob,2,2) = Coord(ob,2,2)-1:
LET PositionCol = PositionCol-1:
ELSEIF key$="P"
LET Coord(ob,1,2) = Coord(ob,1,2)+1: LET Coord(ob,2,2) = Coord(ob,2,2)+1:
LET PositionCol = PositionCol+1:
ENDIF
FOR l = Coord(ob,1,1) TO Coord(ob,2,1)
FOR c = Coord(ob,1,2) TO Coord(ob,2,2)
LET Board$(l)(c) = STR$ ob
NEXT c
NEXT l
PrintObject(ob)
LET Nmove = Nmove+1:
PRINT AT 2,0;"Current: ";Nmove
END PROCEDURE
FUNCTION CheckLegalUp TYPE BOOLEAN
VAR l,c TYPE INTEGER
VAR ok TYPE BOOLEAN
VAR ob TYPE INTEGER
ob = GetObjectAtCursor
LET l = Coord(ob,1,1)-1
IF l > 0
LET ok = TRUE
ELSE
LET ok = FALSE
ENDIF
LET c = Coord(ob,1,2):
WHILE (c <= Coord(ob,2,2)) AND ok
IF Board$(l)(c) <> "0" THEN LET ok = FALSE
LET c = c+1
END WHILE
RETURN ok
END FUNCTION
FUNCTION CheckLegalDown TYPE BOOLEAN
VAR l,c TYPE INTEGER
VAR ok TYPE BOOLEAN
VAR ob TYPE INTEGER
ob = GetObjectAtCursor
LET l = Coord(ob,2,1)+1:
IF l < 5
LET ok = TRUE
ELSE
LET ok = FALSE
ENDIF
LET c = Coord(ob,1,2):
WHILE (c <= Coord(ob,2,2)) AND ok
IF Board$(l)(c) <> "0" THEN LET ok = FALSE
LET c = c+1
END WHILE
RETURN ok
END FUNCTION
FUNCTION CheckLegalLeft TYPE BOOLEAN
VAR l,c TYPE INTEGER
VAR ok TYPE BOOLEAN
VAR ob TYPE INTEGER
ob = GetObjectAtCursor
LET c = Coord(ob,1,2)-1:
IF c > 0
LET ok = TRUE
ELSE
LET ok = FALSE
ENDIF
LET l = Coord(ob,1,1):
WHILE (l <= Coord(ob,2,1)) AND ok
IF Board$(l)(c) <> "0" THEN LET ok = FALSE
LET l = l+1
END WHILE
RETURN ok
END FUNCTION
FUNCTION CheckLegalRight TYPE BOOLEAN
VAR l,c TYPE INTEGER
VAR ok TYPE BOOLEAN
VAR ob TYPE INTEGER
ob = GetObjectAtCursor
LET c = Coord(ob,2,2)+1:
IF c < 6
LET ok = TRUE
ELSE
LET ok = FALSE:
ENDIF
LET l = Coord(ob,1,1):
WHILE (l <= Coord(ob,2,1)) AND ok
IF Board$(l)(c) <> "0" THEN LET ok = FALSE
LET l = l+1
END WHILE
RETURN ok
END FUNCTION
FUNCTION CheckLegalMove (key$ TYPE STRING) TYPE BOOLEAN
VAR legal TYPE BOOLEAN
VAR ob TYPE INTEGER
LET legal = FALSE
ob = GetObjectAtCursor
IF key$ = " " OR key$="M"
IF ob > 0
REM IF grabbed THEN EraseObjectAtCursor
LET grabbed = NOT(grabbed):
REM GetObjectAtCursor: PrintObject: REM (ObjectAtCursor)
ENDIF
ELSEIF key$>="A" AND key$<="Z"
IF grabbed
IF ob > 0
IF key$="Q" THEN legal = CheckLegalUp
IF key$="A" THEN legal = CheckLegalDown
IF key$="O" THEN legal = CheckLegalLeft
IF key$="P" THEN legal = CheckLegalRight
ENDIF
ELSE
IF key$="Q" THEN IF PositionLin > 1 THEN LET PositionLin = PositionLin-1:
IF key$="A" THEN IF PositionLin < 4 THEN LET PositionLin = PositionLin+1:
IF key$="O" THEN IF PositionCol > 1 THEN LET PositionCol = PositionCol-1:
IF key$="P" THEN IF PositionCol < 5 THEN LET PositionCol = PositionCol+1:
ENDIF
ELSE IF key$ = "0"
LET abort = TRUE
ENDIF
RETURN legal
END FUNCTION
FUNCTION InputMove TYPE STRING
VAR key$ TYPE STRING
VAR ColorCursor TYPE INTEGER
LET ColorCursor = yellow
IF grabbed THEN LET ColorCursor = red
PRINT AT ScreenLin+(PositionLin-1)*dl+2,ScreenCol+(PositionCol-1)*dc+1;OVER 1;PAPER ColorCursor;INK ColorCursor;" ";
REPEAT
PAUSE 0: LET key$ = INKEY$
REM IF key$=CHR$(27) THEN LET t = "0":
IF key$ > "Z" THEN LET key$ = CHR$(CODE(key$)+CODE("A")-CODE("a"))
UNTIL key$="0" OR key$=" " OR (key$>="A" AND key$<="Z")
BEEP .1,5
REM IF grabbed THEN PRINT "#" ELSE PRINT " "
PRINT AT ScreenLin+(PositionLin-1)*dl+2,ScreenCol+(PositionCol-1)*dc+1;OVER 1;" ";
RETURN key$
END FUNCTION
PROCEDURE initialization
LET abort = FALSE
LET Nmove = 0
LET grabbed = FALSE
LET PositionLin = 3: LET PositionCol = 3
REM board
LET Board$(0) = "......":
LET Board$(1) = ".98076":
LET Board$(2) = ".98076":
LET Board$(3) = ".11355":
LET Board$(4) = ".11244":
REM size of objects
LET Coord(1,1,1) = 3: LET Coord(1,1,2) = 1: LET Coord(1,2,1) = 4: LET Coord(1,2,2) = 2
LET Coord(2,1,1) = 4: LET Coord(2,1,2) = 3: LET Coord(2,2,1) = 4: LET Coord(2,2,2) = 3
LET Coord(3,1,1) = 3: LET Coord(3,1,2) = 3: LET Coord(3,2,1) = 3: LET Coord(3,2,2) = 3
LET Coord(4,1,1) = 4: LET Coord(4,1,2) = 4: LET Coord(4,2,1) = 4: LET Coord(4,2,2) = 5
LET Coord(5,1,1) = 3: LET Coord(5,1,2) = 4: LET Coord(5,2,1) = 3: LET Coord(5,2,2) = 5
LET Coord(6,1,1) = 1: LET Coord(6,1,2) = 5: LET Coord(6,2,1) = 2: LET Coord(6,2,2) = 5
LET Coord(7,1,1) = 1: LET Coord(7,1,2) = 4: LET Coord(7,2,1) = 2: LET Coord(7,2,2) = 4
LET Coord(8,1,1) = 1: LET Coord(8,1,2) = 2: LET Coord(8,2,1) = 2: LET Coord(8,2,2) = 2
LET Coord(9,1,1) = 1: LET Coord(9,1,2) = 1: LET Coord(9,2,1) = 2: LET Coord(9,2,2) = 1
REM photo of objects
REM 1
LET Sprite$(1,1) = "\ .\..\..\..\..\.."
LET Sprite$(1,2) = "\ :\::\::\::\::\::"
LET Sprite$(1,3) = "\ :\::\::\::\::\::"
LET Sprite$(1,4) = "\ :\::\::\::\::\::"
LET Sprite$(1,5) = "\ :\::\::\::\::\::"
LET Sprite$(1,6) = "\ :\::\::\::\::\::"
REM 2
LET Sprite$(2,1) = "\ .\..\.."
LET Sprite$(2,2) = "\ :\::\::"
LET Sprite$(2,3) = "\ :\::\::"
REM 3
LET Sprite$(3,1) = "\ .\..\.."
LET Sprite$(3,2) = "\ :\::\::"
LET Sprite$(3,3) = "\ :\::\::"
REM 4
LET Sprite$(4,1) = "\ .\..\..\..\..\.."
LET Sprite$(4,2) = "\ :\::\::\::\::\::"
LET Sprite$(4,3) = "\ :\::\::\::\::\::"
REM 5
LET Sprite$(5,1) = "\ .\..\..\..\..\.."
LET Sprite$(5,2) = "\ :\::\::\::\::\::"
LET Sprite$(5,3) = "\ :\::\::\::\::\::"
REM 6
LET Sprite$(6,1) = "\ .\..\.."
LET Sprite$(6,2) = "\ :\::\::"
LET Sprite$(6,3) = "\ :\::\::"
LET Sprite$(6,4) = "\ :\::\::"
LET Sprite$(6,5) = "\ :\::\::"
LET Sprite$(6,6) = "\ :\::\::"
REM 7
LET Sprite$(7,1) = "\ .\..\.."
LET Sprite$(7,2) = "\ :\::\::"
LET Sprite$(7,3) = "\ :\::\::"
LET Sprite$(7,4) = "\ :\::\::"
LET Sprite$(7,5) = "\ :\::\::"
LET Sprite$(7,6) = "\ :\::\::"
REM 8
LET Sprite$(8,1) = "\ .\..\.."
LET Sprite$(8,2) = "\ :\::\::"
LET Sprite$(8,3) = "\ :\::\::"
LET Sprite$(8,4) = "\ :\::\::"
LET Sprite$(8,5) = "\ :\::\::"
LET Sprite$(8,6) = "\ :\::\::"
REM 9
LET Sprite$(9,1) = "\ .\..\.."
LET Sprite$(9,2) = "\ :\::\::"
LET Sprite$(9,3) = "\ :\::\::"
LET Sprite$(9,4) = "\ :\::\::"
LET Sprite$(9,5) = "\ :\::\::"
LET Sprite$(9,6) = "\ :\::\::"
REM background
CLS
PRINT AT 0,12;INK 2;"KLOTSKI"
REM PRINT AT 2,0;"Current= ";Nmove
PRINT AT 2,20;"Minimum= ";MinM
PRINT AT 23,0;INK magenta;"QAOP-Move M,SPC-Select 0-Abort";
FOR ob = 1 TO 9 : PrintObject(ob): NEXT ob
END PROCEDURE
PROCEDURE introduction
BORDER 4: PAPER 4: INK 0: CLS
PRINT AT 5,12;INK 2;"KLOTSKI"
PRINT AT 10,0;"Move the big square","from bottom-left to bottom-right"
PRINT AT 23,0;INK magenta;" ";TAB 9;"Press any key";TAB 32;
PAUSE 0
BEEP .1,5
END PROCEDURE
PROCEDURE MainRoutine
VAR key$ TYPE STRING
VAR legal TYPE BOOLEAN
REPEAT
introduction
initialization
REPEAT
key$ = InputMove
legal = CheckLegalMove(key$)
IF legal THEN MoveObject(key$)
UNTIL (Board$(4)(5)="1") OR abort
UNTIL (Board$(4)(5)="1")
IF Board$(4)(5)="1" THEN finalization
END PROCEDURE
PROGRAM Klotski
PRINT AT 23,0;"Pascalated Boriel ZX BASIC demo";
PAUSE 1*50
MainRoutine
END PROGRAM