Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume3/vms-hangman/part01

Internet Message Format | 1989-02-03 | 15.2 KB

Path: xanth!mcnc!rutgers!mit-eddie!husc6!spdcc!ima!necntc!ncoast!allbery
From: [e-mail]
Newsgroups: comp.sources.misc
Subject: v03i091: Hangman for VMS -- Part 1 of 2
Message-ID: <[e-mail]>
Date: 18 Jul 88 15:00:50 GMT
Sender: [e-mail]
Reply-To: [e-mail]
Lines: 536
Approved: [e-mail]

Posting-number: Volume 3, Issue 91
Submitted-by: "A. Nonymous" <[e-mail]>
Archive-name: vms-hangman/Part1

[...I think it is, at least.  Be nice if it had come in with a Subject: line,
as per the guidelines.  Or does some mailer eat them?  ++bsa]

...................... Cut between dotted lines and save. .....................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.00 26-May-1988.
$!
$! VMS_SHARE was written by James Gray (Gray:[e-mail]) from
$! VMS_SHAR by Michael Bednarek ([e-mail]).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user CCTERRELL
$! on  6-APR-1866 20:07:23.78.
$!
$! ATTENTION: To keep each article below 31 blocks (15872 bytes), this
$!            program has been transmitted in 2 parts.  You should
$!            concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 2 files:
$!        HANGMAN-WORDS.DAT
$!        HANGMAN.PAS
$!
$!==============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.00 26-May-1988 requires VMS V4.4 or higher."
$ EXIT 44
$VERSION_OK:
$ GOTO START
$
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK( NONE
) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 ); IF s_x = "+" THEN r_skip
:= SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip <> 0 THEN s_x := ""
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF; ENDIF
; IF s_x = "-" THEN r_skip := SEARCH( pat_end, FORWARD, EXACT ); IF r_skip <
> 0 THEN s_x := ""; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip := MARK( NONE )
; r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip <> 0 THEN POSITION
( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET ); MOVE_VERTICAL( 1 )
; MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part ) ); ENDIF; ERASE
( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = "V" THEN s_x := ""; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1; MOVE_VERTICAL
( 1 ); ENDIF; IF s_x = "X" THEN s_x := ""; IF i_append_line <
> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> "" THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL( 1
); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH( "`"
, FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1 )
; IF CURRENT_CHARACTER = "`" THEN MOVE_HORIZONTAL( 1 ); ELSE COPY_TEXT( ASCII
( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDIF; ENDLOOP; IF i_errors = 0 THEN SET
( NO_WRITE, b_errors, ON ); ELSE POSITION( BEGINNING_OF( b_errors ) )
; COPY_TEXT( FAO( "The following !UL errors were detected while unpacking !AS"
, i_errors, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors
, "SYS$COMMAND" ); ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!,passed." )
$ RETURN
$
$START:
$ FILE_IS = "HANGMAN-WORDS.DAT"
$ CHECKSUM_IS = 1415151423
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
XBRIGHT
XARROW
XINDIAN
XTERMINAL
XTELEPHONE
XMANUAL
XETHEREAL
XPAPER
XCOMPUTER
XHEAVEN
XPERFECT
XMAGNETIC
XAUTOMOBILE
XCARPET
XCHICAGO
XPLAIN
XOPPONENT
XLOVER
XSECURE
XSTUDENT
XEMPLOYEE
XHANDBOOK
XMEMORIAL
XPREMIUM
XHOLIDAY
XCAMPUS
XMISSISSIPPI
XCOURSE
XNOVEMBER
XLUNCH
XDOLLAR
XEXPERT
XNEWSPAPER
XNOTEBOOK
XHORSE
XSECRET
XHOLIDAY
XDROUGHT
XDANCE
XMUSIC
XCOFFEE
XLETTER
XCHALK
XPICTURE
XBUTTON
XPRESIDENT
XCHAIR
XTRAIN
XEQUIPMENT
XGALLOWS
XTEETH
XLIGHT
XGLASS
XCURTAIN
XALTAR
XTRASH
XPLASTIC
XCANNON
XGRASS
XTHUMB
XCEMENT
XFENCE
XSOCKET
XFRONT
XWHALE
XELECTRICITY
XVESSEL
XBREAK
XWINDOW
XGARDEN
XSYRUP
XMOUNTAIN
XVOLUME
XOCEAN
XCIRCUS
XTANGLE
XSTONE
XPERSON
XSTAGE
XCERAMIC
XMORNING
XVIDEO
XCOLLEGE
XANATOMY
XTRAGEDY
XLABEL
XFORCE
XRULER
XSHAKE
XORDER
XDANGER
XPETAL
XLOCAL
XAUCTION
XDIAMOND
XYACHT
XUNIVERSE
XQUALITY
XSTORY
XFOUGHT
XBATTLE
XPRICE
XPROBLEM
XPEOPLE
$ GOSUB UNPACK_FILE
$ FILE_IS = "HANGMAN.PAS"
$ CHECKSUM_IS = 1463826394
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X[INHERIT ('SYS$LIBRARY:STARLET')]
XPROGRAM HangMan (INPUT, OUTPUT, WordFile);
X(*
X  July 18, 1988
X
X  This is a version of the game "Hangman" in VAX Pascal which I wrote
X  for no good reason (because I felt like it).  If you need an example
X  of how to call the Run-Time Library routines from Pascal, this will
X  do, but don't think of it as an example of good programming style;
X  Actually, it's terrible.
X
X  Anyway, its a fine version of hangman, although the "dictionary" could
X  be larger.
X
X  The dictionary is refered to as "WordFile".  It is an ordinary text
X  file of 100 words, one word per line.  Maximum 15 characters per
X  word, only uppercase letters (A through Z) allowed.
X*)
X
XCONST
X  WordFileName = 'HANGMAN-WORDS.DAT';
X
XTYPE
X  Mask_Longword = [LONG, UNSAFE] PACKED ARRAY [1..32] OF BOOLEAN;
X  Unsigned_Byte = [BYTE] 0..255;
X  Unsigned_Word = [WORD] 0..65535;
X
X  UppercaseLetter = 'A'..'Z';
X  LetterSet = SET OF UppercaseLetter;
X
X  WordString  = VARYING[15] OF CHAR;
X
XVAR
X  Pasteboard : UNSIGNED;
X
X  ManDisplay : UNSIGNED;
X  LetterDisp : UNSIGNED;
X  WordDisp   : UNSIGNED;
X  HelpDisp   : UNSIGNED;
X
X  Keyboard   : UNSIGNED;
X
X  WordFile   : TEXT;
X
X  NewWord    : WordString;
X
X  CurrTime   : PACKED ARRAY [1..11] OF CHAR;
X  SmallStr   : PACKED ARRAY [1..2] OF CHAR;
X
X  RandomSeed : UNSIGNED;
X
X  Done       : BOOLEAN;
X
X
XFUNCTION LIB$WAIT (
X  SECONDS`009`009: REAL) : UNSIGNED; EXTERN;
X
XFUNCTION MTH$RANDOM (
X  VAR SEED`009`009: UNSIGNED) : REAL; EXTERN;
X
XFUNCTION SMG$CREATE_PASTEBOARD (
X  VAR PASTEBOARD_ID `009: UNSIGNED;
V  OUTPUT_DEVICE `009: [CLASS_S] PACKED ARRAY [A..B : INTEGER] OF CHAR := %IMMED
X 0;
X  VAR NUMBER_OF_PASTEBOARD_ROWS
X`009`009`009: INTEGER := %IMMED 0;
X  VAR NUMBER_OF_PASTEBOARD_COLUMNS
X`009`009`009: INTEGER := %IMMED 0;
X  FLAGS`009`009`009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$CREATE_VIRTUAL_DISPLAY (
X  NUMBER_OF_ROWS`009: INTEGER;
X  NUMBER_OF_COLUMNS  `009: INTEGER;
X  VAR DISPLAY_ID `009: UNSIGNED;
X  DISPLAY_ATTRIBUTES`009: Mask_Longword := %IMMED 0;
X  VIDEO_ATTRIBUTES`009: Mask_Longword := %IMMED 0;
X  CHAR_SET  `009`009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$CREATE_VIRTUAL_KEYBOARD (
X  VAR KEYBOARD_ID `009: UNSIGNED;
V  INPUT_DEVICE `009`009: [CLASS_S] PACKED ARRAY [A..B : INTEGER] OF CHAR := %IM
XMED 0;
V  DEFAULT_FILESPEC `009: [CLASS_S] PACKED ARRAY [C..D : INTEGER] OF CHAR := %IM
XMED 0;
V  VAR RESULTANT_FILESPEC: [CLASS_S] PACKED ARRAY [E..F : INTEGER] OF CHAR := %I
XMMED 0;
X  RECALL_SIZE`009`009: Unsigned_Byte := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$DELETE_PASTEBOARD (
X  PASTEBOARD_ID`009`009: UNSIGNED;
X  CLEAR_SCREEN_FLAG`009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$ERASE_DISPLAY (
X  DISPLAY_ID`009`009: UNSIGNED;
X  START_ROW`009`009: INTEGER := %IMMED 0;
X  START_COLUMN`009`009: INTEGER := %IMMED 0;
X  END_ROW`009`009: INTEGER := %IMMED 0;
X  END_COLUMN`009`009: INTEGER := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$PASTE_VIRTUAL_DISPLAY (
X  DISPLAY_ID`009`009: UNSIGNED;
X  PASTEBOARD_ID `009: UNSIGNED;
X  PASTEBOARD_ROW`009: INTEGER;
X  PASTEBOARD_COLUMN`009: INTEGER;
X  TOP_DISPLAY_ID     `009: UNSIGNED := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$PUT_CHARS (
X  DISPLAY_ID`009`009: UNSIGNED;
X  TEXT`009`009`009: [CLASS_S] PACKED ARRAY [A..B : INTEGER] OF CHAR;
X  LINE_NUMBER`009`009: INTEGER := %IMMED 0;
X  COLUMN_NUMBER`009`009: INTEGER := %IMMED 0;
X  ERASE_FLAG`009`009: Mask_Longword := %IMMED 0;
X  RENDITION_SET`009`009: Mask_Longword := %IMMED 0;
X  RENDITION_COMPLEMENT`009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$PUT_CHARS_HIGHWIDE (
X  DISPLAY_ID   `009`009: UNSIGNED;
X  TEXT `009`009`009: [CLASS_S] PACKED ARRAY [A..B:INTEGER] OF CHAR;
X  START_ROW`009`009: INTEGER := %IMMED 0;
X  START_COLUMN   `009: INTEGER := %IMMED 0;
X  RENDITION_SET`009`009: Mask_Longword := %IMMED 0;
X  RENDITION_COMPLEMENT`009: Mask_Longword := %IMMED 0;
X  CHARACTER_SET     `009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$READ_KEYSTROKE (
X  KEYBOARD_ID`009`009: UNSIGNED;
X  VAR TERMINATOR_CODE`009: Unsigned_Word;
V  PROMPT_STRING`009`009: [CLASS_S] PACKED ARRAY [A..B : INTEGER] OF CHAR := %IM
XMED 0;
X  TIMEOUT`009`009: INTEGER := %IMMED 0;
X  DISPLAY_ID`009`009: UNSIGNED := %IMMED 0;
X  RENDITION_SET`009`009: Mask_Longword := %IMMED 0;
X  RENDITION_COMPLEMENT`009: Mask_Longword := %IMMED 0) : UNSIGNED; EXTERN;
X
XFUNCTION SMG$RING_BELL (
X  DISPLAY_ID`009`009: UNSIGNED;
X  NO_OF_TIMES`009`009: INTEGER := %IMMED 0) : UNSIGNED; EXTERN;
X
X
XPROCEDURE LetterPlace (Letter : UppercaseLetter; VAR Row, Column : INTEGER);
XVAR
X  CountChar: UppercaseLetter;
XBEGIN
X  IF Letter <= 'M' THEN
X    BEGIN
X      Row := 1;
X      CountChar := 'A';
X    END
X  ELSE
X    BEGIN
X      Row := 3;
X      CountChar := 'N';
X    END;
X
X  Column := 1;
X  WHILE CountChar < Letter DO
X    BEGIN
X      CountChar := SUCC(CountChar);
X      Column := Column + 4;
X    END; (* WHILE *)
XEND; (* LetterPlace *)
X
X
XPROCEDURE FillLetters;
XVAR
X  Letter     : UppercaseLetter;
X  Row, Column: INTEGER;
X
XBEGIN
X  FOR Letter := 'A' TO 'Z' DO
X    BEGIN
X      LetterPlace (Letter, Row, Column);
X      SMG$PUT_CHARS_HIGHWIDE (LetterDisp, Letter, Row, Column);
X    END; (* FOR *)
XEND; (* FillLetters *)
X
X
XPROCEDURE FillHelpDisplay;
XBEGIN
X  SMG$PUT_CHARS (HelpDisp, 'HANG-MAN', 1, 1, RENDITION_SET := SMG$M_BOLD);
X  SMG$PUT_CHARS (HelpDisp, 'Press <Ctrl/Z> to Quit.', 3, 5);
V  SMG$PUT_CHARS (HelpDisp, 'Press the letter which you think is in the word.',
X5, 5);
V  SMG$PUT_CHARS (HelpDisp, 'If it is actually a part of the word, it will', 6,
X5);
V  SMG$PUT_CHARS (HelpDisp, 'appear there.  Otherwise, a part of the man will',
X7, 5);
X  SMG$PUT_CHARS (HelpDisp, 'be drawn.', 8, 5);
XEND; (* FillHelpDisplay *)
X
X
XPROCEDURE GetWord (VAR NewWord : WordString);
XVAR
X  Counter : INTEGER;
X  WordNum : INTEGER;
XBEGIN
X  OPEN (WordFile, WordFileName, READONLY, SHARING := READONLY);
X  RESET (WordFile);
X
X  WordNum := ROUND(MTH$RANDOM(RandomSeed) * 100.0);
X  WordNum := ROUND(MTH$RANDOM(RandomSeed) * 100.0) + 1;
X
X  FOR Counter := 1 TO WordNum DO
X    READLN (WordFile);
X
X  READLN (WordFile, NewWord);
X
X  CLOSE (WordFile);
XEND; (* GetWord *)
X
X
XFUNCTION GetChar (VAR Ch : CHAR; LegalLetters : LetterSet) : INTEGER;
XVAR
X  KeyPressed : Unsigned_Word;
X  Correct    : BOOLEAN;
XBEGIN
X  REPEAT
X    Correct := TRUE;
X
X    SMG$READ_KEYSTROKE (Keyboard, KeyPressed);
X    IF (KeyPressed >= 97) AND (KeyPressed <= 122) THEN
X      KeyPressed := KeyPressed - 32;
X
X    CASE KeyPressed OF
X      65..90  : IF NOT (CHR(KeyPressed) IN LegalLetters) THEN
X                  Correct := FALSE;
X        26    : (* Do Nothing *);
X      OTHERWISE
X                Correct := FALSE;
X    END; (* Case *)
X  UNTIL Correct;
X
X  IF KeyPressed <> 26 THEN
X    Ch := CHR(KeyPressed)
X  ELSE
X    Ch := ' ';
X
X  GetChar := KeyPressed;
XEND; (* GetChar *)
X
X
XPROCEDURE DrawMan (PartNumber : INTEGER);
XBEGIN
X  CASE PartNumber OF
X    1 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, '___', 2, 6);
X          SMG$PUT_CHARS (ManDisplay, '(. .)', 3, 5);
X          SMG$PUT_CHARS (ManDisplay, '---', 4, 6);
X        END;
X    2 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, 'X', 5, 7);
X          SMG$PUT_CHARS (ManDisplay, 'X', 6, 7);
X          SMG$PUT_CHARS (ManDisplay, 'X', 7, 7);
X          SMG$PUT_CHARS (ManDisplay, 'X', 8, 7);
X        END;
X    3 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, '\', 3, 3);
X          SMG$PUT_CHARS (ManDisplay, '\', 4, 4);
X          SMG$PUT_CHARS (ManDisplay, '\', 5, 5);
X          SMG$PUT_CHARS (ManDisplay, '\', 6, 6);
X        END;
X    4 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, '/', 3, 11);
X          SMG$PUT_CHARS (ManDisplay, '/', 4, 10);
X          SMG$PUT_CHARS (ManDisplay, '/', 5, 9);
X          SMG$PUT_CHARS (ManDisplay, '/', 6, 8);
X        END;
X    5 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, '/', 9, 6);
X          SMG$PUT_CHARS (ManDisplay, '/', 10, 5);
X          SMG$PUT_CHARS (ManDisplay, '/', 11, 4);
X          SMG$PUT_CHARS (ManDisplay, '/', 12, 3);
X        END;
X    6 : BEGIN
X          SMG$PUT_CHARS (ManDisplay, '\', 9, 8);
X          SMG$PUT_CHARS (ManDisplay, '\', 10, 9);
X          SMG$PUT_CHARS (ManDisplay, '\', 11, 10);
X          SMG$PUT_CHARS (ManDisplay, '\', 12, 11);
X        END;
X  END; (* CASE *)
XEND; (* DrawMan *)
X
X
XPROCEDURE SolveWord (NewWord : WordString);
XCONST
X  NumBodyParts = 6;
XVAR
X  WordLength : INTEGER;
X  Column     : INTEGER;
X  Counter    : INTEGER;
X  Row        : INTEGER;
X  NumGuessed : INTEGER;
X  NumWrong   : INTEGER;
X  NumUniqueLetters : INTEGER;
X  Letters    : LetterSet;
X  LegalChars : LetterSet;
X  CharCode   : INTEGER;
X  ChPressed  : CHAR;
X  WordSolved : BOOLEAN;
X  ManHanged  : BOOLEAN;
X
XBEGIN
X  WordLength := LENGTH(NewWord);
X
X  SMG$ERASE_DISPLAY (WordDisp);
X
X  Letters := ['A'..'Z'];
X  Letters := Letters - ['A'..'Z'];
X
X  Column := 1;
X  FOR Counter := 1 TO WordLength DO
X    BEGIN
X      SMG$PUT_CHARS_HIGHWIDE (WordDisp, '-', 1, Column);
X      Column := Column + 2;
X      Letters := Letters + [NewWord[Counter]];
X
X    END; (* FOR *)
X
X  NumUniqueLetters := 0;
X
X  FOR ChPressed := 'A' TO 'Z' DO
X    IF ChPressed IN Letters THEN
X      NumUniqueLetters := NumUniqueLetters + 1;
X
X  WordSolved := FALSE;
X  ManHanged  := FALSE;
X  LegalChars := ['A'..'Z'];
X  NumGuessed := 0;
X  NumWrong   := 0;
X
X  REPEAT
X    CharCode := GetChar (ChPressed, LegalChars);
X    IF CharCode <> 26 THEN
X      BEGIN
X        LetterPlace (ChPressed, Row, Column);
X        SMG$PUT_CHARS_HIGHWIDE (LetterDisp, ' ', Row, Column);
X
X        LegalChars := LegalChars - [ChPressed];
X
X        IF ChPressed IN Letters THEN
X          BEGIN
X            Column := 1;
X            FOR Counter := 1 TO WordLength DO
-+-+-+-+-+ End of part 1 +-+-+-+-+-