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



Code:
' PROGRAM Hangman
' (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 Hangman

' CONSTant declarations
CONST LastLine = 12
CONST MaxLen = 11

' VARiables
VAR NumWords TYPE INTEGER ' 29
VAR Score = 0 ' score
VAR Total = 0 ' total of games
VAR DataBuild(10,4) TYPE INTEGER ' gallows and body design
VAR MaxPieces TYPE INTEGER ' Hang and body pieces
VAR Success TYPE BOOLEAN
VAR Hanged TYPE BOOLEAN
VAR Npieces TYPE INTEGER
VAR Nchars TYPE INTEGER
VAR Xkeymap(26) TYPE INTEGER
VAR Ykeymap(26) TYPE INTEGER
VAR key$ TYPE CHAR
VAR AnotherGame TYPE BOOLEAN
VAR Word$ TYPE STRING
VAR LenWord TYPE INTEGER

PROCEDURE DataWords
REM  "12345678901"
DATA "ADAPTER"
DATA "ALGORITHM"
DATA "ASSEMBLER"
DATA "ASSEMBLY"
DATA "AUDIO"
DATA "BASIC"
DATA "BOARD"
DATA "BRIGHTNESS"
DATA "BROWSER"
DATA "CALCULATION"
DATA "CALCULATOR"
DATA "CARTRIDGE"
DATA "CASSETTE"
DATA "CHARACTER"
DATA "CIRCUIT"
DATA "COLOR"
DATA "COMMAND"
DATA "COMPILER"
DATA "COMPUTER"
DATA "DATABASE"
DATA "DESIGN"
DATA "DISK"
DATA "DISPLAY"
REM  "DISTRIBUTION"
DATA "DRIVER"
DATA "DYNAMIC"
DATA "EARTH"
DATA "ELECTRICITY"
DATA "ELECTRONIC"
DATA "EMULATOR"
DATA "EXPANSION"
DATA "EXPRESSION"
DATA "EXTERNAL"
DATA "FIRMWARE"
DATA "FLASH"
DATA "FLOPPY"
DATA "FLUXOGRAM"
DATA "FUTURE"
DATA "GENERATOR"
DATA "GOOGLE"
DATA "GRAPHIC"
DATA "HARDWARE"
DATA "HUMANITY"
DATA "INPUT"
DATA "INTEGER"
REM  "INTELLIGENCE"
DATA "INTERFACE"
DATA "INTERNAL"
DATA "INTERNET"
DATA "INTERPRETER"
DATA "ITERATION"
DATA "JOYSTICK"
DATA "KEYBOARD"
DATA "KEYWORD"
DATA "LOADING"
DATA "MAGAZINE"
DATA "MANUAL"
DATA "MEMORY"
DATA "MICRODRIVE"
REM  "MICROPROCESSOR"
DATA "MICROSOFT"
DATA "MNEMONIC"
DATA "MOTHERBOARD"
DATA "MONITOR"
DATA "MOUSE"
DATA "NUMBER"
DATA "OPERATION"
DATA "OUTPUT"
DATA "PARADISE"
DATA "PASCAL"
DATA "PASSWORD"
DATA "PIRACY"
DATA "PLATFORM"
DATA "PORTUGAL"
DATA "POWER"
DATA "PRINTER"
DATA "PROCESSOR"
DATA "PROGRAM"
DATA "RANDOM"
DATA "REAL"
DATA "RESOLUTION"
DATA "RESTART"
DATA "REVISION"
DATA "ROBOT"
DATA "SAVING"
DATA "SCROLL"
DATA "SHUTDOWN"
DATA "SINCLAIR"
DATA "SOFTWARE"
DATA "SOUND"
DATA "SPEAKER"
DATA "SPECTRUM"
DATA "SPREADSHEET"
DATA "STATIC"
DATA "STRING"
DATA "STORAGE"
DATA "TECHNOLOGY"
DATA "TELEVISION"
REM  "UNIORDER"
DATA "UNIX"
DATA "UPGRADE"
DATA "USERNAME"
DATA "VIDEO"
DATA "VIRUS"
DATA "VOLTAGE"
DATA "WIKIPEDIA"
DATA "WINDOWS"
DATA "YOUTUBE"
DATA "ZILOG"
DATA ""
REM  "12345678901"
END PROCEDURE

PROCEDURE ClearKeyboard
FOR j=20 TO 13 STEP -1
  PRINT AT j,5;PAPER 4;"                    ";
NEXT j
END PROCEDURE

PROCEDURE ShowCrowd
FOR k=1 TO LenWord
  PRINT PAPER 8;AT 10,8+2*k;"\A"
  PRINT PAPER 8;AT 11,8+2*k;"\B"
  PRINT PAPER 8;AT 12,8+2*k;"\C"
NEXT k
END PROCEDURE

PROCEDURE ReadChar
: FOR h=10 TO -10 STEP -2 : BEEP .006,h : NEXT h
REPEAT
  REPEAT
    PAUSE 0
    LET key$ = INKEY$
    'PRINT key$
  UNTIL key$ <> ""
  IF key$ > "Z" THEN LET key$ = CHR$( CODE(key$)+CODE("A")-CODE("a") )
UNTIL key$ >= "A" AND key$ <= "Z"
: FOR h=-2 TO 2 STEP 2 : BEEP .006,h : NEXT h
RANDOMIZE
END PROCEDURE

PROCEDURE ShowChar (k TYPE INTEGER)
PRINT PAPER 1;INK 7;AT 9,8+2*k;key$
PRINT PAPER 8;AT 10,8+2*k;"\D"
PRINT PAPER 8;AT 11,8+2*k;"\E"
PRINT PAPER 8;AT 12,8+2*k;"\F"
END PROCEDURE

PROCEDURE Congratulations
VAR h TYPE INTEGER
ClearKeyboard
PRINT AT 4,10;PAPER 5;INK 2;"Congratulations!"
: FOR h=-2 TO 2 STEP 1 : BEEP .1,h : NEXT h
END PROCEDURE

PROCEDURE Hang
VAR k TYPE INTEGER
ClearKeyboard
PRINT AT 4,10;PAPER 5;INK 2;"You lost!"
REM open floor
FOR k = 1 TO 12
  INVERSE 1
  PLOT 36,86+16 : DRAW 12-(k-1), -(k-1)
  INVERSE 0
  PLOT 36,86+16 : DRAW 12-k, -k
  PAUSE 2
NEXT k
REM join legs
FOR k = 6 TO 0 STEP -1
  REM left leg
  INVERSE 1
  PLOT 42,97+16 : DRAW -(k+1), -14+INT ((k+1)/2)
  INVERSE 0
  PLOT 42,97+16 : DRAW -k, -14+INT (k/2)
  REM right leg
  INVERSE 1
  PLOT 44,97+16 : DRAW (k+1), -14+INT ((k+1)/2)
  INVERSE 0
  PLOT 44,97+16 : DRAW k, -14+INT (k/2)
  PAUSE 2
NEXT k
REM join arms
FOR k = 10 TO 0 STEP -1
  REM left arm
  INVERSE 1
  PLOT 42,111+16 : DRAW -(k+1), (k+1)-10
  INVERSE 0
  PLOT 42,111+16 : DRAW -k, k-10
  REM right arm
  INVERSE 1
  PLOT 44,111+16 : DRAW (k+1), (k+1)-10
  INVERSE 0
  PLOT 44,111+16 : DRAW k, k-10
  PAUSE 2
NEXT k
BEEP .5,0 : PAUSE 20 : BEEP .5,0 : PAUSE 20 : BEEP .25,0 : PAUSE 2 : BEEP 1,0
END PROCEDURE

PROCEDURE Build
VAR x1,y1,x2,y2 TYPE INTEGER
'RESTORE
'READ x1,y1,x2,y2
LET x1 = DataBuild(Npieces,1)
LET y1 = DataBuild(Npieces,2)
LET x2 = DataBuild(Npieces,3)
LET y2 = DataBuild(Npieces,4)
LET y1=176-y1+16
LET y2=176-y2+16
PAPER 5
IF y2 > 176
  CIRCLE x1,y1,x2
ELSE
  PLOT x1,y1
  DRAW x2-x1,y2-y1
ENDIF
END PROCEDURE

PROCEDURE InitDataBuild
'VAR DataBuild(10,4) TYPE INTEGER ' Hang and body design
REM vertical
DataBuild(1,1) = 17
DataBuild(1,2) = 103
DataBuild(1,3) = 17
DataBuild(1,4) = 42
REM horizontal
DataBuild(2,1) = 17
DataBuild(2,2) = 42
DataBuild(2,3) = 43
DataBuild(2,4) = 42
REM diagonal
DataBuild(3,1) = 18
DataBuild(3,2) = 52
DataBuild(3,3) = 27
DataBuild(3,4) = 43
REM rope
DataBuild(4,1) = 43
DataBuild(4,2) = 52
DataBuild(4,3) = 43
DataBuild(4,4) = 42
REM head
DataBuild(5,1) = 43
DataBuild(5,2) = 57
DataBuild(5,3) = 5
DataBuild(5,4) = -1
REM tors
DataBuild(6,1) = 43
DataBuild(6,2) = 62
DataBuild(6,3) = 43
DataBuild(6,4) = 78
REM left arm
DataBuild(7,1) = 43
DataBuild(7,2) = 65
DataBuild(7,3) = 33
DataBuild(7,4) = 65
REM right arm
DataBuild(8,1) = 43
DataBuild(8,2) = 65
DataBuild(8,3) = 53
DataBuild(8,4) = 65
REM left leg
DataBuild(9,1) = 43
DataBuild(9,2) = 78
DataBuild(9,3) = 37
DataBuild(9,4) = 90
REM right leg
DataBuild(10,1) = 43
DataBuild(10,2) = 78
DataBuild(10,3) = 49
DataBuild(10,4) = 90
REM MaxPieces
LET MaxPieces = 10
END PROCEDURE

PROCEDURE HideKey
VAR k TYPE INTEGER
REM hide key$
LET k = CODE key$ - CODE "A" + 1
PRINT PAPER 6;INK 4;AT Ykeymap(k),Xkeymap(k);key$;
END PROCEDURE

PROCEDURE ProcessChar
VAR k TYPE INTEGER
VAR NewChar TYPE BOOLEAN
LET Success = FALSE
LET Hanged = FALSE
LET NewChar = FALSE
FOR k=1 TO LenWord
  IF Word$(k) = key$
    LET NewChar = TRUE
    LET Word$(k) = "."
    LET Nchars=Nchars+1
    ShowChar(k)
  ENDIF
NEXT k
IF NOT NewChar
  LET Npieces = Npieces + 1
  Build
ENDIF
HideKey
IF Nchars = LenWord THEN LET Success = TRUE
IF Npieces = MaxPieces THEN LET Hanged = TRUE
END PROCEDURE

PROCEDURE InitScreen
BORDER 0 : PAPER 4 : INK 0 : CLS
FOR j=0 TO LastLine
  PRINT PAPER 5;"                                ";
NEXT j
FOR j=1 TO 26 : REM alphabet
  PRINT PAPER 6;AT Ykeymap(j),Xkeymap(j);CHR$( j + CODE "A" - 1 )
NEXT j
REM start gallows aparatus
PAPER 5
PLOT 32,72+16: DRAW 0,14: DRAW 21,0: DRAW 0,-14
ShowCrowd
PRINT PAPER 0;INK 4;AT 0,0;" ";TAB 12;"HANGMAN";TAB 32;
END PROCEDURE

PROCEDURE SelectWord
RESTORE
FOR j=1 TO INT(1+RND*NumWords)
  READ Word$
NEXT j
LET LenWord = LEN Word$
LET Word$ = "." + Word$ ' ignore 0 index
END PROCEDURE

PROCEDURE InitGame
VAR a$ TYPE STRING
REM number of pieces build
LET Npieces = 0
REM number of chars found
LET Nchars = 0
END PROCEDURE

PROCEDURE DefineChars
VAR t TYPE INTEGER
VAR n TYPE INTEGER
VAR i TYPE INTEGER
LET t=0
'RESTORE
READ b$
'PRINT AT 1,0;"READ ";b$
REPEAT
  FOR i=0 TO 7
    READ n
    POKE USR b$+i,n
  NEXT i
  LET t=t+1
  IF t=1 BEGIN v
    PRINT AT 10,4;b$
  ELSEIF t=2
    PRINT AT 11,4;b$
  ELSEIF t=3
    PRINT AT 12,4;b$
  ELSEIF t=4
    PRINT AT 10,28;b$
  ELSEIF t=5
    PRINT AT 11,28;b$
  ELSEIF t=6
    PRINT AT 12,28;b$
  ENDIF
  READ b$
  PAUSE 10
UNTIL b$ = ""
END PROCEDURE

PROCEDURE DataChars
DATA "\A" : REM A
DATA BIN 00000000
DATA BIN 00000000
DATA BIN 00011000
DATA BIN 00111100
DATA BIN 00111100
DATA BIN 00111100
DATA BIN 00011000
DATA BIN 00011000
DATA "\B" : REM B
DATA BIN 00111100
DATA BIN 01111110
DATA BIN 10011001
DATA BIN 10011001
DATA BIN 10011001
DATA BIN 10011001
DATA BIN 10011001
DATA BIN 10011001
DATA "\C" : REM C
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 11100111
DATA "\D" : REM D
DATA BIN 11000011
DATA BIN 10000001
DATA BIN 10011001
DATA BIN 10111101
DATA BIN 10111101
DATA BIN 10111101
DATA BIN 10011001
DATA BIN 10011001
DATA "\E" : REM E
DATA BIN 01111110
DATA BIN 00111100
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA BIN 00011000
DATA "\F" : REM F
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 00100100
DATA BIN 11100111
DATA ""
END PROCEDURE

PROCEDURE TheEnd
BORDER 7 : PAPER 7 : INK 0 : CLS
PRINT AT 10,0;"Have a nice day!"
PRINT "Goodbye."
END PROCEDURE

PROCEDURE ShowWord
VAR k TYPE INTEGER
FOR k=1 TO LenWord
  LET key$ = Word$(k)
  IF key$ <> "." THEN ShowChar(k)
NEXT k
END PROCEDURE

PROCEDURE AskAnotherGame
ClearKeyboard
ShowWord
PRINT AT 17,8;" Another Game? ";
REPEAT
  ReadChar
  IF key$ > "Z" THEN LET key$ = CHR$( CODE(key$)+CODE("A")-CODE("a") )
UNTIL key$ = "Y" OR key$ = "N"
IF key$ = "Y" THEN
  LET AnotherGame = TRUE
ELSE
  LET AnotherGame = FALSE
ENDIF
END PROCEDURE

PROCEDURE Game
InitGame
SelectWord
InitScreen
REPEAT
  ReadChar
  ProcessChar
UNTIL Success OR Hanged
IF Success
  Congratulations
ELSEIF Hanged
  Hang
ENDIF
END PROCEDURE

PROCEDURE ShowAnimation
VAR a$ TYPE STRING
VAR b$ TYPE STRING
VAR DataAnimation(3) TYPE STRING
DataAnimation(0) = "                     "
DataAnimation(1) =  "\. \  \. \..\..\. \. \  \. \..\..\. \. \  \. \..\..\. \. \  \. "
DataAnimation(2) =  "\:.\..\: \:.\..\: \:'\. \: \: \..\. \:'\.'\: \:.\..\: \:'\. \: "
DataAnimation(3) =  "\: \  \: \: \  \: \: \ '\: \:.\..\: \: \  \: \: \  \: \: \ '\: "
'DATA "                                         "
'DATA ".   . ..... .   . ..... .   . ..... .   ."
'DATA ":...: :...: :'. : : ... :'.': :...: :'. :"
'DATA ":   : :   : :  ': :...: :   : :   : :  ':"
b$ = DataAnimation(0)
FOR j=3 TO 0 STEP -1
  a$ = DataAnimation(j)
  FOR i=1 TO LastLine+j-3
    PRINT AT i,6;a$
    PRINT AT i-1,6;b$
    IF j>0 THEN BEEP .01,20-i*2
  NEXT i
  IF j>0 THEN FOR h=10 TO -10 STEP -2 : BEEP .006,h : NEXT h
NEXT j
END PROCEDURE

PROCEDURE Introduction
BORDER 0 : PAPER 4 : INK 0 : CLS
PAPER 5
FOR j=0 TO 12
  PRINT "                                ";
NEXT j
ShowAnimation
PAPER 8
PRINT AT LastLine+1,6;"Guess the english word"
DefineChars
PRINT
PRINT AT 17,6;"Press [S] to start"
ReadChar
PRINT AT 17,6;"                  "
END PROCEDURE

PROCEDURE InitNumWords
VAR t TYPE INTEGER
VAR b$ TYPE STRING
RESTORE
LET t=0
READ b$
WHILE b$ <> ""
  LET t=t+1
  IF LEN b$ > MaxLen THEN PRINT AT 10,0;INK 2;"ERROR: Word Length > ";MaxLen;" !",b$: PAUSE 0
  READ b$
END WHILE
LET NumWords = t
'PRINT AT 0,0;"NumWords= ";NumWords: PAUSE 0
END PROCEDURE

PROCEDURE InitProgram
VAR a$ TYPE STRING
InitDataBuild
InitNumWords
LET Score = 0 : REM score
LET Total = 0 : REM total of games
REM keyboard coordinates
'DIM Xkeymap(26)
'DIM Ykeymap(26)
LET a$ = ".QWERTYUIOP"
FOR j=1 TO LEN a$-1
  LET k=CODE a$(j) - CODE "A" + 1
  LET Ykeymap(k) = 15
  LET Xkeymap(k) = 4 + 2*j
NEXT j
LET a$ = ".ASDFGHJKL"
FOR j=1 TO LEN a$-1
  LET k=CODE a$(j) - CODE "A" + 1
  LET Ykeymap(k) = 17
  LET Xkeymap(k) = 5 + 2*j
NEXT j
LET a$ = ".ZXCVBNM"
FOR j=1 TO LEN a$-1
  LET k=CODE a$(j) - CODE "A" + 1
  LET Ykeymap(k) = 19
  LET Xkeymap(k) = 6 + 2*j
NEXT j
END PROCEDURE

PROCEDURE MainRoutine
InitProgram
Introduction
REPEAT
  Game
  AskAnotherGame
UNTIL NOT AnotherGame
TheEnd
END PROCEDURE

PROGRAM Hangman
PRINT AT 23,0;"Pascalated Boriel ZX BASIC demo";
PAUSE 1*50
MainRoutine
END PROGRAM
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)