>î               HANG6   PAS J än               WORDS   DATL  Äm              ÿ                               ÿ                               ÿ                               ÿ                               ÿ                               
PROGRAM	hang6 ;

{ M plant, 4/17/85
  Yet Another versan of	hangman,this time in
  turbo	pascal.	 string	functions were used
  little,for compatibility with	other pascal's
  words	are in file 'words.dat'                }


CONST
    maxlist	= 100 ;	{ maximum number of words	   }
    maxwordlen	= 26;	{ maximum number of chars per word }
    maxguesses	= 7;	{ number of guesses allowed	   }
    esc		= ^[;

TYPE
    wordtype	= STRING[maxwordlen];
    listtype	= ARRAY[1 .. maxlist] OF wordtype ;
    usedtype	= SET OF char;
    wordrec	= RECORD
		    list : listtype;
		    sise : integer;
		  END;

VAR
    secretword	: wordtype;  { word to try to guess  }
    gameover	: boolean;
    gameswon	: integer;
    gamesplayed	: integer;
    dbg		: wordtype;
    used	: usedtype;
    hlp		: wordtype;  { is help needed }


PROCEDURE emptyword (VAR word :	wordtype);
{ initalise a word to spaces }

VAR
   r : integer;

BEGIN;
  FOR r:=1 TO maxwordlen DO
    word[r] := ' ';
END;

PROCEDURE getword (VAR word : wordtype);

{ read a word as string	,convert it to upercase	}

VAR
    i	 : integer;
    ch	 : integer;

BEGIN;
  emptyword(word);
  write	('? ');
    read (word);
    writeln;
    FOR	i :=1 TO maxwordlen DO
      BEGIN;
	ch := ord(word[i]);
	IF (ch >= 97)
	  THEN BEGIN;
		 ch := ch - 32;
		 word[i] := chr(ch);
	    END;{ if }
	END; { for }
	END;

FUNCTION same (VAR word1:wordtype; VAR word2 : wordtype) : boolean;

{ compare 2 words if same }

  VAR
     g : integer;

   BEGIN;
     same := true;
       FOR g :=1 TO maxwordlen DO
	 IF (word1[g] <> word2[g])
	   THEN	same :=	false;
   END;


FUNCTION Finished : boolean;
{ see if done playing }

VAR
   retry : wordtype;

BEGIN;
  Finished := false;
  write	('Try again ');
  getword (retry);
  IF retry[1] IN ['n','N']
    THEN Finished := true;
END;


PROCEDURE getwords (VAR	words :	wordrec; VAR firstgame : boolean);
{ get wordlist from file 'words.dat
  words	are read as strings	   }

VAR
    infile  : text ;
    word    : wordtype;
    b	    : integer;

BEGIN
   firstgame :=	false;
    assign  (infile,'WORDS.DAT');
    reset   (infile) ;
    IF (ioresult <> 0) { no file }
      THEN
	BEGIN
	    writeln (' Can''t find word list');
	    halt { abort out }
	END ;{ if }
    WITH words DO
      BEGIN;
	sise :=	1 ;
	WHILE NOT eof(infile) DO
	  BEGIN
	    emptyword(word);
	    readln (infile, word);
	    IF (word <>	'')
	      THEN BEGIN;
		     sise := sise + 1;
		     list[sise]	:= word;
		END; { if }
	    END	;{ while }
	close (infile) ;
	END; { with }
END; { getwords	}

FUNCTION len (VAR word:wordtype): integer;

{ find the length of an	array of characters
  spaces are treated as	end of line	   }

VAR
   i : integer;

BEGIN;
  i := 0;
  REPEAT
    i := i+1;
  UNTIL	(word[i] = ' ') OR (i = maxwordlen );
  len := i-1;
END;


PROCEDURE pickword (VAR	words :	wordrec; VAR secretword	: wordtype;
		    VAR	nomorewords : boolean);
{ pick a word from wordlist }

VAR
   rnd : integer;
   tmp : integer;
BEGIN;
  nomorewords := false;
  REPEAT
    rnd	:= random(words.sise);
    emptyword (secretword);
    secretword := words.list[rnd];
  UNTIL	len(secretword)	> 0;
  emptyword (words.list[rnd]);
  words.sise :=	words.sise - 1;
  IF (words.sise = 0)
    THEN nomorewords :=	true;
END;

PROCEDURE writeword (VAR word :	wordtype);
{ write	an array of characters }

VAR
  r : integer;
BEGIN;
  FOR r:=1 TO len(word)	DO
    write (word[r]);
  writeln;
END;

PROCEDURE initgrid (VAR	grid : wordtype; VAR secretword	: wordtype);
{ initilise unguessed word to same number of
  underlines as	secretword		    }

VAR
   e : integer;

BEGIN;
  emptyword(grid);
  FOR e:=1 TO len(secretword) DO
    grid[e] := '_';
END;

FUNCTION noblanks (VAR grid : wordtype;secretword : wordtype): boolean;
{ search grid for unguessed letters }

VAR
    a :	integer;

BEGIN;
  noblanks := true;
  FOR a	:=1 TO len(secretword) DO
    IF grid[a] ='_'
      THEN noblanks := false;
END;

PROCEDURE guessword (VAR guess:wordtype;VAR secretword : wordtype;
		     VAR gameover : boolean);

 { person typed	more then 1 letter
   assumed to be guess of word	  }

 BEGIN;
	   IF same(secretword,guess)
	     THEN BEGIN;
		    writeln;
		    writeln ('You got it!');
		    gameover :=	true;
	       END
	     ELSE
	       writeln ('Wrong word');
      END;

FUNCTION usedletter (VAR guess : wordtype;
		     VAR used  : usedtype): boolean;

{ search used letter set for duplicates	}

VAR
   v : integer;

BEGIN;
  usedletter :=	false;
   IF guess[1] IN used
      THEN usedletter := true
     ELSE BEGIN;
	    used := used + [guess[1]];
       END;
END;

procedure draw_gallows;
begin;
GotoXY (1,7);
writeln	('            ===== ');
writeln	('            I   | ');
writeln	('            I     ');
writeln	('            I     ');
writeln	('            I     ');
writeln	('            I     ');
writeln	('          __I__   ');
writeln	('        ========= ');
end;

PROCEDURE clear_input;

VAR
   x : integer;

BEGIN;
  FOR x	:= 1 TO	40 DO
    write (' ');
  FOR x	:= 1 TO	40 DO
    write (^H);	{ backspace }
END;

PROCEDURE drawfigure (VAR guesscount : integer);

BEGIN;
  CASE guesscount OF
     1:BEGIN;
	 GotoXY	(17,9);
	 write ('0');
      END;

     2:	BEGIN;
	  GotoXY (17,10);
	  write	('W');
	END;

     3:	BEGIN;
	  GotoXY (15,10);
	  write	('\/');
	END;

     4:	BEGIN;
	  GotoXY (18,10);
	  write	('\/');
	END;

     5:	BEGIN;
	 GotoXY	(16,11);
	 write ('/');
	 GotoXY	(16,12);
	 write ('\');
       END;

     6:	BEGIN;
	  GotoXY (18,11);
	  write	('\');
	  GotoXY (18,12);
	  write	('/');
	END;
  END;	{ case }
END;


PROCEDURE writeused (VAR used :	usedtype);

VAR t :	char;
BEGIN;
  GotoXY (1,16);
  write	('Used letters are');
  FOR t	:= 'A' TO 'Z' DO
    IF t IN used
      THEN write (' ',t);
  writeln;
END;

PROCEDURE checkguess (VAR grid : wordtype; VAR secretword : wordtype;
		      VAR guesscount : integer;	VAR gameover : boolean;
		      VAR used : usedtype);

VAR guess : wordtype;
    inword : boolean;
    y :	integer;

BEGIN;
  GotoXY (1,17);
  writeln ('you have ',maxguesses-guesscount:2,' guesses remaining');
  drawfigure (guesscount);
  IF dbg[1] = 'Y'
    THEN writeword(secretword);
  GotoXY (1,19);
  writeword(grid);
  writeused (used);
  writeln;
  emptyword(guess);
  GotoXY (1,21);
  clear_input; { Get rid of some old error messages,if any }
  getword(guess);
  GotoXY (1,15);
  clear_input;
  GotoXY (1,22);
  clear_input;
  inword := false;
  IF len(guess)	> 1
    THEN guessword(guess,secretword,gameover)
    ELSE IF usedletter (guess,used)
	   THEN	BEGIN;
		  GotoXY (1,15);
		  write	('You already used that letter');
	     END
	   ELSE
	     FOR y :=1 TO len(secretword) DO
	       IF guess[1] = secretword[y]
		 THEN
		   BEGIN;
		     inword := true;
		     grid[y] :=	guess[1]
		   END;
	    IF NOT inword
	      THEN guesscount := guesscount + 1;
	    IF noblanks(grid,secretword)
	      THEN BEGIN;
		     GotoXY (1,19);
		     writeword (grid);
		     writeln ('You guessed the word');
		     gameover := true;
		END;
      END;

PROCEDURE endgame (VAR gameover:boolean;VAR gameswon : integer;
		   VAR secretword : wordtype);

BEGIN;
  IF gameover
      THEN gameswon := gameswon	+ 1
      ELSE BEGIN;
	     GotoXY (18,8);
	     write (' ,Ack!');
	     GotoXY (1,22);
	     writeln (^['#3You''re Hung!');
	     writeln (^['#4You''re Hung!');
	     writeln ('The word was ');
	     writeword (secretword);
	END;
END;

PROCEDURE playgame (VAR	gameswon : integer; VAR	gamesplayed : integer);

VAR
    guess	: wordtype;
    grid	: wordtype;  {not totaly guessed w_r_}
    guesscount	: integer;
    gameover	: boolean;
    used	: usedtype;
    firstgame	: boolean;
    words	: wordrec;
    nomorewords	: boolean;

BEGIN;
  gameswon := 0;
  gamesplayed := 0;
  firstgame := true;
  REPEAT
    ClrScr;
    gamesplayed	:= gamesplayed + 1;
    gameover :=	false;
    guesscount := 0;
    used := [];
    IF firstgame
      THEN getwords (words,firstgame);
    pickword (words,secretword,nomorewords);
    initgrid(grid,secretword);
    draw_gallows;
    REPEAT
      checkguess(grid,secretword,guesscount,gameover,used);
    UNTIL (guesscount =	maxguesses) OR gameover;
    endgame (gameover,gameswon,secretword);
  UNTIL	finished OR nomorewords;
   IF nomorewords
     THEN writeln ('Thats it, You guessed all the words');
  END;

PROCEDURE howtoplay;
{ game directions }

VAR
   dummy : wordtype;
BEGIN;
  writeln (' This is a simple hangman game.        ');
  writeln (' You have 7 trys to guess the word.    ');
  writeln (' A guess may be either a single letter ');
  writeln (' or the complete word. Have fun        ');
  writeln ;
  writeln ('Hit <cr> to continue. ');
  getword (dummy);
END;

BEGIN {	hang6 };
  write	('Debug ');
  getword (dbg);
  ClrScr;
  writeln;
  write	('Need help');
  getword (hlp);
  IF hlp[1] = 'Y'
    THEN howtoplay;
  ClrScr;
  playgame (gameswon,gamesplayed);
  writeln ('you won ',gameswon:3,' out of ',gamesplayed:3,' games');
END.
HANGMAN
WORD
LIST
FISH
HEAD
WHITE
COLOR
RED
TELEPHONE
FREAK
JOB
WORK
ORDER
CLEAN
FLOOR
RUG
CARPET
SWITCH
BOARD
BACKWARDS
FOOD
SERVICE
PACK
PRINT
FINISHED
WANDER
SEEK
ERROR
HITCHHIKER
GUIDE
GALAXY