Forum
Pascalated ZX BASIC Demo #9 - 15 - Printable Version

+- Forum (https://www.boriel.com/forum)
+-- Forum: Compilers and Computer Languages (https://www.boriel.com/forum/forumdisplay.php?fid=12)
+--- Forum: ZX Basic Compiler (https://www.boriel.com/forum/forumdisplay.php?fid=11)
+---- Forum: Gallery (https://www.boriel.com/forum/forumdisplay.php?fid=18)
+---- Thread: Pascalated ZX BASIC Demo #9 - 15 (/showthread.php?tid=2354)



Pascalated ZX BASIC Demo #9 - 15 - zarsoft - 03-19-2023

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