Forum

Welcome, Guest

You have to register before you can post on our site.

Search Forums

(Advanced Search)

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.

Microdrive or +3 Disk support when saving & loading

Posted by: jonesypeter - 08-10-2023, 05:40 PM - Forum: Help & Support - Replies (2)

	Hi, I'm creating an application with lots of arrays and wondered if the save and load commands support the microdrive syntax, or saving to +3 Disk? Many thanks Peter

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?

Pages (93): 1 2 3 4 5 … 93 Next »

Login
Username:
Password:	Lost Password?
	Remember me