Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pascalated ZX BASIC Demo #10 - Worm
#1
To run online, click here: RUN ONLINE

Code:
' PROGRAM Worm
' (c) Starsoft 2020 Java console
' (c) Starsoft 2022 Pascalated BASIC
' (c) Starsoft 2023 Pascalated Boriel ZX BASIC
' Written by David Magalhaes
' 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 Worm

' CONSTant declarations
CONST Period TYPE INTEGER = 8

' VAR - Global variables
VAR Clock,Clock0 TYPE INTEGER
VAR GAMEOVER TYPE BOOLEAN
VAR LIN, COL TYPE INTEGER
VAR Direction, DirectionOld TYPE INTEGER
VAR LengthMax TYPE INTEGER
VAR LengthCurrent TYPE INTEGER
VAR TailL, TailC TYPE INTEGER
VAR Cook TYPE INTEGER
VAR DirectionTail TYPE INTEGER
VAR Trail$(8,8) TYPE STRING ' automaton for PrintTrail
VAR TailDirection$(8,128) TYPE STRING ' automaton for getDirectionTail
VAR TailColor(150) TYPE INTEGER ' automaton for tail colors
VAR KeyMap$(128) TYPE STRING ' automaton to use several keys
VAR DX, DY TYPE INTEGER ' index for automaton for moveForward
VAR DXY(8,2) TYPE INTEGER ' automaton for moveForward
VAR Record TYPE INTEGER ' max length achieved

'--- KEYBOARD BUFFER ---

VAR BUFFER$ TYPE STRING = ""

PROCEDURE ScanKey
VAR key$ TYPE STRING = INKEY$
VAR l TYPE INTEGER
IF key$ <> "" THEN
  IF BUFFER$ = "" THEN
    LET BUFFER$ = BUFFER$+INKEY$
  ELSE
    LET l = LEN BUFFER$
    IF BUFFER$(l-1) <> key$ THEN LET BUFFER$ = BUFFER$+INKEY$
  ENDIF
ENDIF
END PROCEDURE

FUNCTION GetKey$ TYPE STRING
VAR result$ TYPE STRING
VAR l TYPE INTEGER
LET l = LEN BUFFER$
IF l = 0
  LET result$ = CHR 0
ELSEIF l = 1
  LET result$ = BUFFER$
  BUFFER$ = ""
ELSE
  LET result$ = BUFFER$(0)
  BUFFER$ = BUFFER$( 1 TO )
ENDIF
RETURN result$
END FUNCTION

'------------------------

PROCEDURE TheEnd
PRINT AT 21,10; ink 2; " GAME OVER "
BEEP .5,15: BEEP .5,10: BEEP .5,5: BEEP .5,0
PAUSE 50
IF LengthCurrent > Record
  PRINT AT 0,8; ink 2; " NEW HIGH SCORE "
  BEEP .5,10: BEEP .5,0: BEEP .5,20
  LET Record = LengthCurrent
ENDIF
REPEAT
UNTIL  INKEY$ = ""
FOR i=1 TO 5
  PAUSE 50
NEXT i
END PROCEDURE

PROCEDURE GiveFood
VAR cMin TYPE INTEGER = 3
VAR cMax TYPE INTEGER = 30
VAR lMin TYPE INTEGER = 3
VAR lMax TYPE INTEGER = 20
VAR l,c TYPE INTEGER
VAR food TYPE INTEGER
IF Cook < 10
  LET Cook = Cook+1
ELSE
  LET Cook = 0
  LET l = lMin + INT(RND * ((lMax - lMin) + 1))
  LET c = cMin + INT(RND * ((cMax - cMin) + 1))
  LET food = 1 + INT(RND * ((9 - 1) + 1))
  IF SCREEN$(l,c) = " " THEN PRINT AT l, c; food
ENDIF
END PROCEDURE

PROCEDURE PrintTrailOldVersion
IF DirectionOld = 5 AND Direction = 5
  LET r$ = "-"
ELSEIF DirectionOld = 5 AND Direction = 6
  LET r$ = "/"
ELSEIF DirectionOld = 5 AND Direction = 7
  LET r$ = "\\"
ELSEIF DirectionOld = 6 AND Direction = 6
  LET r$ = "|"
ELSEIF DirectionOld = 6 AND Direction = 5
  LET r$ = "/"
ELSEIF DirectionOld = 6 AND Direction = 8
  LET r$ = "\\"
ELSEIF DirectionOld = 7 AND Direction = 7
  LET r$ = "|"
ELSEIF DirectionOld = 7 AND Direction = 5
  LET r$ = "\\"
ELSEIF DirectionOld = 7 AND Direction = 8
  LET r$ = "/"
ELSEIF DirectionOld = 8 AND Direction = 8
  LET r$ = "-"
ELSEIF DirectionOld = 8 AND Direction = 6
  LET r$ = "\\"
ELSEIF DirectionOld = 8 AND Direction = 7
  LET r$ = "/"
ELSE
  LET r$ = "."
ENDIF
PRINT AT LIN, COL; r$
END PROCEDURE

PROCEDURE PrintTrail
PRINT AT LIN, COL; ink TailColor(CODE Trail$(DirectionOld,Direction)); Trail$(DirectionOld,Direction)
END PROCEDURE

PROCEDURE getDirectionTailOld1Version
LET c$ = SCREEN$(TailL,TailC)
IF DirectionTail = 5 AND c$ = "-"
  LET DirectionTail = 5
ELSEIF DirectionTail = 5 AND c$ = "/"
  LET DirectionTail = 6
ELSEIF DirectionTail = 5 AND c$ = "\\"
  LET DirectionTail = 7
ELSEIF DirectionTail = 6 AND c$ = "|"
  LET DirectionTail = 6
ELSEIF DirectionTail = 6 AND c$ = "/"
  LET DirectionTail = 5
ELSEIF DirectionTail = 6 AND c$ = "\\"
  LET DirectionTail = 8
ELSEIF DirectionTail = 7 AND c$ = "|"
  LET DirectionTail = 7
ELSEIF DirectionTail = 7 AND c$ = "/"
  LET DirectionTail = 8
ELSEIF DirectionTail = 7 AND c$ = "\\"
  LET DirectionTail = 5
ELSEIF DirectionTail = 8 AND c$ = "-"
  LET DirectionTail = 8
ELSEIF DirectionTail = 8 AND c$ = "/"
  LET DirectionTail = 7
ELSEIF DirectionTail = 8 AND c$ = "\\"
  LET DirectionTail = 6
ENDIF
END PROCEDURE

PROCEDURE getDirectionTailOld2Version
LET c$ = SCREEN$(TailL,TailC)
LET DirectionTail = VAL TailDirection$(DirectionTail,CODE c$)
END PROCEDURE

PROCEDURE getDirectionTail
VAR c TYPE INTEGER
LET c = ATTR(TailL,TailC) - 56
LET DirectionTail = VAL TailDirection$(DirectionTail, c)
END PROCEDURE

PROCEDURE MoveForwardOldVersion
PrintTrail
REM move worm
IF Direction = 8
  LET COL = COL+1
ELSEIF Direction = 5
  LET COL = COL-1
ELSEIF Direction = 7
  LET LIN = LIN-1
ELSE
  LET LIN = LIN+1
ENDIF
LET c$ = SCREEN$(LIN,COL)
IF c$ = " "
  REM nothing ahead
  PRINT AT  LIN, COL; "o"  : REM head of worm
  PRINT AT 22, 8; LengthCurrent
ELSEIF c$ >= "1" AND c$ <= "9"
  REM steped on food
  LET LengthMax = LengthMax + VAL c$
  PRINT AT  LIN, COL; "o";
  BEEP .005,INT (30*RND)
ELSE
  PRINT AT  LIN, COL; "X"
  LET GAMEOVER = TRUE
ENDIF
LET DirectionOld = Direction
REM process Tail
IF LengthCurrent < LengthMax BEGIN w
  LET LengthCurrent = LengthCurrent+1
ELSE
  getDirectionTail
  PRINT AT TailL, TailC; " "
  IF DirectionTail = 6
    LET TailL = TailL+1
  ELSEIF DirectionTail = 5
    LET TailC = TailC-1
  ELSEIF DirectionTail = 8
    LET TailC = TailC+1
  ELSEIF DirectionTail = 7
    LET TailL = TailL-1
  ENDIF
ENDIF
END PROCEDURE

PROCEDURE MoveForward
PrintTrail
REM move worm
LET LIN = LIN + DXY(Direction,DY)
LET COL = COL + DXY(Direction,DX)
LET c$ = SCREEN$(LIN,COL)
IF c$ = " "
  REM nothing ahead
  PRINT AT  LIN, COL; "o"  : REM head of worm
  PRINT AT 22, 8; LengthCurrent
ELSEIF c$ >= "1" AND c$ <= "9"
  REM steped on food
  LET LengthMax = LengthMax + VAL c$
  PRINT AT  LIN, COL; "o";
  BEEP .01,INT (30*RND)
ELSE
  PRINT AT  LIN, COL; "X"
  LET GAMEOVER = TRUE
ENDIF
LET DirectionOld = Direction
REM process Tail
IF LengthCurrent < LengthMax
  LET LengthCurrent = LengthCurrent+1
ELSE
  getDirectionTail
  PRINT AT TailL, TailC; " "
  LET TailL = TailL + DXY(DirectionTail,DY)
  LET TailC = TailC + DXY(DirectionTail,DX)
ENDIF
END PROCEDURE

PROCEDURE WaitClock
VAR elapsed TYPE INTEGER
REPEAT
  ScanKey
  LET Clock = PEEK 23672
  LET elapsed = Clock-Clock0
  IF elapsed<0 THEN LET elapsed = elapsed+256
UNTIL elapsed >= Period
LET Clock0 = Clock0 + Period: IF Clock0 > 255 THEN LET Clock0 = Clock0 - 256
REM PRINT AT 0,0;INK 2;elapsed;"  ";
END PROCEDURE

PROCEDURE WaitForPlayer
PRINT AT 18,5;"Keys: 5678 QAOP arrows"
PRINT AT 19,3;"  PRESS ANY KEY TO START  "
FOR i = -20 TO 20: BEEP .005,ABS i: NEXT i
REPEAT
  PAUSE 0
  LET BUFFER$ = KeyMap$(CODE (INKEY$+" ") )
UNTIL BUFFER$ >= "5" AND BUFFER$ <= "8"
BEEP .1,20
LET Direction = VAL BUFFER$
LET DirectionOld = Direction
LET DirectionTail = Direction
LET Clock0 = PEEK 23672
PRINT AT 18,5;"                      "
PRINT AT 19,5;"                      "
END PROCEDURE

PROCEDURE InitGame
BORDER 7: PAPER 7: INK 0: CLS
REM horizontal frame
FOR i=0 TO 31
  REM  top frame
  PRINT AT  0, i; "#";
  REM  bottom frame
  PRINT AT  21, i; "#";
NEXT i
REM vertical frame
FOR i=0 TO 21
  REM  left frame
  PRINT AT  i, 0; "#";
  REM  right frame
  PRINT AT  i, 31; "#";
NEXT i
REM Titulos
PRINT AT  0, 13; ink 1; "WORM";
PRINT AT 22, 0; "Length: ";
PRINT AT 23, 0; "Record: "; Record
PRINT AT 22, 23; "(c) 2023";AT  23, 23; "STARSOFT";
LET LIN = 10 : LET COL = 10
LET TailL = 10 : LET TailC = 10
LET Direction = 0 : LET DirectionOld = 0 : REM must init with first move
LET Cook= 0
LET BUFFER$ = ""
PRINT AT LIN, COL; "o" : REM head of worm
LET LengthMax = 2 : LET LengthCurrent = 1
REM PRINT AT  1, 10; LengthCurrent
PRINT AT 22, 8; LengthCurrent
LET GAMEOVER = FALSE
END PROCEDURE

PROCEDURE Game
InitGame
WaitForPlayer
REPEAT
  WaitClock
  LET key$ = GetKey
  LET key$ = KeyMap$(CODE (key$+" ") )
  IF key$ >= "5" AND key$ <= "8" THEN  IF Direction + VAL key$ <> 13 THEN LET Direction = VAL key$
  MoveForward
  GiveFood
UNTIL GAMEOVER
TheEnd
END PROCEDURE

PROCEDURE DefineChars
VAR n TYPE INTEGER
REM RESTORE DataChars
READ BUFFER$
REPEAT
  FOR i=0 TO 7
    READ n
    POKE USR BUFFER$+i,n
  NEXT i
  READ BUFFER$
UNTIL BUFFER$ = ""
END PROCEDURE

PROCEDURE DataChars
DATA "A"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11111111
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "B"
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA "C"
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00011111
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "D"
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 11110000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "E"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11110000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA "F"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00011111
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA BIN 00010000
DATA ""
END PROCEDURE

PROCEDURE InitProg
REM CLS: PRINT AT 18,5;"Please wait..."
LET Record = 0
DefineChars
REM automaton for PrintTrail
REM DIM Trail$(8,8)
LET Trail$(5,5) = "\A" : REM "-"
LET Trail$(5,6) = "\F" : REM "/"
LET Trail$(5,7) = "\C" : REM "\\"
LET Trail$(6,6) = "\B" : REM "|"
LET Trail$(6,5) = "\D" : REM "/"
LET Trail$(6,8) = "\C" : REM "\\"
LET Trail$(7,7) = "\B" : REM "|"
LET Trail$(7,5) = "\E" : REM "\\"
LET Trail$(7,8) = "\F" : REM "/"
LET Trail$(8,8) = "\A" : REM "-"
LET Trail$(8,6) = "\E" : REM "\\"
LET Trail$(8,7) = "\D" : REM "/"
REM automaton for getDirectionTail
REM DIM TailDirection$(8,4)
LET TailDirection$(5,1) = "5"
LET TailDirection$(5,3) = "7"
LET TailDirection$(5,4) = "6"
LET TailDirection$(6,2) = "6"
LET TailDirection$(6,3) = "8"
LET TailDirection$(6,4) = "5"
LET TailDirection$(7,2) = "7"
LET TailDirection$(7,3) = "5"
LET TailDirection$(7,4) = "8"
LET TailDirection$(8,1) = "8"
LET TailDirection$(8,3) = "6"
LET TailDirection$(8,4) = "7"
REM automaton for moveForward
REM DIM DXY(8,2)
LET DX = 1 : LET DY = 2
LET DXY(5,DX) = -1 : LET DXY(5,DY) = 0
LET DXY(6,DX) = 0 : LET DXY(6,DY) = 1
LET DXY(7,DX) = 0 : LET DXY(7,DY) = -1
LET DXY(8,DX) = 1 : LET DXY(8,DY) = 0
REM automaton for tail colors
REM DIM TailColor(150)
LET TailColor(CODE("\A")) = 1
LET TailColor(CODE("\B")) = 2
LET TailColor(CODE("\C")) = 3
LET TailColor(CODE("\D")) = 4
LET TailColor(CODE("\E")) = 3
LET TailColor(CODE("\F")) = 4
REM Table for accept 5678 qaop and arrows
REM DIM KeyMap$(128)
REM left
LET KeyMap$(CODE "5") = "5"
LET KeyMap$(CODE "o") = "5"
LET KeyMap$(CODE "O") = "5"
LET KeyMap$(8) = "5" : REM arrow
REM right
LET KeyMap$(CODE "8") = "8"
LET KeyMap$(CODE "p") = "8"
LET KeyMap$(CODE "P") = "8"
LET KeyMap$(9) = "8" : REM arrow
REM up
LET KeyMap$(CODE "7") = "7"
LET KeyMap$(CODE "q") = "7"
LET KeyMap$(CODE "Q") = "7"
LET KeyMap$(11) = "7" : REM arrow
REM down
LET KeyMap$(CODE "6") = "6"
LET KeyMap$(CODE "a") = "6"
LET KeyMap$(CODE "A") = "6"
LET KeyMap$(10) = "6" : REM arrow
END PROCEDURE

PROCEDURE MainRoutine
InitProg
REPEAT
  Game
UNTIL FALSE
END PROCEDURE

BEGIN
POKE 23739,244: REM restore messages
PRINT PAPER 5;INK 0;AT 1,13;"   Do you think   ";AT 2,13;"there will be life";AT 3,13;" in other apples?";
FOR j = 1 TO 3
  FOR i = 0 TO 20: BEEP .005,i: NEXT i
NEXT j
PAUSE 2*50
MainRoutine
END
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)