To run online, click here: RUN ONLINE
Code:
' PROGRAM Eagle1 (Lander)
' (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
'#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 Eagle1
' 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 Gravity TYPE REAL = 1.62 ' gravity on the moon
CONST K TYPE REAL = 0.25
CONST Thrust TYPE REAL = 1.1
CONST MaxFuel TYPE REAL = 300
' VAR - Global variables
REM VARiable declarations
VAR MinSpeed TYPE REAL = 999
VAR MaxScore TYPE INTEGER = -1
VAR U$(10) ' DIM U$(8,5) : REM Sprites, upper line
VAR V$(10) ' DIM V$(8,5) : REM Sprites, bottom line
VAR x TYPE INTEGER
VAR y TYPE REAL
VAR yy TYPE INTEGER
VAR Fuel TYPE REAL
VAR DY TYPE REAL
VAR Landed TYPE BOOLEAN
VAR Score TYPE INTEGER
VAR T TYPE INTEGER
VAR Message TYPE INTEGER
PROCEDURE TRON (m$ TYPE STRING)
PRINT AT 23,0;INK 5;m$;
PAUSE 0
END PROCEDURE
PROCEDURE GetReady
PRINT AT 11,0;INK 5;"Press 1 to start"
REPEAT
PAUSE 0
UNTIL INKEY$ = "1"
PRINT AT 11,0;INK 5;" "
END PROCEDURE
PROCEDURE Report
IF ABS DY < MinSpeed THEN LET MinSpeed = ABS DY
LET Score = INT(0.5+(2000+Fuel)/(2^ABS DY))
IF Score <= 1 THEN LET Score = 0
IF Score > MaxScore THEN LET MaxScore = Score
PRINT INK 6;AT 1,0;"Height: ";0;" "
PRINT INK 4;AT 3,0;"MinSpeed:";(STR$ MinSpeed+" ")(0 TO 2)
PRINT INK 4;AT 4,0;"MaxScore:";MaxScore;
IF Score = 0
LET m$ = "You fell like a rock!"
LET n$ = "Press 0 to Thrust."
PRINT AT 21,15;OVER 1;PAPER 8;INK 3;" ";
ELSEIF Score < 500
LET m$ = "You are a beginner."
LET n$ = "Try to be an amateur."
PRINT AT 21,15;OVER 1;PAPER 8;INK 6;" ";
ELSEIF Score < 1000
LET m$ = "You are an amateur."
LET n$ = "Try to be a professional."
PRINT AT 21,15;OVER 1;PAPER 8;INK 5;" ";
ELSE
LET m$ = "You are a professional!"
LET n$ = "You are wasting your time here!"
PRINT AT 21,15;OVER 1;PAPER 8;INK 4;" ";
ENDIF
PRINT AT 6,0;INK 3;"Score: ";Score
PRINT AT 8,0;INK 6;m$
PRINT AT 9,0;INK 6;n$
BEEP 0.1,0: BEEP 0.1,20: BEEP 0.1,10
REM wait a few seconds
LET T = PEEK 23672 + 3*50
IF T > 255 THEN LET T = T - 255
REPEAT
PAUSE 1
UNTIL ABS (T - PEEK 23672) < 5
GetReady
PRINT AT 6,0;" "
PRINT AT 8,0;INK 4;" "
PRINT AT 9,0;INK 4;" "
PRINT AT 20,15;" ";
PRINT AT 21,15;" ";
END PROCEDURE
FUNCTION DataStory TYPE STRING
VAR r$ TYPE STRING
IF Message = 1
r$ = "Hello!"
ELSEIF Message = 2
r$ = "Hello!" + CHR(13) + "Do you read me?"
ELSEIF Message = 3
r$ = "This is Dr Helena Russel,"
ELSEIF Message = 4
r$ = "This is Dr Helena Russel," + CHR(13) + "calling Moonbase Alpha."
ELSEIF Message = 5
r$ = "We are in danger:"
ELSEIF Message = 6
r$ = "We are in danger:" + CHR(13) + "Pilot Alan Carter is sick."
ELSEIF Message = 7
r$ = "You need to land the Eagle 1"
ELSEIF Message = 8
r$ = "You need to land the Eagle 1" + CHR(13) + "by remote control."
ELSEIF Message = 9
r$ = "You are our only hope." + CHR(13) + "God help us!"
ENDIF
RETURN r$
END FUNCTION
PROCEDURE ClearStory
PRINT AT 8,0;
PRINT " ";TAB 0;" ";TAB 0;
PRINT " ";TAB 0;" ";TAB 0;
END PROCEDURE
PROCEDURE TellStory
VAR m$ TYPE STRING
ClearStory
m$ = DataStory
PRINT AT 8,0;INK 6;m$
BEEP 0.1,0: BEEP 0.1,20: BEEP 0.1,10
PAUSE 3*50
LET Message = Message + 1
END PROCEDURE
PROCEDURE DrawScreen
PRINT PAPER 2;INK 0;BRIGHT 1;AT 0, 22;" EAGLE 1 "
PRINT INK 6;AT 0,0;"Fuel: ";Fuel;" "
PRINT INK 6;AT 1,0;"Height: ";ABS INT y;" "
PRINT INK 5;AT 2,0;"Speed: ";(STR$ ABS DY+" ")(0 TO 2)
END PROCEDURE
PROCEDURE InitVariables
LET x = 150
LET y = 175-8
LET yy = y
LET Fuel = MaxFuel
LET DY = 0
LET Landed = FALSE
END PROCEDURE
PROCEDURE Lander
VAR lin TYPE INTEGER
VAR ix TYPE INTEGER
InitVariables
DrawScreen
IF MaxScore < 0 THEN GetReady
REPEAT
LET k$ = INKEY$
IF k$ = "0" AND Fuel > 0
BEEP .01,30: LET DY = DY + Thrust : LET Fuel = Fuel - 10
ELSE
BEEP .01,-28
ENDIF
LET DY = DY - K*Gravity : REM Gravity
LET y = y + DY
LET yy = INT(y+0.5)
IF yy < 0 THEN LET yy = 0 : LET Landed = TRUE
IF yy > 175-8 THEN LET yy = 175-8
LET lin = 21-INT (yy/8)
LET ix = 1+yy-8*INT(yy/8)
POKE 23606,88 : POKE 23607,251 : REM Sprite
PRINT AT lin-1,15;U$(ix)(1 TO 5)
PRINT AT lin,15;V$(ix)(1 TO 5)
IF lin > 1 THEN PRINT AT lin-2,15;" "; : IF ABS DY > 8 THEN PRINT AT lin-3,15;" ";
IF lin < 21 THEN PRINT AT lin+1,15;" ";
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
PRINT INK 6;AT 0,0;"Fuel: ";Fuel;" "
PRINT INK 6;AT 1,0;"Height: ";ABS INT y;" "
PRINT INK 5;AT 2,0;"Speed: ";(STR$ ABS DY+" ")(0 TO 2)
UNTIL Landed
Report
END PROCEDURE
PROCEDURE RestoreData (s TYPE INTEGER)
VAR b,r,n TYPE INTEGER
RESTORE
FOR b=1 TO s
FOR r=0 TO 4
READ n
NEXT r
NEXT b
END PROCEDURE
PROCEDURE InitSprites
CONST RAMTOP = 23730 : REM (87,255) = 65367 = 65535-21*8
CONST SIZE = 936 : REM 96*8 + 21*8
CONST NEWTOP = 64599 : REM 65535-936
REM CLEAR 64599
CONST CHARS = 23606 : REM (0,61-1) = 15616-256
CONST CharsUDG = 65368 : REM USR "A" = 65368 = 65536-21*8
CONST CharsSprites = 64600 : REM 65536-21*8-96*8
REM CharsSprites POKE = (344,251)
VAR s,b,r,n TYPE INTEGER
VAR dest TYPE INTEGER
LET Message = 0
TellStory
' INIT STRINGS
FOR s=0 TO 7
LET U$(s+1) = ":12345"
LET V$(s+1) = ":12345"
NEXT s
REM Define Lines
LET n=32
FOR s=0 TO 7
FOR c=0 TO 4
LET U$(s+1)(c+1) = CHR$(n)
LET n = n+1
NEXT c
FOR c=0 TO 4
LET V$(s+1)(c+1) = CHR$(n)
LET n = n+1
NEXT c
NEXT s
REM Define Sprites
FOR s=7 TO 0 STEP -1
TellStory
RestoreData(s)
LET dest = CharsSprites + 2*5*8*s
REM upper line
FOR b=0 TO 7
FOR r=0 TO 4
READ n
POKE dest+b+r*8,n
'TRON("POKE "+STR$ (dest+b+r*8) )
NEXT r
NEXT b
LET dest = dest + 5*8
REM bottom line
FOR b=0 TO 7
FOR r=0 TO 4
READ n
POKE dest+b+r*8,n
'TRON("POKE "+STR$ (dest+b+r*8) )
NEXT r
NEXT b
REM print eagle
POKE 23606,88 : POKE 23607,251 : REM Sprite
PRINT AT 0,15;V$(s+1)(1 TO );
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
'TRON("s "+STR$ s)
NEXT s
' show sprites
IF FALSE
CLS
c = 1
FOR s=0 TO 7
' upper
c = 3-c: PAPER c
PRINT U$(s+1);":";
POKE 23606,88 : POKE 23607,251 : REM Sprite
PRINT U$(s+1)(1 TO );
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
PRINT ":"
' bottom
c = 3-c: PAPER c
PRINT V$(s+1);":";
POKE 23606,88 : POKE 23607,251 : REM Sprite
PRINT V$(s+1)(1 TO );
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
PRINT ":"
NEXT s
PAUSE 0
CLS
ENDIF
END PROCEDURE
PROCEDURE DataSprite
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 01111111, BIN 11111111, BIN 11111111, BIN 11100001
DATA BIN 00011110, BIN 11111111, BIN 11111111, BIN 11111111, BIN 11110111
DATA BIN 01111111, BIN 11111111, BIN 11111111, BIN 11111111, BIN 11111111
DATA BIN 01111111, BIN 11111111, BIN 11111111, BIN 11111111, BIN 11110111
DATA BIN 00011110, BIN 11111111, BIN 11111111, BIN 11111111, BIN 11100001
DATA BIN 00000000, BIN 00011110, BIN 00000000, BIN 00001111, BIN 00000000
DATA BIN 00000000, BIN 00001100, BIN 00000000, BIN 00000110, BIN 00000000
DATA BIN 00000000, BIN 00011110, BIN 00000000, BIN 00001111, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
DATA BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000, BIN 00000000
END PROCEDURE
PROCEDURE LoadBackground
BORDER 0 : PAPER 0 : INK 7 : CLS
LOAD "" SCREEN$
END PROCEDURE
PROGRAM Eagle1
REM CLEAR 64599
POKE 23606,0 : POKE 23607,60 : REM ZX Chars
PRINT AT 23,0;INK 3;"Pascalated Boriel ZX BASIC demo";
PAUSE 2*50
LoadBackground
InitSprites
ClearStory
REPEAT
Lander
UNTIL FALSE
GameOver
END PROGRAM