Welcome, Guest |
You have to register before you can post on our site.
|
Forum Statistics |
» Members: 288
» Latest member: _erSa
» Forum threads: 997
» Forum posts: 6,125
Full Statistics
|
Online Users |
There are currently 73 online users. » 0 Member(s) | 73 Guest(s)
|
Latest Threads |
мешки для мусора
Forum: ZX Basic Compiler
Last Post: _egKl
Yesterday, 02:15 PM
» Replies: 0
» Views: 2
|
Error: STRING CONSTant
Forum: Bug Reports
Last Post: boriel
06-04-2023, 10:52 AM
» Replies: 1
» Views: 26
|
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
|
|
|
CLEAR |
Posted by: zarsoft - 03-04-2023, 03:46 PM - Forum: Wishlist
- Replies (4)
|
 |
How do I clean an ARRAY?
I would like to use the function CLEAR.
Code: VAR A(3) TYPE INTEGER
PROCEDURE CLEAR (v)
FOR i = ADDRESS(v) TO ADDRESS(v)+SIZE(v)-1
POKE i,0
NEXT i
END PROCEDURE
PROCEDURE Clean
CLEAR A
END PROCEDURE
PROCEDURE Test
LET A(1) = 1
PRINT A(1)
Clean
PRINT A(1)
END PROCEDURE
|
|
|
Pascalated ZX BASIC Demo #7 - 4 In A Line |
Posted by: zarsoft - 03-04-2023, 01:35 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
I modified the loader to RUN again more easily.
Code: 10 REM loader
30 RANDOMIZE USR 40000
40 STOP
90 :
100 REM Loaded compiled code
110 CLEAR 39999
120 LOAD "" CODE
130 RUN
Listing:
Code: ' PROGRAM 4 In A Line
' (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 BoardLin TYPE INTEGER = 15
CONST BoardCol TYPE INTEGER = 9
' VAR - Global variables
VAR GameOver TYPE BOOLEAN = FALSE
VAR TheEnd TYPE BOOLEAN = FALSE
VAR B(6,7) TYPE INTEGER ' board
VAR H(7) TYPE INTEGER ' high of each column
VAR NPlayer TYPE INTEGER ' current player 1,2
VAR PlayerMove TYPE INTEGER ' last move
VAR NMove TYPE INTEGER ' count moves
VAR l,c TYPE INTEGER
VAR l2,c2 TYPE INTEGER
PROCEDURE SayGoodbye
PRINT AT BoardLin+3,BoardCol;" Goodbye! "
END PROCEDURE
PROCEDURE AskAnotherGame
PRINT AT BoardLin+3,BoardCol-1;PAPER 0;INK 6;" Another game? "
LET TheEnd = FALSE
REPEAT
PAUSE 0
LET k$ = INKEY$
UNTIL k$ = "y" OR k$ = "Y" OR k$ = "n" OR k$ = "N"
BEEP .2,2 : BEEP .2,4
IF k$ = "n" OR k$ = "N" THEN LET TheEnd = TRUE
PRINT AT BoardLin+3,BoardCol-1;"\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E"
END PROCEDURE
PROCEDURE ShowWinner
VAR dl,dc TYPE INTEGER
LET GameOver = TRUE
LET dl = SGN (l2-l)
LET dc = SGN (c2-c)
FOR i = 0 TO 3
PRINT AT BoardLin-(l+i*dl)*2+1,BoardCol+(c+i*dc-1)*2;FLASH 1;OVER 1;PAPER 8;INK 8;" ";
PRINT AT BoardLin-(l+i*dl)*2+2,BoardCol+(c+i*dc-1)*2;FLASH 1;OVER 1;PAPER 8;INK 8;" ";
NEXT i
END PROCEDURE
PROCEDURE CheckGameOver
LET GameOver = FALSE
IF NMove = 6*7 THEN
LET GameOver = TRUE
ELSE
REM check horizontal
FOR l = 1 TO 6
FOR c = 1 TO 4
IF B(l,c) > 0 THEN IF B(l,c) = B(l,c+1) THEN IF B(l,c) = B(l,c+2) THEN IF B(l,c) = B(l,c+3) THEN LET l2 = l : LET c2 = c+3 : ShowWinner
NEXT c
NEXT l
REM check vertical
FOR c = 1 TO 7
FOR l = 1 TO 3
IF B(l,c) > 0 THEN IF B(l,c) = B(l+1,c) THEN IF B(l,c) = B(l+2,c) THEN IF B(l,c) = B(l+3,c) THEN LET l2 = l+3 : LET c2 = c : ShowWinner
NEXT l
NEXT c
REM check diagonal 45o
FOR l = 1 TO 3
FOR c = 1 TO 4
IF B(l,c) > 0 THEN IF B(l,c) = B(l+1,c+1) THEN IF B(l,c) = B(l+2,c+2) THEN IF B(l,c) = B(l+3,c+3) THEN LET l2 = l+3 : LET c2 = c+3 : ShowWinner
NEXT c
NEXT l
REM check diagonal -135o
FOR l = 1 TO 3
FOR c = 7 TO 4 STEP -1
IF B(l,c) > 0 THEN IF B(l,c) = B(l+1,c-1) THEN IF B(l,c) = B(l+2,c-2) THEN IF B(l,c) = B(l+3,c-3) THEN LET l2 = l+3 : LET c2 = c-3 : ShowWinner
NEXT c
NEXT l
ENDIF
END PROCEDURE
PROCEDURE PlaceMove
LET H(PlayerMove) = H(PlayerMove)+1
LET B(H(PlayerMove),PlayerMove) = NPlayer
PRINT AT BoardLin-H(PlayerMove)*2+1,BoardCol+(PlayerMove-1)*2;PAPER 8;INK 2*NPlayer;"\A\B";
PRINT AT BoardLin-H(PlayerMove)*2+2,BoardCol+(PlayerMove-1)*2;PAPER 8;INK 2*NPlayer;"\C\D";
END PROCEDURE
PROCEDURE ReadMove
PRINT AT BoardLin+3,BoardCol-1;PAPER 0;INK 6;" Ready player ";INK 2*NPlayer;"\::";PAPER 0;INK 6;" "
LET PlayerMove = 0
REPEAT
PAUSE 0
LET k$ = INKEY$
IF k$ >= "1" AND k$ <= "7" THEN IF H(VAL k$)<6 THEN LET PlayerMove = VAL k$
UNTIL PlayerMove <> 0
BEEP .2,2 : BEEP .2,4
PRINT AT BoardLin+3,BoardCol-1;"\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E"
LET NMove = NMove+1
END PROCEDURE
PROCEDURE ChangePlayer
LET NPlayer = 3-NPlayer
END PROCEDURE
PROCEDURE DrawBoard
BORDER 0: PAPER 0: INK 7: CLS
REM Below horizon
FOR l=21 TO 0 STEP -1
PRINT AT l,0;PAPER 0;INK 7;"\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E\E";
NEXT l
REM Above horizon
PRINT AT 0,0;PAPER 7;" ";
FOR l=0 TO BoardLin
PRINT PAPER 7;TAB 31;" ";
NEXT l
REM Board
FOR l=1 TO 6
REM top line
PRINT AT BoardLin-l*2+2,BoardCol;
FOR c=1 TO 7
PRINT PAPER 1;INK 7;"\C\D";
NEXT c
REM bottom line
PRINT AT BoardLin-l*2+1,BoardCol;
FOR c=1 TO 7
PRINT PAPER 1;INK 7;"\A\B";
NEXT c
NEXT l
FOR c=1 TO 7
PRINT AT BoardLin+1,BoardCol+(c-1)*2;PAPER 0;INK 7;c;" ";
NEXT c
PRINT AT 1,BoardCol;PAPER 3;INK 0;" 4 IN A LINE "
END PROCEDURE
PROCEDURE InitGame
REM clear B(6,7) TYPE INTEGER: REM board
FOR l=1 TO 6
FOR c=1 TO 7
B(l,c) = 0
NEXT c
NEXT l
REM H(7) TYPE INTEGER : REM high of each column
FOR c=1 TO 7
H(c) = 0
NEXT c
LET NPlayer = 1 : REM Current player
LET NMove = 0
END PROCEDURE
PROCEDURE InitGraphics
REM \A\B \E\E
REM \C\D \E\E
REM \A
POKE USR "A"+0,BIN 00000000
POKE USR "A"+1,BIN 00000111
POKE USR "A"+2,BIN 00011111
POKE USR "A"+3,BIN 00111111
POKE USR "A"+4,BIN 00111111
POKE USR "A"+5,BIN 01111111
POKE USR "A"+6,BIN 01111111
POKE USR "A"+7,BIN 01111111
REM \B
POKE USR "B"+0,BIN 00000000
POKE USR "B"+1,BIN 11100000
POKE USR "B"+2,BIN 11111000
POKE USR "B"+3,BIN 11111100
POKE USR "B"+4,BIN 11111100
POKE USR "B"+5,BIN 11111110
POKE USR "B"+6,BIN 11111110
POKE USR "B"+7,BIN 11111110
REM \C
POKE USR "C"+0,BIN 01111111
POKE USR "C"+1,BIN 01111111
POKE USR "C"+2,BIN 01111111
POKE USR "C"+3,BIN 00111111
POKE USR "C"+4,BIN 00111111
POKE USR "C"+5,BIN 00011111
POKE USR "C"+6,BIN 00000111
POKE USR "C"+7,BIN 00000000
REM \D
POKE USR "D"+0,BIN 11111110
POKE USR "D"+1,BIN 11111110
POKE USR "D"+2,BIN 11111110
POKE USR "D"+3,BIN 11111100
POKE USR "D"+4,BIN 11111100
POKE USR "D"+5,BIN 11111000
POKE USR "D"+6,BIN 11100000
POKE USR "D"+7,BIN 00000000
REM \E
POKE USR "E"+0,BIN 01010101
POKE USR "E"+1,BIN 10101010
POKE USR "E"+2,BIN 01010101
POKE USR "E"+3,BIN 10101010
POKE USR "E"+4,BIN 01010101
POKE USR "E"+5,BIN 10101010
POKE USR "E"+6,BIN 01010101
POKE USR "E"+7,BIN 10101010
END PROCEDURE
PROCEDURE Game
InitGame
DrawBoard
REPEAT
ChangePlayer
ReadMove
PlaceMove
CheckGameOver
UNTIL GameOver
FOR q=1 TO 5 STEP .4: BEEP .04,q: NEXT q
END PROCEDURE
PROCEDURE MainRoutine
InitGraphics
REPEAT
Game
AskAnotherGame
UNTIL TheEnd
SayGoodbye
END PROCEDURE
PROGRAM STRON
MainRoutine
' last 2 lines are going to be deleted
PRINT AT 23,0;
END PROGRAM
|
|
|
Pascalated ZX BASIC Demo #6 - STRON |
Posted by: zarsoft - 02-28-2023, 01:01 PM - Forum: Gallery
- Replies (1)
|
 |
To run online, click here: RUN ONLINE
Code: ' PROGRAM STRON
' (c) 1983 by Roger Allen
' (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 = 16
CONST Dlin TYPE INTEGER = 1
CONST Dcol TYPE INTEGER = 2
' VAR - Global variables
VAR GameOver TYPE BOOLEAN = FALSE
VAR BattleOver TYPE BOOLEAN = FALSE
VAR LIN, COL TYPE INTEGER ' coordinates of user
VAR Direction, DirectionOld TYPE INTEGER ' direction of user
VAR HighScore TYPE INTEGER
VAR Score TYPE INTEGER
VAR Zone TYPE INTEGER ' level number
VAR Tail$(8,8) TYPE STRING ' automaton for PrintTrail
VAR KeyMap$(128) TYPE STRING ' automaton to use several keys
VAR Dlc(8,2) TYPE INTEGER ' automaton for moveForward
VAR BikeSprite$(8) TYPE STRING ' automaton for bike
VAR EnemyLin$,EnemyCol$ TYPE STRING ' lin col of enemies
VAR Pointer TYPE INTEGER ' pointer to current enemy
VAR Clock,Clock0 TYPE INTEGER
VAR Lives TYPE INTEGER
'------------------------
FUNCTION UDG (c$ TYPE STRING) TYPE INTEGER
VAR result TYPE INTEGER
VAR svar TYPE INTEGER
VAR addr TYPE INTEGER
LET svar = 23675
LET addr = PEEK (svar) + 256*PEEK (svar+1)
IF c$ >= "\A" THEN LET c$ = CHR$(CODE(c$)+(CODE("A")-CODE("\A")))
IF c$ >= "a" THEN LET c$ = CHR$(CODE(c$)+(CODE("A")-CODE("a")))
LET result = addr+8*(CODE(c$)-CODE("A"))
RETURN result
END FUNCTION
'--- 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
'------------------------
CONST TRACE TYPE BOOLEAN = 1
PROCEDURE TRON (m$ TYPE STRING)
IF TRACE THEN
PRINT AT 1,10;INK 4;m$;TAB 31;
REPEAT
UNTIL INKEY$ = ""
REPEAT
UNTIL INKEY$ = "c"
ENDIF
END PROCEDURE
FUNCTION DeleteItem (ix TYPE INTEGER, s$ TYPE STRING) TYPE STRING
VAR result$ TYPE STRING
IF LEN s$ <= 1
result$ = ""
ELSEIF LEN s$ = 2
result$ = s$(1-ix)
ELSEIF ix = 0
LET result$ = s$(1 TO )
ELSEIF ix = LEN(s$) - 1
LET result$ = s$( TO ix-1)
ELSE
LET result$ = s$( TO ix-1) + s$(ix+1 TO )
ENDIF
RETURN result$
END FUNCTION
PROCEDURE MoveEnemies
VAR l,c TYPE INTEGER
VAR l0,c0 TYPE INTEGER
VAR elapsed TYPE INTEGER
VAR qt TYPE INTEGER = 4+Zone
REPEAT
ScanKey
LET l0 = CODE EnemyLin$(Pointer)
LET c0 = CODE EnemyCol$(Pointer)
LET l = l0+SGN(LIN-l0)
LET c = c0+SGN(COL-c0)
IF ATTR(l,c) = 0
PRINT AT l,c;INK 3;"\G";
PRINT AT l0,c0;" ";
LET EnemyLin$(Pointer) = CHR$ l
LET EnemyCol$(Pointer) = CHR$ c
ELSEIF ATTR(l,c) = 5
BORDER 2
PRINT AT l0,c0;" ";
PRINT AT l,c;" ";
EnemyLin$ = DeleteItem(Pointer,EnemyLin$)
EnemyCol$ = DeleteItem(Pointer,EnemyCol$)
LET Score = Score+10
PRINT AT 23,6;PAPER 0;INK 6;Score
ELSEIF ATTR(l,c) = 7
BORDER 2
PRINT AT l,c;INK 3;"\G";
PRINT AT l0,c0;" ";
PRINT AT LIN,COL;INK 6;"X"
LET Lives = Lives - 1
IF Lives = 0
LET GameOver = TRUE
ELSE
LET BattleOver = TRUE
ENDIF
ENDIF
LET qt = qt - 1
LET Pointer = Pointer-1
LET Clock = PEEK 23672
LET elapsed = Clock-Clock0: IF elapsed<0 THEN LET elapsed = elapsed+256
UNTIL qt = 0 OR elapsed >= Period OR Pointer < 0 OR GameOver
IF Pointer < 0 THEN LET Pointer = LEN EnemyLin$ - 1
IF LEN EnemyLin$ = 0 THEN LET Zone = Zone+1: LET BattleOver = TRUE
BORDER 0
END PROCEDURE
PROCEDURE PrintTrail
PRINT AT LIN,COL;INK 5; Tail$(DirectionOld,Direction);
END PROCEDURE
PROCEDURE MoveForward
VAR color TYPE INTEGER
PrintTrail
REM move bike
LET LIN = LIN + Dlc(Direction,Dlin)
LET COL = COL + Dlc(Direction,Dcol)
LET color = 1: IF LIN<22 THEN LET color = ATTR(LIN,COL)
IF color = 0
REM nothing ahead
PRINT AT LIN, COL;INK 7;BikeSprite$(Direction); : REM head of bike
ELSE
BORDER 2
IF LIN<22 THEN PRINT AT LIN,COL;INK 6;"X"
IF LIN=22 THEN PRINT AT 22,COL;PAPER 0;INK 6;"X"
LET Lives = Lives - 1
IF Lives = 0
LET GameOver = TRUE
ELSE
LET BattleOver = TRUE
ENDIF
ENDIF
LET DirectionOld = Direction
END PROCEDURE
PROCEDURE ShowEnemies
VAR N TYPE INTEGER
VAR l,c TYPE INTEGER
LET N=2^(Zone+0)
FOR i=1 TO N
LET l = 10-INT(10*RND*RND)
LET c = 30-INT(25*RND*RND)
IF ATTR(l,c) = 0 THEN PRINT AT l,c;INK 3;"\G";: LET EnemyLin$ = EnemyLin$ + CHR$(l): LET EnemyCol$ = EnemyCol$ + CHR$(c)
LET l = 11+INT(11*RND*RND)
LET c = 30-INT(25*RND*RND)
IF ATTR(l,c) = 0 THEN PRINT AT l,c;INK 3;"\G";: LET EnemyLin$ = EnemyLin$ + CHR$(l): LET EnemyCol$ = EnemyCol$ + CHR$(c)
NEXT i
LET Pointer = LEN EnemyLin$ - 1
END PROCEDURE
PROCEDURE InitBattle
BORDER 0: PAPER 0: INK 0: CLS
INK 1
REM top frame
PRINT AT 0,0;"\F\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\E";
REM vertical frame
FOR i=1 TO 21
REM left frame
PRINT AT i,0;"\B";
REM right frame
PRINT AT i,31;"\B";
NEXT i
REM bottom frame
PRINT AT 22,0;PAPER 0;INK 1;"\C\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\A\D";
REM Init Vars
REM Print titles
PRINT AT 0, 13; INK 4; "STRON";
PRINT AT 23,0;INK 6;"Score:";
PRINT AT 23,6;INK 6;Score;
PRINT AT 23,12;INK 6;"Max:";HighScore;
PRINT AT 23,24;INK 6;"Zone:";Zone;
PRINT AT 0,28;INK 2;"\J\J\J\J"(1 TO Lives);
LET LIN = 10 : LET COL = 2
PRINT AT LIN,COL;INK 7;"\H": REM head of bike
LET Direction = 0 : LET DirectionOld = 0 : REM must init with first move
LET EnemyLin$ = ""
LET EnemyCol$ = ""
LET BattleOver = FALSE
INK 0
ShowEnemies
LET Clock0 = PEEK 23672
LET Clock = PEEK 23672
END PROCEDURE
PROCEDURE InitGame
REM Init Vars
LET Zone = 1
LET Score = 0
LET Lives = 3
LET GameOver = FALSE
END PROCEDURE
PROCEDURE InitProg
LET HighScore = 0
REM automaton for PrintTrail
REM DIM Tail$(8,8)
LET Tail$(5,5) = "\A" : REM "-"
LET Tail$(5,6) = "\F" : REM "/"
LET Tail$(5,7) = "\C" : REM "\\"
LET Tail$(6,6) = "\B" : REM "|"
LET Tail$(6,5) = "\D" : REM "/"
LET Tail$(6,8) = "\C" : REM "\\"
LET Tail$(7,7) = "\B" : REM "|"
LET Tail$(7,5) = "\E" : REM "\\"
LET Tail$(7,8) = "\F" : REM "/"
LET Tail$(8,8) = "\A" : REM "-"
LET Tail$(8,6) = "\E" : REM "\\"
LET Tail$(8,7) = "\D" : REM "/"
REM automaton for moveForward
REM DIM Dlc(8,2)
LET Dlc(5,Dlin) = 0 : LET Dlc(5,Dcol) = -1
LET Dlc(6,Dlin) = 1 : LET Dlc(6,Dcol) = 0
LET Dlc(7,Dlin) = -1 : LET Dlc(7,Dcol) = 0
LET Dlc(8,Dlin) = 0 : LET Dlc(8,Dcol) = 1
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$(CODE "a") = "5"
LET KeyMap$(CODE "A") = "5"
LET KeyMap$(8) = "5" : REM left arrow
REM right
LET KeyMap$(CODE "8") = "8"
LET KeyMap$(CODE "p") = "8"
LET KeyMap$(CODE "P") = "8"
LET KeyMap$(CODE "d") = "8"
LET KeyMap$(CODE "D") = "8"
LET KeyMap$(9) = "8" : REM right arrow
REM up
LET KeyMap$(CODE "7") = "7"
LET KeyMap$(CODE "w") = "7"
LET KeyMap$(CODE "W") = "7"
LET KeyMap$(CODE "k") = "7"
LET KeyMap$(CODE "K") = "7"
LET KeyMap$(11) = "7" : REM up arrow
REM down
LET KeyMap$(CODE "6") = "6"
LET KeyMap$(CODE "s") = "6"
LET KeyMap$(CODE "S") = "6"
LET KeyMap$(CODE "m") = "6"
LET KeyMap$(CODE "M") = "6"
LET KeyMap$(10) = "6" : REM down arrow
REM automaton for bike
REM DIM BikeSprite$(8)
LET BikeSprite$(5) = "\H" : REM "-"
LET BikeSprite$(6) = "\I" : REM "|"
LET BikeSprite$(7) = "\I" : REM "|"
LET BikeSprite$(8) = "\H" : REM "-"
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
VAR t$ TYPE STRING
VAR i TYPE INTEGER
FOR i = -10 TO 5: BEEP .005,i+10: BEEP .005,ABS i: NEXT i
REPEAT
PAUSE 0
LET t$ = KeyMap$(CODE (INKEY$+" ") )
UNTIL t$ >= "5" AND t$ <= "8"
REPEAT
UNTIL INKEY$ = ""
BEEP .1,20
LET Direction = VAL t$
LET DirectionOld = Direction
LET Clock0 = PEEK 23672
LET BUFFER$ = ""
END PROCEDURE
PROCEDURE DefineChars
VAR t$ TYPE STRING
VAR n TYPE INTEGER
VAR i TYPE INTEGER
VAR addr TYPE INTEGER
RESTORE
READ t$
REPEAT
REM LET addr = UDG(t$)
LET addr = USR(t$)
FOR i=0 TO 7
READ n
POKE addr+i,n
NEXT i
READ t$
UNTIL t$ = ""
END PROCEDURE
PROCEDURE DefineSprites
' UDG chars
DATA "A"
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 "B"
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA "C"
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011111
DATA BIN 00011111
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "D"
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA "E"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA "F"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00011111
DATA BIN 00011111
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA "G"
DATA BIN 00000000
DATA BIN 11111110
DATA BIN 10010010
DATA BIN 11111110
DATA BIN 10000010
DATA BIN 10000010
DATA BIN 10000010
DATA BIN 11000110
DATA "H"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 01111110
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11100111
DATA BIN 00000000
DATA BIN 00000000
DATA "I"
DATA BIN 00111100
DATA BIN 00111100
DATA BIN 00111100
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00111100
DATA BIN 00111100
DATA BIN 00111100
DATA "J"
DATA BIN 01101100
DATA BIN 01111100
DATA BIN 11111110
DATA BIN 11111110
DATA BIN 01111100
DATA BIN 00111000
DATA BIN 00111000
DATA BIN 00010000
DATA ""
END PROCEDURE
PROCEDURE BattleEnd
VAR i TYPE INTEGER
IF NOT GameOver
PRINT AT 22,9;PAPER 7;INK 2; " BATTLE OVER "
FOR i = -15 TO 5 STEP 2: BEEP .05,i+10: BEEP .05,ABS i: NEXT i
REPEAT
UNTIL INKEY$ = ""
FOR i=1 TO 5
PAUSE 10
NEXT i
ENDIF
END PROCEDURE
PROCEDURE GameEnd
PRINT AT 22,10;PAPER 7;INK 2; " GAME OVER "
BEEP .5,15: BEEP .5,10: BEEP .5,5: BEEP .5,0
IF Score > HighScore
FOR i=1 TO 5
PAUSE 2
NEXT i
PRINT AT 0,8; INK 2;" NEW HIGH SCORE "
BEEP .5,10: BEEP .5,0: BEEP .5,20
LET HighScore = Score
ENDIF
REPEAT
UNTIL INKEY$ = ""
FOR i=1 TO 5
PAUSE 10
NEXT i
END PROCEDURE
PROCEDURE Introduction
VAR i TYPE INTEGER
BORDER 0: PAPER 0: INK 7: CLS
INK 3
PRINT " XXX XXXXX XXXX XXX X X"
PRINT "X X X X X X X XX X"
PRINT "X X X X X X X X X"
PRINT " XXX X XXXX X X X XX"
PRINT " X X X X X X X X"
PRINT "X X X X X X X X X"
PRINT " XXX X X X XXX X X"
PRINT INK 4;AT 10,4;"\*1983 by Roger Allen"
PRINT INK 4;AT 11,4;"\*2023 by ZarSoft"
PRINT INK 1;AT 19,0;" Pascalated BASIC "
PRINT INK 1;AT 20,0;" Compiled by ZX BASIC (Boriel) "
PRINT INK 5;AT 21,0;"Keys: 5678 WSOP WSAD ADKM arrows"
DefineChars
PRINT AT 0,0;
PRINT " \G\G\G \G\G\G\G\G \G\G\G\G \G\G\G \G \G"
PRINT "\G \G \G \G \G \G \G \G\G \G"
PRINT "\G \G \G \G \G \G \G \G \G"
PRINT " \G\G\G \G \G\G\G\G \G \G \G \G\G"
PRINT " \G \G \G \G \G \G \G \G"
PRINT "\G \G \G \G \G \G \G \G \G"
PRINT " \G\G\G \G \G \G \G\G\G \G \G"
FOR i = -20 TO 20: BEEP .005,i: BEEP .005,ABS i: NEXT i
PRINT AT 23,4;INK 2;"Press any key to start"
PAUSE 0
RANDOMIZE
END PROCEDURE
PROCEDURE Battle
VAR t$ TYPE STRING
InitBattle
WaitForPlayer
REPEAT
WaitClock
LET t$ = GetKey$
LET t$ = KeyMap$(CODE t$)
IF t$ >= "5" AND t$ <= "8" THEN IF Direction + VAL t$ <> 13 THEN LET Direction = VAL t$
MoveForward
MoveEnemies
REM WaitClock
BORDER 0
UNTIL BattleOver OR GameOver
BattleEnd
END PROCEDURE
PROCEDURE Game
InitGame
REPEAT
Battle
UNTIL GameOver
GameEnd
END PROCEDURE
PROCEDURE MainRoutine
Introduction
InitProg
REPEAT
Game
UNTIL FALSE
END PROCEDURE
PROGRAM STRON
MainRoutine
' last 2 lines are going to be deleted
PRINT AT 23,0;
END PROGRAM
|
|
|
Pascalated ZX BASIC Demo #5 - Predator |
Posted by: zarsoft - 02-20-2023, 09:34 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
Code: ' PROGRAM Predator
' 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>
#include <screen.bas>
'--- Pascalated Boriel ---
'#define CONST CONST
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define CHAR UBYTE
'#define STRING STRING
#define BOOLEAN LONG
#define TYPE AS
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
#define PROGRAM REM
CONST TRUE TYPE INTEGER = 1
CONST FALSE TYPE INTEGER = 0
' Variable Declarations
VAR Name$ TYPE STRING ' player's name
VAR HighScore TYPE INTEGER ' high HighScore
VAR Score TYPE INTEGER ' Score in this game
VAR UserLin TYPE INTEGER
VAR UserCol TYPE INTEGER
VAR UserLin0 TYPE INTEGER
VAR UserCol0 TYPE INTEGER
VAR PredatorLin TYPE INTEGER
VAR PredatorCol TYPE INTEGER
VAR PredatorLin0 TYPE INTEGER
VAR PredatorCol0 TYPE INTEGER
VAR GameOver TYPE BOOLEAN
VAR Walker$ TYPE STRING ' 2 frames walking
VAR frame TYPE INTEGER
PROCEDURE ShowScores
PRINT AT 22,0;"Score:";Score;TAB 13;"High score: ";HighScore;TAB 13;"by ";Name$;
END PROCEDURE
PROCEDURE InitEnemy
LET PredatorLin = 1+INT (RND*20): LET PredatorCol = 30
LET PredatorLin0 = PredatorLin: LET PredatorCol0 = PredatorCol
END PROCEDURE
PROCEDURE CaughtInTrap
VAR N TYPE INTEGER
PRINT AT PredatorLin0,PredatorCol0;INK 2;" ";
PRINT AT PredatorLin,PredatorCol;INK 3;"*";
LET Score=Score+50
ShowScores
FOR N=-30 TO 30 STEP 5: BEEP .02,ABS N: NEXT N
PRINT AT PredatorLin,PredatorCol;" ";
InitEnemy
END PROCEDURE
PROCEDURE InitArena
VAR N TYPE INTEGER
BORDER 4: PAPER 4: INK 1: CLS
POKE 23609,50
LET GameOver = FALSE
REM InitUser
LET UserLin = 1+INT (RND*20): LET UserCol=1
LET UserLin0 = UserLin: LET UserCol0 = UserCol
InitEnemy
LET Score=0
FOR N=0 TO 31: PRINT AT 0,N;PAPER 1;INK 5;"X";AT 21,N;"X": NEXT N
FOR N=0 TO 21: PRINT AT N,0;PAPER 1;INK 5;"X";AT N,31;"X": NEXT N
FOR N=1 TO 30: PRINT AT 2+INT (18*RND),2+INT (29*RND);"O": NEXT N
PRINT AT 0,11;PAPER 1;INK 7;"-PREDATOR-"
PRINT AT UserLin,UserCol;INK 2;Walker$(1);
PRINT AT PredatorLin,PredatorCol;INK 2;"\{vi}\C\{vn}"
END PROCEDURE
PROCEDURE TheEnd
VAR N TYPE INTEGER
PRINT INK 3;AT UserLin,UserCol;"#";OVER 1;CHR$ 8;"X"
FOR N=-30 TO 30 STEP 3: BEEP .02,ABS N: BEEP .03,N: NEXT N
IF HighScore<Score THEN
LET HighScore=Score
PRINT AT 22,0;"New high score";TAB 0;TAB 31;AT 23,0;"What's your name? ";
Name$ = INPUT(15)
ENDIF
END PROCEDURE
PROCEDURE WaitForUser
PRINT AT 23,0;" Pascalated BASIC demo";
BEEP .1,5: BEEP .1,10: BEEP .1,5: BEEP .1,0
REPEAT
PAUSE 1
LET k$=INKEY$
UNTIL k$ = ""
PAUSE 0
BEEP .1,5: BEEP .1,10: BEEP .1,0
PRINT AT 23,0;" ";
ShowScores
END PROCEDURE
PROCEDURE InitSprites
REM \A\B\C
REM \A
POKE USR "A"+0,BIN 00011000
POKE USR "A"+1,BIN 00010000
POKE USR "A"+2,BIN 00111000
POKE USR "A"+3,BIN 11010111
POKE USR "A"+4,BIN 00010000
POKE USR "A"+5,BIN 00101000
POKE USR "A"+6,BIN 01000100
POKE USR "A"+7,BIN 10000010
REM \B
POKE USR "B"+0,BIN 00011000
POKE USR "B"+1,BIN 00010000
POKE USR "B"+2,BIN 00111000
POKE USR "B"+3,BIN 01010100
POKE USR "B"+4,BIN 10010100
POKE USR "B"+5,BIN 00101000
POKE USR "B"+6,BIN 00101000
POKE USR "B"+7,BIN 01000100
REM \C
POKE USR "C"+0,BIN 11000011
POKE USR "C"+1,BIN 10000001
POKE USR "C"+2,BIN 00100100
POKE USR "C"+3,BIN 00000000
POKE USR "C"+4,BIN 01011010
POKE USR "C"+5,BIN 01111110
POKE USR "C"+6,BIN 01111110
POKE USR "C"+7,BIN 00000000
END PROCEDURE
PROCEDURE Game
REPEAT
REM Process keys
PAUSE 10
LET k$ = INKEY$
IF k$="5" OR k$="o" THEN IF UserCol>1 THEN BEEP .02,5*RND: LET UserCol=UserCol-1
IF k$="6" OR k$="a" THEN IF UserLin<20 THEN BEEP .02,5*RND: LET UserLin=UserLin+1
IF k$="7" OR k$="q" THEN IF UserLin>1 THEN BEEP .02,5*RND: LET UserLin=UserLin-1
IF k$="8" OR k$="p" THEN IF UserCol<30 THEN BEEP .02,5*RND: LET UserCol=UserCol+1
REM show user
PRINT AT UserLin0,UserCol0;INK 5;".";
PRINT AT UserLin,UserCol;INK 2;Walker$(frame);: LET frame = 3-frame
LET UserLin0=UserLin: LET UserCol0=UserCol
REM move predator
IF ABS (PredatorLin-UserLin) > ABS (PredatorCol-UserCol) THEN LET PredatorLin = PredatorLin+SGN (UserLin-PredatorLin)
IF ABS (PredatorLin-UserLin) <= ABS (PredatorCol-UserCol) THEN LET PredatorCol = PredatorCol+SGN (UserCol-PredatorCol)
REM test trap
IF SCREEN$ (PredatorLin,PredatorCol)="O" THEN CaughtInTrap
REM show predator
PRINT AT PredatorLin0,PredatorCol0;" ";
PRINT AT PredatorLin,PredatorCol;INK 2;"\{vi}\C\{vn}";
LET PredatorLin0=PredatorLin: LET PredatorCol0=PredatorCol
BEEP .01,0
REM test game status
IF UserLin=PredatorLin THEN IF UserCol=PredatorCol THEN LET GameOver = TRUE
UNTIL GameOver
END PROCEDURE
PROCEDURE MainRoutine
REPEAT
InitArena
WaitForUser
Game
TheEnd
UNTIL FALSE
END PROCEDURE
PROCEDURE InitProgram
Name$ = "Username"
LET frame = 1
LET HighScore=0
InitSprites: LET Walker$=" \A\B"
END PROCEDURE
PROGRAM Predator
REM (c) 2022 Zarsoft
REM Hunter - Written by ZE OLIVEIRA, 1984
REM Pascalated version 2022, 2023
InitProgram
MainRoutine
' last 2 lines are going to be deleted
PRINT AT 23,0;
END PROGRAM
|
|
|
Pascalated ZX BASIC Demo #4 - Cannonball |
Posted by: zarsoft - 02-10-2023, 12:14 PM - Forum: Gallery
- No Replies
|
 |
To run online, click here: RUN ONLINE
Code: ' PROGRAM Cannonball
' 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>
'--- Pascalated Boriel ---
'#define CONST CONST
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define BOOLEAN LONG
#define TYPE AS
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
#define PROGRAM REM
VAR TRUE TYPE INTEGER = 1
VAR FALSE TYPE INTEGER = 0
' Variable Declarations
CONST gravity TYPE REAL = 9.8
CONST power TYPE REAL = 10.0
CONST k TYPE REAL = 0.04
VAR near TYPE BOOLEAN
' Variable Declarations
VAR enemies TYPE INTEGER
VAR angle TYPE REAL
VAR G,H TYPE REAL ' target coordinates
PROCEDURE GameOver
INK 1
PRINT AT 21,0;" Well done!"
PRINT AT 21,17;" Goodbye!"
END PROCEDURE
PROCEDURE Boom
LET enemies=enemies-1
INK 0
PRINT PAPER 6;AT 0,15;" Enemies: ";enemies;" "
INK 3
OVER 1
CIRCLE G,H,4
REM +
PLOT G+5,H: DRAW 5,0
PLOT G,H+5: DRAW 0,5
PLOT G-5,H: DRAW -5,0
PLOT G,H-5: DRAW 0,-5
REM X
PLOT G+5,H+5: DRAW 5,5
PLOT G-5,H+5: DRAW -5,5
PLOT G-5,H-5: DRAW -5,-5
PLOT G+5,H-5: DRAW 5,-5
OVER 0
:FOR q=5 TO 1 STEP -.4: BEEP .01,q: NEXT q
PAUSE 88
END PROCEDURE
PROCEDURE DrawShot
VAR X,Y TYPE REAL
VAR X0,Y0 TYPE REAL
VAR X1,Y1 TYPE REAL
VAR DX,DY TYPE REAL
'
LET X=0.0 : LET DX=power*COS(angle)
LET Y=88.0 : LET DY=power*SIN(angle)
LET X1=X : LET Y1 = Y
LET X0=X1 : LET Y0 = Y1
INK 3
PLOT X1,Y1
REPEAT
DRAW X1-X0,Y1-Y0
LET X0=X1 : LET Y0 = Y1
LET DY=DY-k*gravity : REM gravity
LET X=X+DX : REM differential increment
LET Y=Y+DY : REM differential increment
LET X1=INT(X+0.5)
LET Y1=INT(Y+0.5)
IF Y1>175 THEN LET Y1=175
LET dist = SQR( (Y-H)*(Y-H) + (X-G)*(X-G) )
LET near = dist < 0.5*(ABS(DY)+ABS(DX))
UNTIL X>255 OR Y<0 OR near
END PROCEDURE
PROCEDURE InputAngle
REPEAT
PRINT AT 21,0;"Angle = ";
angle = VAL INPUT(9)
UNTIL angle>-90 AND angle<90
PRINT angle
LET angle = angle*PI/180 : REM degrees to radians
RANDOMIZE
END PROCEDURE
PROCEDURE SetTarget
LET G=INT (RND*120+60)
LET H=INT (RND*110+35)
INK 1
CIRCLE G,H,4
END PROCEDURE
PROCEDURE DrawScreen
CLS
PRINT INVERSE 1;" CANNONBALL ";
PRINT AT 23,1;INK 6;"Pascalated BASIC Contest demo";
INK 0
PRINT PAPER 6;AT 0,15;" Enemies: ";enemies;" "
PLOT 0,0: DRAW 0,175: PLOT 0,88: DRAW 255,0
END PROCEDURE
PROCEDURE Shot
DrawScreen
SetTarget
InputAngle
DrawShot
IF near THEN Boom
END PROCEDURE
PROCEDURE InitVariables
LET enemies = 10
RANDOMIZE
END PROCEDURE
PROCEDURE PlayGame
InitVariables
REPEAT
Shot
UNTIL enemies = 0
GameOver
END PROCEDURE
PROGRAM CANNONBALL
REM BALA 5 - differential version
REM (c) 2023 by Zarsoft
PlayGame
' last 2 lines are going to be deleted
PRINT AT 23,0;
END PROGRAM
|
|
|
Pascalated ZX BASIC Demo #3 - Multiplication Table |
Posted by: zarsoft - 02-04-2023, 02:54 PM - Forum: Gallery
- Replies (1)
|
 |
To run online, click here: RUN ONLINE
Code: ' PROGRAM MULTIPLICATION TABLE
' Demo for Pascalated BASIC contest
' Version ZX SPECTRUM (c) 1983 by Zarsoft
' Version ZX BASIC Boriel (c) 2023 by Zarsoft
' Language: Pascalated ZX BASIC (BORIEL) compiled
#include <input.bas>
'--- Pascalated Boriel ---
#define VAR DIM
#define INTEGER LONG
#define REAL FLOAT
#define BOOLEAN LONG
#define TYPE AS
#define REPEAT DO
#define UNTIL LOOP UNTIL
#define PROCEDURE SUB
#define PROGRAM REM
VAR TRUE TYPE INTEGER = 1
VAR FALSE TYPE INTEGER = 0
REM Variable Declarations
VAR GoodScore TYPE BOOLEAN = FALSE : REM many right answers
VAR Name$ TYPE STRING = "" : REM User name
VAR RightAnswers TYPE INTEGER = 0 : REM number of right answers
VAR Question$ TYPE STRING : REM the question
VAR Answer TYPE INTEGER = 0 : REM user answer
VAR Level TYPE INTEGER = 0 : REM difficulty level
VAR Attempt TYPE INTEGER : REM number of questions
PROCEDURE Write (line$ TYPE STRING)
REM POKE 23692,9
FOR n=0 TO LEN(line$)-1
PRINT line$(n);
BEEP .02,10+10*RND
NEXT n
END PROCEDURE
PROCEDURE WriteLine (line$ TYPE STRING)
Write(line$)
PRINT
END PROCEDURE
PROCEDURE CheckAnswer
VAR line$ TYPE STRING
PRINT
IF ABS (VAL Question$-Answer) > .01
WriteLine( " Wrong, "+Name$+"." )
WriteLine( " "+Question$+" = "+STR$( VAL( Question$ ) ) )
ELSE
LET RightAnswers = RightAnswers + 1
WriteLine( " Right, "+Name$+"." )
WriteLine( " "+Question$+" = "+STR$( Answer ) )
ENDIF
PAUSE 25
WriteLine( " "+STR$ RightAnswers +" right answers in "+STR$ Attempt+"." )
PAUSE 2*50
END PROCEDURE
PROCEDURE AskQuestion
VAR reply$ TYPE STRING
REPEAT
Write( " "+Question$+" = " )
reply$ = INPUT(9) : PRINT reply$
UNTIL VAL reply$ > 0
LET Answer = VAL reply$
END PROCEDURE
PROCEDURE ChooseNumbers
VAR N1 TYPE INTEGER
VAR N2 TYPE INTEGER
RANDOMIZE
N1 = 2*Level+INT (4*Level*RND)
N2 = 2*Level+INT (3*Level*RND)
LET Question$ = STR$ N1 + " * " + STR$ N2
PRINT
END PROCEDURE
PROCEDURE AskOneQuestion
ChooseNumbers
AskQuestion
CheckAnswer
END PROCEDURE
PROCEDURE ChooseDifficulty
WriteLine( "What difficulty do you like? " )
REPEAT
Write( "1, 2 or 3? " )
Level = VAL INPUT (9) : PRINT Level
UNTIL Level >= 1 AND Level <= 3
PRINT
END PROCEDURE
PROCEDURE GameOver
PRINT
WriteLine( " Well done!" )
WriteLine( " You don't need me anymore..." )
WriteLine( " Goodbye!" )
END PROCEDURE
PROCEDURE GradeTheTest
PRINT
IF RightAnswers > 8
LET GoodScore = TRUE
ELSE
LET GoodScore = FALSE
PRINT
WriteLine(" "+STR$ RightAnswers + " right answers in 10?!")
WriteLine(" This is not good...")
WriteLine(" Let's try again!")
ENDIF
END PROCEDURE
PROCEDURE AskTenQuestions
PRINT
ChooseDifficulty
LET RightAnswers = 0
PRINT CHR$(13, 13, 13, 13, 13, 13)
FOR Attempt = 1 TO 10
AskOneQuestion
NEXT Attempt
END PROCEDURE
PROCEDURE InitVariables
LET RightAnswers = 0
LET GoodScore = 0
END PROCEDURE
PROCEDURE Hello
VAR line$ TYPE STRING
CLS
PRINT "Demo for "
PRINT "2023 Pascalated BASIC contest"
PRINT
PRINT "(c) 2023 by Zarsoft"
PRINT
PRINT "Compiled language:"
PRINT "Pascalated ZX BASIC (Boriel)"
PRINT CHR$(13, 13, 13, 13, 13)
WriteLine(" Hi, Human!")
REPEAT
Write(" What is your name? ")
Name$ = INPUT (20) : PRINT Name$
UNTIL LEN Name$ >= 2
PRINT
WriteLine(" Hi, "+Name$+"!")
WriteLine(" I am your new teacher.")
PAUSE 50
PRINT
WriteLine(" I'm going to see if you know the multiplication table...")
END PROCEDURE
PROCEDURE MainRoutine
Hello
REPEAT
InitVariables
AskTenQuestions
GradeTheTest
UNTIL GoodScore
GameOver
END PROCEDURE
PROGRAM MainRoutine
MainRoutine
' last 2 lines are going to be deleted
PRINT CHR$(13, 13, 13)
END PROGRAM
|
|
|
Please do not abort (solved) |
Posted by: zarsoft - 01-28-2023, 01:21 PM - Forum: Help & Support
- Replies (4)
|
 |
Help! This program resets the computer.
What am I doing wrong?
Can the compiler be fixed?
Code: 11 DIM start1 AS LONG = 16384
12 DIM start2 AS LONG = start1+8*8*32
18 DIM p(192) AS LONG
36 GO SUB 300
40 STOP
200 REM test index y
220 LET y=1
230 POKE p(y+1)+1,255
295 RETURN
300 REM generate plain
310 GO SUB 500
390 RETURN
500 REM init index y
510 DIM addr AS LONG = start1
520 DIM ix AS LONG = 191
530 REM --- ciclo1 ---
540 LET p(ix+1)=addr
550 LET addr=addr+32
580 IF addr<start2 THEN GO TO 530
790 RETURN
|
|
|
|