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