! Metal Hangman v1.0 by Terry R. Olsen
! v1.1 (modifed/enhanced) by Tc Wilson
! v1.1a (modified) by Joshie EMT
!
! Please note that the code is sloppy as hell, since it was written by about
! three-four different people (Terry, Tc, Darrin, etc). It's a mess, but it
! does work.

.defmode get 1

Enter Global
 trap modem=6 goto drop
 trap syserr goto SystemCrash
 trap clock(5) goto drop
 prefix$(20)="2/Hangman/"
 gosub check.data ! Check to see if configured yet
 gosub init.globals

Welcome
 clear vid
 if (term=2) or (term=3) goto Welcome.pse
 print \sysn$" presents Metal Hangman!"\
 print \" by Terry R. Olsen."\
 goto Options

Welcome.pse
 ext #128,15,5,50,9,"F",sysn$
 ? at(33,9) "Metal Hangman"at(38,10)"by"at(32,11)"Terry R. Olsen"at(1,16);

Options
 x$="Hangman":gosub DisplayLevel
 push Options
 get i$
 if I$="P" print "Play Hangman":goto Play
 if I$="V" print "View High Scores":goto View
 if I$="Q" print "Quit":goto Quit
 if i$="?" or i$="/" print "Menu":goto Menu
 if i$="T" print "Terminate":goto Terminate
 if (hpn$=usr$(1)) and (i$="C") print "New Words":goto new.words
 if (i$="C") and (staff>1) goto new.words
 if (i$="S") and (staff) goto sysop
 return

Menu
 clear vid
 print" Metal Hangman Options "\
 print "    (P)lay Hangman"
 print "    (V)iew Scores"
 print "    (Q)uit to main"
 print "    (T)erminate"
 print "    (?) This Menu"
 if (staff>1) or (hpn$=usr$(1)) print "    (C)reate New words"
 if (staff) print "    (S)ysop utilities"
 RETURN


! let's be a bastard and re-arrange the words. Simply swap them 40 times to
! make things REAL interesting. (and to keep people from passing word lists)
Shuffle
 for i = 1 to 40
]L
  a=random(10)+1:b=random(10)+1
  if a=b goto ]L
  a$=wd$(a):wd$(a)=wd$(b):wd$(b)=a$
 next
 return

Play
 test=0:hw=1:scr=0
 if staff print \"Test mode";:gosub GetYesNo:test=yes
 if (term=2) or (term=3) goto play.pse
 print \"Checking for new words...";
 if not test gosub check
 gosub Shuffle
 print "Done!"
Play2
 clear vid:win=0:wg=0:cta$="":wdln=len(wd$(hw))
 for i=1 to wdln
 i$=mid$(wd$(hw),i,1)
 if i$=>"A" and i$<="Z" nw$(i)="_":else nw$(i)=i$:win==+1
 wl$(i)=i$
!< wl$(i)=mid$(wd$(hw),i,1):nw$(i)="_":if wl$(i)=" " nw$(i)=" "
 next
 print "Word: "hw tab(20)"Topic: "cat$
 gosub gallows
Play3
 for i=1 to wdln:print nw$(i)" ";:next
 print \\"Current Score is :"scr
 print \"Used Letters: "cta$
 print \"Enter a letter: ";:gosub getkey
 gc=instring(i$,wd$(hw))
 long if not gc
  pop if
  wg==+1
  clear vid
  print "Word: "hw
  gosub gallows
  long if wg>5
   print "Oh No!  You're dead!  The word was: "wd$(hw)" ";
   clear input:get a$:pop if
   if hw<10 hw==+1:goto Play2:else goto win
  end if
  goto Play3
 end if
 for i=1 to wdln
 if i$=wl$(i) nw$(i)=i$:win==+1
 next
 clear vid
 print "Word: "hw
 gosub gallows
 long if win=wdln
  scr==+((wdln*5)-(wg*5)):pop if
  if hw<10 hw==+1:goto Play2:else goto win
 end if
 goto play3
 return

Play.pse
!< if test goto Play2.pse
 clear vid
 ext #128,25,5,29,5,"F","Wait..."
 print at(27,8)"Checking for new words..."
 if not test gosub check
 gosub Shuffle
Play2.pse
 clear vid:win=0:wg=0:cta$=""
 ext #128,23,1,32,14,"FBI",usr$(1),""+cat$+"  SC: "+str$(scr),"20/pse.gallows"
 ext #128,15,16,50,5,"F","Word "+str$(hw)
 ext #128,2,3,17,10,"F","Letters left"
 ext #128,58,3,17,10,"F","Wrong Guesses"
 for i=1 to 26:print ll$(i);:next
 wdst=40-len(wd$(hw)):wdln=len(wd$(hw))
!< print at(wdst,19) repeat$("_ ",wdln)
!< space=instring(" ",wd$(hw))
!< if not space=0 print at(wdst+(space*2)-2,19) " ":win=1
!<>> WHATTHE FUCK IS THIS??
 print at(wdst,19);
 for i=1 to wdln
 i$=mid$(wd$(hw),i,1)
 if (i$=>"A") and (i$<="Z") print "_";:else print i$;:win==+1
 print " ";
 wl$(i)=i$
 next
Play3.pse
 gosub getkey
 print ll$(gu)" ";
 gc=instring(i$,wd$(hw))
 long if not gc
  pop if
  print wg$(gu);
  wg==+1
  print d$(wg);
  long if wg>5
   print dead$
   print at(17,19)"      Oh No!  You're dead!  The word was:      ";
   print at(40-(len(wd$(hw))/2),20) wd$(hw);
   clear input:get a$:pop if
   if hw<10 hw==+1:goto Play2.pse:else:goto win
  end if
  goto Play3.pse
 end if
 for i=1 to wdln
 if i$=wl$(i) print at(wdst+(i*2)-2,19) i$;:win==+1
 next
 long if win=wdln
  scr==+((wdln*5)-(wg*5)):pop if
  if hw<10 hw==+1:goto Play2.pse:else goto win
 end if
 goto play3.pse
 return

! The following initializes all variables for use in Hangman
! ll$(x)="letters left" positioning array
! wg$(x)="wrong guess"  positioning array
! d$(x)="hanging man"   positioning array
! dead$="dead man" positioning variable
! win=number of letters guessed correctly
! hw=number of current word
! wdln=length of current word
! wdst=starting point of current word in window
! scr=current score of player
! lhw$=last Hangman winner (user who updated, can't let 'im play!
! hbrdn=Sub-board to receive Hangman's "auto-posts"
! hpost$=do we auto-post or not???

init.globals
 win=0:hw=1:wdln=0:wdst=0:cta$="":scr=0
 ll$(1)="$&A":ll$(2)="&&B":ll$(3)="(&C":ll$(4)="*&D":ll$(5)=",&E"
 ll$(6)=".&F":ll$(7)="0&G":ll$(8)="$(H":ll$(9)="&(I":ll$(10)="((J"
 ll$(11)="*(K":ll$(12)=",(L":ll$(13)=".(M":ll$(14)="0(N":ll$(15)="$*O"
 ll$(16)="&*P":ll$(17)="(*Q":ll$(18)="**R":ll$(19)=",*S":ll$(20)=".*T"
 ll$(21)="0*U":ll$(22)="$,V":ll$(23)="&,W":ll$(24)="(,X":ll$(25)="*,Y"
 ll$(26)=",,Z"
 wg$(1)="\&A":wg$(2)="^&B":wg$(3)="`&C":wg$(4)="b&D":wg$(5)="d&E"
 wg$(6)="f&F":wg$(7)="h&G":wg$(8)="\(H":wg$(9)="^(I":wg$(10)="`(J"
 wg$(11)="b(K":wg$(12)="d(L":wg$(13)="f(M":wg$(14)="h(N":wg$(15)="\*O"
 wg$(16)="^*P":wg$(17)="`*Q":wg$(18)="b*R":wg$(19)="d*S":wg$(20)="f*T"
 wg$(21)="h*U":wg$(22)="\,V":wg$(23)="^,W":wg$(24)="`,X":wg$(25)="b,Y"
 wg$(26)="d,Z"
 d$(1)="C&o":d$(2)="C'#":d$(3)="B'<":d$(4)="D'>":d$(5)="B(/"
 d$(6)="D(\":dead$="C&QB'/=\B(/ \"
 f$="20/hangman.data":create f$,6
 open #1,f$:position #1,32,1:input #1,nop
                                                      ! number of players
 for i=1 to 10:position #1,32,1+i:input #1,hp$(i):next     ! player names
 for i=1 to 10:position #1,32,11+i:input #1,hun(i):next    ! player user #'s
 for i=1 to 10:position #1,32,21+i:input #1,hps(i):next    ! player scores
 position #1,32,32:input #1,hpun                           ! high score user #
 position #1,32,33:input #1,hpn$                           ! high score name
 position #1,32,34:input #1,cat$                           ! word catagory
 for i=1 to 10:position #1,32,34+i:input #1,wd$(i):next    ! words
 position #1,32,45:input #1,lhw$                           ! last winner
 position #1,32,46:input #1,hbrdn                          ! sub # for posts
 position #1,32,47:input #1,hpost$                         ! posting active?
 close
 if hpost$<>"Yes" hpost$="No"
 if hbrdn=0 hbrdn=1
init.globals1
 open #1,"2/msg.base.setup"
 position #1,256,hbrdn,40:input #1,brdn$
 close
 return

Gallows
 if wg=0 print \"           _______"
 if wg=0 print "           |---\'|"
 if wg=0 print "                ||"
 if wg=0 print "                ||"
 if wg=0 print "                ||"
 if wg=0 print "              __||__"
 if wg=0 print "             '------'"\
 if wg=1 print \"           _______"
 if wg=1 print "           |---\'|"
 if wg=1 print "           o    ||"
 if wg=1 print "                ||"
 if wg=1 print "                ||"
 if wg=1 print "              __||__"
 if wg=1 print "             '------'"\
 if wg=2 print \"           _______"
 if wg=2 print "           |---\'|"
 if wg=2 print "           o    ||"
 if wg=2 print "           #    ||"
 if wg=2 print "                ||"
 if wg=2 print "              __||__"
 if wg=2 print "             '------'"\
 if wg=3 print \"           _______"
 if wg=3 print "           |---\'|"
 if wg=3 print "           o    ||"
 if wg=3 print "          <#    ||"
 if wg=3 print "                ||"
 if wg=3 print "              __||__"
 if wg=3 print "             '------'"\
 if wg=4 print \"           _______"
 if wg=4 print "           |---\'|"
 if wg=4 print "           o    ||"
 if wg=4 print "          <#>   ||"
 if wg=4 print "                ||"
 if wg=4 print "              __||__"
 if wg=4 print "             '------'"\
 if wg=5 print \"           _______"
 if wg=5 print "           |---\'|"
 if wg=5 print "           o    ||"
 if wg=5 print "          <#>   ||"
 if wg=5 print "          /     ||"
 if wg=5 print "              __||__"
 if wg=5 print "             '------'"\
 if wg=6 print \"           _______"
 if wg=6 print "           |---\'|"
 if wg=6 print "           Q    ||"
 if wg=6 print "          /=\   ||"
 if wg=6 print "          / \   ||"
 if wg=6 print "              __||__"
 if wg=6 print "             '------'"\
 return

!Check to see if the user has played these words
!Kick 'em out if they have; let them play if not

Check
 long if usr$(1)=lhw$
  print "

Sorry, you are the one who updated Hangman last.  Therefore, you
aren't allowed to play these words.  That would be quite unfair, now
wouldn't it?  Notify the Sysop if it's been awhile so he can start a
new game.":pop:return
 end if
 long if nop=10
  print "

Sorry, ten players have already played. Therefore, Hangman needs
updated.  "hpn$" was the winner and needs to update with new words.
Please notify the Sysop if it's been awhile.":pop:return
 end if
 for i=1 to 10
  if usr$(1)=hp$(i) pop next:goto sorry
 next
 return

Getkey
 get i$
 if (i$<"A") or (i$>"Z") or instring(i$,cta$) goto GetKey
 gu=asc(i$)-64:cta$==+i$
 return

Win
 if (term=2) or (term=3) goto Win.pse
 clear vid
 print \"You have finished this game of Hangman with a final score of "scr
 if test return
 print "
The player with the highest score after 10 people have played will
be allowed to set up a new Hangman game.  Check your Email to see
if you are that person."
 print \"Updating Hangman Data...";
 open #1,"20/Hangman.data":position #1,32,1:print #1,nop+1
 position #1,32,nop+2:print #1,usr$(1)
 position #1,32,nop+12:print #1,user
 position #1,32,nop+22:print #1,scr
 close:gosub init.globals:print "Done!"\
 if nop=10 print "Emailing winning player...";:Drop=0:goto Notify
 return

Win.pse
 clear vid
 ext #128,15,5,43,10,"F","Final Score: "+str$(scr)
 print at(17,8)"You have finished this game of Hangman."
 if test print \\\\\\:return
 print at(17,9)"The player with the highest score after"
 print at(17,10)"10 people have played will be allowed"
 print at(17,11)"to set up a new Hangman game.  Check"
 print at(17,12)"your Email to see if you are that"
 print at(17,13)"person.    <Key> ";
 get a$
Win0.pse
 ext #128,20,8,40,5,"F","Writing Statistics"
 print at(22,11)"Updating Hangman Data...";
 open #1,"20/Hangman.data":position #1,32,1:print #1,nop+1
 position #1,32,nop+2:print #1,usr$(1)
 position #1,32,nop+12:print #1,user
 position #1,32,nop+22:print #1,scr
 close:gosub init.globals:print "Done!"\\\
 long if nop=10
   ? at(22,11)"Emailing winning player...   ";:Drop=0:pop if:goto Notify
 end if
 Return

Sorry
 if (term=2) or (term=3) goto sorry.pse
 print \"Sorry, but you've played these words already."
 print "Please notify the the Sysop if it's been awhile."
 pop:return

Sorry.pse
 clear vid
 EXT #128,15,5,40,8,"F","Sorry..."
 print at(17,8)"You've already played these words."
 print at(17,9)"Please notify the sysop if it's been"
 print at(17,10)"awhile."
 pop:return

View
 clear vid
 print "     High Scores     "\\
 for i=1 to nop
 print hp$(i) " " tab(39,".")" " hps(i)
 next
 hs=0
 for i=1 to 10:hs==+(len(wd$(i))*5):next
 print \"Highest possible score: "hs\\
 RETURN

New.Words
 clear vid
 print "
You will now enter a set of ten words (each word may be two words long).
The set of words must fall under a specific catagory.  Please think of ten
words and a catagory and enter them in the following screen.  If you can't
think of anything now, then press 'ESC' or 'X' to exit.

Press [RETURN] to continue, [ESC] or [X] to go back: ";
 get a$
 if a$=esc$ or a$="X" ?"Exit":return
 print "Continue"

 input mode("U,")\\"Enter catagory name: " cat$
 print \"Enter 10 words now.  Make sure spelling is correct."\
 for i=1 to 10:if i<10 print" ";
 print i;:input mode("U ")": " wd$(i):next
 clear vid
 print \"Catagory: "cat$\
 for i=1 to 10:if i<10 ?" ";
 print i": "wd$(i):next
 print \"Are these correct";:gosub GetNoYes
 if not yes goto New.Words
 clear vid
 print \"Updating Hangman...";
 delete "20/Hangman.data":create "20/Hangman.data",4
 open #1,"20/Hangman.data":position #1,32,1:print #1,0
 position #1,32,34:print #1,cat$
 for i=1 to 10:position #1,32,i+34:print #1,wd$(i):next
 position #1,32,45:print #1,usr$(1)
 position #1,32,46:print #1,hbrdn:position #1,32,47:print #1,hpost$
 close:gosub init.globals
 long if ((not staff) and (hpost$="Yes"))
  print \\"Posting 'New Hangman Game' message on Sub-board #"hbrdn"."
  gosub PostMsg
 end if
 long if (staff)
  print \"Post New Hangman game message";:gosub GetYesNo
  if yes gosub PostMsg
 end if
 print "

Hangman update complete.  You will not be allowed to play these words.
However, you can view other players scores at any time.  You will be able to
play again when the next winner updates Hangman.  Thank you.
"
 return

Notify
 hs=0
 for i=1 to 10
  if hps(i)>hs hs=hps(i):hpun=hun(i):hpn$=hp$(i)
 next
 open #1,"20/Hangman.data":position #1,32,32:print #1,hpun
 position #1,32,33:print #1,hpn$:close:gosub init.globals
Set.Dest.Vars
 long if drop
  f$="20/drop.letter":subj$="Don't hang up..."
  whom=user:whom$=usr$(1)
 else
  f$="20/winner.letter":subj$="You're a winner!"
  whom=hpun:whom$=hpn$
 end if
 ds=ourid:dp=0:from=0:from$="The Hangman":ss=ourid
 status=254
 runsub "1/email","wr_letter2"
 print "Done!"\\\
 return

Check.Data
 long if filesize("20/Hangman.data")=0
  clear vid
  print "
Hangman has not yet been initialized on your system.
You will be taken directly to the update section."\
  gosub PressReturn:gosub init.globals:gosub configure:gosub new.words
 end if
 return

Sysop
 push Sysop
 clear vid
 print\"          Sysop Commands          "
 print \"  P)ost new Hangman message"
 print  "  C)onfigure Hangman message data"
 print  "  1) Edit Auto E-Mail to winners"
 print  "  2) Edit Auto E-Mail to users who drop carrier"
 print  "  3) Edit Auto Post Message"
 print  "  Q)uit"
 x$="Hangman Sysop":gosub DisplayLevel
]l
 get a$
 if a$="P" goto PostMsg
 if a$="C" goto Configure
 if a$="1" edd$="20/winner.letter":eds$=edd$:goto editor
 if a$="2" edd$="20/drop.letter":eds$=edd$:goto editor
 if a$="3" edd$="20/Hangman.message":eds$=edd$:goto editor
 if a$="Q" pop:return
 goto ]L

list.bases
 print cr"Message bases avail:"
 open #1,"2/msg.base.setup"
 for x = 1 to brds
  position #1,256,x,40
  input #1,i$ cr brdp$ cr brdm$,brdm cr parm(0) to parm(9)
  if brdp$="" goto ]next
  print right$("  "+str$(x),3)": "i$;
  if parm(4) print tab(40)"[NET]":else print
]next
 next
 close #1
 return


Configure
 push Configure
 clear vid
 print\"          Configure Hangman message data          "
 print \"1. Sub-board to receive posts: "hbrdn" - "brdn$
 print  "2. Sub-board posts active:     "hpost$
 print  "S. Save & Exit"
 print  "Q. Quit w/o save"
 print \"Edit Which? ";
]L
 get a$
 long if a$="1"
]L1
  print \\"Enter new Sub-board # to receive posts from Hangman: ";
  input x$:if x$="" return
  if x$="?" or x$="L" gosub list.bases:goto ]L1
  x=val(x$):if (x>0) and (x<=brds) hbrdn=x:gosub init.globals1
  return
 end if
 long if a$="2"
  if hpost$="Yes" hpost$="No":else hpost$="Yes"
  return
 end if
 long if a$="S"
  open #1,"20/Hangman.data":position #1,32,46:print #1,hbrdn
  position #1,32,47:print #1,hpost$:close:gosub init.globals
  pop:return
 end if
 if a$="Q" pop:return
 goto ]L

Quit
 pop:run "1/main","fromseg"

CrashRecover
 goto Enter

Cleanup
 return

Drop
 gosub Win0.pse
 Drop=1:gosub Set.Dest.Vars
 pop:run "1/main","term0"

Terminate
 gosub AskTerm:if not yes return
 pop:run "1/main","term"

!The following code has been extracted from the "msg.base.s" file and modifed

PostMsg
 brdn=hbrdn
 smf_close(3)
 open #1,"2/msg.base.setup":position #1,256,brdn,40
 input #1,brdn$ cr brdp$ cr brdm$,brdm cr parm(0) to parm(9)
 close #1:if brdp$="" return
 hdr$=brdp$+"msgs"
 smf_open(3,hdr$)

 whom=0:ds=0:whom$="All"
 subj$="New Game of Hangman"
 anon=0:from=0:ss$="The Hangman"
 from$="The System Hangman":from=0:ss=ourid
 datp$=date$+" "+time$+" "+zone$:status=anon
 f$="9/Hangman.post"
 create f$,4:open #1,f$
 ? #1,"5" cr datp$ cr right$("00"+str$(status),3) cr subj$
 ? #1,whom$,whom,ds cr from$,from,ss
 ? #1,\"Latest winner: "lhw$"     New Catagory: "cat$\
 tcopy "20/Hangman.message" to #1
 ? #1,null$;:filesize(1)=filemark(1):close #1

 x=filesize(f$):? cr astr$"Saving message ("x" bytes)...";
 if smf_info(3,2)<1 goto YABADABA
 long if smf_info(3,2)=smf_info(3,1)
    if not parm(1) pop if:goto BaseFull
    bltn=parm(1):smf_delete(3,bltn)
 end if
YABADABA
 bltn=smf_info(3,2)+1
 smf_allocate(3,bltn,x):smf_write(3,bltn,f$)
 smf_user(3,bltn)=parm(0)+1
 parm(0)==+1
 open #1,"2/msg.base.setup":position #1,256,brdn,40
 print #1,brdn$ cr brdp$ cr brdm$,brdm cr parm(0) to parm(9)
 close #1
 stat(10,0)==+1:stat(10,1)==+1
 x=filesize(f$):addr(1)==+x:stat(11,0)==+x:stat(11,1)==+x
! uses the standard subs routine now
 gosub UpdateSystemStats
 f$=hf$
 smf_close(3)
 goto ProdosError

BaseFull
 smf_close(3):? cr"ERROR: Message subboard full.":return

.include 1/I/STND.SUBS