<Á0ÀQ  4€NÃ;död›ös'uö,èö²2öy:QC ú« H8ôGw„<M:ßZf(Uœgmô&|Lö&@;sœ,p:œ,`;"m4xs‹4F|L0gM°hgMØhÇoQÅ8 oQÏ8”qQ€W¾ïY( E:dˆwwÍdÀDâïeZŠ=gf€%ÜÙfR7qP<£[qffKþvµW"þvº‰gw`;HEyø'áy s‰ zp{W z˜{­3}@¦R~gabÑZÑTŠ¶ßâL@ZŠ–-ZŠ—4ZŠ˜®ZŠ™@ZŠšHZŠ››B‘oQ\ŽÆs'ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ@P Ô€I !{********>>>>>>>><<<<<<<<********>> ADVENTURES IN PASCAL Barry C. Breen PO Box 1964 Bellevue, Washington 98009F>> History -- This version of the "Adventures" game is written in OMSIH PASCAL V1.2 running under RSX11M V3.2 BL26 on a PDP 11/23. It utilizesD special display text files for the VT-100 which makes use of double7 width and double height characters for special effect.I Adapted from a FORTRAN-IV-PLUS version obtained from DEC in Santa CLara: ADVENTURES MODIFIED BY KENT BLACKETT ENGINEERING SYSTEMS GROUPN DIGITAL EQUIPMENT CORP.  15-JUL-77, s* ORIGINAL VERSION WAS FOR DECSYSTEM-10. THIS VERSION IS FOR FORTRAN IV-PLUS UNDER. THE IAS OPERATING SYSTEM ON THE PDP-11/70B The FORTRAN version also had a notice in the text files which wasF listed in the instructions at the beginning of the game crediting the original authors as follows:TG THIS PROGRAM WAS ORIGINALLY DEVELOPED BY WILLIE CROWTHER. MOST OF THEG FEATURES OF THE CURRENT PROGRAM WERE ADDED BY DON WOODS (DON @ SU-AI). 5 CONTACT DON IF YOU HAVE ANY QUESTIONS, COMMENTS ETC.O!********>>>>>>>><<<<<<<<********} THIS VERSION IS FOR FORTRAN IV-PLUS UNDER. THE IAS OPERATING SYSTEM ON THE PDP-11/70B The FORTRAN version also had a notice in the text files which wasF listed in the instructions at the beginning of the game crediting the original authors as follows:TG THIS PROGRAM WAS ORIGINALLY DEVELOPED BY WILLIE CROWTHER. MOST OF THEG FEATURE@P ;dPÐ CONTACT DON IF YOU HAVE ANY QUESTIONS, COMMENTS ETC.O!********>>>>>>>><<<<<<<<********} THIS VERSION IS FOR FORTRAN IV-PLUS UNDER. THE IAS OPERATING SYSTEM ON THE PDP-11/70B The FORTRAN version also had a notice in the text files which wasF listed in the instructions at the beginning of the game crediting the original authors as follows:TG THIS PROGRAM WAS ORIGINALLY DEVELOPED BY WILLIE CROWTHER. MOST OF THEG FEATURE!{********>>>>>>>><<<<<<<<********>> MODULE: ADV1 29-SEP-805 This module contains the procedures GETIN and CAPS. !********>>>>>>>><<<<<<<<********} {$C .TITLE GETIN .IDENT /V0/ }7{ This procedure converts smalls to caps in a word. }PROCEDURE CAPS(VAR WRD:WORD);VAR I:INTEGER;BEGIN6 FOR I:=1 TO 5 DO IF (WRD[I]>='a')AND(WRD[I]<='z') 3 THEN WRD[I]:=CHR(ORD(WRD[I])-ORD('a')+ORD('A'))END;M{ This procedure gets the player input words. The first five characters of>Peach word are packed into WORD1 and WORD2. If the word(s) contain more than fiveLcharacters, the next five characters are packed into WORD1X and WORD2X. TheLfirst five characters are used to return word definitions (see VOCAB). The Msecond five are used when echoing player input in order not to truncate words Ohaving more than five letters (see VERBHUH and NOTHERE), words of more than tenD/letters will be truncated to the first ten. }r5PROCEDURE GETIN(VAR WORD1,WORD1X,WORD2,WORD2X: WORD);eVAR X: BOOLEAN; I,J:INTEGER;  LINES:ARRAY[1..72] OF CHAR;LABEL 1;H{ Local procedure to transfer up to five letters from input line bufferFLINES to a variable word, WORDN. X indicates end of buffer reached. }3PROCEDURE GETWORD(VAR X: BOOLEAN; VAR WORDN: WORD);cBEGINl IF I<=72 THEN FOR J:=1 TO 5 DO IF LINES[I]<>' ' THEN  BEGINr WORDN[J]:=LINES[I]; I:=I+1; IF I>72 THEN  BEGIN X:=TRUE; EXIT END END ELSE WORDN[J]:=' ' ELSE WORDN:=' ';:END; BEGIN {Getin}N2 REPEAT {Until we get some input, WORD1<>' ' } BEGIN {Skip a line from last output} WRITELN; {Write a prompt for input} WRITE('->');* {Read raw player input into line buffer} READLN(LINES); X:=FALSE;  I:=1;N {Skip over any leading blanks}, WHILE (LINES[I]=' ') AND (I<72) DO I:=I+1;+ {Get the first five non-blank characters} I GETWORD(X,WORD1);E& {Exit if end of line buffer reached} IF X THEN GOTO 1;W: {Get up to five more non-blank characters of first word}- IF (WORD1[5]<>' ') AND (LINES[I]<>' ') THEN + GETWORD(X,WORD1X) ELSE WORD1X:=' '; }& {Exit if end of line buffer reached} IF X THEN GOTO 1; @ {Skip over remaining characters of first word if more than 10}- WHILE (LINES[I]<>' ') AND (I<72) DO I:=I+1;k% {Skip over blanks in between words}O, WHILE (LINES[I]=' ') AND (I<72) DO I:=I+1;= {Get second word and extension in the same manner as first}e GETWORD(X,WORD2);E IF X THEN GOTO 1; - IF (WORD2[5]<>' ') AND (LINES[I]<>' ') THEN}) GETWORD(X,WORD2X) ELSE WORD2X:=' ';T% 1: { Jump here if line runs out. }' END UNTIL WORD1<>' '; CAPS(WORD1);c CAPS(WORD1X); CAPS(WORD2);S CAPS(WORD2X)iEND;cters of first word if more than 10}- WHILE (LINES[I]<>' ') AND (I<72) DO I:=I+1;k% {Skip over blanks in between words}O, WHILE (LINES[I]=' ') AND (I<72) DO I:=I+1;= {Get second word and extension in the same manner as first}e GETWORD(X,WORD2);E IF X THEN GOTO 1; - IF (WORD2[5]<>' ') AND@ P ;dN´% 1: { Jump here if line runs out. }' END UNTIL WORD1<>' '; CAPS(WORD1);c CAPS(WORD1X); CAPS(WORD2);S CAPS(WORD2X)iEND;cters of first word if more than 10}- WHILE (LINES[I]<>' ') AND (I<72) DO I:=I+1;k% {Skip over blanks in between words}O, WHILE (LINES[I]=' ') AND (I<72) DO I:=I+1;= {Get second word and extension in the same manner as first}e GETWORD(X,WORD2);E IF X THEN GOTO 1; - IF (WORD2[5]<>' ') AND!{********>>>>>>>><<<<<<<<********>> MODULE: PRIMETd 1-OCT-808 This module contains the "wizardry" routine PRIMETIME. t!********>>>>>>>><<<<<<<<********}Y N{$C .TITLE PRIMET  .IDENT /V0/ }@{ ******************* MAGIC MODE PROCEDURES ****************** }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBER* 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGIN 18 -- HENDM 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }(PROCEDURE RDWIZ(VAR X:INTEGER);EXTERNAL;K{ This procedure is used to extract the latest "prime time" info from the Wmagic parameters file. }1PROCEDURE PRIMETIME; TYPE DBL=ARRAY[1..2] OF INTEGER;VAR I,J:INTEGER;2{ Local procedure to read two words at a time. }PROCEDURE READ2(VAR X:DBL);.VAR I:INTEGER;BEGINg FOR I:=1 TO 2 DO RDWIZ(X[I])END;BEGIN1) { Open the magic parameters file. }S$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK');3 { Read the latest "prime time" information. }R SEEK(ADVWIZ,11); READ2(WKDAY); READ2(WKEND);s READ2(HOLID);e RDWIZ(HBEGIN); RDWIZ(HEND); FOR I:=1 TO 20 DO BEGINR RDWIZ(J); HNAME[I]:=CHR(J+ORD('A')) END; CLOSE(ADVWIZ);END;ocal procedure to read two words at a time. }PROCEDURE READ2(VAR X:DBL);.VAR I:INTEGER;BEGINg FOR I:=1 TO 2 DO RDWIZ(X[I])END;BEGIN1) { Open the magic parameters file. }S$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK');3 { Read the latest "prime time" information. }R SEEK(ADVWIZ,11); READ2(WKDAY); @P ;dLHEND); FOR I:=1 TO 20 DO BEGINR RDWIZ(J); HNAME[I]:=CHR(J+ORD('A')) END; CLOSE(ADVWIZ);END;ocal procedure to read two words at a time. }PROCEDURE READ2(VAR X:DBL);.VAR I:INTEGER;BEGINg FOR I:=1 TO 2 DO RDWIZ(X[I])END;BEGIN1) { Open the magic parameters file. }S$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK');3 { Read the latest "prime time" information. }R SEEK(ADVWIZ,11); READ2(WKDAY); !{********>>>>>>>><<<<<<<<*********>> MODULE: DATIMER 1-OCT-804 This module contains the "wizardry" routine DATIME. E!********>>>>>>>><<<<<<<<********}G N{$C .TITLE DATIME .IDENT /V0/ }C{ ********************** MAGIC MODE PROCEDURES ****************** }K{ This procedure returns the date and time in D and T. D is the number ofPKdays since 01-JAN-77, T is minutes past midnight. Since OMSI hasn't a date0)AND(MON>2) THEN D:=D+1 END;]:=28;% FOR I:=1 TO 4 DO HATH[2*I-1]:=31; % FOR I:=1 TO 3 DO HATH[2*I+6]:=31;D% FOR I:=1 TO 2 DO HATH[2*I+2]:=30;7% FOR I:=1 TO 2 DO HATH[2*I+7]:=30;S{$C GTIM$C TIMBUF MOV TIMBUF+G.TIMO,MO(%6)' MOV TIMBUF+G.TIDA,DAY(%6) MOV TIMBU@ P ;dFŽ FOR MON:=1 TO 12 DO BEGINR IF MO=MON THEN EXIT; D:=D+HATH[MON]V END;" D:=D+(YEAR-77)*365+YEAR DIV 4;C IF ((YEAR MOD 4)=0)AND((YEAR MOD 100)<>0)AND(MON>2) THEN D:=D+1 END;]:=28;% FOR I:=1 TO 4 DO HATH[2*I-1]:=31; % FOR I:=1 TO 3 DO HATH[2*I+6]:=31;D% FOR I:=1 TO 2 DO HATH[2*I+2]:=30;7% FOR I:=1 TO 2 DO HATH[2*I+7]:=30;S{$C GTIM$C TIMBUF MOV TIMBUF+G.TIMO,MO(%6)' MOV TIMBUF+G.TIDA,DAY(%6) MOV TIMBU!{********>>>>>>>><<<<<<<<********E>> MODULE: TRANSI 1-OCT-80/ This module contains the procedure TRANSITIVE.A E!********>>>>>>>><<<<<<<<********}L {$C .TITLE TRANSI* .IDENT /V0/ }7{ *************** I/O SUBROUTINES ******************* } 'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;.;{ **************** ACTION PROCEDURES ******************** }PROCEDURE WAKEDWARVES;EXTERNAL;EPROCEDURE GETOBJ;EXTERNAL;PROCEDURE DROPOBJ;EXTERNAL;oPROCEDURE SAYIT;EXTERNAL;EPROCEDURE LOCKED;EXTERNAL;PROCEDURE LAMPON;EXTERNAL;PROCEDURE LAMPOFF;EXTERNAL;oPROCEDURE WAVEIT;EXTERNAL;PROCEDURE FINDIT;EXTERNAL;PROCEDURE KILLOBJ;EXTERNAL; PROCEDURE FILLIT;EXTERNAL;PROCEDURE BLASTIT;EXTERNAL;RPROCEDURE READOBJ;EXTERNAL;PROCEDURE BREAKIT;EXTERNAL;;PROCEDURE EATOBJ;EXTERNAL;PROCEDURE DRINKIT;EXTERNAL;*PROCEDURE FEEDIT;EXTERNAL;PROCEDURE POURIT;EXTERNAL;PROCEDURE THROWOBJ;EXTERNAL;9{ ******************* VERB PROCEDURES **************** } F{ Procedure to analyze a transitive verb, i.e. object has been given.$Self-explanatory case statement....}PROCEDURE TRANSITIVE;ABEGINR CASE VERB OF; {take} 1:GETOBJ;D {drop} 2:DROPOBJ; {say} 3:SAYIT; ; {open} 4, {lock} 6:LOCKED;; {noth} 5:RSPEAK(54);  {on} 7:LAMPON; {off} 8:LAMPOFF; {wave} 9:WAVEIT;R {calm}10, {walk}11, {quit}18, {scor}24, {foo} 25, {brf} 26, {susp}30, {hour}31: RSPEAK(ACTSPK[VERB]); {kill}12: KILLOBJ;V {pour}13: POURIT; {eat} 14: EATOBJ; {drnk}15: DRINKIT; A {rub} 16: IF OBJ=LAMP THEN RSPEAK(ACTSPK[VERB]) ELSE RSPEAK(76);s {toss}17: THROWOBJ; {find}19, {inve}20: FINDIT; {feed}21: FEEDIT; {fill}22: FILLIT; {blst}23: BLASTIT;: {read}27: READOBJ;, {brek}28: BREAKIT;A {wake}29: IF (OBJ<>DWARF)OR NOT CLOSED THEN RSPEAK(ACTSPK[VERB])a ELSE BEGIN RSPEAK(199);a WAKEDWARVES ENDc ENDEND; 25, {brf} 26, {susp}30, {hour}31: RSPEAK(ACTSPK[VERB]); {kill}12: KILLOBJ;V {pour}13: POURIT; {eat} 1@ P ;dO2AK(ACTSPK[VERB]) ELSE RSPEAK(76);s {toss}17: THROWOBJ; {find}19, {inve}20: FINDIT; {feed}21: FEEDIT; {fill}22: FILLIT; {blst}23: BLASTIT;: {read}27: READOBJ;, {brek}28: BREAKIT;A {wake}29: IF (OBJ<>DWARF)OR NOT CLOSED THEN RSPEAK(ACTSPK[VERB])a ELSE BEGIN RSPEAK(199);a WAKEDWARVES ENDc ENDEND; 25, {brf} 26, {susp}30, {hour}31: RSPEAK(ACTSPK[VERB]); {kill}12: KILLOBJ;V {pour}13: POURIT; {eat} 1!{********>>>>>>>><<<<<<<<********>> MODULE: FILLIT 23-SEP-80, This module contains the procedure FILLIT.!********>>>>>>>><<<<<<<<********} {$C .TITLE FILLIT .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;.FUNCTION LIQLOC(LOC:INTEGER):INTEGER;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}<'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;.,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;?{ ************************ VERB FILL ************************ }TPROCEDURE VERBHUH;EXTERNAL;RO{ "fill" -- Bottle must be empty, and some liquid available. (Vase is nasty.)}CPROCEDURE FILLIT;EBEGINO IF OBJ=VASE THEN BEGINN( IF LIQLOC(LOCATION)=0 THEN RSPEAK(144)* ELSE IF NOT TOTING(VASE) THEN RSPEAK(29) ELSE BEGIN RSPEAK(145);A PROP[VASE]:=2;* FIXED[VASE]:=-1;  PSPEAK(VASE,3); DROP(VASE,LOCATION) ENDG END; ELSE IF (OBJ<>0)AND(OBJ<>BOTTLE) THEN RSPEAK(ACTSPK[VERB]) 1 ELSE IF (OBJ=0)AND NOT HERE(BOTTLE) THEN VERBHUH*, ELSE IF LIQLOC(LOCATION)=0 THEN RSPEAK(106) ELSE IF LIQ<>0 THEN RSPEAK(105) ELSE BEGINi2 PROP[BOTTLE]:=2*((CONDI[LOCATION] MOD 4) DIV 2);& IF TOTING(BOTTLE) THEN MOVE(LIQ,-1); JUGGLE(BOTTLE); . IF LIQ=OIL THEN RSPEAK(108) ELSE RSPEAK(107) ENDEND; ELSE BEGIN RSPEAK(145);A PROP[VASE]:=2;* FIXED[VASE]:=-1;  PSPEAK(VASE,3); DROP(VASE,LOCATION) ENDG END; ELSE IF (OBJ<>0)AND(OBJ<>BOTTLE) THEN RSPEAK(ACTSPK[VERB]) 1 ELSE IF (OBJ=0)AND NOT HERE(BOTTLE) THEN VERBHUH*, ELSE IF LIQLOC(LOCATION)=0 THEN RSPEAK(106) ELSE IF LIQ<>0 THEN RSPEAK(105) ELSE BEGINi2 PROP[BOTTLE]:=2*((CONDI[LOCATION] MOD 4) DIV 2);& IF TOTING(BOTTLE) THEN MOVE(LIQ,-1); JUGGLE(BOTTLE); . IF LIQ=O@ P ;dN  RSPEAK(145);A PROP[VASE]:=2;* FIXED[VASE]:=-1;  PSPEAK(VASE,3); DROP(VASE,LOCATION) ENDG END; ELSE IF (OBJ<>0)AND(OBJ<>BOTTLE) THEN RSPEAK(ACTSPK[VERB]) 1 ELSE IF (OBJ=0)AND NOT HERE(BOTTLE) THEN VERBHUH*, ELSE IF LIQLOC(LOCATION)=0 THEN RSPEAK(106) ELSE IF LIQ<>0 THEN RSPEAK(105) ELSE BEGINi2 PROP[BOTTLE]:=2*((CONDI[LOCATION] MOD 4) DIV 2);& IF TOTING(BOTTLE) THEN MOVE(LIQ,-1); JUGGLE(BOTTLE); . IF LIQ=O!{********>>>>>>>><<<<<<<<********>> MODULE: GETIT 22-SEP-80< This module contains the procedure GETIT, which along with& GETOBJ implements carrying an object.!********>>>>>>>><<<<<<<<********} {$C .TITLE GETIT .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;&PROCEDURE CARRY(OBJ:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}t'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;I{ ****************** VERB GET (CARRY, TAKE, etc. ) ******************** }M{ Carry an object. Special cases for bird and cage (if bird in cage, can'tTNtake one without the other. Liquids also special, since they depend on status.of bottle. Also various side effects, etc. }PROCEDURE GETIT;BEGINX3 { Can't carry more than seven objects at once. }R IF HOLDING=7 THEN RSPEAK(92)T ELSE BEGIN*2 { If trying to get the bird into the cage... }% IF (OBJ=BIRD)AND(PROP[BIRD]=0) THENE { Rod scares the bird... }R! IF TOTING(ROD) THEN RSPEAK(26)*& { If he doesn't have the cage... }+ ELSE IF NOT TOTING(CAGE) THEN RSPEAK(27)a { Otherwise, catch him... } ELSE BEGINa PROP[BIRD]:=1; CARRY(BIRD);1 { List the cage first during inventory... } JUGGLE(CAGE);E RSPEAK(54) END ELSE BEGIN% { If getting bird and cage.... }N; IF ((OBJ=BIRD)OR(OBJ=CAGE))AND(PROP[BIRD]<>0) THEN BEGINt& { Get the one not mentioned... } CARRY(BIRD+CAGE-OBJ); & { Get the one he asked for.... } CARRY(OBJ);*1 { List the cage first during inventory... }F JUGGLE(CAGE) END) { Else if getting a full bottle... }- ELSE IF (OBJ=BOTTLE)AND(LIQ<>0) THEN BEGINI. { Move liquid to player, but don't count 4 it in HOLDING by using MOVE instead of CARRY. } L MOVE(LIQ,-1);g { Snatch the bottle. } CARRY(BOTTLE)( END8 { If none of the above, CARRY whatever he wants.. } ELSE CARRY(OBJ);A RSPEAK(54)B END  ENDEND;ne he asked for.... } CARRY(OBJ);*1 { List the cage first during inventory... }F JUGGLE(CAGE) END) { Else if getting a full bottle... }- ELSE IF (OBJ=BOTTLE)AND(LIQ<>0) THEN BEGINI. { Move liquid to player, but don't count 4 it in HOLDING by using MOVE instead of CARRY. } L MOVE(LIQ,-1);g { Snatch @P ;dO$bove, CARRY whatever he wants.. } ELSE CARRY(OBJ);A RSPEAK(54)B END  ENDEND;ne he asked for.... } CARRY(OBJ);*1 { List the cage first during inventory... }F JUGGLE(CAGE) END) { Else if getting a full bottle... }- ELSE IF (OBJ=BOTTLE)AND(LIQ<>0) THEN BEGINI. { Move liquid to player, but don't count 4 it in HOLDING by using MOVE instead of CARRY. } L MOVE(LIQ,-1);g { Snatch !{********>>>>>>>><<<<<<<<********>> MODULE: DROPOB 23-SEP-80- This module contains the procedure DROPOBJ.!********>>>>>>>><<<<<<<<********} {$C .TITLE DROPOB .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;T,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;,{ ******************* VERB DROP ********** }PROCEDURE WAKEDWARVES;EXTERNAL;XK{ Discard object. "Throw" also comes here for most objects. Special casesNOfor bird (might attack snake or dragon) and cage (might contain bird) and vase.R5Drop coins at vending machine for extra batteries. }EPROCEDURE DROPOBJ;9{ Local procedure for normal drop (no side effects) ... } PROCEDURE DROPIT;*BEGIN* { "Okay.." }R RSPEAK(54);G! { Deal with liquids...... }O6 IF (LIQ=OBJ)OR((OBJ=BOTTLE)AND(LIQ<>0)) THEN BEGIN OBJ:=BOTTLE;* DESTROY(LIQ)  END;) { Handle bird and cage stuff..... }a> IF (OBJ=CAGE)AND (PROP[BIRD]<>0) THEN DROP(BIRD,LOCATION);# IF OBJ=BIRD THEN PROP[BIRD]:=0;i { Drop it! } DROP(OBJ,LOCATION)END;BEGIN { dropobj }a* { Might be dropping special rod.... }B IF TOTING(ROD2)AND(OBJ=ROD)AND NOT TOTING(ROD) THEN OBJ:=ROD2;4 { Can't drop something you're not carrying.... } D0 IF NOT TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB])@ { Handle objects with side effects at special locations....} ELSE CASE OBJ OF BIRD: IF HERE(SNAKE) THEN BEGIN { Birds scare snakes.... }) RSPEAK(30);* IF CLOSED THEN WAKEDWARVES ELSE BEGIN DESTROY(SNAKE);  PROP[SNAKE]:=1;C PROP[BIRD]:=0; DROP(BIRD,LOCATION)  END6 END ELSE IF AT(DRAGON)AND (PROP[DRAGON]=0) THEN BEGIN { Dragons eat birds.... } RSPEAK(154);  DROP(BIRD,LOCATION);a DESTROY(BIRD);  PROP[BIRD]:=0;E9 IF PLACE[SNAKE]=PLACE1[SNAKE] THEN TALLY2:=TALLY2+1;c END p/ { Other cases simply drop the fool bird.... }: ELSE DROPIT; * { Coins? ...maybe buying batteries... }# COINS: IF HERE(VENDING) THEN BEGINE DROP(COINS,LOCATION); DESTROY(COINS); MOVE(BATTERY,LOCATION); PSPEAK(BATTERY,0) END { If not, drop em.... }G ELSE DROPIT;A* { Bear may be chasing troll away..... } BEAR: IF AT(TROLL) THEN BEGIN RSPEAK(163);) DESTROY(TROLL); DESTROY(TROLL+100); MOVE(TROLL2,PLACE1[TROLL]);$ MOVE(TROLL2+100,FIXED1[TROLL]); JUGGLE(CHASM);o PROP[TROLL]:=2; DROP(BEAR,LOCATION) END ELSE DROPIT;b/ { Gotta be careful dropping them vases..... }I/ VASE: IF (LOCATION<>PLACE1[PILLOW]) THEN BEGINS9 IF AT(PILLOW) THEN PROP[VASE]:=0 ELSE PROP[VASE]:=2;E PSPEAK(VASE,PROP[VASE]+1);E+ IF PROP[VASE]<>0 THEN FIXED[VASE]:=-1;w DROP(VASE,LOCATION) END ELSE DROPIT; 1 { All other objects okay to just drop.... }Y ELSE DROPIT END { Case of obj }REND; MOVE(TROLL2+100,FIXED1[TROLL]); JUGGLE(CHASM);o PROP[TROLL]:=2; DROP(BEAR,LOCATION) END ELSE DROPIT;b/ { Gotta be careful dropping them vases..... }I/ VASE: IF (LOCATION<>PLACE1[PILLOW]) THEN @P ;dNü PSPEAK(VASE,PROP[VASE]+1);E+ IF PROP[VASE]<>0 THEN FIXED[VASE]:=-1;w DROP(VASE,LOCATION) END ELSE DROPIT; 1 { All other objects okay to just drop.... }Y ELSE DROPIT END { Case of obj }REND; MOVE(TROLL2+100,FIXED1[TROLL]); JUGGLE(CHASM);o PROP[TROLL]:=2; DROP(BEAR,LOCATION) END ELSE DROPIT;b/ { Gotta be careful dropping them vases..... }I/ VASE: IF (LOCATION<>PLACE1[PILLOW]) THEN !{********>>>>>>>><<<<<<<<********>> MODULE: KILLIT 23-SEP-809 This module contains the procedures KILLIT and KILLOBJ.!********>>>>>>>><<<<<<<<********} {$C .TITLE KILLIT .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}<'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;S,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;9PROCEDURE GETIN(VAR WRD1,WRD1X,WRD2,WRD2X:WORD);EXTERNAL;<{ ******************* VERB KILL (INTRANSITIVE) ********** }PROCEDURE VERBHUH;EXTERNAL;*PROCEDURE KILLOBJ;FORWARD;K{ This procedure and KILLOBJ for "attack" -- Assume target if unambiguous.N"Throw" also links here. Attackable objects fall into two categories: enemiesN(snake, dwarf, etc.) and others (bird, clam). Ambiguous if two enemies, or ifno enemies but two others. }NPROCEDURE KILLIT;SVAR I,J:INTEGER;BEGINT J:=0;4 FOR I:=1 TO 5 DO IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN BEGIN* J:=J+1;* OBJ:=DWARF;  EXIT END;  IF HERE(SNAKE) THEN BEGIN J:=J+1;N OBJ:=SNAKE END;L- IF AT(DRAGON) AND(PROP[DRAGON]=0) THEN BEGINo J:=J+1;- OBJ:=DRAGON  END;b IF AT(TROLL) THEN BEGIN J:=J+1;t OBJ:=TROLL END; , IF HERE(BEAR) AND (PROP[BEAR]=0) THEN BEGIN J:=J+1;h OBJ:=BEARa END;b o IF J>1 THEN VERBHUH ELSE IF OBJ<>0 THEN KILLOBJ ELSE BEGINR J:=0;S) { Can't attack bird by throwing axe. }=+ IF HERE(BIRD) AND(VERB<>THROW) THEN BEGIN J:=J+1; OBJ:=BIRD END;A { Clam and oyster both treated as clam for intransitive case. }B* IF HERE(CLAM) OR HERE(OYSTER) THEN BEGIN J:=J+1; OBJ:=CLAM END; IF J>1 THEN VERBHUH ELSE IF OBJ<>0 THEN KILLOBJJ ELSE RSPEAK(44) ENDEND;9{ ******************* VERB KILL (TRANSITIVE) ********** }BPROCEDURE WAKEDWARVES;EXTERNAL;HA{ "attack" -- See KILLIT for sorting out intransitive targets. }tPROCEDURE KILLOBJ;VAR I,K:INTEGER;BEGIND CASE OBJ OF- BIRD: IF CLOSED THEN RSPEAK(137) ELSE BEGINN DESTROY(BIRD);s PROP[BIRD]:=0; 7 IF PLACE[SNAKE]=PLACE1[SNAKE] THEN TALLY2:=TALLY2+1;Y RSPEAK(45)N END; CLAM,O OYSTER: RSPEAK(150); SNAKE: RSPEAK(46);4 DWARF: IF CLOSED THEN WAKEDWARVES ELSE RSPEAK(49); TROLL: RSPEAK(157);*+ BEAR: RSPEAK(165+((PROP[BEAR]+1) DIV 2));> { Fun stuff for dragon. If he insists on attacking it, win!B Set PROP to dead, move dragon to central location (still fixed),B move rug there (not fixed), and move him there too. Then return? with MOVED set to get a new description. If he declines the NB challenge, reset DRAGFLG to branch back and use his input as new turn. }8 DRAGON: IF PROP[DRAGON]<>0 THEN RSPEAK(167) ELSE BEGIN RSPEAK(49); VERB:=0;P OBJ:=0; GETIN(WRD1,WRD1X,WRD2,WRD2X); CASE WRD1[1] OF 'Y': BEGIN PSPEAK(DRAGON,1);  PROP[DRAGON]:=2; PROP[RUG]:=0;e 1 K:=(PLACE1[DRAGON]+FIXED1[DRAGON]) DIV 2;o MOVE(DRAGON+100,0);  MOVE(RUG+100,0); MOVE(DRAGON,K);t MOVE(RUG,K); FOR I:=1 TO MAXTRS DOl$ IF (PLACE[I]=PLACE1[DRAGON])# OR(PLACE[I]=FIXED1[DRAGON])  THEN MOVE(I,K);0 NEWLOC:=K; MOVED:=TRUE9 END; ELSE DRAGFLG:=FALSET END END; ELSE RSPEAK(ACTSPK[VERB])F ENDEND;IN@ P ;dG–[RUG]:=0;e 1 K:=(PLACE1[DRAGON]+FIXED1[DRAGON]) DIV 2;o MOVE(DRAGON+100,0);  MOVE(RUG+100,0); MOVE(DRAGON,K);t MOVE(RUG,K); FOR I:=1 TO MAXTRS DOl$ IF (PLACE[I]=PLACE1[DRAGON])# OR(PLACE[I]=FIXED1[DRAGON])  THEN MOVE(I,K);0 NEWLOC:=K; MOVED:=TRUE9 END; ELSE DRAGFLG:=FALSET END END; ELSE RSPEAK(ACTSPK[VERB])F ENDEND;IN!{********>>>>>>>><<<<<<<<********>> MODULE: BACKUP 11-OCT-80, This module contains the procedure BACKUP. !********>>>>>>>><<<<<<<<********} {$C .TITLE BACKUP .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }.FUNCTION FORCED(LOC:INTEGER):BOOLEAN;EXTERNAL;C{ ************ VERBS BACKUP, RETREAT, ETC. ********************* }G{ Handle "go back". Look for verb which goes from LOCATION to OLDLOC,>or to OLDLC2 if OLDLOC has forced motion. BACKUP returns withFI=LOCATION if we forgot how he got here, or with a new LINK1 such that9I=LINK1^.NEWLOC[2], if we found a verb to retreat with. }*2PROCEDURE BACKUP(VAR I:INTEGER;VAR LINK1:KEYLINK);BEGIN*1 { Set up what he wants NEWLOC to be in I. }*4 IF FORCED(OLDLOC) THEN I:=OLDLC2 ELSE I:=OLDLOC;. { Save new OLDLC2 and OLDLOC as usual. } OLDLC2:=OLDLOC;  OLDLOC:=LOCATION;kB { If where he wants to go is here, we forgot how he got here,: so just return. Otherwise, search for a way back. } IF I<>LOCATION THEN BEGIN,) { Point to the key link for LOCATION. }W LINK1:=KEY[LOCATION];@ { Traverse the key links until we find I as a new location for ( LOCATION or we run out of key links. }. WHILE (LINK1<>NIL)AND(LINK1^.NEWLOC[2]<>I) DO; { If new location is forced to I, then replace I with the d@ forced location (which terminates the "WHILE" loop); otherwise  go to the next key link. }! IF LINK1^.NEWLOC[2]<=LOCSIZ THENr IF FORCED(LINK1^.NEWLOC[2]) AND% (KEY[LINK1^.NEWLOC[2]]^.NEWLOC[2]=I)> THEN I:=LINK1^.NEWLOC[2] ELSE2 LINK1:=LINK1^.NXTLINK ELSE LINK1:=LINK1^.NXTLINK ENDTEND;the key links until we find I as a new location for ( LOCATION or we run out of key links. }. WHILE (LINK1<>NIL)AND(LINK1^.NEWLOC[2]<>I) DO; { If new location is forced to I, then replace I with the d@ forced location (which terminates the "WHILE" loop); otherwise  go to the next key link. }! IF LINK1^.NEWLOC[2]<=LOCSIZ THENr IF FORCED(LINK1^.NEWLOC@P ;dOŒNEWLOC[2] ELSE2 LINK1:=LINK1^.NXTLINK ELSE LINK1:=LINK1^.NXTLINK ENDTEND;the key links until we find I as a new location for ( LOCATION or we run out of key links. }. WHILE (LINK1<>NIL)AND(LINK1^.NEWLOC[2]<>I) DO; { If new location is forced to I, then replace I with the d@ forced location (which terminates the "WHILE" loop); otherwise  go to the next key link. }! IF LINK1^.NEWLOC[2]<=LOCSIZ THENr IF FORCED(LINK1^.NEWLOC!{********>>>>>>>><<<<<<<<********>> MODULE: PLOVER 13-OCT-80, This module contains the procedure PLOVER. !********>>>>>>>><<<<<<<<********} {$C .TITLE PLOVER .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;>{ ***************** TRAVEL TABEL PROCEDURES **************** }O{ Travel 301. Plover-alcove passage. Can carry only emerald. Note: Travel 8Otable must include "useless" entries going through passage, which can never be *;used for actual motion, but can be spotted by "go back". }*PROCEDURE PLOVER; BEGINR NEWLOC:=99+100-LOCATION;F IF (HOLDING<>0)AND NOT ((HOLDING=1)AND TOTING(EMERALD)) THEN BEGIN NEWLOC:=LOCATION; RSPEAK(117) ENDEND;EDURE RSPEAK(MSG:INTEGER);EXTERNAL;>{ ***************** TRAVEL TABEL PROCEDURES **************** }O{ Travel @ P ;dPâel 8Otable must include "useless" entries going through passage, which can never be *;used for actual motion, but can be spotted by "go back". }*PROCEDURE PLOVER; BEGINR NEWLOC:=99+100-LOCATION;F IF (HOLDING<>0)AND NOT ((HOLDING=1)AND TOTING(EMERALD)) THEN BEGIN NEWLOC:=LOCATION; RSPEAK(117) ENDEND;EDURE RSPEAK(MSG:INTEGER);EXTERNAL;>{ ***************** TRAVEL TABEL PROCEDURES **************** }O{ Travel !{********>>>>>>>><<<<<<<<********>> MODULE: TROLLB 13-OCT-80, This module contains the procedure TROLLB. !********>>>>>>>><<<<<<<<********} {$C .TITLE TROLLB .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;p,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;>{ **************** TRAVEL TABLE PROCEDURES ***************** }O{ Travel 303. Troll Bridge. Must be done only as special motion so that the :Ldwarves won't wander across and encounter the bear. (They won't follow the Pplayer there because that region is forbidden to the pirate.) If PROP[TROLL]=1, Phe's crossed since paying, so step out and block him. (Standard travel entries >check for PROP[TROLL]=0.) Also, special stuff for the bear. }PROCEDURE TROLLBRIDGE;BEGINP IF PROP[TROLL]=1 THEN BEGIN* PSPEAK(TROLL,1);A PROP[TROLL]:=0; DESTROY(TROLL2); DESTROY(TROLL2+100);r MOVE(TROLL,PLACE1[TROLL]);p MOVE(TROLL+100,FIXED1[TROLL]);e JUGGLE(CHASM);r NEWLOC:=LOCATIONh END( ELSE BEGIN. NEWLOC:=PLACE1[TROLL]+FIXED1[TROLL]-LOCATION;& IF PROP[TROLL]=0 THEN PROP[TROLL]:=1; IF TOTING(BEAR) THEN BEGINs RSPEAK(162);k PROP[CHASM]:=1; PROP[TROLL]:=2; DROP(BEAR,NEWLOC);c FIXED[BEAR]:=-1;  PROP[BEAR]:=3;B- IF PROP[SPICES]<0 THEN TALLY2:=TALLY2+1;* OLDLC2:=NEWLOC; NEWLOC:=-1 END END)END;ESTROY(TROLL2+100);r MOVE(TROLL,PLACE1[TROLL]);p MOVE(TROLL+100,FIXED1[TROLL]);e JUGGLE(CHASM);r NEWLOC:=LOCATIONh END( ELSE BEGIN. NEWLOC:=PLACE1[TROLL]+FIXED1[TROLL]-LOCATION;& IF PROP[TROLL]=0 THEN PROP[TROLL]:=1; IF TOTING(BEAR) THEN BEGINs RSPEAK(162);k@P ;dI¾C);c FIXED[BEAR]:=-1;  PROP[BEAR]:=3;B- IF PROP[SPICES]<0 THEN TALLY2:=TALLY2+1;* OLDLC2:=NEWLOC; NEWLOC:=-1 END END)END;ESTROY(TROLL2+100);r MOVE(TROLL,PLACE1[TROLL]);p MOVE(TROLL+100,FIXED1[TROLL]);e JUGGLE(CHASM);r NEWLOC:=LOCATIONh END( ELSE BEGIN. NEWLOC:=PLACE1[TROLL]+FIXED1[TROLL]-LOCATION;& IF PROP[TROLL]=0 THEN PROP[TROLL]:=1; IF TOTING(BEAR) THEN BEGINs RSPEAK(162);k!{********>>>>>>>><<<<<<<<********>> MODULE: NOWAY 13-OCT-80+ This module contains the procedure NOWAY. !********>>>>>>>><<<<<<<<********} {$C .TITLE NOWAY .IDENT /V0/ }9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;B{ ***************** TRAVEL TABLE PROCEDURES ******************** }I{ Non-applicable motion. Various messages depending upon word given. }PROCEDURE NOWAY;VAR I:INTEGER;BEGIN NEWLOC:=LOCATION;*1 IF (K>=43)AND(K<=50) THEN I:=9 ELSE CASE K OF3 29,30: I:=9;h 7,36,37: I:=10; 11,19: I:=11; 62,65: I:=42; 17: I:=80;< ELSE I:=12* END; RSPEAK(I)YEND;T /V0/ }9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;B{ ***************** TRAVEL TABLE PROCEDURES ******************** }I{ Non-applicable motion. Various messages depending upon word given. }PROCEDURE NOWAY;VAR I:INTEGER;BEGIN NEWLOC:=@P ;dN–9,30: I:=9;h 7,36,37: I:=10; 11,19: I:=11; 62,65: I:=42; 17: I:=80;< ELSE I:=12* END; RSPEAK(I)YEND;T /V0/ }9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;B{ ***************** TRAVEL TABLE PROCEDURES ******************** }I{ Non-applicable motion. Various messages depending upon word given. }PROCEDURE NOWAY;VAR I:INTEGER;BEGIN NEWLOC:=!{********>>>>>>>><<<<<<<<********S>> MODULE: SAYIT 13-OCT-80I+ This module contains the procedure SAYIT.N!********>>>>>>>><<<<<<<<********}  R{$C .TITLE SAYIT .IDENT /V0/ }HA{********************* VERB SAY *****************************}(PROCEDURE ECHO;EXTERNAL; FUNCTION MAGIC:BOOLEAN;EXTERNAL;PROCEDURE PARSE;EXTERNAL;RN{ "Say" -- Echo WRD2-WRD2X, unless input in response to "Say what?", in whichGcase we echo the entire input: "drop keys" . Magic words override.. }*PROCEDURE SAYIT;BEGIN ! { Check for magic words... }I IF MAGIC THEN PARSEs { Otherwise, say it.... } ELSE ECHO<END;****}  R{$C .TITLE SAYIT .IDENT /V0/ }HA{********************* VERB SAY *****************************}(PROCEDURE ECHO;EXTERNAL; FUNCTION MAGIC:BOOLEAN;EXTERNAL;PROCEDURE PARSE;EXTERNAL;RN{ "Say" -- Echo WRD2-WRD2X, unless input in response to "Say what?", in whichGcase we echo the entire input: "drop keys" . Magic words overri@P ;dP x }I IF MAGIC THEN PARSEs { Otherwise, say it.... } ELSE ECHO<END;****}  R{$C .TITLE SAYIT .IDENT /V0/ }HA{********************* VERB SAY *****************************}(PROCEDURE ECHO;EXTERNAL; FUNCTION MAGIC:BOOLEAN;EXTERNAL;PROCEDURE PARSE;EXTERNAL;RN{ "Say" -- Echo WRD2-WRD2X, unless input in response to "Say what?", in whichGcase we echo the entire input: "drop keys" . Magic words overri!{********>>>>>>>><<<<<<<<********>> MODULE: RESPON 13-OCT-80. This module contains the procedure RESPONSE.!********>>>>>>>><<<<<<<<********} {$C .TITLE RESPON .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }-FUNCTION RAN(RANGE:INTEGER):INTEGER;EXTERNAL;0FUNCTION BITSET(LOC,N:INTEGER):BOOLEAN;EXTERNAL;.FUNCTION LIQLOC(LOC:INTEGER):INTEGER;EXTERNAL;FUNCTION DARK:BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}>'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;O>PROCEDURE GETIN(VAR WORD1,WORD1X,WORD2,WORD2X: WORD);EXTERNAL;>{************* MAIN PROGRAM PROCEDURES ********************}PROCEDURE HINTROUTINE;EXTERNAL;*PROCEDURE FINISH;EXTERNAL;PROCEDURE MAINTINENCE;EXTERNAL;NPROCEDURE CLSECLUE;EXTERNAL;PROCEDURE ENDDEMO;EXTERNAL;EPROCEDURE CLOSECAVE;EXTERNAL;NPROCEDURE CAVECLOSING;EXTERNAL;APROCEDURE LAMPDIM;EXTERNAL;EPROCEDURE DUMPWD1;EXTERNAL; PROCEDURE OVRLOAD;EXTERNAL;*PROCEDURE PARSE;EXTERNAL;IP{ This procedure is the next most important nested block below the main programLblock. It gets the player input and controls a number of conditions on each5turn (counting down to cave closing, for example). }PROCEDURE RESPONSE;CBEGINNP { Player input is parsed into a verb or object value (or both) in order to N understand what he wants us to do. Sometimes it takes two input turns to 9 make sense (if possible) out of what the jerk typed. AD Once we've got a valid defintion and responded to his instructions,K the object and verb values are zeroed out before getting more input. } OBJ:=0;a VERB:=0; REPEAT { until gotboth }uE { GOTBOTH is used to indicate whether we need further input before E G responding. It is set "true" initially in case because we assume his hG input will be complete. Should he type "drop", for example, and he's sC carrying six things, procedure VERBHUH would be called to respond rF "Drop what?", GOTBOTH would be set false and the input loop would be < repeated from here without first zeroing out VERB again. } GOTBOTH:=TRUE;u9 { Before getting his input, go do the "hints" stuff. }b HINTROUTINE;BG { If we're in the repository, go see whether to give him the clue on o5 the oyster (which really isn't much help anyway). }s IF CLOSED THEN CLSECLUE;c. { Keep track if it's dark twice in a row. } WZDARK:=DARK;A { Get rid of the dwarf's knife if moved from scene of attack. }r5 IF (KNFLOC>0) AND (KNFLOC<>LOCATION) THEN KNFLOC:=0;pI { Kick the random number generator just to add variety to the chase. }G I:=RAN(100);0 { Get the next command from our Adventurer. } GETIN(WRD1,WRD1X,WRD2,WRD2X);H { If trying to kill the dragon and blowing it, the player input comes G from KILLOBJ so the loop would be repeated from here. DRAGFLG is set E% FALSE by KILLOBJ if this happens. }n REPEAT { until dragflg }  DRAGFLG:=TRUE;aI { Every input, check "FOOBAR" flag. If zero, nothing's going on. OE If positive, make negative. If negative and VERB is not "say", a+ he skipped a word, so make it zero. }G IF FOOBAR>0 THEN FOOBAR:=-FOOBAR ELSE IF VERB<>SAY THEN FOOBAR:=0;W { Chalk up another turn. }  TURNS:=TURNS+1;/ { Tick CLOCK2 once CLOCK1 has run out. }o' IF CLOCK1<0 THEN CLOCK2:=CLOCK2-1;sF { Invoke wizardry routines if he says "Magic Mode" on his first ? turn and terminate demo games during prime time, otherwiseg continue with the turn. }OD IF (WRD1='MAGIC')AND(WRD2='MODE ')AND(TURNS=1) THEN MAINTINENCE0 ELSE IF DEMO AND(TURNS>=SHORT) THEN ENDDEMO ELSE BEGINT- { When CLOCK2 runs out, close the cave. }A IF CLOCK2=0 THEN BEGIN CLOSECAVE; MOVED:=TRUE END A { If his lamp is dead and he's outside the cave, force him to C: give up since there's no way to get to the batteries. }. ELSE IF (LIMIT<0)AND(LOCATION<=8) THEN BEGIN RSPEAK(185); GAVEUP:=TRUE;s FINISH ENDh ELSE BEGIN@ { If he's found all the treasures, tick CLOCK1 when deep ) into the cave (and not at "Y2"). }H$ IF (TALLY=0)AND(LOCATION>=15) . AND(LOCATION<>33) THEN CLOCK1:=CLOCK1-1;A { If CLOCK1 runs out, begin to close the cave. Otherwise ( go handle the lamp limit stuff. } e0 IF CLOCK1=0 THEN CAVECLOSING ELSE LAMPDIM;$ { Special case for waders. }? IF (WRD1='ENTER')AND((WRD2='STREA')OR(WRD2='WATER')) THENA? IF LIQLOC(LOCATION)=WATER THEN RSPEAK(70) ELSE RSPEAK(43)s ELSE BEGIN< { Other instances of "enter" look at second word only. }3 IF (WRD1='ENTER')AND(WRD2<>' ') THEN DUMPWD1 4 { Special case where "water" and "oil" are used  as verbs. }u+ ELSE IF ((WRD1='WATER')OR(WRD1='OIL ')) : AND((WRD2='PLANT')OR(WRD2='DOOR ')) THEN WRD2:='POUR ';8 { Now jump down to the next nesting level and parse : the current command. Dummy procedure OVRLOAD is called. to pull in the most common overlay tree. }$ REPEAT OVRLOAD;PARSE UNTIL NODUMP ENDG END{ END UNTIL DRAGFLG UNTIL GOTBOTHrEND; }3 IF (WRD1='ENTER')AND(WRD2<>' ') THEN DUMPWD1 4 { Special case where "water" and "oil" are used  as verbs. }u+ ELSE IF ((WRD1='WATER')OR(WRD1='OIL ')) : AND((WRD2='PLANT')OR(WRD2='DOOR ')) THEN WRD2:='POUR ';8 { Now jump down to the next nesting level and parse : the current command. Dummy procedure OVRLOAD is called. to pull in the most common overlay @ P ;dP* END UNTIL DRAGFLG UNTIL GOTBOTHrEND; }3 IF (WRD1='ENTER')AND(WRD2<>' ') THEN DUMPWD1 4 { Special case where "water" and "oil" are used  as verbs. }u+ ELSE IF ((WRD1='WATER')OR(WRD1='OIL ')) : AND((WRD2='PLANT')OR(WRD2='DOOR ')) THEN WRD2:='POUR ';8 { Now jump down to the next nesting level and parse : the current command. Dummy procedure OVRLOAD is called. to pull in the most common overlay !{********>>>>>>>><<<<<<<<********v>> MODULE: SUBS0 15-OCT-80N< This module contains the data structure functions TOTING, * HERE, BITSET, FORCED, DARK, RAN, and PCT.!********>>>>>>>><<<<<<<<********}A N{$C .TITLE SUBS0 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** } ({ True if player is carrying object. }%FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;BEGINN TOTING:=(PLACE[OBJ]=-1)END;K{ This function is true if an object is at the player's current location or<being carried. }#FUNCTION HERE(OBJ:INTEGER):BOOLEAN;hBEGINl+ HERE:=(PLACE[OBJ]=LOCATION) OR TOTING(OBJ)GEND;)FUNCTION BIT(I:INTEGER):INTEGER;EXTERNAL;*H{ This function is true if argument location has bit n set in CONDI. }'FUNCTION BITSET(LOC,N:INTEGER):BOOLEAN;NBEGIN*( BITSET:=((CONDI[LOC] AND BIT(N))<>0)END;5{ This function is true if loc has forced motion. }E%FUNCTION FORCED(LOC:INTEGER):BOOLEAN;BEGINf FORCED:=(CONDI[LOC]=2)eEND;K{ This function is true if the current LOCATION has no source of light. }EFUNCTION DARK:BOOLEAN;BEGIN(G DARK:= NOT BITSET(LOCATION,0) AND ((PROP[LAMP]=0) OR (NOT HERE(LAMP)))EEND;P{ Random number function is a hybrid developed from the one in the F4P version Mand the one supplied as a demo program with OMSI. It is seeded from the timeD5of day an returns an integer value from 1 to RANGE. }a$FUNCTION RAN(RANGE:INTEGER):INTEGER;FUNCTION RANDOM:REAL;BEGIN" SEED:=(SEED*13077+6925)MOD 32768; RANDOM:=SEED/32768.0iEND;BEGIN  IF STRTRAN THEN BEGIN SEED:=TRUNC(TIME*1000.0);L STRTRAN:=FALSE END;  RAN:=TRUNC(RANDOM*RANGE)+1[END;2{ This function is true n percent of the time. } o FUNCTION PCT(N:INTEGER):BOOLEAN;VAR I:INTEGER;BEGIN I:=RAN(100);p PCT:=(I>>>>>>><<<<<<<<********>> MODULE: WIZMAG 15-OCT-809 This module contains the "wizardry" routines GETMAGIC,  WRTMAGIC, and CHKMAGIC.!********>>>>>>>><<<<<<<<********} {$C .TITLE WIZMAG .IDENT /V0/ }={ *************** DATA STRUCTURE ROUTINES ***************** }-FUNCTION RAN(RANGE:INTEGER):INTEGER;EXTERNAL;B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBER< 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGIN* 18 -- HENDC 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }(PROCEDURE RDWIZ(VAR X:INTEGER);EXTERNAL;!TYPE ARR5=ARRAY[1..5] OF INTEGER;NL{ The follwing three procedures are used by the WIZARD function to test forNwizards. The first extracts the current magic word and number from ADVWIZ. }<PROCEDURE GETMAGIC(VAR MAGICNUMBER:ARR5;VAR MAGICWORD:WORD);VAR I:INTEGER;BEGIN + { Open magic parameters file, seek. }e$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK');! { Get present parameters. }6 SEEK(ADVWIZ,1);t FOR I:=1 TO 5 DO BEGIN RDWIZ(MAGICNUMBER[I]);R+ MAGICWORD[I]:=CHR(MAGICNUMBER[I]+ORD('A'))= END;* FOR I:=1 TO 5 DO RDWIZ(MAGICNUMBER[I])END;M{ This procedure is used to challenge the player with a random magic word. }r'PROCEDURE WRTMAGIC(VAR MAGICWORD:WORD);}VAR I:INTEGER;BEGINR9 FOR I:=1 TO 5 DO MAGICWORD[I]:=CHR(ORD('A')+RAN(25));I WRITELN; a WRITELN(MAGICWORD)END;N{ This function returns true if the player input word is the correct functionCof the random magic word, the time of day, and the magic number. }?FUNCTION CHKMAGIC(WRD,MAGICWORD:WORD;MAGICNUMBER:ARR5):BOOLEAN;:VAR WRDX:WORD; I,MAGICTIME:INTEGER;BEGIN  MAGICTIME:=TRUNC(TIME);eH FOR I:=1 TO 5 DO WRDX[I]:=CHR(ORD('A')+((ORD(MAGICWORD[I])-ORD('A')+' MAGICNUMBER[I]+MAGICTIME) MOD 26)); 9 IF WRD1=WRDX THEN CHKMAGIC:=TRUE ELSE CHKMAGIC:=FALSETEND; WRITELN(MAGICWORD)END;N{ This function returns true if the pla@ P ;dPìthe time of day, and the magic number. }?FUNCTION CHKMAGIC(WRD,MAGICWORD:WORD;MAGICNUMBER:ARR5):BOOLEAN;:VAR WRDX:WORD; I,MAGICTIME:INTEGER;BEGIN  MAGICTIME:=TRUNC(TIME);eH FOR I:=1 TO 5 DO WRDX[I]:=CHR(ORD('A')+((ORD(MAGICWORD[I])-ORD('A')+' MAGICNUMBER[I]+MAGICTIME) MOD 26)); 9 IF WRD1=WRDX THEN CHKMAGIC:=TRUE ELSE CHKMAGIC:=FALSETEND; WRITELN(MAGICWORD)END;N{ This function returns true if the pla!{********>>>>>>>><<<<<<<<********>> MODULE: THROWO 16-OCT-80. This module contains the procedure THROWOBJ.!********>>>>>>>><<<<<<<<********} {$C .TITLE THROWO .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }-FUNCTION RAN(RANGE:INTEGER):INTEGER;EXTERNAL;+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************} 'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;T5{ ******************* VERB THROW ****************** }RPROCEDURE DROPOBJ;EXTERNAL;RPROCEDURE FEEDIT;EXTERNAL;PROCEDURE KILLIT;EXTERNAL;PROCEDURE SNARF;EXTERNAL;RPROCEDURE THROWAXE;EXTERNAL;L{ "throw" -- Same as discard unless axe. Then same as attack except ignore Hbird and if dwarf present then one might be killed (only way to do so!).PAxe is also special for dragon, bear, and troll. Treasures special for troll. }PROCEDURE THROWOBJ;VAR I:INTEGER;BEGINI@ IF TOTING(ROD2) AND(OBJ=ROD)AND NOT TOTING(ROD) THEN OBJ:=ROD2;- IF NOT TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB])R5 ELSE IF (OBJ>=50)AND(OBJ<=MAXTRS)AND AT(TROLL) THEN % { Snarf a treasure for the troll! } R SNARF, ELSE IF (OBJ=FOOD)AND HERE(BEAR) THEN BEGIN( { Throwing food at the bear is okay! } OBJ:=BEAR; FEEDIT END0 { Anything else other than the axe, drop it. } ELSE IF OBJ<>AXE THEN DROPOBJ. { Else he's thrown his axe at something... } ELSE THROWAXE;   IF OBJ=0 THEN KILLITIEND;TING(ROD2) AND(OBJ=ROD)AND NOT TOTING(ROD) THEN OBJ:=ROD2;- IF NOT TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB])R5 ELSE IF (OBJ>=50)AND(OBJ<=MAXTRS)AND AT(TROLL) THEN % { Snarf a treasure for the troll! } R SNARF, ELSE IF (OBJ=FOOD)AND HERE(BEAR) THEN BEGIN( { Throwing food @ P ;dO*else other than the axe, drop it. } ELSE IF OBJ<>AXE THEN DROPOBJ. { Else he's thrown his axe at something... } ELSE THROWAXE;   IF OBJ=0 THEN KILLITIEND;TING(ROD2) AND(OBJ=ROD)AND NOT TOTING(ROD) THEN OBJ:=ROD2;- IF NOT TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB])R5 ELSE IF (OBJ>=50)AND(OBJ<=MAXTRS)AND AT(TROLL) THEN % { Snarf a treasure for the troll! } R SNARF, ELSE IF (OBJ=FOOD)AND HERE(BEAR) THEN BEGIN( { Throwing food !{********>>>>>>>><<<<<<<<********>> MODULE: SAVVAR 17-OCT-80< This module contains the procedure SAVVAR which is used byE SAVE to save key variable values required to restart a saved game. !********>>>>>>>><<<<<<<<********} {$C .TITLE SAVVAR  .IDENT /V0/ }@{ ****************** SUSPEND PROCEDURE *********************** }8PROCEDURE DATIME(VAR D:UNSIGNED;VAR T:INTEGER);EXTERNAL;N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERe 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGIN 18 -- HENDE 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }$PROCEDURE WRWIZ(J:INTEGER);EXTERNAL;%PROCEDURE WRWIZB(X:BOOLEAN);EXTERNAL;NI{ The following procedure is used to save a copy of enough key variablesHMinto ADVWIZ.DTA so that a player may resume his Adventure where he left off. aOGlobal variable I is a record pointer into ADVWIZ; refer to comment in WRWIZ. }mPROCEDURE SAVVAR(SAV:INTEGER);VAR J,SAVET:INTEGER; SAVED:UNSIGNED;eBEGIN1 I:=253*(SAV-1)+102;g SEEK(ADVWIZ,I);  DATIME(SAVED,SAVET); WRWIZ(SAVED);e WRWIZ(SAVET);C WRWIZ(LOCATION); WRWIZ(HOLDING);R FOR J:=1 TO MAXTRS DO BEGIN WRWIZ(PLACE[J]);o WRWIZ(FIXED[J]);a WRWIZ(PROP[J])g END; WRWIZ(TALLY);. WRWIZ(TALLY2); WRWIZ(DFLAG);e WRWIZ(TURNS);  WRWIZ(IWEST);a  WRWIZ(KNFLOC); WRWIZ(NUMDIE); WRWIZ(DKILL);Z WRWIZ(CLOCK1); WRWIZ(CLOCK2); WRWIZ(LIMIT); FOR J:=1 TO 10 DO BEGIN WRWIZ(HINTLC[J]); WRWIZB(HINTED[J]) END; FOR J:=1 TO 6 DO BEGIN WRWIZ(ODLOC[J]);  WRWIZ(DLOC[J]); WRWIZB(DSEEN[J]) END; WRWIZB(WZDARK);: WRWIZB(LMWARN); WRWIZB(CLOSING); WRWIZB(PANIC); WRWIZB(CLOSED);  WRWIZ(NEWLOC); WRWIZ(OLDLC2); WRWIZ(OLDLOC)AEND; WRWIZ(TURNS);  WRWIZ(IWEST);a  WRWIZ(KNFLOC); WRWIZ(NUMDIE); WRWIZ(DKILL);Z WRWIZ(CLOCK1); WRWIZ(CLOCK2); WRWIZ(LIMIT); FOR J:=1 TO 10 DO BEGIN WRWIZ(HINTLC[J]);@ P ;dORDLOC[J]);  WRWIZ(DLOC[J]); WRWIZB(DSEEN[J]) END; WRWIZB(WZDARK);: WRWIZB(LMWARN); WRWIZB(CLOSING); WRWIZB(PANIC); WRWIZB(CLOSED);  WRWIZ(NEWLOC); WRWIZ(OLDLC2); WRWIZ(OLDLOC)AEND; WRWIZ(TURNS);  WRWIZ(IWEST);a  WRWIZ(KNFLOC); WRWIZ(NUMDIE); WRWIZ(DKILL);Z WRWIZ(CLOCK1); WRWIZ(CLOCK2); WRWIZ(LIMIT); FOR J:=1 TO 10 DO BEGIN WRWIZ(HINTLC[J]);!{********>>>>>>>><<<<<<<<********>> MODULE: DUMPWD 17-OCT-80< This module contains the procedures DUMPWD1, SMALL, DOWHAT NOTHERE,and VERBHUH. !********>>>>>>>><<<<<<<<********} {$C .TITLE DUMPWD .IDENT /V0/ }={ ************** OBJECT,VERB DEFAULT PROCEDURES *********** }O{ This procedure is used to throw away the first player input word and get thesecond for analysis. } PROCEDURE DUMPWD1;BEGIN WRD1:=WRD2; WRD1X:=WRD2X; WRD2:=' 'END;J{ This procedure is used by the default procedures below to echo player'sFinput in small letters. Input in other characters is left as is. }PROCEDURE SMALL(WRD:WORD);VAR I,J:INTEGER;BEGIN* J:=ORD('A')-ORD('a');M* FOR I:=1 TO 5 DO IF WRD[I]<>' ' THEN & IF (WRD[I]>='A')AND(WRD[I]<='Z') THEN WRITE(CHR(ORD(WRD[I])-J)) ELSE WRITE(WRD[I]);END;L{ This procedure responds to verbs requiring a definite object and none hasLbeen given or can be deduced. I changed this from the original program. ItLused to echo the verb with "huh?", it now echoes the verb with "what?" which#seems to read easier. For example, / Player is carrying six things and says "DROP". ; We say "Drop what?" (makes more sense than "Drop huh?") 1<Purists, you may simply change it back if you like....... }PROCEDURE VERBHUH;VAR J,I:INTEGER;BEGINT; { Echo the first letter capitalized and the rest small. }r J:=ORD('A')-ORD('a'); WRITELN;( IF (WRD1[1]>='a')AND(WRD1[1]<='z') THEN WRITE(CHR(ORD(WRD1[1])+J)). ELSE WRITE(WRD1[1]);v FOR I:=2 TO 5 DO  IF WRD1[I]<>' ' THEN ) IF (WRD1[I]>='A')AND(WRD1[I]<='Z') THENe WRITE(CHR(ORD(WRD1[I])-J)) ELSE WRITE(WRD1[I]); SMALL(WRD1X); WRITELN(' what?');r OBJ:=0; GOTBOTH:=FALSE1END;>{ Reverse of VERBHUH, applies when object given with no verb:1 "What do you want me to do with the snake?" } PROCEDURE DOWHAT;l dVAR I,J:INTEGER;BEGIN WRITELN;). WRITE('What do you want me to do with the '); SMALL(WRD1);N SMALL(WRD1X); WRITELN('?')END;M{ An object must be here in order to do something with it. This procedure AKechoes the player input if it is defined as an object but it isn't here to )muck with: "I see no pyramid here." }=PROCEDURE NOTHERE;BEGIN WRITELN;e WRITE('I see no '); SMALL(WRD1);n SMALL(WRD1X); WRITELN(' here.')END;with the snake?" } PROCEDURE DOWHAT;l dVAR I,J:INTEGER;BEGIN WRITELN;). WRITE('What do you want me to do with the '); SMALL(WRD1);N SMALL(WRD1X); WRITELN@P ;dI2 with it. This procedure AKechoes the player input if it is defined as an object but it isn't here to )muck with: "I see no pyramid here." }=PROCEDURE NOTHERE;BEGIN WRITELN;e WRITE('I see no '); SMALL(WRD1);n SMALL(WRD1X); WRITELN(' here.')END;with the snake?" } PROCEDURE DOWHAT;l dVAR I,J:INTEGER;BEGIN WRITELN;). WRITE('What do you want me to do with the '); SMALL(WRD1);N SMALL(WRD1X); WRITELN!{********>>>>>>>><<<<<<<<********>> MODULE: FINISH 17-SEP-80= This module contains the procedures FINISH and WAKEDWARVES.!********>>>>>>>><<<<<<<<********} {$C .TITLE FINISH .IDENT /V0/ }9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;1PROCEDURE CSPEAK(SCORE,MAXSCOR:INTEGER);EXTERNAL;F{******************* SCORING AND GAME END ***************************}PROCEDURE CALSCORE;EXTERNAL;PROCEDURE WRTSCORE;EXTERNAL;4{ This procedure implements the end of the game. }PROCEDURE FINISH;sBEGIN " { First caluculate the score. } CALSCORE; { Now write it out. } WRTSCORE;+ { Print out his player classification. } CSPEAK(SCORE,MAXSCOR);U WRITELN; WRITELN;*I { Set program control flags to cause exit from the main program loop. }S MOVED:=TRUE;T DONE:=TRUELEND;9{ ************ WAKE DWARVES IN REPOSITORY ************* }*.{ Oh dear, he's disturbed the dwarves.... }PROCEDURE WAKEDWARVES;BEGINi RSPEAK(136);l FINISHeEND;the game. }PROCEDURE FINISH;sBEGIN " { First caluculate the score. } CALSCORE; { Now write it out. } WRTSCORE;+ { Print out his player classification. } CSPEAK(SCORE,MAXSCOR);U WRITELN; WRITELN;*I { Set program control flags to cause exit from the main program loop. }S MOVED:=TRUE;T DONE:=TRUELEND;9{ ************ WAKE DWARVES IN REPOSITORY ************* }*.{ Oh dear, he's disturbed the dwarves.... }PROCEDURE WAKE@P ;dP þOCEDURE FINISH;sBEGIN " { First caluculate the score. } CALSCORE; { Now write it out. } WRTSCORE;+ { Print out his player classification. } CSPEAK(SCORE,MAXSCOR);U WRITELN; WRITELN;*I { Set program control flags to cause exit from the main program loop. }S MOVED:=TRUE;T DONE:=TRUELEND;9{ ************ WAKE DWARVES IN REPOSITORY ************* }*.{ Oh dear, he's disturbed the dwarves.... }PROCEDURE WAKE!{********>>>>>>>><<<<<<<<********>> MODULE: PARSE 17-OCT-80? This module contains the procedures PARSE, DOVERB, and DOOBJ.I This is the third and final "main" level in the overlay structure below G MAIN and RESPONSE. The procedure PARSE is used to do a rough sort of H the player input commands and generally calls TRAVEL for motion verbs, 7 DOOBJ for object words, and DOVERB for action verbs. !********>>>>>>>><<<<<<<<********} {$C .TITLE PARSE .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** } ,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;)FUNCTION PCT(N:INTEGER):BOOLEAN;EXTERNAL;r:FUNCTION VOCAB(ID: WORD; INIT: INTEGER): INTEGER;EXTERNAL;5{ **************** I/O PROCEDURES ***************** }d'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;i:{ ****************** INPUT PARSING ********************* }PROCEDURE TRANSITIVE;EXTERNAL;PROCEDURE VERBHUH;EXTERNAL;TPROCEDURE DUMPWD1;EXTERNAL;*PROCEDURE ASKSCORE;EXTERNAL;PROCEDURE QUITGAME;EXTERNAL;PROCEDURE TAKEIT;EXTERNAL;PROCEDURE LOCKIT;EXTERNAL;PROCEDURE LAMPON;EXTERNAL;PROCEDURE LAMPOFF;EXTERNAL;RPROCEDURE KILLIT;EXTERNAL;PROCEDURE WHATYOUGOT;EXTERNAL;PROCEDURE FILLIT;EXTERNAL;PROCEDURE BLASTIT;EXTERNAL;PROCEDURE FEEFOO;EXTERNAL;PROCEDURE BRIEF;EXTERNAL;*PROCEDURE READIT;EXTERNAL;PROCEDURE EATIT;EXTERNAL;NPROCEDURE DRINKIT;EXTERNAL;E ;PROCEDURE POURIT;EXTERNAL;PROCEDURE SAVE;EXTERNAL;PROCEDURE HOURS;EXTERNAL;RN{ Procedure to analyze a verb. Remember what it was and go back for analysisLof second word if not blank (or if verb isn't "say" (which snarfs arbitrary second word or input). }HPROCEDURE DOVERB;BEGIND { Save verb value. } VERB:=K;/ IF (WRD2<>' ')AND(VERB<>SAY) THEN BEGINC DUMPWD1;; NODUMP:=FALSE ENDEN { If verb is "say" and we still have a WRD2 or if object has been given,  go do a transitive verb. }C ELSE IF ((OBJ<>-1)AND(OBJ<>0))OR((VERB=SAY)AND(WRD2<>' ')) u THEN TRANSITIVE L { Otherwise, analyze an intransitive verb, i.e. no object given yet. } ELSE CASE VERB OF  {take} 1:TAKEIT; 3 { We require all these guys to specify objects. }E {drop} 2, {say} 3, {wave} 9, {calm}10, {rub} 16, {toss}17, {find}19, {feed}21, {brek}28, {wake}29: VERBHUH;N0 { Other intransitive verbs have procedures... } {open} 4, {lock} 6: LOCKIT; {noth} 5: RSPEAK(54); {on} 7: LAMPON; {off} 8: LAMPOFF;0 {walk}11: RSPEAK(ACTSPK[VERB]); {kill}12: KILLIT; {pour}13: POURIT; {eat} 14: EATIT;a {drnk}15: DRINKIT;  {quit}18: QUITGAME; {inve}20: WHATYOUGOT; {fill}22: FILLIT; {blst}23: BLASTIT;e {scor}24: ASKSCORE; {foo} 25: FEEFOO; {brf} 26: BRIEF;e , {read}27: READIT; {susp}30: SAVE; {hour}31: BEGIN MSPEAK(6);, HOURS END END END; PROCEDURE TRAVEL;EXTERNAL;PROCEDURE NOTHERE;EXTERNAL;:PROCEDURE DOWHAT;EXTERNAL;PROCEDURE SAYIT;EXTERNAL;}!FUNCTION TSTOBJ:BOOLEAN;EXTERNAL;SJ{ Procedure to analyze an object word. See if the thing is here, whetherMwe've got a verb yet, and so on. Object must be here unless verb is "find or;P"inventory" (and no new verb yet to be analyzed). Water and oil are also funny,Osince they are never actually dropped at any location, but might be here inside <the bottle or as a feature of the LOCATION. (see TSTOBJ) }PROCEDURE DOOBJ;I{ Local procedure to deal with object once it's determined to be here. }UPROCEDURE OBJECT;ABEGINN. { Go get second word, if there is one. } IF WRD2<>' ' THEN BEGINr DUMPWD1;  NODUMP:=FALSE ENDb7 { Else if we've got a verb, analyze transitive. }a# ELSE IF VERB<>0 THEN TRANSITIVEW? { Otherwise, what do you want me to do with this thing? }e ELSE BEGIN DOWHAT; GOTBOTH:=FALSE  ENDtEND;BEGIN { Doobj } : { If second word available and is "say" then SAYIT. }) IF WRD2='SAY ' THEN SAYIT ELSE BEGINi { Save object definition. } OBJ:=K;* { If the object is here then analyze... }$ IF AT(OBJ) OR HERE(OBJ) THEN OBJECT? { If the object is not here, check a few special cases.... }g ELSE IF TSTOBJ THEN s; { If TSTOBJ returned true with OBJ=0, a knife disappearedr% so do nothing else analyze object. }i IF OBJ=0 THEN ELSE OBJECT @ { If TSTOBJ returns false with OBJ=0, an object word has been . magically transformed into a travel verb... } T ELSE IF OBJ=0 THEN TRAVEL: { Object need not be here for "find" or "inventory"... }F ELSE IF ((VERB=FIND)OR(VERB=INVENTORY))AND(WRD2<>' ') THEN OBJECT4 { Otherwise, OBJ is just not anywhere in sight. } ELSE NOTHEREs ENDEND;D{ This procedure gets the player input word definition and calls a 3procedure to handle the word according to type. }BPROCEDURE PARSE;VAR I:INTEGER;BEGINu NODUMP:=TRUE;? { If he's typing "west" instead of "w", then inform him he canv abbreviate if he wants to. } IF WRD1='WEST ' THEN BEGIN  IWEST:=IWEST+1;n IF IWEST>=5 THEN RSPEAK(17)F END;=F { If we already have an intransitive verb "say", echo this input... }' IF VERB=SAY THEN TRANSITIVE ELSE BEGINS> { Get first listed full definition of the input word. } KK:=VOCAB(WRD1,-1);! { Extract the word type. }o WORDTYPE:=KK DIV 1000;R3 { Remove the wordtype from the definition. }; K:=KK MOD 1000;9 { If it's defined, go according to word type.... }f$ IF KK<>-1 THEN CASE WORDTYPE OF 0: TRAVEL; 1: DOOBJ;n 2: DOVERB; 3: RSPEAK(K)4 END ELSE BEGIN { Gee! I don't understand! } I:=60; IF PCT(25) THEN I:=61; IF PCT(25) THEN I:=13; RSPEAK(I)  END ENDEND;l definition of the input word. } KK:=VOCAB(WRD1,-1);! { Extract the word type. }o WORDTYPE:=KK DIV 1000;R3 { Remove the wordtype from the definition. }; K:=KK MOD 1000;9 { If it's defined, go according to word type....@P ;dP®BJ;n 2: DOVERB; 3: RSPEAK(K)4 END ELSE BEGIN { Gee! I don't understand! } I:=60; IF PCT(25) THEN I:=61; IF PCT(25) THEN I:=13; RSPEAK(I)  END ENDEND;l definition of the input word. } KK:=VOCAB(WRD1,-1);! { Extract the word type. }o WORDTYPE:=KK DIV 1000;R3 { Remove the wordtype from the definition. }; K:=KK MOD 1000;9 { If it's defined, go according to word type....!{********>>>>>>>><<<<<<<<********>> MODULE: CALSCO 20-OCT-80< This module contains the procedures CALSCORE and WRTSCORE.!********>>>>>>>><<<<<<<<********} {$C .TITLE CALSCO .IDENT /V0/ }F{******************* SCORING AND GAME END ***************************}K{ This procedure is used by the "score" command and at the end of the game7to compute his score and the maximum score possible. }PROCEDURE CALSCORE;VAR I,K:INTEGER;BEGIN SCORE:=0; MAXSCOR:=0;*/{ The present scoring algorithm is as follows:C- Objective: Points: Present Total Possible:p$Getting well into the cave 25 25 Each treasure < chest 12 60 Treasure chest itself 14 14'Each treasure > chest 16 144G Surviving (max-num)*10 30Not quitting 4 4Reaching "closing" 25 25a"Closed": quit/killed 10 klutzed 25 wrong way 30 success 45 45Came to Witt's End 1 1NRound out the total 2 2 Total: 350.(Points can also be deducted for using hints.)L First tally up the treasures. Must be in building and not broken. Give< the poor guy 2 points just for finding each treasure. } FOR I:=50 TO MAXTRS DO BEGIN= IF I=CHEST THEN K:=14 ELSE IF I>CHEST THEN K:=16 ELSE K:=12;g$ IF (PLACE[I]=3) THEN SCORE:=SCORE+K( ELSE IF PROP[I]>=0 THEN SCORE:=SCORE+2; MAXSCOR:=MAXSCOR+Kg END;O { Now look at how he finished and how far he got. MAXDIE and NUMDIE tell O us how well he survived. GAVEUP says whether he exited via "quit". DFLAG iP will tell us if he ever got suitably deep into the cave. CLOSING indicates K whether he reached the endgame. And if he got as far as "Cave Closed" XO (indicated by CLOSED), then bonus is zero for mundane exits or 133,134,135 # if he blew it (so to speak). }S$ SCORE:=SCORE+(MAXDIE-NUMDIE)*10; MAXSCOR:=MAXSCOR+MAXDIE*10; 3 IF NOT (SCORING OR GAVEUP) THEN SCORE:=SCORE+4;  MAXSCOR:=MAXSCOR+4;% IF DFLAG<>0 THEN SCORE:=SCORE+25;y MAXSCOR:=MAXSCOR+25;$ IF CLOSING THEN SCORE:=SCORE+25; MAXSCOR:=MAXSCOR+25; IF CLOSED THEN CASE BONUS OF 0: SCORE:=SCORE+10; e 135: SCORE:=SCORE+25; 134: SCORE:=SCORE+30; 133: SCORE:=SCORE+45S END; MAXSCOR:=MAXSCOR+45;; { Did he leave magazines in Witt's End as he should? }/ IF PLACE[MAGAZINE]=108 THEN SCORE:=SCORE+1;: MAXSCOR:=MAXSCOR+1;  { Round it off. }) SCORE:=SCORE+2;  MAXSCOR:=MAXSCOR+2;P { Deduct points for hints. Hints < 4 are special; see database description.}C FOR I:=1 TO HNTMAX DO IF HINTED[I] THEN SCORE:=SCORE-HINTS[I,2]CEND;H{ This procedure writes out the player score at the end of the game. }PROCEDURE WRTSCORE;SBEGINS WRITELN;WRITELN;S WRITE('You scored');  WRITE(SCORE:4); WRITE(' out of a possible');? WRITE(MAXSCOR:4); WRITE(' using');C WRITE(TURNS:4); WRITELN(' turns.') END; Round it off. }) SCORE:=SCORE+2;  MAXSCOR:=MAXSCOR+2;P { Deduct p@P ;dQ6C FOR I:=1 TO HNTMAX DO IF HINTED[I] THEN SCORE:=SCORE-HINTS[I,2]CEND;H{ This procedure writes out the player score at the end of the game. }PROCEDURE WRTSCORE;SBEGINS WRITELN;WRITELN;S WRITE('You scored');  WRITE(SCORE:4); WRITE(' out of a possible');? WRITE(MAXSCOR:4); WRITE(' using');C WRITE(TURNS:4); WRITELN(' turns.') END; Round it off. }) SCORE:=SCORE+2;  MAXSCOR:=MAXSCOR+2;P { Deduct p!{********>>>>>>>><<<<<<<<********>> MODULE: HOURS 21-OCT-80< This module contains the "wizardry" routine HOURS and the  function LIQLOC. !********>>>>>>>><<<<<<<<********} {$C .TITLE HOURS .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** })FUNCTION BIT(N:INTEGER):INTEGER;EXTERNAL;0FUNCTION BITSET(LOC,N:INTEGER):BOOLEAN;EXTERNAL;H{ This function returns the object value of the liquid (if any) presentKat the argument location. If there is none, the value zero is returned. }L%FUNCTION LIQLOC(LOC:INTEGER):INTEGER; BEGINs IF BITSET(LOC,2) THENR" IF BITSET(LOC,1) THEN LIQLOC:=OIL ELSE LIQLOC:=WATER< ELSE LIQLOC:=0END;B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERr 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGINT 18 -- HENDR 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }8PROCEDURE DATIME(VAR D:UNSIGNED;VAR T:INTEGER);EXTERNAL;PROCEDURE PRIMETIME;EXTERNAL;.M{ This procedure is used to announce the current hours when the cave is open-Ofor adventuring. This info is stored in WKDAY, WKEND, and HOLID, which are all Ltwo integer arrays. The first integer covers the hours from 0 (midnight) toP14 (2 pm) where bit N is on if the hour from N:00 to N:59 is "prime time" (cave Mclosed). Bits 0 thru 8 of the second integer are similarly used for hours 15tQthru 23. WKDAY is for weekdays, WKEND is for weekends, HOLID for holidays. Next DEholiday is from HBEGIN to HEND, and has it's name stored in HNAME. }uPROCEDURE HOURS; TYPE DBL=ARRAY[1..2] OF INTEGER; STRNG8=ARRAY[1..8] OF CHAR; ,VAR D:UNSIGNED;  FROM,TILL,J,K,T:INTEGER;;{ Local procedure to grab one set of hours for display. } (PROCEDURE HOURSX(PTIM:DBL;TITLE:STRNG8);VAR FROM,TILL,J,K:INTEGER; FIRST:BOOLEAN;BEGIN K IF (PTIM[1]=0)AND(PTIM[2]=0) THEN WRITELN(' ',TITLE,' Open All Day')  ELSE BEGIN FIRST:=TRUE; FOR FROM:=0 TO 23 DO BEGIN IF FROM<=14 THEN BEGIND J:=PTIM[1];n K:=FROMi END ELSE BEGINR J:=PTIM[2];D K:=FROM-15 END;;2 IF (FROM<>23)AND((J AND BIT(K))=0) THEN BEGIN! FOR TILL:=FROM+1 TO 24 DO BEGIN IF TILL<=14 THEN BEGIN J:=PTIM[1]; K:=TILL END ELSE BEGIN J:=PTIM[2]; K:=TILL-15R END;2 IF ((J AND BIT(K))<>0)OR(TILL=24) THEN BEGIN" IF FIRST THEN WRITE(' ',TITLE)  ELSE WRITE(' ');. WRITELN(' ',FROM:2,':00 to ',TILL:2,':00'); FIRST:=FALSE; FROM:=TILL; EXIT END: END]$ END ELSE IF FIRST AND(FROM=23) 1 THEN WRITELN(' ',TITLE,' Closed All Day')F END ENDAEND;BEGIN { Hours } PRIMETIME; WRITELN; HOURSX(WKDAY,'Mon-Fri:');G WRITELN; HOURSX(WKEND,'Sat-Sun:');E WRITELN; HOURSX(HOLID,'Holidays');  DATIME(D,T);/ IF NOT ((HEND>>>>>>><<<<<<<<********)>> MODULE: MAGICWD 21-OCT-80E= This module contains the procedures MAGIC, ECHO, and FEEFOO."!********>>>>>>>><<<<<<<<********}H .{$C .TITLE MAGICW .IDENT /V0/ }*G{******************* DATA STRUCTURE ROUTINES *************************}X6FUNCTION VOCAB(ID:WORD;INIT:INTEGER):INTEGER;EXTERNAL;+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL; )PROCEDURE DROP(OBJ,LOC:INTEGER);EXTERNAL;E.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************} 'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;:{ ********************* VERB SAY ******************** }PROCEDURE DUMPWD1;EXTERNAL;*G{ This function is used by the SAYIT procedure to test for magic words=if used with the verb say, e.g. "say fee", "say fie", etc. }OFUNCTION MAGIC:BOOLEAN;BEGIN ! { Check for magic words... }R KK:=VOCAB(WRD1,-1);:6 IF (KK=62)OR(KK=65)OR(KK=71)OR(KK=2025) THEN BEGIN VERB:=0;* MAGIC:=TRUE END ELSE BEGIN { Check second word... } KK:=VOCAB(WRD2,-1);3 IF (KK=62)OR(KK=65)OR(KK=71)OR(KK=2025) THEN BEGIN* VERB:=0;* DUMPWD1;* MAGIC:=TRUE END ELSE MAGIC:=FALSE ENDiEND;#PROCEDURE SMALL(WRD:WORD);EXTERNAL; 1{ Procedure used by say to echo player input. }ePROCEDURE ECHO;.BEGIN WRITELN; WRITE('Okay, "');  IF WRD1<>'SAY ' THEN BEGIN SMALL(WRD1);1 SMALL(WRD1X); 6& IF (WRD2<>' ')AND(WRD2<>'SAY ')  THEN WRITE(' ') END; IF WRD2<>'SAY ' THEN BEGINe SMALL(WRD2); SMALL(WRD2X), END; WRITELN('".')KEND;G{********************* FEE,FIE,FOE,FOO *****************************}EL{ FEE FIE FOE FOO (and FUM). Advance to the next state if given in proper Norder (and no intervening input). Look up WRD1 in section 3 of the vocabularyMto determine which word we've got. Last word zips the eggs back to the GiantW Room (unless already there). }PROCEDURE FEEFOO;<BEGIN' K:=VOCAB(WRD1,3); IF FOOBAR=(1-K) THEN BEGIN FOOBAR:=K;$ IF K<>4 THEN RSPEAK(54) ELSE BEGIN FOOBAR:=0;L IF (PLACE[EGGS]=PLACE1[EGGS]). OR(TOTING(EGGS) AND(LOCATION=PLACE1[EGGS])) THEN RSPEAK(42) ELSE BEGIN 1 { Bring back the Troll if he steals the eggs  back before crossing... }) IF (PLACE[EGGS]=0)AND(PLACE[TROLL]=0)u+ AND(PROP[TROLL]=0) THEN PROP[TROLL]:=1;t& IF LOCATION=PLACE1[EGGS] THEN K:=0 ELSE IF HERE(EGGS) THEN K:=1 ELSE K:=2;- IF TOTING(EGGS) THEN DROP(EGGS,LOCATION);- MOVE(EGGS,PLACE1[EGGS]); PSPEAK(EGGS,K) END ENDN END# ELSE IF FOOBAR<>0 THEN RSPEAK(151)[ ELSE RSPEAK(42)END; AND(LOCATION=PLACE1[EGGS])) THEN RSPEAK(42) ELSE BEGIN 1 { Bring back the Troll if he steals the eggs  back before crossing... }) IF (PLACE[EGGS]=0)AND(PLACE[TROLL]=0)u+ AND(PROP[TROLL]=0) THEN PROP[TROLL]:=1;t& IF LOCATION=PLACE1[EGGS] THEN K:=0@P ;dOìEGGS) THEN DROP(EGGS,LOCATION);- MOVE(EGGS,PLACE1[EGGS]); PSPEAK(EGGS,K) END ENDN END# ELSE IF FOOBAR<>0 THEN RSPEAK(151)[ ELSE RSPEAK(42)END; AND(LOCATION=PLACE1[EGGS])) THEN RSPEAK(42) ELSE BEGIN 1 { Bring back the Troll if he steals the eggs  back before crossing... }) IF (PLACE[EGGS]=0)AND(PLACE[TROLL]=0)u+ AND(PROP[TROLL]=0) THEN PROP[TROLL]:=1;t& IF LOCATION=PLACE1[EGGS] THEN K:=0!{********>>>>>>>><<<<<<<<********D>> MODULE: VERBS5 21-OCT-80e; This module contains the procedures QUITGAME, WHATYOUGOT,J BRIEF, and TSTOBJ. !********>>>>>>>><<<<<<<<********}  t{$C .TITLE VERBS5b .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }A.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;.FUNCTION LIQLOC(LOC:INTEGER):INTEGER;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************} 'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;T,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;0FUNCTION ASKR(I,J,K: INTEGER): BOOLEAN;EXTERNAL;>{************* MAIN PROGRAM PROCEDURES ********************}PROCEDURE FINISH;EXTERNAL;F{********************* QUIT PROCEDURE *****************************}G{ "quit" -- Intransitive only. Verify intent and exit if that's what T he wants. }PROCEDURE QUITGAME;NBEGINB GAVEUP:=ASKR(22,54,54);* IF GAVEUP THEN FINISH*END;K{********************* INVENTORY PROCEDURE *****************************}O1{ "inventory" -- Report on the current burden. }TPROCEDURE WHATYOUGOT;;VAR LINK:OBJLINK; BEGINO LINK:=ATLOC[-1];* IF LINK=NIL THEN RSPEAK(98) ELSE BEGIN RSPEAK(99); WHILE LINK<>NIL DO BEGINU2 IF LINK^.OBJ<>BEAR THEN PSPEAK(LINK^.OBJ,-1); LINK:=LINK^.NXT END;e! IF TOTING(BEAR) THEN RSPEAK(141)n ENDREND;7{ ********************* VERB BRIEF ****************** }GI{ Intransitive verb "brief". If he wants brief descriptions, skyrocket * *;ABBNUM and force removal of "detail" response to "look". }ePROCEDURE BRIEF;BEGIN  RSPEAK(156); ABBNUM:=10000; DETAIL:=6TEND;;{ *************** OBJECT PROCEDURES ******************** }WN{ Function to test if special case objects are here. Returns true with OBJ<>0Oif object is here; true with OBJ=0 if object disappears (dwarf's knife); false Nwith OBJ<>0 if it is not here; and false with OBJ=0 if object (grate) has beenreplaced by a travel verb. }rFUNCTION TSTOBJ:BOOLEAN;VAR X:BOOLEAN;BEGINl CASE OBJ OFoI { Interpret "grate" as travel verb "depression" if near but not at the =I grate. Other places outside the cave use "entrance". Return false with*C OBJ=0 if this is the case. Otherwise return false with OBJ<>0. }r GRATE: BEGINe TSTOBJ:=FALSE;cC IF (LOCATION=1)OR(LOCATION=4)OR(LOCATION=7) THEN K:=DEPRESSIONe; ELSE IF (LOCATION>9)AND(LOCATION<15) THEN K:=ENTRANCE;j IF K<>GRATE THEN OBJ:=0 END;r { Dwarf? See if one's here. } DWARF: BEGINO X:=FALSE; FOR I:=1 TO 5 DOn5 IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN X:=TRUE;  TSTOBJ:=X END;OD { Plant? Might be phony plant (seen in twopit room only when real  plant is large enough). }r5 PLANT: IF AT(PLANT2) AND(PROP[PLANT2]<>0) THEN BEGIN  OBJ:=PLANT2;  TSTOBJ:=TRUER END ELSE TSTOBJ:=FALSE;' { Dwarves' knives disappear....... }I% KNIFE: IF KNFLOC=LOCATION THEN BEGINj TSTOBJ:=TRUE; OBJ:=0; KNFLOC:=-1; RSPEAK(116) END ELSE TSTOBJ:=FALSE; { Rod may be special rod... } ROD: IF HERE(ROD2) THEN BEGIN OBJ:=ROD2;R TSTOBJ:=TRUEX END ELSE TSTOBJ:=FALSE;C { If not one of the above objects, check for water and oil... } 9 ELSE IF ((K=LIQ)AND HERE(BOTTLE))OR(K=LIQLOC(LOCATION)) E% THEN TSTOBJ:=TRUE ELSE TSTOBJ:=FALSEB END { Case of obj }END; Dwarves' knives di@P ;dA€STOBJ:=TRUE; OBJ:=0; KNFLOC:=-1; RSPEAK(116) END ELSE TSTOBJ:=FALSE; { Rod may be special rod... } ROD: IF HERE(ROD2) THEN BEGIN OBJ:=ROD2;R TSTOBJ:=TRUEX END ELSE TSTOBJ:=FALSE;C { If not one of the above objects, check for water and oil... } 9 ELSE IF ((K=LIQ)AND HERE(BOTTLE))OR(K=LIQLOC(LOCATION)) E% THEN TSTOBJ:=TRUE ELSE TSTOBJ:=FALSEB END { Case of obj }END; Dwarves' knives di!{********>>>>>>>><<<<<<<<********>> MODULE: RDWIZ 21-OCT-80< This module contains the "wizardry" routine RDWIZ and the  function BIT. !********>>>>>>>><<<<<<<<********} {$C .TITLE RDWIZ .IDENT /V0/ }?{ This procedure reads one integer sequentially from ADVWIZ. }PROCEDURE RDWIZ(VAR X:INTEGER);BEGIN X:=ADVWIZ^; GET(ADVWIZ)END;A{ *************** DATA STRUCTURE ROUTINES ****************** },{ This function returns the value 2**I . }"FUNCTION BIT(I: INTEGER): INTEGER;VAR J,L:INTEGER;BEGINR J:=1;O) IF I<>0 THEN FOR L:=1 TO I DO J:=J*2;d BIT:=JEND;d the  function BIT. !********>>>>>>>><<<<<<<<********} {$C .TITLE RDWIZ .IDENT /V0/ }?{ This procedure reads one integer sequentially from ADVWIZ. }PROCEDURE RDWIZ(VAR X:INTEGER);BEGIN X:=ADVWIZ^; GET(ADVWIZ)END;A{ *************** DATA STRUCTURE ROUTINES ****************** },{ This function returns the value 2**I . }"FUNCTION@P ;dO’ IF I<>0 THEN FOR L:=1 TO I DO J:=J*2;d BIT:=JEND;d the  function BIT. !********>>>>>>>><<<<<<<<********} {$C .TITLE RDWIZ .IDENT /V0/ }?{ This procedure reads one integer sequentially from ADVWIZ. }PROCEDURE RDWIZ(VAR X:INTEGER);BEGIN X:=ADVWIZ^; GET(ADVWIZ)END;A{ *************** DATA STRUCTURE ROUTINES ****************** },{ This function returns the value 2**I . }"FUNCTION!{********>>>>>>>><<<<<<<<********t>> MODULE: TAKEd 21-OCT-80o? This module contains the procedures GETOBJ and TAKEIT, which : along with procedure GETIT, implement carrying an object.!********>>>>>>>><<<<<<<<********} F{$C .TITLE TAKEE .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** } .FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}*'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL; H{ ******************* VERB GET (CARRY, TAKE, etc. )******************* }N{ Carry an object. Special cases for bird and cage (if bird in cage, can'tOtake one without the other. Liquids also special, since they depend on statusR/of bottle. Also various side effects, etc. }TPROCEDURE FILLIT;EXTERNAL;PROCEDURE GETIT;EXTERNAL;NPROCEDURE GETOBJ;ABEGINU' { "You're already carrying it!" }*, IF TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB]) { "You can't get it.... }$ ELSE IF FIXED[OBJ]<>0 THEN BEGIN3 IF (OBJ=PLANT)AND(PROP[PLANT]<=0) THEN RSPEAK(115)5 ELSE IF (OBJ=BEAR)AND(PROP[BEAR]=1) THEN RSPEAK(169)(7 ELSE IF (OBJ=CHAIN)AND(PROP[BEAR]<>0) THEN RSPEAK(170)u ELSE RSPEAK(25) ENDy { Handle liquids.. }- ELSE IF (OBJ=WATER)OR(OBJ=OIL) THEN BEGIND9 { If we're not referring to liquid in bottle, then.. }D- IF NOT HERE(BOTTLE) OR (LIQ<>OBJ) THEN BEGINr OBJ:=BOTTLE; 0 { If toting empty bottle, then fill it. }7 IF TOTING(BOTTLE) AND (PROP[BOTTLE]=1) THEN FILLITB { Otherwise, }D ELSE BEGINT) { You either can't carry the liquid, }O( IF NOT TOTING(BOTTLE) THEN RSPEAK(104)& { Or your bottle's already full. }* ELSE IF PROP[BOTTLE]<>1 THEN RSPEAK(105) END ENDG { If the liquid he wants is in the bottle, then get the bottle... }i ELSE BEGINi OBJ:=BOTTLE;D GETIT END ENDLA { Not carrying it, not fixed, not a liquid, so go get it. }o e ELSE GETITEND;E{ ********************* VERB TAKE (INTRANSITIVE) ****************** },PROCEDURE VERBHUH;EXTERNAL;uN{ Intransitive verb "take" ("get",etc.). Take what's here only if one thing to take. }lPROCEDURE TAKEIT;}BEGINEE IF (ATLOC[LOCATION]<>NIL)AND(ATLOC[LOCATION]^.NXT=NIL) THEN BEGIN ) { Check if there's a dwarf here also. }t? FOR I:=1 TO 5 DO IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN BEGIN VERBHUH;N EXIT  END; 5 { If there was a dwarf then GOTBOTH will be false. }T IF GOTBOTH THEN BEGIN OBJ:=ATLOC[LOCATION]^.OBJ;V GETOBJ* END END ELSE VERBHUH;UEND;AL;uN{ Intransitive verb "take" ("get",etc.). Take what's here only if one thing to take. }lPROCEDURE TAKEIT;}BEGINEE IF (ATLOC[LOCATION]<>NIL)AND(ATLOC[LOCATION]^.NXT=NIL) THEN BEGIN ) { Check if there's a dwarf here also. }t? FOR I:=1 TO 5 DO IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN BEGIN VERBHUH;N EXIT  END; 5 { If there was a @"P ;dPà OBJ:=ATLOC[LOCATION]^.OBJ;V GETOBJ* END END ELSE VERBHUH;UEND;AL;uN{ Intransitive verb "take" ("get",etc.). Take what's here only if one thing to take. }lPROCEDURE TAKEIT;}BEGINEE IF (ATLOC[LOCATION]<>NIL)AND(ATLOC[LOCATION]^.NXT=NIL) THEN BEGIN ) { Check if there's a dwarf here also. }t? FOR I:=1 TO 5 DO IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN BEGIN VERBHUH;N EXIT  END; 5 { If there was a !{********>>>>>>>><<<<<<<<********e>> MODULE: SUBS1 21-OCT-80t? This module contains the procedure MOVE and it's special caseoE relatives: CARRY,DROP,JUGGLE and DESTROY; the functions AT, LIQ, andu! VOCAB; and the procedure PSPEAK.e s!********>>>>>>>><<<<<<<<********}n {$C .TITLE SUBS1 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }(H{ This procedure moves an object from it's present location to WHERE byFfirst updating PLACE[OBJ] (or FIXED[OBJ] for the second of two placed Oobjects), and then removing it's objlink from the ATLOC chain for it's present Llocation (or creating a new objlink if none exists) and linking it into the $ATLOC chain for the new location. }"PROCEDURE MOVE(OBJ,WHERE:INTEGER);VAR FROM:INTEGER; LINK,LINK0:OBJLINK;DBEGIN/P { First do single placed objects and first location of two-placed objects. } IF OBJ<100 THEN BEGINc { Save prior location. }t FROM:=PLACE[OBJ]; { Set new location. } PLACE[OBJ]:=WHERE END ELSE O { OBJ+100 indicates second copy of two-placed objects, so FIXED is updated  rather than PLACE. } BEGIN  { Save prior location. } FROM:=FIXED[OBJ-100]; { Set new location. } FIXED[OBJ-100]:=WHERE END;= { Point to first objlink in ATLOC for prior location. }  LINK0:=ATLOC[FROM];jG { If it is not an empty list, search for this object's objlink. }I3 IF LINK0<>NIL THEN IF LINK0^.OBJ=OBJ THEN BEGIN4 { If it's at the head of the list, pull it off. } LINK:=LINK0;B ATLOC[FROM]:=LINK0^.NXT ENDp/ { Otherwise look further down the list. }t ELSE BEGINF { While we have another objlink to check and it's not the one we're & looking for, advance down the list. }G WHILE (LINK0^.NXT<>NIL)AND(LINK0^.NXT^.OBJ<>OBJ) DO LINK0:=LINK0^.NXT; 8 { If we found it, pull it out and collapse the list. } IF LINK0^.NXT<>NIL THEN BEGIN LINK:=LINK0^.NXT; LINK0^.NXT:=LINK^.NXT END7 { Otherwise it's not here so create a new objlink. }  ELSE NEW(LINK)B ENDF= { If the list at FROM is empty, create a new objlink. }t ELSE NEW(LINK);EL { Now link the objlink into the head of the list at it's new location. } LINK^.NXT:=ATLOC[WHERE]; LINK^.OBJ:=OBJ;I ATLOC[WHERE]:=LINK TEND;N{ Carry an object by incrementing the player holding count and moving object&to player's clutches (location -1). }PROCEDURE CARRY(OBJ:INTEGER);.BEGINN HOLDING:=HOLDING+1;s MOVE(OBJ,-1)END;N{ Drop an object (reverse of carry), decrement holding count and move object@from player to somewhere else (need not be present location). }"PROCEDURE DROP(OBJ,WHERE:INTEGER);BEGIN  HOLDING:=HOLDING-1;  MOVE(OBJ,WHERE)EEND;I{ Bring an object to the top of it's ATLOC list, causing it to be listedyHfirst when WHATSHERE or WHATYOUGOT prints objects at a location or being carried. }nPROCEDURE JUGGLE(OBJ:INTEGER);BEGIN) MOVE(OBJ,PLACE[OBJ]);L1 IF FIXED[OBJ]>0 THEN MOVE(OBJ+100,FIXED[OBJ])cEND;D{ This procedure destroys an object by moving it to "non-existant" location 0. }PROCEDURE DESTROY(OBJ:INTEGER);}BEGIND MOVE(OBJ,0)EEND;N{ This function is true if an object is at the player's current location (notLbeing carried). Ususally used for two placed objects which can't be carried anyway. }!FUNCTION AT(OBJ:INTEGER):BOOLEAN;oBEGINi6 AT:=(PLACE[OBJ]=LOCATION) OR (FIXED[OBJ]=LOCATION)END;O{ This function returns the object number of the liquid in the bottle, or 0 ifthe bottle is empty. }sFUNCTION LIQ:INTEGER; BEGIN-% IF PROP[BOTTLE]=0 THEN LIQ:=WATERE( ELSE IF PROP[BOTTLE]=2 THEN LIQ:=OIL ELSE LIQ:=0TEND;O{ This function is used to hunt for a player input word in the vocabulary tree)Lfile and return it's numeric definition as defined in the original database.LIf the argument INIT is -1, the first listed (lowest value) is returned for Lwords with multiple definitions. Otherwise, INIT is taken as the word type Jand the value returned is for that type only and is stripped of it's type  ?information. If a word is undefined, the value -1 is returned.PP As an example, take the case of the word "steps" which is defined as a motionPverb (34) and as an object (1007). VOCAB('STEPS',-1) would return the value 34,Nsame as VOCAB('STEPS',0), however VOCAB('STEPS',1) would return the value 7. 'Other examples: VOCAB('FEE ',-1)=2025  VOCAB('FEE ',2)=25 VOCAB('FEE ',3)=1I& VOCAB('FEE ',0)=-1 (undefined) }1FUNCTION VOCAB(ID: WORD; INIT: INTEGER): INTEGER;oVAR I,J,K:INTEGER; LTR:CHAR;aJ{ This local procedure extracts one letter from the input word string andLincrements an index into the string. We do a little fiddling with the inputKletter before returning in order to be compatible with the way in which theSLKATAB file is linked: only ASCII values of capital letters are allowed. So,Hthe "2" in "Y2" is treated as a "T" and the quote and question mark are Lreplaced by "Q". GETIN automatically converts smalls to caps, so all other HASCII characters are returned as a "Z" in order to kick out funny input.>If we index off the end of the input word we return a blank. N The resulting letter (or blank) is left in variable LTR and the ORD is left*in K, both of which are local to VOCAB. }PROCEDURE GETLTR;VAR DIF:INTEGER;BEGINy I:=I+1; * IF I<=5 THEN LTR:=ID[I] ELSE LTR:=' '; IF LTR='2' THEN LTR:='T'/ ELSE IF (LTR='"')OR(LTR='?') THEN LTR:='Q'; 9 IF (LTR<>' ')AND((LTR<'A')OR(LTR>'Z')) THEN LTR:='Z';t K:=ORD(LTR)cEND;BEGIN { vocab }  { Reset index} I:=0;uK { Get the first letter from the input word to LTR and it's ORD to K. }s GETLTR; N { If we have a starting letter, index by ORD (ASCII value with OMSI) into 4 the vocabulary file. Otherwise, exit with -1. }* IF LTR<>' ' THEN J:=KTAB[K] ELSE J:=0; IF J<>0 THEN BEGIN SEEK(KATAB,J);'# { Get the second letter, if any. }O GETLTR;H { If the second letter is non-blank, then index down the tree until we 0 run out of input letters or run out of tree. }1 IF LTR<>' ' THEN WHILE KATAB^.NXT[K]<>0 DO BEGINe J:=KATAB^.NXT[K]; SEEK(KATAB,J);t GETLTR; IF LTR=' ' THEN EXITa END;nI { If LTR is a blank then we reached a node in the tree corresponding to l ' the input, otherwise return with -1. }  IF LTR=' ' THENF { If INIT=-1 then return the first, full definition. Otherwise look ) for one of type INIT = value div 1000. }o0 IF INIT=-1 THEN VOCAB:=KATAB^.VAL[1] ELSE BEGIN% IF (KATAB^.VAL[1] DIV 1000)=INITr' THEN VOCAB:=KATAB^.VAL[1] MOD 1000L* ELSE IF (KATAB^.VAL[2] DIV 1000)=INIT' THEN VOCAB:=KATAB^.VAL[2] MOD 1000T ELSE VOCAB:=-1H END ELSE VOCAB:=-1I END ELSE VOCAB:=-1END;9{ ************* I/O SUBROUTINES ********************}eG{ This procedure prints out object descriptions for object number OBJ.iHPROP controls which message to use, -1 says inventory message, otherwiseJuse description numbered PROP*100. (see database description in ADVINI) }#PROCEDURE PSPEAK(OBJ,PROP:INTEGER);AVAR I,OLDLOC,REC:INTEGER; OFF:ARRAY[1..3] OF CHAR;BEGIN=A { Point to the starting record in ADVTXT for this object. }H REC:=PTEXT[OBJ]; SEEK(ADVTXT,REC);1 WITH ADVTXT^ DO BEGINII { If PROP is -1, print out the inventory message for the object, (which jA we are already pointing to), otherwise seek out the description g corresponding to PROP value. } IF PROP>=0 THEN REPEAT  GET(ADVTXT);0 REC:=REC+1; UNTIL (LOC DIV 100) = PROP;, { Check for the 'no message' flag, '>$<' }! FOR I:=1 TO 3 DO OFF[I]:=TXT[I];  IF OFF<>'>$<' THEN BEGINi4 { Save line number for multi-line messages. } OLDLOC:=LOC;O> { If it's not the inventory message then space a line. } IF PROP<>-1 THEN WRITELN; { Output the message. } WHILE LOC=OLDLOC DO BEGIN WRITELN(TXT);k GET(ADVTXT)p END END END END;ue. } IF PROP>=0 THEN REPEAT @P ;dQÞP;, { Check for the 'no message' flag, '>$<' }! FOR I:=1 TO 3 DO OFF[I]:=TXT[I];  IF OFF<>'>$<' THEN BEGINi4 { Save line number for multi-line messages. } OLDLOC:=LOC;O> { If it's not the inventory message then space a line. } IF PROP<>-1 THEN WRITELN; { Output the message. } WHILE LOC=OLDLOC DO BEGIN WRITELN(TXT);k GET(ADVTXT)p END END END END;ue. } IF PROP>=0 THEN REPEAT !{********>>>>>>>><<<<<<<<********>> MODULE: MAIN 28-OCT-80. This module contains the main program block.!********>>>>>>>><<<<<<<<********} {$C .TITLE MAIN .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }.FUNCTION FORCED(LOC:INTEGER):BOOLEAN;EXTERNAL;D{ ***************** INITIALIZATION PROCEDURES **************** }PROCEDURE INITIALIZE;EXTERNAL; FUNCTION START:BOOLEAN;EXTERNAL;#PROCEDURE MOTD(X:BOOLEAN);EXTERNAL;9{ ************* I/O SUBROUTINES ********************}M0FUNCTION ASKR(I,J,K: INTEGER): BOOLEAN;EXTERNAL;<{******************** DWARF PROCEDURE *******************}PROCEDURE DWARFSTUFF;EXTERNAL;?{***************** MAIN PROGRAM PROCEDURES ******************}PROCEDURE BLOCKED;EXTERNAL;)PROCEDURE ALIVE;EXTERNAL;*PROCEDURE WHEREAREWE;EXTERNAL;PROCEDURE TRAVEL;EXTERNAL;PROCEDURE WHATSHERE;EXTERNAL;PROCEDURE RESPONSE;EXTERNAL;6{ ***************** MAIN PROGRAM ******************}P{ The structure of the main program block roughly follows the F4P version butQthe spaghetti has been somewhat straightened out. It was very difficult to CPpreserve the exact flow without using massive random "goto"'s as was done inQthe original. The way I got around this problem was adding a few program flow DQcontrol booleans which, in essence, cause repeat loops to exit and jump back to NQa lower nesting level under certain conditions (check out DRAGFLG, which pops *Qyou back from KILLOBJ to the middle of RESPONSE). As a result this program vQprobably only rates a B- for structure but from the player's standpoint, at iPleast, it appears to operate exactly as the original with a few minor changes. Q You may argue that the thing is overly overlaid, but it does run in less than rQ12Kwords despite the size of OMSI's runtime stuff. In the future I plan to Qinvestigate shrinking the OMSI stuff further and possibly reorganizing the iQorder of things so that it will run even smaller. The time required to swap Cout overlays is presently only slightly noticable by the player. }aBEGIN {MAIN PROGRAM} { Initialize everything. } INITIALIZE;n w) { Print the "message of the day". }e MOTD(FALSE);= { Start-up, check for "prime time", saved games, etc. }p DEMO:=START;* { If allowed to start, then go.... } IF NOT DONE THEN BEGIN6 { Do this only at the beginning of a new game.... } IF NOT SETUP THEN BEGINB { Welcome the player and (optionally) give "instructions". . If he accepts it will cost him points. } HINTED[3]:=ASKR(65,1,0);IL { If he asked for instructions, then give him some extra lamp time. }3 IF HINTED[3] THEN LIMIT:=1000 ELSE LIMIT:=330;  END;a REPEAT {Until DONE is true} MOVED:=FALSE;B {The beginning of this loop is repeated every time the player> has moved to a new location, which is indicated by MOVED  becoming true. @ First check to see if the new location is outside the cave and@ it's closing or if a dwarf's blocking his way (either case% returns with NEWLOC=LOCATION). } BLOCKED;e$ { Move to the new location. } LOCATION:=NEWLOC; { Go do the dwarf stuff. } DWARFSTUFF;C { Go see if this guy's still alive or not, returns with MOVEDeD true if he dies and is reincarnated or with MOVED and DONE true% if he's dead and that's it.. }b ALIVE; A IF NOT (MOVED OR DONE) THEN { Give him another turn..} BEGINd { Tell him where he is. } WHEREAREWE;'- { If location has forced motion, do it. }w! IF FORCED(LOCATION) THEN TRAVELK ELSE7 { Otherwise, tell him what's here and respond to his;' instructions until he moves again. }D BEGIN; WHATSHERE;" REPEAT RESPONSE UNTIL MOVED; ENDt END UNTIL DONE; END;* { Set VT-100's back to VT-52 mode. }( IF VT100 THEN WRITE(CHR(33B),'[?2l')END.LIVE; A IF NOT (MOVED OR DONE@*P ;dQ>. } WHEREAREWE;'- { If location has forced motion, do it. }w! IF FORCED(LOCATION) THEN TRAVELK ELSE7 { Otherwise, tell him what's here and respond to his;' instructions until he moves again. }D BEGIN; WHATSHERE;" REPEAT RESPONSE UNTIL MOVED; ENDt END UNTIL DONE; END;* { Set VT-100's back to VT-52 mode. }( IF VT100 THEN WRITE(CHR(33B),'[?2l')END.LIVE; A IF NOT (MOVED OR DONE!{********>>>>>>>><<<<<<<<********>> MODULE: LOOP1 28-OCT-80? This module contains the procedures ENDDEMO, CAVECLOSING and D CLOSECAVE. It also contains the procedures HINTROUTINE, CLSECLUE, " LAMPDIM, LAMP0, LAMP1, and LAMP2.!********>>>>>>>><<<<<<<<********} {$C .TITLE LOOP1 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;<(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;0FUNCTION BITSET(LOC,N:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}*'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL; 'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;T,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;.FUNCTION ASKR(I,J,K:INTEGER):BOOLEAN;EXTERNAL;B{ ****************** MAGIC MODE PROCEDURES ********************* }PROCEDURE FINISH;EXTERNAL;;{ This procedure is called to end a demonstration game. };PROCEDURE ENDDEMO;BEGINE MSPEAK(1); FINISHEND;@{ ***************** CAVE CLOSING PROCEDURES ****************** }P{ CAVECLOSING and CLOSECAVE handle the closing of the cave. The cavePcloses CLOCK1 turns after the last treasure has been located (including thePPirate's chest, which may of course never show up). Note that the treasuresPneed not have been taken yet, just located. Hence CLOCK1 must be large enoughPto get out of the cave (it only ticks while inside the cave). When it hitsPzero, we call CAVECLOSING to start closing the cave, and then sit back and waitPfor him to try and get out. If he doesn't within CLOCK2 turns, we close thePcave; if he does try, we assume he panics, and give him a few additional turnsPto get frantic before we close. When CLOCK2 hits zero, we call CLOSECAVE toPtransport him into the final puzzle. Note that the puzzle depends upon allPsorts of random things. For instance, there must be no water or oil, sincePthere are beanstalks which we don't want to be able to water, since the codePcan't handle it. Also, we can have no keys, since there is a grate (havingPmoved the fixed object!) there separating him from all the treasures. MostPof these problems arise from the use of negative PROP numbers to supress the a:object descriptions until he's actually moved the objects. hP When the first warning comes (via CAVECLOSING), we lock the grate, destroyQthe bridge, kill all the dwarves (and the pirate), remove the troll and bear aQ(unless dead), and set CLOSING to true. Leave the dragon; too much trouble to iQmove it. From now until CLOCK2 runs out, he cannot unlock the grate, move to rQany location outside the cave (LOCATION<9), or create the bridge. Nor can he Qbe resurrected if he dies. Note that the snake is already gone, since he got bQto the treasure accesible only via the Hall of the Mt. King. Also, he's been ,Qin Giant Room (to get eggs), so we can refer to it. Also also, he's gotten the nQpearl, so we know the bivalve is an oyster. *And*, the dwarves must have been u'activated, since we've found the chest.2P Once he's panicked, and CLOCK2 has run out, we call CLOSECAVE to set up thePstorage room. The room has two LOCATIONs, hardwired as 115 (ne) and 116 (sw).PAt the ne end, we place empty bottles, a nursery of plants, a bed of oysters,Pa pile of lamps, rods with stars, sleeping dwarves, and him. At the sw end weQplace grate over treasures, snake pit, covey of caged birds, more rods, and aPpillows. A mirror stretches across one wall. Many of the objects come fromPknown locations and/or states (e.g. the snake is known to have been destroyedPand needn't be carried away from it's old PLACE), making the various objectsPbe handled differently. We also drop all other objects he might be carryingP(lest we have some that could cause trouble, such as the keys). We describe the#flash of light and trundle back. } PROCEDURE CAVECLOSING;VAR I:INTEGER;BEGINr PROP[GRATE]:=0;w PROP[FISSURE]:=0;  FOR I:=1 TO 6 DO BEGIN DSEEN[I]:=FALSE;r DLOC[I]:=0a END; DESTROY(TROLL);n DESTROY(TROLL+100);e MOVE(TROLL2,PLACE1[TROLL]);i# MOVE(TROLL2+100,FIXED1[TROLL]);  JUGGLE(CHASM);( IF PROP[BEAR]<>3 THEN DESTROY(BEAR); PROP[CHAIN]:=0;  FIXED[CHAIN]:=0; PROP[AXE]:=0;t FIXED[AXE]:=0; RSPEAK(129); CLOCK1:=-1;e CLOSING:=TRUEtEND;PROCEDURE CLOSECAVE;VAR I:INTEGER;Q{This local function is used when setting up the repository. It moves objects or 1Pdrops them (if being carried) and returns a value used to set new PROP value. }-FUNCTION PUT(OBJ,WHERE,PVAL:INTEGER):INTEGER;1BEGIN)= IF TOTING(OBJ) THEN DROP(OBJ,WHERE) ELSE MOVE(OBJ,WHERE);  F PUT:=-1-PVALEND;BEGIN { Closecave }A$ PROP[BOTTLE]:=PUT(BOTTLE,115,1);" PROP[PLANT]:=PUT(PLANT,115,0);$ PROP[OYSTER]:=PUT(OYSTER,115,0); PROP[LAMP]:=PUT(LAMP,115,0); PROP[ROD]:=PUT(ROD,115,0);" PROP[DWARF]:=PUT(DWARF,115,0); LOCATION:=115; NEWLOC:=115; OLDLOC:=115; OLDLC2:=115;9 { Leave the grate with normal (non-negative) PROP }I I:=PUT(GRATE,116,0);" PROP[SNAKE]:=PUT(SNAKE,116,1); PROP[BIRD]:=PUT(BIRD,116,1); PROP[CAGE]:=PUT(CAGE,116,0); PROP[ROD2]:=PUT(ROD2,116,0);$ PROP[PILLOW]:=PUT(PILLOW,116,0);$ PROP[MIRROR]:=PUT(MIRROR,115,0); FIXED[MIRROR]:=116;T6 FOR I:=1 TO MAXTRS DO IF TOTING(I) THEN DROP(I,0); RSPEAK(132); CLOSED:=TRUEEND;7{ **************** HINT ROUTINE ********************* }LQ{ This procedure is called to check if the current LOCATION is eligible for any Mhints. If been here long enough, calls local procedure GIVEHINT to give the ]hint. }PROCEDURE HINTROUTINE;VAR I,J:INTEGER;8{ Local procedure to implement the giving of a hint. }PROCEDURE GIVEHINT(I:INTEGER);BEGINRH { First ask the question unique to each hint. Does he need help? }' IF ASKR(HINTS[I,3],0,54) THEN BEGIN 9 { Let him know what it will cost to accept the hint. }* WRITELN;*A WRITE('I am prepared to give you a hint, but it will cost you');I WRITE(HINTS[I,2]:3);  WRITE(' points.');e= { Ask if he still wants it and, if so, answer with hint. }t$ HINTED[I]:=ASKR(175,HINTS[I,4],54); END;@ { If he took the hint, give him a little more lamp time. }> IF HINTED[I]AND(LIMIT>30) THEN LIMIT:=LIMIT+30*HINTS[I,2];- { Finally, clear HINTLC back to zero. }  HINTLC[I]:=0END;BEGIN { Hintroutine }B { Hints less than 4 are special, see database description. } p5 FOR I:=4 TO HNTMAX DO IF NOT HINTED[I] THEN BEGINWI { Increment the HINTLC counter for this location if it is eligible for d0 a hint; all other counters are kept at zero. }. IF NOT BITSET(LOCATION,I) THEN HINTLC[I]:=-1; HINTLC[I]:=HINTLC[I]+1;I { If he's been here long enough, do some quick tests and, if they pass,N give the hint. }$ IF HINTLC[I]>=HINTS[I,1] THEN BEGIN J:=I-3; CASE J OF0 {Cave} 1: IF (PROP[GRATE]=0)AND NOT HERE(KEYS)% THEN GIVEHINT(I) ELSE HINTLC[I]:=0;8 {Bird} 2: IF HERE(BIRD) AND TOTING(ROD) AND (OBJ=BIRD) THEN GIVEHINT(I);I- {Snake}3: IF HERE(SNAKE) AND NOT HERE(BIRD)e% THEN GIVEHINT(I) ELSE HINTLC[I]:=0; : {Maze} 4: IF (ATLOC[OLDLC2]=NIL) AND (ATLOC[OLDLOC]=NIL)+ AND (ATLOC[LOCATION]=NIL) AND (HOLDING>1)e% THEN GIVEHINT(I) ELSE HINTLC[I]:=0;s9 {Dark} 5: IF (PROP[EMERALD]<>-1) AND (PROP[PYRAMID]=-1)N% THEN GIVEHINT(I) ELSE HINTLC[I]:=0;C {Witt} 6: GIVEHINT(I)( END END ENDEEND;3{ ************ CLOSED CLUE ********************** }FQ{ In the repository, if he happens to pick up the oyster, hmmmm..... Also, (Qcheck for any objects being toted with PROP<0 and set the PROP to -1-PROP. This (Qway objects won't be described until they've been picked up and put down G(separate from their respective piles. }PROCEDURE CLSECLUE;RBEGINAA IF (PROP[OYSTER]<0) AND TOTING(OYSTER) THEN PSPEAK(OYSTER,1);:N FOR I:=1 TO MAXTRS DO IF TOTING(I) AND(PROP[I]<0) THEN PROP[I]:=-1-PROP[I]END;@{ ********************* LAMP DIMMING PROCEDURES ************* }P{ Another way we can force an end to things is by having the lamp give out.PWhen it gets close, we call one of these procedures to warn him. We call LAMP0Pif the lamp and fresh batteries are here, in which case we replace the batteriesQand continue. LAMP1 is for other cases of lamp dying. LAMP2 is used when the EQlamp goes out, and LAMPDIM is used to tick away the lamp LIMIT and sort out the HQvarious cases. The case where he's wandered outside the cave and the lamp is *Nused up is handled in the procedure RESPONSE, where he is forced to giveup. }PROCEDURE LAMP0;BEGINe RSPEAK(188); PROP[BATTERY]:=1; 3 IF TOTING(BATTERY) THEN DROP(BATTERY,LOCATION);a LIMIT:=LIMIT+2500; LMWARN:=FALSEtEND; iPROCEDURE LAMP1;BEGINs, IF (NOT LMWARN)AND HERE(LAMP) THEN BEGIN LMWARN:=TRUE;$ IF PROP[BATTERY]=1 THEN RSPEAK(189); ELSE IF PLACE[BATTERY]=0 THEN RSPEAK(183) ELSE RSPEAK(187)  END END;PROCEDURE LAMP2;BEGINa LIMIT:=-1; PROP[LAMP]:=0;" IF HERE(LAMP) THEN RSPEAK(184)END;PROCEDURE LAMPDIM;BEGINC( IF PROP[LAMP]=1 THEN LIMIT:=LIMIT-1;F IF (LIMIT<=30)AND HERE(BATTERY) AND(PROP[BATTERY]=0)AND HERE(LAMP)F THEN LAMP0 ELSE IF LIMIT=0 THEN LAMP2 ELSE IF LIMIT<=30 THEN LAMP1END;GINs, IF (NOT LMWARN)AND HERE(LAMP) THEN BEGIN LMWARN:=TRUE;$ IF PROP[BATTERY]=1 THEN RSPEAK(189); ELSE IF PLACE[BATTERY]=0 THEN RSPEAK(183) ELSE RSPEAK(187)  END END;PROCEDURE LAMP2;BEGINa LIMIT:=-1; PROP[LAMP]:=0;" IF HERE(LAMP) THEN RSPEAK(184)END;PROCEDURE LAMPDIM;BEGINC( IF PROP[LAMP]=1 THEN LIMIT:=LIMIT-1;F IF (LIMIT<=30)AND HERE(BATTERY) AND(PROP[BATTERY]=0)AND HERE(LAMP)F THEN LAMP0 E@ P ;dP , IF (NOT LMWARN)AND HERE(LAMP) THEN BEGIN LMWARN:=TRUE;$ IF PROP[BATTERY]=1 THEN RSPEAK(189); ELSE IF PLACE[BATTERY]=0 THEN RSPEAK(183) ELSE RSPEAK(187)  END END;PROCEDURE LAMP2;BEGINa LIMIT:=-1; PROP[LAMP]:=0;" IF HERE(LAMP) THEN RSPEAK(184)END;PROCEDURE LAMPDIM;BEGINC( IF PROP[LAMP]=1 THEN LIMIT:=LIMIT-1;F IF (LIMIT<=30)AND HERE(BATTERY) AND(PROP[BATTERY]=0)AND HERE(LAMP)F THEN LAMP0 E!{********>>>>>>>><<<<<<<<********>> PROGRAM: POOF 28-OCT-80? This program is used to initialize the magic parameters file D ADVWIZ with dummy data prior to the "first" wizard tweaking things.G It can also be used to restore it if for some reason it gets clobbered by the system. !********>>>>>>>><<<<<<<<********} {$C .TITLE POOF .IDENT /V0/ }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORDa 6..10 -- MAGICNUMBER 11..12 -- WKDAYi 13..14 -- WKEND  15..16 -- HOLIDr 17 -- HBEGIN 18 -- HEND 19..38 -- HNAMEr 39 -- SHORT 40 -- Count of saved games.  41 -- LATENCY! 42..61 -- Name of saved game 1.! 62..81 -- Name of saved game 2./" 82..101 -- Name of saved game 3. 102..354 -- Saved game 1. 355..607 -- Saved game 2.e 608..860 -- Saved game 3.* 861..1560 -- Message of the day. }VAR MAGICNUMBER:INTEGER;" MAGICWORD:ARRAY[1..5] OF CHAR;BEGINa! REWRITE(ADVWIZ,'ADVWIZ.DTA');-P { Set up initial magic word as 'dwarf' and initial magic number to 11111. } MAGICWORD:='DWARF';  MAGICNUMBER:=1;  FOR I:=1 TO 5 DO BEGIN% ADVWIZ^:=ORD(MAGICWORD[I])-ORD('A');1 PUT(ADVWIZ) END; FOR I:=1 TO 5 DO BEGINN ADVWIZ^:=MAGICNUMBER; PUT(ADVWIZ);d END;> { Set up cave to be open at all hours with no holidays. } FOR I:=11 TO 18 DO BEGIN ADVWIZ^:=0; PUT(ADVWIZ) END; FOR I:=19 TO 38 DO BEGIN ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWIZ) END;' { Set a short game to 30 turns. }d ADVWIZ^:=30; PUT(ADVWIZ);* { Set count of saved games to zero. } ADVWIZ^:=0;T PUT(ADVWIZ);$ { Set latency to 45 minutes. } A ADVWIZ^:=45; PUT(ADVWIZ);0 { Fill the saved game names with blanks. } FOR I:=42 TO 101 DO BEGINt ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWIZ) END;+ { Fill saved game area with zeroes. }) FOR I:=102 TO 860 DO BEGIN ADVWIZ^:=0; PUT(ADVWIZ) END;+ { Blank out the message of the day. }g FOR I:=861 TO 1560 DO BEGIN: ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWIZ) END; CLOSE(ADVWIZ)DEND.=0;T PUT(ADVWIZ);$ { Set latency to 45 minutes. } A ADVWIZ^:=45; PUT(ADVWIZ);0 { Fill the saved game names with blanks. } FOR I:=42 TO 101 DO BEGINt ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWI@ P ;dN¼R I:=102 TO 860 DO BEGIN ADVWIZ^:=0; PUT(ADVWIZ) END;+ { Blank out the message of the day. }g FOR I:=861 TO 1560 DO BEGIN: ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWIZ) END; CLOSE(ADVWIZ)DEND.=0;T PUT(ADVWIZ);$ { Set latency to 45 minutes. } A ADVWIZ^:=45; PUT(ADVWIZ);0 { Fill the saved game names with blanks. } FOR I:=42 TO 101 DO BEGINt ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWI!{********>>>>>>>><<<<<<<<********>> PROGRAM: PEEK 29-OCT-80> This self contained program is used for maintinence purposesE to peek at the current contents of ADVWIZ.DTA. It must be assembled, using ADVGBL.PAS for variable declarations.!********>>>>>>>><<<<<<<<********} {$C .TITLE PEEK .IDENT /V0/ }B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERu 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGINa 18 -- HENDi 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }PROCEDURE HOURS;EXTERNAL;a#PROCEDURE MOTD(X:BOOLEAN);EXTERNAL;0VAR J:INTEGER;BEGIN1$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK');( WRITE('The current magic word is '); FOR I:=1 TO 5 DO BEGIN WRITE(CHR(ADVWIZ^+ORD('A'))); GET(ADVWIZ) END; WRITELN('.'); * WRITE('The current magic number is '); FOR I:=1 TO 5 DO BEGIN WRITE(ADVWIZ^:1); GET(ADVWIZ) END; WRITELN('.');. SEEK(ADVWIZ,39);L WRITELN('The number of turns in a demonstration game is',ADVWIZ^:3,'.'); GET(ADVWIZ); I:=ADVWIZ^;D< WRITELN('The current number of saved games is',I:2,'.'); GET(ADVWIZ);H WRITELN('The current latency requirement is',ADVWIZ^:3,' minutes.'); GET(ADVWIZ); IF I<>0 THEN BEGIN FOR I:=1 TO 3 DO BEGIN> WRITELN('The name under which game #',I:1,' is stored:');  WRITE(' '); FOR J:=1 TO 20 DO BEGIN WRITE(CHR(ADVWIZ^+ORD('A')));. GET(ADVWIZ)A END; WRITELN END;e END; CLOSE(ADVWIZ);1 WRITELN('The current prime time specs are:');A HOURS;2 WRITELN('The current message of the day is:'); MOTD(FALSE)DEND.H WRITELN('The current latency requirement is',ADVWIZ^:3,' minutes.'); GET(ADVWIZ); IF I<>0 THEN BEGIN FOR I:=1 TO 3 DO BEGIN> WRITELN('The name under which game #',I:1,' is stored:');  WRITE(' '); FOR J:=1 TO 20 DO BEGIN WRITE(CHR(ADVWIZ^+ORD('A')));. GET(ADVWIZ)A END; @$P ;dK current prime time specs are:');A HOURS;2 WRITELN('The current message of the day is:'); MOTD(FALSE)DEND.H WRITELN('The current latency requirement is',ADVWIZ^:3,' minutes.'); GET(ADVWIZ); IF I<>0 THEN BEGIN FOR I:=1 TO 3 DO BEGIN> WRITELN('The name under which game #',I:1,' is stored:');  WRITE(' '); FOR J:=1 TO 20 DO BEGIN WRITE(CHR(ADVWIZ^+ORD('A')));. GET(ADVWIZ)A END; !{********>>>>>>>><<<<<<<<********>> MODULE: ADVGBL 28-OCT-80< This module (and only this module) contains all the global data declarations.!********>>>>>>>><<<<<<<<********} 8{ ********* GLOBAL DATA DECLARATIONS ***************}E{ Data base limits, should be changed if text files are changed }+CONST LOCSIZ=140; {Maximum location number}# MAXTRS=64; {Maximum object number}{ Object number mnemonics } LAMP=2; BOTTLE=20; WATER=21; OIL=22; KEYS=1; GRATE=3; CAGE=4; ROD=5;< ROD2=6; STEPS=7;M BIRD=8; DOOR=9; PILLOW=10; SNAKE=11; FISSURE=12; TABLET=13;a CLAM=14; OYSTER=15; MAGAZINE=16; DWARF=17; KNIFE=18; FOOD=19; PLANT=24; PLANT2=25;L AXE=28; MIRROR=23;* DRAGON=31; CHASM=32; TROLL=33; TROLL2=34;e BEAR=35;i MESSAGE=36; VENDING=38; BATTERY=39;{ Treasure number mnemonics }X NUGGET=50;m COINS=54; CHEST=55; EGGS=56; TRIDENT=57; VASE=58;B EMERALD=59; PYRAMID=60; PEARL=61; RUG=62; SPICES=63;; CHAIN=64;{ Motion verb mnemonics }= ENTRANCE=64;P DEPRESSION=63;E NULL=21;U 1 BACK=8; LOOK=57;A CAVE=67;S{ Action verb mnemonics }D SAY=3; LOCK=6; THROW=17; FIND=19;; INVENTORY=20;{ Type declarations:> Word types are used for vocabulary input and manipulation. }TYPE WORD= ARRAY[1..5] OF CHAR;Y{ Usigned integer types. }c UNSIGNED=0..65535;C/{ Line types are used for text manipulation. }S LINE=ARRAY[1..72] OF CHAR;D7{ Location arrays are data associated with locations }i& LOCARRAY=ARRAY[1..LOCSIZ] OF INTEGER;3{ Object arrays are data associated with objects }C& OBJARRAY=ARRAY[1..MAXTRS] OF INTEGER;D{ Linked object records are used to keep a linked list of objects at? a particular location, including carried objects (which are ata location number -1). } OBJLINK=^NXTOBJ; NXTOBJ=RECORD NXT:OBJLINK;S OBJ:INTEGER END;F{ Linked verb records hold the verbs applicable to a particular motion entry in the travel array. } VERBLINK=^NXTVRB; NXTVRB=RECORD NXTVERB:VERBLINK; VERBVAL:INTEGER END;J{ Linked key records contain one set of motion information for a location.G The second entry points to the next possible motion (another keylink),D the first entry points to the linked list of verbs that cause this B motion, and the third entry contains the new location number and + conditional information on the motion. }r KEYLINK=^NXTKEY;v NXTKEY=RECORD NXTVERB:VERBLINK; NXTLINK:KEYLINK;l NEWLOC:ARRAY[1..2] OF INTEGER END;H{ Alpha table records are the nodes in the vocabulary tree. Each record cF has an array of record numbers indexed by the ASCII value of the nextF letter in sequence in a word, followed by the numeric "definition" of0 the letter sequence so far (0 if undefined). } ATAB=RECORD NXT:ARRAY[65..90] OF INTEGER; VAL:ARRAY[1..2] OF INTEGERi END;F{ Line records are text file records. Each contains a number followed by a line of text. } LREC=RECORD LOC:INTEGER;2 TXT:LINE END;{ Variable declarations: 0 Location number the player is currently at, } VAR LOCATION,r+{ The number of objects being carried, }h HOLDING:INTEGER;s!{ The vocabulary table file, }n KATAB:FILE OF ATAB;J{ Pointers into the vocabulary table file, each corresponding to the first letter in a word, } KTAB:ARRAY[65..90] OF INTEGER; -{ Array of lists of objects at locations, }E$ ATLOC:ARRAY[-1..LOCSIZ] OF OBJLINK;A{ Properties of objects, their immovability info, and the currentN location of each object, }  PROP,FIXED,PLACE:OBJARRAY;eG{ "Liquid" assets, hints eligibility and other location conditions, }r CONDI:LOCARRAY;"{ Random number generator seed, } SEED:UNSIGNED;T){ Random number generator start flag, }u STRTRAN:BOOLEAN;c{ Maximum number of hints, } HNTMAX,*{ Tally of objects "unseen" by player, } TALLY, D{ Tally of objects which can't be found (because player blew it), } TALLY2,{ Object value, } OBJ,r4{ Location of pirate's chest at dead end in maze, } CHLOC, 6{ Dead end in other maze, location of chest "clue", } CHLOC2, { Dwarf activity level flag, } DFLAG,C{ Alternate starting location for a dwarf (so as not to start with T one dwarf on top of player, } DALTLC,-{ Number of turns taken by player so far, }, TURNS,T={ Number of times player has typed "west" instead of "w", }a  IWEST,s2{ Location of dwarves knife after being thrown, } KNFLOC,D{ Number of times we've said "not allowed to give more details", } DETAIL,>{ Number of times between long descriptions of a location, } ABBNUM,5{ The maximum number of times the player may die, }n MAXDIE,,{ The number of times a player has died, } NUMDIE,{ Number of dwarves killed, }D DKILL, +{ Progress in saying "fee fie foe foo", } FOOBAR,'{ Bonus score gained in repository, }  BONUS,f{ Caveclosing timers, }  CLOCK1,CLOCK2,e{ Maximum possible score, } MAXSCOR, F{ Maximum number of turns the lamp may be on before batteries die, } LIMIT: INTEGER;!{ Text file for all messages, }a ADVTXT:FILE OF LREC;,>{ Array of travel table starting entries for all locations, }! KEY:ARRAY[1..LOCSIZ] OF KEYLINK;h2{ Array of record numbers for object messages, } PTEXT,L{ Initial object locations, } PLACE1,FIXED1,{ Default verb respnses, }d ACTSPK:OBJARRAY; G{ Array of record numbers for short and long location descriptions, }b STEXT,LTEXT,0{ Number of times we've described a location, } ABB:LOCARRAY;1{ Array of record numbers for random messages, } RTEXT:ARRAY[1..300] OF INTEGER;1{ Array of record numbers for magic messages, }f MTEXT:ARRAY[1..100] OF INTEGER;7{ Record number for start of player class messages, }e CTEXT:INTEGER;"{ Hints "at location" counters, } HINTLC:ARRAY[1..10] OF INTEGER;?{ Array of flags used to keep track of hints already given, } HINTED:ARRAY[1..10] OF BOOLEAN;@{ Hints information: message numbers, points deducted, etc., }$ HINTS:ARRAY[1..10,1..4] OF INTEGER;&{ Dwarf old and current locations, }# ODLOC,DLOC:ARRAY[1..6] OF INTEGER;${ "Dwarf has seen player" flags, } DSEEN:ARRAY[1..6] OF BOOLEAN;*{ True if it was dark before this turn, } WZDARK,-{ True if lamp running out warning given, }a LMWARN, o{ True if cave is closing, } CLOSING,;K{ True if player has discovered he can't get out of cave during closing, }R PANIC,]{ True if cave has closed, } CLOSED,{ True if player gave up, }, GAVEUP,4{ True if scoring in response to "score" request, } SCORING:BOOLEAN;{ Used for verb values, }T VERB,.{ New location after motion verb response, } NEWLOC,#{ Old location two turns prior, }o OLDLC2,{ Player score, }r SCORE,p,{ Wordtype part of vocabulary definition,  0, motion verbs 1, objects 2, action verbsi 3, miscellaneous words }t WORDTYPE,5{ Number of turns allowed in a demonstration game, }c SHORT,} { Raw vocabulary definitions, } KK,{ Old location, last turn, }  OLDLOC,{ Index variable, } I,S3{ Definition within wordtype of vocabulary word, }, K: INTEGER;{ Words input by player, }, WRD1,WRD1X,WRD2,WRD2X: WORD;t;{ Program flow control flag used when dragon is killed, }p DRAGFLG,e3{ True if demonstration game during prime time, }  DEMO,6{ Program flow control flag, true if game is done, } DONE,J{ Program flow control flag, true if player has moved to new location, } MOVED,uH{ Player input parsing flag, true if we have definitions for each of the two allowed input words, } GOTBOTH,iJ{ Player input parsing flag, true if we don't throw away the first word, } NODUMP:BOOLEAN;{ Wizardry data file. } ADVWIZ:FILE OF INTEGER;{ Cave hours. }d* WKDAY,WKEND,HOLID:ARRAY[1..2] OF INTEGER;{ Holiday dates. }e HBEGIN,HEND:UNSIGNED;{ Holiday name. }t HNAME:ARRAY[1..20] OF CHAR; %{ True if restarting a saved game. }a SETUP:BOOLEAN;n"{ True if using VT100 database. } VT100:BOOLEAN;a true if we have definitions for each of the two allowed input words, } GOTBOTH,iJ{ Player input parsing flag, true if we don't throw away the first word, } NODUMP:BOOLEAN;{ Wizardry data file. } ADVWIZ:FILE OF INTEGER;{ Cave hours. }d* WKDAY,WKEND,HOLID:ARRAY[1..2] OF INTEGER;{ Holiday dates. }e HBEGIN,HEND:UNSIGNED;{ Holiday name. }t HNAME:ARRAY[1..20] OF CHAR; %{ True if restarting a saved game. }a SETUP:BOOLEAN;n"{ True if using VT100 database. } VT100:BOOLEAN@P ;dOjut words, } GOTBOTH,iJ{ Player input parsing flag, true if we don't throw away the first word, } NODUMP:BOOLEAN;{ Wizardry data file. } ADVWIZ:FILE OF INTEGER;{ Cave hours. }d* WKDAY,WKEND,HOLID:ARRAY[1..2] OF INTEGER;{ Holiday dates. }e HBEGIN,HEND:UNSIGNED;{ Holiday name. }t HNAME:ARRAY[1..20] OF CHAR; %{ True if restarting a saved game. }a SETUP:BOOLEAN;n"{ True if using VT100 database. } VT100:BOOLEAN!{********>>>>>>>><<<<<<<<********>> MODULE: ASK 29-OCT-80: This module contains the procedures ASK, ASKR, ASKM, and WIZARD. !********>>>>>>>><<<<<<<<********} {$C .TITLE ASK .IDENT /V0/ }9{ ****************** I/O SUBROUTINES ****************** }'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;>PROCEDURE GETIN(VAR WORD1,WORD1X,WORD2,WORD2X: WORD);EXTERNAL;H{ This function asks question I using output procedure SPK (which couldEbe RSPEAK or MSPEAK) and returns a value true for a 'yes' and outputsGmessage J or returns a value false for a 'no' and outputs message K. }5FUNCTION ASK(I,J,K: INTEGER; PROCEDURE SPK): BOOLEAN;KBEGINN< REPEAT { Until question answered, WRD1[1]= 'Y' OR 'N' } { Ask the question }  SPK(I); { Get the player's response } GETIN(WRD1,WRD1X,WRD2,WRD2X); CASE WRD1[1] OF { Player responded yes } 'Y': BEGIN SPK(J); ASK:=TRUE END; { Player responded no }d 'N': BEGIN SPK(K); ASK:=FALSE) END;+ { Avoiding the question is not allowed! }e ELSE RSPEAK(202) END& UNTIL (WRD1[1]='Y')OR(WRD1[1]='N')END;6{ Ask a question and respond from random messages. }'FUNCTION ASKR(I,J,K: INTEGER): BOOLEAN;eBEGIN[ ASKR:=ASK(I,J,K,RSPEAK)END;5{ Ask a question and respond from magic messages. }N'FUNCTION ASKM(I,J,K: INTEGER): BOOLEAN;FBEGINl ASKM:=ASK(I,J,K,MSPEAK)END;B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBER I 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGINc 18 -- HEND 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.d 102..354 -- Saved game 1.  355..607 -- Saved game 2. 608..860 -- Saved game 3.r( 861..1560 -- Message of the day. }!TYPE ARR5=ARRAY[1..5] OF INTEGER;EPROCEDURE GETMAGIC(VAR MAGICNUMBER:ARR5;VAR MAGICWORD:WORD);EXTERNAL;10PROCEDURE WRTMAGIC(VAR MAGICWORD:WORD);EXTERNAL;HFUNCTION CHKMAGIC(WRD,MAGICWORD:WORD;MAGICNUMBER:ARR5):BOOLEAN;EXTERNAL;O{ This function tests for Wizards and returns a value of true if he passes. } FUNCTION WIZARD:BOOLEAN;VAR MAGICWORD:WORD;a MAGICNUMBER:ARR5;a.{ Local procedure to deal with imposters... }PROCEDURE IMPOSTER;3{ Aha! An imposter! } BEGINd MSPEAK(20);E WIZARD:=FALSEFEND;BEGIN { Wizard }. { Get the current magic word and number. }$ GETMAGIC(MAGICNUMBER,MAGICWORD);I { Ask if he's a wizard. If he says yes, make him prove it. Return R% true if he really is a wizard. }c IF ASKM(16,0,7) THEN BEGINA { He says he is. First step: does he know anything magical? } MSPEAK(17); GETIN(WRD1,WRD1X,WRD2,WRD2X);! IF WRD1<>MAGICWORD THEN IMPOSTERt@ { He does. Give him a random challenge and check his reply. }# ELSE IF ASKM(18,0,0) THEN IMPOSTER ELSE BEGIN . { Get random magic word and write it. } WRTMAGIC(MAGICWORD);G { Get his reply.... }" GETIN(WRD1,WRD1X,WRD2,WRD2X);$ { If he replied correctly... }8 IF CHKMAGIC(WRD1,MAGICWORD,MAGICNUMBER) THEN BEGIN  G, { By golly, he really *is* a wizard... } MSPEAK(19);i WIZARD:=TRUE END ELSE IMPOSTER END END ELSE WIZARD:=FALSE;  CLOSE(ADVWIZ) END; Give him a random challenge and check his reply. }# ELSE IF ASKM(18,0,0) THEN IMPOSTER ELSE BEGIN . { Get random magic word and write it. } WRTMAGIC(MAGICWORD);G { Get his reply.... }" GETIN(WRD1,WRD1X,WRD2,WRD2X);$ { If he replied correctly... }8 IF CHKMAGIC(WRD1,MAGICWORD,MAGICNUMBER) THEN BEGIN  G, { By golly, he really *is* a wizard... } MSPEAK(19)@>P ;dQ¬ARD:=FALSE;  CLOSE(ADVWIZ) END; Give him a random challenge and check his reply. }# ELSE IF ASKM(18,0,0) THEN IMPOSTER ELSE BEGIN . { Get random magic word and write it. } WRTMAGIC(MAGICWORD);G { Get his reply.... }" GETIN(WRD1,WRD1X,WRD2,WRD2X);$ { If he replied correctly... }8 IF CHKMAGIC(WRD1,MAGICWORD,MAGICNUMBER) THEN BEGIN  G, { By golly, he really *is* a wizard... } MSPEAK(19) {*******>>>>>>>><<<<<<<<********>> MODULE: LOOP0 29-OCT-80A This module contains the main program loop procedures which areI used after each turn in which the player has moved from one location to D another: DWARFSTUFF, BLOCKED, ALIVE, DEATH, PITDEATH, WHEREAREWE,  and WHATSHERE.!********>>>>>>>><<<<<<<<********} {$C .TITLE LOOP0 .IDENT /V0/ }@{ *************** DATA STRUCTURE ROUTINES ******************** }.FUNCTION FORCED(LOC:INTEGER):BOOLEAN;EXTERNAL;0FUNCTION BITSET(LOC,N:INTEGER):BOOLEAN;EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;t(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION DARK:BOOLEAN;EXTERNAL;o)FUNCTION PCT(N:INTEGER):BOOLEAN;EXTERNAL;D)PROCEDURE MOVE(OBJ,LOC:INTEGER);EXTERNAL;**FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;&PROCEDURE CARRY(OBJ:INTEGER);EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;)FUNCTION RAN(N:INTEGER):INTEGER;EXTERNAL;E?{ ************** I/O SUBROUTINES **************************** }C'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;0FUNCTION ASKR(I,J,K: INTEGER): BOOLEAN;EXTERNAL;&PROCEDURE SPEAK(MSG:INTEGER);EXTERNAL;,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;B{ **************** MAIN PROGRAM PROCEDURES ********************* }>{ After having moved, check to see if his way is blocked... }PROCEDURE BLOCKED;BEGIN;P { If the cave is closing and the player has exited from the cave and is not Q dead, put him back where he was and tell him he's stuck. The first time this P happens, set the time until closure to 15 turns and remember he's panicked.}6 IF (NEWLOC<9)AND(NEWLOC<>-1)AND CLOSING THEN BEGIN RSPEAK(130);K NEWLOC:=LOCATION; IF NOT PANIC THEN CLOCK2:=15; PANIC:=TRUE END;O { See if a dwarf has seen him and has come from where he wants to go. If eN so, the dwarf's blocking his way, put him back and tell him about it. If P coming from place forbidden to pirate (dwarves rooted in place) let him get  out (and attacked). }t 2 IF (NEWLOC<>LOCATION)AND NOT FORCED(LOCATION) 4 AND NOT BITSET(LOCATION,3) THEN FOR I:=1 TO 5 DOG IF (ODLOC[I]=NEWLOC) AND DSEEN[I] AND (NEWLOC<>LOCATION) THEN BEGIN; NEWLOC:=LOCATION; RSPEAK(2); EXIT= END END;PROCEDURE FINISH;EXTERNAL;{ "You're dead, Jim."eQ If the current LOCATION is -1, it means the clown got himself killed. We'll iQallow this MAXDIE times. MAXDIE is set based on the number of snide messages ePavailable. Each death results in a message (81, 83, etc.) which offersPreincarnation; if accepted, this results in message 82, 84, etc. The last time,Pif he wants another chance, he gets a snide remark as we exit. WhenQreincarnated, all objects being carried get dropped at OLDLC2 (presumably the Plast place prior to being killed) without change of PROPs. The loop runsQbackwards to assure that the bird is dropped before the cage. The lamp is a Pspecial case (it wouldn't do to leave it in the cave). It is turned off andPleft outside the building (only if he was carrying it, of course). He himselfPis left inside the building (and heaven help him if he tries to XYZZY back intoPthe cave without the lamp!). OLDLOC is zapped so he can't just "retreat". }PROCEDURE DEATH;FORWARD;PROCEDURE PITDEATH;FORWARD;oPROCEDURE ALIVE;BEGINe IF LOCATION=-1 THEN DEATH K { If it's dark two or more moves in a row then he has a 35% chance of eA falling into a pit. This is the easiest way to get killed. }d5 ELSE IF DARK AND WZDARK AND PCT(35) THEN PITDEATHtEND;PROCEDURE DEATH;VAR J:INTEGER; YEA:BOOLEAN;BEGINn IF NOT CLOSING THEN BEGINb' YEA:=ASKR(81+NUMDIE*2,82+NUMDIE*2,54);O NUMDIE:=NUMDIE+1;4 IF (NUMDIE=MAXDIE)OR NOT YEA THEN FINISH ELSE BEGIN DESTROY(WATER); DESTROY(OIL);( IF TOTING(LAMP) THEN PROP[LAMP]:=0;1 FOR J:=MAXTRS DOWNTO 1 DO IF TOTING(J) THEN n2 IF J=LAMP THEN DROP(J,1) ELSE DROP(J,OLDLC2); NEWLOC:=3;s LOCATION:=NEWLOC; OLDLOC:=LOCATION; OLDLC2:=OLDLOC; MOVED:=TRUE END  END ELSE BEGIND { He died during closing time. No resurrection. Tally up a death and exit. }8 RSPEAK(131);U NUMDIE:=NUMDIE+1; FINISH+ ENDNEND;J{ The easiest way to get killed is to fall into a pit in the darkness. }PROCEDURE PITDEATH;LBEGINE RSPEAK(23); OLDLC2:=LOCATION;T DEATHOEND;L{ Tell him where he is using the long description followed by ABBNUM short descriptions. }PROCEDURE WHEREAREWE;TBEGIN L { If it's dark and not a forced location, warn him about pit death (he A can't see where he is). Otherwise tell him where he is. }i5 IF DARK AND NOT FORCED(LOCATION) THEN RSPEAK(16)  ELSE BEGIN' { Is he being followed by the bear? }l" IF TOTING(BEAR) THEN RSPEAK(141);, { Use either long or short description. }0 IF (ABBNUM=0) OR ((ABB[LOCATION] MOD ABBNUM)=0)3 OR (STEXT[LOCATION]=0) THEN SPEAK(LTEXT[LOCATION])  ELSE SPEAK(STEXT[LOCATION]); D { Increment the number of times we've described this location. } ABB[LOCATION]:=ABB[LOCATION]+1e END;< { At "Y2", 25% of the time a hollow voice says "Plugh"}> IF (LOCATION=33)AND PCT(25) AND NOT CLOSING THEN RSPEAK(8)END;P{ This procedure describes the objects at the current location and keeps track !of newly discovered treasures. }rPROCEDURE WHATSHERE;VAR LINK:OBJLINK;I OBJ,I:INTEGER;BEGINE1 { If it's dark, he can't see what's here. }  IF NOT DARK THEN BEGIN= { Point to the head of the ATLOC list for this location. }  LINK:=ATLOC[LOCATION];O9 { While there are things in the list, describe them. }l WHILE LINK<>NIL DO BEGIN  { Get object number. }  OBJ:=LINK^.OBJ;H { If it's the second of two placed objects, use the normal object E number. Two placed objects have OBJ+100 linked into the second T location's list. }" IF OBJ>100 THEN OBJ:=OBJ-100;= { Skip the steps description if he's toting the gold. }H B7 IF ((OBJ<>STEPS) OR NOT TOTING(NUGGET)) THEN BEGINc> { If PROP is -1 and we're not in the repository, he's found  another treasure. }+ IF (PROP[OBJ]<0)AND NOT CLOSED THEN BEGIN $ { Make it's property zero. } PROP[OBJ]:=0;'@ { Rug is special case; once seen, it's PROP is 1 (dragon A on it) till dragon is killed. Similarly for chain; PROP is ? initially 1 (locked to bear). This is because PROP=0 is {" needed to get full score. }2 IF (OBJ=RUG)OR(OBJ=CHAIN) THEN PROP[OBJ]:=1;' { Tally off another treasure. }O TALLY:=TALLY-1;nB { If the remaining treasures are too elusive (if the snake 8 eats the bird, for example), then zap his lamp. }A IF (TALLY=TALLY2)AND(TALLY<>0)AND(LIMIT>35) THEN LIMIT:=35;e END; I:=PROP[OBJ];a? { Use the description for the bottom of the steps if at the R" east end of the hall of mists. }5 IF (OBJ=STEPS)AND(LOCATION=FIXED[STEPS]) THEN I:=1;e< { Describe the object according to it's current property B value. Skip the description for objects in the repository which % haven't been moved yet (PROP=-1). }e IF I>=0 THEN PSPEAK(OBJ,I) END;a< { Advance to the next objlink and repeat if not nil. } LINK:=LINK^.NXT END { While LINK<>NIL }= END { If not DARK }BEND;8{**************** DWARF PROCEDURE *******************}K{ This procedure handles activation, movement, and attack routines for theEdwarves and the pirate. }PROCEDURE DWARFSTUFF;g$VAR I,J,DTOTAL,ATTACK,STICK:INTEGER;J{ When we know what the dwarves are up to we call this local procedure to"tell the poor sucker about it! }PROCEDURE DWARFATTACK;VAR K:INTEGER;BEGIN ) IF DTOTAL=1 THEN RSPEAK(4) ELSE BEGIN WRITELN;^ WRITE('There are ');K WRITE(DTOTAL:1); > WRITELN(' threatening little dwarves in the room with you.'); END; IF ATTACK>0 THEN BEGIN IF DFLAG=2 THEN DFLAG:=3; IF ATTACK=1 THEN BEGIN  RSPEAK(5); K:=52 END ELSE BEGINR WRITELN;, T WRITE(ATTACK:1);E. WRITELN(' of them throw knives at you!'); K:=6i END; , IF STICK<=1 THEN RSPEAK(K+STICK) ELSE BEGIN WRITELN;W WRITE(STICK:1);! WRITELN(' of them get you!')R END;) IF STICK<>0 THEN BEGIN+ { Too bad -- This guy got killed. }W OLDLC2:=LOCATION; LOCATION:=-1r END END;END;M{ This procedure is called if the pirate's spotted him. He leaves him aloneE5once we've found the chest (the call is not made). } PROCEDURE PIRATE; VAR J,K:INTEGER;BEGIN O { K counts if a treasure is here. If not, and TALLY=TALLY2 plus one (for 4 an unseen chest), let the pirate be spotted. } K:=0; FOR J:=50 TO MAXTRS DO BEGINH { Pirate won't take the pyramid from the plover room or the dark room  (too easy!). }/ IF ((J<>PYRAMID)OR((LOCATION<>PLACE1[PYRAMID])N9 AND(LOCATION<>PLACE1[EMERALD])))AND TOTING(J) THEN BEGINi+ { This guy has treasure to steal. }e RSPEAK(128); G { First time this happens put the chest in the maze and the clue u in the other maze. }f0 IF PLACE[MESSAGE]=0 THEN MOVE(CHEST,CHLOC); MOVE(MESSAGE,CHLOC2); { Now steal everything. }! FOR J:=50 TO MAXTRS DO BEGINa/ IF (J<>PYRAMID)OR((LOCATION<>PLACE1[PYRAMID]) , AND(LOCATION<>PLACE1[EMERALD])) THEN BEGIN- IF AT(J) AND(FIXED[J]=0) THEN CARRY(J);C% IF TOTING(J) THEN DROP(J,CHLOC)T ENDI END; : { Finally, move the pirate to his chest location. } DLOC[6]:=CHLOC; ODLOC[6]:=CHLOC;n DSEEN[6]:=FALSE END;  IF J>MAXTRS THEN J:=MAXTRS;2 { Set K if there is any treasure here at all. } IF HERE(J) THEN K:=1  END; IF DSEEN[6] THEN BEGING { If there are no treasures here *and* the rest can't be found *and* II the lamp is here and on *and* the pirate hasn't stolen anything, we let DF the pirate be spotted and pop him and his chest back to the maze. } 1 IF (TALLY=(TALLY2+1))AND(K=0)AND(PLACE[CHEST]=0)s, AND HERE(LAMP) AND(PROP[LAMP]=1) THEN BEGIN RSPEAK(186);  MOVE(CHEST,CHLOC); MOVE(MESSAGE,CHLOC2); DLOC[6]:=CHLOC; ODLOC[6]:=CHLOC;a DSEEN[6]:=FALSE END; G { Finally, if the pirate sees him but there is no treasure to be had eD and there is more to be found, he hears the pirate sneaking around / ("faint rustling noises in the darkness"). }e3 IF (ODLOC[6]<>DLOC[6])AND PCT(20) THEN RSPEAK(127)t END END;O{ This procedure moves a dwarf "I" at random by searching the travel table for]Mall valid moves from a given location and selecting one at random. Backward ,Omovement is not allowed, dwarves may not move into forced travel locations, andD$they may not go to locations<15. }PROCEDURE MOVEDWARF(I:INTEGER);dVAR COND,J,NEWLOC:INTEGER; LINK:KEYLINK;e TK:ARRAY[0..20] OF INTEGER;tBEGINn7 { Zero out the array of possible new locations. }A FOR J:=0 TO 20 DO TK[J]:=0; 9 { Set the number of possible new locations to 1. } J:=1;gP { Get the first key link from the travel table for this dwarf's location. } LINK:=KEY[DLOC[I]];eJ { Now search the keylinks for valid new locations for our friend. } WHILE LINK<>NIL DO BEGIN NEWLOC:=LINK^.NEWLOC[2];W COND:=LINK^.NEWLOC[1];D6 { Check if new location is allowed and different. }8 IF (NEWLOC<=LOCSIZ)AND(NEWLOC>=15)AND(NEWLOC<>ODLOC[I]); AND((J=1)OR(TK[J-1]<>NEWLOC))AND(J<20)AND(NEWLOC<>DLOC[I]) @ THEN IF (NOT FORCED(NEWLOC))AND((I<>6)OR(NOT BITSET(NEWLOC,3))) AND(COND<>100) THEN BEGIN5 { If okay, save it and increment the total. }} TK[J]:=NEWLOC;I J:=J+1N END;c" { Advance to the next keylink. } LINK:=LINK^.NXTLINK END;< { Put the old location in as a last possible choice. } TK[J]:=ODLOC[I];I { If we have other locations available, don't allow the old one. }L IF J>=2 THEN J:=J-1;J { Select a new location at random from the list of possibilities. } J:=RAN(J);( { Make the current location old. } ODLOC[I]:=DLOC[I]; { Move the dwarf. } i DLOC[I]:=TK[J]; 4 { Has the fearless Adventurer been spotted? }? DSEEN[I]:=(DSEEN[I] AND (LOCATION>=15))OR(DLOC[I]=LOCATION)  OR(ODLOC[I]=LOCATION);1 { If so, stay with him and create havoc. } IF DSEEN[I] THEN BEGIN= { This threatening little dwarf is in the room with him! }N DLOC[I]:=LOCATION;c@ { If the dwarf is really a dwarf and not the pirate then.....} IF I<>6 THEN BEGINM= { Increment the total of dwarves who have seen him. }  DTOTAL:=DTOTAL+1;5 { If twice at the same location, then attack!!}r# IF ODLOC[I]=DLOC[I] THEN BEGIND ATTACK:=ATTACK+1;>8 { Make the knife available for attempted recovery. }% IF KNFLOC>=0 THEN KNFLOC:=LOCATION;v@ { Randomly decide if this knife stuck him or not. Note that = the odds go up as DFLAG increases (dwarves get *mad* ). }f1 IF RAN(1000)<(95*(DFLAG-2)) THEN STICK:=STICK+1n END END0 { .....otherwise, the pirate's spotted him! }8 ELSE IF (LOCATION<>CHLOC)AND(PROP[CHEST]<0) THEN PIRATE ENDeEND;BEGIN { Dwarfstuff }N { If this guy's not dead and the location doesn't have forced motion and F the new location is not forbidden to the pirate then go........ }2 IF (LOCATION<>-1) THEN IF NOT FORCED(LOCATION)) AND NOT BITSET(LOCATION,3) THEN BEGIN  CASE DFLAG OFH { Activate the dwarves after he is at or beyond the hall of mists  (location 15). }D& 0: IF LOCATION>=15 THEN DFLAG:=1;F { When we encounter the first dwarf, we kill 0,1, or 2 of the 5 F dwarves. If any of the survivors is at the current LOCATION, we ( replace him with the alternate. }0 1: IF (LOCATION>=15) AND PCT(10) THEN BEGIN DFLAG:=2;. FOR I:=1 TO 2 DO BEGIN J:=RAN(5); IF PCT(50) THEN DLOC[J]:=0 END; FOR I:=1 TO 5 DO BEGIN/ IF DLOC[I]=LOCATION THEN DLOC[I]:=DALTLC;  ODLOC[I]:=DLOC[I]o END; RSPEAK(3); MOVE(AXE,LOCATION) END;>H { Things are in full swing. Move each dwarf at random, except if H he's seen us he sticks with us. Dwarves never go to locations<15. B If wandering at random, they don't back up unless there's no E alternative. If they don't have to move, they attack. And, of O8 course, dead dwarves don't do much of anything. }  ELSE BEGINT DTOTAL:=0; ATTACK:=0; STICK:=0;H& { Move every dwarf still alive. }3 FOR I:=1 TO 6 DO IF DLOC[I]<>0 THEN MOVEDWARF(I); ? { Now we know what's happening. Let's tell the poor sucker a about it. } IF DTOTAL>0 THEN DWARFATTACK END END { Case of dflag. } END END;ering at random, they don't back up unless there's no E alternative. If they don't have to move, they attack. And, of O8 course, dead dwarves don't do much of anything. }  ELSE BEGINT DTOTAL:=0; ATTACK:=0; STICK:=0;H& { Move every dwarf still alive. }3 FOR I:=1 TO 6 DO IF DLOC[I]<>0 THEN MOVEDWARF(I)@ P ;dNì a about it. } IF DTOTAL>0 THEN DWARFATTACK END END { Case of dflag. } END END;ering at random, they don't back up unless there's no E alternative. If they don't have to move, they attack. And, of O8 course, dead dwarves don't do much of anything. }  ELSE BEGINT DTOTAL:=0; ATTACK:=0; STICK:=0;H& { Move every dwarf still alive. }3 FOR I:=1 TO 6 DO IF DLOC[I]<>0 THEN MOVEDWARF(I)!{********>>>>>>>><<<<<<<<********>> MODULE: SAVNAM 29-OCT-80> This module contains the procedure SAVNAME, which is used byI SAVE to record the name under which a game is being saved in ADVWIZ.DTA.!********>>>>>>>><<<<<<<<********} {$C .TITLE SAVNAM  .IDENT /V0/ }9{ ************* I/O SUBROUTINES ********************}9PROCEDURE GETIN(VAR WRD1,WRD1X,WRD2,WRD2X:WORD);EXTERNAL;'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;@{ ****************** SUSPEND PROCEDURE *********************** }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERD 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGIN 18 -- HEND( 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }5PROCEDURE WRWRD(WRD1,WRD1X,WRD2,WRD2X:WORD);EXTERNAL;CI{ Procedure to save the player's name for a saved game. Variable SAV is1Kreturned as an index into which of the save areas we used. Global variableSHI is used as a record pointer into ADVWIZ; refer to commment in WRWIZ. }#PROCEDURE SAVNAME(VAR SAV:INTEGER);fVAR J:INTEGER; WRD:WORD;aBEGINa SEEK(ADVWIZ,40); ADVWIZ^:=ADVWIZ^+1;5 PUT(ADVWIZ); SEEK(ADVWIZ,42); FOR SAV:=1 TO 3 DO BEGIN FOR J:=1 TO 5 DO BEGIN # WRD[J]:=CHR(ADVWIZ^+ORD('A'));, GET(ADVWIZ) END; FOR J:=6 TO 20 DO GET(ADVWIZ);  IF WRD=' ' THEN EXITi END; I:=20*(SAV-1)+42;x SEEK(ADVWIZ,I);v MSPEAK(38);  b! GETIN(WRD1,WRD1X,WRD2,WRD2X);  MSPEAK(39);I WRWRD(WRD1,WRD1X,WRD2,WRD2X)END;URE SAVNAME(VAR SAV:@ P ;dOZ,40); ADVWIZ^:=ADVWIZ^+1;5 PUT(ADVWIZ); SEEK(ADVWIZ,42); FOR SAV:=1 TO 3 DO BEGIN FOR J:=1 TO 5 DO BEGIN # WRD[J]:=CHR(ADVWIZ^+ORD('A'));, GET(ADVWIZ) END; FOR J:=6 TO 20 DO GET(ADVWIZ);  IF WRD=' ' THEN EXITi END; I:=20*(SAV-1)+42;x SEEK(ADVWIZ,I);v MSPEAK(38);  b! GETIN(WRD1,WRD1X,WRD2,WRD2X);  MSPEAK(39);I WRWRD(WRD1,WRD1X,WRD2,WRD2X)END;URE SAVNAME(VAR SAV:!{********>>>>>>>><<<<<<<<********>> MODULE: SPEAK 29-OCT-80< This module contains the procedures SPEAK, RSPEAK, MSPEAK, and CSPEAK. !********>>>>>>>><<<<<<<<********} {$C .TITLE SPEAK .IDENT /V0/ }9{ ************* I/O SUBROUTINES ********************}B{ This procedure outputs a message from ADVTXT starting at recordLnumber REC and continuing as long as the message number at the start of eachline remains the same. }PROCEDURE SPEAK(REC: INTEGER);VAR OLDLC:INTEGER;BEGIN> SEEK(ADVTXT,REC); WITH ADVTXT^ DO BEGIN8 OLDLC:=LOC;( {Supress printout if message is '>$<' }: IF (TXT[1]<>'>')OR(TXT[2]<>'$')OR(TXT[3]<>'<') THEN BEGIN WRITELN;  WHILE LOC=OLDLC DO BEGIN WRITELN(TXT); GET(ADVTXT)E END END ENDEND;O{ This procedure outputs message number MSG from the random messages group. }nPROCEDURE RSPEAK(MSG:INTEGER);BEGINt! IF MSG<>0 THEN SPEAK(RTEXT[MSG])eEND;O{ This procedure outputs message number MSG from the magic messages group. }EPROCEDURE MSPEAK(MSG:INTEGER);BEGINC! IF MSG<>0 THEN SPEAK(MTEXT[MSG])gEND;H{ This procedure is used at the end of the game to print out the player)classification according to his score. }R(PROCEDURE CSPEAK(SCORE,MAXSCOR:INTEGER);VAR REC,MSG:INTEGER; WRD1:WORD;BEGINtF { First point to the player classification messages in ADVTXT. } REC:=CTEXT; SEEK(ADVTXT,CTEXT);P WITH ADVTXT^ DO BEGIN H { Now search for the applicable message. See database description in ' ADVINI for explanation of messages. }I WHILE SCORE>=LOC DO BEGIN GET(ADVTXT); REC:=REC+1  END; : { Save the breakpoint score for the next higher class. } MSG:=LOCg END;& { Tell him his classification. } T SPEAK(REC);SD { Find out how many points he needs to reach the next level. } MSG:=MSG-SCORE;s3 IF MSG=1 THEN WRD1:='. ' ELSE WRD1:='s. ';X WRITELN;6 { If he got a perfect score, congratulations!! }% IF SCORE=MAXSCOR THEN RSPEAK(203)AL { Otherwise tell him how many points he needs to hit the next level. } ELSE BEGIN5 WRITE('To achieve the next higher rating you need');h WRITE(MSG:4); WRITE(' more point'); WRITELN(WRD1) END END;cation. } T SPEAK(REC);SD { Find out how many points he needs to reach the next level. } MSG:=MSG-SCORE;s3 IF MSG=1 THEN WRD1:='. ' ELSE WRD1:='s. ';X WRITELN;6 { If he got a perfect score, congratulations!! }% @P ;dM\w many points he needs to hit the next level. } ELSE BEGIN5 WRITE('To achieve the next higher rating you need');h WRITE(MSG:4); WRITE(' more point'); WRITELN(WRD1) END END;cation. } T SPEAK(REC);SD { Find out how many points he needs to reach the next level. } MSG:=MSG-SCORE;s3 IF MSG=1 THEN WRD1:='. ' ELSE WRD1:='s. ';X WRITELN;6 { If he got a perfect score, congratulations!! }% !{********>>>>>>>><<<<<<<<********>> MODULE: VERBS0 29-OCT-806 This module contains the procedures FINDIT, BREAKIT, LAMPON, LAMPOFF, WAVEIT.!********>>>>>>>><<<<<<<<********} {$C .TITLE VERBS0 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;.FUNCTION LIQLOC(LOC:INTEGER):INTEGER;EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;*,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION DARK:BOOLEAN;EXTERNAL;e9{ ************* I/O SUBROUTINES ********************}>'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;R,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;A{********************* VERB FIND *****************************}:3{ "find" -- Might be carrying it, might be here. }BPROCEDURE FINDIT;VAR X:BOOLEAN; I:INTEGER;;BEGINC IF TOTING(OBJ) THEN RSPEAK(24)E ELSE IF CLOSED THEN RSPEAK(138) ELSE BEGINX X:=FALSE;U IF OBJ=DWARF THENE FOR I:=1 TO 5 DO2 IF (DLOC[I]=LOCATION)AND(DFLAG>=2) THEN X:=TRUE;= IF AT(OBJ)OR((LIQ=OBJ)AND AT(BOTTLE))OR(K=LIQLOC(LOCATION))E OR X THEN RSPEAK(94) ELSE RSPEAK(ACTSPK[VERB])O ENDEND;5{ ******************* VERB BREAK ****************** }*PROCEDURE WAKEDWARVES;EXTERNAL; M{ "break" -- Only works for mirror in repository and, of course, the vase. }IPROCEDURE BREAKIT;BEGING CASE OBJ OF MIRROR: IF CLOSED THEN BEGIN RSPEAK(197);  WAKEDWARVES END  O ELSE RSPEAK(148); " VASE: IF PROP[VASE]=0 THEN BEGIN, IF TOTING(VASE) THEN DROP(VASE,LOCATION); PROP[VASE]:=2;L FIXED[VASE]:=-1;O RSPEAK(198) ENDK ELSE RSPEAK(ACTSPK[VERB]); ELSE RSPEAK(ACTSPK[VERB])* ENDEND;>{****************** LAMP ON PROCEDURE *********************}{ Light the lamp... }kPROCEDURE LAMPON;oBEGINa/ IF NOT HERE(LAMP) THEN RSPEAK(ACTSPK[VERB])$ ELSE IF LIMIT<0 THEN RSPEAK(184)) ELSE IF PROP[LAMP]=1 THEN RSPEAK(204)A ELSE BEGIN PROP[LAMP]:=1;4 RSPEAK(39); IF WZDARK THEN BEGING MOVED:=TRUE;S NEWLOC:=LOCATIONI END ENDAEND;<{***************** LAMP OFF PROCEDURE *******************}PROCEDURE LAMPOFF;BEGIN(/ IF NOT HERE(LAMP) THEN RSPEAK(ACTSPK[VERB])  ELSE BEGIN! IF PROP[LAMP]=0 THEN RSPEAK(205)g ELSE BEGIN. PROP[LAMP]:=0;N RSPEAK(40)F END;R IF DARK THEN RSPEAK(16) ENDEND;>{******************** VERB WAVE *****************************}6{ "wave" -- No effect unless waving rod at fissure. }PROCEDURE WAVEIT;IBEGIN J IF (NOT TOTING(OBJ))AND((OBJ<>ROD)OR NOT TOTING(ROD2)) THEN RSPEAK(29)@ ELSE IF CLOSING OR NOT AT(FISSURE) THEN RSPEAK(ACTSPK[VERB]) ELSE BEGIN PROP[FISSURE]:=1-PROP[FISSURE]; PSPEAK(FISSURE,2-PROP[FISSURE]) END]END;RSPEAK(205)g ELSE BEGIN. PROP[LAMP]:=0;N RSPEAK(40)F END;R IF DARK THEN RSPEAK(16) ENDEND;>{******************** VERB WAVE ************@P ;dP issure. }PROCEDURE WAVEIT;IBEGIN J IF (NOT TOTING(OBJ))AND((OBJ<>ROD)OR NOT TOTING(ROD2)) THEN RSPEAK(29)@ ELSE IF CLOSING OR NOT AT(FISSURE) THEN RSPEAK(ACTSPK[VERB]) ELSE BEGIN PROP[FISSURE]:=1-PROP[FISSURE]; PSPEAK(FISSURE,2-PROP[FISSURE]) END]END;RSPEAK(205)g ELSE BEGIN. PROP[LAMP]:=0;N RSPEAK(40)F END;R IF DARK THEN RSPEAK(16) ENDEND;>{******************** VERB WAVE ************!{********>>>>>>>><<<<<<<<********>> MODULE: VERBS1 21-OCT-80> This module contains the procedures LOCKED, LOCKIT, READOBJ, and READIT.!********>>>>>>>><<<<<<<<********} {$C .TITLE VERBS1 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;)PROCEDURE DROP(OBJ,LOC:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION DARK:BOOLEAN;EXTERNAL; 9{ ************* I/O SUBROUTINES ********************}<'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;.FUNCTION ASKR(I,J,K:INTEGER):BOOLEAN;EXTERNAL;A{*************** VERBS UNLOCK/LOCK (TRANSITIVE) ***************}TP{ Lock, unlock an object. Special stuff for opening clam/oyster and for chain. }PROCEDURE LOCKED;AVAR I:INTEGER;BEGINB CASE OBJ OFN CLAM, OYSTER: BEGINI { I is used to keep track of whether referring to clam or oyster. }R% IF OBJ=CLAM THEN I:=0 ELSE I:=1; 7 { Must put it down before attempts to open it. }*& IF TOTING(OBJ) THEN RSPEAK(120+I)= { Trident is the only thing strong enough to open it. }*3 ELSE IF NOT TOTING(TRIDENT) THEN RSPEAK(122+I)*& { If trying to lock it.. what? }& ELSE IF VERB=LOCK THEN RSPEAK(61)I { Else if clam, open and drop pearl. "..this must be an oyster." }N ELSE IF I<>1 THEN BEGIN DESTROY(CLAM); MOVE(OYSTER,LOCATION); MOVE(PEARL,105); RSPEAK(124)  END) { Opening oyster gets nothing... }o ELSE RSPEAK(125)p END; % { Door may still be too rusty... }+8 DOOR: IF PROP[DOOR]=1 THEN RSPEAK(54) ELSE RSPEAK(111); { The cage isn't locked... }( CAGE: RSPEAK(32);( { Trying to lock/unlock the keys??? } ? KEYS: RSPEAK(55); { Need keys for the chain.. }) CHAIN: IF NOT HERE(KEYS) THEN RSPEAK(31)s$ { Got keys, wants to lock it... } ELSE IF VERB=LOCK THENL# { Maybe it's already locked... }E" IF PROP[CHAIN]<>0 THEN RSPEAK(34)2 { Or else there's nothing here to lock it to. }1 ELSE IF LOCATION<>PLACE1[CHAIN] THEN RSPEAK(173)o& { Okay, lock it back to the wall. } ELSE BEGIN) PROP[CHAIN]:=2;0 IF TOTING(CHAIN) THEN DROP(CHAIN,LOCATION); FIXED[CHAIN]:=-1; RSPEAK(172) END9 { Wants to unlock it but the bear's still dangerous.. }N% ELSE IF PROP[BEAR]=0 THEN RSPEAK(41){# { Maybe it's already unlocked.. }E& ELSE IF PROP[CHAIN]=0 THEN RSPEAK(37) { Okay, unlock it. } ELSE BEGIN0 PROP[CHAIN]:=0; FIXED[CHAIN]:=0; ) IF PROP[BEAR]<>3 THEN PROP[BEAR]:=2;P FIXED[BEAR]:=2-PROP[BEAR];{ RSPEAK(171) END;h5 { Grate.. can't be closing or this exit's closed. }  GRATE: IF CLOSING THEN BEGINO" IF NOT PANIC THEN CLOCK2:=15; PANIC:=TRUE;D RSPEAK(130) END { If he has no keys... }s' ELSE IF NOT HERE(KEYS) THEN RSPEAK(31)(' { Otherwise lock/unlock the grate. }E ELSE BEGINO I:=34+PROP[GRATE];)% IF VERB=LOCK THEN PROP[GRATE]:=00 ELSE PROP[GRATE]:=1;  I:=I+2*PROP[GRATE]; RSPEAK(I) END;O3 { All other objects can't be locked/unlocked... }R ELSE RSPEAK(ACTSPK[VERB]) ENDbEND;F{ ************** VERBS LOCK/UNLOCK (INTRANSITIVE) ****************** }PROCEDURE VERBHUH;EXTERNAL;PN{ Intransitive case of verbs "open","unlock","close","lock",etc. If he wants Nto lock or unlock something fixed, we see if it's here. If the chain is here Mtoo, then "...what?", otherwise if the chain is the only thing here, then go use the chain as OBJ. } *PROCEDURE LOCKIT;RBEGIN)F IF HERE(CLAM) THEN OBJ:=CLAM ELSE IF HERE(OYSTER) THEN OBJ:=OYSTERF ELSE IF AT(DOOR) THEN OBJ:=DOOR ELSE IF AT(GRATE) THEN OBJ:=GRATE;7 IF (OBJ<>0) AND HERE(CHAIN) THEN VERBHUH ELSE BEGIN; IF HERE(CHAIN) THEN OBJ:=CHAIN;/ IF OBJ=0 THEN RSPEAK(ACTSPK[VERB]) ELSE LOCKEDh ENDEND;G{******************** VERB READ (INTRANSITIVE) *********************}oPROCEDURE READOBJ;FORWARD;P{ "read" , no object given. READOBJ if only one thing present, else ...what? }PROCEDURE READIT;)VAR J:INTEGER;BEGINN J:=0;E IF HERE(MAGAZINE) THEN BEGIN J:=J+1; OBJ:=MAGAZINE END; IF HERE(TABLET) THEN BEGIN J:=J+1; OBJ:=TABLET END; IF HERE(MESSAGE) THEN BEGINI J:=J+1; OBJ:=MESSAGEH END;+ IF CLOSED AND TOTING(OYSTER) THEN BEGIN J:=J+1; OBJ:=OYSTER END;6 IF (J>1)OR(OBJ=0)OR DARK THEN VERBHUH ELSE READOBJEND;D{****************** VERB READ (TRANSITIVE) **********************}PROCEDURE NOTHERE;EXTERNAL;tH{ "read" -- Magazines in dwarvish, message we've seen, and ...oyster? }PROCEDURE READOBJ;BEGIN;) IF DARK THEN NOTHERE ELSE CASE OBJ OFL MAGAZINE: RSPEAK(190); TABLET: RSPEAK(196); MESSAGE: RSPEAK(191);F OYSTER: IF NOT CLOSED OR NOT TOTING(OYSTER) THEN RSPEAK(ACTSPK[VERB])E ELSE IF HINTED[2] THEN RSPEAK(194) ELSE HINTED[2]:=ASKR(192,193,54);J ELSE RSPEAK(ACTSPK[VERB]) ENDEND;{****************** VERB READ (TRANSITIVE) **********************}PROCEDURE NOTHERE;EXTERNAL;tH{ "read" -- Magazines in dwarvish, message we've seen, and ...oyster? }PROCEDURE READOBJ;BEGIN;) IF DARK THEN NOTHERE ELSE CASE OBJ OFL MAGAZINE: RSPEAK(190); TABLET: RSPEAK(196); MESSAGE: RSPEAK(191);F OYSTER: IF NOT CLOSED OR NOT TOTING(OYSTER) THEN RSPEAK(ACTSPK[VERB])E ELSE IF HINTED[2] THEN RSPEAK(194) ELSE HINTED[2]:=ASKR(192,193,54);J ELSE RSPEAK(ACTSPK[VE@P ;dN **********************}PROCEDURE NOTHERE;EXTERNAL;tH{ "read" -- Magazines in dwarvish, message we've seen, and ...oyster? }PROCEDURE READOBJ;BEGIN;) IF DARK THEN NOTHERE ELSE CASE OBJ OFL MAGAZINE: RSPEAK(190); TABLET: RSPEAK(196); MESSAGE: RSPEAK(191);F OYSTER: IF NOT CLOSED OR NOT TOTING(OYSTER) THEN RSPEAK(ACTSPK[VERB])E ELSE IF HINTED[2] THEN RSPEAK(194) ELSE HINTED[2]:=ASKR(192,193,54);J ELSE RSPEAK(ACTSPK[VE!{********>>>>>>>><<<<<<<<********>> MODULE: VERBS3 20-OCT-809 This module contains the procedures FEEDIT, SNARF, and THROWAXE.!********>>>>>>>><<<<<<<<********} {$C .TITLE VERBS3 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;<'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;T*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;-FUNCTION RAN(RANGE:INTEGER):INTEGER;EXTERNAL;>9{ ************* I/O SUBROUTINES ********************} 'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;T5{ ******************* VERB FEED ******************* }IN{ "feed" -- If bird, no seed. Snake, dragon, troll: quip. If dwarf, make himmad. Bear, special. }RPROCEDURE FEEDIT;RBEGINN CASE OBJ OFT BIRD: RSPEAK(100);O TROLL: RSPEAK(182);> DRAGON: IF PROP[DRAGON]<>0 THEN RSPEAK(110) ELSE RSPEAK(102);? SNAKE: IF CLOSED OR NOT HERE(BIRD) THEN RSPEAK(102) ELSE BEGINR. IF TOTING(BIRD) THEN DROP(BIRD,LOCATION); DESTROY(BIRD);* PROP[BIRD]:=0;D TALLY2:=TALLY2+1; RSPEAK(101) END;*> DWARF: IF NOT HERE(FOOD) THEN RSPEAK(ACTSPK[VERB]) ELSE BEGIN DFLAG:=DFLAG+1; RSPEAK(103) END;a> BEAR: IF NOT HERE(FOOD) THEN IF PROP[BEAR]=0 THEN RSPEAK(102)@ ELSE IF PROP[BEAR]=3 THEN RSPEAK(110) ELSE RSPEAK(ACTSPK[VERB]) ELSE BEGINR. IF TOTING(FOOD) THEN DROP(FOOD,LOCATION); DESTROY(FOOD);R PROP[BEAR]:=1;R FIXED[AXE]:=0;R PROP[AXE]:=0; RSPEAK(168) END;N ELSE RSPEAK(14) ) ENDPEND;?{ *************** TROLL TREASURE PROCEDURE ****************** } PROCEDURE SNARF;BEGINA( { Snarf a treasure for the troll. } DROP(OBJ,0); DESTROY(TROLL);: DESTROY(TROLL+100);F MOVE(TROLL2,PLACE1[TROLL]);E# MOVE(TROLL2+100,FIXED1[TROLL]);E JUGGLE(CHASM); RSPEAK(159)REND;>{ ****************** VERB THROW (OBJ=AXE) ****************** }A{ Good grief! He's thrown his axe. What is he trying to kill? }RPROCEDURE THROWAXE;EVAR I:INTEGER;BEGIN 3 FOR I:=1 TO 5 DO IF DLOC[I]=LOCATION THEN BEGINU { He attacks a little dwarf! }D' IF RAN(3)=1 THEN RSPEAK(48) ELSE BEGINe DSEEN[I]:=FALSE;  DLOC[I]:=0; DKILL:=DKILL+1;0 IF DKILL=1 THEN RSPEAK(149) ELSE RSPEAK(47) END;  DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE;  I:=5K END;B IF NOT MOVED THEN IF AT(DRAGON) AND(PROP[DRAGON]=0) THEN BEGIN RSPEAK(152);e DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE$ END ELSE IF AT(TROLL) THEN BEGIN RSPEAK(158);  DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE7 END ELSE IF HERE(BEAR) AND(PROP[BEAR]=0) THEN BEGIN 5 { This'll teach him to throw the axe at the bear! }D DROP(AXE,LOCATION); FIXED[AXE]:=-1; PROP[AXE]:=1; JUGGLE(BEAR); RSPEAK(164) END ELSE OBJ:=0CEND; MOVED:=TRUE;  I:=5K END;B IF NOT MOVED THEN IF AT(DRAGON) AND(PROP[DRAGON]=0) THEN BEGIN RSPEAK(152);e DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE$ END ELSE IF AT(TROLL) THEN BEGIN RSPEAK(158);  DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE7 END ELSE IF HERE(BEAR) AND(PROP[BEAR]=0) THEN BEGIN 5 { This'll teach him to throw the axe at the bear! }D DROP(AXE,LOCATION); FIXED[AXE]:=-1; PROP[AXE]:=1; JUGGLE(BEAR); RSPEAK(164) END ELSE OBJ:=0CEND;@P ;dQAGON) AND(PROP[DRAGON]=0) THEN BEGIN RSPEAK(152);e DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE$ END ELSE IF AT(TROLL) THEN BEGIN RSPEAK(158);  DROP(AXE,LOCATION); NEWLOC:=LOCATION; MOVED:=TRUE7 END ELSE IF HERE(BEAR) AND(PROP[BEAR]=0) THEN BEGIN 5 { This'll teach him to throw the axe at the bear! }D DROP(AXE,LOCATION); FIXED[AXE]:=-1; PROP[AXE]:=1; JUGGLE(BEAR); RSPEAK(164) END ELSE OBJ:=0CEND;!{********>>>>>>>><<<<<<<<********>> MODULE: VERBS4 29-OCT-80; This module contains the verb procedures ASKSCORE, which C responds to the "score" command, SAVE, which responds to the verbsD "pause", "save","suspend", and three procedures used to write saved5 game info to ADVWIZ.DTA: WRWIZ, WRWRD, and WRWIZB. !********>>>>>>>><<<<<<<<********} {$C .TITLE VERBS4  .IDENT /V0/ }9{ ************* I/O SUBROUTINES ********************}'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;*0FUNCTION ASKR(I,J,K: INTEGER): BOOLEAN;EXTERNAL;'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;vK{********************* ASK SCORE PROCEDURE *****************************} PROCEDURE CALSCORE;EXTERNAL;PROCEDURE FINISH;EXTERNAL;${ Scoring command comes here.... }PROCEDURE ASKSCORE;IBEGIND SCORING:=TRUE; CALSCORE;> SCORING:=FALSE; WRITELN;> WRITE('If you were to quit now, you would score',SCORE:4);0 WRITELN(' out of a possible',MAXSCOR:4,'.'); GAVEUP:=ASKR(143,54,54); IF GAVEUP THEN FINISHEEND;@{ ****************** SUSPEND PROCEDURE *********************** }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERL 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGINL 18 -- HENDs 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }A{ Procedure to write one integer to ADVWIZ. Global variable I is0Ipresumed to be current record count. This kluge is because sometimes theLJ"PUT" function dosen't advance through the file sequentially as it should. DI have yet to figure this bug out, so I throw in redundant seeks. }PROCEDURE WRWIZ(J:INTEGER);fBEGINg ADVWIZ^:=J;  PUT(ADVWIZ); I:=I+1;2 SEEK(ADVWIZ,I)END;3{ Procedure to write one boolean value to ADVWIZ. }ePROCEDURE WRWIZB(X:BOOLEAN);BEGINy$ IF X THEN WRWIZ(1) ELSE WRWIZ(0)END;:{ Procedure to write four player input words to ADVWIZ. },PROCEDURE WRWRD(WRD1,WRD1X,WRD2,WRD2X:WORD);VAR I:INTEGER;BEGINn2 FOR I:=1 TO 5 DO WRWIZ(ORD(WRD1[I])-ORD('A'));3 FOR I:=1 TO 5 DO WRWIZ(ORD(WRD1X[I])-ORD('A')); 2 FOR I:=1 TO 5 DO WRWIZ(ORD(WRD2[I])-ORD('A'));2 FOR I:=1 TO 5 DO WRWIZ(ORD(WRD2X[I])-ORD('A'))END;,PROCEDURE SAVNAME(VAR SAV:INTEGER);EXTERNAL;'PROCEDURE SAVVAR(SAV:INTEGER);EXTERNAL;RQ{ "Suspend" -- Offer to exit, while saving all key variables, but requiring a rQdelay before restarting (this was originally so he couldn't save the world RQbefore trying something risky, but in this version he only gets to restart a )Psaved game once anyway. The latency requirement was left in for compatability)with the original program's behaviour). I This procedure uses external procedures SAVNAM and SAVVAR to save theEEplayer's name and current variable values, respectively, in ADVWIZ. } PROCEDURE SAVE; VAR SAV:INTEGER;BEGIN l' IF DEMO THEN RSPEAK(201) ELSE BEGINs$ RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK'); SEEK(ADVWIZ,40);  IF ADVWIZ^=3 THEN BEGIN MSPEAK(49); ASKSCOREr END ELSE BEGIN  GET(ADVWIZ);e MSPEAK(50);G WRITELN('wait at least ',ADVWIZ^:3,' minutes before continuing.');i" IF ASKR(200,54,54) THEN BEGIN SAVNAME(SAV);t SAVVAR(SAV); MSPEAK(51);V DONE:=TRUE;h MOVED:=TRUEm END  END;e CLOSE(ADVWIZ) END END;} PROCEDURE SAVE; VAR SAV:INTEGER;BEGIN l' IF DEMO THEN RSPEAK(201) ELSE BEGINs$ RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK'); SEEK(ADVWIZ,40);  IF ADVWIZ^=3 THEN BEGIN MSPEAK(49); ASKSCOREr END ELSE BEGIN  GET@HP ;dR##J^:3,' minutes before continuing.');i" IF ASKR(200,54,54) THEN BEGIN SAVNAME(SAV);t SAVVAR(SAV); MSPEAK(51);V DONE:=TRUE;h MOVED:=TRUEm END  END;e CLOSE(ADVWIZ) END END;} PROCEDURE SAVE; VAR SAV:INTEGER;BEGIN l' IF DEMO THEN RSPEAK(201) ELSE BEGINs$ RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK'); SEEK(ADVWIZ,40);  IF ADVWIZ^=3 THEN BEGIN MSPEAK(49); ASKSCOREr END ELSE BEGIN  GET!{********>>>>>>>><<<<<<<<********>> MODULE: ADVINI 29-OCT-80A This module contains the procedure INITIALIZE. It reads inH the database and database pointers and initializes all variables before the game commences. !********>>>>>>>><<<<<<<<********} {$C .TITLE ADVINI  .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;)FUNCTION BIT(I:INTEGER):INTEGER;EXTERNAL;>{******************** I/O PROCEDURES ************************}=PROCEDURE GETIN(VAR WORD1,WORD1X,WORD2,WORD2X:WORD);EXTERNAL;t'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;D{ ***************** INITIALIZATION PROCEDURES **************** }J{ The two main data files, ADVENTURE.DAT and ADVENTURE.100, are organizedPthe same and contain all the information required by the game modules. EachPmain database file is organized into twelve sections. Each section ends witha line containing "-1". I Section 1 contains the long form descriptions of locations. Each lineEQcontains a location number, LOC, and a line of text. The set of (necessarily ;Padjacent) lines whose numbers are LOC form the long description of location LOC.I Section 2 contains the short form descriptions. The format is the samedPas the long form descriptions, however, not all locations have short form descriptions. I Section 3 contains the object descriptions. Again, each line containsnPa number followed by a line of text. If the number, OBJ, is in the range of 1Pto 99, the message is the "inventory" message for object OBJ. Otherwise thePnumber, m, is 000,100,200,etc., and the message should be the description of thePpreceding object when it's "property" (PROP[OBJ]) is m/100. The m/100 is usedPonly to distinguish multiple messages from multi-line messages; the prop infoPactually requires all messages for an object to be present and consecutive.FProperties which produce no message should be given the message ">$<".I Section 4 contains arbitrary messages. Same format as sections 1,2,gPand 3, except the numbers bear no relationship to anything (except for someGspecial verbs in the vocabulary and some special travel table entries). I Section 5 contains the class messages. Each line contains a number naPand a line describing a classification of player. The scoring section selectsPthe appropriate message, where each message is considered to apply to playersPwhose scores are higher than or equal to the previous n but not higher thanPthis n. Note that these scores probably change with every modification (and'particularly expansion) of the program. I Section 6 contains the magic messages. Identical to section 4 except5Pput in a separate section for easier reference. Magic messages are used byGthe maintenence mode routine (MAINTINENCE) and startup routine (START).pJ Section 7 contains the vocabulary. Each line contains a number, KK, Qand a five letter word. Let m=KK div 1000 and K=KK mod 1000. If m=0 (K=KK), nQthen the word is a motion verb for use in travelling (see section 8). Else if l yPm=1, the word is an object and K is the object number (same number as in sectionQ3). Else, if m=2, the word is an action verb (such as "carry" or "attack"). iPElse, if m=3, the word is a special case verb and K is a message number in section 4.I Section 8 contains the travel array. Each line contains a locationKPnumber (LOC), a conditional motion number (COND), a second location numberQ(NEWLOC), and a list of motion verb numbers (see section 7). In general, Pall verbs in a line will cause him to go to NEWLOC from LOC under conditionsof COND and NEWLOC as follows:( If COND=0 the motion is unconditional.; If 0300 PROP[COND mod 100] must *not* be (COND div2 100)-3. For example, if COND=531, the property+ of the dragon, PROP[31], must not be 2. - If NEWLOC<=300 it is the location to go to.r@ If 300 If NEWLOC>500 message NEWLOC-500 from section 4 is given and he remains at LOC.I If the condition (if any) is not met, then the next *different* NEWLOCPvalue is used (unless it fails to meet *its* conditions, in which case the nextPis found, etc.). Typically, the next destination will be for one of the sameRverbs, so that its only use is as the alternate destination for those verbs. For instance:t 15,110,22,29,31,34,35,23,42 15,0,14,29ePThis says that, from LOC 15, any of the verbs 29,31, etc. will take him to 22;if he's carrying object 10, and otherwise he will go to 14.t 11,303,8,49 11,0,9,50PThis says that, from 11, 49 takes him to 8 unless PROP[3]=0, in which case he9goes to 9. Verb 50 takes him to 9 regardless of PROP[3].iI Section 9 contains the initial object locations. Each line containsoPan object number, OBJ, followed by two initial location numbers, PLACE1[OBJ] andQFIXED1[OBJ]. If PLACE1[OBJ]=0, the object has no initial location. If the ePobject is immovable, FIXED1[OBJ]=-1. If it has two locations (e.g., the grate)Ethen FIXED1[OBJ]=second location and the object is assumed immovable. J Section 10 contains the action verb default responses. Each line Pcontains an "action-verb" number and the number in section 4 of it's defaultresponse message.nI Section 11 contains the location assets information. Each line contains,Qa number, n, and up to ten location numbers. Some values of n have two lines tPand up to twenty locations. Bit n (where 0 is the units bit) is set inGCONDI[LOC] for each LOC listed. The CONDI bits currently assigned are:m 0 -- light / 1 -- if bit 2 is on: on for oil, off for wateru 6 2 -- set if liquid present at LOC, see bit 1 for type1 3 -- pirate doesn't go here unless following himB (other bits are used to indicate location is eligible for a hint) 4 -- trying to get into cave  5 -- trying to catch bird 6 -- trying to deal with snake  7 -- lost in maze 8 -- pondering dark room  9 -- at Witt's End PCONDI[LOC] is set to 2 (Bit 1 on), overriding all other bits, if LOC hasforced motion.J Section 12 contains the hints information. Each line contains a hint Pnumber (corresponding to a CONDI bit, section 11), the number of turns he mustQbe at the right LOC(s) before triggering the hint, the points deducted for aQtaking the hint, the message number (section 4) of the question, and the Pmessage number of the hint. These values are stashed in the HINTS array.PHNTMAX is set to the maximum hint number. The HINTED array keeps track ofPhints we have given. Numbers 1-3 are unusable since CONDI bits are otherwisePassigned, so 2 is used to remember if he's read the clue in the repository, andP3 is used to remember whether he asked for instructions (gets more turns, butloses points).I The files initialization programs (ADVFLS and 100FLS) transfer sections nO1,2,3,4,5, and 6 to the file ADVTXT.DTA (or ADVTXT.100) and the starting recordTOnumbers for each message to arrays LTEXT,STEXT, PTEXT, RTEXT, CTEXT, and MTEXT Orespectively. Also, section 7 is translated into a tree structure andoOtransfered to KATAB.DTA with the starting letter record pointers stored inoOarray KTAB. The seven record pointer arrays are then stored in ADVDAT.DTA (orrPADVDAT.100). The remainder of the database, sections 8-12, are changed from PASCII to integers and duplicated in the file ADVENT.DTA. These sections are 2identical in both the normal and VT100 databases.I INITIALIZE first asks whether the user is using a VT100 or not. Then tPthe appropriate version of ADVTXT and ADVDAT are opened, the pointer arrays are Oread in, and ADVDAT is closed. Then KATAB and ADVENT are opened. Sections 8,e79,10,11, and 12 are then read in and ADVENT is closed. D TI INITIALIZE then set up other initial variable values and returns to the main program block, MAIN. }iPROCEDURE INITIALIZE;T+VAR VERB,LOC,OLDLC,COND,NXTLOC,I,J:INTEGER;n TK:ARRAY[1..20] OF INTEGER;I LINK1,LINK4:KEYLINK; LINK2,LINK3:VERBLINK;o" ADVENT,ADVDAT:FILE OF INTEGER;PROCEDURE GETDT;FORWARD;K{ This procedure opens the normal text pointers file and gets the data. }aPROCEDURE GETDAT;dBEGINi$ RESET(ADVDAT,'ADVDAT.DTA/SEEK'); GETDTVEND; eF{ This procedure reads the data from either version of ADVDAT into therecord pointer arrays. }PROCEDURE GETDT;BEGINC' { Long description pointers. }N FOR I:=1 TO LOCSIZ DO BEGINR LTEXT[I]:=ADVDAT^;I GET(ADVDAT) END;' { Short description pointers. }T FOR I:=1 TO LOCSIZ DO BEGIND STEXT[I]:=ADVDAT^; GET(ADVDAT) END;( { Object description pointers. } FOR I:=1 TO MAXTRS DO BEGINE PTEXT[I]:=ADVDAT^;T GET(ADVDAT) END;$ { Random message pointers. } FOR I:=1 TO 300 DO BEGIN RTEXT[I]:=ADVDAT^;t GET(ADVDAT) END;# { Magic message pointers. }  FOR I:=1 TO 100 DO BEGIN MTEXT[I]:=ADVDAT^;T GET(ADVDAT) END;# { Class messages pointer. }N CTEXT:=ADVDAT^;c GET(ADVDAT);5 { Vocabulary tree starting letter pointers. }A FOR I:=65 TO 90 DO BEGIN KTAB[I]:=ADVDAT^; GET(ADVDAT) END; CLOSE(ADVDAT)SEND;D{ This procedure opens the VT-100 text record pointers file and gets the data. }}PROCEDURE GET100;0BEGING$ RESET(ADVDAT,'ADVDAT.100/SEEK'); GETDTEND;2{ This procedure reads one integer from ADVENT. }PROCEDURE RDADV(VAR I:INTEGER);TBEGIN) I:=ADVENT^;  GET(ADVENT)pEND;"BEGIN { INITIALIZATION PROCEDURE }- { First find out which database to use }e o WRITELN;& WRITELN('Are you using a VT100?');! GETIN(WRD1,WRD1X,WRD2,WRD2X); WRITELN;? WRITELN('Be patient, it takes a while to initialize.....');s WRITELN;( WRITELN('Now loading sections 1-7'); IF WRD1[1]='Y' THEN BEGIN09 { If yes, set VT100 in ANSI mode and read in .100 data }n VT100:=TRUE;N WRITE(CHR(33B),'<');A GET100; RESET(ADVTXT,'ADVTXT.100/SEEK') END ELSE BEGIN { If no, get normal database }U VT100:=FALSE; GETDAT; RESET(ADVTXT,'ADVTXT.DTA/SEEK') END;# { Open the vocabulary file. }'" RESET(KATAB,'KATAB.DTA/SEEK');. { Open the initial variables data file. }$ RESET(ADVENT,'ADVENT.DTA/SEEK');$ {*** Read in travel table ***} MSPEAK(32); > { Set the array of pointers into the travel tree to NIL }& FOR I:=1 TO LOCSIZ DO KEY[I]:=NIL;' { Read the first location number }T RDADV(LOC);0N { If it is zero or -1 there is an error in the database, don't read it. }P IF (LOC<>-1)AND(LOC<>0) THEN REPEAT{Until LOC=-1,at the end of the section }( { Save the current location in OLDLC } OLDLC:=LOC;( { Read the conditions on this motion } RDADV(COND);D, { Read the next location for this motion } RDADV(NXTLOC);E7 { Read in the various verbs which cause this motion }l FOR I:=1 TO 20 DO RDADV(TK[I]);4 { Create a new key link record for this location } NEW(LINK1);- { Store COND and NEWLOC in the new record }i LINK1^.NEWLOC[1]:=COND; LINK1^.NEWLOC[2]:=NXTLOC;H { Point the key link back to the KEY pointer array for this location } LINK1^.NXTLINK:=KEY[LOC];& { Set the verb link pointer to nil } LINK1^.NXTVERB:=NIL;i* { Now point KEY[LOC] to the new record } KEY[LOC]:=LINK1;nB { Now add the verbs list and other motion entries for this same location. }R WHILE OLDLC=LOC DO BEGIN;9 { First check that there are some verbs listed. }W IF TK[1]<>0 THEN BEGINN8 { Okay, we got some verbs, create a new verb link. } NEW(LINK2);N O( { Put the first verb in the link. } LINK2^.VERBVAL:=TK[1];' { Make it's verblink pointer NIL. } ! LINK2^.NXTVERB:=LINK1^.NXTVERB;@ { Now point the key link's verb link pointer to this link. } LINK1^.NXTVERB:=LINK2 END; D { Now we link the remaining verbs onto the first verb link. }- FOR I:=2 TO 20 DO IF TK[I]<>0 THEN BEGINh NEW(LINK3);m LINK3^.VERBVAL:=TK[I];! LINK3^.NXTVERB:=LINK2^.NXTVERB;, LINK2^.NXTVERB:=LINK3; LINK2:=LINK3 END;(J { One complete line has now been read in. Read the location number 7 in the next line and see if it still the same. }N RDADV(LOC);G { If so, we read in the data, create a new key link for the same G location, link it to the last keylink for this location, and loop e back to link in the verbs.I Otherwise if it is different, we go back to the beginning of the RJ loop and initialize KEY[LOC] for the new location (unless it's -1 or . zero which terminate the repeat loop). } IF OLDLC=LOC THEN BEGIN RDADV(COND); RDADV(NXTLOC);! FOR I:=1 TO 20 DO RDADV(TK[I]);h NEW(LINK4);  LINK4^.NEWLOC[1]:=COND;s LINK4^.NEWLOC[2]:=NXTLOC;e LINK4^.NXTVERB:=NIL;! LINK4^.NXTLINK:=LINK1^.NXTLINK;h LINK1^.NXTLINK:=LINK4; LINK1:=LINK4;e END { if oldlc=loc then } END { while oldlc=loc do }s UNTIL (LOC=-1)OR(LOC=0); { Zero out various arrays } FOR I:=1 TO MAXTRS DO BEGINo PLACE1[I]:=0; FIXED1[I]:=0; PLACE[I]:=0;m FIXED[I]:=0;t ACTSPK[I]:=0; PROP[I]:=0  END;& FOR I:=1 TO LOCSIZ DO CONDI[I]:=0;5 FOR I:=1 TO 10 DO FOR J:=1 TO 4 DO HINTS[I,J]:=0;^) FOR I:=-1 TO LOCSIZ DO ATLOC[I]:=NIL;L( { Read in initial object locations } MSPEAK(33);I RDADV(OBJ);T WHILE OBJ<>-1 DO BEGIN RDADV(PLACE1[OBJ]); RDADV(FIXED1[OBJ]); RDADV(OBJ);  END;. { Read in default action verb responses } MSPEAK(34);  RDADV(VERB); WHILE VERB<>-1 DO BEGIND RDADV(ACTSPK[VERB]);m RDADV(VERB) END;5 { Read in the conditions for various locations }Z MSPEAK(35); RDADV(I);  WHILE I<>-1 DO BEGIN FOR K:=1 TO 10 DO RDADV(TK[K]); FOR K:=1 TO 10 DO4 IF TK[K]<>0 THEN CONDI[TK[K]]:=CONDI[TK[K]]+BIT(I); RDADV(I); END;& { Read in the hints information } MSPEAK(36);R RDADV(I);] HNTMAX:=0; WHILE I<>-1 DO BEGIN FOR J:=1 TO 4 DO RDADV(TK[J]);s1 IF I<>0 THEN FOR J:=1 TO 4 DO HINTS[I,J]:=TK[J];E IF I>HNTMAX THEN HNTMAX:=I; RDADV(I); END;1 { Close out the initial variable data file. }i CLOSE(ADVENT);I { Zero out the abbreviation counts and set CONDI[location]=2 if the O! location has forced motion. } FOR I:=1 TO LOCSIZ DO BEGINO ABB[I]:=0;TC IF (KEY[I]<>NIL) AND (KEY[I]^.NXTVERB^.VERBVAL=1) THEN CONDI[I]:=2  END;; { Put all of the objects at their initial locations. }N# FOR I:=MAXTRS DOWNTO 1 DO BEGINI PLACE[I]:=PLACE1[I];  FIXED[I]:=FIXED1[I];E JUGGLE(I) END;4 { Set the tally of "unseen" objects to zero. } TALLY:=0;d= { Set the tally of impossible to get objects to zero. }i TALLY2:=0;N { Set the initial property of treasures to -1 and initialize tally to the ' number of treasures to be seen. }Y FOR I:=50 TO MAXTRS DO BEGIN PROP[I]:=-1;O TALLY:=TALLY+1N END;P { Set the "hinted" array to false and the hints location counters to zero. } FOR I:=1 TO HNTMAX DO BEGIN  HINTED[I]:=FALSE; HINTLC[I]:=0) END;P { Initialize the dwarves. DLOC is loc of dwarves, hard-wired in. ODLOC is Q prior location of each dwarf, initially garbage. DALTLC is alternate tR location for dwarf, in case one of them starts out on top of the adventurer. Q No two of the five initial locations are adjacent. DSEEN is true if dwarf + has seen him. 7 DFLAG controls the level of activation of all this:u< 0 No dwarf stuff yet (wait until reaches the hall of mists)4 1 Reached hall of mists, but hasn't met first dwarf= 2 Met first dwarf, others start moving, no knives thrown yet4 3 A knife has been thrown (first set always misses). 3+ Dwarves are mad (increases their accuracy)O Sixth dwarf is speacial (the pirate). He always starts at his chest'soO eventual location inside the maze. This loc is saved in CHLOC for ref.eF The dead end in the other maze has its loc stored in CHLOC2. } CHLOC:=114;  CHLOC2:=140;% FOR I:=1 TO 6 DO DSEEN[I]:=FALSE;f DFLAG:=0;n DLOC[1]:=19; DLOC[2]:=27; DLOC[3]:=33; DLOC[4]:=44; DLOC[5]:=64; DLOC[6]:=CHLOC;( DALTLC:=18;m6 { Other random flags and counters: }  STRTRAN:=TRUE; TURNS:=0;i SETUP:=FALSE;s LMWARN:=FALSE; IWEST:=0;u KNFLOC:=0; DETAIL:=0; ABBNUM:=5; MAXDIE:=3; NUMDIE:=0; HOLDING:=0;t DKILL:=0;s FOOBAR:=0; BONUS:=0;  CLOCK1:=30;  CLOCK2:=50;  CLOSING:=FALSE;E PANIC:=FALSE;  CLOSED:=FALSE; GAVEUP:=FALSE; SCORING:=FALSE;3 WZDARK:=FALSE;P { Start the Adventurer out at the end of the road in front of the building.} LOCATION:=1;M { Set the new location and both old locations to the present location. }A NEWLOC:=LOCATION;0 OLDLOC:=LOCATION;  OLDLC2:=LOCATION;=" { The game now commences.... } DONE:=FALSEEND;L:=0;s FOOBAR:=0; BONUS:=0;  CLOCK1:=30;  CLOCK2:=50;  CLOSING:=FALSE;E PANIC:=FALSE;  CLOSED:=FALSE; GAVEUP:=FALSE; SCORING:=FALSE;3 @P ;dM â road in front of the building.} LOCATION:=1;M { Set the new location and both old locations to the present location. }A NEWLOC:=LOCATION;0 OLDLOC:=LOCATION;  OLDLC2:=LOCATION;=" { The game now commences.... } DONE:=FALSEEND;L:=0;s FOOBAR:=0; BONUS:=0;  CLOCK1:=30;  CLOCK2:=50;  CLOSING:=FALSE;E PANIC:=FALSE;  CLOSED:=FALSE; GAVEUP:=FALSE; SCORING:=FALSE;3 !{********>>>>>>>><<<<<<<<********>> PROGRAM: ADVFLS 29-OCT-80A When built into a task, this program is invoked by the command H RUN ADVFLS. It reads in the database and database pointers from G ADVENTURE.DAT and creates files ADVTXT.DTA, KATAB.DTA, ADVDAT.DTA,A and ADVENT.DTA for the normal (non-VT-100) use of ADVENTURE.TSK.!********>>>>>>>><<<<<<<<********} {$C .TITLE ADVFLS  .IDENT /V0/ }F{ For a complete description of the database refer to the comments inmodule ADVINI. }<VAR TXTFILE:TEXT;R" ADVENT,ADVDAT:FILE OF INTEGER;L{ This procedure transfers text records from ADVENTURE.DAT to ADVTXT.DTA and%keeps track of the record numbers. } PROCEDURE GETTEXT;VAR REC,I,J,LOC,OLDLC:INTEGER; LINES:ARRAY[1..72] OF CHAR;DPROCEDURE PUTTXT; BEGIN  OLDLC:=LOC;0 WHILE LOC=OLDLC DO BEGIN READLN(TXTFILE,LINES);* ADVTXT^.LOC:=LOC; ADVTXT^.TXT:=LINES; PUT(ADVTXT);F REC:=REC+1; SEEK(ADVTXT,REC); READ(TXTFILE,LOC) END END;BEGIN { gettxt }& REWRITE(ADVTXT,'ADVTXT.DTA/SEEK'); REC:=1;; FOR I:=1 TO LOCSIZ DO BEGINx LTEXT[I]:=0;A STEXT[I]:=0 END;& FOR I:=1 TO MAXTRS DO PTEXT[I]:=0;# FOR I:=1 TO 300 DO RTEXT[I]:=0;, CTEXT:=0;E# FOR I:=1 TO 100 DO MTEXT[I]:=0;D& WRITELN('Now loading section 1'); SEEK(ADVTXT,REC);= READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN LTEXT[LOC]:=REC;T PUTTXT; END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 2'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN STEXT[LOC]:=REC;  PUTTXT; END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 3'); READ(TXTFILE,LOC); X WHILE LOC<>-1 DO BEGIN PTEXT[LOC]:=REC; PUTTXT;& WHILE (LOC=0)OR(LOC>MAXTRS) DO PUTTXT END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 4'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN RTEXT[LOC]:=REC; PUTTXT END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 5'); READ(TXTFILE,LOC); CTEXT:=REC; WHILE LOC<>-1 DO PUTTXT; READLN(TXTFILE,LINES);& WRITELN('Now loading section 6'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN MTEXT[LOC]:=REC;T PUTTXTC END; READLN(TXTFILE,LINES); CLOSE(ADVTXT) END;J{ This procedure reads the vocabulary section of ADVENTURE.DAT and creates*the tree structured version in KATAB.DTA }PROCEDURE READVOCAB;VAR LINES:WORD;  LOC,I,J,K,L,M,N:INTEGER; LTR:CHAR;aPROCEDURE GETLTR; BEGINT I:=I+1;- IF I<=5 THEN LTR:=LINES[I] ELSE LTR:=' ';H IF LTR='2' THEN LTR:='T' ELSE IF (LTR='?')OR(LTR='"') THEN LTR:='Q'; K:=ORD(LTR)END;PROCEDURE NEWREC;BEGINL SEEK(KATAB,L);( FOR J:=65 TO 90 DO KATAB^.NXT[J]:=0;' FOR J:=1 TO 2 DO KATAB^.VAL[J]:=-1;e L:=L+1;c GETLTREND;BEGIN { readvocab }t& WRITELN('Now loading section 7');" FOR I:=65 TO 90 DO KTAB[I]:=0;$ REWRITE(KATAB,'KATAB.DTA/SEEK'); L:=1;: R READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN READLN(TXTFILE,LINES);] I:=0; GETLTR; M:=KTAB[K]; IF M<>0 THEN BEGINF SEEK(KATAB,M); GETLTR;5 IF LTR<>' ' THEN WHILE KATAB^.NXT[K]<>0 DO BEGIN N:=KATAB^.NXT[K];  SEEK(KATAB,N); GETLTR;X IF LTR=' ' THEN EXIT END;B END ELSE BEGIN  KTAB[K]:=L; NEWREC END;  WHILE LTR<>' ' DO BEGIN KATAB^.NXT[K]:=L; PUT(KATAB); NEWREC[ END;, IF KATAB^.VAL[1]=-1 THEN KATAB^.VAL[1]:=LOC ELSE KATAB^.VAL[2]:=LOC;C PUT(KATAB); READ(TXTFILE,LOC) END; CLOSE(KATAB)END;M{ This procedure saves all the record pointer arrays created as the text and vocabulary were transferred. }NPROCEDURE SAVPTR;VAR REC,I:INTEGER;PROCEDURE PUTPTR(X:INTEGER);BEGINR ADVDAT^:=X;  PUT(ADVDAT); REC:=REC+1;A SEEK(ADVDAT,REC)END;BEGINE& REWRITE(ADVDAT,'ADVDAT.DTA/SEEK'); REC:=1;K SEEK(ADVDAT,REC);E+ FOR I:=1 TO LOCSIZ DO PUTPTR(LTEXT[I]);:+ FOR I:=1 TO LOCSIZ DO PUTPTR(STEXT[I]);;+ FOR I:=1 TO MAXTRS DO PUTPTR(PTEXT[I]);A( FOR I:=1 TO 300 DO PUTPTR(RTEXT[I]);( FOR I:=1 TO 100 DO PUTPTR(MTEXT[I]); PUTPTR(CTEXT);3 FOR I:=ORD('A') TO ORD('Z') DO PUTPTR(KTAB[I]);N CLOSE(ADVDAT)  PEND;PROCEDURE SAVADV; VAR I,SEC,REC:INTEGER;BEGIN& REWRITE(ADVENT,'ADVENT.DTA/SEEK'); REC:=1;E& WRITELN('Now loading section 8'); READ(TXTFILE,ADVENT^); WHILE ADVENT^<>-1 DO BEGIN PUT(ADVENT);E REC:=REC+1; SEEK(ADVENT,REC); READ(TXTFILE,ADVENT^) END;& WRITELN('Now loading section 9'); PUT(ADVENT); REC:=REC+1; SEEK(ADVENT,REC);P READ(TXTFILE,ADVENT^);/ WHILE ADVENT^<>-1 DO FOR I:=1 TO 3 DO BEGINT PUT(ADVENT); REC:=REC+1; SEEK(ADVENT,REC); READ(TXTFILE,ADVENT^) END; PUT(ADVENT); REC:=REC+1;D SEEK(ADVENT,REC);E FOR SEC:=10 TO 12 DO BEGIN& WRITELN('Now loading section',SEC:3); READ(TXTFILE,ADVENT^);  WHILE ADVENT^<>-1 DO BEGINC PUT(ADVENT);E REC:=REC+1; SEEK(ADVENT,REC); READ(TXTFILE,ADVENT^) END; PUT(ADVENT);D REC:=REC+1;! IF SEC<>12 THEN SEEK(ADVENT,REC) END; CLOSE(ADVENT) END;&BEGIN { FILES INITIALIZATION PROGRAM }, WRITELN('Files Creation for Adventure');< WRITELN('Be patient, it takes a while to do this.....');# RESET(TXTFILE,'ADVENTURE.DAT'); GETTEXT; READVOCAB; SAVPTR; SAVADV;o CLOSE(TXTFILE);F WRITELN('....done!')END.-1 DO BEGINC PUT(ADVENT)@P ;dLTVENT^) END; PUT(ADVENT);D REC:=REC+1;! IF SEC<>12 THEN SEEK(ADVENT,REC) END; CLOSE(ADVENT) END;&BEGIN { FILES INITIALIZATION PROGRAM }, WRITELN('Files Creation for Adventure');< WRITELN('Be patient, it takes a while to do this.....');# RESET(TXTFILE,'ADVENTURE.DAT'); GETTEXT; READVOCAB; SAVPTR; SAVADV;o CLOSE(TXTFILE);F WRITELN('....done!')END.-1 DO BEGINC PUT(ADVENT)!{********>>>>>>>><<<<<<<<********>> PROGRAM: 100FLS 30-OCT-80B When built into a task, this program is invoked by the commandJ RUN 100FLS. It reads in the text and text pointers from the file J ADVENTURE.100 and creates new copies of ADVTXT.100 and ADVDAT.100 for ; use by ADVENTURE.TSK when a VT-100 terminal is being used.!********>>>>>>>><<<<<<<<********} {$C .TITLE HUNFLS  .IDENT /V0/ }D{ ***************** INITIALIZATION PROCEDURES **************** }L{ For a detailed description of the database refer to the comments in moduleGADVINI. The data files transfer procedures are commented in ADVFLS. } VAR TXTFILE:TEXT;  ADVDAT:FILE OF INTEGER;rPROCEDURE GETTEXT;VAR REC,I,J,LOC,OLDLC:INTEGER; LINES:ARRAY[1..72] OF CHAR; PROCEDURE PUTTXT; BEGINh OLDLC:=LOC;n WHILE LOC=OLDLC DO BEGIN READLN(TXTFILE,LINES); ADVTXT^.LOC:=LOC; ADVTXT^.TXT:=LINES; PUT(ADVTXT);* REC:=REC+1; SEEK(ADVTXT,REC); READ(TXTFILE,LOC) ENDoEND;BEGIN { gettxt }& REWRITE(ADVTXT,'ADVTXT.100/SEEK'); REC:=1;I SEEK(ADVTXT,REC);f FOR I:=1 TO LOCSIZ DO BEGINV LTEXT[I]:=0; STEXT[I]:=0 END;& FOR I:=1 TO MAXTRS DO PTEXT[I]:=0;# FOR I:=1 TO 300 DO RTEXT[I]:=0; CTEXT:=0;.# FOR I:=1 TO 100 DO MTEXT[I]:=0;& WRITELN('Now loading section 1'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN LTEXT[LOC]:=REC;T PUTTXT; END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 2'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN T STEXT[LOC]:=REC;  PUTTXT END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 3'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN = PTEXT[LOC]:=REC;  PUTTXT;& WHILE (LOC=0)OR(LOC>MAXTRS) DO PUTTXT END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 4'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN RTEXT[LOC]:=REC;  PUTTXT  END; READLN(TXTFILE,LINES);& WRITELN('Now loading section 5'); READ(TXTFILE,LOC); CTEXT:=REC; WHILE LOC<>-1 DO PUTTXT; READLN(TXTFILE,LINES);& WRITELN('Now loading section 6'); READ(TXTFILE,LOC); WHILE LOC<>-1 DO BEGIN MTEXT[LOC]:=REC;T PUTTXTC END; READLN(TXTFILE,LINES); CLOSE(ADVTXT) END;PROCEDURE SAVPTR;NVAR REC:INTEGER;PROCEDURE PUTPTR(X:INTEGER);BEGINT ADVDAT^:=X;H PUT(ADVDAT); REC:=REC+1;R SEEK(ADVDAT,REC)END;BEGINT& REWRITE(ADVDAT,'ADVDAT.100/SEEK'); REC:=1;; SEEK(ADVDAT,REC);;+ FOR I:=1 TO LOCSIZ DO PUTPTR(LTEXT[I]);X+ FOR I:=1 TO LOCSIZ DO PUTPTR(STEXT[I]);N+ FOR I:=1 TO MAXTRS DO PUTPTR(PTEXT[I]);C( FOR I:=1 TO 300 DO PUTPTR(RTEXT[I]);( FOR I:=1 TO 100 DO PUTPTR(MTEXT[I]); PUTPTR(CTEXT);3 FOR I:=ORD('A') TO ORD('Z') DO PUTPTR(KTAB[I]);N CLOSE(ADVDAT) END;-BEGIN { VT-100 FILES INITIALIZATION PROGRAM }D2 WRITELN('VT100 Files Creation for Adventure');; WRITELN('Be patient, it takes a while to do this....');1# RESET(TXTFILE,'ADVENTURE.100');: GETTEXT; U$ RESET(ADVDAT,'ADVDAT.DTA/SEEK'); I:=2*LOCSIZ+MAXTRS+402;  SEEK(ADVDAT,I); ( FOR I:=ORD('A') TO ORD('Z') DO BEGIN KTAB[I]:=ADVDAT^; GET(ADVDAT) END; CLOSE(ADVDAT); SAVPTR;T WRITELN('.....done!'); CLOSE(TXTFILE)END. CLOSE(ADVDAT) END;-BEGIN { VT-100 FILES INITIALIZATION PROGRAM }D2 WRITELN('VT100 Files Creation for Adventure');; WRITELN('Be patient, it takes a while @P ;dO &EXT; U$ RESET(ADVDAT,'ADVDAT.DTA/SEEK'); I:=2*LOCSIZ+MAXTRS+402;  SEEK(ADVDAT,I); ( FOR I:=ORD('A') TO ORD('Z') DO BEGIN KTAB[I]:=ADVDAT^; GET(ADVDAT) END; CLOSE(ADVDAT); SAVPTR;T WRITELN('.....done!'); CLOSE(TXTFILE)END. CLOSE(ADVDAT) END;-BEGIN { VT-100 FILES INITIALIZATION PROGRAM }D2 WRITELN('VT100 Files Creation for Adventure');; WRITELN('Be patient, it takes a while !{********>>>>>>>><<<<<<<<********>> MODULE: START 30-OCT-808 This module contains the "wizardry" routines START and UNSAVE.!********>>>>>>>><<<<<<<<********} {$C .TITLE START .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** })FUNCTION BIT(N:INTEGER):INTEGER;EXTERNAL;+PROCEDURE MOVE(OBJ,WHERE:INTEGER);EXTERNAL;'PROCEDURE JUGGLE(OBJ:INTEGER);EXTERNAL;9{ ************* I/O SUBROUTINES ********************}'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;<>PROCEDURE GETIN(VAR WORD1,WORD1X,WORD2,WORD2X: WORD);EXTERNAL;0FUNCTION ASKM(I,J,K: INTEGER): BOOLEAN;EXTERNAL;B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBER* 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGINI 18 -- HENDD 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }(PROCEDURE RDWIZ(VAR X:INTEGER);EXTERNAL;J{ Procedure to restore a saved Adventure. Var SAV tells us which of the Lstorage locations to use. The name for the saved game is wiped out so saved$games can only be restarted once. }PROCEDURE UNSAVE(SAV:INTEGER);$VAR SAVED,SAVET,I,PLAC,FIXD:INTEGER;8{ Local procedure to restore the value of a boolean. } PROCEDURE RDWIZB(VAR X:BOOLEAN);VAR Z:INTEGER;BEGINS RDWIZ(Z);6% IF Z=0 THEN X:=FALSE ELSE X:=TRUE0 END;BEGINd MSPEAK(40);C' RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK');  SEEK(ADVWIZ,40); ADVWIZ^:=ADVWIZ^-1;A PUT(ADVWIZ); SEEK(ADVWIZ,20*SAV+42);u FOR I:=1 TO 20 DO BEGINa IF I=8 THEN MSPEAK(41); IF I=19 THEN MSPEAK(42);  ADVWIZ^:=ORD(' ')-ORD('A'); PUT(ADVWIZ);  SEEK(ADVWIZ,20*SAV+42+I)E END; SEEK(ADVWIZ,253*SAV+102);  RDWIZ(SAVED);  RDWIZ(SAVET);B RDWIZ(LOCATION); RDWIZ(HOLDING);  FOR I:=1 TO MAXTRS DO BEGINF IF I=25 THEN MSPEAK(43);; RDWIZ(PLAC); RDWIZ(FIXD);  RDWIZ(PROP[I]); MOVE(I,PLAC);$ IF (FIXD>0)OR((FIXD=0)AND(PLAC=0)) * THEN MOVE(I+100,FIXD) ELSE FIXED[I]:=FIXD END; MSPEAK(44); ( FOR I:=MAXTRS DOWNTO 1 DO JUGGLE(I); RDWIZ(TALLY);  RDWIZ(TALLY2); RDWIZ(DFLAG);' RDWIZ(TURNS); RDWIZ(IWEST);+ RDWIZ(KNFLOC); RDWIZ(NUMDIE); RDWIZ(DKILL);( RDWIZ(CLOCK1); RDWIZ(CLOCK2); RDWIZ(LIMIT);I FOR I:=1 TO 10 DO BEGIN  RDWIZ(HINTLC[I]); RDWIZB(HINTED[I]);) END; MSPEAK(45);F FOR I:=1 TO 6 DO BEGIN RDWIZ(ODLOC[I]);F RDWIZ(DLOC[I]); RDWIZB(DSEEN[I])  END; RDWIZB(WZDARK);= RDWIZB(LMWARN);S RDWIZB(CLOSING); RDWIZB(PANIC); G RDWIZB(CLOSED);L RDWIZ(NEWLOC); RDWIZ(OLDLC2); RDWIZ(OLDLOC); CLOSE(ADVWIZ)SEND;8PROCEDURE DATIME(VAR D:UNSIGNED;VAR T:INTEGER);EXTERNAL;!FUNCTION WIZARD:BOOLEAN;EXTERNAL;;PROCEDURE PRIMETIME;EXTERNAL;1PROCEDURE HOURS;EXTERNAL;LL{ This function is called after initialization at the beginning of the gameOto check for "prime time" and suitable latency after saved games. It returns aIOvalue of true if a demonstration game is being allowed, otherwise always false.LGlobal variable DONE is set to true if play is disallowed for any reason. }FUNCTION START:BOOLEAN;N"VAR DELAY,LATENCY,SAV,D,T:INTEGER;" PRIMTM:ARRAY[1..2] OF INTEGER; SAVED,SAVET:UNSIGNED;( SOON,WAYTOOSOON,FOUND,PTIME:BOOLEAN;.{ Local procedure to check saved game names. }PROCEDURE MATCH(WRD:WORD);VAR J,K:INTEGER;BEGINo FOR J:=1 TO 5 DO BEGIN RDWIZ(K);- IF WRD[J]<>CHR(K+ORD('A')) THEN FOUND:=FALSEf ENDaEND;BEGIN { Start }iK { Check to see if this is "prime time". If so, only wizards may play, pIthough others may be allowed a short game for demonstration purposes. If,Ithis is a saved game, check for suitable latency. Return true if this isEIa demo game, return DONE true if play not allowed, restore data for saved games. }v PRIMETIME; DATIME(D,T);1 IF (D>=HBEGIN)AND(D<=HEND) THEN PRIMTM:=HOLIDT+ ELSE IF (D MOD 7)<=1 THEN PRIMTM:=WKENDR ELSE PRIMTM:=WKDAY;fC IF (T DIV 60)<15 THEN PTIME:=((PRIMTM[1] AND BIT(T DIV 60))<>0)p8 ELSE PTIME:=((PRIMTM[2] AND BIT((T DIV 60)-15))<>0);$ RESET(ADVWIZ,'ADVWIZ.DTA/SEEK'); SEEK(ADVWIZ,39); RDWIZ(SHORT);  RDWIZ(SAV);u RDWIZ(LATENCY);r SETUP:=FALSE; SOON:=FALSE; WAYTOOSOON:=FALSE; o- IF SAV<>0 THEN IF ASKM(31,7,7) THEN BEGINR MSPEAK(46); GETIN(WRD1,WRD1X,WRD2,WRD2X); FOR SAV:=0 TO 2 DO BEGINO FOUND:=TRUE;D MATCH(WRD1);M MATCH(WRD1X); MATCH(WRD2);  MATCH(WRD2X); IF FOUND THEN EXITD END;D( IF NOT FOUND THEN MSPEAK(47) ELSE BEGIN MSPEAK(48); SETUP:=TRUE;E SEEK(ADVWIZ,102+(SAV*253)); RDWIZ(SAVED); RDWIZ(SAVET);% DELAY:=(D-SAVED)*1440+(T-SAVET); IF DELAY> FILE: ADVPAS.ODL ; 28-OCT-80;2;>> OVERLAY DESCRIPTION FOR PASCAL SUPPORT MODULES;?;***NOTE: FOR NON-EIS PROCESSORS SUBSTITUTE RUNLB2 FOR RUNLIB.;2; THE STATEMENT BELOW DESCRIBES THE TIME FUNCTION.;+FFUNC: .FCTR RUNLIB/LB:$FTIME:$FPSIM:$CNVRT;@; THE STATEMENTS BELOW DESCRIBE THE MODULES WHICH MUST APPEAR IN; THE ROOT OF A THE PROGRAM.;2P1: .FCTR RUNLIB/LB:$INIT:$IO:$INPUT:$OUTPT:$ERROR!P2: .FCTR RUNLIB/LB:$WRINT:$DYNMM,P3: .FCTR RUNLIB/LB:$GETF:$PUTF:$CLOSE:$RSIMPASRES: .FCTR P1-P2-P3;L&; ERROR PROGRAM AND ARITHMETIC MODULES; P4: .FCTR RUNLIB/LB:ERRORP5: .FCTR RUNLIB/LB:$ARITHPASERR: .FCTR P4-P5R;B; OVERLAYS DEALING WITH I/OT;NIO1: .FCTR RUNLIB/LB:$OPENIO2: .FCTR RUNLIB/LB:$READINIO3: .FCTR RUNLIB/LB:$SEEKPASIO: .FCTR IO1-(IO2,IO3);S; ROOT DEFINITION:; +SINGLE: .FCTR *PASRES-*(PASERR-FFUNC,PASIO);G; OVERLAY DEFINITIONS FOR MODULES IN THE SYSTEM LIBRARY. THESE OVERLAYWO; DEFINITIONS MAY BE UNCOMMENTED IF YOUR SYSTEM DOES NOT HAVE A SHARED RESIDENT3'; LIBRARY WHICH CONTAINS THESE MODULES.L;H;FINIT: .FCTR LB:[1,1]SYSLIB/LB:FINIT:ASSLUN:RETADR:RDWAIT:EOFCHK:WATSET$;CSI1: .FCTR LB:[1,1]SYSLIB/LB:.CSI1$;CSI2: .FCTR LB:[1,1]SYSLIB/LB:.CSI2%;OPFNB: .FCTR LB:[1,1]SYSLIB/LB:OPFNBR$;PARS: .FCTR LB:[1,1]SYSLIB/LB:PARSEF;POSRC: .FCTR LB:[1,1]SYSLIB/LB:POSREC:MOVREC:PGCR:RDRN:PNTMRK:GET:PUT%;CLOSE: .FCTR LB:[1,1]SYSLIB/LB:CLOSEO;E; SYSTEM I/O CO-TREE; 8;SYSIO: .FCTR *FINIT-*(CSI1,CSI2,OPFNB,PARS,POSRC,CLOSE)YSTEM DOES NOT H@ P l^Ex;H;FINIT: .FCTR LB:[1,1]SYSLIB/LB:FINIT:ASSLUN:RETADR:RDWAIT:EOFCHK:WATSET$;CSI1: .FCTR LB:[1,1]SYSLIB/LB:.CSI1$;CSI2: .FCTR LB:[1,1]SYSLIB/LB:.CSI2%;OPFNB: .FCTR LB:[1,1]SYSLIB/LB:OPFNBR$;PARS: .FCTR LB:[1,1]SYSLIB/LB:PARSEF;POSRC: .FCTR LB:[1,1]SYSLIB/LB:POSREC:MOVREC:PGCR:RDRN:PNTMRK:GET:PUT%;CLOSE: .FCTR LB:[1,1]SYSLIB/LB:CLOSEO;E; SYSTEM I/O CO-TREE; 8;SYSIO: .FCTR *FINIT-*(CSI1,CSI2,OPFNB,PARS,POSRC,CLOSE)YSTEM DOES NOT H; ;>> FILE: ADVBLD.ODL ; 28-OCT-80;*;>> ADVENTURES PROGRAM OVERLAY DESCRIPTION;0; PASCAL SUPPORT MODULES OVERLAY DESCRIPTION: @ADVPAS.ODL;%; ROOT OVERLAY SEGMENT DEFINITION:;E; Uncomment the following root definition and delete the other if youC; don't have a resident runtime system library. Also uncomment the; SYSIO definition in ADVPAS. ;.ROOT SINGLE,SYSIO,ADVSUB,*MAIN;.ROOT SINGLE,ADVSUB,*MAIN;$; SUBROUTINES CO-TREE DEFINITION:;;ADVSUB: .FCTR ADV/LB:SUBS0-*(S1,ADV/LB:DUMPWD,ADV/LB:SUBS1)0S1: .FCTR ADV/LB:RDWIZ-(S2,S3)*S2: .FCTR ADV/LB:FINISH-(S4,ADV/LB:CALSCO)4S3: .FCTR ADV/LB:HOURS-(ADV/LB:DATIME,ADV/LB:PRIMET)>S4: .FCTR ADV/LB:ASK-(ADV/LB:WIZMAG,ADV/LB:SPEAK,ADV/LB:GETIN);d!; MAIN PROGRAM TREE DEFINITIONo;MAIN: .FCTR ADV/LB:MAIN-*LOOP LOOP: .FCTR (L1,L2,L3,ADVRSP) *ADVRSP: .FCTR ADV/LB:RESPON-(R1,R2,ADVACT)ADVACT: .FCTR ADV/LB:PARSE-A1;O ; MAIN LOOP OVERLAY DESCRIPTION;OL1: .FCTR ADV/LB:ADVINI:L2: .FCTR ADV/LB:LOOP0 BL3: .FCTR ADV/LB:START;D(; RESPONSE SUB-LOOP OVERLAY DESCRIPTION;R1: .FCTR ADV/LB:LOOP1 SR2: .FCTR ADV/LB:MAGICM ;D%; PARSE SUB-LOOP OVERLAY DESCRIPTION);4A1: .FCTR (A2,ADV/LB:VERBS5,A9),%A2: .FCTR ADV/LB:TRANSI-(A3,A4,A5,A6)I6A3: .FCTR (ADV/LB:VERBS0,ADV/LB:VERBS1,ADV/LB:VERBS2) *A4: .FCTR ADV/LB:SAYIT-(ADV/LB:MAGICW,A7) 2A5: .FCTR ADV/LB:TAKE-(ADV/LB:FILLIT,ADV/LB:GETIT)CA6: .FCTR ADV/LB:THROWO-(ADV/LB:VERBS3,ADV/LB:DROPOB,ADV/LB:KILLIT)T7A7: .FCTR ADV/LB:TRAVEL-(ADV/LB:BACKUP,ADV/LB:NOWAY,A8)/'A8: .FCTR (ADV/LB:PLOVER,ADV/LB:TROLLB)Y5A9: .FCTR ADV/LB:VERBS4-(ADV/LB:SAVNAM,ADV/LB:SAVVAR)D.ENDAGICM ;D%; PARSE SUB-LOOP OVERLAY DESCRIPTION);4A1: .FCTR (A2,ADV/LB:VERBS5,A9),%A2: .FCTR ADV/LB:TRANSI-(A3,A4,A5,A6)I6A3: .FCTR (ADV/LB:VERBS0,ADV/LB:VERBS1,ADV/LB:VERBS2) *A4: .FCTR ADV/LB:SAYIT-(ADV/LB:MAGICW,A7) 2A5: .FCTR ADV/LB:TAKE-(ADV/LB:FILLIT,ADV/LB:GETIT)CA6: .FCTR ADV/LB:THROWO-(ADV/LB:VERBS3,ADV/LB:DROPOB,ADV/LB:KILLIT)T7A7: .FCTR ADV/LB:TRAVEL-(ADV/LB:BACKUP,A@P ;dQ ÎCTR ADV/LB:VERBS4-(ADV/LB:SAVNAM,ADV/LB:SAVVAR)D.ENDAGICM ;D%; PARSE SUB-LOOP OVERLAY DESCRIPTION);4A1: .FCTR (A2,ADV/LB:VERBS5,A9),%A2: .FCTR ADV/LB:TRANSI-(A3,A4,A5,A6)I6A3: .FCTR (ADV/LB:VERBS0,ADV/LB:VERBS1,ADV/LB:VERBS2) *A4: .FCTR ADV/LB:SAYIT-(ADV/LB:MAGICW,A7) 2A5: .FCTR ADV/LB:TAKE-(ADV/LB:FILLIT,ADV/LB:GETIT)CA6: .FCTR ADV/LB:THROWO-(ADV/LB:VERBS3,ADV/LB:DROPOB,ADV/LB:KILLIT)T7A7: .FCTR ADV/LB:TRAVEL-(ADV/LB:BACKUP,A!{********>>>>>>>><<<<<<<<********>> MODULE: MAGICM 12-NOV-80@ This module contains the "wizardry" routines used when someone5 invokes "magic mode": MAINTINENCE, NEWHRS, and MOTD. !********>>>>>>>><<<<<<<<********} {$C .TITLE MAGICM .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** })FUNCTION BIT(N:INTEGER):INTEGER;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}'PROCEDURE MSPEAK(MSG:INTEGER);EXTERNAL;0FUNCTION ASKM(I,J,K: INTEGER): BOOLEAN;EXTERNAL;B{ ****************** MAGIC MODE PROCEDURES ********************* }N{ All of the data required for the wizardry routines, including saving games,@is stored encoded in one random access file of integers: ADVWIZ.BThe current record usage assignments for this file are as follows, 1..5 -- MAGICWORD 6..10 -- MAGICNUMBERR 11..12 -- WKDAY 13..14 -- WKEND 15..16 -- HOLID 17 -- HBEGIN* 18 -- HENDR 19..38 -- HNAME 39 -- SHORT 40 -- Count of saved games. 41 -- LATENCY" 42..61 -- Name of saved game 1." 62..81 -- Name of saved game 2.# 82..101 -- Name of saved game 3.i 102..354 -- Saved game 1.v 355..607 -- Saved game 2. 608..860 -- Saved game 3.t( 861..1560 -- Message of the day. }L{ "Message of the day" -- If X is false, print current message. If X is true-then get new message from Wizard and save. }DPROCEDURE MOTD(X:BOOLEAN);VAR MSGLINE,BLNKLINE:LINE; REC,I,J:INTEGER;BEGINS' FOR I:=1 TO 72 DO BLNKLINE[I]:=' ';  MSGLINE:=BLNKLINE;' RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK');m REC:=861;  SEEK(ADVWIZ,REC);o IF X THEN BEGIN2 MSPEAK(23); MSGLINE[1]:='A';0 FOR I:=1 TO 10 DO BEGIN$ IF MSGLINE<>BLNKLINE THEN BEGIN READLN(MSGLINE);7 WHILE (MSGLINE[71]<>' ')OR(MSGLINE[72]<>' ') DO BEGINi MSPEAK(24);  READLN(MSGLINE)n m ENDf END;a FOR J:=1 TO 70 DO BEGIN$ ADVWIZ^:=ORD(MSGLINE[J])-ORD('A'); PUT(ADVWIZ); REC:=REC+1;+ IF (J<>70)OR(I<>10) THEN SEEK(ADVWIZ,REC)  END END;; IF MSGLINE<>BLNKLINE THEN BEGIN MSPEAK(25);2 REPEAT READLN(MSGLINE) UNTIL MSGLINE=BLNKLINE END END ELSE BEGIN WRITELN;= FOR I:=1 TO 10 DO BEGIN FOR J:=1 TO 70 DO BEGIN$ MSGLINE[J]:=CHR(ADVWIZ^+ORD('A'));& IF (I<>10)OR(J<>70) THEN GET(ADVWIZ) END;K8 IF MSGLINE=BLNKLINE THEN EXIT ELSE WRITELN(MSGLINE) END END; CLOSE(ADVWIZ)ZEND;8PROCEDURE DATIME(VAR D:UNSIGNED;VAR T:INTEGER);EXTERNAL;!FUNCTION WIZARD:BOOLEAN;EXTERNAL;CPROCEDURE HOURS;EXTERNAL;LI{ This procedure is used to set up new hours for the cave. Specified as Pinverse -- i.e., when is it closed due to prime time? See HOURS for descriptionof variables. }PROCEDURE NEWHRS; TYPE STRNG8=ARRAY[1..8] OF CHAR;VAR REC:INTEGER;K{ Local procedure to input prime time specs and set up a word of internal L4format and write it to the magic parameters file. }PROCEDURE NEWHRX(TITLE:STRNG8);;VAR FROM,TILL,I,J,K:INTEGER;" PRMTIM:ARRAY[1..2] OF INTEGER;BEGINR FROM:=0; TILL:=0; PRMTIM[1]:=0;  PRMTIM[2]:=0; WRITELN;& WRITE('Prime time on ',TITLE,',');E WHILE (FROM>=0)AND(FROM<=23)AND(TILL>=FROM)AND(TILL<=24) DO BEGIN FROM:=-1; TILL:=-1; WRITE(' from: ');  READLN(FROM);% IF (FROM>=0)AND(FROM<=23) THEN BEGINn WRITE(' till: '); READLN(TILL); TILL:=TILL-1;' IF (TILL>=FROM)AND(TILL<=23) THEN }E FOR I:=FROM TO TILL DO IF I<=14 THEN PRMTIM[1]:=PRMTIM[1]+BIT(I)R( ELSE PRMTIM[2]:=PRMTIM[2]+BIT(I-15) END END; ADVWIZ^:=PRMTIM[1];  PUT(ADVWIZ); REC:=REC+1; SEEK(ADVWIZ,REC);n ADVWIZ^:=PRMTIM[2];  PUT(ADVWIZ); REC:=REC+1;M SEEK(ADVWIZ,REC)END;BEGIN { Newhrs }' RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK'); REC:=11; SEEK(ADVWIZ,REC);n MSPEAK(21);l NEWHRX('Weekdays');; NEWHRX('Weekends');  NEWHRX('Holidays');= CLOSE(ADVWIZ); MSPEAK(22);D HOURSTEND;F{ This procedure is called when someone says the magic word to invokeQmaintenence mode. If so, let him tweak all sorts of things and update the magic Aparameters file. }WPROCEDURE MAINTINENCE;VAR REC,LATENCY,T,I:INTEGER;' MAGICNUMBER:ARRAY[1..5] OF INTEGER;h MAGICWORD:WORD;Z D,HBEGIN,HEND:UNSIGNED;  HNAME:ARRAY[1..20] OF CHAR;BEGINE IF WIZARD THEN BEGIN IF ASKM(10,0,0) THEN HOURS; IF ASKM(11,0,0) THEN NEWHRS;$ RESET(ADVWIZ,'ADVWIZ.DTA/RW/SEEK'); IF ASKM(26,0,0) THEN BEGINr MSPEAK(27); READLN(HBEGIN); MSPEAK(28); READLN(HEND); DATIME(D,T);w HBEGIN:=HBEGIN+D; HEND:=HBEGIN+HEND-1;a MSPEAK(29); READLN(HNAME);; A REC:=17;, SEEK(ADVWIZ,REC); ADVWIZ^:=HBEGIN;G PUT(ADVWIZ);: REC:=REC+1; SEEK(ADVWIZ,REC); ADVWIZ^:=HEND;  PUT(ADVWIZ);  REC:=REC+1; SEEK(ADVWIZ,REC); FOR I:=1 TO 20 DO BEGIN" ADVWIZ^:=ORD(HNAME[I])-ORD('A'); PUT(ADVWIZ); REC:=REC+1;T SEEK(ADVWIZ,REC) END END;A SEEK(ADVWIZ,39);M SHORT:=ADVWIZ^; WRITELN;;H WRITE('Length of a short game (zero to leave at ',SHORT:3,' turns): '); READLN(I);9 IF I>0 THEN BEGIN ADVWIZ^:=I; PUT(ADVWIZ) END;R MSPEAK(12); READLN(MAGICWORD);P! IF MAGICWORD<>' ' THEN BEGIN REC:=1; SEEK(ADVWIZ,REC); FOR I:=1 TO 5 DO BEGINR& ADVWIZ^:=ORD(MAGICWORD[I])-ORD('A'); PUT(ADVWIZ); REC:=REC+1;W SEEK(ADVWIZ,REC) END END;D MSPEAK(13); READLN(MAGICNUMBER[5]); IF MAGICNUMBER[5]<>0 THEN BEGIN FOR I:=5 DOWNTO 2 DO BEGINN* MAGICNUMBER[I-1]:=MAGICNUMBER[I] DIV 10;' MAGICNUMBER[I]:=MAGICNUMBER[I] MOD 10( END;> REC:=6; SEEK(ADVWIZ,REC); FOR I:=1 TO 5 DO BEGIN2 ADVWIZ^:=MAGICNUMBER[I]; PUT(ADVWIZ); REC:=REC+1;  SEEK(ADVWIZ,REC) END END;; SEEK(ADVWIZ,41);5 LATENCY:=ADVWIZ^; WRITELN;C DI WRITELN('Latency for restart (zero to leave at',LATENCY:4,' minutes):');D READLN(I);P IF I>0 THEN BEGIN' IF I<45 THEN MSPEAK(30) ELSE BEGINN ADVWIZ^:=I;R PUT(ADVWIZ)D END END;N CLOSE(ADVWIZ);N! IF ASKM(14,0,0) THEN MOTD(TRUE);= MSPEAK(15); MSPEAK(37)  END; MOVED:=TRUESEND;IZ,REC); FOR I:=1 TO 5 DO BEGIN2 ADVWIZ^:=MAGICNUMBER[I]; PUT(ADVWIZ); REC:=REC+1;  SEEK(ADVWIZ,REC) END END;; SEEK(ADVWIZ,41);5 LATENCY:=ADVWIZ^; WRITELN;C DI WRITELN('Latency for restart (zero to leave at',LATENCY:4,' minutes):');D READLN(I);P IF I>0 THEN BEGIN' @Q;dP IZ)D END END;N CLOSE(ADVWIZ);N! IF ASKM(14,0,0) THEN MOTD(TRUE);= MSPEAK(15); MSPEAK(37)  END; MOVED:=TRUESEND;IZ,REC); FOR I:=1 TO 5 DO BEGIN2 ADVWIZ^:=MAGICNUMBER[I]; PUT(ADVWIZ); REC:=REC+1;  SEEK(ADVWIZ,REC) END END;; SEEK(ADVWIZ,41);5 LATENCY:=ADVWIZ^; WRITELN;C DI WRITELN('Latency for restart (zero to leave at',LATENCY:4,' minutes):');D READLN(I);P IF I>0 THEN BEGIN' !{********>>>>>>>><<<<<<<<********>> MODULE: VERBS2 26-MAY-81= This module contains the procedures EATIT, EATOBJ, BLASTIT, DRINKIT, and POURIT.!********>>>>>>>><<<<<<<<********} {$C .TITLE VERBS2 .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** })PROCEDURE DROP(OBJ,LOC:INTEGER);EXTERNAL;(PROCEDURE DESTROY(OBJ:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;,FUNCTION HERE(OBJ:INTEGER):BOOLEAN;EXTERNAL;FUNCTION LIQ:INTEGER;EXTERNAL;.FUNCTION LIQLOC(LOC:INTEGER):INTEGER;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;9{ ************* I/O SUBROUTINES ********************}>'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;,PROCEDURE PSPEAK(OBJ,PROP:INTEGER);EXTERNAL;>{**************** VERB EAT (INTRANSITIVE) ******************}PROCEDURE VERBHUH;EXTERNAL;RB{ "eat" -- intransitive: assume food if present, else ask what. }PROCEDURE EATIT;BEGINH* IF NOT HERE(FOOD) THEN VERBHUH ELSE BEGIN+ IF TOTING(FOOD) THEN DROP(FOOD,LOCATION);O DESTROY(FOOD); RSPEAK(72) ENDEND;@{**************** VERB EAT (TRANSITIVE) ********************}J{ "eat" -- Food okay, some things lose appetite, others are ridiculous. }PROCEDURE EATOBJ;:BEGIN)( IF OBJ=FOOD THEN EATIT ELSE CASE OBJ OF< BIRD,SNAKE,CLAM,OYSTER,DWARF,DRAGON,TROLL,BEAR:RSPEAK(71); ELSE RSPEAK(ACTSPK[VERB])v ENDEND;>{************* MAIN PROGRAM PROCEDURES ********************}PROCEDURE FINISH;EXTERNAL;B{********************* VERB BLAST *****************************}H{ "blast" -- No effect (heh-heh) unless you've got dynamite, which is a  *neat trick! }PROCEDURE BLASTIT;BEGINe9 IF (PROP[ROD2]<0)OR NOT CLOSED THEN RSPEAK(ACTSPK[VERB]) ELSE BEGINI IF HERE(ROD2) THEN BONUS:=135C& ELSE IF LOCATION=115 THEN BONUS:=134 ELSE BONUS:=133; RSPEAK(BONUS); FINISH ENDEND;C{********************* VERB DRINK *****************************}*M{ "drink" -- If no object, assume water and look for it here. If water is in*Pthe bottle, drink that, else must be at a water location, so drink the stream. }PROCEDURE DRINKIT;BEGINe9 IF (OBJ=0)AND(LIQLOC(LOCATION)<>WATER)AND((LIQ<>WATER)OR) NOT HERE(BOTTLE)) THEN VERBHUHV1 ELSE IF (OBJ<>0)AND(OBJ<>WATER) THEN RSPEAK(110)3B ELSE IF (LIQ<>WATER)OR NOT HERE(BOTTLE) THEN RSPEAK(ACTSPK[VERB]) ELSE BEGIN PROP[BOTTLE]:=1;( IF TOTING(BOTTLE) THEN DESTROY(WATER); RSPEAK(74) ENDEND;A{********************* VERB POUR *****************************} I{ "pour" -- If no object, or object is bottle, assume contents of bottle.oASpecial tests for pouring water or oil on plant or rusty door. }QPROCEDURE POURIT;RBEGINI( IF (OBJ=BOTTLE)OR(OBJ=0) THEN OBJ:=LIQ; IF OBJ=0 THEN VERBHUH2 ELSE IF NOT TOTING(OBJ) THEN RSPEAK(ACTSPK[VERB])2 ELSE IF (OBJ<>OIL)AND(OBJ<>WATER) THEN RSPEAK(78) ELSE BEGIN  PROP[BOTTLE]:=1; DESTROY(OBJ); = IF AT(PLANT) THEN IF OBJ<>WATER THEN RSPEAK(112) ELSE BEGIN* PSPEAK(PLANT,PROP[PLANT]+1);*& PROP[PLANT]:=(PROP[PLANT]+2) MOD 6;# PROP[PLANT2]:=PROP[PLANT] DIV 2;o NEWLOC:=LOCATION; MOVED:=TRUE END  ELSE IF AT(DOOR) THEN BEGINd4 IF OBJ=OIL THEN PROP[DOOR]:=1 ELSE PROP[DOOR]:=0; RSPEAK(113+PROP[DOOR])I END  ELSE RSPEAK(77)  ENDEND; B THEN RSPEAK(ACTSPK[VERB])2 ELSE IF (OBJ<>OIL)AND(OBJ<>WATER) THEN RSPEAK(78) ELSE BEGIN  PROP[BOTTLE]:=1; DESTROY(OBJ); = IF AT(PLANT) THEN IF OBJ<>WATER THEN RSPEAK(112) ELSE BEGIN* PSPEAK(PLANT,PROP[PLANT]+@Q ;dN P[PLANT] DIV 2;o NEWLOC:=LOCATION; MOVED:=TRUE END  ELSE IF AT(DOOR) THEN BEGINd4 IF OBJ=OIL THEN PROP[DOOR]:=1 ELSE PROP[DOOR]:=0; RSPEAK(113+PROP[DOOR])I END  ELSE RSPEAK(77)  ENDEND; B THEN RSPEAK(ACTSPK[VERB])2 ELSE IF (OBJ<>OIL)AND(OBJ<>WATER) THEN RSPEAK(78) ELSE BEGIN  PROP[BOTTLE]:=1; DESTROY(OBJ); = IF AT(PLANT) THEN IF OBJ<>WATER THEN RSPEAK(112) ELSE BEGIN* PSPEAK(PLANT,PROP[PLANT]+!{********>>>>>>>><<<<<<<<********>> MODULE: TRAVEL 29-OCT-81@ This module contains the procedures TRAVEL, TRVTBL, and SEARCH, which oversee the response to motion verbs. !********>>>>>>>><<<<<<<<********} {$C .TITLE TRAVEL .IDENT /V0/ }A{ *************** DATA STRUCTURE ROUTINES ****************** }.FUNCTION FORCED(LOC:INTEGER):BOOLEAN;EXTERNAL;+PROCEDURE DROP(OBJ,WHERE:INTEGER);EXTERNAL;.FUNCTION TOTING(OBJ:INTEGER):BOOLEAN;EXTERNAL;*FUNCTION AT(OBJ:INTEGER):BOOLEAN;EXTERNAL;)FUNCTION PCT(N:INTEGER):BOOLEAN;EXTERNAL;89{ ************* I/O SUBROUTINES ********************}n'PROCEDURE RSPEAK(MSG:INTEGER);EXTERNAL;tC{ ********************* TRAVEL PROCEDURE *********************** }A:PROCEDURE BACKUP(VAR I:INTEGER;VAR LINK:KEYLINK);EXTERNAL;PROCEDURE TRVTBL;FORWARD; #{ Figure out the new location.....ENGiven the current location in LOCATION, and a motion verb number in K, put theLnew location in NEWLOC. The current LOCATION is saved in OLDLOC in case he Lwants to retreat. The current OLDLOC is saved in OLDLC2, in case he dies. L(If he does, NEWLOC will be in limbo, and OLDLOC will be what killed him, so8we need OLDLC2, which is the last place he was safe.) }PROCEDURE TRAVEL; VAR LINK1:KEYLINK; I:INTEGER;BEGINR2 { Get the key link for the present location. } LINK1:=KEY[LOCATION];iH { If the motion is forced, don't bother with the verb, just move. }" IF FORCED(LOCATION) THEN BEGIN NEWLOC:=LINK1^.NEWLOC[2]; OLDLC2:=OLDLOC; OLDLOC:=LOCATIONT ENDt4 { Otherwise, check for a few special verbs... } ELSE CASE K OF { Do nothing. }L NULL: NEWLOC:=LOCATION;H { Handle "go back". Look for verb which goes from LOCATION to OLDLOC,? or to OLDLC2 if OLDLOC has forced motion. BACKUP returns withhG I=LOCATION if we forgot how he got here, or with a new LINK1 such that : I=LINK1^.NEWLOC[2], if we found a verb to retreat with. } BACK: BEGIN I:=0; BACKUP(I,LINK1);O IF I=LOCATION THEN BEGINO RSPEAK(91);: C NEWLOC:=LOCATION END iA { If we exited without finding a path, you can't get there n from here. }+ ELSE IF I<>LINK1^.NEWLOC[2] THEN BEGIN  RSPEAK(140); NEWLOC:=LOCATION END? { Otherwise, grab the first verb for this path and go to " normal travel table search. } ELSE BEGINe K:=LINK1^.NXTVERB^.VERBVAL;E TRVTBL END END; {Case K of BACK}}F { Look. Cant't give more detail. Pretend it wasn't dark (though it G may "now" be dark) so he won't fall into a pit while staring out into f the gloom. } LOOK:BEGINp! IF DETAIL<3 THEN RSPEAK(15);o DETAIL:=DETAIL+1; WZDARK:=FALSE;T ABB[LOCATION]:=0; NEWLOC:=LOCATION END;DB { Cave. Different messages depending on whether above ground. } CAVE:BEGINr3 IF LOCATION<8 THEN RSPEAK(57) ELSE RSPEAK(58);X NEWLOC:=LOCATIONT END;  ELSEE? { All other cases look for verb in travel table. See databasen7 description for explanation of conditional motions. }o BEGIN OLDLC2:=OLDLOC; OLDLOC:=LOCATION; TRVTBL:' END { of else clause in case of K }o END; {Case of K} MOVED:=TRUEFEND; C{ *************** TRAVEL TABLE PROCEDURES *********************** }r,PROCEDURE SEARCH(VAR LINK1:KEYLINK);FORWARD;PROCEDURE NOWAY;EXTERNAL;AL{ Search the travel table for the new location. See database description in<module ADVINI for explanation of travel table conditions. }PROCEDURE TRVTBL;fVAR LINK1:KEYLINK;BEGINa4 { Get the keylink pointer for this location. } LINK1:=KEY[LOCATION];: NEWLOC:=0;8 REPEAT SEARCH(LINK1) UNTIL (NEWLOC<>0)OR(LINK1=NIL); T IF NEWLOC=0 THEN NOWAYEND;K{ Dummy procedure to force overlay mechanism to pull in entire tree path to1here when PARSE is loaded. } PROCEDURE OVRLOAD;BEGINhEND;PROCEDURE PLOVER;EXTERNAL;PROCEDURE TROLLBRIDGE;EXTERNAL;oN{ Search the travel table for the new location. See database description in?module ADVINI for an explanation of travel table conditions. } %PROCEDURE SEARCH; {VAR LINK1:KEYLINK}VAR LINK2:VERBLINK;E COND:INTEGER;U FOUND:BOOLEAN;BEGIN; LINK2:=LINK1^.NXTVERB;H WHILE (LINK2^.VERBVAL<>K) AND (LINK2<>NIL) DO LINK2:=LINK2^.NXTVERB;G IF LINK2=NIL THEN LINK1:=LINK1^.NXTLINK ELSE REPEAT { until found }I FOUND:=TRUE;C IF LINK1<>NIL THEN BEGINR& IF LINK1^.NEWLOC[1]<>0 THEN BEGIN COND:=LINK1^.NEWLOC[1];h IF COND<=100 THEN BEGINs! IF NOT PCT(COND) THEN BEGIN  LINK1:=LINK1^.NXTLINK;b FOUND:=FALSE ENDR! END ELSE IF COND<300 THEN BEGIN ! IF NOT TOTING(COND MOD 100)U, AND((COND<200)OR NOT AT(COND MOD 100)) THEN BEGIN LINK1:=LINK1^.NXTLINK;N FOUND:=FALSE END2! END ELSE IF COND>300 THEN BEGINI. IF PROP[COND MOD 100]=((COND DIV 100)-3) THEN BEGIN LINK1:=LINK1^.NXTLINK; FOUND:=FALSEW ENDH ENDN END;I IF FOUND THEN BEGIN8 IF LINK1^.NEWLOC[2]<=300 THEN NEWLOC:=LINK1^.NEWLOC[2]) ELSE IF LINK1^.NEWLOC[2]>500 THEN BEGIN NEWLOC:=LOCATION; " RSPEAK(LINK1^.NEWLOC[2]-500)# END ELSE CASE LINK1^.NEWLOC[2] OFnil } UNTIL FOUNDrEND;port. Drop the emerald (only B use special travel if toting it), so he's forced to use the @ plover-passage to get it out. Having dropped it, go back 5 and pretend he wasn't carrying it after all. }C