Forum

Welcome, Guest

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

Search Forums

(Advanced Search)

Forum Statistics

» Members: 259
» Latest member: Jeffreybub
» Forum threads: 1,074
» Forum posts: 6,434

Full Statistics

Online Users

There are currently 283 online users.
» 1 Member(s) | 279 Guest(s)
Baidu, Bing, Google, Zoran

Latest Threads

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

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

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

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

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

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

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

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

Spectrum keywords codes
Forum: Bug Reports
Last Post: boriel
03-08-2025, 11:00 AM
» Replies: 1
» Views: 392

ZXodus][Engine
Forum: ZX Basic Compiler
Last Post: boriel
02-19-2025, 11:43 PM
» Replies: 69
» Views: 213,412

Pascalated ZX BASIC Demo #10 - Worm

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

To run online, click here: RUN ONLINE

Code:
' PROGRAM Worm

' (c) Starsoft 2020 Java console

' (c) Starsoft 2022 Pascalated BASIC

' (c) Starsoft 2023 Pascalated Boriel ZX BASIC

' Written by David Magalhaes

' Pascalated Sinclair BASIC (c) 1987 by ZarSoft

' Pascalated BASIC Converter (c) 2021 by Zarsoft

' Pascalated Boriel (c) 2023 by ZarSoft

' ZX BASIC Compiler (c) 2008 by Boriel

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

#include <screen.bas> ' SCREEN$ function

#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---

#define PROGRAM   REM

#define BEGIN    REM

'#define CONST     CONST

#define VAR       DIM

#define INTEGER   LONG

#define REAL      FLOAT

#define CHAR      STRING

'#define STRING    STRING

#define BOOLEAN   UBYTE

#define TYPE      AS

'#define WHILE    WHILE

#define REPEAT    DO

#define UNTIL     LOOP UNTIL

#define PROCEDURE SUB

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

PROGRAM Worm

' CONSTant declarations

CONST Period TYPE INTEGER = 8

' VAR - Global variables

VAR Clock,Clock0 TYPE INTEGER

VAR GAMEOVER TYPE BOOLEAN

VAR LIN, COL TYPE INTEGER

VAR Direction, DirectionOld TYPE INTEGER

VAR LengthMax TYPE INTEGER

VAR LengthCurrent TYPE INTEGER

VAR TailL, TailC TYPE INTEGER

VAR Cook TYPE INTEGER

VAR DirectionTail TYPE INTEGER

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

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

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

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

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

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

VAR Record TYPE INTEGER ' max length achieved

'--- KEYBOARD BUFFER ---

VAR BUFFER$ TYPE STRING = ""

PROCEDURE ScanKey

VAR key$ TYPE STRING = INKEY$

VAR l TYPE INTEGER

IF key$ <> "" THEN 

  IF BUFFER$ = "" THEN 

    LET BUFFER$ = BUFFER$+INKEY$

  ELSE

    LET l = LEN BUFFER$

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

  ENDIF

ENDIF

END PROCEDURE

FUNCTION GetKey$ TYPE STRING

VAR result$ TYPE STRING

VAR l TYPE INTEGER

LET l = LEN BUFFER$

IF l = 0

  LET result$ = CHR 0

ELSEIF l = 1

  LET result$ = BUFFER$

  BUFFER$ = ""

ELSE

  LET result$ = BUFFER$(0)

  BUFFER$ = BUFFER$( 1 TO )

ENDIF

RETURN result$

END FUNCTION

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

PROCEDURE TheEnd

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

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

PAUSE 50

IF LengthCurrent > Record 

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

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

  LET Record = LengthCurrent

ENDIF

REPEAT 

UNTIL  INKEY$ = ""

FOR i=1 TO 5

  PAUSE 50

NEXT i

END PROCEDURE

PROCEDURE GiveFood

VAR cMin TYPE INTEGER = 3

VAR cMax TYPE INTEGER = 30

VAR lMin TYPE INTEGER = 3

VAR lMax TYPE INTEGER = 20

VAR l,c TYPE INTEGER

VAR food TYPE INTEGER

IF Cook < 10 

  LET Cook = Cook+1

ELSE

  LET Cook = 0

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

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

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

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

ENDIF

END PROCEDURE

PROCEDURE PrintTrailOldVersion

IF DirectionOld = 5 AND Direction = 5 

  LET r$ = "-"

ELSEIF DirectionOld = 5 AND Direction = 6

  LET r$ = "/"

ELSEIF DirectionOld = 5 AND Direction = 7

  LET r$ = "\\"

ELSEIF DirectionOld = 6 AND Direction = 6

  LET r$ = "|"

ELSEIF DirectionOld = 6 AND Direction = 5

  LET r$ = "/"

ELSEIF DirectionOld = 6 AND Direction = 8

  LET r$ = "\\"

ELSEIF DirectionOld = 7 AND Direction = 7

  LET r$ = "|"

ELSEIF DirectionOld = 7 AND Direction = 5

  LET r$ = "\\"

ELSEIF DirectionOld = 7 AND Direction = 8

  LET r$ = "/"

ELSEIF DirectionOld = 8 AND Direction = 8

  LET r$ = "-"

ELSEIF DirectionOld = 8 AND Direction = 6

  LET r$ = "\\"

ELSEIF DirectionOld = 8 AND Direction = 7

  LET r$ = "/"

ELSE

  LET r$ = "."

ENDIF

PRINT AT LIN, COL; r$

END PROCEDURE

PROCEDURE PrintTrail

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

END PROCEDURE

PROCEDURE getDirectionTailOld1Version

LET c$ = SCREEN$(TailL,TailC)

IF DirectionTail = 5 AND c$ = "-" 

  LET DirectionTail = 5

ELSEIF DirectionTail = 5 AND c$ = "/"

  LET DirectionTail = 6

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

  LET DirectionTail = 7

ELSEIF DirectionTail = 6 AND c$ = "|"

  LET DirectionTail = 6

ELSEIF DirectionTail = 6 AND c$ = "/"

  LET DirectionTail = 5

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

  LET DirectionTail = 8

ELSEIF DirectionTail = 7 AND c$ = "|"

  LET DirectionTail = 7

ELSEIF DirectionTail = 7 AND c$ = "/"

  LET DirectionTail = 8

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

  LET DirectionTail = 5

ELSEIF DirectionTail = 8 AND c$ = "-"

  LET DirectionTail = 8

ELSEIF DirectionTail = 8 AND c$ = "/"

  LET DirectionTail = 7

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

  LET DirectionTail = 6

ENDIF

END PROCEDURE

PROCEDURE getDirectionTailOld2Version

LET c$ = SCREEN$(TailL,TailC)

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

END PROCEDURE

PROCEDURE getDirectionTail 

VAR c TYPE INTEGER

LET c = ATTR(TailL,TailC) - 56

LET DirectionTail = VAL TailDirection$(DirectionTail, c)

END PROCEDURE

PROCEDURE MoveForwardOldVersion

PrintTrail

REM move worm

IF Direction = 8 

  LET COL = COL+1

ELSEIF Direction = 5

  LET COL = COL-1

ELSEIF Direction = 7

  LET LIN = LIN-1

ELSE

  LET LIN = LIN+1

ENDIF

LET c$ = SCREEN$(LIN,COL)

IF c$ = " " 

  REM nothing ahead

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

  PRINT AT 22, 8; LengthCurrent

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

  REM steped on food

  LET LengthMax = LengthMax + VAL c$

  PRINT AT  LIN, COL; "o";

  BEEP .005,INT (30*RND)

ELSE

  PRINT AT  LIN, COL; "X"

  LET GAMEOVER = TRUE

ENDIF

LET DirectionOld = Direction

REM process Tail

IF LengthCurrent < LengthMax BEGIN w

  LET LengthCurrent = LengthCurrent+1

ELSE

  getDirectionTail

  PRINT AT TailL, TailC; " "

  IF DirectionTail = 6 

    LET TailL = TailL+1

  ELSEIF DirectionTail = 5

    LET TailC = TailC-1

  ELSEIF DirectionTail = 8

    LET TailC = TailC+1

  ELSEIF DirectionTail = 7

    LET TailL = TailL-1

  ENDIF

ENDIF

END PROCEDURE

PROCEDURE MoveForward

PrintTrail

REM move worm

LET LIN = LIN + DXY(Direction,DY)

LET COL = COL + DXY(Direction,DX)

LET c$ = SCREEN$(LIN,COL)

IF c$ = " " 

  REM nothing ahead

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

  PRINT AT 22, 8; LengthCurrent

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

  REM steped on food

  LET LengthMax = LengthMax + VAL c$

  PRINT AT  LIN, COL; "o";

  BEEP .01,INT (30*RND)

ELSE

  PRINT AT  LIN, COL; "X"

  LET GAMEOVER = TRUE

ENDIF

LET DirectionOld = Direction

REM process Tail

IF LengthCurrent < LengthMax 

  LET LengthCurrent = LengthCurrent+1

ELSE

  getDirectionTail

  PRINT AT TailL, TailC; " "

  LET TailL = TailL + DXY(DirectionTail,DY)

  LET TailC = TailC + DXY(DirectionTail,DX)

ENDIF

END PROCEDURE

PROCEDURE WaitClock

VAR elapsed TYPE INTEGER

REPEAT

  ScanKey

  LET Clock = PEEK 23672

  LET elapsed = Clock-Clock0

  IF elapsed<0 THEN LET elapsed = elapsed+256

UNTIL elapsed >= Period

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

REM PRINT AT 0,0;INK 2;elapsed;"  ";

END PROCEDURE

PROCEDURE WaitForPlayer

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

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

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

REPEAT 

  PAUSE 0

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

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

BEEP .1,20

LET Direction = VAL BUFFER$

LET DirectionOld = Direction

LET DirectionTail = Direction

LET Clock0 = PEEK 23672

PRINT AT 18,5;"                      "

PRINT AT 19,5;"                      "

END PROCEDURE

PROCEDURE InitGame

BORDER 7: PAPER 7: INK 0: CLS

REM horizontal frame

FOR i=0 TO 31

  REM  top frame

  PRINT AT  0, i; "#";

  REM  bottom frame

  PRINT AT  21, i; "#";

NEXT i

REM vertical frame

FOR i=0 TO 21

  REM  left frame

  PRINT AT  i, 0; "#";

  REM  right frame

  PRINT AT  i, 31; "#";

NEXT i

REM Titulos

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

PRINT AT 22, 0; "Length: ";

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

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

LET LIN = 10 : LET COL = 10

LET TailL = 10 : LET TailC = 10

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

LET Cook= 0

LET BUFFER$ = ""

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

LET LengthMax = 2 : LET LengthCurrent = 1

REM PRINT AT  1, 10; LengthCurrent

PRINT AT 22, 8; LengthCurrent

LET GAMEOVER = FALSE

END PROCEDURE

PROCEDURE Game

InitGame

WaitForPlayer

REPEAT 

  WaitClock

  LET key$ = GetKey

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

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

  MoveForward

  GiveFood

UNTIL GAMEOVER

TheEnd

END PROCEDURE

PROCEDURE DefineChars

VAR n TYPE INTEGER

REM RESTORE DataChars

READ BUFFER$

REPEAT 

  FOR i=0 TO 7

    READ n

    POKE USR BUFFER$+i,n

  NEXT i

  READ BUFFER$

UNTIL BUFFER$ = ""

END PROCEDURE

PROCEDURE DataChars

DATA "A"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11111111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "B"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA "C"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00011111

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "D"

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 11110000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA "E"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 11110000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA "F"

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00000000

DATA BIN 00011111

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA BIN 00010000

DATA ""

END PROCEDURE

PROCEDURE InitProg

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

LET Record = 0

DefineChars

REM automaton for PrintTrail

REM DIM Trail$(8,8)

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

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

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

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

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

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

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

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

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

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

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

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

REM automaton for getDirectionTail

REM DIM TailDirection$(8,4)

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

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

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

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

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

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

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

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

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

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

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

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

REM automaton for moveForward

REM DIM DXY(8,2)

LET DX = 1 : LET DY = 2

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

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

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

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

REM automaton for tail colors

REM DIM TailColor(150)

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

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

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

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

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

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

REM Table for accept 5678 qaop and arrows

REM DIM KeyMap$(128)

REM left

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

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

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

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

REM right

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

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

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

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

REM up

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

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

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

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

REM down

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

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

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

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

END PROCEDURE

PROCEDURE MainRoutine

InitProg

REPEAT 

  Game

UNTIL FALSE

END PROCEDURE

BEGIN

POKE 23739,244: REM restore messages

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

FOR j = 1 TO 3

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

NEXT j

PAUSE 2*50

MainRoutine

END

Pascalated ZX BASIC Demo #9 - 15

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

To run online, click here: RUN ONLINE

Code:
' PROGRAM 15

' (c) 2023 by Zarsoft

' Written by Ze Oliveira

' Demo for the Pascalated language

' Pascalated Sinclair BASIC (c) 1987 by ZarSoft

' Pascalated BASIC Converter (c) 2021 by Zarsoft

' Pascalated Boriel (c) 2023 by ZarSoft

' ZX BASIC Compiler (c) 2008 by Boriel

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

#include <screen.bas> ' SCREEN$ function

#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---

'#define CONST     CONST

#define VAR       DIM

#define INTEGER   LONG

#define REAL      FLOAT

#define CHAR      STRING

'#define STRING    STRING

#define BOOLEAN   UBYTE

#define TYPE      AS

'#define WHILE    WHILE

#define REPEAT    DO

#define UNTIL     LOOP UNTIL

#define PROCEDURE SUB

#define PROGRAM   REM

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

' CONSTant declarations

' VAR - Global variables

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

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

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

VAR Success TYPE BOOLEAN '--- board completed

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

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

VAR NewPositionL TYPE INTEGER 

VAR NewPositionC TYPE INTEGER 

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

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

PROCEDURE GameOver

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

PAUSE 50

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

PAUSE 0

END PROCEDURE

PROCEDURE ShowPosition

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

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

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

END PROCEDURE

PROCEDURE HidePosition

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

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

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

END PROCEDURE

PROCEDURE MovePiece

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

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

ShowPosition

LET PositionL = NewPositionL

LET PositionC = NewPositionC

HidePosition

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

END PROCEDURE

FUNCTION ReadKey TYPE INTEGER

REPEAT 

  PAUSE 0

  LET k$ = INKEY$

UNTIL k$ <> ""

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

BEEP .01,10

RETURN CODE k$

END FUNCTION

PROCEDURE ShowBoard

VAR bakL TYPE INTEGER

VAR bakC TYPE INTEGER

BORDER 1 : PAPER 1 : INK 7 : CLS

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

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

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

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

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

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

PAPER 0 : INK 7

REM backup vars because there is no local vars

LET bakL = PositionL

LET bakC = PositionC

REM show all positions

FOR L=1 TO 4

  FOR C=1 TO 4

    LET PositionL = L

    LET PositionC = C

    ShowPosition

  NEXT C

NEXT L

REM restore vars

LET PositionL = bakL

LET PositionC = bakC

HidePosition

REM shadow on the bottom

FOR C=1 TO 12

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

NEXT C

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

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

REM shadow on the right

FOR L=1 TO 12

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

NEXT L

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

END PROCEDURE

PROCEDURE InitVariables

LET PosL = 3

LET PosC = 5

REM Board

REM DIM Board$(4,4)

REM board for debug

LET Board$(1) = ".ABCD"

LET Board$(2) = ".EFGH"

LET Board$(3) = ".IJKL"

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

LET PositionL = 4

LET PositionC = 3

REM inverse order

LET Board$(1) = ". ONM"

LET Board$(2) = ".LKJI"

LET Board$(3) = ".HGFE"

LET Board$(4) = ".DCBA"

LET PositionL = 1

LET PositionC = 1

LET Success = FALSE

REM Table for keyboard conversion to make movements

REM DIM Table(128,2)

REM left

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

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

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

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

REM right

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

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

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

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

REM up

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

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

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

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

REM down

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

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

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

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

END PROCEDURE

PROCEDURE MainRoutine

InitVariables

ShowBoard

REPEAT 

  keycode = ReadKey

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

    LET NewPositionL = PositionL+Table(keycode,1)

    LET NewPositionC = PositionC+Table(keycode,2)

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

      MovePiece

    ENDIF

  ENDIF

UNTIL Success

GameOver

END PROCEDURE

PROGRAM Game15

MainRoutine

' last 2 lines are going to be deleted

PRINT AT 23,0;

END PROGRAM

ARRAY of STRING (solved)

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

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

Error: Invalid file name (solved)

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

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

Code:
SUB SaveImage 

DIM size AS LONG

size = 192*32+32*24

SAVE "image" CODE 16384,size

END SUB

SUB Run

SaveImage

END SUB

Run

Change RAMs on ZX Spectrum 128k

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

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

Pascalated ZX BASIC Demo #8 - Pong

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

To run online, click here: RUN ONLINE

Listing:

Code:
' PROGRAM Pong

' (c) 2023 by Zarsoft

' Written by Ze Oliveira

' Demo for the Pascalated language

' Pascalated Sinclair BASIC (c) 1987 by ZarSoft

' Pascalated BASIC Converter (c) 2021 by Zarsoft

' Pascalated Boriel (c) 2023 by ZarSoft

' ZX BASIC Compiler (c) 2008 by Boriel

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

#include <screen.bas> ' SCREEN$ function

#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---

'#define CONST     CONST

#define VAR       DIM

#define INTEGER   LONG

#define REAL      FLOAT

#define CHAR      STRING

'#define STRING    STRING

#define BOOLEAN   UBYTE

#define TYPE      AS

'#define WHILE    WHILE

#define REPEAT    DO

#define UNTIL     LOOP UNTIL

#define PROCEDURE SUB

#define PROGRAM   REM

CONST   TRUE      TYPE BOOLEAN = 1 

CONST   FALSE     TYPE BOOLEAN = 0 

' CONSTant declarations

CONST Period TYPE INTEGER = 8

' VAR - Global variables

VAR ScorePlayer TYPE INTEGER = 0

VAR ScoreComputer TYPE INTEGER = 0

VAR PlayerFirst TYPE BOOLEAN = TRUE

VAR Handicap TYPE INTEGER = 14

VAR Goal TYPE BOOLEAN

VAR ComputerPos TYPE INTEGER = 15

VAR PlayerPos TYPE INTEGER = 15

VAR BallLin TYPE INTEGER = 19-1

VAR BallCol TYPE INTEGER = PlayerPos

VAR DL TYPE INTEGER = -1

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

VAR Clock,Clock0 TYPE INTEGER

PROCEDURE GetReady

LET Goal = FALSE

IF BallLin = 2 THEN LET ScorePlayer = ScorePlayer+1

IF BallLin = 19 THEN LET ScoreComputer = ScoreComputer+1

PRINT AT 0,7;ScoreComputer

PRINT AT 21,7;ScorePlayer

IF BallLin = 2 

  LET PlayerFirst = TRUE

ELSEIF BallLin = 19

  LET PlayerFirst = FALSE

ENDIF

IF PlayerFirst 

  LET BallLin = 19-1

  LET BallCol = PlayerPos

  LET DL = -1

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

ELSE

  LET BallLin = 2+1

  LET BallCol = ComputerPos

  LET DL = 1

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

ENDIF

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

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

PRINT AT BallLin,BallCol;"\A"

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

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

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

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

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

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

END PROCEDURE

PROCEDURE DrawField

BORDER 0: PAPER 0: INK 7: CLS

LET Goal = FALSE

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

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

PRINT AT 1,0;"\ .";

PRINT AT 1,31;"\. ";

PRINT AT 20,0;"\ '";

PRINT AT 20,31;"\' ";

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

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

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

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

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

END PROCEDURE

FUNCTION GetKey$ TYPE CHAR

VAR result$ TYPE CHAR = ""

VAR key$ TYPE CHAR

VAR elapsed TYPE INTEGER

REPEAT 

  key$ = INKEY$

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

  LET Clock = PEEK 23672

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

UNTIL elapsed >= Period

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

RETURN result$

END FUNCTION

PROCEDURE WaitForUser

REPEAT 

  PAUSE 1

  LET k$ = INKEY$

UNTIL k$ = ""

PAUSE 0

BEEP .05,20

LET k$ = INKEY$

REM this give advantage; canceled

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

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

END PROCEDURE

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

PROCEDURE ProcessPlayer

  LET k$ = GetKey$

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

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

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

END PROCEDURE

PROCEDURE ProcessComputer

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

  IF ComputerPos < 3 THEN LET ComputerPos = 3

  IF ComputerPos > 28 THEN LET ComputerPos = 28

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

END PROCEDURE

PROCEDURE ProcessBall

  PRINT AT BallLin,BallCol;INK 6;" "

  LET BallCol = BallCol + DC

  LET BallLin = BallLin + DL

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

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

END PROCEDURE

PROCEDURE TestGameStatus

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

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

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

END PROCEDURE

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

PROCEDURE InitVariables

POKE 23609,50

LET Goal = FALSE

LET ComputerPos = 15

LET PlayerPos = 15

LET BallLin = 19-1

LET BallCol = PlayerPos

LET DL = -1

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

END PROCEDURE

PROCEDURE InitGraphics

REM \A

POKE USR "A"+0,BIN 00111100

POKE USR "A"+1,BIN 01111110

POKE USR "A"+2,BIN 11111111

POKE USR "A"+3,BIN 11111111

POKE USR "A"+4,BIN 11111111

POKE USR "A"+5,BIN 11111111

POKE USR "A"+6,BIN 01111110

POKE USR "A"+7,BIN 00111100

END PROCEDURE

PROCEDURE Game

LET Clock0 = PEEK 23672

REPEAT 

  ProcessPlayer

  ProcessComputer

  ProcessBall

  TestGameStatus

UNTIL Goal

END PROCEDURE

PROCEDURE MainRoutine

InitGraphics

InitVariables

DrawField

REPEAT 

  GetReady

  IF PlayerFirst THEN WaitForUser

  Game

UNTIL FALSE

END PROCEDURE

PROGRAM Pong

MainRoutine

' last 2 lines are going to be deleted

PRINT AT 23,0;

END PROGRAM

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?

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

Login
Username:
Password:	Lost Password?
	Remember me