Boriel Basic Forum

Welcome, Guest

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

Search Forums

(Advanced Search)

Forum Statistics

» Members: 277
» Latest member: Elemento26
» Forum threads: 1,087
» Forum posts: 6,490

Full Statistics

Online Users

There are currently 160 online users.
» 0 Member(s) | 158 Guest(s)
DuckDuckGo, Google

Latest Threads

GuSprites
Forum: Help & Support
Last Post: zedex82
2026-06-19, 06:39 PM
» Replies: 2
» Views: 355

New video Couse / Nuevo c...
Forum: News
Last Post: Duefectu
2026-04-29, 11:02 PM
» Replies: 0
» Views: 2,697

location of heap manageme...
Forum: Help & Support
Last Post: boriel
2026-03-07, 12:13 AM
» Replies: 1
» Views: 744

non-paged supervisor code...
Forum: Help & Support
Last Post: sdo303
2026-02-20, 06:38 PM
» Replies: 8
» Views: 1,847

How to open fuse as an ex...
Forum: How-To & Tutorials
Last Post: Duefectu
2026-02-09, 01:52 PM
» Replies: 3
» Views: 1,742

Old zxbasic game errors
Forum: Help & Support
Last Post: boriel
2025-11-09, 11:52 AM
» Replies: 7
» Views: 2,537

Error: Undefined GLOBAL l...
Forum: Help & Support
Last Post: ardentcrest
2025-11-04, 05:46 PM
» Replies: 3
» Views: 1,394

A Fast(er) Plot Routine f...
Forum: How-To & Tutorials
Last Post: tubz74
2025-10-30, 03:16 PM
» Replies: 2
» Views: 1,478

Hall of Fame - Include fo...
Forum: How-To & Tutorials
Last Post: tubz74
2025-10-28, 03:48 PM
» Replies: 0
» Views: 818

[SOLVED] Array layout bug...
Forum: Bug Reports
Last Post: Zoran
2025-10-25, 05:48 PM
» Replies: 2
» Views: 1,539

Pascalated ZX BASIC Demo #8 - Pong

Posted by: zarsoft - 2023-03-11, 11: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

CLEAR

Posted by: zarsoft - 2023-03-04, 04: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 - 2023-03-04, 02:35 PM - Forum: Gallery - No Replies

To run online, click here: RUN ONLINE

I modified the loader to RUN again more easily.

Code:
REM loader
RANDOMIZE USR 40000
STOP 
:
REM Loaded compiled code
CLEAR 39999
LOAD "" CODE 
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 - 2023-02-28, 02: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 - 2023-02-27, 12:20 AM - Forum: Help & Support - Replies (5)

	Where is the USR function?

404 page not found

Posted by: zarsoft - 2023-02-26, 08: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 - 2023-02-20, 10: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 - 2023-02-10, 01: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 - 2023-02-04, 03: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 - 2023-01-28, 02: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

Pages (101): « Previous 1 … 10 11 12 13 14 … 101 Next »

Login
Username:
Password:	Lost Password?
	Remember me