Forum

Welcome, Guest

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

Search Forums

(Advanced Search)

Forum Statistics

» Members: 261
» Latest member: Roberitlar
» Forum threads: 1,074
» Forum posts: 6,439

Full Statistics

Online Users

There are currently 154 online users.
» 0 Member(s) | 153 Guest(s)
Bing

Latest Threads

Printing with FZX
Forum: Help & Support
Last Post: boriel
07-17-2025, 09:08 PM
» Replies: 1
» Views: 348

Strange Happenings
Forum: Bug Reports
Last Post: boriel
05-23-2025, 09:15 AM
» Replies: 4
» Views: 2,516

.tap file code not execut...
Forum: Help & Support
Last Post: Zoran
04-28-2025, 10:59 AM
» Replies: 4
» Views: 2,704

Exit from more than one l...
Forum: Wishlist
Last Post: Duefectu
04-23-2025, 10:06 PM
» Replies: 3
» Views: 2,257

put small ASM programs li...
Forum: How-To & Tutorials
Last Post: Zoran
04-18-2025, 02:02 PM
» Replies: 6
» Views: 5,249

Creating +3 Menus - Loadi...
Forum: Help & Support
Last Post: merlinkv
04-16-2025, 02:08 PM
» Replies: 6
» Views: 3,688

Randomize not very random...
Forum: Help & Support
Last Post: Zoran
04-08-2025, 10:40 AM
» Replies: 4
» Views: 3,423

Scope rules
Forum: Bug Reports
Last Post: Zoran
04-04-2025, 09:46 AM
» Replies: 2
» Views: 1,947

Using constants not allow...
Forum: Bug Reports
Last Post: baltasarq
03-19-2025, 10:00 PM
» Replies: 8
» Views: 4,731

404 page not found
Forum: Documentation
Last Post: boriel
03-08-2025, 07:16 PM
» Replies: 5
» Views: 5,414

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

USR (solved)

Posted by: zarsoft - 02-26-2023, 11:20 PM - Forum: Help & Support - Replies (5)

	Where is the USR function?

404 page not found

Posted by: zarsoft - 02-26-2023, 07:18 PM - Forum: Documentation - Replies (5)

	This page does not exist: https://zxbasic.readthedocs.io/en/latest/library/point/

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:
DIM start1 AS LONG = 16384

DIM start2 AS LONG = start1+8*8*32

DIM p(192) AS LONG

GO SUB 300

STOP 

REM test index y

LET y=1

POKE p(y+1)+1,255

RETURN 

REM generate plain

GO SUB 500 

RETURN 

REM init index y

DIM addr AS LONG = start1

DIM ix AS LONG = 191

REM --- ciclo1 ---

LET p(ix+1)=addr

LET addr=addr+32

IF addr<start2 THEN GO TO 530

RETURN

PRINT '''''' (solved)

Posted by: zarsoft - 01-27-2023, 08:48 PM - Forum: Help & Support - Replies (1)

	How do I translate this to ZX BASIC? PRINT '''''' (print several blank lines)

Pascalated ZX BASIC Demo #2 - Laser

Posted by: zarsoft - 01-27-2023, 11:49 AM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

Code:
' PROGRAM LASER

' Demo for Pascalated BASIC contest

' Version ZX81 (c) 1982 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 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

REM VAR - Global variables

REM LINA routine variables

VAR SX0 = 0 : VAR SXN = 255

VAR SY0 = 0 : VAR SYN = 175-10

VAR X0 = 0  : VAR Y0 = 88 : ' first point

VAR M TYPE REAL : VAR B TYPE REAL : ' y = mX+b

REM other variables

VAR enemies = 0

VAR enemyX = 0

VAR enemyY = 0

VAR TRON = 1

PROCEDURE LINA

VAR x,y TYPE REAL

VAR dx,dy TYPE INTEGER

VAR w$ TYPE STRING = "0" : ' string starts at index 0

LET y = M*SX0+B: IF y >= SY0 THEN IF y <= SYN THEN LET w$ = w$+CHR$(SX0)+CHR$(y)

LET y = M*SXN+B: IF y >= SY0 THEN IF y <= SYN THEN LET w$ = w$+CHR$(SXN)+CHR$(y)

LET x = (SY0-B)/(M+1E-15): IF x >= SX0 THEN IF x <= SXN THEN LET w$ = w$+CHR$(x)+CHR$(SY0)

LET x = (SYN-B)/(M+1E-15): IF x >= SX0 THEN IF x <= SXN THEN LET w$ = w$+CHR$(x)+CHR$(SYN)

IF LEN(w$)-1 > 2 THEN 

  PLOT INK 8;CODE(w$(1)),CODE(w$(2))

  FOR i=3 TO LEN(w$)-1 STEP 2

    dx = CODE(w$(i))-CODE(w$(i-2))

    ' dy = dy*0 + CODE(w$(i+1))-CODE(w$(i-1)) : ' need to cast to INTEGER (bug?!)

    ' dy = -1 + CODE(w$(i+1))-CODE(w$(i-1)) + 1 : ' need to cast to INTEGER (bug?!)

    dy = CAST(INTEGER,0) + CODE(w$(i+1)) - CODE(w$(i-1)) : ' need to cast to INTEGER (bug?!)

    DRAW INK 8;dx,dy

  NEXT i

END IF

END PROCEDURE

PROCEDURE GameOver

INK 1

PRINT AT 21,5;"> Well done! Goodbye.";

END PROCEDURE

PROCEDURE Explosion

INK 3

CIRCLE enemyX-1,enemyY+1,4

CIRCLE enemyX+1,enemyY+1,4

CIRCLE enemyX+1,enemyY-1,4

OVER 0

FOR q=1 TO 30: BEEP .002,20+5*RND: NEXT q

PAUSE 100

END PROCEDURE

PROCEDURE OnTarget

LET SXN = enemyX

OVER 1: INK 2

LINA : PAUSE 5 : LINA

OVER 0

LINA

LET enemies = enemies-1

PRINT PAPER 6;INK 0;AT 0,15;" Enemies: ";enemies;"  "

Explosion

END PROCEDURE

PROCEDURE TestShot (angle TYPE REAL)

VAR y TYPE REAL

LET M = TAN(angle): LET B = Y0-M*X0

LET y = M*enemyX+B:

IF ABS(y-enemyY) < 5 THEN

  OnTarget

ELSE

  LET SXN = 255

  INK 2

  LINA

  :FOR q=-10 TO 29: BEEP .005,50-ABS q: NEXT q

ENDIF

END PROCEDURE

FUNCTION ReadAngle TYPE REAL

VAR angle TYPE REAL

REPEAT

  PRINT AT 23,0;"Angle = ";

  angle = VAL( INPUT(5) )

UNTIL angle > -90 AND angle < 90

PRINT AT 23,0;"        ";

LET angle = angle*PI/180 : REM degrees to radians

RETURN angle

END FUNCTION

PROCEDURE ShowEnemy

LET enemyX = 64+RND*182

LET enemyY = 44+RND*122

INK 1

CIRCLE enemyX,enemyY,4

END PROCEDURE

PROCEDURE DrawScreen

CLS 

PRINT PAPER 0;INK 7;AT 0,0;" LASER "

PRINT PAPER 6;INK 0;AT 0,15;" Enemies: ";enemies;"  "

INK 0

PLOT 0,0: DRAW 0,175 : ' vertical line

PLOT 0,88: DRAW 255,0 : ' horizontal line

END PROCEDURE

PROCEDURE InitVariables

LET enemies = 5

END PROCEDURE

PROCEDURE MainRoutine

VAR angle TYPE REAL

InitVariables

REPEAT 

  DrawScreen

  ShowEnemy

  angle = ReadAngle

  TestShot(angle)

UNTIL enemies = 0

GameOver

END PROCEDURE

PROGRAM Laser

MainRoutine

PROGRAM END

-1 = 255 (solved)

Posted by: zarsoft - 01-19-2023, 02:54 PM - Forum: Bug Reports - Replies (1)

	Why this gives different results? How can I force to give -1 ? PRINT CODE("012"(1)) - CODE("012"(2)) ' gives -1 LET w$="012": PRINT CODE(w$(1))-CODE(w$(2)) ' gives 255

Pages (100): « Previous 1 … 9 10 11 12 13 … 100 Next »

Login
Username:
Password:	Lost Password?
	Remember me