To run online, click here: RUN ONLINE
Code:
' PROGRAM Memory
' (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 Memory
' CONSTant declarations
CONST npositions TYPE INTEGER = 15
CONST ncards TYPE INTEGER = 52
' VAR - Global variables
VAR DECK(52,2) TYPE INTEGER ' 52 cards, suit, value
VAR KEYMAP(128) TYPE INTEGER ' keyboard to card number
VAR numPairs TYPE INTEGER ' number of card pairs
VAR POSITION(20,3) TYPE INTEGER ' position and id of cards (lin, col, card)
VAR card1 TYPE INTEGER ' first selected card
VAR card2 TYPE INTEGER ' second selected card
VAR STATE TYPE INTEGER ' number of cards face-up
VAR v$ TYPE CHAR ' card value on top
VAR w$ TYPE CHAR ' card value on bottom
VAR s$ TYPE CHAR ' card suit on top
VAR t$ TYPE CHAR ' card suit on bottom
VAR KEYS$ TYPE STRING ' keys to identify cards
PROCEDURE RemoveCard (p TYPE INTEGER)
LET POSITION(p,3) = 0
POKE 23659,1: REM 23 lines
POKE 23606,88: POKE 23607,251: REM sprites
PRINT AT POSITION(p,1)+0,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2); PAPER 0;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2); PAPER 0;" ";
POKE 23606,0: POKE 23607,60: REM ZX Chars
POKE 23659,2: REM 22 lines
END PROCEDURE
PROCEDURE RemoveCards
FOR p=1 TO npositions
RemoveCard(p)
NEXT p
END PROCEDURE
PROCEDURE PrintBack (p TYPE INTEGER)
POKE 23659,1: REM 23 lines
POKE 23606,88: POKE 23607,251: REM sprites
PRINT AT POSITION(p,1)+0,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+1,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+2,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+3,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+4,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+5,POSITION(p,2); INK 1;".....";
PRINT AT POSITION(p,1)+6,POSITION(p,2); INK 1;".....";
POKE 23606,0: POKE 23607,60: REM ZX Chars
POKE 23659,2: REM 22 lines
END PROCEDURE
PROCEDURE PrintBacks
BORDER 0: PAPER 0: INK 7: CLS
PAPER 7: INK 2
FOR p=1 TO npositions
PrintBack(p)
BEEP .02,20*RND
NEXT p
END PROCEDURE
PROCEDURE PrintCard1 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" "+s$+" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard2 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard3 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard4 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard5 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard6 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard7 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard8 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";s$;" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";t$;" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard9 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;s$;s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;s$;s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;t$;t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard10 (p TYPE INTEGER)
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" ";
PRINT AT POSITION(p,1)+1,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+2,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+3,POSITION(p,2);" ";s$;" ";s$;" ";
PRINT AT POSITION(p,1)+4,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+5,POSITION(p,2);" ";t$;" ";t$;" ";
PRINT AT POSITION(p,1)+6,POSITION(p,2);" ";w$;
END PROCEDURE
PROCEDURE PrintCard11 (p TYPE INTEGER)
REM jack
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" /01";
PRINT AT POSITION(p,1)+1,POSITION(p,2);s$;" 234";
PRINT AT POSITION(p,1)+2,POSITION(p,2);"56789";
PRINT AT POSITION(p,1)+3,POSITION(p,2);":;<=>";
PRINT AT POSITION(p,1)+4,POSITION(p,2);"?@ABC";
PRINT AT POSITION(p,1)+5,POSITION(p,2);"DEF ";t$;
PRINT AT POSITION(p,1)+6,POSITION(p,2);"GHI ";w$;
END PROCEDURE
PROCEDURE PrintCard12 (p TYPE INTEGER)
REM queen
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" JKL";
PRINT AT POSITION(p,1)+1,POSITION(p,2);s$;" MNO";
PRINT AT POSITION(p,1)+2,POSITION(p,2);"PQRST";
PRINT AT POSITION(p,1)+3,POSITION(p,2);"UVWXY";
PRINT AT POSITION(p,1)+4,POSITION(p,2);"Z[\\]^";
PRINT AT POSITION(p,1)+5,POSITION(p,2);"_`a ";t$;
PRINT AT POSITION(p,1)+6,POSITION(p,2);"bcd ";w$;
END PROCEDURE
PROCEDURE PrintCard13 (p TYPE INTEGER)
REM king
PRINT AT POSITION(p,1)+0,POSITION(p,2);v$;" efg";
PRINT AT POSITION(p,1)+1,POSITION(p,2);s$;" hij";
PRINT AT POSITION(p,1)+2,POSITION(p,2);"klmno";
PRINT AT POSITION(p,1)+3,POSITION(p,2);"pqrst";
PRINT AT POSITION(p,1)+4,POSITION(p,2);"uvwxy";
PRINT AT POSITION(p,1)+5,POSITION(p,2);"z{| ";t$;
PRINT AT POSITION(p,1)+6,POSITION(p,2);"}~\* ";w$;
END PROCEDURE
PROCEDURE PrintCard (p TYPE INTEGER)
VAR card TYPE INTEGER
VAR suit TYPE INTEGER
VAR cor TYPE INTEGER
VAR value TYPE INTEGER
POKE 23659,1: REM 23 lines
POKE 23606,88: POKE 23607,251: REM sprites
LET card = POSITION(p,3)
LET suit = DECK(card,1)
LET cor = 2*(suit>2)
LET cor = 0
IF suit>2 THEN LET cor = 2
LET value=DECK(card,2)
LET s$ = CHR$ ( CODE ("\L") + 2*suit)
LET t$ = CHR$ ( CODE ("\L") + 2*suit+1)
LET v$ = CHR$ ( CODE ("\A") - 1+value)
LET w$ = CHR$ ( CODE (" ") + value)
INK cor
IF value = 1
PrintCard1(p)
ELSEIF value = 2
PrintCard2(p)
ELSEIF value = 3
PrintCard3(p)
ELSEIF value = 4
PrintCard4(p)
ELSEIF value = 5
PrintCard5(p)
ELSEIF value = 6
PrintCard6(p)
ELSEIF value = 7
PrintCard7(p)
ELSEIF value = 8
PrintCard8(p)
ELSEIF value = 9
PrintCard9(p)
ELSEIF value = 10
PrintCard10(p)
ELSEIF value = 11
PrintCard11(p)
ELSEIF value = 12
PrintCard12(p)
ELSEIF value = 13
PrintCard13(p)
ENDIF
POKE 23606,0: POKE 23607,60: REM ZX Chars
POKE 23659,2: REM 22 lines
END PROCEDURE
PROCEDURE PrintCards
FOR p=1 TO npositions
IF POSITION(p,3) > 0 THEN PrintCard(p)
NEXT p
END PROCEDURE
PROCEDURE DealCards
VAR randomCard TYPE INTEGER
VAR randomPosition TYPE INTEGER
VAR UsedCards(ncards) TYPE BOOLEAN
VAR card TYPE INTEGER
PRINT AT 23,10;PAPER 0;"Please wait";
BEEP .05,20
PAUSE 25
'FOR i = 1 TO ncards
' UsedCards(i) = FALSE
'NEXT i'
LET numPairs = INT(npositions/2)
'DIM UsedCards(ncards)
FOR p=1 TO numPairs
REM LET POSITION(p,3)=1+INT (ncards*RND)
REPEAT
LET randomCard = 1+INT (ncards*RND)
UNTIL UsedCards(randomCard ) = FALSE
LET UsedCards(randomCard ) = TRUE
REM Place card
REPEAT
LET randomPosition = 1+INT (npositions*RND)
UNTIL POSITION(randomPosition,3) = 0
LET POSITION(randomPosition,3) = randomCard
REM Place other card
REPEAT
LET randomPosition = 1+INT (npositions*RND)
UNTIL POSITION(randomPosition,3) = 0
LET POSITION(randomPosition,3) = randomCard
NEXT p
' remove position card not used
LET card = 0
REPEAT
LET card = card + 1
UNTIL POSITION(card,3) = 0
RemoveCard(card)
PRINT AT 23,10;PAPER 0;" ";
END PROCEDURE
PROCEDURE testPair
IF POSITION(card1,3) <> POSITION(card2,3)
PrintBack(card1)
PrintBack(card2)
ELSE
LET numPairs = numPairs - 1
RemoveCard(card1)
RemoveCard(card2)
FOR i = 1 TO 20 STEP 10: BEEP .02,20: BEEP .02,20*RND: NEXT i
ENDIF
END PROCEDURE
PROCEDURE Success
PAPER 0: INK 4: CLS
REM PRINT AT 10,10; "SUCCESS!"
PRINT AT 8,1; "\::\::\:: \:: \:: \::\::\:: \::\::\:: \::\::\:: \::\::\:: \::\::\:: \::"
PRINT AT 9,1; "\:: \:: \:: \:: \:: \:: \:: \:: \::"
PRINT AT 10,1; "\::\::\:: \:: \:: \:: \:: \::\::\:: \::\::\:: \::\::\:: \::"
PRINT AT 11,1; " \:: \:: \:: \:: \:: \:: \:: \::"
PRINT AT 12,1; "\::\::\:: \::\::\:: \::\::\:: \::\::\:: \::\::\:: \::\::\:: \::\::\:: \::"
FOR i = 1 TO 20: BEEP .02,i: BEEP .02,20*RND: NEXT i
PAUSE 5*50
END PROCEDURE
PROCEDURE PrintIndex
POKE 23659,1: REM 23 lines
FOR p = 1 TO npositions
PRINT AT POSITION(p,1)+6,POSITION(p,2)-1; PAPER 0; INK 1;KEYS$(p);
NEXT p
POKE 23659,2: REM 22 lines
END PROCEDURE
PROCEDURE InitVariables
VAR c TYPE INTEGER
VAR s TYPE INTEGER
VAR v TYPE INTEGER
REM keyboard index
POKE 23658,8: REM upper case
LET KEYS$="X12345QWERTASDFG"
LET j$="12345qwertasdfg"
REM keymap - keyboard to card number
'DIM KEYMAP(128)
LET KEYMAP( CODE "1")=1
LET KEYMAP( CODE "2")=2
LET KEYMAP( CODE "3")=3
LET KEYMAP( CODE "4")=4
LET KEYMAP( CODE "5")=5
LET KEYMAP( CODE "Q")=6
LET KEYMAP( CODE "W")=7
LET KEYMAP( CODE "E")=8
LET KEYMAP( CODE "R")=9
LET KEYMAP( CODE "T")=10
LET KEYMAP( CODE "A")=11
LET KEYMAP( CODE "S")=12
LET KEYMAP( CODE "D")=13
LET KEYMAP( CODE "F")=14
LET KEYMAP( CODE "G")=15
REM deck
'DIM DECK(52,2) ' 52 cards, suit, value
LET c=0
FOR s=1 TO 4
FOR v=1 TO 13
LET c=c+1
LET DECK(c,1) = s: LET DECK(c,2) = v
NEXT v
NEXT s
'LET ncards = c
REM positions
' DIM POSITION(20,3): REM (lin, col, card)
REM part 1
LET POSITION(1,1)=0: LET POSITION(1,2)=1
LET POSITION(2,1)=0: LET POSITION(2,2)=7
LET POSITION(3,1)=0: LET POSITION(3,2)=13
LET POSITION(4,1)=0: LET POSITION(4,2)=19
LET POSITION(5,1)=0: LET POSITION(5,2)=25
REM part 2
LET POSITION(6,1)=8: LET POSITION(6,2)=1
LET POSITION(7,1)=8: LET POSITION(7,2)=7
LET POSITION(8,1)=8: LET POSITION(8,2)=13
LET POSITION(9,1)=8: LET POSITION(9,2)=19
LET POSITION(10,1)=8: LET POSITION(10,2)=25
REM part 3
LET POSITION(11,1)=16: LET POSITION(11,2)=1
LET POSITION(12,1)=16: LET POSITION(12,2)=7
LET POSITION(13,1)=16: LET POSITION(13,2)=13
LET POSITION(14,1)=16: LET POSITION(14,2)=19
LET POSITION(15,1)=16: LET POSITION(15,2)=25
LET STATE = 0 : REM 0: 0 cards face-up, 1: 1 card face-up
LET card1 = 0 : REM first card selected
LET card2 = 0 : REM second card selected
END PROCEDURE
PROCEDURE Game
VAR p TYPE INTEGER
VAR legal TYPE BOOLEAN
PrintBacks
DealCards
REM POKE 23659,1
PrintIndex
REM PrintCards
FOR i = 1 TO 20 STEP 5: BEEP .02,i: BEEP .02,20*RND: NEXT i
REPEAT
PAUSE 0: LET k$=INKEY$: BEEP .1,20
IF k$<>""
LET p = KEYMAP( CODE k$)
LET legal = TRUE
IF p = 0 THEN LET legal = FALSE
IF legal THEN IF POSITION(p,3) = 0 THEN LET legal = FALSE
IF legal
IF STATE = 0
LET card1 = p : PrintCard(p)
LET STATE = 1
ELSEIF STATE = 1 and p <> card1
LET card2 = p : PrintCard(p)
pause 1*50
testPair
LET STATE = 0
ENDIF
ENDIF
ENDIF
UNTIL numPairs = 0
Success
END PROCEDURE
PROCEDURE WaitForUser
CLS
PRINT AT 11,5; INK 3; "PRESS ANY KEY TO START"
BEEP .05,20
PAUSE 0
PRINT AT 11,5; INK 3; " Shuffling Deck... "
RANDOMIZE
BEEP .1,20
PAUSE 25
END PROCEDURE
PROCEDURE LoadSprites
PRINT AT 18,0;
LOAD "sprites" CODE 64600
END PROCEDURE
PROCEDURE SaveSprites
SAVE "sprites" CODE 64600,2^16-64600
END PROCEDURE
PROCEDURE Main
' LoadSprites
WaitForUser
InitVariables
REPEAT
Game
UNTIL FALSE
END PROCEDURE
BEGIN
REM CLEAR 64599
REM PRINT "Demo for Pascalated BASIC"
POKE 23606,0: POKE 23607,60: REM ZX Chars
PRINT AT 0,0;"Starsoft presents"
BEEP .05,20
PAUSE 50
PRINT "Memory"'''
BEEP .05,20
PAUSE 50
Main
END