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