To run online, click here: RUN ONLINE
Code:
' PROGRAM 15
' (c) 2023 by Zarsoft
' Written by Ze Oliveira
' Demo for the Pascalated language
' 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 INPUTable(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas> ' ATTR function
'--- Pascalated Boriel ---
'#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
#define PROGRAM REM
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
' CONSTant declarations
' VAR - Global variables
REM VAR B$(4,4) TYPE CHAR '--- the board
VAR Board$(4) TYPE STRING '--- the board
VAR Table(127,2) TYPE INTEGER '--- table for key conversion onto movements Lin,Col
VAR Success TYPE BOOLEAN '--- board completed
VAR PositionL TYPE INTEGER '--- current position of the blank space
VAR PositionC TYPE INTEGER '--- current position of the blank space
VAR NewPositionL TYPE INTEGER
VAR NewPositionC TYPE INTEGER
VAR PosL TYPE INTEGER '--- position of the board
VAR PosC TYPE INTEGER '--- position of the board
PROCEDURE GameOver
PRINT AT 21,10;FLASH 1;"SUCCESS!";
PAUSE 50
PRINT AT 22,3;"GAME OVER - insert coin";
PAUSE 0
END PROCEDURE
PROCEDURE ShowPosition
PRINT AT PosL+0+3*PositionL,PosC+3*PositionC;"\:'\''\':";
PRINT AT PosL+1+3*PositionL,PosC+3*PositionC;"\: ";Board$(PositionL)(PositionC);"\ :";
PRINT AT PosL+2+3*PositionL,PosC+3*PositionC;"\:.\..\.:";
END PROCEDURE
PROCEDURE HidePosition
PRINT AT PosL+0+3*PositionL,PosC+3*PositionC;"\::\::\::";
PRINT AT PosL+1+3*PositionL,PosC+3*PositionC;"\::\::\::";
PRINT AT PosL+2+3*PositionL,PosC+3*PositionC;"\::\::\::";
END PROCEDURE
PROCEDURE MovePiece
LET Board$(PositionL)(PositionC) = Board$(NewPositionL)(NewPositionC)
LET Board$(NewPositionL)(NewPositionC) = " "
ShowPosition
LET PositionL = NewPositionL
LET PositionC = NewPositionC
HidePosition
IF Board$(4) = "MNO " THEN IF Board$(3) = "IJKL" THEN IF Board$(2) = "EFGH" THEN IF Board$(1) = "ABCD" THEN LET Success = TRUE
END PROCEDURE
FUNCTION ReadKey TYPE INTEGER
REPEAT
PAUSE 0
LET k$ = INKEY$
UNTIL k$ <> ""
REM PRINT AT 21,0;CODE k$;" ";
BEEP .01,10
RETURN CODE k$
END FUNCTION
PROCEDURE ShowBoard
VAR bakL TYPE INTEGER
VAR bakC TYPE INTEGER
BORDER 1 : PAPER 1 : INK 7 : CLS
PRINT AT 0,9;"--- ";INK 3;15;INK 7;" ---"
PRINT AT 2,5;INK 5;"Sort the characters"
PRINT AT 3,3;INK 5;"(in alphabetical order)"
PRINT AT 20,3;INK 5;"Keys: 5678 QAOP arrows";
PRINT AT 22,3;INK 0;" Pascalated BASIC ";
PRINT AT 23,3;INK 0;"Compiled by ZX BASIC (Boriel)";
PAPER 0 : INK 7
REM backup vars because there is no local vars
LET bakL = PositionL
LET bakC = PositionC
REM show all positions
FOR L=1 TO 4
FOR C=1 TO 4
LET PositionL = L
LET PositionC = C
ShowPosition
NEXT C
NEXT L
REM restore vars
LET PositionL = bakL
LET PositionC = bakC
HidePosition
REM shadow on the bottom
FOR C=1 TO 12
PRINT AT PosL+3+12,PosC+2+C;" ";
NEXT C
PRINT AT PosL+3+12,PosC+2+1;INK 1;"\. ";
PRINT AT PosL+3+12,PosC+3+12;" ";
REM shadow on the right
FOR L=1 TO 12
PRINT AT PosL+2+L,PosC+3+12;" ";
NEXT L
PRINT AT PosL+2+1,PosC+3+12;INK 1;"\':";
END PROCEDURE
PROCEDURE InitVariables
LET PosL = 3
LET PosC = 5
REM Board
REM DIM Board$(4,4)
REM board for debug
LET Board$(1) = ".ABCD"
LET Board$(2) = ".EFGH"
LET Board$(3) = ".IJKL"
LET Board$(4) = ".MN O"
LET PositionL = 4
LET PositionC = 3
REM inverse order
LET Board$(1) = ". ONM"
LET Board$(2) = ".LKJI"
LET Board$(3) = ".HGFE"
LET Board$(4) = ".DCBA"
LET PositionL = 1
LET PositionC = 1
LET Success = FALSE
REM Table for keyboard conversion to make movements
REM DIM Table(128,2)
REM left
LET Table(CODE "5",2) = 1
LET Table(CODE "o",2) = 1
LET Table(CODE "O",2) = 1
LET Table(8,2) = 1 : REM arrow
REM right
LET Table(CODE "8",2) = -1
LET Table(CODE "p",2) = -1
LET Table(CODE "P",2) = -1
LET Table(9,2) = -1 : REM arrow
REM up
LET Table(CODE "7",1) = 1
LET Table(CODE "q",1) = 1
LET Table(CODE "Q",1) = 1
LET Table(11,1) = 1 : REM arrow
REM down
LET Table(CODE "6",1) = -1
LET Table(CODE "a",1) = -1
LET Table(CODE "A",1) = -1
LET Table(10,1) = -1 : REM arrow
END PROCEDURE
PROCEDURE MainRoutine
InitVariables
ShowBoard
REPEAT
keycode = ReadKey
IF Table(keycode,1)+Table(keycode,2) <> 0
LET NewPositionL = PositionL+Table(keycode,1)
LET NewPositionC = PositionC+Table(keycode,2)
IF NewPositionL >=1 AND NewPositionL <= 4 AND NewPositionC >= 1 AND NewPositionC <= 4
MovePiece
ENDIF
ENDIF
UNTIL Success
GameOver
END PROCEDURE
PROGRAM Game15
MainRoutine
' last 2 lines are going to be deleted
PRINT AT 23,0;
END PROGRAM