Pascalated ZX BASIC Demo #17 - Hangman

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