**
**BASIC
**08-07-08 23:24:44
**08/07/08
**TOM PHILLIPS
**www.tom-phillips.info
**Copyright 2008 by SQUASH. All rights reserved. 
*
* QHANGMAN - A command line program to "play" the Hangman game.
*
*            This program was produced via a request to demonstrate
*            my programming skills (6 hours start to finish.)
*
*            If a file name is provided then the list of words will
*            be created via the item keys in that file.
*
*            QHANGMAN  { { DICT } file_name }
*
*            2 consecutive null inputs will stop execution.
*
*
* Note: Some changes need to be made for D3, and are prefixed
*       with a comment line containing "D3-MODS".
*
* Note: Some changes need to be made for MAVERICK, and are prefixed
*       with a comment line containing "MAVERICK" or
*       the line contains "MAVERICK" in the comments.
*
*
EQU GLBL.MAV TO 0;* SET TO 1 IF MAVERICK 
*
*EQU AM TO @AM;* NORMALLY CHAR(254)
EQU AM TO CHAR(254)
EQU DICT.LT5 TO 'DICT '
EQU ERRS.ALR TO \Sorry, you already guessed '\
EQU ERRS.FIN TO \So sorry. You struck out.\
EQU ERRS.MUL TO \' has more than one letter.\
EQU ERRS.NOT TO \' is not a valid letter.\
EQU ERRS.SOR TO \Sorry - bad guess.\
EQU ERRS.WRN TO \WARNING! Not entering anything will stop.\
EQU GOOD.MSG TO \Congratulations.  You  W*O*N!\
EQU HANG.101 TO ' O'
EQU HANG.201 TO '\'
EQU HANG.202 TO '\|'
EQU HANG.203 TO '\|/'
EQU HANG.301 TO ' |'
EQU HANG.401 TO '/'
EQU HANG.402 TO '/ \'
EQU LITR.ANS TO \The mystery word was '\
EQU LITR.GUS TO \Guessed letters: \
EQU LITR.HI1 TO \Welcome to Hangman.\
EQU LITR.HI2 TO \You get seven(7) chances to guess the mystery word.\
EQU LITR.HI3 TO \No input is a request to stop.\
EQU LITR.LET TO \Pick a letter --> \
EQU MCA TO 'MCA'
EQU MCP TO 'MCP'
EQU MCU TO 'MCU'
EQU SP TO ' '
EQU SQ TO \'\
EQU UL TO '_'
*
PROMPT ''
SPAC.LFT=SPACE(5)
*
CMND.LIN=''
***
*** UNIVERSE CODE TO GET THE COMMAND LINE
CMND.LIN=@SENTENCE
***
*-> D3-MODS - D3 CODE TO GET THE COMMAND LINE
*-> TCLREAD CMND.LIN
***
*-> MAVERICK CODE TO GET THE COMMAND LINE
*-> CMND.LIN = SENTENCE()
***
CALL QCMDLINE (FILE.NAM,DICT.FLG,OPTN.RUN,CMND.LIN)
IF FILE.NAM#'' THEN FILE.FLG=1 ELSE FILE.FLG=0
*
*The following is to insure a truly random number
PORT.OPR='QHANGMAN'
*MAVERICK ONLY HAS A SINGLE PORT 0
IF (GLBL.MAV) THEN
 PORT.NBR=0
END ELSE
 PORT.NBR=FIELD(OCONV('','U50BB'),' ',1)
END
STUP.VLU=(TIME()+DATE())*100
STUP.VLU=STUP.VLU+PORT.NBR+1
STUP.LMT=LEN(PORT.OPR)
FOR STUP.POS=1 TO STUP.LMT
 STUP.VLU=STUP.VLU+SEQ(PORT.OPR[STUP.POS,1])
NEXT STUP.POS
STUP.VLU=INT((STUP.VLU*1000)+821)
STUP.VLU=RND(STUP.VLU)
*
STOP.ERR=0
GOSUB 1000;* BUILD WORD TABLE
IF (STOP.ERR) THEN STOP
*
*Hello world
PRINT LITR.HI1
PRINT LITR.HI2
PRINT LITR.HI3
*Get a random word from the word table.
TABL.AMC=RND(TABL.LMT)+1
*Fail-safe testing for a word acquired.
FINI.FLG=1
BEGIN CASE
 CASE NOT(TABL.AMC)
 CASE TABL.AMC>TABL.LMT
 CASE 1
  FINI.FLG=0
END CASE
IF (FINI.FLG) THEN
 PRINT \Programmer error. TABL.AMC=\:TABL.AMC
END ELSE
 HOLD.WRD=TABL.WDS<TABL.AMC>
 HOLD.LMT=LEN(HOLD.WRD)
 IF NOT(HOLD.LMT) THEN
  PRINT \Programmer error. Word null\
  FINI.FLG=1
 END ELSE
  GOOD.TBL='';* Table to build the good results
  FOR GOOD.AMC=1 TO HOLD.LMT
   GOOD.TBL<GOOD.AMC>=UL
  NEXT GOOD.AMC
  GOOD.CTR=0
  HOLD.TBL='';* Table to hold the original word
  FOR HOLD.AMC=1 TO HOLD.LMT
   HOLD.CHR=HOLD.WRD[HOLD.AMC,1]
   HOLD.TBL<HOLD.AMC>=HOLD.CHR
  NEXT HOLD.AMC
  GUES.TBL='';GUES.LMT=0;* Guess letters
 END
END
NUMB.ERR=0
GOOD.FLG=0
LOOP
WHILE ( (NUMB.ERR<7) & NOT(FINI.FLG) ) DO
 PRINT LITR.LET:
 INPUT ENTR.FLD 
 ENTR.FLD=OCONV(OCONV(ENTR.FLD,MCP),MCU)
 IF ENTR.FLD='' THEN
  GOSUB 2001;* EXIT REQUEST ?
 END
 BEGIN CASE
  CASE ENTR.FLD=''
   FINI.FLG=1
  CASE ENTR.FLD='???';* Cheating
   PRINT \OK you cheat. The word is: \:HOLD.WRD
  CASE LEN(ENTR.FLD)#1
   PRINT SQ:ENTR.FLD:ERRS.MUL
   GOSUB 5000;* ERROR
  CASE NOT(ENTR.FLD MATCH \1A\)
   PRINT SQ:ENTR.FLD:ERRS.NOT
   GOSUB 5000;* ERROR
  CASE 1
   LOCATE(ENTR.FLD,HOLD.TBL;HOLD.AMC) THEN;* good letter
    HOLD.CHR=HOLD.TBL<HOLD.AMC>
    HOLD.TBL<HOLD.AMC>=UL
    GOOD.TBL<HOLD.AMC>=HOLD.CHR
    GOOD.CTR=GOOD.CTR+1
    IF GOOD.CTR=HOLD.LMT THEN;* Done
     GOOD.FLG=1
     FINI.FLG=1
    END
    LOCATE(ENTR.FLD,GUES.TBL;GUES.AMC) ELSE;* Accumulate guess letters
     GUES.TBL<-1>=ENTR.FLD
     GUES.LMT=DCOUNT(GUES.TBL,AM)
    END
    GOSUB 6000;* DISPLAY STATUS
   END ELSE
    LOCATE(ENTR.FLD,GUES.TBL;GUES.AMC) THEN;* Already guessed
     PRINT ERRS.ALR:ENTR.FLD:SQ
    END ELSE
     PRINT ERRS.SOR
     GUES.TBL<-1>=ENTR.FLD;* Accumulate guess letters
     GUES.LMT=DCOUNT(GUES.TBL,AM)
    END
    GOSUB 5000;* ERROR
   END
 END CASE
REPEAT
BEGIN CASE
 CASE (GOOD.FLG);* Success message
  PRINT GOOD.MSG
 CASE NUMB.ERR=7;* Failure
  PRINT ERRS.FIN
  PRINT LITR.ANS:HOLD.WRD
 CASE 1
END CASE
STOP 
*
******
1000 * BUILD WORD TABLE
******
TABL.LMT=0
TABL.WDS=''
IF (FILE.FLG) THEN
 GOSUB 1002;* GET WORDS FROM FILE
END ELSE
 GOSUB 1001;* DEFAULT WORDS
END
TABL.LMT=DCOUNT(TABL.WDS,AM)
BEGIN CASE
 CASE (STOP.ERR)
 CASE (TABL.LMT)
 CASE 1
  STOP.ERR=1
END CASE
RETURN
*
******
1001 * DEFAULT WORDS
******
TABL.WDS<-1>='COMPLY'
TABL.WDS<-1>='THREE'
TABL.WDS<-1>='VACATION'
TABL.WDS<-1>='INFORMATION'
TABL.WDS<-1>='TECHNOLOGY'
TABL.WDS<-1>='ORLANDO'
TABL.WDS<-1>='COMPUTER'
TABL.WDS<-1>='ROUTER'
TABL.WDS<-1>='PRINTER'
TABL.WDS<-1>='BUDGE'
TABL.WDS<-1>='SOFTWARE'
TABL.WDS<-1>='HARDWARE'
TABL.WDS<-1>='OBJECTIVE'
TABL.WDS<-1>='FILE'
TABL.WDS<-1>='EMPLOYEE'
TABL.WDS<-1>='SECURITY'
TABL.WDS<-1>='DATA'
TABL.WDS<-1>='REPORT'
TABL.WDS<-1>='PROPERTY'
TABL.WDS<-1>='OWNERSHIP'
RETURN
*
******
1002 * BUILD WORD TABLE WITH FILE KEYS
******
OPEN.ERR=0
DISP.NAM=FILE.NAM
IF (DICT.FLG) THEN
 DISP.NAM=DICT.LT5:DISP.NAM
END
BEGIN CASE
 CASE (FILE.FLG) & (DICT.FLG)
  OPEN 'DICT',FILE.NAM TO SFIL ELSE OPEN.ERR=1 
 CASE (FILE.FLG)
  OPEN '',FILE.NAM TO SFIL ELSE OPEN.ERR=1 
 CASE FILE.NAM[1,5]=DICT.LT5 
  FILE.NAM=FILE.NAM[6,LEN(FILE.NAM)] 
  OPEN 'DICT',FILE.NAM TO SFIL ELSE OPEN.ERR=1 
 CASE 1
  OPEN '',FILE.NAM TO SFIL ELSE OPEN.ERR=1 
END CASE
IF (OPEN.ERR) THEN
 PRINT \Can't open \:DISP.NAM 
 STOP.ERR=1
END ELSE
 SELECT SFIL
 LOOP.END=0
 LOOP
  READNEXT FILE.KEY ELSE LOOP.END=1
 UNTIL (LOOP.END) DO
  TABL.FLD=OCONV(OCONV(FILE.KEY,MCP),MCU)
  TEST.FLD=OCONV(TABL.FLD,MCA)
  BEGIN CASE
   CASE TABL.FLD=''
   CASE TABL.FLD#TEST.FLD;* TEST ALL ALPHA
   CASE 1
    LOCATE(TABL.FLD,TABL.WDS;TABL.AMC) ELSE
     TABL.WDS<-1>=TABL.FLD
    END
  END CASE
 REPEAT
END
RETURN
*
******
2001 * 1 NULL INPUT. 2 = EXIT
******
PRINT ERRS.WRN
PRINT LITR.LET:
INPUT ENTR.FLD
RETURN
*
******
5000 * BUMB ERROR COUNT & DISPLAY STATUS
******
NUMB.ERR=NUMB.ERR+1
GOSUB 6000;* DISPLAY STATUS
RETURN
*
******
6000 * DISPLAY STATUS
******
*Display guessed letters
DISP.FLD='';DISP.DLM=''
FOR GUES.AMC=1 TO GUES.LMT
 DISP.FLD=DISP.FLD:DISP.DLM:GUES.TBL<GUES.AMC>
 DISP.DLM=SP
NEXT GUES.AMC
PRINT LITR.GUS:DISP.FLD
PRINT
*Display "hangman" icon if any errors so far
IF (NUMB.ERR) THEN
 ON NUMB.ERR GOSUB 6001,6002,6003,6004,6005,6006,6007
 PRINT
END
*Display result word status so far
DISP.FLD='';DISP.DLM=''
FOR GOOD.AMC=1 TO HOLD.LMT
 DISP.FLD=DISP.FLD:DISP.DLM:GOOD.TBL<GOOD.AMC>
 DISP.DLM=SP
NEXT GOOD.AMC
PRINT DISP.FLD;PRINT
RETURN
*
******
6001 * 1 ERROR
******
PRINT SPAC.LFT:HANG.101
RETURN
*
******
6002 * 2 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.201
RETURN
*
******
6003 * 3 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.202
RETURN
*
******
6004 * 4 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.203
RETURN
*
******
6005 * 5 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.203
PRINT SPAC.LFT:HANG.301
RETURN
*
******
6006 * 6 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.203
PRINT SPAC.LFT:HANG.301
PRINT SPAC.LFT:HANG.401
RETURN
*
******
6007 * 7 ERRORS
******
PRINT SPAC.LFT:HANG.101
PRINT SPAC.LFT:HANG.203
PRINT SPAC.LFT:HANG.301
PRINT SPAC.LFT:HANG.402
RETURN
*
END