/* Hangman An implementation in ARexx of the classic word game. Improvements that could be made include: 1) Read word list from file instead of initializing by assignment 2) Use better graphics (perhaps IFF using appropriate libraries) 3) Let user decide when to quit instead of having just 1 turn per game */ call random(,,time('s')) /* Seed RNG */ call AddRexxSupport('FAIL') /* Ensure we have rexxsupport.library */ if OS_Version()=2.0 then /* Only the 2.0 console supports CLOSE */ flags = '/CLOSE' else flags = '' width = 480 /* Width of our console */ /* Variable initialization */ numwords = InitWords() /* Size of word list */ promstr = 'Your guess? ' /* Prompt string */ wd = upper(value('word.'random(1,numwords))) /* Word to guess */ turn = 1 /* First turn */ letters = '' /* Letters guessed */ mgn = length(promstr) /* Word disp. indent */ steps = 6 /* # gallows steps */ left = (width % 8 - 14) - steps * 3 /* Victim's start X */ top = 5 /* Gallows graphic Y */ inp = top + steps + 8 /* Input line Y */ /* Divert the I/O - from here on, STDOUT and STDIN operate through our custom console window. */ if ~divert('con:0/8/480/'inp*8+40'/Hangman!'flags) then do say "Unable to open console window." exit end /* Set up prompt, adding space/backspace to wipe out previous input */ options prompt promstr'2008'x /* Display title */ call PutCursor(top - 3) say center('H A N G M A N',width % 8 - 3) say center('-------------',width % 8 - 3) /* Draw gallows */ call PutCursor(top) call DrawGallows(left - 3, steps) /* Main loop */ do until victory | turn = 7 victory = 0 /* Draw current position of victim */ call PutCursor(top + 9 - turn) call DrawVictim(left + 3 * turn, 1) /* Display word as so far known */ call PutCursor(inp) guess = translate(wd, letters, letters || wd, '_') say copies(' ', mgn)guess'0a'x /* Got it? Exit victorious, stage right */ if guess = wd then victory = 1 /* Not got it? Get input, preferably just one character but we can't do a lot about that. Throw away 2nd and subsequent characters anyway. If the input was an asterisk, abort script - we're debugging. Add new letter to the list of those guessed so far. Unless it is part of the target word, advance the victim up the gallows and bump the turn count. */ else do call PutCursor(inp + 2) pull c 2 if c='*' then exit if pos(c, letters)=0 then do letters = c || letters if pos(c, wd)=0 then do call PutCursor(top + 9 - turn) call DrawVictim(left + 3 * turn, 0) turn = turn + 1 end end end end /* Game lost? Draw victim hanging. */ if ~victory then do call PutCursor(top + 2) call DrawVictim(left + 21, 2) end /* Wipe out the input area */ call PutCursor(inp) do 3 say copies(' ',20) end say '0b0b0b'x if victory then say '0b'x"You win!" say "The word was `"wd"'." call Delay(100) exit /* DrawVictim(margin, mode) Draw a stick figure in given pen color, margin spaces from the left edge. Mode: 0 Color 0 (erase), use '___' for Color 1 legs 1 Color 1 use '/_\' for Color 1 legs 2 Color 3 use '/ \' for Color 3 legs The modes make (some) sense when you see the graphic. */ DrawVictim: procedure parse arg n, m feet = substr('___/_\/ \', m * 3 + 1, 3) c1 = word("0 1 3", m + 1) c2 = word("1 1 3", m + 1) call ConColor(c1) say '1b'x'['n'C O ' say '1b'x'['n'C-+-' say '1b'x'['n'C | ' call ConColor(c2) say '1b'x'['n'C'feet call ConColor(1) return /* DrawGallows(left) Draw gallows graphic such that the first available space for the victim is arg(1) columns from the left edge. */ DrawGallows: procedure parse arg n, s n = n + 6 m = n + s * 3 + 1 say copies(' ',m)'______' say copies(' ',m)'| \ |' say copies(' ',m)'0 \|' do 3 say copies(' ',m + 5)'|' end say copies(' ',m - 4)copies('_',9)'|' do i=n + (s-2)*3 to n + 3 by -3 say copies(' ',i)'___|' end say copies('_', n + 3)'|' return /* PutCursor(row) Put cursor at beginning of given row, counting from 1. */ putcursor: procedure call writech('STDOUT','1b'x'['arg(1)';1H') return /* ConColor Set console color to 0, 1, 2 or 3 Sends ESC-[3?m to standard output, where ? is 0, 1, 2 or 3 Usage: call ConColor(n) */ ConColor: procedure call writech('STDOUT','1b'x'[3'arg(1)//4'm') return /* OS_Version Return either 2.0 (OS versions 2.0 or later) or 1.3 (1.3 or earlier). If more specific version information were wanted, this could easily be extended. */ OS_Version: procedure if c2d(import(offset(showlist('l','exec.library',,'a'),20),2))>=36 then return 2.0 else return 1.3 /* AddRexxSupport You can use this to check/add `rexxsupport.library' and verify its existence before trying to call functions it contains. That way the script won't bomb out ungracefully and unhelpfully with either `Function not found' or `Host environment not found'. If you call this with arg(1)=`FAIL', it will SAY a message and exit the script if the library is not available. Otherwise the availability of the library will be reflected in the boolean return value (1 = OK, 0 = no library). */ AddRexxSupport: procedure signal on syntax if ~show('l','rexxsupport.library') then call addlib('rexxsupport.library',0,-30) /* add to library list */ call null() /* force lib to load */ return 1 syntax: if arg(1)='FAIL' then do say "Library rexxsupport.library is unavailable." exit end else return 0 /* Divert Divert standard input and output streams to a (console) file opened according to the passed-in spec. If this fails (probably because of a bad spec), or if the function is called with no arguments, the default i/o streams are reopened. e.g.: con_opened = Divert('con:0/0/640/200/My console') If the argument is the keyword `DEFAULT' instead of a console specification, a default specification is used. If no arguments are given, the default i/o is reopened. */ Divert: procedure call close("STDOUT") call close("STDIN") parse arg con success = 0 if arg()=1 then if upper(con)='DEFAULT' then con='con:0/10/640/190/Output console' if open("STDOUT",con,"w") then do call pragma("*","STDOUT") if open("STDIN","*","r") then success = 1 else call close("STDOUT") end if ~success then do call pragma("*") call open("STDOUT","*","w") call open("STDIN", "*","r") end return success | arg()=0 /* InitWords Set up word list for Hangman. Should be longer. */ InitWords: procedure expose word. word.1 = 'coffee' ; word.2 = 'hamster'; word.3 = 'morning' word.4 = 'silence'; word.5 = 'horror' ; word.6 = 'freight' word.7 = 'temple' ; word.8 = 'exact' ; word.9 = 'shampoo' word.10 = 'border' ; word.11 = 'utility'; word.12 = 'abacus' word.13 = 'severe' ; word.14 = 'imbibe' ; word.15 = 'avatar' word.16 = 'barrage'; word.17 = 'sheriff'; word.18 = 'caprice' word.19 = 'replace'; word.20 = 'sandal' ; word.21 = 'syzygy' word.22 = 'revive' ; word.23 = 'ellipse'; word.24 = 'baboon' word.25 = 'penguin'; word.26 = 'jaguar' ; word.27 = 'college' word.28 = 'panache'; word.29 = 'inning' ; word.30 = 'hooplah' return 30