To run online, click here: RUN ONLINE
All Pascated BASIC demos are compiled with Boriel BASIC compiler just with BASIC without any assembly.
All Pascated BASIC demos are compiled with Boriel BASIC compiler just with BASIC without any assembly.
Code:
' PROGRAM Torpedo
' (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 ' UBYTE is type integer
'#define STRING STRING
#define BOOLEAN UBYTE
#define TYPE AS
'#define WHILE WHILE
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
'#define MOD MOD
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
PROGRAM Torpedo
' 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 MaxTorpedos = 23 : REM min = 23 = 2+2+3+3+4+4+5
CONST FleetDelay = 20 : REM fleet speed
CONST TorpedoDelay = 5 : REM torpedo speed
CONST DepthChargeDelay = 15 : REM depth charge timeout
'CONST Blank$ TYPE STRING = " " ' 30 blank spaces *** compiler error
' VAR - Global variables
VAR Blank$ TYPE STRING = " " ' 30 blank spaces *** should be CONST
VAR Zeros$ TYPE STRING = "000000000000000000000000000000" ' 30 zeros
VAR Fleet1$,Fleet2$ TYPE STRING ' fleet silhouette
VAR Value$ TYPE STRING ' value of ship
VAR Part$ TYPE STRING ' part number of ship
VAR Life$ TYPE STRING ' life of ship
VAR Hit$ TYPE STRING ' hits
VAR Smoke2$ TYPE STRING ' smoke of hits
VAR Smoke1$ TYPE STRING ' smoke of hits
VAR MaxScore TYPE INTEGER
VAR Heading TYPE INTEGER ' center at 200
VAR Rotation TYPE INTEGER ' periscope rotation
VAR Shield TYPE INTEGER = 100
VAR Hits TYPE INTEGER ' hits on target
VAR Sink TYPE INTEGER ' ships destroyed
VAR Score TYPE INTEGER ' Current score
VAR RiposteDamage TYPE REAL ' Riposte damage (from depth charge)
VAR INDEX TYPE INTEGER
VAR DepthChargeTime TYPE INTEGER
VAR Torpedos TYPE INTEGER
VAR GameOver TYPE BOOLEAN
VAR Period TYPE INTEGER = 8
VAR CLICK TYPE INTEGER ' animation sprite bit selection 0 to 7
'---------------------------
PROCEDURE TRON (m$ TYPE STRING)
PRINT AT 0,17;TAB 31;
PRINT AT 0,17;INK 5;m$;
PAUSE 0
END PROCEDURE
'--- KEYBOARD BUFFER ---
VAR BUFFER$ TYPE STRING = ""
VAR LASTKEY$ TYPE STRING = ""
PROCEDURE ScanKey
VAR key$ TYPE STRING = INKEY$ + "#"
IF key$(0) <> LASTKEY$
LASTKEY$ = key(0)
LET BUFFER$ = BUFFER$+key$(0)
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$(0)
BUFFER$ = ""
ELSE
LET result$ = BUFFER$(0)
BUFFER$ = BUFFER$( 1 TO )
ENDIF
RETURN result$
END FUNCTION
FUNCTION LastKey$ TYPE STRING
RETURN LASTKEY$
END FUNCTION
'------------------------
VAR Clock,Clock0 TYPE INTEGER
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 SetSprites
POKE 23606,88 : POKE 23607,251-3*CLICK : REM Sprite
END PROCEDURE
PROCEDURE SetASCII
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
END PROCEDURE
'------------------------
PROCEDURE TheEnd
BORDER 0
PRINT AT 3,14;PAPER 5;INK 2;"GAME";AT 4,14;"OVER"
IF Torpedos = 0 THEN PRINT AT 5,3;PAPER 0;INK 3;Torpedos;" ";
IF Shield = 0 THEN PRINT AT 8,1;PAPER 0;INK 3;INT(Shield+0.5);"% "
IF MaxScore < Score THEN LET MaxScore = Score
END PROCEDURE
PROCEDURE ShowFleet
SetSprites
PRINT AT 12,6;Fleet1$(INDEX+Rotation-10 TO INDEX+Rotation+10)
PRINT AT 11,6;Fleet2$(INDEX+Rotation-10 TO INDEX+Rotation+10)
PRINT AT 12,6;OVER 1;Smoke1$(INDEX+Rotation-10 TO INDEX+Rotation+10)
PRINT AT 11,6;OVER 1;Smoke2$(INDEX+Rotation-10 TO INDEX+Rotation+10)
SetASCII
END PROCEDURE
PROCEDURE ProcessDepthCharge
BORDER 2
LET Shield = Shield - RiposteDamage
IF Shield <= 0 THEN LET Shield = 0 : LET Score = Score - 500 : PRINT AT 21,26;PAPER 0;INK 7;" ";AT 21,26;Score : LET GameOver = TRUE
PRINT AT 8,1;PAPER 0;INK 7;INT(Shield+0.5);"% "
END PROCEDURE
PROCEDURE SetSmokeHit
LET Hit$(INDEX+Rotation) = "1"
IF Hit$(INDEX+Rotation-1) = "0" AND Hit$(INDEX+Rotation+1) = "0"
LET Smoke2$(INDEX+Rotation-1) = """"
LET Smoke1$(INDEX+Rotation-1) = "#"
LET Smoke2$(INDEX+Rotation) = "("
LET Smoke1$(INDEX+Rotation) = ")"
ELSEIF Hit$(INDEX+Rotation-1) = "0" AND Hit$(INDEX+Rotation+1) = "1"
LET Smoke2$(INDEX+Rotation-1) = """"
LET Smoke1$(INDEX+Rotation-1) = "#"
LET Smoke2$(INDEX+Rotation) = "$"
LET Smoke1$(INDEX+Rotation) = "%"
ELSEIF Hit$(INDEX+Rotation-1) = "1" AND Hit$(INDEX+Rotation+1) = "0"
LET Smoke2$(INDEX+Rotation-1) = "$"
LET Smoke1$(INDEX+Rotation-1) = "%"
LET Smoke2$(INDEX+Rotation) = "("
LET Smoke1$(INDEX+Rotation) = ")"
ELSEIF Hit$(INDEX+Rotation-1) = "1" AND Hit$(INDEX+Rotation+1) = "1"
LET Smoke2$(INDEX+Rotation-1) = "$"
LET Smoke1$(INDEX+Rotation-1) = "%"
LET Smoke2$(INDEX+Rotation) = "$"
LET Smoke1$(INDEX+Rotation) = "%"
ENDIF
END PROCEDURE
PROCEDURE SetSmokeSink (ShipStart TYPE INTEGER, ShipValue TYPE INTEGER)
VAR i TYPE INTEGER
LET i = 0
LET Smoke2$(ShipStart+i-1) = """"
LET Smoke1$(ShipStart+i-1) = "#"
FOR i = 1 TO ShipValue*2-1
' PRINT AT 12,16;PAPER 8;INK 2;OVER 1;" ";
LET Smoke2$(ShipStart+i-1) = "$"
LET Smoke1$(ShipStart+i-1) = "%"
NEXT i
LET i = ShipValue*2
LET Smoke2$(ShipStart+i-1) = "("
LET Smoke1$(ShipStart+i-1) = ")"
END PROCEDURE
' invoqued if Value$(INDEX+Rotation) > "0"
PROCEDURE ProcessHit
VAR ShipStart TYPE INTEGER
VAR ShipValue TYPE INTEGER
LET ShipValue = VAL Value$(INDEX+Rotation)
' hit
PRINT AT 12,16;PAPER 8;INK 2;OVER 1;" ";
IF Hit$(INDEX+Rotation) = "1" ' hit on old position
LET Score = Score + ShipValue
PRINT AT 21,26;PAPER 0;INK 7;" ";AT 21,26;Score
ELSE ' hit on new position
LET Score = Score + 10 * ShipValue
PRINT AT 21,26;PAPER 0;INK 7;" ";AT 21,26;Score
LET Hit$(INDEX+Rotation) = "1"
SetSmokeHit
LET Hits = Hits + 1
PRINT AT 5,28;PAPER 0;INK 7;Hits
'LET Value$(INDEX+Rotation) = "0"
LET ShipStart = (INDEX+Rotation) - VAL Part$(INDEX+Rotation)
LET Life$(ShipStart) = STR$ ( VAL Life$(ShipStart) - 1 )
IF Life$(ShipStart) = "0"
LET Sink = Sink + 1
PRINT AT 8,28;PAPER 0;INK 7;Sink;" ";
LET Score = Score + 10*ShipValue*ShipValue
PRINT AT 21,26;PAPER 0;INK 7;" ";AT 21,26;Score
SetSmokeSink (ShipStart,ShipValue)
ENDIF
BEEP .02,0 : BEEP .02,1 : BEEP .02,4 : BEEP .02,-1 :
ENDIF
END PROCEDURE
PROCEDURE FireTorpedo
VAR elapsed TYPE INTEGER
VAR ShipValue TYPE INTEGER
' update number of torpedos
LET Torpedos = Torpedos - 1
PRINT AT 5,3;PAPER 0;INK 7;Torpedos;" ";
' first half way
FOR CLICK = 0 TO 7
ShowFleet
PLOT PAPER 1;INK 7;131,35+3*CLICK : DRAW PAPER 1;INK 7;-2*(16-CLICK)*RND,0
PLOT PAPER 1;INK 7;131,35+3*CLICK : DRAW PAPER 1;INK 7;2*(16-CLICK)*RND,0
REPEAT
' time
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
' process deaph charge
BORDER 0
IF DepthChargeTime THEN LET DepthChargeTime = DepthChargeTime - 1 : IF DepthChargeTime = 0 THEN ProcessDepthCharge
NEXT CLICK
CLICK = 0
LET INDEX = INDEX + 1 : ShowFleet
' second half way
FOR CLICK = 0 TO 7
ShowFleet
PLOT PAPER 1;INK 7;131,35+3*(CLICK+8) : DRAW PAPER 1;INK 7;-(16-(CLICK+8))*RND,0
PLOT PAPER 1;INK 7;131,35+3*(CLICK+8) : DRAW PAPER 1;INK 7;(16-(CLICK+8))*RND,0
REPEAT
' time
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
' process deaph charge
BORDER 0
IF DepthChargeTime THEN LET DepthChargeTime = DepthChargeTime - 1 : IF DepthChargeTime = 0 THEN ProcessDepthCharge
NEXT CLICK
CLICK = 0
LET INDEX = INDEX + 1 : ShowFleet
' process hit
IF Value$(INDEX+Rotation) > "0"
ProcessHit
REM ship riposte
LET ShipValue = VAL Value$(INDEX+Rotation)
LET RiposteDamage = ShipValue*(1+1.0*RND)
LET DepthChargeTime = DepthChargeDelay-INT(RND*5)
ENDIF
' delete torpedo trail
PRINT AT 13,16;PAPER 1; " "
PRINT AT 14,16;PAPER 1; " "
PRINT AT 15,15;PAPER 1; " "
PRINT AT 16,14;PAPER 1; " "
PRINT AT 17,13;PAPER 1; " "
PRINT AT 18,12;PAPER 1;" "
PRINT AT 19,12;PAPER 1;" "
END PROCEDURE
PROCEDURE ShowKeys
PRINT AT 23,0;PAPER 0;INK 5;" Keys: 12 0 "
END PROCEDURE
PROCEDURE InitFleet
VAR r TYPE INTEGER
PRINT AT 3,14;PAPER 5;" ";AT 4,14;" " : REM delete GAME OVER
'DIM Blank$(30)
LET Fleet1$ = Blank$
LET Fleet2$ = Blank$
LET Value$ = Zeros$
LET Part$ = Blank$
LET Life$ = Blank$
LET Hit$ = ""
LET Smoke2$ = ""
LET Smoke1$ = ""
FOR i = 1 TO 7
PRINT AT 0,15;PAPER 0;INK 7;5*i;" ";
LET r = 1+INT (RND*5)
LET Fleet1$ = Fleet1$ + Blank$( TO r)
LET Fleet2$ = Fleet2$ + Blank$( TO r)
LET Value$ = Value$ + Value$( TO r)
LET Part$ = Part$ + Part$( TO r)
LET Life$ = Life$ + Life$( TO r)
IF i = 1 OR i = 7 THEN LET Value$ = Value$ + "02222" : LET Fleet2$ = Fleet2$ + " ": LET Fleet1$ = Fleet1$ + "+-/13" : LET Part$ = Part$ + " 0123" : LET Life$ = Life$ + " 2xxx"
IF i = 2 OR i = 6 THEN LET Value$ = Value$ + "0333333" : LET Fleet2$ = Fleet2$ + "468:<>@": LET Fleet1$ = Fleet1$ + "579;=?A" : LET Part$ = Part$ + " 012345" : LET Life$ = Life$ + " 3xxxxx"
IF i = 3 OR i = 5 THEN LET Value$ = Value$ + "044444444" : LET Fleet2$ = Fleet2$ + "BDFHJLNPR": LET Fleet1$ = Fleet1$ + "CEGIKMOQS" : LET Part$ = Part$ + " 01234567" : LET Life$ = Life$ + " 4xxxxxxx"
IF i = 4 THEN LET Value$ = Value$ + "05555555555" : LET Fleet2$ = Fleet2$ + "TVXZ\\^`bdfh": LET Fleet1$ = Fleet1$ + "UWY[]_acegi" : LET Part$ = Part$ + " 0123456789" : LET Life$ = Life$ + " 5xxxxxxxxx"
PAUSE 10
NEXT i
FOR i = 1 TO 3
PRINT AT 0,15;PAPER 0;INK 7;35+i*5;" ";
LET Fleet1$ = Fleet1$ + "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
LET Fleet2$ = Fleet2$ + Blank$
LET Value$ = Value$ + "000000000000000000000000000000"
LET Part$ = Part$ + Blank$
LET Life$ = Life$ + Blank$
PAUSE 10
NEXT i
FOR i = 1 TO LEN Fleet1$
Hit$ = Hit$ + "0"
Smoke2$ = Smoke2$ + " "
Smoke1$ = Smoke1$ + " "
NEXT i
' init clock
LET Clock = PEEK 23672
LET Clock0 = Clock0 + Period
' PRINT LEN Fleet1$, LEN Fleet2$, LEN Value$, LEN Part$, LEN Life$, LEN Hit$, LEN Smoke2$, LEN Smoke1$
' PAUSE 0
' PRINT Fleet1$( TO 90);TAB 0;Value$( TO 90);TAB 0; Part$( TO 90);TAB 0; Life$( TO 90)
' PAUSE 0
END PROCEDURE
PROCEDURE InitVariables
BORDER 0 : PAPER 5 : INK 0
LET GameOver = FALSE
InitFleet
LET INDEX = 30
LET Heading = 50+10*INT(10*RND)
LET Rotation = 0
PRINT AT 0,15;PAPER 0;INK 7;Heading+Rotation*5;" ";
LET Torpedos = MaxTorpedos
PRINT AT 5,3;PAPER 0;INK 7;Torpedos;" ";
LET Shield = 100
PRINT AT 8,1;PAPER 0;INK 7;Shield;"% "
LET Hits = 0
PRINT AT 5,28;PAPER 0;INK 7;Hits;" ";
LET Sink = 0
PRINT AT 8,28;PAPER 0;INK 7;Sink;" ";
LET Score = 0
PRINT AT 21,26;PAPER 0;INK 7;" ";AT 21,26;Score
PRINT AT 21,3;PAPER 0;INK 7;MaxScore
LET DepthChargeTime = 0
END PROCEDURE
PROCEDURE Game
VAR key$ TYPE STRING
VAR TorpedoLoaded TYPE BOOLEAN
VAR elapsed TYPE INTEGER
InitVariables
ShowKeys
ShowFleet
LET Clock0 = PEEK 23672 + Period
REPEAT ' game
'PRINT AT 0,20;PAPER 6;INK 0;Clock0;" ";
TorpedoLoaded = FALSE
FOR CLICK = 0 TO 7
ShowFleet
'PRINT AT 0,20;INDEX
' WaitClock
REPEAT
ScanKey
LET key$ = GetKey$
IF key$ = "1" AND NOT TorpedoLoaded THEN IF Heading+Rotation*5 > 0 THEN BEEP .02,10: LET Rotation = Rotation - 1 : PRINT AT 0,15;PAPER 0;INK 7;Heading+Rotation*5;" " : ShowFleet
IF key$ = "2" AND NOT TorpedoLoaded THEN IF Heading+Rotation*5 < 300 THEN BEEP .02,15: LET Rotation = Rotation + 1 : PRINT AT 0,15;PAPER 0;INK 7;Heading+Rotation*5;" " : ShowFleet
IF key$ = "0" AND NOT TorpedoLoaded AND Torpedos > 0 THEN PRINT AT 23,8;PAPER 0;INK 6;"Loading torpedo";: TorpedoLoaded = TRUE
' time
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
BORDER 0
IF TorpedoLoaded THEN BEEP .01,5*(CLICK+RND)
' process deaph charge
IF DepthChargeTime THEN LET DepthChargeTime = DepthChargeTime - 1 : IF DepthChargeTime = 0 THEN ProcessDepthCharge
NEXT CLICK
CLICK = 0
LET INDEX = INDEX + 1 : ShowFleet : IF Fleet1$(INDEX-10) = "!" THEN LET GameOver = TRUE
IF TorpedoLoaded THEN PRINT AT 23,8;PAPER 0;INK 7;" ";: FireTorpedo
UNTIL GameOver
TheEnd
END PROCEDURE
PROCEDURE PressStart
VAR key$ TYPE STRING
PRINT AT 23,0;PAPER 0;INK 7;" Press ";INK 2;"S";INK 7;"tart ";
REPEAT
PAUSE(50)
LET key$ = INKEY$
UNTIL key$ = "s" OR key$ = "S"
PRINT AT 3,14;PAPER 5;INK 2;" ";AT 4,14;" ": REM delete Game Over
PRINT AT 23,0;PAPER 0;INK 6;" Scanning fleet... "
RANDOMIZE
END PROCEDURE
PROCEDURE ShowScreen
BORDER 0: PAPER 0: INK 0
REM sky
PAPER 5: OVER 1
PRINT AT 1,15;" "
PRINT AT 2,12;" "
PRINT AT 3,10;" "
PRINT AT 4,9;" "
PRINT AT 5,8;" "
PRINT AT 6,8;" "
PRINT AT 7,8;" "
PRINT AT 8,7;" "
PRINT AT 9,7;" "
PRINT AT 10,7;" "
PRINT AT 11,7;" "
PRINT AT 12,7;" "
PAPER 1: OVER 1
PRINT AT 13,7;" "
PRINT AT 14,7;" "
PRINT AT 15,7;" "
PRINT AT 16,8;" "
PRINT AT 17,8;" "
PRINT AT 18,9;" "
PRINT AT 19,10;" "
PRINT AT 20,12;" "
PRINT AT 21,15;" "
OVER 0
REM Instruments
PAPER 0 : INK 7
PRINT AT 0,7;"HEADING"
PRINT AT 4,0;"TORPEDOS"
PRINT AT 7,0;"SHIELD"
PRINT AT 4,27;"HITS"
PRINT AT 7,27;"SHIPS"
PRINT AT 20,25;"SCORE"
PRINT AT 20,0;"MAX SCORE"
PAPER 5 : INK 0
END PROCEDURE
PROCEDURE TestSprites
SetSprites
PRINT
PRINT " "
PRINT "+-/13"
PRINT
PRINT "468:<>@"
PRINT "579;=?A"
PRINT
PRINT "BDFHJLNPR"
PRINT "CEGIKMOQS"
PRINT
PRINT "TVXZ\\^`bdfh"
PRINT "UWY[]_acegi"
PRINT
PRINT """$&("
PRINT "#%')"
PRINT
SetASCII
END PROCEDURE
PROCEDURE SaveShips
SAVE "ships" CODE 64600,96*8
END PROCEDURE
PROCEDURE LoadShips
LOAD "ships" CODE 64600
END PROCEDURE
PROCEDURE MainRoutine
ShowScreen
PressStart
REPEAT
Game
PressStart
UNTIL FALSE
END PROCEDURE
PROGRAM Torpedo
' TestSprites: PAUSE 0
PRINT AT 23,7;PAPER 0;INK 4;"(c) 2023 by Zarsoft";
FOR n=0 TO 30: BEEP .01,n: NEXT n
PRINT AT 23,0;PAPER 0;INK 7;"Pascalated Boriel ZX BASIC demo";
PAUSE 3*50
MainRoutine
PRINT AT 23,10;INK 2;"The End"
END PROGRAM