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


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 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
Reply


Messages In This Thread
Pascalated ZX BASIC Demo #7 - 4 In A Line - by zarsoft - 03-04-2023, 01:35 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)