program CONTEST {TurboPascal 5.0} ; uses Dos, Crt ; type setofchar = set of char ; const Loud : boolean = true ; Show : boolean = false ; Name = 'CONTEST' ; Esc = #27 ; Sp = #32 ; Places = 20 ; NDonors = 9 ; Donor : array [0..NDonors] of string[10] = ('Nobody', 'Marina', 'Colin', 'Sybil', 'Pam', 'Dave', 'Fred', 'Clare', 'John', 'Dick') ; NDrinks = 5 ; Sip : array [0..NDrinks] of string[20] = ('nothing', 'a small mug of tea', 'a double whisky', 'a medium coffee', 'a large cocoa', 'a quart of beer') ; BoHas = 7 ; Bo : array[-1..BoHas] of string[25] = ('a swift kick', 'nothing', 'half a box of matches', 'a bog-roll', 'a Brillo', 'some washing-up liquid', 'some sisal', 'six tent-pegs', 'a mallet') ; Ways = 5 ; How : array [0..Ways] of string[15] = ('reluctant', 'gent', 'tactful', 'stern', 'violent', 'vicious') ; Npat = 3 ; Patrols : array [1..Npat] of record Pname : string [12] ; PLis : string [12] end = ( (Pname : 'Amundsen' ; PLis : 'Tom'), (Pname : 'Drake' ; PLis : 'Hugh'), (Pname : 'Scott' ; PLis : 'Davin') ) ; Boss : string [12] = 'Irrelevant!' ; Plural : array [boolean] of string[1] = ('s', '') ; Girl : setofchar = ['B', 'G'] ; Scout : setofchar = ['E'] { increases later } ; Adult : setofchar = ['F', 'L', 'P'] ; type position = 0..Places ; locality = record N, E, S, W : position ; AC : string [2] ; View : string end ; var Facts : text ; NowAt : position ; Death, Scene : string ; Ch, ID, Sex : char ; PL, Wood, Water : boolean ; GWD, GTP, JM, P, Pts, TFFP, TFA, THQ, TMQ, TQM, TPS : integer ; Site : array [1..Places] of locality ; KickOut : byte ; QQ : integer ; procedure GetData ; var Err, NS : integer ; Strin : string ; function SubS(var St : string) : string ; var K : byte ; begin K := Pos(',', St) ; SubS := Copy(St, 1, K-1) ; Delete(St, 1, K) ; while Strin[1]=Sp do Delete(Strin, 1, 1) end {SubS} ; begin Strin := ParamStr(0) ; if Pos('TURBO', Strin)>0 then Strin := Name else Dec(Strin[0], 4) ; ClrScr ; Writeln ; Writeln ; Write('Program ', Strin) ; if ParamCount>0 then Strin := ParamStr(1) else Strin := Strin + '.PAS' ; Writeln(', reading ', Strin, ', please wait ...') ; Assign(Facts, Strin) ; Reset(Facts) ; NS := 0 ; while not Eof(Facts) do begin Readln(Facts, Ch, Strin) ; if Ch='#' then begin Val(SubS(Strin), NowAt, Err) ; if NowAt=0 then Scene := Strin else with Site[NowAt] do begin Inc(NS) ; Val(SubS(Strin), N, Err) ; Val(SubS(Strin), E, Err) ; Val(SubS(Strin), S, Err) ; Val(SubS(Strin), W, Err) ; AC := SubS(Strin) ; View := Strin end ; end {#}; end {not} ; Writeln('Map data has been read OK.') ; while KeyPressed do Err := integer(ReadKey) ; Delay(1000) ; if KeyPressed then begin for NowAt := 1 to NS do with Site[NowAt] do Writeln(NowAt:4, N:4, E:3, S:3, W:3, AC:4, ' ', View) ; Err := integer(ReadKey) ; Err := integer(ReadKey) ; ClrScr end ; end {GetData} ; procedure Din(Hz : word) ; begin if Loud then Sound(Hz) end {Din} ; procedure Whistle (times : byte; var Timer : integer ; steps : integer; ForMe : boolean) ; var N : byte ; begin NoSound ; for N := 1 to times do begin Write(' Whistle ') ; Din(2000) ; Delay(750) ; NoSound ; Delay(500) end ; Writeln ; if ForMe then Timer := steps end {Whistle} ; procedure Peep(S : string) ; begin NoSound ; Writeln(S) ; Din(1500) ; Delay(1000) ; NoSound ; end {Peep} ; procedure Score(S : string ; N : integer) ; var J : integer ; const Profit : array [boolean] of string[5] = ('lose ', 'gain ') ; begin Inc(Pts, N) ; J := Abs(N) ; Writeln(S, '; ', Profit[N>0], J, ' point', Plural[J=1]) end ; procedure DoAP ; var JP : integer ; begin with Site[NowAt] do begin if AC='FA' then Writeln('Fortunately, Emma''s Potty is still here') else if (AC<>'PB') and (AC<>'LT') and (AC<>'Wd') then begin JP := P ; if AC='QM' then begin Inc(JP, 15) ; Write('VERY ') end ; if AC='Tp' then begin Inc(JP, 12) ; Write('MODERATELY ') end ; if AC='MQ' then begin Inc(JP, 10) ; Write('RATHER ') end ; if AC='BT' then begin Inc(JP, 10) ; Write('SOMEWHAT ') end ; if AC='PS' then begin Inc(JP, 5) ; Write('FAIRLY ') end ; Score('Highly Insanitary', -JP) end ; end ; for JP := P downto 0 do begin NoSound ; Din(1000+100*JP) ; Delay(100) ; NoSound ; Delay(50) end ; if P>5 then Writeln('That feels better.') else Score('Timewaster!', P-5) ; P := 0 end {DoAP}; procedure SpeedUp(St : string ; var T : integer) ; begin if (Site[NowAt].AC=St) and (T>0) then T := (1+T) div 2 end ; procedure ShowVars ; begin Writeln(P:7, 'P', TFFP:7, 'F', TQM:7, 'Q', TMQ:7, 'M', THQ:7, 'H', TPS:7, 'S', GTP:7, 'T', GWD:7, 'W', TFA:7, 'A') end ; procedure MainGame ; var J1, J2 : integer ; Booze : string[20] ; BEGIN repeat with Site[NowAt] do begin Write('Score is ', Pts, ' point', Plural[Abs(Pts)=1], '; now at #', NowAt, '; ') ; if (View[1] in Scout) or not (AC='PS') then Write(View) else Write('Wasteland') ; Writeln('.') ; if AC='DD' then begin Death := 'That place is FATAL.' ; Exit end ; if PL then Write('ž') ; Write(ID, char(11+Ord(Sex='F')), ': ') ; if (TMQ<0) and (TQM<0) and (TFFP<0) and (TFA<0) and (THQ<0) then case Random(1000) of 100..160 : Whistle(3, TMQ, 15, (ID in Scout) and not PL) ; 300..365 : Whistle(2, TQM, 15, (ID in Scout) and not PL) ; 400..450 : Whistle(1, THQ, 15, PL) ; 500..570 : begin Writeln(^G'A long bell rings'^G) ; TFFP := 10 end ; 600..610 : begin Writeln(^G'You have annoyed RENKO and been chewed !') ; Writeln('You will want First Aid soon!'^G) ; Death := 'Bled to death from being chewed ! ' ; TFA := 10 end ; 650..680 : Writeln('RENKO barks in the distance ! ') ; 700..710 : begin Writeln(^G'You have frightened FRODO and been clawed !') ; Writeln('You will need First Aid before long!'^G) ; Death := 'Bled to death after being clawed ! ' ; TFA := 10 end ; 650..680 : Writeln('FRODO growls not far away ! ') ; end ; Speedup('FP', TFFP) ; SpeedUp('QM', TQM) ; SpeedUp('FA', TFA) ; SpeedUp('MQ', TMQ) ; SpeedUp('MQ'{sic}, THQ) ; SpeedUp(ID, TPS) ; if (Random(15)=0) and (AC<>'LT') and (AC<>'PB') then begin J2 := Random(NDonors+1) ; Write(Donor[J2]) ; J1 := Random(NDrinks+1) ; if J2>0 then Booze := Sip[J1] else Booze := 'anything' ; if ((ID in Scout+Girl) and ((J1=2) or (J1=5))) or ((ID='V') and (J1=2)) then begin Booze := 'nothing' ; J2 := 0 end ; Writeln(' gives you ', Booze, ' to drink!'^G) ; if J2>0 then Inc(P, J1) end ; if (AC='BT') and (Random(2)=0) then begin J1 := Random(BoHas+2) ; J1 := J1-1 ; Write(^G'Bosun gives you ', Bo[J1]) ; if J1>=0 then Write(' to carry in your pocket') ; Writeln end ; if (AC='PS') and (ID=View[1]) and not PL then begin J1 := Random(10) ; if J1<2 then Write('Your PL, ', Boss, ', needs '^G) ; if J1=0 then begin GWD := 15 ; Writeln('wood') end ; if J1=1 then begin GTP := 15 ; Writeln('water') end ; end ; if ((AC='PS') and (ID in Scout+['V']) and (ID<>View[1]) and (View[1] in Scout)) and ((Random(10)=0) or (KickOut>0)) then begin if KickOut=0 then KickOut := Random(Ways+1) else if KickOut=Ways then begin Writeln('You will need First Aid soon!'^G) ; TFA := 10 ; Death := 'You were beaten up by a Patrol, and got no First Aid' end ; end ; if (AC='PS') and (ID=View[1]) and not PL then begin if Wood then begin Wood := false ; GWD := -1 ; Score('Wood gratefully received by '+Boss, 5) end ; if Water then begin Water := false ; GTP := -1 ; Score('Water thankfully accepted by '+Boss, 5) end ; end ; Write('Paths start from here heading in these directions : ') ; if N<>0 then Write('N ') ; if E<>0 then Write('E ') ; if S<>0 then Write('S ') ; if W<>0 then Write('W ') ; Writeln ; repeat Dec(TFFP) ; Dec(TQM) ; Dec(TMQ) ; Dec(TPS) ; Dec(GWD) ; Dec(GTP) ; Dec(TFA) ; Dec(THQ) ; if (AC='QM') and (TQM<0) and (Sex='M') then Score('QM says "GO AWAY!!!"', -5) ; if (AC='MQ') and (TMQ<0) and ((THQ<0) or not PL) and (ID<>'L') and (ID<>'V') and (ID<>'F') then Score('All leaders shout "GO AWAY!!!"', -3) ; if TFFP=0 then if AC='FP' then Peep('John K dismisses you') else begin Death := 'John K explodes - you aren''t fallen in ! ' ; Exit end ; if TMQ=0 then if AC='MQ' then Peep('John K sends you away OK') else begin Death := 'John K goes bananas - you aren''t at HQ ! ' ; Exit end ; if (THQ=0) and PL then if (AC='MQ') or (AC='FP') then Peep('John K holds a quick PLC and sends you away OK') else begin Death := 'John K goes berserk - you''re missing a PLC at MQ or FP ! ' ; Exit end ; if TFA=0 then if AC='FA' then Peep('Pam probably cures you OK') else Exit ; if TQM=0 then if (ID in Scout) and not PL then if AC='QM' then begin TPS := 5 ; Peep('QM gives you your food') end else begin Death := 'QM goes nuts - you aren''t collecting food ! ' ; Exit end ; if (TPS=0) and not PL then if ID=View[1] then Peep('Your PL takes the food gratefully') else begin Death := 'Your PL comes & slays you for delaying the food ! ' ; Exit end ; if GWD=0 then begin Death := 'Your PL ran out of '+'wood ! ' ; Exit end ; if GTP=0 then begin Death := 'Your PL ran out of '+'water ! ' ; Exit end ; if ((Sex='F') and (AC='LT')) or ((Sex='M') and (AC='PB')) then begin Death := 'You must not go in there ! ' ; Exit end ; if AC<>'FA' then Inc(P) ; if P>15 then begin Death := 'You have disregarded a pressing call of nature so you burst!' ; Exit end ; if Show then begin J1 := WhereY ; GotoXY(1, 1) ; ShowVars ; ClrEol ; GotoXY(1, J1) end ; Write( { P:7, TFA:7, } ' What now ? ') ; while KeyPressed do Ch := ReadKey ; Ch := UpCase(ReadKey) ; if Ch=Esc then Halt ; if Ch=#0 then begin Ch := ReadKey ; case Ch of #33: {AltF} Loud := not Loud ; #31: {AltS} Show := not Show ; #72: Ch := 'N'; #77: Ch := 'E'; #80: Ch := 'S'; #75: Ch := 'W'; else Ch := #1 end ; end {#0} ; Writeln(Ch) ; until Ch in [Sp, 'N', 'S', 'E', 'W', 'P', 'Q', 'U', 'D', '^'] ; J1 := NowAt ; case Ch of Sp : if (AC='LT') or (AC='CC') then {} Score('Don''t hang around here!', -5) ; '^' : begin Death := 'Gave up!' ; Exit end ; 'D' : begin Score('Command not yet implemented', -1) ; (* if Wood then begin Wood := false ; if ID=AC then Score(Boss+' says "Thanks for Wood"', 10) end ; if Water then begin Water := false ; if ID=AC then Score(Boss+' says "Thanks for Water"', 5) end ; *) end ; 'U' : if AC='Wd' then Wood := true else if (AC='Tp') and (GTP>0) then Water := true else Score('Cannot pick Up anything wanted', -4) ; 'N' : J1 := N ; 'E' : J1 := E ; 'S' : J1 := S ; 'W' : J1 := W ; 'Q' : begin Score('Q is costly', -2) ; ShowVars ; Write('Carrying') ; if Wood or Water then begin if Wood then Write(' Wood') ; if Water then Write(' Water') ; end { W/W } else Write(' nothing') ; Writeln end ; 'P' : DoAP ; else J1 := -1 ; end ; if J1=0 then Score('You cannot go that way from here'^G, -3) else if J1<>NowAt then begin Inc(Pts) ; if J1>0 then begin KickOut := 0 ; NowAt := J1 end ; end ; end {with}; Writeln ; until false END {MainGame} ; procedure Ask(St : string ; var Ch : char ; SC : setofchar) ; begin repeat Write(St, ' ? '^G) ; Ch := UpCase(ReadKey) ; Writeln(Ch) until Ch in SC end {Ask} ; procedure After(H, M : word; S : string) ; var IH, IM, IS, JS : word ; S1, S2 : string [2] ; begin GetTime(IH, IM, IS, JS) ; if IH*60+IM > H*60+M then begin Str(H, S1) ; Str(M, S2) ; Death := S + Sp + S1 + ':' + S2 + '.' end ; end {After} ; BEGIN GetData ; repeat Writeln ; Writeln('(>=04/01/92) ANOTHER ADVENTURE GAME "', Name, '" STARTING !') ; Writeln ; Writeln(Scene) ; Writeln ; Writeln('The object is to survive as long as you can and to score points.') ; Writeln ; Writeln('The whole site is linked by possibly peculiar twisted paths.') ; Writeln('Some paths may be one-way, but no paths change during a game.') ; Write('It has 5 Patrol sites, some Woods, a Tap, all mod cons,') ; Writeln(' and the usual HQ area.') ; Writeln ; for QQ := 1 to Npat do Scout := Scout + [Patrols[QQ].Pname[1]] ; Death := '' ; repeat while KeyPressed do ID := ReadKey ; Writeln('What sort of person are you [Scout is best] (Type first letter of ') ; Ask(' Brownie, Guide, Cub, Scout, Venture, Fellowship, Leader, Parent)', ID, Girl + Adult + ['C', 'S', 'V', Esc]) ; if ID='C' then Writeln('All Cubs must behave like Scouts at Scout Camp.') ; until ID<>'C' ; if ID='S' then begin Write('Our own Scout Patrols are: ') ; for QQ := 1 to Npat do Write(Patrols[QQ].Pname, ', ') ; Writeln(#8#8'; Extra.') ; Ask('Which one are you in (type the first letter of your Patrol)', ID, Scout + [Esc]) ; Ask('Are you the PL (Y)', Ch, ['Y', 'N']) ; PL := Ch='Y' ; end else PL := false ; if ID=Esc then Halt ; if ID in Scout then begin Write('Hello, ') ; for QQ := 1 to Npat do if ID=Patrols[QQ].Pname[1] then begin Boss := Patrols[QQ].PLis ; Write(Boss) end ; if not PL then Write(' is your PL') ; Writeln('.'^G) ; Delay(1000) end ; Sex := 'M' ; if ID in Girl then Sex := 'F' ; if ID in ['V']+Adult then Ask('Male or Female (M/F)', Sex, ['M', 'F']) ; Writeln ; if ID='B' then After(20, 00, 'Brownie''s bedtime is') ; if ID='G' then After(21, 30, 'Sheila''s & Jenny''s bedtime is') ; if PL then After(22, 15, 'PL Bedtime') else if ID in Scout then After(21, 45, 'Go to bed at') ; if ID='V' then After(21, 30, 'Ventures depart') ; if ID in ['B', 'P'] then begin Writeln('One Bell : Start of Inspection') ; Writeln('Long Bell : all go to FlagPole & wait tidily') ; Writeln('1 whistle : if PL, go to HQ and wait majestically {HQ = MQ/FP}') ; Writeln('2 whistles : if Scout, go to QM''s Store and wait humbly') ; Writeln('3 whistles : if Scout, go to Marquee and wait patiently') ; Delay(3000) end ; Delay(1000) ; ClrScr ; Writeln ; Writeln ; Writeln('Keys to use :') ; Write(' N S E W') ; for Ch := #24 to #27 do Write(Ch:2) ; Writeln(' P Q U d ^ @f @s : press keys gently !') ; Writeln ; while KeyPressed do Ch := ReadKey ; if ID='P' then begin Ask('Are any of your family on the Committee &c (Y/N)', Ch, ['Y', 'N']) ; case Ch of 'Y' : Pts := 50 ; 'N' : Pts := -50 end ; Writeln(Pts:5, ' points for that!'^G) ; Writeln ; end else if ID='L' then Pts := -100 else Pts := 0 ; if Sex='F' then P := -30000 else case ID of 'V' : P := 10 ; 'F' : P := 5 ; else P := 0 end ; TFFP := 0 ; TPS := 0 ; TQM := 0 ; TMQ := 0 ; TFA := 0 ; THQ := 0 ; KickOut := 0 ; GWD := 0 ; Wood := false ; GTP := 0 ; Water := false ; Randomize ; NowAt := Random(3)+1 ; if Death='' then MainGame ; Writeln ; Write(Death, Sp); NoSound ; for JM := 2 to 15 do begin Din(1000 div JM) ; Delay(JM*20) ; Din(JM*50) ; Delay(1000 div JM) ; NoSound end ; Writeln ; Writeln('You have been eliminated! Score is ', Pts, ' point', Plural[Abs(Pts)=1], '.') ; Writeln ; Delay(2500) ; Writeln('==========================================================':68) ; until false ; END. œ At, N, E, S, W, AC, View... # 1, 0, 2, 5, 4, xx, a Shaky Slippery Stile # 2, 0, 3, 6, 1, yy, a Gnarled and Grimy Gate # 3, 0, 8, 7, 2, zz, the Elegant Eastern Entrance # 4, 1, 5, 9, 0, LT, a Load of Large Leaning Latrines # 5, 1, 6, 10, 4, Tp, a Tin Trough and a Temporary Turnable Tap # 6, 2, 7, 11, 5, FP, a Fiendishly Floppy Flag-Pole # 7, 3, 8, 12, 6, Wd, a wet, wormy, wild and windy Wood # 8, 3, 0, 13, 7, Wd, a frightfully foetid Forest # 9, 4, 10, 14, 0, PS, Amundsens' Amazing Abode # 10, 5, 11, 15, 9, PS, Cooks' Celebrated Caf‚ # 11, 6, 12, 16, 10, PS, Drakes' Delightful Domain # 12, 7, 13, 17, 11, PS, Hillarys' High-Class Haven # 13, 8, 0, 18, 12, PS, Scotts' Superlative Site # 14, 9, 15, 19, 0, FA, a First Aid Tent, with Teddies and Dollies # 15, 10, 16, 19, 14, BT, the Bailiff's Store of Second-hand Sundries # 16, 11, 17, 16, 15, MQ, the Management's Magnificent Main Marquee # 17, 12, 18, 20, 16, QM, the QM's Cornucopia of Cookable Comestibles # 18, 13, 0, 20, 17, PB, a Cunningly Contrived Cubical Canvas Closet # 19, 0, 0, 0, 0, DD, you have fallen over a Cliff into a stream # 20, 0, 0, 0, 0, DD, you sink in a smelly swamp .. GLUG GLug glug # 0, This new 15th Wimbledon summer-camp map represents nowhere in particular.