Forum

Welcome, Guest

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

Search Forums

(Advanced Search)

Forum Statistics

» Members: 292
» Latest member: bracckets
» Forum threads: 1,028
» Forum posts: 6,212

Full Statistics

Online Users

There are currently 565 online users.
» 0 Member(s) | 563 Guest(s)
Bing, Google

Latest Threads

Includes in ASM
Forum: How-To & Tutorials
Last Post: bracckets
04-04-2024, 12:17 AM
» Replies: 2
» Views: 415

Intermittent errors
Forum: Help & Support
Last Post: zarsoft
03-12-2024, 12:39 PM
» Replies: 0
» Views: 253

Store array information i...
Forum: Help & Support
Last Post: rbiondi
03-10-2024, 09:42 PM
» Replies: 0
» Views: 327

ScrollLeft function scrol...
Forum: Bug Reports
Last Post: rbiondi
03-07-2024, 03:57 PM
» Replies: 2
» Views: 669

string.bas errors when co...
Forum: Bug Reports
Last Post: rbiondi
03-01-2024, 10:10 AM
» Replies: 2
» Views: 593

Using Beepola with ZX BAS...
Forum: How-To & Tutorials
Last Post: edtoo
02-29-2024, 09:47 AM
» Replies: 15
» Views: 32,019

Johnny Bravo
Forum: Gallery
Last Post: zarsoft
02-11-2024, 11:20 PM
» Replies: 0
» Views: 408

Compiling +D G+DOS progra...
Forum: ZX Basic Compiler
Last Post: boriel
01-22-2024, 08:32 AM
» Replies: 4
» Views: 8,432

VAL = ? (solved)
Forum: Bug Reports
Last Post: zarsoft
01-03-2024, 11:44 PM
» Replies: 8
» Views: 2,828

Wrong math (solved)
Forum: Bug Reports
Last Post: zarsoft
01-03-2024, 11:38 PM
» Replies: 4
» Views: 1,526

Pascalated ZX BASIC Demo #8 - Pong

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

To run online, click here: RUN ONLINE

Listing:

Code:
' PROGRAM Pong

' (c) 2023 by Zarsoft

' Written by Ze Oliveira

' Demo for the Pascalated language

' Pascalated Sinclair BASIC (c) 1987 by ZarSoft

' Pascalated BASIC Converter (c) 2021 by Zarsoft

' Pascalated Boriel (c) 2023 by ZarSoft

' ZX BASIC Compiler (c) 2008 by Boriel

#include <input.bas>  ' number = VAL INPUT(12)

#include <screen.bas> ' SCREEN$ function

#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---

'#define CONST     CONST

#define VAR       DIM

#define INTEGER   LONG

#define REAL      FLOAT

#define CHAR      STRING

'#define STRING    STRING

#define BOOLEAN   UBYTE

#define TYPE      AS

'#define WHILE    WHILE

#define REPEAT    DO

#define UNTIL     LOOP UNTIL

#define PROCEDURE SUB

#define PROGRAM   REM

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

' CONSTant declarations

CONST Period TYPE INTEGER = 8

' VAR - Global variables

VAR ScorePlayer TYPE INTEGER = 0

VAR ScoreComputer TYPE INTEGER = 0

VAR PlayerFirst TYPE BOOLEAN = TRUE

VAR Handicap TYPE INTEGER = 14

VAR Goal TYPE BOOLEAN

VAR ComputerPos TYPE INTEGER = 15

VAR PlayerPos TYPE INTEGER = 15

VAR BallLin TYPE INTEGER = 19-1

VAR BallCol TYPE INTEGER = PlayerPos

VAR DL TYPE INTEGER = -1

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

VAR Clock,Clock0 TYPE INTEGER

PROCEDURE GetReady

LET Goal = FALSE

IF BallLin = 2 THEN LET ScorePlayer = ScorePlayer+1

IF BallLin = 19 THEN LET ScoreComputer = ScoreComputer+1

PRINT AT 0,7;ScoreComputer

PRINT AT 21,7;ScorePlayer

IF BallLin = 2 

  LET PlayerFirst = TRUE

ELSEIF BallLin = 19

  LET PlayerFirst = FALSE

ENDIF

IF PlayerFirst 

  LET BallLin = 19-1

  LET BallCol = PlayerPos

  LET DL = -1

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

ELSE

  LET BallLin = 2+1

  LET BallCol = ComputerPos

  LET DL = 1

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

ENDIF

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

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

PRINT AT BallLin,BallCol;"\A"

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

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

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

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

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

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

END PROCEDURE

PROCEDURE DrawField

BORDER 0: PAPER 0: INK 7: CLS

LET Goal = FALSE

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

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

PRINT AT 1,0;"\ .";

PRINT AT 1,31;"\. ";

PRINT AT 20,0;"\ '";

PRINT AT 20,31;"\' ";

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

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

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

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

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

END PROCEDURE

FUNCTION GetKey$ TYPE CHAR

VAR result$ TYPE CHAR = ""

VAR key$ TYPE CHAR

VAR elapsed TYPE INTEGER

REPEAT 

  key$ = INKEY$

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

  LET Clock = PEEK 23672

  LET elapsed = Clock-Clock0: IF elapsed<0 THEN LET elapsed = elapsed+256

UNTIL elapsed >= Period

LET Clock0 = Clock0 + Period: IF Clock0>255 THEN LET Clock0 = Clock0-256

RETURN result$

END FUNCTION

PROCEDURE WaitForUser

REPEAT 

  PAUSE 1

  LET k$ = INKEY$

UNTIL k$ = ""

PAUSE 0

BEEP .05,20

LET k$ = INKEY$

REM this give advantage; canceled

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

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

END PROCEDURE

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

PROCEDURE ProcessPlayer

  LET k$ = GetKey$

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

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

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

END PROCEDURE

PROCEDURE ProcessComputer

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

  IF ComputerPos < 3 THEN LET ComputerPos = 3

  IF ComputerPos > 28 THEN LET ComputerPos = 28

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

END PROCEDURE

PROCEDURE ProcessBall

  PRINT AT BallLin,BallCol;INK 6;" "

  LET BallCol = BallCol + DC

  LET BallLin = BallLin + DL

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

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

END PROCEDURE

PROCEDURE TestGameStatus

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

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

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

END PROCEDURE

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

PROCEDURE InitVariables

POKE 23609,50

LET Goal = FALSE

LET ComputerPos = 15

LET PlayerPos = 15

LET BallLin = 19-1

LET BallCol = PlayerPos

LET DL = -1

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

END PROCEDURE

PROCEDURE InitGraphics

REM \A

POKE USR "A"+0,BIN 00111100

POKE USR "A"+1,BIN 01111110

POKE USR "A"+2,BIN 11111111

POKE USR "A"+3,BIN 11111111

POKE USR "A"+4,BIN 11111111

POKE USR "A"+5,BIN 11111111

POKE USR "A"+6,BIN 01111110

POKE USR "A"+7,BIN 00111100

END PROCEDURE

PROCEDURE Game

LET Clock0 = PEEK 23672

REPEAT 

  ProcessPlayer

  ProcessComputer

  ProcessBall

  TestGameStatus

UNTIL Goal

END PROCEDURE

PROCEDURE MainRoutine

InitGraphics

InitVariables

DrawField

REPEAT 

  GetReady

  IF PlayerFirst THEN WaitForUser

  Game

UNTIL FALSE

END PROCEDURE

PROGRAM Pong

MainRoutine

' last 2 lines are going to be deleted

PRINT AT 23,0;

END PROGRAM

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:
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 - 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 - No Replies

	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

Pages (95): « Previous 1 … 4 5 6 7 8 … 95 Next »

Login
Username:
Password:	Lost Password?
	Remember me