Forum

Welcome, Guest

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

Search Forums

(Advanced Search)

Forum Statistics

» Members: 287
» Latest member: _glPl
» Forum threads: 997
» Forum posts: 6,125

Full Statistics

Online Users

There are currently 77 online users.
» 0 Member(s) | 77 Guest(s)

Latest Threads

мешки для мусора
Forum: ZX Basic Compiler
Last Post: _egKl
Yesterday, 02:15 PM
» Replies: 0
» Views: 1

Error: STRING CONSTant
Forum: Bug Reports
Last Post: boriel
06-04-2023, 10:52 AM
» Replies: 1
» Views: 25

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
06-03-2023, 11:31 AM
» Replies: 0
» Views: 7

Compiles OK then crashed
Forum: Bug Reports
Last Post: Neo-Rio
05-30-2023, 11:11 AM
» Replies: 2
» Views: 57

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
05-21-2023, 01:07 PM
» Replies: 0
» Views: 41

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
05-15-2023, 02:21 PM
» Replies: 0
» Views: 66

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
05-06-2023, 07:56 PM
» Replies: 0
» Views: 60

No more loading messages ...
Forum: Help & Support
Last Post: zarsoft
05-06-2023, 10:00 AM
» Replies: 2
» Views: 116

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
04-29-2023, 04:33 PM
» Replies: 0
» Views: 69

Pascalated ZX BASIC Demo ...
Forum: Gallery
Last Post: zarsoft
04-23-2023, 05:37 PM
» Replies: 0
» Views: 66

Pascalated ZX BASIC Demo #12 - Dogfight David

Posted by: zarsoft - 04-15-2023, 03:01 PM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Code:
' PROGRAM Dogfight David

' (c) Starsoft 2022 Pascalated BASIC

' (c) Starsoft 2023 Pascalated Boriel ZX BASIC

' 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 Dogfight David

' CONSTant declarations

CONST DX TYPE INTEGER = 1 ' index for automaton for moveForward

CONST DY TYPE INTEGER = 2 ' index for automaton for moveForward

' VAR - Global variables

REM boolean GAMEOVER

VAR player1COL TYPE INTEGER

VAR player1LIN TYPE INTEGER

VAR player1COL0 TYPE INTEGER

VAR player1LIN0 TYPE INTEGER

VAR player2COL TYPE INTEGER

VAR player2LIN TYPE INTEGER

VAR player2COL0 TYPE INTEGER

VAR player2LIN0 TYPE INTEGER

VAR DirectionP1 TYPE INTEGER

VAR DirectionP2 TYPE INTEGER

VAR missile1COL TYPE INTEGER

VAR missile1LIN TYPE INTEGER

VAR missile1COL0 TYPE INTEGER

VAR missile1LIN0 TYPE INTEGER

VAR missile2COL TYPE INTEGER

VAR missile2LIN TYPE INTEGER

VAR missile2COL0 TYPE INTEGER

VAR missile2LIN0 TYPE INTEGER

VAR DirectionM1 TYPE INTEGER

VAR missile1Fuel TYPE INTEGER

VAR DirectionM2 TYPE INTEGER

VAR missile2Fuel TYPE INTEGER

VAR Sprite$(8) TYPE STRING ' automaton for plane image

VAR KeyMap(13,2,2) TYPE INTEGER ' automaton to use several keys

VAR DXY(8,2) TYPE INTEGER ' automaton for moveForward

VAR key TYPE INTEGER

VAR range TYPE INTEGER

VAR player1Points TYPE INTEGER

VAR player2Points TYPE INTEGER

VAR Clock,Clock0 TYPE INTEGER

VAR Period TYPE INTEGER = 8

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 Process1

LET player1LIN0 = player1LIN

LET player1COL0 = player1COL

LET DirectionP1 = DirectionP1 + KeyMap(key,1,1)

IF DirectionP1 > 8 THEN LET DirectionP1 = 1

IF DirectionP1 < 1 THEN LET DirectionP1 = 8

LET player1LIN = player1LIN + DXY(DirectionP1,DY)

IF player1LIN > 21 THEN LET player1LIN = 1

IF player1LIN < 1 THEN LET player1LIN = 21

LET player1COL = player1COL + DXY(DirectionP1,DX)

IF player1COL > 31 THEN LET player1COL = 1

IF player1COL < 1 THEN LET player1COL = 31

PRINT AT  player1LIN0 , player1COL0 ; " ";

PRINT AT  player1LIN , player1COL ;  ink 6; Sprite$(DirectionP1);

END PROCEDURE

PROCEDURE Process2

LET player2LIN0 = player2LIN

LET player2COL0 = player2COL

LET DirectionP2 = DirectionP2 + KeyMap(key,2,1)

IF DirectionP2 > 8 THEN LET DirectionP2 = 1

IF DirectionP2 < 1 THEN LET DirectionP2 = 8

LET player2LIN = player2LIN + DXY(DirectionP2,DY)

IF player2LIN > 21 THEN LET player2LIN = 0

IF player2LIN < 0 THEN LET player2LIN = 21

LET player2COL = player2COL + DXY(DirectionP2,DX)

IF player2COL > 31 THEN LET player2COL = 0

IF player2COL < 0 THEN LET player2COL = 31

PRINT AT  player2LIN0 , player2COL0 ; " ";

PRINT AT  player2LIN , player2COL ;  ink 5; Sprite$(DirectionP2);

END PROCEDURE

PROCEDURE Player1Shot

BORDER 2

LET player2Points = player2Points + 1

PRINT AT  23, 20; PAPER 1; ink 4; "Points: "; player2Points;

LET player1LIN0 = player1LIN

LET player1COL0 = player1COL

PRINT AT  player1LIN , player1COL ; "\F"

LET missile2Fuel = 0

PRINT AT  missile2LIN , missile2COL ;  ink 5; "\F"

LET player1LIN = player2LIN + 11

IF player1LIN > 21 THEN LET player1LIN = player1LIN - 21

LET player1COL = 0

LET DirectionP1 = 1

FOR i = 1 TO 20 : BEEP .005,5*RND : NEXT i

PRINT AT  player1LIN0 , player1COL0 ; " "

PRINT AT  player1LIN , player1COL ;  ink 6; Sprite$(DirectionP1)

PRINT AT  missile2LIN , missile2COL ; " "

END PROCEDURE

PROCEDURE Player2Shot

BORDER 2

LET player1Points = player1Points + 1

PRINT AT  23, 0; PAPER 1; ink 4; "Points: "; player1Points;

LET player2LIN0 = player2LIN

LET player2COL0 = player2COL

PRINT AT  player2LIN , player2COL ; "\F"

LET missile1Fuel = 0

PRINT AT  missile1LIN , missile1COL ;  ink 6; "\F"

LET player2LIN = player1LIN + 11

IF player2LIN > 21 THEN LET player2LIN = player2LIN - 21

LET player2COL = 31

LET DirectionP2 = 5

FOR i = 1 TO 20 : BEEP .005,5*RND : NEXT i

PRINT AT  player2LIN0 , player2COL0 ; " "

PRINT AT  player2LIN , player2COL ;  ink 5; Sprite$(DirectionP2)

PRINT AT  missile1LIN , missile1COL ; " "

END PROCEDURE

PROCEDURE ProcessMissile1

LET missile1LIN0 = missile1LIN

LET missile1COL0 = missile1COL

LET missile1LIN = missile1LIN + DXY(DirectionM1,DY)

IF missile1LIN > 21 THEN LET missile1LIN = 1

IF missile1LIN < 1 THEN LET missile1LIN = 21

LET missile1COL = missile1COL + DXY(DirectionM1,DX)

IF missile1COL > 31 THEN LET missile1COL = 1

IF missile1COL < 1 THEN LET missile1COL = 31

LET missile1Fuel = missile1Fuel - 1

PRINT AT  missile1LIN0 , missile1COL0 ; " "

IF ABS(missile1LIN - player2LIN) <= range AND ABS(missile1COL - player2COL) <= range THEN Player2Shot

IF missile1Fuel > 0 THEN PRINT AT  missile1LIN , missile1COL ;  ink 6; "\A"

END PROCEDURE

PROCEDURE ProcessMissile2

LET missile2LIN0 = missile2LIN

LET missile2COL0 = missile2COL

LET missile2LIN = missile2LIN + DXY(DirectionM2,DY)

IF missile2LIN > 21 THEN LET missile2LIN = 1

IF missile2LIN < 1 THEN LET missile2LIN = 21

LET missile2COL = missile2COL + DXY(DirectionM2,DX)

IF missile2COL > 31 THEN LET missile2COL = 1

IF missile2COL < 1 THEN LET missile2COL = 31

LET missile2Fuel = missile2Fuel - 1

PRINT AT  missile2LIN0 , missile2COL0 ; " "

IF ABS(missile2LIN - player1LIN) <= range AND ABS(missile2COL - player1COL) <= range THEN Player1Shot

IF missile2Fuel > 0 THEN PRINT AT  missile2LIN , missile2COL ;  ink 5; "\A"

END PROCEDURE

PROCEDURE Fire1

LET missile1Fuel = 15

LET DirectionM1 = DirectionP1

LET missile1COL = player1COL + DXY(DirectionP1,DX)

IF missile1COL > 31 THEN LET missile1COL = 1

IF missile1COL < 1 THEN LET missile1COL = 31

LET missile1LIN = player1LIN + DXY(DirectionP1,DY)

IF missile1LIN > 21 THEN LET missile1LIN = 1

IF missile1LIN < 1 THEN LET missile1LIN = 21

PRINT AT  missile1LIN , missile1COL ;  ink 6; "\A"

END PROCEDURE

PROCEDURE Fire2

LET missile2Fuel = 15

LET DirectionM2 = DirectionP2

LET missile2COL = player2COL + DXY(DirectionP2,DX)

IF missile2COL > 31 THEN LET missile2COL = 1

IF missile2COL < 1 THEN LET missile2COL = 31

LET missile2LIN = player2LIN + DXY(DirectionP2,DY)

IF missile2LIN > 21 THEN LET missile2LIN = 1

IF missile2LIN < 1 THEN LET missile2LIN = 21

PRINT AT  missile2LIN , missile2COL ;  ink 5; "\A"

END PROCEDURE

PROCEDURE WaitForPlayer

VAR B$ TYPE STRING

PRINT AT 13,3; ink 6; "  Difficulty: 1, 2 or 3"

REPEAT 

  PAUSE 0

  LET B$ = INKEY$

UNTIL B$ >= "1" AND B$ <= "3"

LET range = 3 - VAL B$

LET dif = VAL B$

IF dif = 1 THEN Period = 24

IF dif = 2 THEN Period = 16

IF dif = 3 THEN Period = 8

RANDOMIZE

LET Clock0 = PEEK 23672

CLS

END PROCEDURE

PROCEDURE InitGame

LET player1LIN = 5 : LET player1COL = 0 : LET DirectionP1 = 1

LET player2LIN = 16 : LET player2COL = 31 : LET DirectionP2 = 5

PRINT AT player1LIN, player1COL; ink 6; Sprite$(DirectionP1)

PRINT AT player2LIN, player2COL; ink 5; Sprite$(DirectionP2)

LET missile1Fuel = 0

LET missile2Fuel = 0

LET player1Points = 0

LET player2Points = 0

END PROCEDURE

PROCEDURE initScreen

BORDER 1 : PAPER 1 : ink 7 : CLS

PRINT AT  0,9; ink 4; "Dogfight David";

PRINT AT 21,0; ink 4; "    (c) 2022, 2023 STARSOFT";

PRINT AT 22,0; ink 4; "       Pascalated BASIC";

PRINT AT 23,0; ink 4; "  Compiled by Boriel ZX BASIC";

PRINT AT 10,3; "Player1: ASD  Player2: JKL"

PRINT AT 13,9; ink 6; "Please wait..."

END PROCEDURE

PROCEDURE DefineChars

VAR n TYPE INTEGER

'RESTORE Sprites

READ car$

REPEAT 

  FOR i=0 TO 7

    READ n

    POKE USR car$+i,n

  NEXT i

  READ car$

UNTIL car$ = ""

END PROCEDURE

PROCEDURE Sprites

DATA "A"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00001000

DATA BIN 00011100

DATA BIN 00111110

DATA BIN 00011100

DATA BIN 00001000

DATA BIN 00000000

DATA "B"

DATA BIN 00000010

DATA BIN 01000011

DATA BIN 01100110

DATA BIN 01111100

DATA BIN 00111000

DATA BIN 00011100

DATA BIN 00101110

DATA BIN 00000111

DATA "C"

DATA BIN 00111100

DATA BIN 00011000

DATA BIN 00011000

DATA BIN 00011000

DATA BIN 11111111

DATA BIN 01111110

DATA BIN 00011000

DATA BIN 00000000

DATA "D"

DATA BIN 01000000

DATA BIN 11000010

DATA BIN 01100110

DATA BIN 00111110

DATA BIN 00011100

DATA BIN 00111000

DATA BIN 01110100

DATA BIN 11100000

DATA "E"

DATA BIN 00010000

DATA BIN 00110000

DATA BIN 00110001

DATA BIN 01111111

DATA BIN 01111111

DATA BIN 00110001

DATA BIN 00110000

DATA BIN 00010000

DATA "F"

DATA BIN 00100010

DATA BIN 01010101

DATA BIN 10001000

DATA BIN 00000000

DATA BIN 01000100

DATA BIN 10101010

DATA BIN 00010001

DATA BIN 00000000

DATA "G"

DATA BIN 00001000

DATA BIN 00001100

DATA BIN 10001100

DATA BIN 11111110

DATA BIN 11111110

DATA BIN 10001100

DATA BIN 00001100

DATA BIN 00001000

DATA "H"

DATA BIN 00000000

DATA BIN 00001110

DATA BIN 01011100

DATA BIN 00111000

DATA BIN 01111000

DATA BIN 11101100

DATA BIN 11000111

DATA BIN 10000010

DATA "I"

DATA BIN 00000000

DATA BIN 00011000

DATA BIN 01111110

DATA BIN 11111111

DATA BIN 00011000

DATA BIN 00011000

DATA BIN 00011000

DATA BIN 00111100

DATA "J"

DATA BIN 11100000

DATA BIN 01110100

DATA BIN 00111000

DATA BIN 00011100

DATA BIN 00111110

DATA BIN 01100110

DATA BIN 11000010

DATA BIN 01000000

DATA ""

END PROCEDURE

PROCEDURE InitProg

DefineChars

REM automaton for plane image

'DIM Sprite$(8)

LET Sprite$(1) = "\G"

LET Sprite$(2) = "\J"

LET Sprite$(3) = "\I"

LET Sprite$(4) = "\H"

LET Sprite$(5) = "\E"

LET Sprite$(6) = "\B"

LET Sprite$(7) = "\C"

LET Sprite$(8) = "\D"

REM automaton for moveForward

'DIM DXY(8,2)

LET DXY(1,DX) = 1 : LET DXY(1,DY) = 0

LET DXY(2,DX) = 1 : LET DXY(2,DY) = -1

LET DXY(3,DX) = 0 : LET DXY(3,DY) = -1

LET DXY(4,DX) = -1 : LET DXY(4,DY) = -1

LET DXY(5,DX) = -1 : LET DXY(5,DY) = 0

LET DXY(6,DX) = -1 : LET DXY(6,DY) = 1

LET DXY(7,DX) = 0 : LET DXY(7,DY) = 1

LET DXY(8,DX) = 1 : LET DXY(8,DY) = 1

REM automaton for keys

'DIM KeyMap(32,2,2)

LET KeyMap(2,1,1) = 1

LET KeyMap(3,1,2) = TRUE

LET KeyMap(5,1,1) = -1

LET KeyMap(4,1,1) = -1 : LET KeyMap(4,1,2) = TRUE

LET KeyMap(7,1,1) = 1 : LET KeyMap(7,1,2) = TRUE

LET KeyMap(9,2,1) = 1

LET KeyMap(5,2,2) = TRUE

LET KeyMap(3,2,1) = -1

LET KeyMap(13,2,1) = -1 : LET KeyMap(4,2,2) = TRUE

LET KeyMap(7,2,1) = 1 : LET KeyMap(7,2,2) = TRUE

END PROCEDURE

PROCEDURE Game

InitProg

initScreen

InitGame

WaitForPlayer

PRINT AT 23,0; ink 4; "Points: "; player1Points;

PRINT AT 23,20; ink 4; "Points: "; player2Points;

REPEAT 

  WaitClock

  BORDER 1

  LET key = 192 - IN 65022

  Process1

  IF missile1Fuel = 0 THEN IF KeyMap(key,1,2) = 1 THEN BEEP .1,5: Fire1

  IF missile1Fuel THEN ProcessMissile1

  IF missile2Fuel THEN ProcessMissile2

  LET key = 192 - IN 49150

  Process2

  IF missile2Fuel = 0 THEN IF KeyMap(key,2,2) = 1 THEN BEEP .1,5: Fire2

  IF missile1Fuel THEN ProcessMissile1

  IF missile2Fuel THEN ProcessMissile2

UNTIL FALSE

END PROCEDURE

BEGIN

REM PRINT "Demo for Pascalated BASIC"

PAUSE 50

Game

END

Pascalated ZX BASIC Demo #11 - The Towers of Hanoi

Posted by: zarsoft - 04-09-2023, 01:01 PM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Code:
' PROGRAM The Towers of Hanoi

' (c) Zarsoft 2022 Pascalated BASIC

' (c) Zarsoft 2023 Pascalated Boriel ZX BASIC

' 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 The Towers of Hanoi

' CONSTant declarations

CONST black TYPE INTEGER = 0

CONST blue TYPE INTEGER = 1

CONST green TYPE INTEGER = 4

CONST white TYPE INTEGER = 7

CONST MinDisks TYPE INTEGER = 6

CONST PoleLine TYPE INTEGER = 16

' VAR - Global variables

VAR DiskShape(11) TYPE STRING ' :REM disk ARRAY (0..10) OF ARRAY (1..19) OF CHAR;

VAR Pole(3,11) TYPE INTEGER ' pole ARRAY (1..03) OF ARRAY (1..10) OF INTEGER;

VAR PoleLen(3) TYPE INTEGER :REM REM PoleLen :ARRAY (1..03) OF INTEGER;

VAR PoleCol(3) TYPE INTEGER :REM REM PoleCol :ARRAY (1..03) OF INTEGER;

VAR f,t TYPE INTEGER ' from, to

VAR MaxDisks TYPE INTEGER 

VAR movement TYPE INTEGER 

VAR LegalMove TYPE BOOLEAN

VAR abort TYPE BOOLEAN

VAR TheEnd TYPE BOOLEAN

PROCEDURE CheckEnd

LET TheEnd = TRUE

IF abort THEN LET TheEnd = FALSE

IF (MaxDisks < MinDisks) 

  LET TheEnd = FALSE

  PRINT AT PoleLine+2,0;

  PRINT INK 3;"    =-- NOT ENOUGH DISKS --="

  PRINT INK 2;"           Try again  "

ELSEIF (MaxDisks >= MinDisks) AND (movement > 2^MaxDisks-1)

  LET TheEnd = FALSE

  PRINT AT PoleLine+2,0;

  PRINT INK 3;"  =-- TOO MUCH MOVEMENTS --="

  PRINT INK 2;"         Try again  "

  PAUSE 10

ENDIF

PRINT AT 21,0;PAPER 1;"   Press any key to continue    "

PAUSE 10

PAUSE 10

PAUSE 0

END PROCEDURE 

PROCEDURE finalization

PRINT AT PoleLine+2,0;

PRINT INK 3;"  ===-- CONGRATULATIONS! --==="

PRINT INK 2;"                                "

: FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i

PAUSE 0

END PROCEDURE 

PROCEDURE MoveDisk (f TYPE INTEGER,t TYPE INTEGER) 

VAR column TYPE INTEGER

VAR l,col TYPE INTEGER

BEGIN

LET movement = movement+1

PRINT AT 2,0;"This move: ";movement

LET PoleLen(t) = PoleLen(t)+1

LET Pole(t,PoleLen(t)) = Pole(f,PoleLen(f))

LET Pole(f,PoleLen(f)) = 0

LET PoleLen(f) = PoleLen(f)-1

REM move up

LET col = PoleCol(f)

FOR l = PoleLine-PoleLen(f)-2 TO PoleLine-11 STEP -1

  PRINT AT l,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);

  PRINT AT l+1,col;INK blue;DiskShape$(0+1);

NEXT l

REM left/right

IF f < t 

  REM move right

  LET col = PoleCol(f)+2

  WHILE col < PoleCol(t) 

    PRINT AT PoleLine-11,col-2;INK green;"  ";DiskShape$(Pole(t,PoleLen(t))+1);

    LET col = col+2

  END WHILE

ELSE

  REM move left

  LET col = PoleCol(f)-2

  WHILE col > PoleCol(t) 

    PRINT AT PoleLine-11,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);"  ";

    LET col = col-2

  END WHILE

ENDIF

PRINT AT PoleLine-11,PoleCol(t);"         ";

PRINT AT PoleLine-11,0;"                                ";

PRINT AT PoleLine-10,PoleCol(t);INK green;DiskShape$(Pole(t,PoleLen(t))+1);

REM move down

LET col = PoleCol(t)

FOR l = PoleLine-9 TO PoleLine-PoleLen(t)

  PRINT AT l,col;INK green;DiskShape$(Pole(t,PoleLen(t))+1);

  PRINT AT l-1,col;INK blue;DiskShape$(0+1);

NEXT l

END PROCEDURE 

PROCEDURE CheckLegalMove

REM (VAR f,t:INTEGER);

LET LegalMove = TRUE

IF (f = t) OR (PoleLen(f) = 0) 

  LET LegalMove = FALSE

ELSEIF PoleLen(t) <> 0

  IF NOT( Pole(f,PoleLen(f)) < Pole(t,PoleLen(t)) ) THEN LET LegalMove = FALSE

ENDIF

END PROCEDURE 

PROCEDURE InputMove

REM (VAR f,t:INTEGER);

VAR k$ TYPE STRING

BEGIN

PRINT AT PoleLine+2,1;"MOVE FROM... ";

REPEAT 

  PAUSE 0

  LET k$ = INKEY$

UNTIL k$ >= "0" AND k$ <= "9"

BEEP .1,5

LET f = VAL (k$)

LET k$ = "X"

IF f=0 THEN LET abort = TRUE: LET k$="0"

PRINT AT PoleLine+2,1;"MOVE FROM ";f;" TO... ";

WHILE NOT(abort) AND NOT (k$ >= "0" AND k$ <= "9") 

  PAUSE 0

  LET k$ = INKEY$

END WHILE

BEEP .1,5

LET t = VAL k$

IF t=0 THEN LET abort = TRUE

IF abort THEN LET f = 1: LET t = 1

PRINT AT PoleLine+2,1;"                            ";

END PROCEDURE 

PROCEDURE PrintPole (PoleNumber TYPE INTEGER)

VAR col TYPE INTEGER

VAR i TYPE INTEGER

BEGIN

LET col = PoleCol(PoleNumber)

FOR i = 1 TO 10

  IF Pole(PoleNumber,i) = 0 THEN INK blue

  IF Pole(PoleNumber,i) <> 0 THEN INK green

  PRINT AT PoleLine-i,col;DiskShape$(Pole(PoleNumber,i)+1);

NEXT i

INK white

END PROCEDURE 

PROCEDURE Initialization

VAR i TYPE INTEGER

BEGIN

LET TheEnd = FALSE

LET abort = FALSE

LET PoleCol(1) = 1

LET PoleCol(2) = 1+9+2

LET PoleCol(3) = 1+9+2+9+2

LET DiskShape$( 1) =  "    |    "

LET DiskShape$( 2) =  "    1    "

LET DiskShape$( 3) =  "   \A2\C   "

LET DiskShape$( 4) =  "   \B3\B   "

LET DiskShape$( 5) =  "  \A\B4\B\C  "

LET DiskShape$( 6) =  "  \B\B5\B\B  "

LET DiskShape$( 7) =  " \A\B\B6\B\B\C "

LET DiskShape$( 8) =  " \B\B\B7\B\B\B "

LET DiskShape$( 9) =  "\A\B\B\B8\B\B\B\C"

LET DiskShape$(10) =  "\B\B\B\B9\B\B\B\B"

FOR i = 1 TO 10

  LET Pole(1,i) = 0

  LET Pole(2,i) = 0

  LET Pole(3,i) = 0

NEXT i

FOR i = 1 TO MaxDisks

  LET Pole(1,i) = MaxDisks-(i-1)

NEXT i

LET PoleLen(1) = MaxDisks

LET PoleLen(2) = 0

LET PoleLen(3) = 0

INK blue

PRINT AT PoleLine,PoleCol(1);

PRINT "\::\::\::\::1\::\::\::\::";

PRINT "  ";

PRINT "\::\::\::\::2\::\::\::\::";

PRINT "  ";

PRINT "\::\::\::\::3\::\::\::\::";

INK white

LET movement = 0

PRINT AT 0,7;INK green;"THE TOWERS OF HANOI"

PRINT AT 2,19;"Minimum: ";2^MaxDisks-1

PAPER blue: INK green

PRINT AT 21,0;"1,2,3 - Select pole    0 - ABORT"

PAPER black

END PROCEDURE 

PROCEDURE AskMaxDisks

VAR  k$ TYPE CHAR

BEGIN

INK green

PRINT AT PoleLine+3,0;"NUMBER OF DISKS = [1..9] ";

REPEAT 

  PAUSE 0

  LET k$ = INKEY$

UNTIL k$ >= "1" AND k$ <= "9"

BEEP .1,5

LET MaxDisks = VAL (k$)

IF MaxDisks=0 THEN LET MaxDisks = 10

PRINT AT PoleLine+2,1;

END PROCEDURE 

PROCEDURE Introduction

REM VAR s :BOOLEAN

BEGIN

BORDER black: PAPER black:  INK green: CLS

PRINT "     THE TOWERS OF HANOI"

PRINT

INK white

PRINT "In the great temple of Brahma","in Benares of India, there is ","a plate with 3 diamond needles","under the dome that marks the","center of the world."

PRINT

PRINT "At the creation, God placed 64","disks of pure gold in the order of their sizes, from largest to smallest."

PRINT

PRINT "This is the Tower of Brahma."

PRINT

PRINT "Day and night unceasingly the","monks of the temple move the","disks from one diamond needle","to another."

PRINT

PRINT AT 21,0;PAPER 1;"Press any key to read the rules"

PAUSE 0

INK 6

CLS

PRINT INK 3;"RULES:"

PRINT

PRINT " 1 - Only one disk can be moved at a time."

PRINT

PRINT " 2 - A disk can only be placed","on a larger disk (or no smaller disk below)."

PRINT

PRINT " 3 - All disks must go to the","third needle."

PRINT

INK 7

PRINT "When all disks are moved from","the first needle to the third","needle forming the Tower of","Brahma, then will come the end","of the universe and all will","turn to dust."

PRINT

END PROCEDURE 

PROCEDURE DefineChars

VAR n TYPE INTEGER

'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 00000000

DATA BIN 00000000

DATA BIN 00001111

DATA BIN 00001111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "B"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11111111

DATA BIN 11111111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "C"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11110000

DATA BIN 11110000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA ""

END PROCEDURE 

PROCEDURE MainRoutine

DefineChars

REPEAT 

  Introduction

  AskMaxDisks

  CLS

  Initialization

  PrintPole(1)

  PrintPole(2)

  PrintPole(3)

  REPEAT 

    InputMove: REM (f,t)

    CheckLegalMove: REM (f,t)

    IF LegalMove THEN MoveDisk(f,t)

  UNTIL (PoleLen(3) = MaxDisks) OR abort

  CheckEnd

UNTIL TheEnd

finalization

END PROCEDURE 

BEGIN

CLS

PRINT "Demo for Pascalated BASIC"

MainRoutine

END

ZX Spectrum with Pascal interpreter instead of BASIC interpreter

Posted by: zarsoft - 04-01-2023, 08:48 AM - Forum: Gallery - No Replies

	Now we can program the ZX Spectrum directly in Pascal language instead of BASIC language. See the listing below: To run an example online, click HERE. After the program finishes, you can examine the Pascal listing with LIST and run the program again with RUN.

Microsoft Windows On The ZX Spectrum

Posted by: zarsoft - 04-01-2023, 08:25 AM - Forum: Gallery - Replies (2)

	Microsoft Windows is out for the ZX Spectrum. It uses maximum memory (128K) and several diskettes (FDD) but we managed to get a demo version for the 48K. This demo version has some problems due to low memory but you can see what the 128K version looks like. The box with 5 diskettes and manuals costs USD $34,99. To run online - the demo version - click HERE.

Pascalated ZX BASIC Demo #10 - Worm

Posted by: zarsoft - 03-25-2023, 08:12 PM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Code:
' PROGRAM Worm

' (c) Starsoft 2020 Java console

' (c) Starsoft 2022 Pascalated BASIC

' (c) Starsoft 2023 Pascalated Boriel ZX BASIC

' Written by David Magalhaes

' 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 Worm

' CONSTant declarations

CONST Period TYPE INTEGER = 8

' VAR - Global variables

VAR Clock,Clock0 TYPE INTEGER

VAR GAMEOVER TYPE BOOLEAN

VAR LIN, COL TYPE INTEGER

VAR Direction, DirectionOld TYPE INTEGER

VAR LengthMax TYPE INTEGER

VAR LengthCurrent TYPE INTEGER

VAR TailL, TailC TYPE INTEGER

VAR Cook TYPE INTEGER

VAR DirectionTail TYPE INTEGER

VAR Trail$(8,8) TYPE STRING ' automaton for PrintTrail

VAR TailDirection$(8,128) TYPE STRING ' automaton for getDirectionTail

VAR TailColor(150) TYPE INTEGER ' automaton for tail colors

VAR KeyMap$(128) TYPE STRING ' automaton to use several keys

VAR DX, DY TYPE INTEGER ' index for automaton for moveForward

VAR DXY(8,2) TYPE INTEGER ' automaton for moveForward

VAR Record TYPE INTEGER ' max length achieved

'--- KEYBOARD BUFFER ---

VAR BUFFER$ TYPE STRING = ""

PROCEDURE ScanKey

VAR key$ TYPE STRING = INKEY$

VAR l TYPE INTEGER

IF key$ <> "" THEN 

  IF BUFFER$ = "" THEN 

    LET BUFFER$ = BUFFER$+INKEY$

  ELSE

    LET l = LEN BUFFER$

    IF BUFFER$(l-1) <> key$ THEN LET BUFFER$ = BUFFER$+INKEY$

  ENDIF

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$

  BUFFER$ = ""

ELSE

  LET result$ = BUFFER$(0)

  BUFFER$ = BUFFER$( 1 TO )

ENDIF

RETURN result$

END FUNCTION

'------------------------

PROCEDURE TheEnd

PRINT AT 21,10; ink 2; " GAME OVER "

BEEP .5,15: BEEP .5,10: BEEP .5,5: BEEP .5,0

PAUSE 50

IF LengthCurrent > Record 

  PRINT AT 0,8; ink 2; " NEW HIGH SCORE "

  BEEP .5,10: BEEP .5,0: BEEP .5,20

  LET Record = LengthCurrent

ENDIF

REPEAT 

UNTIL  INKEY$ = ""

FOR i=1 TO 5

  PAUSE 50

NEXT i

END PROCEDURE

PROCEDURE GiveFood

VAR cMin TYPE INTEGER = 3

VAR cMax TYPE INTEGER = 30

VAR lMin TYPE INTEGER = 3

VAR lMax TYPE INTEGER = 20

VAR l,c TYPE INTEGER

VAR food TYPE INTEGER

IF Cook < 10 

  LET Cook = Cook+1

ELSE

  LET Cook = 0

  LET l = lMin + INT(RND * ((lMax - lMin) + 1))

  LET c = cMin + INT(RND * ((cMax - cMin) + 1))

  LET food = 1 + INT(RND * ((9 - 1) + 1))

  IF SCREEN$(l,c) = " " THEN PRINT AT l, c; food

ENDIF

END PROCEDURE

PROCEDURE PrintTrailOldVersion

IF DirectionOld = 5 AND Direction = 5 

  LET r$ = "-"

ELSEIF DirectionOld = 5 AND Direction = 6

  LET r$ = "/"

ELSEIF DirectionOld = 5 AND Direction = 7

  LET r$ = "\\"

ELSEIF DirectionOld = 6 AND Direction = 6

  LET r$ = "|"

ELSEIF DirectionOld = 6 AND Direction = 5

  LET r$ = "/"

ELSEIF DirectionOld = 6 AND Direction = 8

  LET r$ = "\\"

ELSEIF DirectionOld = 7 AND Direction = 7

  LET r$ = "|"

ELSEIF DirectionOld = 7 AND Direction = 5

  LET r$ = "\\"

ELSEIF DirectionOld = 7 AND Direction = 8

  LET r$ = "/"

ELSEIF DirectionOld = 8 AND Direction = 8

  LET r$ = "-"

ELSEIF DirectionOld = 8 AND Direction = 6

  LET r$ = "\\"

ELSEIF DirectionOld = 8 AND Direction = 7

  LET r$ = "/"

ELSE

  LET r$ = "."

ENDIF

PRINT AT LIN, COL; r$

END PROCEDURE

PROCEDURE PrintTrail

PRINT AT LIN, COL; ink TailColor(CODE Trail$(DirectionOld,Direction)); Trail$(DirectionOld,Direction)

END PROCEDURE

PROCEDURE getDirectionTailOld1Version

LET c$ = SCREEN$(TailL,TailC)

IF DirectionTail = 5 AND c$ = "-" 

  LET DirectionTail = 5

ELSEIF DirectionTail = 5 AND c$ = "/"

  LET DirectionTail = 6

ELSEIF DirectionTail = 5 AND c$ = "\\"

  LET DirectionTail = 7

ELSEIF DirectionTail = 6 AND c$ = "|"

  LET DirectionTail = 6

ELSEIF DirectionTail = 6 AND c$ = "/"

  LET DirectionTail = 5

ELSEIF DirectionTail = 6 AND c$ = "\\"

  LET DirectionTail = 8

ELSEIF DirectionTail = 7 AND c$ = "|"

  LET DirectionTail = 7

ELSEIF DirectionTail = 7 AND c$ = "/"

  LET DirectionTail = 8

ELSEIF DirectionTail = 7 AND c$ = "\\"

  LET DirectionTail = 5

ELSEIF DirectionTail = 8 AND c$ = "-"

  LET DirectionTail = 8

ELSEIF DirectionTail = 8 AND c$ = "/"

  LET DirectionTail = 7

ELSEIF DirectionTail = 8 AND c$ = "\\"

  LET DirectionTail = 6

ENDIF

END PROCEDURE

PROCEDURE getDirectionTailOld2Version

LET c$ = SCREEN$(TailL,TailC)

LET DirectionTail = VAL TailDirection$(DirectionTail,CODE c$)

END PROCEDURE

PROCEDURE getDirectionTail 

VAR c TYPE INTEGER

LET c = ATTR(TailL,TailC) - 56

LET DirectionTail = VAL TailDirection$(DirectionTail, c)

END PROCEDURE

PROCEDURE MoveForwardOldVersion

PrintTrail

REM move worm

IF Direction = 8 

  LET COL = COL+1

ELSEIF Direction = 5

  LET COL = COL-1

ELSEIF Direction = 7

  LET LIN = LIN-1

ELSE

  LET LIN = LIN+1

ENDIF

LET c$ = SCREEN$(LIN,COL)

IF c$ = " " 

  REM nothing ahead

  PRINT AT  LIN, COL; "o"  : REM head of worm

  PRINT AT 22, 8; LengthCurrent

ELSEIF c$ >= "1" AND c$ <= "9"

  REM steped on food

  LET LengthMax = LengthMax + VAL c$

  PRINT AT  LIN, COL; "o";

  BEEP .005,INT (30*RND)

ELSE

  PRINT AT  LIN, COL; "X"

  LET GAMEOVER = TRUE

ENDIF

LET DirectionOld = Direction

REM process Tail

IF LengthCurrent < LengthMax BEGIN w

  LET LengthCurrent = LengthCurrent+1

ELSE

  getDirectionTail

  PRINT AT TailL, TailC; " "

  IF DirectionTail = 6 

    LET TailL = TailL+1

  ELSEIF DirectionTail = 5

    LET TailC = TailC-1

  ELSEIF DirectionTail = 8

    LET TailC = TailC+1

  ELSEIF DirectionTail = 7

    LET TailL = TailL-1

  ENDIF

ENDIF

END PROCEDURE

PROCEDURE MoveForward

PrintTrail

REM move worm

LET LIN = LIN + DXY(Direction,DY)

LET COL = COL + DXY(Direction,DX)

LET c$ = SCREEN$(LIN,COL)

IF c$ = " " 

  REM nothing ahead

  PRINT AT  LIN, COL; "o"  : REM head of worm

  PRINT AT 22, 8; LengthCurrent

ELSEIF c$ >= "1" AND c$ <= "9"

  REM steped on food

  LET LengthMax = LengthMax + VAL c$

  PRINT AT  LIN, COL; "o";

  BEEP .01,INT (30*RND)

ELSE

  PRINT AT  LIN, COL; "X"

  LET GAMEOVER = TRUE

ENDIF

LET DirectionOld = Direction

REM process Tail

IF LengthCurrent < LengthMax 

  LET LengthCurrent = LengthCurrent+1

ELSE

  getDirectionTail

  PRINT AT TailL, TailC; " "

  LET TailL = TailL + DXY(DirectionTail,DY)

  LET TailC = TailC + DXY(DirectionTail,DX)

ENDIF

END PROCEDURE

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 WaitForPlayer

PRINT AT 18,5;"Keys: 5678 QAOP arrows"

PRINT AT 19,3;"  PRESS ANY KEY TO START  "

FOR i = -20 TO 20: BEEP .005,ABS i: NEXT i

REPEAT 

  PAUSE 0

  LET BUFFER$ = KeyMap$(CODE (INKEY$+" ") )

UNTIL BUFFER$ >= "5" AND BUFFER$ <= "8"

BEEP .1,20

LET Direction = VAL BUFFER$

LET DirectionOld = Direction

LET DirectionTail = Direction

LET Clock0 = PEEK 23672

PRINT AT 18,5;"                      "

PRINT AT 19,5;"                      "

END PROCEDURE

PROCEDURE InitGame

BORDER 7: PAPER 7: INK 0: CLS

REM horizontal frame

FOR i=0 TO 31

  REM  top frame

  PRINT AT  0, i; "#";

  REM  bottom frame

  PRINT AT  21, i; "#";

NEXT i

REM vertical frame

FOR i=0 TO 21

  REM  left frame

  PRINT AT  i, 0; "#";

  REM  right frame

  PRINT AT  i, 31; "#";

NEXT i

REM Titulos

PRINT AT  0, 13; ink 1; "WORM";

PRINT AT 22, 0; "Length: ";

PRINT AT 23, 0; "Record: "; Record

PRINT AT 22, 23; "(c) 2023";AT  23, 23; "STARSOFT";

LET LIN = 10 : LET COL = 10

LET TailL = 10 : LET TailC = 10

LET Direction = 0 : LET DirectionOld = 0 : REM must init with first move

LET Cook= 0

LET BUFFER$ = ""

PRINT AT LIN, COL; "o" : REM head of worm

LET LengthMax = 2 : LET LengthCurrent = 1

REM PRINT AT  1, 10; LengthCurrent

PRINT AT 22, 8; LengthCurrent

LET GAMEOVER = FALSE

END PROCEDURE

PROCEDURE Game

InitGame

WaitForPlayer

REPEAT 

  WaitClock

  LET key$ = GetKey

  LET key$ = KeyMap$(CODE (key$+" ") )

  IF key$ >= "5" AND key$ <= "8" THEN  IF Direction + VAL key$ <> 13 THEN LET Direction = VAL key$

  MoveForward

  GiveFood

UNTIL GAMEOVER

TheEnd

END PROCEDURE

PROCEDURE DefineChars

VAR n TYPE INTEGER

REM RESTORE DataChars

READ BUFFER$

REPEAT 

  FOR i=0 TO 7

    READ n

    POKE USR BUFFER$+i,n

  NEXT i

  READ BUFFER$

UNTIL BUFFER$ = ""

END PROCEDURE

PROCEDURE DataChars

DATA "A"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11111111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "B"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA "C"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00011111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "D"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 11110000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "E"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11110000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA "F"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00011111

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA ""

END PROCEDURE

PROCEDURE InitProg

REM CLS: PRINT AT 18,5;"Please wait..."

LET Record = 0

DefineChars

REM automaton for PrintTrail

REM DIM Trail$(8,8)

LET Trail$(5,5) = "\A" : REM "-"

LET Trail$(5,6) = "\F" : REM "/"

LET Trail$(5,7) = "\C" : REM "\\"

LET Trail$(6,6) = "\B" : REM "|"

LET Trail$(6,5) = "\D" : REM "/"

LET Trail$(6,8) = "\C" : REM "\\"

LET Trail$(7,7) = "\B" : REM "|"

LET Trail$(7,5) = "\E" : REM "\\"

LET Trail$(7,8) = "\F" : REM "/"

LET Trail$(8,8) = "\A" : REM "-"

LET Trail$(8,6) = "\E" : REM "\\"

LET Trail$(8,7) = "\D" : REM "/"

REM automaton for getDirectionTail

REM DIM TailDirection$(8,4)

LET TailDirection$(5,1) = "5"

LET TailDirection$(5,3) = "7"

LET TailDirection$(5,4) = "6"

LET TailDirection$(6,2) = "6"

LET TailDirection$(6,3) = "8"

LET TailDirection$(6,4) = "5"

LET TailDirection$(7,2) = "7"

LET TailDirection$(7,3) = "5"

LET TailDirection$(7,4) = "8"

LET TailDirection$(8,1) = "8"

LET TailDirection$(8,3) = "6"

LET TailDirection$(8,4) = "7"

REM automaton for moveForward

REM DIM DXY(8,2)

LET DX = 1 : LET DY = 2

LET DXY(5,DX) = -1 : LET DXY(5,DY) = 0

LET DXY(6,DX) = 0 : LET DXY(6,DY) = 1

LET DXY(7,DX) = 0 : LET DXY(7,DY) = -1

LET DXY(8,DX) = 1 : LET DXY(8,DY) = 0

REM automaton for tail colors

REM DIM TailColor(150)

LET TailColor(CODE("\A")) = 1

LET TailColor(CODE("\B")) = 2

LET TailColor(CODE("\C")) = 3

LET TailColor(CODE("\D")) = 4

LET TailColor(CODE("\E")) = 3

LET TailColor(CODE("\F")) = 4

REM Table for accept 5678 qaop and arrows

REM DIM KeyMap$(128)

REM left

LET KeyMap$(CODE "5") = "5"

LET KeyMap$(CODE "o") = "5"

LET KeyMap$(CODE "O") = "5"

LET KeyMap$(8) = "5" : REM arrow

REM right

LET KeyMap$(CODE "8") = "8"

LET KeyMap$(CODE "p") = "8"

LET KeyMap$(CODE "P") = "8"

LET KeyMap$(9) = "8" : REM arrow

REM up

LET KeyMap$(CODE "7") = "7"

LET KeyMap$(CODE "q") = "7"

LET KeyMap$(CODE "Q") = "7"

LET KeyMap$(11) = "7" : REM arrow

REM down

LET KeyMap$(CODE "6") = "6"

LET KeyMap$(CODE "a") = "6"

LET KeyMap$(CODE "A") = "6"

LET KeyMap$(10) = "6" : REM arrow

END PROCEDURE

PROCEDURE MainRoutine

InitProg

REPEAT 

  Game

UNTIL FALSE

END PROCEDURE

BEGIN

POKE 23739,244: REM restore messages

PRINT PAPER 5;INK 0;AT 1,13;"   Do you think   ";AT 2,13;"there will be life";AT 3,13;" in other apples?";

FOR j = 1 TO 3

  FOR i = 0 TO 20: BEEP .005,i: NEXT i

NEXT j

PAUSE 2*50

MainRoutine

END

Pascalated ZX BASIC Demo #9 - 15

Posted by: zarsoft - 03-19-2023, 11:01 AM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Code:
' PROGRAM 15

' (c) 2023 by Zarsoft

' Written by Ze Oliveira

' Demo for the Pascalated language

' 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 INPUTable(12)

#include <screen.bas> ' SCREEN$ function

#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---

'#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

#define PROGRAM   REM

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

' CONSTant declarations

' VAR - Global variables

REM VAR B$(4,4) TYPE CHAR '--- the board

VAR Board$(4) TYPE STRING '--- the board

VAR Table(127,2) TYPE INTEGER '--- table for key conversion onto movements Lin,Col

VAR Success TYPE BOOLEAN '--- board completed

VAR PositionL TYPE INTEGER '--- current position of the blank space

VAR PositionC TYPE INTEGER '--- current position of the blank space

VAR NewPositionL TYPE INTEGER 

VAR NewPositionC TYPE INTEGER 

VAR PosL TYPE INTEGER '--- position of the board

VAR PosC TYPE INTEGER '--- position of the board

PROCEDURE GameOver

PRINT AT 21,10;FLASH 1;"SUCCESS!";

PAUSE 50

PRINT AT 22,3;"GAME OVER - insert coin";

PAUSE 0

END PROCEDURE

PROCEDURE ShowPosition

PRINT AT PosL+0+3*PositionL,PosC+3*PositionC;"\:'\''\':";

PRINT AT PosL+1+3*PositionL,PosC+3*PositionC;"\: ";Board$(PositionL)(PositionC);"\ :";

PRINT AT PosL+2+3*PositionL,PosC+3*PositionC;"\:.\..\.:";

END PROCEDURE

PROCEDURE HidePosition

PRINT AT PosL+0+3*PositionL,PosC+3*PositionC;"\::\::\::";

PRINT AT PosL+1+3*PositionL,PosC+3*PositionC;"\::\::\::";

PRINT AT PosL+2+3*PositionL,PosC+3*PositionC;"\::\::\::";

END PROCEDURE

PROCEDURE MovePiece

LET Board$(PositionL)(PositionC) = Board$(NewPositionL)(NewPositionC)

LET Board$(NewPositionL)(NewPositionC) = " "

ShowPosition

LET PositionL = NewPositionL

LET PositionC = NewPositionC

HidePosition

IF Board$(4) = "MNO " THEN IF Board$(3) = "IJKL" THEN IF Board$(2) = "EFGH" THEN IF Board$(1) = "ABCD" THEN LET Success = TRUE

END PROCEDURE

FUNCTION ReadKey TYPE INTEGER

REPEAT 

  PAUSE 0

  LET k$ = INKEY$

UNTIL k$ <> ""

REM PRINT AT 21,0;CODE k$;" ";

BEEP .01,10

RETURN CODE k$

END FUNCTION

PROCEDURE ShowBoard

VAR bakL TYPE INTEGER

VAR bakC TYPE INTEGER

BORDER 1 : PAPER 1 : INK 7 : CLS

PRINT AT 0,9;"--- ";INK 3;15;INK 7;" ---"

PRINT AT 2,5;INK 5;"Sort the characters"

PRINT AT 3,3;INK 5;"(in alphabetical order)"

PRINT AT 20,3;INK 5;"Keys: 5678 QAOP arrows";

PRINT AT 22,3;INK 0;"   Pascalated BASIC       ";

PRINT AT 23,3;INK 0;"Compiled by ZX BASIC (Boriel)";

PAPER 0 : INK 7

REM backup vars because there is no local vars

LET bakL = PositionL

LET bakC = PositionC

REM show all positions

FOR L=1 TO 4

  FOR C=1 TO 4

    LET PositionL = L

    LET PositionC = C

    ShowPosition

  NEXT C

NEXT L

REM restore vars

LET PositionL = bakL

LET PositionC = bakC

HidePosition

REM shadow on the bottom

FOR C=1 TO 12

  PRINT AT PosL+3+12,PosC+2+C;" ";

NEXT C

PRINT AT PosL+3+12,PosC+2+1;INK 1;"\. ";

PRINT AT PosL+3+12,PosC+3+12;" ";

REM shadow on the right

FOR L=1 TO 12

  PRINT AT PosL+2+L,PosC+3+12;" ";

NEXT L

PRINT AT PosL+2+1,PosC+3+12;INK 1;"\':";

END PROCEDURE

PROCEDURE InitVariables

LET PosL = 3

LET PosC = 5

REM Board

REM DIM Board$(4,4)

REM board for debug

LET Board$(1) = ".ABCD"

LET Board$(2) = ".EFGH"

LET Board$(3) = ".IJKL"

LET Board$(4) = ".MN O"

LET PositionL = 4

LET PositionC = 3

REM inverse order

LET Board$(1) = ". ONM"

LET Board$(2) = ".LKJI"

LET Board$(3) = ".HGFE"

LET Board$(4) = ".DCBA"

LET PositionL = 1

LET PositionC = 1

LET Success = FALSE

REM Table for keyboard conversion to make movements

REM DIM Table(128,2)

REM left

LET Table(CODE "5",2) = 1

LET Table(CODE "o",2) = 1

LET Table(CODE "O",2) = 1

LET Table(8,2) = 1 : REM arrow

REM right

LET Table(CODE "8",2) = -1

LET Table(CODE "p",2) = -1

LET Table(CODE "P",2) = -1

LET Table(9,2) = -1 : REM arrow

REM up

LET Table(CODE "7",1) = 1

LET Table(CODE "q",1) = 1

LET Table(CODE "Q",1) = 1

LET Table(11,1) = 1 : REM arrow

REM down

LET Table(CODE "6",1) = -1

LET Table(CODE "a",1) = -1

LET Table(CODE "A",1) = -1

LET Table(10,1) = -1 : REM arrow

END PROCEDURE

PROCEDURE MainRoutine

InitVariables

ShowBoard

REPEAT 

  keycode = ReadKey

  IF Table(keycode,1)+Table(keycode,2) <> 0 

    LET NewPositionL = PositionL+Table(keycode,1)

    LET NewPositionC = PositionC+Table(keycode,2)

    IF NewPositionL >=1 AND NewPositionL <= 4 AND NewPositionC >= 1 AND NewPositionC <= 4 

      MovePiece

    ENDIF

  ENDIF

UNTIL Success

GameOver

END PROCEDURE

PROGRAM Game15

MainRoutine

' last 2 lines are going to be deleted

PRINT AT 23,0;

END PROGRAM

ARRAY of STRING (solved)

Posted by: zarsoft - 03-18-2023, 05:06 PM - Forum: Help & Support - Replies (2)

	I'm a bit confused. How do I do this? DIM Board$(3,4) LET Board$(1) = "ABCD" LET Board$(2) = "EFGH" LET Board$(3) = "IJKL"

Error: Invalid file name (solved)

Posted by: zarsoft - 03-17-2023, 08:22 PM - Forum: Bug Reports - Replies (2)

This code gives an error:
"F Invalid file name"

Code:
SUB SaveImage 

DIM size AS LONG

size = 192*32+32*24

SAVE "image" CODE 16384,size

END SUB

SUB Run

SaveImage

END SUB

Run

Change RAMs on ZX Spectrum 128k

Posted by: Week of the agents - 03-15-2023, 07:42 PM - Forum: Help & Support - Replies (2)

	Hi, Boriel I'm taking part in the BASIC 2023 jam and plan to swap 128k RAM banks with graph data and use the shadow screen Is there a way I can do it? ZX Basic use RAM0 for a stack and a data heap, can I somehow move them to a lower address WITH BASIC OPERATORS ONLY?

Pascalated ZX BASIC Demo #8 - Pong

Posted by: zarsoft - 03-11-2023, 10:12 PM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Listing:

Code:
' PROGRAM Pong

' (c) 2023 by Zarsoft

' Written by Ze Oliveira

' Demo for the Pascalated language

' 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 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

#define PROGRAM   REM

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

' CONSTant declarations

CONST Period TYPE INTEGER = 8

' VAR - Global variables

VAR ScorePlayer TYPE INTEGER = 0

VAR ScoreComputer TYPE INTEGER = 0

VAR PlayerFirst TYPE BOOLEAN = TRUE

VAR Handicap TYPE INTEGER = 14

VAR Goal TYPE BOOLEAN

VAR ComputerPos TYPE INTEGER = 15

VAR PlayerPos TYPE INTEGER = 15

VAR BallLin TYPE INTEGER = 19-1

VAR BallCol TYPE INTEGER = PlayerPos

VAR DL TYPE INTEGER = -1

VAR DC TYPE INTEGER = -1 + INT (RND*3)

VAR Clock,Clock0 TYPE INTEGER

PROCEDURE GetReady

LET Goal = FALSE

IF BallLin = 2 THEN LET ScorePlayer = ScorePlayer+1

IF BallLin = 19 THEN LET ScoreComputer = ScoreComputer+1

PRINT AT 0,7;ScoreComputer

PRINT AT 21,7;ScorePlayer

IF BallLin = 2 

  LET PlayerFirst = TRUE

ELSEIF BallLin = 19

  LET PlayerFirst = FALSE

ENDIF

IF PlayerFirst 

  LET BallLin = 19-1

  LET BallCol = PlayerPos

  LET DL = -1

  LET DC = -1 + INT (RND*3)

ELSE

  LET BallLin = 2+1

  LET BallCol = ComputerPos

  LET DL = 1

  LET DC = -1 + INT (RND*3)

ENDIF

PRINT AT 19,PlayerPos-2;INK 4;" \''\''\'' ";

PRINT AT 2,ComputerPos-2;INK 3;" \..\..\.. ";

PRINT AT BallLin,BallCol;"\A"

IF ScorePlayer-ScoreComputer >= 2 THEN IF Handicap < 15 THEN LET Handicap = 15

IF ScorePlayer-ScoreComputer >= 3 THEN IF Handicap < 16 THEN  LET Handicap = 16

IF ScorePlayer-ScoreComputer >= 4 THEN IF Handicap < 17 THEN  LET Handicap = 17

IF ScorePlayer-ScoreComputer >= 5 THEN IF Handicap < 18 THEN  LET Handicap = 18

IF ScorePlayer-ScoreComputer >= 6 THEN IF Handicap < 19 THEN  LET Handicap = 19

IF ScorePlayer-ScoreComputer >= 7 THEN IF Handicap < 20 THEN  LET Handicap = 20

END PROCEDURE

PROCEDURE DrawField

BORDER 0: PAPER 0: INK 7: CLS

LET Goal = FALSE

FOR N=1 TO 30: PRINT AT 1,N;"\..";AT 20,N;"\''";: NEXT N

FOR N=2 TO 19: PRINT AT N,0;"\ :";AT N,31;"\: ";: NEXT N

PRINT AT 1,0;"\ .";

PRINT AT 1,31;"\. ";

PRINT AT 20,0;"\ '";

PRINT AT 20,31;"\' ";

PRINT AT 0,25;INK 6;"PONG"

PRINT AT 0,0;"Score: ";0;

PRINT AT 21,0;"Score: ";0;

PRINT AT 19,PlayerPos-2;INK 4;" \''\''\'' ";

PRINT AT 21,11;INK 1;"Pascalated BASIC demo"

END PROCEDURE

FUNCTION GetKey$ TYPE CHAR

VAR result$ TYPE CHAR = ""

VAR key$ TYPE CHAR

VAR elapsed TYPE INTEGER

REPEAT 

  key$ = INKEY$

  IF key$ = "5" OR key$ = "8" THEN LET result$ = key$

  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

RETURN result$

END FUNCTION

PROCEDURE WaitForUser

REPEAT 

  PAUSE 1

  LET k$ = INKEY$

UNTIL k$ = ""

PAUSE 0

BEEP .05,20

LET k$ = INKEY$

REM this give advantage; canceled

REM IF k$ = "5" THEN LET DC = -1

REM IF k$ = "8" THEN LET DC = 1

END PROCEDURE

'----------------- game -------------------

PROCEDURE ProcessPlayer

  LET k$ = GetKey$

  IF k$="5" THEN IF PlayerPos>3 THEN LET PlayerPos = PlayerPos-1

  IF k$="8" THEN IF PlayerPos<28 THEN LET PlayerPos = PlayerPos+1

  PRINT AT 19,PlayerPos-2;INK 4;" \''\''\'' ";

END PROCEDURE

PROCEDURE ProcessComputer

  IF BallLin < Handicap THEN LET ComputerPos = ComputerPos + SGN(BallCol-ComputerPos)

  IF ComputerPos < 3 THEN LET ComputerPos = 3

  IF ComputerPos > 28 THEN LET ComputerPos = 28

  PRINT AT 2,ComputerPos-2;INK 3;" \..\..\.. ";

END PROCEDURE

PROCEDURE ProcessBall

  PRINT AT BallLin,BallCol;INK 6;" "

  LET BallCol = BallCol + DC

  LET BallLin = BallLin + DL

  PRINT AT BallLin,BallCol;INK 6;"\A"

  IF BallCol = 1 OR BallCol = 30 THEN LET DC = -DC: BEEP .05,10

END PROCEDURE

PROCEDURE TestGameStatus

  IF BallLin = 2 OR BallLin = 19 THEN LET Goal = TRUE: BEEP .1,0

  IF BallLin = 3 THEN IF ABS(BallCol-ComputerPos)<=1 THEN LET DL = -DL: LET DC = SGN(RND*10-5): BEEP .05,20

  IF BallLin = 18 THEN IF ABS(BallCol-PlayerPos)<=1 THEN LET DL = -DL: BEEP .05,20

END PROCEDURE

'----------------- end game -------------------

PROCEDURE InitVariables

POKE 23609,50

LET Goal = FALSE

LET ComputerPos = 15

LET PlayerPos = 15

LET BallLin = 19-1

LET BallCol = PlayerPos

LET DL = -1

LET DC = -1 + INT (RND*3)

END PROCEDURE

PROCEDURE InitGraphics

REM \A

POKE USR "A"+0,BIN 00111100

POKE USR "A"+1,BIN 01111110

POKE USR "A"+2,BIN 11111111

POKE USR "A"+3,BIN 11111111

POKE USR "A"+4,BIN 11111111

POKE USR "A"+5,BIN 11111111

POKE USR "A"+6,BIN 01111110

POKE USR "A"+7,BIN 00111100

END PROCEDURE

PROCEDURE Game

LET Clock0 = PEEK 23672

REPEAT 

  ProcessPlayer

  ProcessComputer

  ProcessBall

  TestGameStatus

UNTIL Goal

END PROCEDURE

PROCEDURE MainRoutine

InitGraphics

InitVariables

DrawField

REPEAT 

  GetReady

  IF PlayerFirst THEN WaitForUser

  Game

UNTIL FALSE

END PROCEDURE

PROGRAM Pong

MainRoutine

' last 2 lines are going to be deleted

PRINT AT 23,0;

END PROGRAM

Pages (92): « Previous 1 2 3 4 5 … 92 Next »

Login
Username:
Password:	Lost Password?
	Remember me