Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pascalated ZX BASIC Demo #15 - River Crossing
#1
To run online, click here: RUN ONLINE



Code:
' PROGRAM River Crossing
' (c) ZarSoft 2022 Pascalated BASIC
' (c) ZarSoft 2023 Pascalated Boriel ZX BASIC
' Written by Ze Oliveira
' 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 RiverCrossing

' CONSTant declarations
CONST black = 0
CONST blue = 1
CONST green = 4
CONST white = 7

' VARiables
VAR CharsOK TYPE BOOLEAN = FALSE
VAR abort TYPE BOOLEAN
VAR TheEnd TYPE BOOLEAN
VAR Weight$(3) ' Weights of 3 positions ( X 3 animals )
VAR Sprite$(3,3) ' sprites of 3 animals X 3 lines ( X 3 chars )
VAR Location$(3,3,3) ' sprites in 3 positions of 3 animals X 3 lines ( X 3 chars )
VAR position TYPE INTEGER

PROCEDURE RefreshDisplay
REM Location 1 (left)
PRINT AT 16,0;Location$(1,1,1);Location$(1,2,1);Location$(1,3,1);
PRINT AT 17,0;Location$(1,1,2);Location$(1,2,2);Location$(1,3,2);
PRINT AT 18,0;Location$(1,1,3);Location$(1,2,3);Location$(1,3,3);
REM Location 2 (boat)
LET c = 9+1
IF position = 3 THEN LET c = 12+1
PRINT AT 16,c;Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);
PRINT AT 17,c;Location$(2,1,2);Location$(2,2,2);Location$(2,3,2);
PRINT AT 18,c;Location$(2,1,3);Location$(2,2,3);Location$(2,3,3);
REM Location 3 (right)
PRINT AT 16,23;Location$(3,1,1);Location$(3,2,1);Location$(3,3,1);
PRINT AT 17,23;Location$(3,1,2);Location$(3,2,2);Location$(3,3,2);
PRINT AT 18,23;Location$(3,1,3);Location$(3,2,3);Location$(3,3,3);
END PROCEDURE

PROCEDURE MoveBoat
IF position = 1
  FOR c = 9 TO 11
    PRINT AT 19,c;PAPER 5;" ";PAPER 0;INK 5;"\U         \C";
    PRINT AT 18,c;"  ";Location$(2,1,3);Location$(2,2,3);Location$(2,3,3);
    PRINT AT 17,c;"  ";Location$(2,1,2);Location$(2,2,2);Location$(2,3,2);
    PRINT AT 16,c;"  ";Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);
    BEEP .01,20*RND
  NEXT c
ELSE
  FOR c = 11 TO 9 STEP -1
    PRINT AT 19,c;PAPER 0;INK 5;"\U         \C";PAPER 5;" ";
    PRINT AT 18,c;" ";Location$(2,1,3);Location$(2,2,3);Location$(2,3,3);" ";
    PRINT AT 17,c;" ";Location$(2,1,2);Location$(2,2,2);Location$(2,3,2);" ";
    PRINT AT 16,c;" ";Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);" ";
    BEEP .01,20*RND
  NEXT c
ENDIF
LET position = 4-position
END PROCEDURE

PROCEDURE Sink
LET c = 9+1
IF position = 3 THEN LET c = 12+1
REM frame 1
PRINT AT 19,c-1;" ";Location$(2,1,3);Location$(2,2,3);Location$(2,3,3);" ";
PRINT AT 18,c;Location$(2,1,2);Location$(2,2,2);Location$(2,3,2);
PRINT AT 17,c;Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);
PRINT AT 16,c;"         ";
BEEP .01,20*RND
PAUSE 10
REM frame 2
PRINT AT 19,c;Location$(2,1,2);Location$(2,2,2);Location$(2,3,2);
PRINT AT 18,c;Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);
PRINT AT 17,c;"         ";
BEEP .01,20*RND
PAUSE 10
REM frame 3
PRINT AT 19,c;Location$(2,1,1);Location$(2,2,1);Location$(2,3,1);
PRINT AT 18,c;"         ";
PAUSE 10
REM frame 4
PRINT AT 19,c;"         ";
BEEP .01,20*RND
PAUSE 10
END PROCEDURE

PROCEDURE finalization
PRINT AT 7,8;"CONGRATULATIONS!"
PRINT AT 9,8;INK 1;"Press any key.";
: FOR i=-11 TO 11: BEEP .01,i: BEEP .01,ABS(i): NEXT i
PAUSE 5*50
END PROCEDURE

PROCEDURE CheckTheEnd
IF Weight$(3) = ".XXX"
  LET TheEnd = TRUE
ELSEIF (Weight$(2) = ".XXX") OR (Weight$(2) = ".X X")
  LET abort = TRUE
  PRINT AT 7,8;INK 1;"TOO MUCH WEIGHT!"
  Sink
  : FOR i=11 TO 0 STEP -1: BEEP .01,i+2: BEEP .01,i: NEXT i
  PRINT AT 9,3;INK 1;"Try again. Press any key.";
  PAUSE 5*50
ELSEIF (Weight$(1) = ". XX") OR (Weight$(1) = ".XX ") OR (Weight$( 2) = ". XX") OR (Weight$( 2) = ".XX ") OR (Weight$( 3) = ". XX") OR (Weight$( 3) = ".XX ")
  LET abort = TRUE
  PRINT AT 7,8;INK 1;"Yum! Yum! Yum!";
  : FOR i=11 TO 0 STEP -1: BEEP .01,i+2: BEEP .01,i: NEXT i
  PRINT AT 9,8;INK 1;"Press any key.";
  PAUSE 5*50
ENDIF
PRINT AT 7,0;"                                              ";
PRINT AT 9,0;"                                              ";
END PROCEDURE

PROCEDURE PutIntoBoat (animal)
IF Weight$(position)(animal) <> " "
  REM Weights
  LET Weight$(position)(animal) = " "
  LET Weight$(2)(animal) = "X"
  REM sprites
  LET Location$(position,animal,1) = "   "
  LET Location$(position,animal,2) = "   "
  LET Location$(position,animal,3) = "   "
  LET Location$(2,animal,1) = Sprite$(animal,1)
  LET Location$(2,animal,2) = Sprite$(animal,2)
  LET Location$(2,animal,3) = Sprite$(animal,3)
  RefreshDisplay
ENDIF
END PROCEDURE

PROCEDURE TakeOutOfBoat (animal)
IF Weight$(2)(animal) <> " "
  REM Weights
  LET Weight$(2)(animal) = " "
  LET Weight$(position)(animal) = "X"
  REM sprites
  LET Location$(2,animal,1) = "   "
  LET Location$(2,animal,2) = "   "
  LET Location$(2,animal,3) = "   "
  LET Location$(position,animal,1) = Sprite$(animal,1)
  LET Location$(position,animal,2) = Sprite$(animal,2)
  LET Location$(position,animal,3) = Sprite$(animal,3)
  RefreshDisplay
ENDIF
END PROCEDURE

PROCEDURE PutOrTake
VAR animal TYPE INTEGER
REM --- TAKE OUT ---
LET k$="1": REM dummy key just to enter cycle
WHILE (Weight$(2) <> ".   ") AND (k$ >= "1" AND k$ <= "3")
  PRINT AT 9,8;INK 1;"TAKE OUT OF BOAT ?";
  PAUSE 0: LET k$ = INKEY$: BEEP .1,5
  IF k$ >= "1" AND k$ <= "3" THEN  LET animal = CODE(k$)-CODE("0"): TakeOutOfBoat(animal)
END WHILE
REM --- PUT INTO ---
LET k$="1": REM dummy key just to enter cycle
WHILE (Weight$(3) <> ".XXX") AND (Weight$(position) <> ".   ") AND (k$ >= "1" AND k$ <= "3")
  PRINT AT 9,8;INK 1;"PUT INTO BOAT ?   ";
  PAUSE 0: LET k$ = INKEY$: BEEP .1,5
  IF k$ >= "1" AND k$ <= "3" THEN LET animal = CODE(k$)-CODE("0"): PutIntoBoat(animal)
END WHILE
PRINT AT 9,8;"                  ";
END PROCEDURE

PROCEDURE ShowStartAnimals
PRINT AT 16,0;" \A\B\H\I\J   ";
PRINT AT 17,0;" \C\D\K\L\M  \Q";
PRINT AT 18,0;"\E\F\G\N\O\P\R\S\T";
PRINT AT 19,12;PAPER 0;INK 5;"\U         \C";
END PROCEDURE

PROCEDURE inicialization
REM Weights on the 3 positions
' DIM Weight$(3,3): REM Weights on 3 positions X 3 animals
LET Weight$(1) = ".XXX"
LET Weight$(2) = ".   "
LET Weight$(3) = ".   "
REM sprites of the 3 animals
' DIM Sprite$(3,3,3): REM sprites of 3 animals X 3 lines X 3 chars
REM Dog
LET Sprite$(1,1) = " \A\B"
LET Sprite$(1,2) = " \C\D"
LET Sprite$(1,3) = "\E\F\G"
REM Cat
LET Sprite$(2,1) = "\H\I\J"
LET Sprite$(2,2) = "\K\L\M"
LET Sprite$(2,3) = "\N\O\P"
REM mouse
LET Sprite$(3,2) = "  \Q"
LET Sprite$(3,3) = "\R\S\T"
REM sprites on the 3 positions
' DIM Location$(3,3,3,3): REM sprites in 3 positions of 3 animals X 3 lines X 3 chars
' LOCATION 1 (start)
REM Dog
LET Location$(1,1,1) = Sprite$(1,1)
LET Location$(1,1,2) = Sprite$(1,2)
LET Location$(1,1,3) = Sprite$(1,3)
REM Cat
LET Location$(1,2,1) = Sprite$(2,1)
LET Location$(1,2,2) = Sprite$(2,2)
LET Location$(1,2,3) = Sprite$(2,3)
REM Mouse
LET Location$(1,3,1) = Sprite$(3,1)
LET Location$(1,3,2) = Sprite$(3,2)
LET Location$(1,3,3) = Sprite$(3,3)
' CLEAR LOCATION 2 (boat) and 3 (finish)
FOR i = 2 TO 3 ' location
  FOR j = 1 TO 3 ' animal
    FOR k = 1 TO 3 ' store
      LET Location$(i,j,k) = "   "
    NEXT k
  NEXT j
NEXT i
' extra
LET TheEnd = FALSE
LET abort = FALSE
LET position = 3: REM other side of the river
END PROCEDURE

PROCEDURE DefineChars
' RESTORE Sprites
READ b$
REPEAT
  FOR i=0 TO 7
    READ n
    POKE USR b$+i,n
  NEXT i
  ShowStartAnimals
  ' PAUSE 20
  READ b$
UNTIL b$ = ""
LET CharsOK = true
END PROCEDURE

PROCEDURE Sprites
REM Dog
REM  \A\B
REM  \C\D
REM \E\F\G
REM Cat
REM H\I\J
REM \K\L\M
REM \N\O\P
REM mouse
REM   \Q
REM \R\S\T
REM boat
REM \C\U
END PROCEDURE

PROCEDURE SpriteDog
DATA "A"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000001
DATA BIN 00000001
DATA BIN 00000001
DATA BIN 00000001
DATA "B"
DATA BIN 00000000
DATA BIN 10000000
DATA BIN 10000000
DATA BIN 11100000
DATA BIN 11111000
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111110
DATA "C"
DATA BIN 00000011
DATA BIN 00000011
DATA BIN 00000111
DATA BIN 00001111
DATA BIN 00011111
DATA BIN 00111111
DATA BIN 01111111
DATA BIN 11111111
DATA "D"
DATA BIN 11111000
DATA BIN 11110000
DATA BIN 11110000
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 11110000
DATA "E"
DATA BIN 00000001
DATA BIN 00000001
DATA BIN 00000011
DATA BIN 11000011
DATA BIN 11000011
DATA BIN 11100011
DATA BIN 01111111
DATA BIN 00111111
DATA "F"
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111101
DATA BIN 11111101
DATA BIN 11111110
DATA BIN 11111111
DATA "G"
DATA BIN 11100000
DATA BIN 11000000
DATA BIN 11000000
DATA BIN 10000000
DATA BIN 10000000
DATA BIN 11000000
DATA BIN 11000000
DATA BIN 01100000
END PROCEDURE

PROCEDURE SpriteCat
DATA "H"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00001110
DATA BIN 00010011
DATA "I"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000001
DATA "J"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00100000
DATA BIN 01100000
DATA BIN 11110000
DATA BIN 11110000
DATA "K"
DATA BIN 00000001
DATA BIN 00000001
DATA BIN 00000001
DATA BIN 00000011
DATA BIN 00000010
DATA BIN 00000110
DATA BIN 00001100
DATA BIN 00011001
DATA "L"
DATA BIN 00000011
DATA BIN 00000011
DATA BIN 00000111
DATA BIN 00111111
DATA BIN 01111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA "M"
DATA BIN 11111000
DATA BIN 11111000
DATA BIN 11110000
DATA BIN 11100000
DATA BIN 11100000
DATA BIN 11100000
DATA BIN 11100000
DATA BIN 11100000
DATA "N"
DATA BIN 00010001
DATA BIN 00010001
DATA BIN 00011001
DATA BIN 00001101
DATA BIN 00001111
DATA BIN 00000111
DATA BIN 00000011
DATA BIN 00000001
DATA "O"
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111100
DATA "P"
DATA BIN 11000000
DATA BIN 10000000
DATA BIN 10000000
DATA BIN 10000000
DATA BIN 10000000
DATA BIN 11000000
DATA BIN 11000000
DATA BIN 11100000
END PROCEDURE

PROCEDURE SpriteMouse
DATA "Q"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 01100000
DATA "R"
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 01111000
DATA BIN 00000111
DATA "S"
DATA BIN 00000000
DATA BIN 00001111
DATA BIN 00011111
DATA BIN 00011111
DATA BIN 00111111
DATA BIN 00111111
DATA BIN 01111111
DATA BIN 11111111
DATA "T"
DATA BIN 01111100
DATA BIN 11111110
DATA BIN 11111100
DATA BIN 11110000
DATA BIN 11100000
DATA BIN 11000000
DATA BIN 01000000
DATA BIN 00100000
END PROCEDURE

PROCEDURE SpriteBoat
DATA "U"
DATA BIN 10000000
DATA BIN 11000000
DATA BIN 11100000
DATA BIN 11110000
DATA BIN 11111000
DATA BIN 11111100
DATA BIN 11111110
DATA BIN 11111111
END PROCEDURE

PROCEDURE SpritesEnd
DATA ""
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00000000
DATA ""
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
DATA BIN 11111111
END PROCEDURE

PROCEDURE ShowBackground
REM green
PRINT AT 19,0;PAPER 4;" ";TAB 31;" ";TAB 31;" ";TAB 31;" ";
REM Space for boat
PRINT AT 19,9;PAPER 5;" ";TAB 22;" "
REM River
PRINT AT 20,9;PAPER 1;" ";TAB 22;" "
PRINT AT 21,9;PAPER 1;" ";TAB 22;" "
REM Boat
PRINT AT 19,12;PAPER 0;" ";TAB 18;" "
REM keys
PRINT AT 22,0;PAPER green;" ";TAB 0;PAPER green;"1,2,3 - Take/Put   SPACE - Cross";
END PROCEDURE

PROCEDURE introduction
BORDER 5: PAPER 5: INK 2: CLS
PRINT AT 0,7;INK 2;"THE RIVER CROSSING"
PRINT AT 4,0;INK 1;"You have a mouse, a cat and"
PRINT AT 5,0;INK 1;"a dog..."
PRINT AT 7,0;INK 1;"CROSS THE RIVER..."
PRINT AT 9,0;INK 1;"But don't let them"
PRINT AT 10,0;INK 1;"eat each other!"
END PROCEDURE

PROCEDURE Main
introduction
ShowBackground
IF NOT CharsOK THEN DefineChars
PAUSE 5*50
PRINT AT 4,0;" ",,,,,,,,,,,,," " : REM clean introduction
REPEAT
  inicialization
  RefreshDisplay
  MoveBoat
  REPEAT
    PutOrTake
    IF NOT(abort) THEN MoveBoat
    CheckTheEnd
  UNTIL abort OR TheEnd
UNTIL TheEnd
finalization
END PROCEDURE

PROGRAM RiverCrossing
PRINT
PRINT "Pascalated Boriel ZX BASIC demo"
PAUSE 1*50
Main
END PROGRAM
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)