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