Welcome, Guest |
You have to register before you can post on our site.
|
Forum Statistics |
» Members: 292
» Latest member: anime
» Forum threads: 1,008
» Forum posts: 6,144
Full Statistics
|
Online Users |
There are currently 89 online users. » 0 Member(s) | 88 Guest(s) Bing
|
Latest Threads |
Error: STRING CONSTant
Forum: Bug Reports
Last Post: boriel
08-30-2023, 07:40 AM
» Replies: 2
» Views: 523
|
48K, CLEAR, ZAP!
Forum: Help & Support
Last Post: zarsoft
08-18-2023, 11:31 AM
» Replies: 0
» Views: 137
|
Microdrive or +3 Disk sup...
Forum: Help & Support
Last Post: cronomantic
08-15-2023, 08:35 PM
» Replies: 2
» Views: 282
|
up7
Forum: Gallery
Last Post: zarsoft
08-13-2023, 08:30 PM
» Replies: 0
» Views: 147
|
Win Prizes playing videog...
Forum: Gallery
Last Post: zarsoft
08-01-2023, 01:58 PM
» Replies: 0
» Views: 159
|
TAP be gone
Forum: Wishlist
Last Post: zarsoft
07-31-2023, 10:55 PM
» Replies: 2
» Views: 310
|
Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
07-25-2023, 07:18 PM
» Replies: 0
» Views: 178
|
Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
07-16-2023, 06:12 PM
» Replies: 0
» Views: 211
|
ORG 60000 - LEN(compiled ...
Forum: ZX Basic Compiler
Last Post: zarsoft
07-02-2023, 12:42 PM
» Replies: 2
» Views: 2,281
|
Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
07-02-2023, 12:33 PM
» Replies: 0
» Views: 234
|
|
|
48K, CLEAR, ZAP! |
Posted by: zarsoft - 08-18-2023, 11:31 AM - Forum: Help & Support
- No Replies
|
 |
Hi
I want to use all the available memory with PEEK/POKE.
On the ZX Spectrum I could do CLEAR NNNN and use all the memory after NNNN.
How do I know what memory is available?
|
|
|
up7 |
Posted by: zarsoft - 08-13-2023, 08:30 PM - Forum: Gallery
- No Replies
|
 |
Game up7 written in Pascalated BASIC.
To play online, click HERE.
|
|
|
Win Prizes playing videogames |
Posted by: zarsoft - 08-01-2023, 01:58 PM - Forum: Gallery
- No Replies
|
 |
Poker written in Pascalated BASIC.
To play online, click HERE.
(On the bottom of the page you have the link to play online and the link to download.)
|
|
|
TAP be gone |
Posted by: zarsoft - 07-29-2023, 09:01 AM - Forum: Wishlist
- Replies (2)
|
 |
I wish ".tap" not to appear in the name of the recorded bytes.
"Game.tap" CODE 32768,12345
should be
"Game" CODE 32768,12345
".tap" already appears in the file name.
It does not need to appear again in the recorded block header.
|
|
|
Pascalated ZX BASIC Demo #24 - Torpedo |
Posted by: zarsoft - 07-25-2023, 07:18 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
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
|
|
|
Pascalated ZX BASIC Demo #23 - Space Invader |
Posted by: zarsoft - 07-16-2023, 06:12 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
Code: ' PROGRAM Space Invader
' (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
CONST TRUE TYPE BOOLEAN = 1
CONST FALSE TYPE BOOLEAN = 0
PROGRAM SpaceInvader
' 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 ZXscreen = 22528
CONST GameScreen = ZXscreen+4+4*32
' VAR - Global variables
VAR INKoff TYPE INTEGER = blue
VAR INKon TYPE INTEGER= cyan
VAR LEDoff TYPE INTEGER = INKoff+64
VAR LEDon TYPE INTEGER = INKon+64
VAR VIDEO(8,6) TYPE INTEGER ' video memory
VAR ADDR(8,6) TYPE INTEGER ' video address
VAR score1 TYPE INTEGER
VAR score2 TYPE INTEGER
VAR score3 TYPE INTEGER
VAR PlayerLin TYPE INTEGER
VAR PlayerCol TYPE INTEGER
VAR MissileLin TYPE INTEGER
VAR MissileCol TYPE INTEGER
VAR BombLin TYPE INTEGER
VAR BombCol TYPE INTEGER
VAR MothershipLin TYPE INTEGER
VAR MothershipCol TYPE INTEGER
VAR MothershipInc TYPE INTEGER
VAR Enemies TYPE INTEGER
VAR ScrollState TYPE INTEGER
VAR ScrollLin TYPE INTEGER
VAR ScrollCol TYPE INTEGER
VAR GameOver TYPE BOOLEAN
' VAR Scroll TYPE INTEGER = VAL ("Scroll"+STR$ ScrollState)
VAR k$ TYPE CHAR
VAR Period TYPE INTEGER = 16
'--- 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 InitADDR
VAR l,c TYPE INTEGER
FOR l=1 TO 8
FOR c=1 TO 6
ADDR(l,c) = GameScreen+l*64+c*3
' POKE ADDR(l,c),18
NEXT c
NEXT l
END PROCEDURE
PROCEDURE ShipOFF (l TYPE INTEGER,c TYPE INTEGER)
VAR addr TYPE INTEGER
VIDEO(l,c) = 0
addr = ADDR(l,c)
POKE addr,LEDoff: POKE addr+1,LEDoff: POKE addr+2,LEDoff
END PROCEDURE
PROCEDURE ShipON (l TYPE INTEGER,c TYPE INTEGER)
VAR addr TYPE INTEGER
IF VIDEO(l,c) = 0 THEN VIDEO(l,c) = 1 ' do not change shield value
addr = ADDR(l,c)
POKE addr,LEDon: POKE addr+1,LEDon: POKE addr+2,LEDon
END PROCEDURE
PROCEDURE FireOFF (l TYPE INTEGER,c TYPE INTEGER)
VAR addr TYPE INTEGER
addr = ADDR(l,c)
IF VIDEO(l,c) = 0 THEN POKE addr+1,LEDoff
END PROCEDURE
PROCEDURE FireON (l TYPE INTEGER,c TYPE INTEGER)
VAR addr TYPE INTEGER
addr = ADDR(l,c)
IF VIDEO(l,c) = 0 THEN POKE addr+1,LEDon
END PROCEDURE
'------------------------
'------------------------
PROCEDURE ChangeColors
VAR l,c TYPE INTEGER
VAR oldOFF,oldON TYPE INTEGER
oldOFF = LEDoff
oldON = LEDon
INKoff = (black+blue)-INKoff
INKon = (red+cyan)-INKon
LEDoff = INKoff+64
LEDon = INKon+64
' update colors on screen
FOR l=2 TO 4
FOR c=7 TO 24
IF ATTR(l,c) = oldOFF THEN PRINT AT l,c;OVER 1;BRIGHT 1;PAPER 8;INK LEDoff;" ";
IF ATTR(l,c) = oldON THEN PRINT AT l,c;OVER 1;BRIGHT 1;PAPER 8;INK LEDon;" ";
NEXT c
NEXT l
FOR l=6 TO 20 STEP 2
FOR c=7 TO 24
IF ATTR(l,c) = oldOFF THEN PRINT AT l,c;OVER 1;BRIGHT 1;PAPER 8;INK LEDoff;" ";
IF ATTR(l,c) = oldON THEN PRINT AT l,c;OVER 1;BRIGHT 1;PAPER 8;INK LEDon;" ";
NEXT c
NEXT l
END PROCEDURE
'------------------------
PROCEDURE ShowScore
IF score1 > 9 THEN LET score1 = score1-10: LET score2 = score2 + 1: IF score2 > 9 THEN LET score2 = score2-10: LET score3 = score3 + 1: IF score3 > 9 THEN LET score3 = score3-10
ShowDigit(1,score1)
ShowDigit(2,score2)
ShowDigit(3,score3)
END PROCEDURE
'------------------------
PROCEDURE NewWave
' Period for game speed
LET Period = Period-1: IF Period < 8 THEN LET Period = 8
' Enemies
LET VIDEO(2,1) = 1: LET VIDEO(2,2) = 1: LET VIDEO(2,3) = 1: LET VIDEO(2,4) = 1
LET VIDEO(3,1) = 1: LET VIDEO(3,2) = 1: LET VIDEO(3,3) = 1: LET VIDEO(3,4) = 1
LET Enemies = 8
' bombs and missiles
LET BombLin = 0
LET BombCol = 0
LET MissileLin = 0
LET MissileCol = 0
' Scroll
LET ScrollState = 1
LET ScrollLin = 6
LET ScrollCol = 6
' refresh screen
FOR l=1 TO 8
FOR c=1 TO 6
IF VIDEO(l,c) = 0
ShipOFF(l,c)
ELSE
ShipON(l,c)
ENDIF
NEXT c
NEXT l
END PROCEDURE
'------------------------
PROCEDURE MoveLeft
VAR i TYPE INTEGER
IF PlayerCol > 1
ShipOFF(PlayerLin,PlayerCol)
LET PlayerCol = PlayerCol - 1
ShipON(PlayerLin,PlayerCol)
BEEP .01,5
ENDIF
END PROCEDURE
PROCEDURE MoveRight
VAR i TYPE INTEGER
IF PlayerCol < 6
ShipOFF(PlayerLin,PlayerCol)
LET PlayerCol = PlayerCol + 1
ShipON(PlayerLin,PlayerCol)
BEEP .01,5
ENDIF
END PROCEDURE
PROCEDURE MissileFire
IF MissileLin = 0
IF VIDEO(7,PlayerCol) = 0 ' freeway
LET MissileLin = 7
LET MissileCol = PlayerCol
FireON(MissileLin,MissileCol)
BEEP .1,5
ENDIF
ENDIF
END PROCEDURE
PROCEDURE MissileGo
FireOFF(MissileLin,MissileCol)
LET MissileLin = MissileLin-1
IF MissileLin >= 1 ' free way
IF VIDEO(MissileLin,MissileCol) = 0
FireON(MissileLin,MissileCol)
ELSE
IF MissileLin = 1 ' hit on mothership
ShipOFF(MissileLin,MissileCol): LET MothershipCol = 0
LET score1 = score1 + 5: ShowScore
LET MissileLin = 0
BEEP .01,0: BEEP .01,10: BEEP .01,20: BEEP .01,30
ELSE ' hit on ship
ShipOFF(MissileLin,MissileCol)
LET Enemies = Enemies - 1: LET score1 = score1 + 2: ShowScore
LET MissileLin = 0
BEEP .01,0: BEEP .01,10: BEEP .01,20: BEEP .01,30
IF Enemies = 0 THEN NewWave: FOR n=0 TO 30: BEEP .01,n: NEXT n
ENDIF
ENDIF
ENDIF
END PROCEDURE
PROCEDURE BombDrop
LET BombLin = 6
LET BombCol = 1+INT(RND*6)
WHILE VIDEO(BombLin,BombCol) = 0 AND BombLin >= 1
LET BombLin = BombLin-1
END WHILE
IF BombLin = 1
LET BombLin = BombLin+1
FireON(BombLin,BombCol)
ENDIF
END PROCEDURE
PROCEDURE BombGo
FireOFF(BombLin,BombCol)
LET BombLin = BombLin+1
IF BombLin = 9
REM ground zero
LET BombLin = 0
ELSEIF VIDEO(BombLin,BombCol) = 0 ' free way
FireON(BombLin,BombCol)
ELSEIF BombLin = 7 ' hit shield
LET VIDEO(7,BombCol) = VIDEO(7,BombCol)-1: IF VIDEO(7,BombCol) = 0 THEN ShipOFF(7,BombCol): BEEP .2,30
LET BombLin = 0
ELSEIF BombLin = 8 ' hit defender
ShipOFF(PlayerLin,PlayerCol)
LET BombLin = 0
BEEP .2,5: BEEP .2,7: BEEP .2,0: BEEP .4,0
LET GameOver = TRUE
ENDIF
END PROCEDURE
PROCEDURE MothershipStart
VAR i TYPE INTEGER
LET MothershipInc = -MothershipInc
LET MothershipCol = 1+5*(MothershipInc = -1)
ShipON(MothershipLin,MothershipCol)
END PROCEDURE
PROCEDURE MothershipGo
ShipOFF(MothershipLin,MothershipCol)
LET MothershipCol = MothershipCol + MothershipInc
IF MothershipCol < 1 OR MothershipCol > 6
LET MothershipCol = 0
ELSE
ShipON(MothershipLin,MothershipCol)
ENDIF
END PROCEDURE
' scroll right
PROCEDURE Scroll1
VAR l TYPE INTEGER
REM shift ship
FOR l = 6 TO 2 STEP -1
IF VIDEO(l,ScrollCol-1) > 0 THEN ShipON(l,ScrollCol): ShipOFF(l,ScrollCol-1)
NEXT l
LET ScrollCol = ScrollCol-1
IF ScrollCol = 1
IF VIDEO(2,6) + VIDEO(3,6) + VIDEO(4,6) + VIDEO(5,6) + VIDEO(6,6) = 0
REM continue scroll right
LET ScrollState = 1
LET ScrollCol = 6
ELSE
REM goto scroll down (at right corner)
LET ScrollState = 2
LET ScrollCol = 6
IF VIDEO(6,1) + VIDEO(6,2) + VIDEO(6,3) + VIDEO(6,4) + VIDEO(6,5) + VIDEO(6,6) > 0 THEN BEEP .1,5: BEEP .1,7: BEEP .1,0: BEEP .1,0: LET GameOver = TRUE
ENDIF
ENDIF
END PROCEDURE
' scroll down (at right corner)
PROCEDURE Scroll2
VAR l TYPE INTEGER
REM shift ship
FOR l = 6 TO 3 STEP -1
IF VIDEO(l-1,ScrollCol) > 0 THEN ShipON(l,ScrollCol): ShipOFF(l-1,ScrollCol)
NEXT l
LET ScrollCol = ScrollCol-1
IF ScrollCol = 1 ' goto scroll left
LET ScrollState = 3
LET ScrollCol = 1
ENDIF
END PROCEDURE
' scroll left
PROCEDURE Scroll3
VAR i TYPE INTEGER
REM shift ship
FOR i = 6 TO 2 STEP -1
IF VIDEO(i,ScrollCol+1) > 0 THEN ShipON(i,ScrollCol): ShipOFF(i,ScrollCol+1)
NEXT i
LET ScrollCol = ScrollCol+1
IF ScrollCol = 6
IF VIDEO(2,1) + VIDEO(3,1) + VIDEO(4,1) + VIDEO(5,1) + VIDEO(6,1) = 0
REM continue scroll left
LET ScrollState = 3
LET ScrollCol = 1
ELSE
REM goto scroll down (at right corner)
LET ScrollState = 4
LET ScrollCol = 1
IF VIDEO(6,1) + VIDEO(6,2) + VIDEO(6,3) + VIDEO(6,4) + VIDEO(6,5) + VIDEO(6,6) > 0 THEN BEEP .1,5: BEEP .1,7: BEEP .1,0: BEEP .1,0: LET GameOver = TRUE
ENDIF
ENDIF
END PROCEDURE
' scroll down (at left corner)
PROCEDURE Scroll4
VAR l TYPE INTEGER
REM shift ship
FOR l = 6 TO 3 STEP -1
IF VIDEO(l-1,ScrollCol) > 0 THEN ShipON(l,ScrollCol): ShipOFF(l-1,ScrollCol)
NEXT l
LET ScrollCol = ScrollCol+1
IF ScrollCol = 6 ' goto scroll right
LET ScrollState = 1
LET ScrollCol = 5
ENDIF
END PROCEDURE
PROCEDURE Scroll
IF ScrollState = 1
Scroll1
ELSEIF ScrollState = 2
Scroll2
ELSEIF ScrollState = 3
Scroll3
ELSEIF ScrollState = 4
Scroll4
ENDIF
END PROCEDURE
PROCEDURE ShowDigit0 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\: \ :";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\:.\.:";
END PROCEDURE
PROCEDURE ShowDigit1 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\ \ .";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\ \ :";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\ \ :";
END PROCEDURE
PROCEDURE ShowDigit2 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\..\.:";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\:.\..";
END PROCEDURE
PROCEDURE ShowDigit3 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\..\.:";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\..\.:";
END PROCEDURE
PROCEDURE ShowDigit4 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\. \ .";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\:.\.:";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\ \ :";
END PROCEDURE
PROCEDURE ShowDigit5 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\:.\..";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\..\.:";
END PROCEDURE
PROCEDURE ShowDigit6 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\:.\..";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\:.\.:";
END PROCEDURE
PROCEDURE ShowDigit7 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\ \ :";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\ \ :";
END PROCEDURE
PROCEDURE ShowDigit8 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\:.\.:";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\:.\.:";
END PROCEDURE
PROCEDURE ShowDigit9 (col TYPE INTEGER)
PRINT AT 2,col;BRIGHT 1;INK INKon;"\..\..";
PRINT AT 3,col;BRIGHT 1;INK INKon;"\:.\.:";
PRINT AT 4,col;BRIGHT 1;INK INKon;"\ \ :";
END PROCEDURE
PROCEDURE ShowDigit (ndigit TYPE INTEGER, value TYPE INTEGER)
VAR col TYPE INTEGER
LET col = 12+3*(3-ndigit)
IF value = 0
ShowDigit0 (col)
ELSEIF value = 1
ShowDigit1 (col)
ELSEIF value = 2
ShowDigit2 (col)
ELSEIF value = 3
ShowDigit3 (col)
ELSEIF value = 4
ShowDigit4 (col)
ELSEIF value = 5
ShowDigit5 (col)
ELSEIF value = 6
ShowDigit6 (col)
ELSEIF value = 7
ShowDigit7 (col)
ELSEIF value = 8
ShowDigit8 (col)
ELSEIF value = 9
ShowDigit9 (col)
ENDIF
END PROCEDURE
PROCEDURE ClearScreen
FOR i=2 TO 20
PRINT AT i,7;OVER 1;BRIGHT 1;INK LEDoff;" ";
NEXT i
END PROCEDURE
PROCEDURE Game
VAR active TYPE INTEGER
VAR k$ TYPE STRING
VAR elapsed TYPE INTEGER
REPEAT
REM process1
'WaitClock
REPEAT
ScanKey
LET k$ = GetKey$
IF k$ = "1" THEN MoveLeft
IF k$ = "2" THEN MoveRight
IF k$ = "0" THEN MissileFire
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
LET active = MothershipCol
IF NOT active THEN MothershipStart
IF active THEN MothershipGo
LET active = BombLin
'IF Enemies > 3 THEN IF active+RND < ((score3+1.5)*10+score2)/50 THEN BombDrop
IF NOT active THEN BombDrop
IF active THEN BombGo
IF MissileLin THEN MissileGo
REM process2
'WaitClock
REPEAT
ScanKey
LET k$ = GetKey$
IF k$ = "1" THEN MoveLeft
IF k$ = "2" THEN MoveRight
IF k$ = "0" THEN MissileFire
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
LET active = MothershipCol
IF NOT active THEN MothershipStart
IF active THEN MothershipGo
LET active = BombLin
'IF Enemies > 3 THEN IF active+RND < ((score3+1.5)*10+score2)/50 THEN BombDrop
IF NOT active THEN BombDrop
IF active THEN BombGo
IF MissileLin THEN MissileGo
REM process3
Scroll
UNTIL GameOver
END PROCEDURE
PROCEDURE WaitForPlayer
PRINT AT 23,6;PAPER blue;INK white;" [s] [c]";
REPEAT
PAUSE 0
LET k$ = INKEY$
IF k$ = "c" THEN ChangeColors
UNTIL k$ = "s"
BEEP .4,5
RANDOMIZE
LET Clock0 = PEEK 23672
PRINT AT 23,6;PAPER blue;INK white;" [1][2] [0]";
END PROCEDURE
PROCEDURE InitGame
VAR l,c TYPE INTEGER
LET Period = 16+1
' score
LET score1 = 0
LET score2 = 0
LET score3 = 0
ShowScore
' clear screen
FOR l=1 TO 8
FOR c=1 TO 6
VIDEO(l,c) = 0
NEXT c
NEXT l
' Mothership
LET MothershipLin = 1
LET MothershipCol = 0
LET MothershipInc = -1
' defense shield
LET VIDEO(7,2) = 10: LET VIDEO(7,5) = 10
' Player
LET PlayerLin = 8
LET PlayerCol = 1
LET VIDEO(PlayerLin,PlayerCol) = 1
' new wave
NewWave
' extra
LET GameOver = FALSE
END PROCEDURE
PROCEDURE InitScreen
BORDER 1: PAPER 1: INK 7: CLS
PRINT AT 0,8;INK 7;"* SPACE INVADER *";
PAPER 0
FOR i=1 TO 21
PRINT AT i,6;INK 1;" ";
NEXT i
PRINT AT 1,6;INK 7;"\:'\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\''\':";
FOR i=2 TO 20
PRINT AT i,6;INK 7;"\: ";
PRINT AT i,25;INK 7;"\ :";
NEXT i
PRINT AT 21,6;INK 7;"\:.\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\..\.:";
REM PLOT 11*8,176-2*8: DRAW 10*8,0: DRAW 0,-4*8+4: DRAW -10*8,0: DRAW 0,4*8-4
PRINT AT 2,12;INK INKoff;"\..\.. \..\.. \..\..";
PRINT AT 3,12;INK INKoff;"\:.\.: \:.\.: \:.\.:";
PRINT AT 4,12;INK INKoff;"\:.\.: \:.\.: \:.\.:";
PRINT AT 6,7;BRIGHT 1;INK INKoff;"\A\B\C\A\B\C\A\B\C\A\B\C\A\B\C\A\B\C";
FOR i=1 TO 5
PRINT AT 6+i*2,7;BRIGHT 1;INK INKoff;"\D\E\F\D\E\F\D\E\F\D\E\F\D\E\F\D\E\F";
NEXT i
REM PRINT AT 18,7;INK INKoff;" \G\H\I \G\H\I";
REM PRINT AT 19,7;INK INKoff;" \E \E \E \E \E \E ";
PRINT AT 18,7;BRIGHT 1;INK INKoff;"\M\E\N\M\E\N\M\E\N\M\E\N\M\E\N\M\E\N";
PRINT AT 20,7;BRIGHT 1;INK INKoff;"\J\K\L\J\K\L\J\K\L\J\K\L\J\K\L\J\K\L";
REM PRINT AT 23,7;INK 7;"12 keys 90";
PRINT AT 23,6;PAPER blue;INK white;" [1][2] [0]";
END PROCEDURE
PROCEDURE DefineChars
VAR i,n TYPE INTEGER
VAR b$ TYPE STRING
RESTORE ' DataChars
READ b$
REPEAT
FOR i=0 TO 7
READ n
POKE USR b$+i,n
NEXT i
READ b$
UNTIL b$ = ""
END PROCEDURE
PROCEDURE DataChars
DATA "A"
DATA BIN 00000000
DATA BIN 00000011
DATA BIN 00000001
DATA BIN 00011111
DATA BIN 00111111
DATA BIN 01111111
DATA BIN 00111111
DATA BIN 00000111
DATA "B"
DATA BIN 00111100
DATA BIN 11111111
DATA BIN 01011010
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 00111100
DATA "C"
DATA BIN 00000000
DATA BIN 11000000
DATA BIN 10000000
DATA BIN 11111000
DATA BIN 11111100
DATA BIN 11111110
DATA BIN 11111100
DATA BIN 11100000
DATA "D"
DATA BIN 00000010
DATA BIN 00000010
DATA BIN 00000110
DATA BIN 00001111
DATA BIN 00001111
DATA BIN 00011100
DATA BIN 00010000
DATA BIN 00010000
DATA "E"
DATA BIN 00011000
DATA BIN 00111100
DATA BIN 01111110
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 01111110
DATA BIN 00111100
DATA BIN 00011000
DATA "F"
DATA BIN 01000000
DATA BIN 01000000
DATA BIN 01100000
DATA BIN 11110000
DATA BIN 11110000
DATA BIN 00110000
DATA BIN 00010000
DATA BIN 00001000
END PROCEDURE
PROCEDURE DataChars2
DATA "G"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000001
DATA BIN 00000111
DATA BIN 00011111
DATA BIN 01111111
DATA BIN 00000000
DATA BIN 00000000
DATA "H"
DATA BIN 00011000
DATA BIN 01111110
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 00000000
DATA BIN 00000000
DATA "I"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 10000000
DATA BIN 11100000
DATA BIN 11111000
DATA BIN 11111110
DATA BIN 00000000
DATA BIN 00000000
DATA "J"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00011111
DATA BIN 00111111
DATA BIN 01111111
DATA BIN 00111111
DATA BIN 00011110
DATA "K"
DATA BIN 00011000
DATA BIN 01111110
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 00000000
DATA "L"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11110000
DATA BIN 11111100
DATA BIN 11111110
DATA BIN 11111100
DATA BIN 01111000
DATA "M"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00001111
DATA BIN 00011111
DATA BIN 00111100
DATA BIN 01111000
DATA BIN 11110000
DATA "N"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11110000
DATA BIN 11111000
DATA BIN 00111100
DATA BIN 00011110
DATA BIN 00001111
DATA ""
END PROCEDURE
PROCEDURE TellStory
BORDER 1: PAPER 1: INK 7: CLS
PRINT AT 5,0;"In 1980 was launched"
PRINT TAB 0;"the first handheld videogame:"
PRINT TAB 5;""
PRINT TAB 5;INK 6;"SPACE INVADER"
PRINT TAB 5;" by Entex"
PRINT TAB 5;""
PRINT TAB 5;"Red leds screen"
PRINT TAB 5;"6 x 8 resolution"
PRINT TAB 5;"6 AA batteries"
PRINT TAB 5;""
PRINT TAB 0;"On youtube search:"
PRINT TAB 0;" Entex Space Invader"
PAUSE 15*50
END PROCEDURE
PROCEDURE MainRoutine
TellStory
DefineChars
InitADDR
InitScreen
WaitForPlayer
InitGame
REPEAT
Game
WaitForPlayer
ClearScreen
InitGame
UNTIL FALSE
END PROCEDURE
PROGRAM SpaceInvader
FOR n=0 TO 30: BEEP .01,n: NEXT n
PRINT AT 23,0;"Pascalated Boriel ZX BASIC demo";
PAUSE 3*50
MainRoutine
PRINT AT 21,10;INK 2;"The End"
END PROGRAM
|
|
|
Pascalated ZX BASIC Demo #22 - Eagle 1 |
Posted by: zarsoft - 07-02-2023, 12:33 PM - Forum: Gallery
- No Replies
|
 |
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
|
|
|
Pascalated ZX BASIC Demo #21 - Fxy Graph |
Posted by: zarsoft - 06-24-2023, 01:46 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
Try these:
2*(x*x+y*y<1.5)
(x*x+y*y<1.5)*(2-x*x-y*y)
Code: ' PROGRAM ViewFxy
' (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 ViewFxy
' 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 res TYPE INTEGER = 20 ' resolution
CONST zoom TYPE REAL = 10 ' resize
' VAR - Global variables
VAR nfunc TYPE INTEGER = 1 ' active function number
REM Fxy = VAL ("F"+STR$ nfunc)
VAR F$ TYPE STRING = "0.5*COS(ABS(x*y*12))"
VAR G$ TYPE STRING ' USER function (only X and Y accepted)
VAR X,Y TYPE REAL ' x,y of the PROCEDURE
VAR Z TYPE REAL ' z = f(x,y)
VAR Horizon(255) TYPE INTEGER ' horizon
VAR x1,y1, x2,y2 TYPE REAL ' view domain
VAR TheEnd TYPE BOOLEAN
PROCEDURE TRON (m TYPE STRING)
PRINT AT 23,0;m;
PAUSE 0
END PROCEDURE
FUNCTION VARaz (V$ TYPE STRING) TYPE REAL
VAR R TYPE REAL
IF V$ = "Z"
R = Z
ELSE IF V$ = "Y" OR V$ = "y"
R = Y
ELSE IF V$ = "X" OR V$ = "x"
R = X
ENDIF
RETURN R
END FUNCTION
FUNCTION VALx$ (S$ TYPE STRING) TYPE STRING
VAR R$ TYPE STRING
R$ = ""
FOR i = 0 TO LEN S$ -1
IF S$(i) >= "A"
LET R$ = R$ + STR$ VARaz( S$(i) )
ELSE
LET R$ = R$ + S$(i)
ENDIF
NEXT i
RETURN R$
END FUNCTION
PROCEDURE DrawLineYY (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
VAR swap TYPE BOOLEAN
VAR x,y TYPE INTEGER
VAR xi,yi TYPE REAL
VAR xs,ys TYPE INTEGER
VAR aux TYPE INTEGER
VAR dx TYPE REAL
LET swap = FALSE
IF sy0>sy THEN LET swap = TRUE: LET aux = sy0: LET sy0 = sy: LET sy = aux: LET aux = sx0: LET sx0 = sx: LET sx = aux
LET xi = sx0
LET yi = sy0
LET dx = (0.1+sx-sx0-0.1)/(0.1+sy-sy0-0.1)
FOR y = sy0 TO sy
' xi = xi
yi = y
xs = INT (xi+0.5)
ys = y
IF Horizon(xs) < ys THEN LET Horizon(xs) = ys
IF Horizon(xs) > ys THEN LET ys = Horizon(xs)
PLOT xs, ys
LET xi = xi+dx
' LET yi = yi+1
NEXT y
IF swap THEN LET aux = sy0: LET sy0 = sy: LET sy = aux: LET aux = sx0: LET sx0 = sx: LET sx = aux
END PROCEDURE
PROCEDURE DrawLineXX (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
VAR x,y TYPE INTEGER
VAR xi,yi TYPE REAL
VAR xs,ys TYPE INTEGER
VAR dy TYPE REAL
LET xi = sx0
LET yi = sy0
LET dy = (0.1+sy-sy0-0.1)/(sx-sx0)
FOR x = sx0 TO sx
xi = x
xs = x
ys = INT (yi+0.5)
IF Horizon(xs) < ys THEN LET Horizon(xs) = ys
IF Horizon(xs) > ys THEN LET ys = Horizon(xs)
PLOT xs,ys
LET yi = yi+dy
' LET xi = xi+1
NEXT x
END PROCEDURE
PROCEDURE DrawLine (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
IF sx-sx0 >= ABS(sy-sy0) THEN DrawLineXX(sx0,sy0,sx,sy)
IF sx-sx0 < ABS(sy-sy0) THEN DrawLineYY(sx0,sy0,sx,sy)
END PROCEDURE
FUNCTION F0 TYPE REAL
F$ = VALx$( G$ )
RETURN VAL( F$ )
END FUNCTION
FUNCTION F1 TYPE REAL
RETURN 9/(1+8*X*X+8*Y*Y)
END FUNCTION
FUNCTION F2 TYPE REAL
RETURN 9/(1+X*X*8+Y*Y*8)+0.25*COS(X*8+Y*8)
END FUNCTION
FUNCTION F3 TYPE REAL
RETURN -9/(1+8*X*X+8*Y*Y)
END FUNCTION
FUNCTION F4 TYPE REAL
RETURN 1*SIN(X*Y*6)/(X*Y*6+1.3E-5)
END FUNCTION
FUNCTION F5 TYPE REAL
RETURN 1.2*INT(3*(SIN(X*3)*SIN(X*3))*SIN(X*3)*(SIN(Y*3)*SIN(Y*3))*SIN(Y*3))
END FUNCTION
FUNCTION F6 TYPE REAL
RETURN SIN(X*3)*SIN(Y*3)
END FUNCTION
FUNCTION F7 TYPE REAL
RETURN INT(9/(1+8*X*X+8*Y*Y))
END FUNCTION
FUNCTION F8 TYPE REAL
RETURN 15*(X+Y)*EXP((-X*X*3-Y*Y*3))
END FUNCTION
FUNCTION F9 TYPE REAL
RETURN 7*COS(SQR(X*X*64+Y*Y*64))/(1+X*X*16+Y*Y*16)
END FUNCTION
FUNCTION Fxy TYPE REAL
VAR r TYPE REAL
IF nfunc = 0
r = F0
ELSEIF nfunc = 1
r = F1
ELSEIF nfunc = 2
r = F2
ELSEIF nfunc = 3
r = F3
ELSEIF nfunc = 4
r = F4
ELSEIF nfunc = 5
r = F5
ELSEIF nfunc = 6
r = F6
ELSEIF nfunc = 7
r = F7
ELSEIF nfunc = 8
r = F8
ELSEIF nfunc = 9
r = F9
ENDIF
RETURN r
END FUNCTION
PROCEDURE ShowGraph
VAR sx,sy TYPE INTEGER ' ortogonal screen coordinates
VAR sx0,sy0 TYPE REAL ' previous screen coordinates
VAR u,v TYPE INTEGER ' iterations 1 to res
VAR x0,y0 TYPE REAL ' previous x,y
VAR dx,dy TYPE REAL ' increment
VAR i TYPE INTEGER
BORDER 0 : PAPER 1 : INK 7 : CLS
PRINT "Function ";nfunc
IF nfunc = 0 THEN PRINT "F(x,y)= ";G$
REM DIM Horizon(255) : REM reset horizon
FOR i = 0 TO 255
Horizon(i) = 0
NEXT i
LET y0 = y1
LET dy = (y2-y1)/res
LET Y = y0
FOR v = 1 TO res
LET u = 0
LET x0 = x1
LET dx = (x2-x1)/res
LET X = x0
Z = Fxy ' LET z = F1(x,y)
LET sx0 = 52 + 10*u - INT(2.5*v)
LET sy0 = 0 + INT(2.5*v) + INT(2.5*u) + INT(zoom*Z)
LET Y = Y+dy
FOR u = 1 TO res
LET X = X+dx
Z = Fxy ' LET z = F(x,y)
LET sx = 52 + 10*u - INT(2.5*v)
LET sy = 0 + INT(2.5*v) + INT(2.5*u) + INT(zoom*Z)
' PLOT sx,sy ' OK
' PLOT sx0,sy0: DRAW sx-sx0,sy-sy0 ' OK
' DrawLine(sx0,sy0,sx,sy)
DrawLine( INT (0.5+sx0), INT (0.5+sy0), INT (0.5+sx), INT (0.5+sy) )
LET sx0 = sx
LET sy0 = sy
IF INKEY$ <> "" THEN u = res
NEXT u : REM for x
IF INKEY$ <> "" THEN v = res
NEXT v : REM for y
END PROCEDURE
PROCEDURE WaitKey
PRINT AT 0,0;"Press any key to continue"
PAUSE(0)
END PROCEDURE
PROCEDURE ShowMenu
CLS
PRINT "MENU"
PRINT
PRINT "0 - Input function"
PRINT "1 - 9/(1+8*x*x+8*y*y)"
PRINT "2 - 9/(1+x*x*8+y*y*8)+0.25*COS(x*8+y*8)"
PRINT "3 - -9/(1+8*x*x+8*y*y)"
PRINT "4 - 1*SIN(x*y*6)/(x*y*6+1.3E-5)"
PRINT "5 - 1.2*INT(3*(SIN(x*3)*SIN(x*3))*SIN(x*3)*(SIN(y*3)*SIN(y*3))*SIN(y*3))"
PRINT "6 - SIN(x*3)*SIN(y*3)"
PRINT "7 - INT(9/(1+8*x*x+8*y*y))"
PRINT "8 - 15*(x+y)*EXP((-x*x*3-y*y*3))"
PRINT "9 - 7*COS(SQR(x*x*64+y*y*64))/(1+x*x*16+y*y*16)"
PRINT "Q - Quit"
PRINT
PRINT "Your command: "
END PROCEDURE
PROCEDURE ReadOption
LET TheEnd = FALSE
REPEAT
REPEAT
PAUSE(50)
LET k$ = INKEY$
UNTIL k$ <> ""
UNTIL (k$ >= "0" AND k$ <= "9") OR (k$ = "q")
IF k$ = "q" THEN LET TheEnd = TRUE
IF k$ <> "q" THEN LET nfunc = VAL(k$) ' : LET Fxy = VAL ("F"+STR$ nfunc)
IF nfunc = 0 THEN PRINT ,,"Only X and Y accepted.","You cannot use functions.","F(x,y)= "; : G$ = INPUT(80)
END PROCEDURE
PROCEDURE DefineFirstGraph
LET nfunc = 1
' LET Fxy = VAL ("F"+STR$ nfunc)
LET x1 = -PI/2: LET y1 = -PI/2
LET x2 = PI/2: LET y2 = PI/2
END PROCEDURE
PROGRAM ViewFxy
PRINT AT 23,0;"Pascalated Boriel ZX BASIC demo";
PAUSE 1*50
DefineFirstGraph
REPEAT
ShowGraph
WaitKey
ShowMenu
ReadOption
UNTIL TheEnd
PRINT AT 21,10;INK 2;"The End"
END PROGRAM
|
|
|
VAL incomplete |
Posted by: zarsoft - 06-24-2023, 11:54 AM - Forum: Wishlist
- Replies (3)
|
 |
In ZX SPECTRUM:
LET x = 2
PRINT VAL "2*x"
Prints 4
But on the compiler gives 0
How about adding variables from "a" to "z" in VAL?
|
|
|
|