To run online, click here: RUN ONLINE
I modified the loader to RUN again more easily.
Listing:
I modified the loader to RUN again more easily.
Code:
10 REM loader
30 RANDOMIZE USR 40000
40 STOP
90 :
100 REM Loaded compiled code
110 CLEAR 39999
120 LOAD "" CODE
130 RUNListing:
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