To run online, click here: RUN ONLINE
Code:
' PROGRAM LASER
' Demo for Pascalated BASIC contest
' Version ZX81 (c) 1982 by Zarsoft
' Version ZX BASIC Boriel (c) 2023 by Zarsoft
' Language: Pascalated ZX BASIC (BORIEL) compiled
#include <input.bas>
'--- Pascalated Boriel ---
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define TYPE AS
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
#define PROGRAM REM
VAR TRUE TYPE INTEGER = 1
VAR FALSE TYPE INTEGER = 0
REM Variable declarations
REM VAR - Global variables
REM LINA routine variables
VAR SX0 = 0 : VAR SXN = 255
VAR SY0 = 0 : VAR SYN = 175-10
VAR X0 = 0 : VAR Y0 = 88 : ' first point
VAR M TYPE REAL : VAR B TYPE REAL : ' y = mX+b
REM other variables
VAR enemies = 0
VAR enemyX = 0
VAR enemyY = 0
VAR TRON = 1
PROCEDURE LINA
VAR x,y TYPE REAL
VAR dx,dy TYPE INTEGER
VAR w$ TYPE STRING = "0" : ' string starts at index 0
LET y = M*SX0+B: IF y >= SY0 THEN IF y <= SYN THEN LET w$ = w$+CHR$(SX0)+CHR$(y)
LET y = M*SXN+B: IF y >= SY0 THEN IF y <= SYN THEN LET w$ = w$+CHR$(SXN)+CHR$(y)
LET x = (SY0-B)/(M+1E-15): IF x >= SX0 THEN IF x <= SXN THEN LET w$ = w$+CHR$(x)+CHR$(SY0)
LET x = (SYN-B)/(M+1E-15): IF x >= SX0 THEN IF x <= SXN THEN LET w$ = w$+CHR$(x)+CHR$(SYN)
IF LEN(w$)-1 > 2 THEN
PLOT INK 8;CODE(w$(1)),CODE(w$(2))
FOR i=3 TO LEN(w$)-1 STEP 2
dx = CODE(w$(i))-CODE(w$(i-2))
' dy = dy*0 + CODE(w$(i+1))-CODE(w$(i-1)) : ' need to cast to INTEGER (bug?!)
' dy = -1 + CODE(w$(i+1))-CODE(w$(i-1)) + 1 : ' need to cast to INTEGER (bug?!)
dy = CAST(INTEGER,0) + CODE(w$(i+1)) - CODE(w$(i-1)) : ' need to cast to INTEGER (bug?!)
DRAW INK 8;dx,dy
NEXT i
END IF
END PROCEDURE
PROCEDURE GameOver
INK 1
PRINT AT 21,5;"> Well done! Goodbye.";
END PROCEDURE
PROCEDURE Explosion
INK 3
CIRCLE enemyX-1,enemyY+1,4
CIRCLE enemyX+1,enemyY+1,4
CIRCLE enemyX+1,enemyY-1,4
OVER 0
FOR q=1 TO 30: BEEP .002,20+5*RND: NEXT q
PAUSE 100
END PROCEDURE
PROCEDURE OnTarget
LET SXN = enemyX
OVER 1: INK 2
LINA : PAUSE 5 : LINA
OVER 0
LINA
LET enemies = enemies-1
PRINT PAPER 6;INK 0;AT 0,15;" Enemies: ";enemies;" "
Explosion
END PROCEDURE
PROCEDURE TestShot (angle TYPE REAL)
VAR y TYPE REAL
LET M = TAN(angle): LET B = Y0-M*X0
LET y = M*enemyX+B:
IF ABS(y-enemyY) < 5 THEN
OnTarget
ELSE
LET SXN = 255
INK 2
LINA
:FOR q=-10 TO 29: BEEP .005,50-ABS q: NEXT q
ENDIF
END PROCEDURE
FUNCTION ReadAngle TYPE REAL
VAR angle TYPE REAL
REPEAT
PRINT AT 23,0;"Angle = ";
angle = VAL( INPUT(5) )
UNTIL angle > -90 AND angle < 90
PRINT AT 23,0;" ";
LET angle = angle*PI/180 : REM degrees to radians
RETURN angle
END FUNCTION
PROCEDURE ShowEnemy
LET enemyX = 64+RND*182
LET enemyY = 44+RND*122
INK 1
CIRCLE enemyX,enemyY,4
END PROCEDURE
PROCEDURE DrawScreen
CLS
PRINT PAPER 0;INK 7;AT 0,0;" LASER "
PRINT PAPER 6;INK 0;AT 0,15;" Enemies: ";enemies;" "
INK 0
PLOT 0,0: DRAW 0,175 : ' vertical line
PLOT 0,88: DRAW 255,0 : ' horizontal line
END PROCEDURE
PROCEDURE InitVariables
LET enemies = 5
END PROCEDURE
PROCEDURE MainRoutine
VAR angle TYPE REAL
InitVariables
REPEAT
DrawScreen
ShowEnemy
angle = ReadAngle
TestShot(angle)
UNTIL enemies = 0
GameOver
END PROCEDURE
PROGRAM Laser
MainRoutine
PROGRAM END