DEFINT a-z game$ = "AmigaVenture 1.17" ' Version number of game dataformat$ = "AmigaVenture 1.1X" ' Version number for load/save only ' ' AmigaVenture Kernal 1.17 ' ' Core routines for writing an Adventure of your own ' In Microsoft AmigaBasic ' ' by Mitsu Hadeishi 7/15/86 ' 1460 W. 182nd Street ' Gardena CA 90248 ' ' Written for the Winner's Circle Amiga User's Group ' '--------------------------------------------------------------------------- ' Permission is given to freely distribute this code in full or in part ' provided this notice is copied IN FULL. ' ' AmigaVenture Kernal Copyright (c) 1986 by Mitsu Hadeishi ' This code may not be used in part or in full in any commercial ' product, nor may this code in part or in full be sold intentionally ' to make a profit, without an explicit written agreement with the author. '--------------------------------------------------------------------------- ' ' Please write to me if you have plans to distribute a significantly ' modified version of the *kernal*. ' Feel free to distribute *adventures* written with this kernal without ' contacting me, but please! give credit where credit is due. ' ' Updates and enhancements may be obtained from: ' ' Mitsu Hadeishi ' hadeishi@husc4.UUCP ' or hadeishi%husc4.harvard.edu ' 3 Sacramento Street ' Cambridge, MA 02138 ' ' All variables are, unless otherwise indicated, short integers. ' GOTO Initialize Messages: ' Message subroutines/subprograms Cannot: IF n$(1) = "" THEN PRINT"You can't "v$" "nn$(0)"! ELSE PRINT"You can't "v$" "nn$(0)" "p$" "nn$(1)"! END IF RETURN SUB CantSee(nn$) STATIC PRINT"I don't see what you're referring to. END SUB SUB DontHave(nn$) STATIC PRINT"You don't have "nn$"! END SUB SUB CantGetAt(nn$) STATIC PRINT"You can't get at "nn$"!" END SUB Absurd: ON RND(1)*2+1 GOTO Absurd1,Absurd2 Absurd1: PRINT"Don't be absurd.":RETURN Absurd2: PRINT"Don't talk nonsense.":RETURN Mystery: PRINT"I can't see what you're referring to. RETURN ' Prints a list of alternatives for the player to select from ' If all the choices are positionally referenced, then "that" is ' returned as 1 SUB AskAmbig(choice(2),num,that) STATIC SHARED adj$(),par(),rel(),prepn$() PRINT"Which do you mean:" num = ABS(num) FOR i = 1 TO num IF i = num THEN PRINT"or "; c=choice(i,0) CALL NameNoun(c,n$,nn$) IF c > 0 AND adj$(c) <> "" THEN PRINT"the "adj$(c)" "n$; that=-1 ELSE PRINT nn$; END IF IF c > 0 AND adj$(c) = "" AND par(c) <> 0 THEN PRINT" that's "prepn$(rel(c)+1)" "; IF that <> -1 THEN that=1 CALL NameNoun(par(c),n$,nn$) PRINT nn$; END IF IF i = num THEN PRINT"?" ELSE PRINT", "; NEXT i IF that = -1 THEN that=0 END SUB Calc: ' ' Calculation subprograms follow ' ' Visible() determines whether noun code 'code' is visible or not. ' If type is 1, then only checks to see if visible on the player, ' if 2, then only checks to see if visible in room (but not on player). ' Returns truth value in vis SUB Visible(code,vis,type) STATIC SHARED par(),rel(),opaque(),closed(),lo(),l a = type obj = code IF obj < 0 THEN vis=1:EXIT SUB vis = 0 IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB vis = -1 WHILE (vis = -1) IF par(obj) < 2 THEN vis = 1 ELSEIF (opaque(rel(obj),par(obj)) = 1) AND (rel(obj) = 0 AND closed(par(obj)) <> 0) THEN vis = 0 ELSE obj = par(obj) END IF WEND END SUB ' Avail() determines whether noun code 'code' is available or not. ' If the object is available, but you couldn't get it out from where ' it is, returns -1 ' See Visible, above, for explanation of 'type' ' Returns truth value in ava SUB Avail(code,ava,type) STATIC SHARED par(),rel(),closed(),lo(),l,opening(),size(),holdwater() a = type IF a = 0 THEN a = 3 obj = code IF obj < 0 THEN ava=1:EXIT SUB ava = 0 IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB siz = size(code):IF holdwater(code) = 2 THEN siz = 0 WHILE (1) IF par(obj)<2 THEN IF ava <> -1 THEN ava = 1 EXIT SUB ELSEIF closed(par(obj)) <> 0 AND (rel(obj) < 2) THEN ava = 0 EXIT SUB ELSEIF opening(rel(obj),par(obj)) < siz THEN ava = -1 END IF obj = par(obj) WEND END SUB '*** CheckLight() should be modified for your own program's way '*** of casting light and shadow on the situation. Returns 0 '*** for total darkness, 1 for lamp light, 2 for moonlight/nighttime, '*** 3 for twilight, 4 for daylight SUB CheckLight(light) STATIC SHARED l,lamp,lampon,day,flag(),Llight(),Lon() light = 0 IF Lon(l) THEN light = Lon(l):EXIT SUB IF Llight(l) = 1 AND flag(day) <> 0 THEN light = flag(day):EXIT SUB CALL Visible(lamp,vis,0) IF (flag(lampon) = 1) AND (vis = 1) THEN light = 1 END SUB ' NameNoun() returns appropriate strings in n$ and nn$, where ' n$ is the class word for the noun code, and nn$ is "the " + n$, ' unless the noun is abstract (negative code) in which case nn$ = n$ SUB NameNoun(n,n$,nn$) STATIC SHARED word$(),abstract$() IF n > 0 THEN n$ = word$(n) nn$ = "the " + n$ ELSE n$ = abstract$(-n) nn$ = n$ END IF END SUB Calc2: ' Places in array() siblings starting with object obj and children ' which are underneath all objects in the list. ' Starts the list at array(count + 1) (this allows you to call this ' routine multiple times and list several lists) This routine ' is used by the interpreter to list objects SUB ListSib(obj,array(2),count(1),nn) STATIC SHARED cc(),opaque(),right(),first() ll = 1 cc(1) = obj cc(0) = 0 ListSib1: WHILE (ll > 0) WHILE (cc(ll)) count(nn) = count(nn) + 1 array(nn,count(nn)) = cc(ll) IF first(3,cc(ll)) <> 0 AND opaque(3,cc(ll)) = 0 THEN ll = ll + 1 cc(ll) = first(3,cc(ll-1)) GOTO ListSib1 END IF cc(ll) = right(cc(ll)) WEND ll = ll - 1 cc(ll) = right(cc(ll)) WEND END SUB ' Determines if c1 is a descendant of c2 (inside, on, etc.) ' Returns truth value in ins SUB Inside(c1,c2,ins,rel) STATIC SHARED par() ins = 0 c = c1 WHILE (c) IF par(c) = c2 THEN ins = 1:rel = rel(c):EXIT SUB c = par(c) WEND END SUB ' EvalCond evaluates a condition on the flag() array; ret is the truth ' value returned. The condition tested depends on the value of b; ' it is whether or not flag(a) < c, flag(a) = c, or flag(a) > c, ' depending on whether b = -1, 0, or 1, respectively. This function ' is used to evaluate the conditionals in the map and the descriptions. ' (see Go:, Look:, and map:). SUB EvalCond(a,b,c,ret) STATIC SHARED flag(),random IF a = random THEN CALL RollDice IF b = 0 THEN ret = (flag(a) = c) ELSEIF b = 1 THEN ret = (flag(a) > c) ELSE ret = (flag(a) < c) END IF END SUB SUB RollDice STATIC SHARED flag(),random flag(random) = RND(1) * 100 END SUB ' List all bottles in the player's possession ' Starts at array(0), returns count in a SUB ListBottles(array(1),a) STATIC SHARED bottles(),lo(),nbot a = 0 FOR i = 0 TO nbot IF lo(bottles(i)) = 1 THEN CALL Avail(bottles(i),ava,1) IF ava THEN array(a) = bottles(i) a = a + 1 END IF END IF NEXT END SUB Lists: ' The following subprograms handle the linked lists of objects, ' parents, children, siblings ' Contents() prints a list of obj and all siblings and children ' If sing = 1, then just prints what's in it, ' not siblings SUB Contents(obj,indent,sing) STATIC SHARED cc(),mc(),mrel,pre$(),word$(),closed(),opaque(),right(),worn() SHARED folded(),fold$(),first() ll = 1 mc(1) = 0 cc(1) = obj WHILE (ll > 0) WHILE (cc(ll) <> 0) Contents1: c = cc(ll) mode = mc(ll) IF mode = 0 AND (sing = 0 OR ll > 1) AND c > 1 THEN PRINT TAB(indent);pre$(c)" "word$(c); IF folded(c) THEN PRINT" ("fold$(folded(c))")" ELSE PRINT END IF END IF IF first(mode,c) <> 0 AND (opaque(mode,c) = 0 OR (mode = 0 AND closed(c) = 0)) THEN nn$ = "the " + word$(c) PRINT TAB(indent); IF sing = 2 THEN ' *** Don't print anything ELSEIF mode = 0 THEN IF c = 1 THEN PRINT"You are wearing:" ELSE IF sing THEN PRINT FNcap$(nn$); ELSE PRINT nn$; PRINT" contains:" END IF ELSEIF mode = 1 THEN IF c = 1 THEN PRINT"You are carrying:" ELSE IF sing THEN PRINT"W"; ELSE PRINT"w"; PRINT"rapped by "nn$", you see:" END IF ELSEIF mode = 2 THEN IF sing THEN PRINT"L"; ELSE PRINT"l"; PRINT"ying on "nn$", you see:" ELSEIF mode = 3 THEN IF sing THEN PRINT"U"; ELSE PRINT"u"; PRINT"nder "nn$", you see:" END IF ll = ll + 1 cc(ll) = first(mode,c) mc(ll) = 0 indent = indent + 3 GOTO Contents1 END IF mc(ll) = mc(ll) + 1 IF mc(ll) > mrel THEN IF sing THEN IF ll = 1 THEN EXIT SUB cc(ll) = right(c) mc(ll) = 0 END IF WEND ll = ll - 1 indent = indent - 3 mc(ll) = mc(ll) + 1 IF mc(ll) > mrel THEN IF sing THEN IF ll = 1 THEN EXIT SUB cc(ll) = right(cc(ll)) mc(ll) = 0 END IF WEND END SUB ' Removes object from list and places it in limbo SUB Remove(obj) STATIC SHARED par(),right(),left(),rel(),first(),last() SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size() ri = right(obj) le = left(obj) right(le) = ri left(ri) = le IF par(obj) = 0 THEN lc = lo(obj) IF Llast(lc) = obj THEN Llast(lc) = le IF Lfirst(lc) = obj THEN Lfirst(lc) = ri ELSE pa = par(obj) IF last(rel(obj),pa) = obj THEN last(rel(obj),pa) = le IF first(rel(obj),pa) = obj THEN first(rel(obj),pa) = ri c = obj w = totw(c):b = totb(c) IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c) WHILE (pa) IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0 IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0 c = par(c) pa = par(c) WEND END IF par(obj) = 0 left(obj) = 0 right(obj) = 0 lo(obj) = 0 rel(obj) = 0 END SUB ' Inserts object into relation to object "into". If into is negative ' or zero, the routine will insert it into the room number -into. ' The relation is determined by "mode". This is 0 for in, 1 for wrapped, ' 2 for on top of, and 3 for underneath (like under a table, NOT like ' under something stacked on top of the object.) ' NOTE: this routine assumes that the object has already been "Removed" ' (see above.) The routine does not do any checking for weight, capacity, ' or mode violations. This must be done by the calling routine, using the ' totw() and totb() arrays, which are updated by this routine. SUB Insert(obj,into,mode) STATIC SHARED par(),rel(),mrel,right(),left(),first(),last() SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size() IF mode < 0 OR mode > mrel THEN EXIT SUB right(obj) = 0 IF into > 0 THEN par(obj) = into IF first(mode,into) = 0 THEN first(mode,into) = obj left(obj) = last(mode,into) right(last(mode,into)) = obj last(mode,into) = obj rel(obj) = mode pa = into c = obj w = totw(c):b = totb(c) IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c) WHILE (pa) IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0 IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0 c = par(c) pa = par(c) WEND CALL Setloc(obj,lo(into),1) ELSE into = -into par(obj) = 0 rel(obj) = 0 IF Lfirst(into) = 0 THEN Lfirst(into) = obj left(obj) = Llast(into) right(Llast(into)) = obj Llast(into) = obj CALL Setloc(obj,into,1) END IF END SUB ' Sets the location of obj and all its descendants recursively ' If sing is 0, then all siblings are set to location l as well, ' otherwise, only obj is set SUB Setloc(obj,l,sing) STATIC SHARED mrel,cc(),mc(),first(),right(),lo() lo(obj) = l ll = 1 mc(1) = 0 cc(1) = obj WHILE (ll > 0) WHILE (cc(ll) <> 0) Setloc1: c = cc(ll) mode = mc(ll) lo(c) = l IF (first(mode,c) <> 0) THEN ll = ll + 1 cc(ll) = first(mode,c) GOTO Setloc1 END IF mc(ll) = mc(ll) + 1 IF mc(ll) > mrel THEN IF sing THEN IF ll = 1 THEN EXIT SUB cc(ll) = right(cc(ll)) mc(ll) = 0 END IF WEND ll = ll - 1 mc(ll) = mc(ll) + 1 IF mc(ll) > mrel THEN IF sing THEN IF ll = 1 THEN EXIT SUB cc(ll) = right(cc(ll)) mc(ll) = 0 END IF WEND END SUB ' Removes the list of objects related to "code" in the relationship ' "mode" (0 - in, 1 - wrapped, 2 - on, 3 - underneath). ' Returns the first object in the list in "head". ' ***WARNING***: ' This routine DOES NOT set the location pointers, to speed up routines ' that set the location pointers themselves. Therefore the list is ' unlinked (it won't show up in a "look" or "examine", etc.) but if you ' ask whether or not the objects are visible or accessibile (with ' Visible() and Avail()) they will still be "there" in the room. ' To send them to limbo, call Setloc(head,0,0) after RemList. SUB RemList(code,mode,head) STATIC SHARED par(),rel(),right(),first(),last(),Lfirst(),Llast() SHARED totw(),totb(),bulk(),size() IF code > 0 THEN head = first(mode,code) first(mode,code) = 0 last(mode,code) = 0 ELSE code = -code head = Lfirst(code) Lfirst(code) = 0 Llast(code) = 0 END IF c = head WHILE (c) pa = par(c) d = c w = totw(c):b = totb(c) IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c) WHILE (pa) IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0 IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0 d = par(d) pa = par(d) WEND par(c) = 0 rel(c) = 0 c = right(c) WEND END SUB ' Concat concatenates the list of objects beginning with "head" into ' relationship with "code" in the manner "mode". If code is ' positive, it is an object, if negative, it is a location. ' This routine typically called after RemList. SUB Concat(head,code,mode) STATIC SHARED lo(),par(),rel(),left(),right(),first(),last(),Lfirst(),Llast() SHARED totw(),totb(),bulk(),size() IF head = 0 THEN EXIT SUB into = code IF code <= 0 THEN mode = 0:into = 0 totw = 0:totb = 0 c = head WHILE (c) rel(c) = mode par(c) = into pa = into d = c w = totw(c):b = totb(c) IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c) WHILE (pa) IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0 IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0 d = par(d) pa = par(d) WEND tail = c c = right(c) WEND IF code > 0 THEN left(head) = last(mode,code) right(last(mode,code)) = head IF first(mode,code) = 0 THEN first(mode,code) = head last(mode,code) = tail lc = lo(code) ELSE code = -code left(head) = Llast(code) right(Llast(code)) = head IF Lfirst(code) = 0 THEN Lfirst(code) = head Llast(code) = tail lc = code END IF CALL Setloc(head,lc,0) END SUB WaterLists: ' Fill() fills the obj with the specified about of water. Returns ' the actual amount filled in wat. SUB Fill(obj,wat) STATIC SHARED totw(),totb(),bulk(),par(),rel(),cap(),size() IF obj < 0 THEN EXIT SUB IF wat = 0 THEN EXIT SUB c=obj IF cap(0,c)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.) ' Check for overflow/underflow IF wat + bulk(0,c) > cap(0,c) THEN wat = cap(0,c) - bulk(0,c) IF wat < 0 THEN wat = 0:EXIT SUB ELSEIF wat + bulk(0,c) <= 0 THEN wat = -bulk(0,c) CALL Empty(obj) EXIT SUB END IF c = obj IF par(c+1) = 0 THEN ' No current water object inside c totw(c+1) = wat totb(c+1) = wat size(c+1) = wat CALL Insert(c+1,c,0) EXIT SUB ELSE ' Must modify bulk, weight in c totw(c+1) = totw(c+1) + wat totb(c+1) = totw(c+1) + wat size(c+1) = size(c+1) + wat bulk(0,c) = bulk(0,c) + wat WHILE (c) totw(c) = totw(c) + wat IF rel(c) < 3 THEN c = par(c) ELSE c = 0 WEND END IF END SUB ' Empties the water from object "obj". This routine DOES ' check to make sure the object IS a container SUB Empty(obj) STATIC SHARED holdwater(),par(),cap(),size(),totw(),totb() IF obj < 0 THEN EXIT SUB IF cap(0,obj)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.) IF holdwater(obj) <> 1 THEN EXIT SUB IF par(obj+1) = 0 THEN EXIT SUB CALL Remove(obj+1) size(obj+1) = 0 totw(obj+1) = 0 totb(obj+1) = 0 END SUB ' The Tumble routine takes all objects that are stacked on top of ' the object obj and makes them siblings of obj SUB Tumble(obj) STATIC SHARED cc(),c1(),c2(),lo(),par(),first(),right() ll = 1 cc(1) = first(2,obj) IF cc(1) = 0 THEN EXIT SUB tum = 0 c1(tum) = obj PRINT c1(tum) WHILE (ll > 0) WHILE (cc(ll) <> 0) Tumble1: c = cc(ll) IF (first(2,c) <> 0) THEN tum = tum + 1 c1(tum) = c ll = ll + 1 cc(ll) = first(2,c) GOTO Tumble1 END IF cc(ll) = right(cc(ll)) WEND ll = ll - 1 cc(ll) = right(cc(ll)) WEND FOR i = 0 TO tum CALL RemList(c1(i),2,c2(i)) NEXT i lc = par(obj) IF lc = 0 THEN lc = -lo(obj) FOR i = 0 TO tum CALL Concat(c2(i),lc,0) NEXT i END SUB ' ' Interpreter subprograms follow ' Interpreter: ' GetVerb() returns a verb code in v and a verb string in v$, ' and returns cmd$ starting with the first word following the verb phrase SUB GetVerb(cmd$,v,v$) STATIC SHARED verb$() IF cmd$ = "" THEN EXIT SUB cc(3) = -1 FOR i = 2 TO 0 STEP -1 cc(i) = INSTR(cc(i+1)+2,cmd$," ") - 1 NEXT i FOR i = 0 TO 2 '*** Search 3-word, 2-word, then 1-word verb lists IF cc(i) < 0 THEN GetVerb1 c$ = "," + LEFT$(cmd$,cc(i)) + "," c = INSTR(verb$(i),c$) IF c <> 0 THEN vl = i:i = 2 GetVerb1: NEXT i IF c = 0 THEN EXIT SUB ELSE v$ = MID$(c$,2,LEN(c$) - 2) lv = LEN(v$) v = VAL(MID$(verb$(vl),c + lv + 2)) cmd$ = MID$(cmd$,lv + 2) WHILE (MID$(cmd$,1,1) = " ") cmd$ = MID$(cmd$,2) WEND END IF END SUB ' ExNoun() returns an array of noun code choices and a count ' Returns 0 in nch if no noun is found ' Returns -1 if inconsistent nouns are found (like "diamond sandwich", etc.) ' Returns 1 in "that" if a "that" clause is identified ' Note: this routine exits immediately after ambiguity is resolved. ' This routine truncates cmd$ SUB ExNoun(cmd$,choice(2),nch,that) STATIC SHARED mhom,nnoun,noun$,nindex(),nhom(),ncode() ll = 0 ExNoun1: IF cmd$ = "" THEN ExNoun2 c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+"," c = INSTR(noun$,c$) IF c = 0 THEN ExNoun2 ln = LEN(c$) - 2 i = VAL(MID$(noun$,c + ln + 2)) cmd$ = MID$(cmd$,ln + 2) WHILE (MID$(cmd$,1,1) = " ") cmd$ = MID$(cmd$,2) WEND IF ncode(nindex(i)) = -14 THEN that = 1:GOTO ExNoun2 ' Found "that" IF ncode(nindex(i)) = -15 THEN ' "what's" == "everything that" IF nch THEN nch = -1:EXIT SUB choice(1,0) = -11:nch = 1:that = 1 CALL SkipNoun(cmd$) EXIT SUB END IF IF (nhom(i) = 0) THEN ExNoun1 '*** Null word, get next word IF (nch = 0) THEN '*** Empty context FOR j = 1 TO nhom(i) '*** Ambiguous code = ncode(nindex(i) + j - 1) nch = nch + 1 choice(nch,ll) = ncode(nindex(i) + nch -1) NEXT j ll = 1 - ll GOTO ExNoun1 ELSE '*** Try to resolve ambiguity within old context newnch = 0 FOR j = 1 TO nch FOR k = 1 TO nhom(i) code = ncode(nindex(i)+k-1) IF choice(j,1-ll) = code THEN newnch = newnch + 1 choice(newnch,ll) = code k = mhom END IF NEXT k NEXT j IF newnch = 0 THEN nch = -1:REM inconsistent nouns EXIT SUB END IF nch = newnch ll = 1 - ll GOTO ExNoun1 END IF ExNoun2: IF ll = 0 THEN FOR i = 1 TO nch choice(i,0) = choice(i,1) NEXT i END IF END SUB ' Skip noun (skips nouns without looking at meaning) SUB SkipNoun(cmd$) STATIC SHARED noun$ ll = 0 SkipNoun1: IF cmd$ = "" THEN EXIT SUB c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+"," c = INSTR(noun$,c$) IF c = 0 THEN EXIT SUB cmd$ = MID$(cmd$,LEN(c$)) WHILE (MID$(cmd$,1,1) = " ") cmd$ = MID$(cmd$,2) WEND GOTO SkipNoun1 END SUB ' GetNoun() uses ExNoun to return all possible noun code choices, ' and tries to resolve the ambiguity by calling ChooseVisible to ' see if the object is in the room or on the player. If this ' fails, then tries using the vtype1 flag, and then the vtype2 ' flag (see ChooseVisible for explanation of vtype.) (vtype1 is ' nounat(verb) and vtype2 is noundef(verb) (see Commands for ' explanation of nounat and noundef.)) ' Returns ch = -1 for inconsistent nouns ' Returns ch = -2 for ambiguity not resolved by visual check ' Returns that = 1 if a "that" clause follows ' See ExNoun() and ChooseVisible() SUB GetNoun(cmd$,choice(2),ch,n,vtype1,vtype2,that) STATIC SHARED c1() z = 0 c1(0) = 0:c1(1) = vtype1:c1(2) = vtype2 IF vtype1 <> c1(z) THEN z = z + 1:c1(z) = vtype1 IF vtype2 <> c1(z) THEN z = z + 1:c1(z) = vtype2 och = ch CALL ExNoun(cmd$,choice(),ch,that) IF that THEN IF ch = och THEN EXIT SUB IF ch = 1 THEN n = choice(1,0) ELSEIF ch = -1 THEN EXIT SUB ELSE '*** Try to resolve ambiguity FOR i = 0 TO z CALL ChooseVisible(choice(),ch,c1(i)) IF ch = 1 THEN 'Found it n = choice(1,0) EXIT SUB ELSEIF ch < -1 AND i = 0 THEN 'Can't see anywhere ch = -2 EXIT SUB ELSEIF ch <= 0 THEN 'Return last step's ambiguity ch = -ch EXIT SUB END IF NEXT i END IF END SUB ' Get preposition SUB GetPrep(cmd$,p) STATIC SHARED prep$,prepn$() WHILE (1) IF cmd$ = "" THEN EXIT SUB c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+"," c = INSTR(prep$,c$) IF c = 0 THEN EXIT SUB lp = LEN(c$) - 2 p = VAL(MID$(prep$,c + lp + 2)) cmd$ = MID$(cmd$,lp + 2) WHILE (MID$(cmd$,1,1) = " ") cmd$ = MID$(cmd$,2) WEND WEND END SUB ' Routine scans the choice array and returns an array with only ' visible items. Returns the same array with a negative ' nchoice if none of the items are visible. ' If vtype is 1, then only checks to see if object is visible on the ' player, and if 2, then only checks if objects is visible in room, ' but not carried by player. If 0, checks both places. SUB ChooseVisible(choice(2),nchoice,vtype) STATIC SHARED mhom IF nchoice < 2 THEN EXIT SUB newnchoice = 0 FOR i = 1 TO nchoice CALL Visible(choice(i,0),vis,vtype) IF (vis) THEN newnchoice = newnchoice + 1 choice(newnchoice,1) = choice(i,0) END IF NEXT i IF newnchoice = 0 THEN nchoice = -nchoice EXIT SUB ELSE nchoice = newnchoice FOR i = 1 TO nchoice choice(i,0) = choice(i,1) NEXT i END IF END SUB ' Parses the cmd$ string and returns the next preposition and ' noun (used in a sentence like "get the water that's *in the bottle*") ' Returns -1 in tp if player overrided command in an AskAmbig process ' Returns -2 in tp if player makes a fatal grammatical error SUB GetThatClause(cmd$,tp,tn) STATIC SHARED nchoice2() IF tp THEN GetThatClause1 tn = 0:tp = 0 CALL SkipNoun(cmd$) CALL GetPrep(cmd$,tp) GetThatClause1: IF tp < 1 OR tp > 4 THEN EXIT SUB nch = 0:ambig = 0:that = 0 GetThatClause2: CALL GetNoun(cmd$,nchoice2(),nch,tn,0,0,that) IF that THEN PRINT"Your language is too complex for me. Please restate." tp = -2 EXIT SUB END IF IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so cmd$ = amb$ ' assume that the player overrided the old command, and tp = -1 ' return a -1 error flag EXIT SUB ELSE ambig = 0 ' Clear AskAmbig flag END IF IF nch = -1 THEN GOSUB Absurd:tp = -2:EXIT SUB IF nch = -2 THEN GOSUB Mystery:tp = -2:EXIT SUB IF nch > 1 THEN ' Ask player to resolve ambiguity CALL AskAmbig(nchoice2(),nch,that) IF that THEN PRINT"Wait a sec---I'm getting confused. Let's start over from the beginning.":EXIT SUB PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT cmd$ = amb$ + cmd$:ambig = 1 ' (see above) GOTO GetThatClause2 ' Try to resolve ambiguity END IF END SUB ' Skips a clause of the form preposition-noun SUB SkipThatClause(cmd$) STATIC CALL SkipNoun(cmd$) CALL GetPrep(cmd$,a) CALL SkipNoun(cmd$) END SUB ' Attempts to resolve ambiguity by choosing only those ' items in array(,0) that are related to tn by mode tr ' (i.e., only objects that are "in" the "bottle", "on" the "table", etc.) SUB ResolveThat(array(2),nch,n,tr,tn) STATIC SHARED par(),rel(),mrel IF tn<0 THEN EXIT SUB IF tr<0 OR tr>mrel THEN EXIT SUB nnch = 0 FOR i = 1 TO nch IF array(i,0) < 0 THEN nnch = nnch + 1 array(nnch,1) = array(i,0) ELSEIF par(array(i,0)) = tn AND rel(array(i,0)) = tr THEN nnch = nnch + 1 array(nnch,1) = array(i,0) END IF NEXT nch = nnch FOR i = 1 TO nch array(i,0) = array(i,1) ' Copy array to position zero NEXT IF nch = 1 THEN n = array(1,0) END SUB Initialize: CLS PRINT"Welcome to "game$"! PRINT"One moment please . . ." DEF FNcap$(a$) = CHR$(ASC(a$) AND 223) + MID$(a$,2) z$ = CHR$(8) ' Stack for routines which recursively search object lists ' (Maximum stack depth 30) mdepth = 30 DIM cc(mdepth),mc(mdepth) ' General storage arrays for subroutines mlist = 50 DIM c1(mlist),c2(mlist) ' Read abstract descriptions RESTORE abstract READ mabs 'Maximum # of abstract nouns DIM abstract$(mabs),abstract(mabs) READ a WHILE (a <> 0) READ abstract$(a) READ a IF a > nabs THEN nabs = a WEND ' Read "folded" state RESTORE fold READ mfold DIM fold$(mfold) nfold = 0 READ f$ WHILE (f$ <> "") nfold = nfold + 1 fold$(nfold) = f$ READ f$ WEND ' Read verbs RESTORE Verbs DIM verb$(2) nverb = 0 FOR i = 0 TO 2 v = 1 WHILE (v <> 0) READ v$,v verb$(i) = verb$(i) + "," + v$ + "," + STR$(v) IF v > nverb THEN nverb = v WEND NEXT i ' Read verb attributes (verbs must be in order!) RESTORE Commands DIM reqnoun(1,nverb),defprep(nverb),nounat(1,nverb) DIM noundef(1,nverb),nounpl(1,nverb) FOR i = 1 TO nverb READ reqnoun(0,i),reqnoun(1,i),defprep(i),nounat(0,i),nounat(1,i) READ noundef(0,i),noundef(1,i),nounpl(0,i),nounpl(1,i) NEXT i '*** Set the null verb's "attributes" nounpl(0,0) = 2:nounpl(1,0) = 2 ' Read nouns RESTORE Nouns READ mnouns,mcode DIM nindex(mnouns),nhom(mnouns),ncode(mcode) noun$ = "" nnoun = 0 mhom = 0:REM maximum number of homonyms for any noun nbase = 0:REM start at base of ncode table code = 0 READ n$ WHILE (n$ <> "") noun$ = noun$ + "," + n$ + "," + STR$(nnoun) hom = 0 nindex(nnoun) = nbase READ code WHILE (code <> 0) ncode(nbase) = code nbase = nbase + 1 hom = hom + 1 READ code WEND nhom(nnoun) = hom IF hom > mhom THEN mhom = hom nnoun = nnoun + 1 READ n$ WEND ' Read prepositions RESTORE Prepositions prep$ = "" nprep = 0 READ p$ WHILE (p$ <> "") READ p nprep = nprep + 1 prep$ = prep$ + "," + p$ + "," + STR$(p) READ p$ WEND ' Read preposition names RESTORE Prepnames DIM prepn$(nprep) READ p$ nprepn = -1 WHILE (p$ <> "") nprepn = nprepn + 1 prepn$(nprepn) = p$ READ p$ WEND imap: ' Read map (see Locations: for details) PRINT"I am reading the map . . ." RESTORE map READ mloc,avdes,mmcond,mfcond,avfcond DIM map(mloc,9),Llight(mloc),Lon(mloc) DIM dindex(mloc),des$(mloc * avdes) DIM mcond(4,mloc),mmes$(mloc) DIM findex(mloc),fcond(5,mfcond),fdes$(mfcond * avfcond) REM N,NE,E,SE,S,SW,W,NW,U,D, water, light, lighton? nloc = 1:ndes = 0:nmcond = 0:nfcond = 0:nfcdes = 0 READ l WHILE (l <> 0) nloc = nloc + 1 IF nloc <> l THEN PRINT"MAP IS IN BAD FORMAT AT LOC"nloc:STOP cmcond = 0 ' Count the number of map cond. in this location FOR i = 0 TO 9 READ n IF (n < 0) AND (n > -99) THEN n = -n IF n > cmcond THEN cmcond = n map(l,i) = -nmcond - n ELSE map(l,i) = n END IF NEXT i READ Llight(l),Lon(l) FOR j = 1 TO cmcond ' Read map conditionals (if there are any) nmcond = nmcond + 1 FOR k = 0 TO 4 READ mcond(k,nmcond) NEXT k READ mmes$(nmcond) NEXT j dindex(l) = ndes READ des$(ndes) ' First line is short description (can be NULL) WHILE (des$(ndes) <> "") ' Succeeding lines are long descriptions ndes = ndes + 1 READ des$(ndes) WEND READ a,b,c,d findex(l) = nfcond + 1 WHILE (a <> -1) ' Read a flag conditional nfcond = nfcond + 1 fcond(0,nfcond) = a:fcond(1,nfcond) = b:fcond(2,nfcond) = c fcond(3,nfcond) = d:fcond(4,nfcond) = nfcdes READ fdes$(nfcdes) WHILE (fdes$(nfcdes) <> "") nfcdes = nfcdes + 1 READ fdes$(nfcdes) WEND READ a,b,c,d WEND READ l WEND dindex(nloc+1) = ndes:fcond(4,nfcond+1) = nfcdes ' Mark end of description lists findex(nloc+1) = nfcond + 1 ' and mark end of flag lists ' Read flags ' Flag 1 is lamp on/off, flag 2 is daytime/nighttime RESTORE Flags READ mflag nflag = 0 DIM flag(mflag) READ f WHILE (f) IF f>nflag THEN nflag = f READ flag(f),f WEND iobj: ' Read objects DIM Lfirst(nloc),Llast(nloc),seen(nloc) RESTORE Objects READ mobj,mrel,mbot DIM pre$(mobj),word$(mobj),adj$(mobj),long$(mobj) DIM lo(mobj),par(mobj),rel(mobj) DIM first(mrel,mobj),last(mrel,mobj),left(mobj),right(mobj) DIM size(mobj),opening(mrel,mobj),cap(mrel,mobj),opaque(mrel,mobj) DIM closed(mobj),openable(mobj) DIM folded(mobj),foldable(mobj),locked(mobj),holdwater(mobj) DIM worn(mobj),wearable(mobj),soft(mobj),food(mobj),immobile(mobj) DIM totw(mobj),totb(mobj),bulk(mrel,mobj) DIM bottles(mbot) nbot = -1 ' Keep a list of bottles ' Read objects nobj = 0 READ n WHILE (n <> 0) IF (n > nobj) THEN nobj = n READ pre$(n),word$(n),adj$(n),long$(n) READ lo(n),par(n),rel(n) READ size(n),wei FOR i = 0 TO mrel READ opening(i,n) NEXT i anycap = 0 FOR i = 0 TO mrel READ cap(i,n) anycap = anycap OR cap(i,n) NEXT i FOR i = 0 TO mrel READ opaque(i,n) NEXT i READ closed(n),openable(n),folded(n),foldable(n),locked(n) READ holdwater(n),worn(n),wearable(n),soft(n),food(n),immobile(n) IF holdwater(n) THEN nbot = nbot + 1:bottles(nbot) = n totw(n) = wei totb(n) = size(n) IF par(n) <> 0 OR immobile(n) = 0 OR anycap <> 0 THEN IF par(n) THEN CALL Insert(n,par(n),rel(n)) ELSE CALL Insert(n,-lo(n),0) END IF END IF READ n: REM next object WEND Arrays: ' Arrays hold homonyms for ambiguity resolution DIM nchoice(mhom + 2,1),nchoice2(mhom + 2,1) ' Arrays hold lists of nouns and objects DIM lnoun(1,mlist),nlnoun(1),ncount(1),olnoun(mlist) DIM mnoun(1,mlist),mlnoun(1),mcount(1) ' Commands can be superseded temporarily by other commands (e.g., ' if you say "wear hat" you must first "take" it; the program will ' automatically do this) But for the sake of the multiple-noun ' sequences, etc., the command must be restored to its original ' form, even if it has been superseded. Thus, you use RecordCommand ' and RestoreCommand to store this activity on a "command stack". ' The Alias() subprogram does this automatically for you. mrlev = 10 ' Maximum ten (!) levels of command stack DIM vo(mrlev),po(mrlev),no(mrlev,1) DIM vo$(mrlev),po$(mrlev),no$(mrlev,1),nno$(mrlev,1) ' Arrays hold the direct object and indirect object DIM n(1),n$(1),nn$(1) Initvals: GOSUB Flags ' Set mnemonic variables fdindex = 4 ' internal use constant (see Look:) fseen = 5 ' internal use constant (see SaveGame: and Look:) ' Setup starting values l = 2:ol = 2:REM You start in room 2 t = flag(tim):REM time is kept by flag variable "tim" GOSUB ClearCommand:FOR z = 0 TO 1:ncount(z) = 0:nlnoun(z) = 0:NEXT v = 1:REM "Look" is the first command v$ = "look" Player: maxcap = 15:maxweight = 50:REM Player's capacity, total weight capacity maxgrab = 20:maxlift = 40:REM Maximum size, weight, player can lift (see Take:) fat = 20:REM Size of player while sitting (3*fat is size when lying down) GOTO PreProcess NewCommand: rlev = 0 ' Clear command stack GOSUB RecordCommand GOSUB ClearCommand GOSUB ClearList ncmd$ = "":GOTO InCommand ContCommand: rlev = 0 ' Clear command stack GOSUB RecordCommand ncmd$ = "":GOTO InCommand GetCommand: rlev = 0 ' Clear command stack IF nlnoun(1) THEN '*** take care of multiple indirect objects ncount(1) = ncount(1) + 1 IF ncount(1) <= nlnoun(1) THEN n(1) = lnoun(1,ncount(1)) CALL NameNoun(n(1),n$(1),nn$(1)) PRINT p$" "nn$(1)": "; GOTO Filter END IF END IF IF nlnoun(0) THEN '*** take care of multiple direct objects ncount(0) = ncount(0) + 1 IF ncount(0) <= nlnoun(0) THEN ncount(1) = 1 IF nlnoun(1) THEN n(0) = lnoun(1,1) n(0) = lnoun(0,ncount(0)) CALL NameNoun(n(0),n$(0),nn$(0)) PRINT nn$(0)": "; GOTO Filter END IF END IF GOSUB RecordCommand GOSUB ClearCommand GOSUB ClearList InCommand: PRINT IF ncmd$ = "" THEN LINE INPUT"> ";cmd$:PRINT:cmd$ = cmd$ + " " ELSE GOSUB waitforesc:IF a$ = CHR$(27) THEN NewCommand cmd$ = ncmd$ END IF Parse: ' Take care of grammatical quirks a = INSTR(cmd$,".") ' Periods IF (a) THEN ncmd$ = MID$(cmd$,a+1) WHILE (MID$(ncmd$,1,1) = " ") ncmd$ = MID$(ncmd$,2) WEND cmd$ = LEFT$(cmd$,a-1) + " " ELSE ncmd$ = "" END IF a = INSTR(cmd$,",and ") ' Replace commas WHILE (a) cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+5) a = INSTR(cmd$,",and ") WEND a = INSTR(cmd$,", and ") WHILE (a) cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+6) a = INSTR(cmd$,", and ") WEND a = INSTR(cmd$,",") WHILE (a) cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+1) a = INSTR(cmd$,",") WEND WHILE (MID$(cmd$,1,1) = " ") ' Get rid of excess spaces cmd$ = MID$(cmd$,2) WEND Interpret: ' nn is the noun number (0 = direct obj, 1 = indirect obj) IF cmd$ = "" THEN PRINT"Say what?":GOTO ContCommand nlnoun(0) = 0:nlnoun(1) = 0 '*** stop multiple noun loops ocmd$ = cmd$:locmd=LEN(ocmd$) IF noobj THEN v = 0 '*** See Filter: for origin of noobj flag CALL GetVerb(cmd$,v,v$) IF noobj THEN IF v <> 0 AND v <> vo THEN vo=v:vo$=v$ GOSUB ClearCommand '*** User can override old verb v=vo:v$=vo$ ELSE v=vo END IF END IF IF cmd$ = "" THEN PreProcess IF noobj THEN InPrep ambig=0:but=0:cand=0:nch=0:that=0:nn=0 InNoun: CALL GetNoun(cmd$,nchoice(),nch,n(nn),nounat(nn,v),noundef(nn,v),that) IF nch = -1 THEN PRINT"I don't understand what you're talking about.":GOTO NewCommand IF nch = -2 THEN GOSUB Mystery:GOTO NewCommand IF nn = 0 THEN IF cmd$<>"" AND nounpl(1,v) = 0 THEN ' default "that" clause? tn=0:c=0:CALL GetPrep(cmd$,c) IF c > 0 AND c < 8 THEN tp=c:that=1:GOTO InThatClause ELSE ' Message for InPrep not to scan again for a preposition trp=c END IF END IF END IF IF that THEN ' "that" clause tp=0:tn=0 InThatClause: IF nch = 0 THEN CALL SkipThatClause(cmd$) ELSE CALL GetThatClause(cmd$,tp,tn) IF tp = -1 THEN Parse IF tp = -2 THEN NewCommand IF ambig = 1 AND tn = 0 THEN 'Ambig resolution failed, so GOTO Parse ' assume player overrided old command and start over END IF IF tp < 0 OR tp > 4 OR tn = 0 THEN IF cmd$ <> "" THEN PRINT"I don't know what you mean by '"cmd$"'. GOTO NewCommand ELSE PRINT"That's . . . what?" ' Try to resolve ambiguity PRINT:LINE INPUT"> ";cmd$:cmd$=cmd$+" ":PRINT ambig=1:GOTO InThatClause END IF END IF CALL ResolveThat(nchoice(),nch,n(nn),tp-1,tn) IF nch = 0 THEN GOSUB Mystery:GOTO NewCommand END IF END IF IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so cmd$=amb$ ' assume that the player overrided the old command, and GOTO Parse ' start over ELSE ambig = 0 ' Clear AskAmbig flag END IF IF nch > 1 THEN ' Ask player to resolve ambiguity that = 0:CALL AskAmbig(nchoice(),nch,that) PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT cmd$ = amb$ + cmd$:ambig = 1 ' (see above) GOTO InNoun ' Try to resolve ambiguity END IF IF nch THEN IF n(nn) = -12 THEN ' Resolve pronoun ambiguity IF no(0,1) > 0 THEN ' Choose last noun referenced n(nn)=no(0,1) ELSEIF no(0,0) > 0 THEN n(nn)=no(0,0) ELSE n(nn)=0 END IF IF n(nn) <> 0 THEN CALL NameNoun(n(nn),n$,nn$) IF nn = 0 THEN PRINT"("nn$") ELSE PRINT"("p$" "nn$") END IF END IF END IF IF but = 0 THEN ' "and" clause IF n(nn) = -11 THEN ' this is the "all" noun na = noundef(nn,v):IF na = 0 THEN na = 3 IF that = 1 AND tp > 0 AND tn > 0 THEN ' everything that's in ... that = 0 CALL Visible(tn,vis,0) IF vis = 0 THEN GOSUB Mystery:GOTO NewCommand ' Place test particle in tn, relation tp-1, to see if ' stuff in there is visible or not lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1 CALL Visible(0,vis,0) IF vis THEN ThatAgain: CALL ListSib(first(tp-1,tn),lnoun(),nlnoun(),nn) ELSE IF closed(tn) THEN PRINT"(opening the "word$(tn)" first): "; CALL Alias("open",8,(tn),0,0):GOSUB OpenIt GOSUB RestoreCommand lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1 CALL Visible(0,vis,0) IF vis=0 THEN NewCommand ELSE GOTO ThatAgain ELSE GOSUB Mystery:GOTO NewCommand END IF END IF ELSE IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),nn) IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),nn) END IF IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1) ELSEIF n(nn) = -13 THEN ' plural pronoun IF ncount(nn) = 0 THEN FOR i = 1 TO onlnoun nlnoun(nn) = nlnoun(nn) + 1 lnoun(nn,nlnoun(nn)) = olnoun(i) NEXT IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1) END IF ELSEIF n(nn) <> 0 THEN nlnoun(nn) = nlnoun(nn) + 1 lnoun(nn,nlnoun(nn)) = n(nn) END IF ELSE '"but" clause IF n(nn) = -11 THEN PRINT"You humans have a strange way of speaking.":GOTO NewCommand IF n(nn) = -13 THEN ' plural pronoun FOR i = 1 TO onlnoun a = 0 FOR j = 1 TO nlnoun(nn) IF lnoun(nn,j) = olnoun(i) THEN a=1:nlnoun(nn)=nlnoun(nn)-1 IF a THEN lnoun(nn,i) = lnoun(nn,i+1) NEXT NEXT ELSE ' single word a = 0 FOR i = 1 TO nlnoun(nn) IF lnoun(nn,i) = n(nn) THEN a = 1:nlnoun(nn) = nlnoun(nn) - 1 IF a THEN lnoun(nn,i) = lnoun(nn,i+1) NEXT END IF IF nlnoun(nn) THEN n(nn) = lnoun(nn,1) ELSE n(nn) = 0 END IF ELSE IF cand = 1 THEN ncmd$ = cmd$+"."+ncmd$:cmd$ = "":GOTO PreProcess END IF IF cmd$ = "" THEN PreProcess InPrep: lcmd = LEN(cmd$) c = 0:IF trp THEN c=trp:trp=0 ELSE CALL GetPrep(cmd$,c) IF c = 0 THEN PreProcess IF c < 8 AND nn = 0 THEN p = c:ploc = locmd-lcmd ' Record prep location IF cmd$ = "" THEN PreProcess IF (c = 8 AND nn = 0 AND n(0) = 0) THEN ncmd$ = cmd$ + "." + ncmd$ cmd$ = "" GOTO PreProcess END IF IF c = 8 THEN cand = 1:nch = 0:that = 0:GOTO InNoun ' and ... IF c = 9 THEN but = 1:nch = 0:that = 0:GOTO InNoun ' but ... IF nn = 1 THEN ' What!? Insert a "that's" and start over IF warnthat < 3 THEN warnthat = warnthat + 1 PRINT"(Please use more specific language in the future, e.g., PRINT CHR$(34)LEFT$(ocmd$,ploc)"THAT'S "MID$(ocmd$,ploc+1)CHR$(8)CHR$(34)"-Ed.) END IF GOSUB ClearCommand:GOSUB ClearList cmd$ = LEFT$(ocmd$,ploc)+"that's "+MID$(ocmd$,ploc+1) ocmd$ = cmd$:locmd = LEN(ocmd$) GOTO Parse END IF nn = 1:but = 0:cand = 0:nch = 0:that = 0:GOTO InNoun 'Get indirect object PreProcess: nn = 0:p$ = prepn$(p) FOR i = 0 TO 1 IF n(i) <> 0 THEN CALL NameNoun(n(i),n$(i),nn$(i)) NEXT IF cmd$ <> "" THEN cmd$ = LEFT$(cmd$,LEN(cmd$) - 1) PRINT"I don't know what you mean by '"cmd$CHR$(8)"'. GOTO NewCommand END IF FOR i = 0 TO 1 IF nlnoun(i) = 1 THEN nlnoun(i) = 0 NEXT FOR i = 0 TO 1 IF nlnoun(i) THEN IF nounpl(i,v) < 2 THEN PRINT"You can't use multiple "; IF i = 1 THEN PRINT"indirect "; PRINT"objects with '"v$"'! GOTO NewCommand END IF END IF NEXT IF nlnoun(0) > 0 OR nlnoun(1) > 0 THEN GetCommand Filter: '*** grammatical replacements IF (n(0)<0) AND (n(0)>=-10) AND (v = 0) THEN v = 6: v$="go" IF v = 3 THEN IF n(1) <> 0 THEN v = 7 ' "drop xxx on yyy" == "put xxx on yyy" IF v = 0 AND n(0) = 0 AND n(1) = 0 THEN PRINT"I don't understand.":GOTO NewCommand FOR i = 0 TO 1 IF n(i) <> 0 AND nounpl(i,v) = 0 THEN PRINT"You can't use "; IF i = 1 THEN PRINT"indirect "; PRINT"objects with '"v$"'! GOTO NewCommand END IF NEXT IF v = 0 AND n(0) <> 0 THEN PRINT"What do you want to do with "nn$(0)"? GOTO ContCommand END IF IF v = 0 AND n(1) <> 0 THEN PRINT". . . "prepn$(p)" "nn$(1)"? GOTO ContCommand END IF FOR i = 0 TO 1 IF reqnoun(i,v) THEN na = noundef(i,v):IF na = 0 THEN na = 3 IF n(i) = 0 THEN IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),i) IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),i) IF nlnoun(i) = 1 THEN n(i) = lnoun(i,1):ncount(i) = 1 CALL NameNoun(n(i),n$(i),nn$(i)) IF i = 0 THEN PRINT"("nn$(i)") ELSE IF p = 0 THEN p = defprep(v):p$ = prepn$(p) PRINT"("p$" "nn$(i)") END IF ELSE IF i = 0 THEN PRINT FNcap$(v$)" what?":GOTO ContCommand ELSE IF p = 0 THEN p = defprep(v):p$ = prepn$(p) PRINT FNcap$(v$)" "nn$(0)" "p$" what?":noobj = 1:GOTO ContCommand END IF END IF END IF CALL Visible(n(i),vis,0) IF vis = 0 THEN CALL CantSee(nn$(i)):GOTO GetCommand IF reqnoun(i,v) = 2 THEN ' Check physical accessibility pa = par(n(i)) TryAvail: CALL Avail(n(i),ava,0) IF ava = 0 THEN ' Try to open next parent up if still not accessible IF pa = 0 OR closed(pa) = 0 THEN ToNoAvail CALL Visible(pa,vis,0):IF vis = 0 THEN ToNoAvail PRINT"(opening the "word$(pa)" first): "; CALL Alias("open",8,(pa),0,0):GOSUB OpenIt GOSUB RestoreCommand IF closed(pa) <> 0 THEN ToNoAvail pa = par(pa):GOTO TryAvail ToNoAvail: CALL CantGetAt(nn$(i)):GOTO GetCommand END IF END IF END IF NEXT FOR i = 0 TO 1 IF nounat(i,v) THEN IF n(i) < 0 THEN GOSUB Absurd:GOTO GetCommand ELSEIF nounat(i,v) = 1 AND n(i) > 0 THEN IF lo(n(i)) <> 1 THEN CALL Avail(n(i),ava,2) IF ava = 0 THEN CALL DontHave(nn$(i)):GOTO GetCommand PRINT"(taking "nn$(i)" first): "; CALL Alias("get",2,(n(i)),0,0):GOSUB Take GOSUB RestoreCommand IF lo(n)<>1 THEN NewCommand END IF END IF END IF NEXT DoCommand: ' The variables n and o hold the values of n(0) and n(1), respectively ' (the direct and indirect object). These variables are used as a ' kind of shorthand to make the verb routines easier to read. n = n(0):o = n(1) ' See PostProcess for the meaning of the ask flag (set by the verb routine) ask = 0 IF v = 0 OR v > 33 THEN PRINT"DoCommand: Unrecognized verb '"v$"', code"STR$(v)". GOTO PostProcess END IF IF v < 6 THEN ON v GOSUB Look,Take,Drop,Inventory,Examine:GOTO PostProcess IF v < 11 THEN ON v - 5 GOSUB go,Place,OpenIt,CloseIt,Lock:GOTO PostProcess IF v < 16 THEN ON v - 10 GOSUB Unlock,TurnOn,TurnOff,Wordy,Brief:GOTO PostProcess IF v < 21 THEN ON v - 15 GOSUB Superbrief,SaveGame,LoadGame,PutOn,TakeOff:GOTO PostProcess IF v < 26 THEN ON v - 20 GOSUB Wrap,UnWrap,Restart,Again,Empty:GOTO PostProcess IF v < 31 THEN ON v - 25 GOSUB Fill,Eat,Drink,Sit,Stand:GOTO PostProcess IF v < 36 THEN ON v - 30 GOSUB Lie,QuitGame,DrinkAll:GOTO PostProcess PostProcess: ON ask GOTO ContCommand,NewCommand,Interpret t = t + 1:flag(tim) = t ' Time marches on . . . ol = l ' Keep track of where we are GOTO GetCommand ' Record last command on the command stack (push command stack) RecordCommand: vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$ FOR z = 0 TO 1 no(rlev,z) = n(z):no$(rlev,z) = n$(z):nno$(rlev,z) = nn$(z) NEXT rlev = rlev + 1 RETURN ' Clear current command (clear top of stack) ClearCommand: v$ = "":p$ = "" v = 0:n = 0:p = 0:o = 0 FOR z = 0 TO 1 n(z) = 0:n$(z) = "":nn$(z) = "" NEXT ' Reset interpreter flags noobj = 0 RETURN ' Clear and record multiple noun lists ClearList: z1 = 0:onlnoun = nlnoun(0):IF nlnoun(1) THEN onlnoun = nlnoun(1):z1 = 1 FOR z = 1 TO onlnoun olnoun(z) = lnoun(z1,z) NEXT FOR z = 0 TO 1 nlnoun(z) = 0:ncount(z) = 0 NEXT RETURN ' Restore recorded command (pop command stack) RestoreCommand: rlev = rlev - 1:IF rlev < 0 THEN rlev = 0 v$ = vo$(rlev):p$ = po$(rlev) v = vo(rlev):p = po(rlev) FOR z = 0 TO 1 n(z) = no(rlev,z):n$(z) = no$(rlev,z):nn$(z) = nno$(rlev,z) NEXT n = n(0):o = n(1) RETURN ' Pushes the command stack with a new command SUB Alias(av$,av,n0,ap,n1) STATIC SHARED n(),vo(),no(),po() SHARED vo$(),n$(),nn$(),nno$(),no$(),po$(),prepn$() SHARED v$,v,n,p,p$,o,rlev vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$ FOR i = 0 TO 1 no(rlev,i) = n(i):no$(rlev,i) = n$(i):nno$(rlev,i) = nn$(i) NEXT rlev = rlev + 1 v$ = "":p$ = "" v = 0:n = 0:p = 0:o = 0 FOR i = 0 TO 1 n(i) = 0:n$(i) = "":nn$(i) = "" NEXT v$=av$:v=av:n(0)=n0:n(1)=n1:IF ap THEN p=ap:p$=prepn$(p) IF n(0) THEN CALL NameNoun(n(0),n$(0),nn$(0)) IF n(1) THEN CALL NameNoun(n(1),n$(1),nn$(1)) n=n(0):o=n(1) END SUB Commands: ' The first DATA statement for each verb has the following ' meaning: ' ' DATA require_direct_object?,require_indirect_object?,defaultprep? ' ' The first two numbers have the following meanings: ' 0 - not required ' 1 - must be visible (see Calc:Visible()) ' 2 - must be physically accessible (see Calc:Avail()) ' ' defaultprep? is either 0 for no default preposition,or a prep number ' (see Prepositions:) ' ' The next line is: ' ' DATA direct_object_location?,indirect_object_location? ' ' 0 - no checking done ' 1 - player must be carrying the item ' 2 - the item should be in the same location as the player ' ' The third line means: ' ' DATA direct_obj_default_location?,indirect_obj_default_location? ' ' The codes are the same as above, except that these are used in the ' "verb all" and "verb what?" ambiguity resolution routines to determine ' where to look. This is usually the same as above, but in some cases ' the verb is *usually* used for one purpose but may be used for another; ' e.g., "get" which is usually used to get objects from the room but ' may be used to get an object out of a container the player is ' carrying. In this case the default (room) is different from the ' required (either room or player). ' ' The fourth means: ' ' DATA number_direct_objects?,number_indirect_objects? ' ' If the number is 0, can have no nouns. ' If 1, can only have a single noun. ' If 2, can have single and plural (no checking is done). ' ' Finally, if the verb wishes to ask a question or report an error, ' the flag 'ask' can be set to the following values: ' 1 - return to input line but keep context (as in "get what?") ' 2 - return to input line (interrupt a multiple-command line) ' (usually used after some error message has been given) ' (throw away context) ' 3 - go to Interpret after returning, and reprocess the ' verb, noun, object codes (see Again:) ' ' See PreProcess:, DoCommand:, and PostProcess: Look: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 IF l = 0 THEN PRINT"Can't go that way.":l = ol:RETURN IF map(l,0) <> -99 THEN CALL CheckLight(flag(1)) IF (flag(1) = 0) THEN PRINT"It's too dark to see.":RETURN END IF IF (l > nloc) OR l < 2 THEN PRINT"You are in room "l", which is manifestly impossible. RETURN END IF ' Display description ' This code can be changed to get a description off of a random file ' from disk longdes = 0 IF dindex(l) <> dindex(l+1) THEN IF des$(dindex(l)) <> " " THEN PRINT des$(dindex(l)) IF ((seen(l) = 0 OR flag(verbose) = 1 OR v = 1) AND flag(verbose) <> -1) OR des$(dindex(l)) = " " THEN longdes = 1 ' We are printing the long description FOR i = dindex(l) + 1 TO dindex(l + 1) - 1 IF des$(i) = "z" THEN GOSUB waitforkey ELSE PRINT des$(i) END IF NEXT i seen(l) = 1 'Jack was here END IF END IF ' Display conditional descriptions FOR i = findex(l) TO findex(l + 1) - 1 CALL EvalCond(fcond(0,i),fcond(1,i),fcond(2,i),true) IF true AND ((fcond(3,i) AND 1) <> 0 OR longdes = 1) AND NOT ((fcond(3,i) AND 1)= 0 AND flag(verbose) = -1) THEN IF (fcond(3,i) AND 2) = 0 OR fcond(fseen,i) = 0 THEN ' Check for one-time-only FOR j = fcond(fdindex,i) TO fcond(fdindex,i + 1) - 1 IF fdes$(j) = "z" THEN GOSUB waitforkey ELSE PRINT fdes$(j) END IF NEXT j fcond(fseen,i) = 1 ' We've seen this one now END IF END IF NEXT IF Lfirst(l) THEN PRINT"Here, you see: CALL Contents(Lfirst(l),3,0) END IF ' Check for forced move IF map(l,0) = -99 THEN CALL EvalCond(map(l,1),map(l,2),map(l,3),true) IF true THEN nl = map(l,4) ELSE nl = map(l,5) IF nl = -99 THEN l = ol ' Bounce back RETURN ELSE l = nl ' Don't want absurd negative locations PRINT GOTO Look ' Describe new location END IF END IF RETURN waitforesc: PRINT"[press any key or ESC]";:GOTO getkey waitforkey: PRINT"[press any key]"; getkey: a$ = INKEY$ WHILE(a$ = "") a$ = INKEY$ WEND ' Erase message PRINT z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$; RETURN Take: DATA 2,0,0 DATA 0,0 DATA 2,0 DATA 2,0 IF n > 0 THEN IF holdwater(n) = 2 THEN CALL ListBottles(c1(),a) IF a = 0 THEN PRINT"You don't have anything to hold the water.":RETURN IF a > 1 THEN PRINT"Put the water in what? v=7:v$="put":p=1:p$="in" ask=1 RETURN END IF CALL Alias("fill",26,c1(0),6,(n)):GOSUB Fill GOSUB RestoreCommand RETURN END IF END IF IF n < 0 THEN GOSUB Cannot:RETURN IF immobile(n) THEN GOSUB Absurd:RETURN IF lo(n) = 1 AND par(n) = 1 THEN PRINT"You already have "nn$(0)"!":RETURN IF totw(n) > maxlift THEN PRINT FNcap$(nn$(0))" is too heavy to lift.":RETURN IF totb(n) > maxgrab THEN PRINT FNcap$(nn$(0))" is too big to get a hold of.":RETURN IF totw(n) + totw(1) > maxweight THEN PRINT"Your load is too heavy.":RETURN IF totb(n) + bulk(1,1) > maxcap THEN PRINT"Your load is too bulky.":RETURN CALL Remove(n) CALL Insert(n,1,1) PRINT"Taken." RETURN Drop: DATA 1,0,0 DATA 0,0 DATA 1,0 DATA 2,1 IF n < 0 THEN GOSUB Cannot:RETURN IF immobile(n) THEN GOSUB Cannot:RETURN IF lo(n) <> 1 THEN CALL DontHave(nn$(0)):RETURN CALL Avail(n,ava,0) IF ava = 0 THEN CALL CantGetAt(nn$(0)):RETURN ELSEIF ava = -1 THEN PRINT"You can't get "nn$(0)" out.":RETURN END IF IF holdwater(n) = 2 THEN IF par(n) = 0 THEN PRINT"Something's wrong here. ELSE CALL Alias("pour out",25,(par(n)),0,0):GOSUB Empty GOSUB RestoreCommand RETURN END IF ELSE CALL Remove(n) CALL Insert(n,-l,0) worn(n) = 0 PRINT"Dropped. END IF RETURN Inventory: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 IF sat>0 THEN PRINT"(you are sitting on the "word$(sat)".) IF sat<0 THEN PRINT"(you are lying on the "word$(-sat)".) CALL Contents(1,0,0) IF first(1,1) = 0 THEN PRINT"You are carrying nothing. RETURN Examine: DATA 1,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n = -20 THEN GOSUB Inventory:RETURN IF n < 0 OR long$(n) = "" THEN PRINT"You see nothing unusual about "nn$(0)".":RETURN END IF PRINT long$(n) IF openable(n) THEN IF closed(n) THEN PRINT FNcap$(nn$(0))" is closed. ELSE PRINT FNcap$(nn$(0))" is open. END IF END IF IF folded(n) THEN PRINT FNcap$(nn$(0))" is "fold$(folded(n))". IF n = 7 AND lampon = 1 THEN PRINT"The lamp is on. CALL Contents(n,0,1) '*** List what's related to it, if anything RETURN go: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 1,0 IF n = 0 THEN PRINT"Which way do you want to "v$"?":ask = 1:RETURN IF n > 0 THEN GOSUB Absurd:RETURN nl = map(l,-n-1) IF nl < 0 THEN ' Map conditional i = -nl CALL EvalCond(mcond(0,i),mcond(1,i),mcond(2,i),true) IF true THEN nl = mcond(3,i) ELSE IF mmes$(i) <> "" THEN PRINT mmes$(i) nl = mcond(4,i) IF nl = l THEN RETURN IF mmes$(i) <> "" THEN PRINT END IF END IF ol = l:l = nl GOTO Look Place: DATA 2,2,1 DATA 1,0 DATA 1,0 DATA 2,1 mode = p - 1 IF mode = 1 THEN GOTO Wrap IF n > 0 THEN IF holdwater(n) = 2 AND holdwater(o) = 1 THEN CALL Alias("fill",26,(n(1)),6,(n(0))):GOSUB Fill GOSUB RestoreCommand RETURN END IF END IF IF n < 0 OR o < 0 THEN GOSUB Cannot:RETURN IF immobile(n) THEN GOSUB Absurd:RETURN IF cap(mode,o) = 0 THEN GOSUB Cannot:RETURN IF mode = 0 THEN IF holdwater(n) = 2 THEN PRINT FNcap$(nn$(1))" won't hold water.":RETURN IF holdwater(n) = 0 THEN IF holdwater(first(0,o))=2 THEN PRINT"You can't put anything in "nn$(1)", there's water in it. RETURN END IF END IF f = 0:IF folded(o) THEN f = 1 IF (openable(o) <> 0 AND closed(o) <> 0) OR f = 1 THEN 'try to open o PRINT"(opening "nn$(1)" first): CALL Alias("open",8,(n(1)),0,0):GOSUB OpenIt GOSUB RestoreCommand IF (openable(o)<>0 AND closed(o)<>0) OR folded(o)<>0 THEN RETURN PRINT"(then, putting "nn$(0)" "p$" "nn$(1)"): "; IF f THEN mode=2:p$="on" END IF END IF IF totb(n) > opening(mode,o) THEN PRINT FNcap$(nn$(0))" won't fit "p$" "nn$(1)". RETURN END IF IF totb(n) + bulk(mode,o) > cap(mode,o) THEN PRINT FNcap$(nn$(0))" won't fit; there's too much already "p$" "nn$(1)". RETURN END IF IF n = o THEN GOSUB Cannot:RETURN ' Can't put stuff in clothing that you're wearing on your head (e.g. hats) IF mode = 0 AND (worn(o) AND 2) <> 0 THEN PRINT"You can't put anything in "nn$(1)"; you're wearing it.":RETURN END IF IF rel(n) = mode AND par(n) = o THEN PRINT FNcap$(nn$(0))" is already "p$" "nn$(1)"!":RETURN END IF CALL Inside(o,n,ins,rel) 'Don't want to make n a descendant of itself IF ins THEN PRINT"But "nn$(1)" is "prepn$(rel + 1)" "nn$(0)"!":RETURN CALL Remove(n) CALL Insert(n,o,mode) worn(n) = 0 IF mode = 0 AND first(2,n) <> 0 THEN PRINT"Done, but everything that was on top of "nn$(0)" falls off inside PRINT nn$(1)". CALL Tumble(n) ELSE PRINT"Done. END IF RETURN OpenIt: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF folded(n) THEN GOTO UnWrap IF openable(n) = 0 THEN GOSUB Cannot:RETURN IF locked(n) THEN PRINT"(trying to unlock "nn$(0)" first) CALL Alias("unlock",11,(n(0)),0,0):GOSUB Unlock GOSUB RestoreCommand IF locked(n) THEN RETURN PRINT"(then, proceeding . . .) END IF IF closed(n) = 0 THEN PRINT FNcap$(nn$(0))" is already open.":RETURN closed(n) = 0 IF first(0,n) <> 0 AND (opaque(0,n) <> 0) THEN PRINT"Opening "nn$(0)" reveals: CALL Contents(n,0,2) ELSE PRINT FNcap$(nn$(0))" is now open. END IF RETURN CloseIt: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF openable(n) = 0 THEN IF foldable(n) THEN GOTO Wrap ELSE GOSUB Cannot:RETURN END IF IF closed(n) THEN PRINT FNcap$(nn$(0))" is already closed.":RETURN closed(n) = 1 PRINT FNcap$(nn$(0))" is now closed. RETURN Lock: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN PRINT"Don't know how to lock that. RETURN Unlock: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN PRINT"Don't know how to unlock that. RETURN TurnOn: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF n <> lamp THEN GOSUB Cannot:RETURN IF flag(lampon) THEN PRINT FNcap$(nn$(0))" is already on.":RETURN flag(lampon) = 1 PRINT FNcap$(nn$(0))" is now on. RETURN TurnOff: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF n <> lamp THEN GOSUB Cannot:RETURN IF flag(lampon) = 0 THEN PRINT FNcap$(nn$(0))" is already off.":RETURN flag(lampon) = 0 PRINT FNcap$(nn$(0))" is now off. RETURN Wordy: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 flag(verbose) = 1 PRINT"I shall use long descriptions. RETURN Brief: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 flag(verbose) = 0 PRINT"Brief descriptions. RETURN Superbrief: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 flag(verbose) = -1 PRINT"Superbrief. RETURN SaveGame: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 2,0 LINE INPUT"Save to file? ";file$ ON ERROR GOTO Saverr cantopen = 0 1000 OPEN file$ FOR OUTPUT AS 1 1010 PRINT#1, dataformat$ ' Version number to verify format (see Initialize:) ' Write out globals PRINT#1, "GLOBAL" WRITE#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat ' Write out flags PRINT#1, "FLAGS" WRITE#1, nflag FOR i = 0 TO nflag WRITE#1, flag(i) NEXT ' Write out objects PRINT#1, "OBJS" WRITE#1, nobj,mrel FOR i = 0 TO nobj WRITE#1, lo(i),par(i),rel(i) FOR j = 0 TO mrel PRINT#1, first(j,i) NEXT FOR j = 0 TO mrel PRINT#1, last(j,i) NEXT WRITE#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i) WRITE#1, totw(i),totb(i) FOR j = 0 TO mrel PRINT#1, bulk(j,i) NEXT NEXT i ' Write out locations PRINT#1, "LOCS" PRINT#1, nloc FOR i = 0 TO nloc WRITE#1, Lfirst(i),Llast(i),Lon(i) NEXT i ' Write out flag conditionals PRINT#1, "FLAGCONDS" PRINT #1,nfcond FOR i = 0 TO nfcond PRINT#1, fcond(fseen,i) NEXT ' End marker PRINT#1, "END" PRINT:PRINT"Done. EndSave: ON ERROR GOTO 0 IF cantopen = 0 THEN CLOSE 1 RETURN Saverr: IF ERL = 1000 THEN cantopen = 1 PRINT"Can't open'"file$"'! ELSE PRINT"Disk error while saving game. Aborting save. END IF RESUME EndSave LoadGame: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 LINE INPUT"Enter name of saved game: ";file$ ON ERROR GOTO Loaderr cantopen = 0:okay = 0 2000 OPEN file$ FOR INPUT AS 1 2010 INPUT#1, a$ IF a$ <> dataformat$ THEN AbortLoad ' Load constants INPUT#1, a$:IF a$ <> "GLOBAL" THEN AbortLoad INPUT#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat ' Load flags INPUT#1, a$:IF a$ <> "FLAGS" THEN AbortLoad INPUT#1, nflag FOR i = 0 TO nflag INPUT#1, flag(i) NEXT ' Load objects INPUT#1, a$:IF a$ <> "OBJS" THEN AbortLoad INPUT#1, nobj,mrel FOR i = 0 TO nobj INPUT#1, lo(i),par(i),rel(i) FOR j = 0 TO mrel INPUT#1, first(j,i) NEXT FOR j = 0 TO mrel INPUT#1, last(j,i) NEXT INPUT#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i) INPUT#1, totw(i),totb(i) FOR j = 0 TO mrel INPUT#1, bulk(j,i) NEXT NEXT i ' Load locations INPUT#1, a$:IF a$ <> "LOCS" THEN AbortLoad INPUT#1, nloc FOR i = 0 TO nloc INPUT#1, Lfirst(i),Llast(i),Lon(i) NEXT i ' Load flag conditionals info INPUT#1, a$:IF a$ <> "FLAGCONDS" THEN AbortLoad INPUT#1, nfcond FOR i = 0 TO nfcond INPUT#1, fcond(fseen,i) NEXT PRINT:PRINT"Done.":okay = 1 EndLoad: ON ERROR GOTO 0 IF cantopen = 0 THEN CLOSE 1 IF okay THEN Look RETURN AbortLoad: PRINT"Saved game is in wrong format (shouldn't have read '"a$"'). PRINT"Aborting. GOTO EndLoad Loaderr: IF ERL = 2000 THEN cantopen = 1 PRINT"Can't open'"file$"'! ELSE PRINT"Disk error while loading game. END IF RESUME EndLoad PutOn: DATA 2,0,0 DATA 1,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF wearable(n) = 0 THEN GOSUB Cannot:RETURN IF worn(n) <> 0 THEN PRINT"You're already wearing "nn$(0)"!":RETURN worn(n) = wearable(n) CALL Remove(n) CALL Insert(n,1,0) PRINT"You are now wearing "nn$(0)". RETURN TakeOff: DATA 2,0,0 DATA 1,0 DATA 1,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF wearable(n) = 0 THEN GOSUB Absurd:RETURN IF worn(n) = 0 THEN PRINT"You're not wearing "nn$(0)".":RETURN dropflag = 0 IF totb(n) + totb(1) > maxcap OR totw(n) + totb(1) > maxweight THEN PRINT"You're carrying too much already, you'll have to drop something first. RETURN END IF IF totw(n) > maxlift OR totb(n) > maxgrab THEN PRINT"You take off "nn$(0)", but you fumble with it and it falls. worn(n) = 0 PRINT FNcap$(nn$(0))": "; GOTO Drop END IF worn(n) = 0 CALL Remove(n) CALL Insert(n,1,1) PRINT"You are now no longer wearing "nn$(0)". RETURN Wrap: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,1 IF n < 0 OR o < 0 THEN GOSUB Absurd:RETURN IF o <> 0 AND p <> 1 AND p <> 3 AND p <> 6 THEN GOSUB Absurd:RETURN IF o <> 0 THEN CALL Avail(o,ava,0) IF ava = 0 THEN CALL CantGetAt(nn$(1)):RETURN END IF IF o = 0 THEN o = n:n(1) = n(0):n = 0:n(0) = 0:nn$(1) = nn$(0) IF foldable(o) = 0 OR cap(1,o) = 0 THEN GOSUB Absurd:RETURN IF folded(o) THEN PRINT FNcap$(nn$(1))" is already "fold$(folded(o))". RETURN END IF IF bulk(0,o) THEN PRINT"You can't wrap anything with "nn$(1)"; there's something in it. RETURN END IF IF worn(o) THEN PRINT"(taking off "nn$(1)" first): CALL Alias("take off",20,(n(1)),0,0):GOSUB TakeOff GOSUB RestoreCommand IF (worn(n)) THEN RETURN PRINT"(then, proceeding . . .) END IF IF n = 0 THEN IF bulk(2,o) > cap(1,o) THEN PRINT FNcap$(nn$(1))" isn't big enough to wrap what's on it. RETURN END IF CALL RemList(o,2,head) CALL Concat(head,o,1) ELSE IF totb(n) > cap(1,o) THEN PRINT FNcap$(nn$(1))" isn't big enough to wrap "nn$(0)". RETURN END IF CALL Remove(n) CALL Insert(n,o,1) END IF folded(o) = foldable(o) PRINT"Done. RETURN UnWrap: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n < 0 THEN GOSUB Absurd:RETURN IF foldable(n) = 0 THEN GOSUB Absurd:RETURN IF folded(n) = 0 THEN PRINT FNcap$(nn$(0))" isn't "fold$(foldable(n))".":RETURN folded(n) = 0 tumb = (bulk(1,n) > cap(2,n)) CALL RemList(n,1,head) IF tumb THEN PRINT"When you open "nn$(0)", everything in it falls out. CALL Concat(head,-l,0) ELSE IF head <> 0 THEN PRINT"Opening "nn$(0)" reveals: CALL Contents(head,3,0) CALL Concat(head,n,2) ELSE PRINT"Opened. END IF END IF RETURN Restart: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 LINE INPUT"Start over from the beginning? (Are you sure?) >";a$ IF LEFT$(a$,1) = "y" THEN RUN PRINT:PRINT"Okay. RETURN Again: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 cmd$ = ocmd$:ask = 3:RETURN Empty: DATA 2,0,1 DATA 1,0 DATA 1,2 DATA 2,1 IF n<0 OR o<0 THEN GOSUB Absurd:RETURN IF p THEN IF p<>1 THEN GOSUB Cannot:RETURN IF holdwater(n)=2 THEN c=n-1 ELSE c=n IF holdwater(c)=0 THEN ' Place test particle inside n, to see if ' stuff in there is visible or not lo(0) = l:par(0) = c:rel(0) = 0 CALL Visible(0,vis,0) IF vis THEN Empty1: mlnoun(0) = 0 CALL ListSib(first(0,c),mnoun(),mlnoun(),0) IF mlnoun(0) = 0 THEN PRINT FNcap$(nn$(0))" is empty. RETURN END IF ELSE IF closed(c) THEN PRINT"(opening "nn$(0)" first): "; CALL Alias("open",8,c,0,0):GOSUB OpenIt GOSUB RestoreCommand lo(0)=l:par(0)=c:rel(0)=0 CALL Visible(0,vis,0) IF vis=0 THEN RETURN ELSE GOTO Empty1 ELSE GOSUB Mystery:GOTO NewCommand END IF END IF FOR emptyi=1 TO mlnoun(0) PRINT"the "word$(mnoun(0,emptyi))": "; CALL Alias("drop",3,mnoun(0,emptyi),0,0):GOSUB Drop GOSUB RestoreCommand NEXT RETURN END IF IF bulk(0,c) = 0 THEN PRINT"The "word$(c)" is empty.":RETURN IF par(c)<>1 THEN PRINT"(taking out the "word$(c)" first): "; CALL Alias("take out",2,c,0,0):GOSUB Take GOSUB RestoreCommand IF par(c)<>1 THEN RETURN END IF IF closed(c) THEN PRINT"(opening the "word$(c)" first): CALL Alias("open",8,c,0,0):GOSUB OpenIt GOSUB RestoreCommand IF closed(c) THEN RETURN END IF IF o THEN IF holdwater(o) = 2 THEN d=o-1 ELSE d=o amt = bulk(0,c) CALL Fill(d,amt) CALL Fill(c,-amt) IF bulk(0,c)<>0 THEN PRINT"You fill up the "word$(d)" with some water from the "word$(c)".":RETURN PRINT"You empty the "word$(c)" completely into the "word$(d)". ELSE CALL Empty(c) PRINT"The water pours out and evaporates. END IF RETURN Fill: DATA 2,2,6 DATA 1,0 DATA 1,2 DATA 2,1 IF n<0 OR (p<>6 AND p<>7) THEN GOSUB Absurd:RETURN IF holdwater(o) = 1 THEN w=o+1 ELSE w=o IF holdwater(n)<>1 OR holdwater(w)<>2 THEN CALL Alias("put",7,w,1,n):GOSUB Place GOSUB RestoreCommand RETURN END IF IF size(w)=0 THEN PRINT"The "word$(w-1)" is empty.":RETURN amt=size(w):max=amt CALL Fill(n,amt) IF amt 3 THEN GOSUB Cannot:RETURN IF sat THEN IF sitflag = 1 THEN IF sat = o THEN PRINT"You're already sitting on "nn$(1)". RETURN END IF ELSE IF -sat = o THEN PRINT"You're already lying on "nn$(1)". RETURN END IF END IF IF ABS(sat) <> o THEN PRINT"(standing up first): CALL Alias("stand up",30,0,0,0):GOSUB Stand GOSUB RestoreCommand IF (sat) THEN RETURN PRINT"(then, proceeding . . .) END IF END IF IF cap(2,o) < fat * sitflag THEN PRINT FNcap$(nn$(1))" is too small for you to "v$" on. ELSE IF soft(o) = 0 THEN PRINT FNcap$(nn$(1))" is very uncomfortable, but you "v$" on it anyway. ELSE PRINT"You "v$" on "nn$(1)". IF soft(o) = 2 THEN PRINT"It's very comfortable. END IF IF sitflag = 1 THEN sat = o ELSE sat = -o END IF RETURN Stand: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 0,0 IF sat = 0 THEN PRINT"You're already standing.":RETURN sat = 0 PRINT"You get up. RETURN Lie: DATA 0,0,0 DATA 0,2 DATA 0,2 DATA 0,2 sitflag = 3:GOSUB Sit1 RETURN QuitGame: DATA 0,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n = 0 THEN n = -22 IF n <> -22 THEN GOSUB Absurd:RETURN LINE INPUT"Quit the game? (Are you sure?) >";a$ IF LEFT$(a$,1) <> "y" THEN PRINT"Okay.":RETURN LINE INPUT"Save the game first? ";a$ IF LEFT$(UCASE$(a$),1) = "Y" THEN GOSUB SaveGame PRINT"Okay, bye! END RETURN ' In case the player does a "cont" DrinkAll: DATA 2,0,0 DATA 0,0 DATA 0,0 DATA 2,0 IF n<0 THEN GOSUB Absurd:RETURN wat = -bulk(0,n-1) CALL Fill(n-1,wat) IF wat < 0 THEN PRINT "You drink all of "nn$(0)". ELSE PRINT"There's nothing to drink. END IF RETURN '*** Error detection marker DATA "Z" map: ' Location 1 is reserved to hold object 1, which holds everything the ' player is carrying (in his/her hands) ' ' The data format is as follows: ' ' DATA loc, N,NE,E,SE,S,SW,W,NW,U,D, light, lighton? ' ' (OPTIONAL: ' DATA flag1,comp1,value1,loctrue1,locfalse1,"falsemessage" ' DATA flag2,comp2,value2,loctrue2,locfalse2,"falsemessage" ' . . . and so on, one line for each map conditional here) ' ' DATA short description ' DATA long description line 1 ' DATA long description line 2 ' DATA . . . ' DATA long description last line ' DATA "" ' ' (OPTIONAL: ' DATA flagnum,comp,value,verbose ' DATA description lines ' DATA "" ' . . . repeat as often as desired) ' ' DATA -1,0,0,0 ' End of this description ' ' Loc is the location number, and is used as a checking mechanism only; ' unlike elsewhere, the map MUST be in sequential order, starting with 2. ' Location 1 is reserved to hold "object" number 1 which contains ' everything the player is carrying (see Objects:). ' ' The following numbers are direction codes for each direction. ' ' The light flag is 0 if there is no light source (cave), 1 if there is ' natural light, and 2 if there is electric light (switchable on/off). ' ' Lighton? is usually used to flag whether or not the electric light ' is on or off. If this flag is non-zero, the value returned by CheckLight() ' will be this value. ' ' Then come the map conditional DATA statements, the short and long ' descriptions, the conditional descriptions, then the 0,0,0,0 end marker. ' ' DEFINITIONS: ' ' CONDITIONAL: ' A "conditional" is a triplet "flagnum,comp,value" which ' is evaluated as TRUE when flag(flagnum) < value, flag(flagnum) = value, ' flag(flagnum) > value, or flag(flagnum) <> value, depending on whether ' comp is -1, 0, 1, or 2, respectively. (See Calc:EvalCond(). See ' also Flags:) ' ' DIRECTION CODES: ' If positive, these are simply location numbers. ' (If the first number is -99, this is a "forced move" or a "bounceback" ' location; the codes are interpreted differently; see below for details.) ' ' MAP CONDITIONAL: ' If the direction code is a negative number (from -10 to -1), the code ' is an index to a "map conditional". -1 refers to the first map ' conditional in the location, -2 to the second, etc. For each map ' conditional in a location, there must be a DATA statement: (following ' the direction and status codes) ' ' DATA flagnum,comp,value,trueloc,falseloc,"falsemessage" ' ^--(conditional)--^ ' ' If the conditional is true, the player lands in trueloc, no questions ' asked. If false, the program prints "falsemessage" and then a blank line ' (if "falsemessage" is NOT null), and then the player goes to falseloc ' (which can be 0, which ends up with a "Can't go that way.") ' ' For example, ' DATA 54, 41,0,3,0,27,0,-1,0,0,0, 0,0,0 ' DATA 12,0,1,97,54,"The snake blocks your way." ' means, this is location 54. You can go north to 41, east to 3, ' and south to 27. If flag 12 is equal to 1, you can go west to ' location 97; otherwise "The snake blocks your way" and you stay ' in location 54. ' ' FORCED MOVE LOCATIONS, BOUNCEBACK: ' If the location number for "north" is -99, then the location ' is a "forced move" location; the player simply gets to see the ' description and then is moved immediately to a new location: ' ' DATA loc, -99,flagnum,cond,value,loctrue,locfalse,0,0,0,0, 0,0,0 ' ^---conditional---^ ' ' The player is immediately moved to loctrue if the conditional is ' true, and locfalse if false. If either locations are -99, the player ' is simply "bounced back" to his/her former location (combining this ' with the map conditionals described above allows you to have ' map conditionals that print out arbitrarily long messages). Note: ' since flag zero is set to a constant value of 1, you can always ' force a specific move or bounceback by testing flag zero for value 1. ' ' DESCRIPTIONS: ' Finally, you have the short description, which is a one-line ' "title" for the room. Then follows the long description, which ends ' with a NULL string. If the first line is a null string, NO description ' is printed (except possibly for the conditional descriptions, below.) ' Normally the long description is only printed when the player ' encounters a location for the first time, when flag(verbose) = 1, ' or when the player says "look". At other times only the short description ' is printed. ' In addition, if the short description is simply a space " ", the ' full description will always be printed. ' Any line in the long description that is just a single "z" will ' cause the "press any key to continue" message. ' ' CONDITIONAL DESCRIPTIONS: ' ' DATA flagnum,comp,value,verbosity ' ^---conditional---^ ' DATA "First line" ' . . . ' DATA "Last line" ' DATA "" ' ' If the conditional is true, and the "verbosity" condition is satisfied, ' the description is printed. If verbosity is 0, the description is printed ' only if the long description (see above) is printed. If 1, then ' it doesn't matter whether or not the long description is printed. If 2, ' then the conditional description is printed only ONCE, but only when ' the long description is printed, and if 3, the conditional is printed ' only once, but irregardless of whether or not the long description is ' printed as well. ' ' Any line in the conditional description that is just a single "z" ' will cause the "press any key to continue" message. ' ' Finally, DATA -1,0,0,0 will mark the end of a description. ' All the parameters below can be changed to suit your particular style ' Maximum location number DATA 100 ' Average number of lines of description per location DATA 5 ' Maximum number of map conditionals DATA 50 ' Maximum number of flag conditionals DATA 50 ' Average number of lines of description per flag conditional DATA 3 MapList: ' Begin with location 2 ' -99 means forced move ' "0,0,0" means test flag 0 to equal 0, which is ALWAYS TRUE, so ' go to location 3 immediately ' this v---v is the conditional (always true) DATA 2, -99,0,0,0,3,0,0,0,0,0, 0,0 DATA "Welcome . . . DATA " " DATA " You awaken to find yourself in a completely foreign DATA "land, filled with creatures and peoples you have never even DATA "imagined. After wandering for some time, you come to a deserted DATA "castle on a hilltop, overlooking the sea. You climb up to the DATA "tower and have a good night's sleep, unaware of the adventures DATA "that lie ahead . . . DATA " " DATA " You awake from a deep sleep, hoping to find yourself safe DATA "at home, but, alas, you are still in the--- DATA "z" DATA "" DATA -1,0,0,0 ' Go down to location 4 --v DATA 3, 0,0,0,0,0,0,0,0,0,4, 1,0 ' Natural lighting --^ DATA "Castle Tower DATA "From here you can see the raging green ocean, stretching out DATA "to the horizon to the north. The tower itself is ravaged by DATA "time, and the walls of the tower are crumbling and exposed. DATA "A spiral stairway winds down the inside of the walls of this DATA "round tower. DATA "" DATA -1,0,0,0 ' Two map conditionals here, indicated by "-1" and "-2" ' West to location 8--v v--Go up to location 3 DATA 4, 0,0,-1,0,-2,0,8,0,3,0, 1,0 ' Natural lighting --^ ' If flag 20 equals 1, go to location 6. Otherwise go to 4, print "closed." DATA 20,0,1,6,4,"The door is closed." ' If flag 21 equals 1, go to location 7. Otherwise print "Can't go that..." DATA 21,0,1,7,0,"" DATA "Tower Base DATA "This is a high-ceilinged room, some 25 feet, with the only light DATA "coming through the doorway to the west and dimly from upstairs. DATA "There is a heavy wooden door, about fifteen feet tall, in the DATA "eastern wall. The walls of made of finely-hewn stone, set with DATA "a minimum of mortar, and are surprisingly well-preserved. DATA "A spiral staircase winds up the perimeter. The staircase was DATA "cut from the very stone walls themselves. DATA "" ' On the first day, print this message once ' (flag(4) is the day number, verbosity code 2 means print only once) DATA 4,0,1,2 DATA "Here in the base of the tower you find evidence that the people DATA "who built this castle were more highly technically advanced DATA "than you originally thought: there are steel brackets mounted DATA "in the walls. Funny that you didn't recall seeing them last DATA "night, but after all it was dark and you were tired and disoriented. DATA "" ' Secret passageway ' If flag 21 equals 1, print the following description DATA 21,0,1,0 DATA "A solid black rectangle, about the size of a door, hovers DATA "as if attached to the southern wall. It appears pitch black, DATA "nevertheless a slight breeze emerges from it. DATA "" ' Continuation of long description ' If flag 0 equals 0 (always true), and the long description was ' printed (verbosity 0), print the following DATA 0,0,0,0 DATA "You hear the surf pounding on the rocks in the distance. DATA "" DATA -1,0,0,0 ' Example of a bounceback location ' -99 means forced move ' If flag 0 equals 0 (always true), go to location -99, which means ' "bounce back" ' this v---v is the conditional (always true) DATA 5, -99,0,0,0,-99,0,0,0,0,0, 0,0 DATA " " DATA "There is a flash of intense blue light and you are blinded DATA "for a moment before the air clears and you realize you have DATA "been jolted back into the tower base by some sort of force field. DATA "" DATA -1,0,0,0 ' One map conditional, marked by "-1" ' Going west --v checks map conditional 1 first DATA 6, 0,0,0,0,0,0,-1,0,0,0, 0,0 ' Lamp lighting --^ ' Map conditional 1 (for this location) ' if flag 20 equals 1, goto 4, otherwise stay in 6, print "door shut." DATA 20,0,1,4,6,"The door is firmly shut. DATA "Strange Grotto DATA "This is more a hollowed-out cave than a room. The walls are DATA "simply made of soft dirt that seems to have been recently dug, DATA "except for the stone wall to the west in which is embedded a DATA "heavy wooden door. The walls seem to be held together only by DATA "a tightly woven net of roots which seem to ooze from everywhere DATA "and appear almost as if they are moving. DATA "" ' If flag 20 equals 1, print the following ' (verbosity code 0 means only print when the long description is also) DATA 20,0,1,0 DATA "The door is ajar.","" DATA -1,0,0,0 ' One map conditional here, marked by "-1" ' If you go north, check map conditional 1 first ' Otherwise, stay in location 7, no matter where you go DATA 7, -1,7,7,7,7,7,7,7,7,7, 0,0 DATA 21,0,1,4,7,"" ' " " first means always print the long description DATA " " DATA "FLYING DATA "You have a vision, that you are flying way above the clouds, DATA "with nothing about you but the earth far below, a mountain range DATA "to the east, and a bright afternoon sun. DATA 21,0,1,0 DATA "A dark rectangle hovers in the air directly north of you.","" DATA -1,0,0,0 ' Go east to location 3, west to location 5 DATA 8, 0,0,4,0,0,0,5,0,0,0, 0,0 DATA "Entry Hall DATA "This is what was obviously once an entry hall. The doorway to DATA "the outside lies to the west. A fountain, made from exquisite DATA "marble, lies in the center of the room, and still contains water. DATA "" DATA -1,0,0,0 ' End marker DATA 0 Flags: ' The flag format is simple: ' ' DATA flag,value,flag,value, . . . ' ' Where flag is a flag number and value is its initial value. If ' not otherwise specified, the value is zero. ' ' The first value is the maximum number of flags (mflag). ' DATA 40 ' Note: the convention followed here is that flags 0-19 are "system" ' flags, common to all adventures that use this kernal. At the moment, ' only flags 0-7 are being used. Flags 20 and up are "adventure" flags, ' which are set and reset by the individual program. In the example ' "adventure" given here, flags 20 and 21 are used. ' ' This program segment is also called as a subroutine by Initialize: ' to set various mnemonic variables to index the flag() array ' ' Note: flag zero should never be changed from its value of zero ' Flag zero is used as a constant value for flag conditionals flag(0) = 0 ' Lamp on? lamp = 2:lampon = 2 'lamp is object 2 DATA 2,1 ' Daytime? 2-moonlight, 3-twilight, 4-daytime day = 3 DATA 3,4 ' Day number date = 4 DATA 4,1 ' Time (aka "t") (See PostProcess:) tim = 5 DATA 5,1 ' Detail level (see Wordy: Brief: and Superbrief:) verbose = 6 DATA 6,0 ' Random (varies from 0 to 99) call RollDice to set this flag (Calc:) ' Note: EvalCond() automatically calls RollDice if flag(random) is tested random = 7 RANDOMIZE TIMER ' Seed generator with timer value DATA 7,0 CALL RollDice ' End marker DATA 0 RETURN Objects: ' ' The list of objects is as follows: ' data Number,prefix,word,adjectives,long description ' data location,parent,relation ' data size,weight,inopening,wrapopening,onopening,underopening ' data containcapacity,wrapcapacity,surfacecapacity,undercapacity ' data containopaque,wrapopaque,surfaceopaque,underopaque ' data closed?,openable?,folded?,foldable?,locked? ' data holdwater?,worn?,wearable?,soft?,food?,immobile? ' data special 1,special 2,special 3 ' ' This information is placed in the following arrays, indexed by Number: ' ' pre$(),word$(),adj$(),long$() ' lo(),par(),rel() ' { see below for first(rel,),last(rel,),left(), and right() } ' size(),{see below for totw()},opening(rel,),cap(rel,),opaque(rel,) ' closed(),openable(),folded(),foldable(),locked() ' holdwater(),worn(),wearable(),soft(),food(),immobile() ' special(0/1/2,) ' ' More information is placed in the following arrays: ' ' totw(),totb(),bulk(rel,) ' ' The Number identifies the object to the program. You can delete and ' add objects without changing these Numbers, and in fact the objects ' can be listed in any order. ' ' The prefix contains "a" or "an" and any modifiers to be used when ' listing the object (as in Contents()). --> pre$() ' ' Word is a single word describing the type of object. --> word$() ' ' Adjectives are used by the program to ask the player to ' distinguish one object from another. --> adj$() ' ' The long description is for use when the player examines an ' object. --> long$() ' ' The location is the room number the object is in. This is 0 if the ' object does not exist, and 1 if the player is carrying it. This means ' actual room numbers start with the number 2. --> lo() ' ' The parent is the container the object is in, or zero. (The parent ' is zero if it is in a room.) --> par() ' ' The "relationship" to the parent is given by: ' MODE DESCRIPTION ' 0 - inside ' 1 - wrapped by ' 2 - on top of ' 3 - underneath (only for objects under tables, etc., NOT for ' objects stacked on top of each other---use 2 for that) ' --> rel() ' ' (The maximum number of relationships is stored in the mrel variable. ' This is set by the second number in the first DATA statement, below. ' The relationship is also referred to as "mode" elsewhere in the program.) ' ' Size --> size(). The size of the object and everything ' on top of and wrapped by (relations 1 and 2) the object --> totb() ' The total bulk contained in relation rel to object n. --> bulk(rel,n) ' Weight --> ?. You give the weight of the object by itself, but the only ' number which is stored is the total weight of the object and everything ' inside it and on top of it. This is stored in --> totw() ' (The weight of the object by itself is implicit in the totw() array, ' so it is not stored anywhere.) ' Inopening, wrapopening, onopening, underopening --> opening(rel,obj). ' where rel varies from 0 to 3. This is how big an object can ' fit in, wrapped by, on top of, and underneath an object. The ' "onopening" is usually equal to the surfacecapacity, below. ' Containcapacity, wrapcapacity, surfacecapacity, undercapacity --> ' cap(rel,obj), where rel varies from 0 to 3. This is how much stuff ' total can fit in relation to the object in these ways. ' Containopaque, wrapopaque, surfaceopaque, underopaque --> opaque(rel,obj). ' This determines whether or not objects inside, wrapped by, on top of, ' or underneath an object are not visible. ' ' Examples: ' A bottle might have inopening 1 (narrow opening) but containcapacity ' 3 (so it can contain 3 objects of size 1). It would be transparent, ' i.e. containopaque = 0. ' A purse, on the other hand, might have inopening 4, capacity 6, ' and containopaque = 1 (opaque unless the purse is open). ' A rug might have wrapcapacity 10, but surfacecapacity 30 (you can ' wrap about a third of what you can stuff on top of it lying flat.) ' A table might have surfacecapacity 30 and undercapacity 30 ' (you can stuff as much stuff on it as underneath it). However, a book ' might have surfacecapacity 3, so a table would not fit on the book, ' but you could certainly put the book under the table. ' ' (Size, weight, opening, capacity are in arbitrary units you can devise. ' My convention is that most ordinary objects have a size of at least ' 2, so that really small objects can be distinguished from them by having ' a size of 1.) ' ' Holdwater? --> holdwater(). ' The codes are as follows: ' 0 - cannot hold water ' 1 - can hold water ' 2 - is water ' ALL OBJECTS WHICH HOLD WATER MUST BE FOLLOWED BY their own personal ' water object (i.e. holdwater() = 2). This object is resized ' as water is added to and removed from the container. ' Currently, the program allows an object to hold either water or objects, ' but not both at the same time. (In a revision that can handle ' "wetness" this restriction could be lifted. I *have* thought out ' algorithms for handling wetness; it would require major ' revisions of almost every subprogram, so I decided to ' release this "dry" version of AmigaVenture for those of you who ' do not require wetness in your adventures. If you are interested ' in adding such code (remember, you have to handle evaporation, weight, ' etc., without slowing down the program too much) please email me (USENET) ' at mitsu@well.UUCP through July 1987, and at harvard!mitsu (I think) ' from August 1987, and I'll mail you my ideas for how to go about ' implementing it within AmigaVenture.) ' ' Closed? --> closed() ' Locked? --> locked() ' ' Folded? --> folded() ' Foldable? --> foldable() ' (Using the following codes: ' 0 - not foldable ' 1 - rolled up/rollable ' 2 - folded up/foldable ' 3 - tied up/tieable) ' ' Worn? --> worn() ' Wearable? --> wearable() ' (Using the following codes: ' 0 - not wearable ' 1 - on hand ' 2 - on head, neck, ears ' 4 - on torso (backpacks, jackets, shirts) ' 8 - around waist (belts) ' 16 - on legs) ' ' Soft? --> soft() is 1 for a chair or sofa type soft, and 2 for a bed ' soft. An object can be used as a piece of furniture if its surface is ' large enough. ' ' Food? --> food() Whether or not it is edible, and how nutritious. ' Arbitrary units. Currently the food just disappears when eaten, ' and has no effect. Modify the Eat: routine for your personal system. ' ' Liquid? --> liquid() Whether or not the object is a liquid. All such ' objects MUST be preceded by an object that can "holdwater". ' Similarly, all objects that "holdwater" must be followed by a ' liquid. Currently the only liquid is water. ' ' Immobile? --> immobile() objects cannot be moved, removed, etc. (like ' doors, etc.) In future revisions, this might contain a value ' describing the degree of immobility (from 0-free, 1-nails/hinges, ' 2-mortar, 3-plasteel, etc.) Currently, if an "immobile" object ' that has *no* interior or surface (no capacity in any of the four ' relations) and is lying free in a room (no parent), it is NOT linked into ' the list of objects in that room, and will NOT appear in the description ' of objects in the room (i.e., will not appear in the Here, you see: ' list.) The object should be described in the textual description of the ' room. Good uses for this would be for stairways, bookshelves, and the ' like. You don't want such things in the "Here, you see:" list, but ' if the player has a reason to refer to them, you don't want the ' program to say "I see no stairwell here." or worse "I don't know ' what you mean by 'stairwell.'" ' ' Please note the special importance of object 1, as described below. ' ' Feel free to add to this list. If you add to the list, simply ' change the Initialize: routine and update the object data statements. ' Perhaps someone can come up with an IFF-style format for storing ' object descriptions, and people could write adventures that ' allowed you to take objects from one adventure to the next. But ' that is a whole different ball of wax. (How would you Number them, ' for example?) ' ' Of course, to save memory, this list and the whole Initialize: routine ' should be placed in a separate program and run *before* the program, ' and the program could just read in the results from a disk file. Note ' that you must copy the Insert() and Setloc() subprograms to such ' an "initialization" program. This would also be much faster. However, ' while developing an adventure, it is much more handy to have the ' object list in the program, so you can "recompile" the object list ' immediately as you modify your adventure. Another neat idea would be ' to write an AmigaVenture Object Editor, which could have all sorts ' of interesting features (standard object types, etc. so you don't ' have to specify all these attributes over and over for each object.) ' ' This list is meant only as a guide to a fairly complete, albeit simple, ' system for defining objects and their relationships. One could imagine ' arbitrarily extending this list of attributes to any desired degree ' of realism; however, you should consider how much the added ' attribute actually adds to the realism and play value of your ' adventure versus the effort and program space taken to take care of ' all the relationships the such attributes might entail (for example, ' wetness). ' ' NOTE TO THE PROGRAMMER: ' Objects are kept track of in the following way: ' The arrays lo(), par(), first(rel,), last(rel,), left(), and right() ' contain information about doubly-linked lists of objects embedded ' in a tree structure. ' ' lo(obj) is the room the object is in. (0 if it is in limbo. Note ' the significance of location 1, the player's special location.) ' ' first(rel,obj) holds the first in the list of objects in, wrapped by, on, ' or under object "obj", or zero if none. The "rel" index is 0, 1, 2, ' and 3, respectively. ' ' Lfirst(loc) (see Map:) holds the first in the list of objects lying free ' in location "loc". ' ' last(rel,obj) holds the last in the list of objects in, wrapped by, on, ' or under object "obj", or zero if none. The "rel" index is the same ' as above. ' ' Llast(loc) (see Map:) holds the last in the list of objects lying free ' in location "loc". ' ' par(obj) holds the parent of the object (0 if it is lying free) ' rel(obj) holds the relation. (0, 1, 2, 3 for in, wrapped, on, under.) ' (Ex.:If object 7 is on top of object 3, then par(7) = 3, rel(7) = 2 (on).) ' (Ex.:If object 4 is lying free in room 17, then lo(4) = 17, par(4) = 0, ' and rel(4) = 0.) ' ' right(obj) holds the next in the list of objects. ' ' left(obj) is the *previous* object in the list. ' ' As below: ' ' Parent (Bag) ---------------------------------\ ' | (RELATION 0, in) | Last ' V V ' First (Fruit) Right -> (Sandwich) Right -> (Rock) Right -> Zero 'Zero <- Left <- Left <- Left ' ' The paradigm is the program keeps track of a whole bunch of little ' lists of objects. Each list is either lying free in a room, ' or inside, on top of, wrapped by, or underneath another object. ' EVERY OBJECT keeps track of the following information about their ' list: the parent of the list (0 if lying free), the relation the list ' is in to the parent (0, 1, 2, 3 for in, wrapped, on, under), the ' location number the list resides in (0 for limbo, 1 for player, 2 ... ' for a map location). ' ' The Remove(), Insert(), RemList() and Concat() subprograms handle ' the list operations automatically. They also update the totw(), totb() ' and bulk(rel,) arrays. ALWAYS use these routines to move objects ' around, NEVER directly modify the list arrays yourself, to ensure that ' all the lists and arrays remain consistent. It took a long time to ' debug these arrays, and a lot of redundant information is kept track ' of for program speed, so take advantage of these routines. Descriptions ' of the routines are found near their implementations (after Lists:). ' Maximum number of objects (can be changed at will) DATA 100 ' The largest relationship number (in == 0, on, under, wrap == 3) DATA 3 ' The largest number of water containers (can be changed at will) DATA 10 ' NOTE: Object number 1 is reserved for containing all the objects the ' player is carrying. This object is placed in location 1, and may not ' be moved. Also, no other object should be placed in location 1. ' ' Items being carried by the player should be related to object 1 in ' mode 1 (normally "wrapped by"). Items being *worn* by the player should ' be related to object 1 in mode 0. ' ' FOR OBJECT NUMBER 1 ONLY: ' ' RELATION DESCRIPTION ' -------- ----------- ' 0 Objects being worn ' 1 Objects being carried ' ' Objects carried thus must start with 1,1,1,... ' Objects worn must start with 1,0,1,... ObjList: DATA 1,,you,, DATA 1,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,,0 ' The program currently assumes the variable "lamp" is the object ' number of the lamp, and the flag number "lampon" determines whether ' it is on or off. See Flags:, Calc:CheckLight(), and also TurnOn: ' and TurnOff: DATA 2,a brass,lamp,brass,"The lamp is worn from use but still serviceable. DATA 1,1,1, 5,5, 0,0,2,0, 0,0,2,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0 DATA 3,a,sandwich,ham and cheese,"It's a ham and cheese sandwich. DATA 1,7,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,0 DATA 5,a small,purse,satin,"The purse is made of satin. DATA 4,0,0, 3,2, 6,0,2,0, 6,0,2,0, 1,1,0,0, 0,1,0,0,0,0, 0,0,0,0,0 DATA 6,a pearl,earring,pearl,"The earring is made of three exquisite pearls. DATA 4,5,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0 DATA 7,a brown,bag,small paper,"It's just a small paper lunch sack. DATA 1,1,1, 3,2, 4,2,4,0, 4,2,4,0, 1,1,0,0, 1,1,0,2,0,0, 0,0,0,0,0 DATA 8,a diamond,earring,diamond,"The earring is made of two precious diamonds. DATA 3,0,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0 DATA 10,a glass,bottle,glass,"It's an old Coke bottle. DATA 3,0,0, 1,1, 1,0,1,0, 2,0,1,0, 0,0,0,0, 0,1,0,0,0,1, 0,0,0,0,0 DATA 11,some,water,"","" DATA 3,10,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0 DATA 12,an elfin,hat,elfin,"It's made of old, dirty green felt. DATA 1,1,0, 2,2, 3,1,2,0, 3,1,2,0, 0,1,0,1, 0,0,0,2,0,0, 2,2,1,0,0 DATA 13,a small Oriental,rug,small Oriental,"The rug is well-worn from use. DATA 4,0,0, 10,8, 0,7,20,0, 0,7,20,0, 0,0,0,1, 0,0,0,1,0,0, 0,0,1,0,0 DATA 14,a large,backpack,frame,"The label says 'REI.' DATA 3,0,0, 10,10, 10,0,5,0, 20,0,5,0, 1,0,0,0, 1,1,0,0,0,0, 0,4,1,0,0 DATA 15,a long,rope,long,"The rope is made from hemp. DATA 4,14,0, 4,3, 0,0,10,0, 0,0,10,0, 0,0,0,0, 0,0,0,0,0,0, 0,8,0,0,0 DATA 16,a,table,wooden,"The table is simply constructed from wood. DATA 4,0,0, 70,50, 0,0,15,20, 0,0,20,20, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0 DATA 17,some steel,brackets,steel,"The brackets are heavy-duty and appear good as new. DATA 4,0,0, 10,10, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1 DATA 18,a spiral,staircase,spiral,"The staircase is somewhat crumbling, but still quite useable. DATA 4,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1 DATA 19,a marble,fountain,marble,"The fountain is made of striated marble. DATA 8,0,0, 200,300, 100,0,0,0, 100,0,0,0, 0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,1 DATA 20,some,water,"","" DATA 8,19,0, 100,100, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0 ' (End marker) DATA 0 Nouns: ' The list of nouns goes simply ' ' data noun,object 1,object 2, . . .,0 ' ' for each noun. The list of objects are all the objects the noun ' could possibly refer to. ' ' The "noun" could also be an adjective. The interpreter will ' ask for futher clarification if there is still unresolved ambiguity. ' ' Negative numbers refer to features or directions or other ' abstractions which do not have objects associated with them. ' ' This list must be all single words, no spaces. ' ' Maximum number of nouns, maximum number of homonyms DATA 150,300 DATA the,0,a,0,an,0,those,0,these,0,for,0,is,0,are,0,by,0 DATA north,-1,0,n,-1,0,northeast,-2,0,ne,-2,0,east,-3,0,e,-3,0 DATA southeast,-4,0,se,-4,0,south,-5,0,s,-5,0,southwest,-6,0,sw,-6,0 DATA west,-7,0,w,-7,0,northwest,-8,0,nw,-8,0 DATA up,-9,0,u,-9,0,down,-10,0,d,-10,0 DATA upstairs,-9,0,downstairs,-10,0,ascend,-9,0,descend,-10,0 ' Nouns from -11 to -19 are reserved as special words for use by the ' interpreter. Do not change them without changing the interpreter also DATA all,-11,0,everything,-11,0,it,-12,0,him,-12,0,her,-12,0,them,-13,0 DATA that,-14,0,that's,-14,0,that're,-14,0 DATA what,-15,0,what's,-15,0,what're,-15,0 DATA i,-20,0,me,-20,0,myself,-20,0,self,-20,0,my,-20,0 DATA you,-21,0,yourself,-21,0,your,-21,0 DATA game,-22,0 DATA lamp,2,0,brass,2,0 DATA ham,3,0,cheese,3,0,sandwich,3,0 DATA small,5,7,0,satin,5,0,purse,5,0 DATA pearl,6,0,earring,6,8,0 DATA brown,7,0,paper,7,0,bag,7,0 DATA diamond,8,0 DATA glass,10,0,bottle,10,0,Coke,10,0 DATA water,11,20,0 DATA elfin,12,0,felt,12,0,old,12,0,dirty,12,0,green,12,0,hat,12,0 DATA small,13,0,Oriental,13,0,well-worn,13,0,worn,13,0,rug,13,0 DATA large,14,0,frame,14,0,REI,14,0,backpack,14,0,pack,14,0 DATA long,15,0,hemp,15,0,rope,15,0 DATA wooden,16,0,table,16,0,wood,16,0 DATA steel,17,0,brackets,17,0 DATA stairs,18,0,staircase,18,0,spiral,18,0,stairway,18,0 DATA marble,19,0,fountain,19,0 ' (End marker) DATA "",0 ' Abstract words like directions, etc., (any noun associated ' with no concrete moveable Object). ' The format is: ' DATA code,word,code,word,etc. (this is the same as ' the Objects format, but with only one descriptor). abstract: ' Maximum number of abstract nouns (changeable, of course) DATA 50 DATA 1,north,2,northeast,3,east,4,southeast,5,south DATA 6,southwest,7,west,8,northwest,9,up,10,down DATA 11,everything DATA 13,water DATA 20,yourself,21,me DATA 22,the game ' (End marker) DATA 0,"" fold: DATA 3 DATA rolled up,folded up,tied up ' (End marker) DATA "" Verbs: ' ' The list of verbs goes: ' ' data verb,number,verb,number, . . . ' ' The "number" refers to the number of the verb, which must correspond ' to the number used by DoCommand when it goes to the appropriate ' command in its ON GOTO statement. See DoCommand. ' ' Verbs of three words in length are placed first, ' followed by a data "",0. Then verbs of two words, followed ' by a data "",0. Finally all single-word verbs. ' ' (an unlimited number of verbs are possible). ' ' Please reserve verb numbers 1-49 for kernal verbs, common to ' all adventures. This allows upgrades of the adventure kernal ' to be separated from adventure-specific commands. If you update ' the kernal, please use verbs 1-49; use verbs 50 and up for ' magic words, etc. which would not be used in another adventure. ' This allows other people to be able to take advantage of your ' kernal upgrades without having to wade through adventure-specific ' code. Currently verbs 1-29 are being used. '*** Three-word verbs DATA let go of,3,get rid of,3,do it again,24,do it over,24 DATA i give up,32,I give up,32 DATA "",0 '*** Two-word verbs DATA look at,5,look around,1,pick up,2,get out,2,take out,2,put down,3 DATA get me,3 DATA turn on,12,turn off,13,save game,17,load game,18 DATA put on,19,take off,20,wrap up,21,fold up,21,tie up,21,roll up,21 DATA start over,23,repeat last,24,do again,24,do over,24,over again,24 DATA pour out,25,fill up,26,eat up,27,gobble up,27 DATA sit down,29,stand up,30,get up,30,lie down,31 DATA quit game,32,give up,32,end game,32,drink all,33,drink up,33,slurp up,33 DATA "",0 '*** One-word verbs DATA look,1,see,1,l,1 DATA get,2,take,2 DATA drop,3,release,3 DATA inventory,4,i,4 DATA examine,5,read,5 DATA go,6,walk,6,run,6,hop,6,skip,6,jump,6 DATA put,7,place,7 DATA open,8,close,9,lock,10,unlock,11 DATA activate,12,deactivate,13 DATA wordy,14,verbose,14,brief,15,superbrief,16 DATA save,17,load,18,restore,18,record,17 DATA wear,19,don,19 DATA wrap,21,fasten,21,unwrap,22,restart,23 DATA again,24,repeat,24 DATA empty,25,pour,25,fill,26 DATA eat,27,munch,27,consume,27,gobble,27,drink,28,quaff,28,slurp,28 DATA sit,29,stand,30,lie,31 DATA quit,32 ' (End marker) DATA "",0 ' The preposition codes are 1 more than the relationship codes ' for object lists (see Objects: 0 = in, 1 = wrapped by, et cetera). Prepositions: DATA in,1,into,1,inside,1,wrapped,2,lying,3,on,3,onto,3,under,4,underneath,4 DATA to,5,with,6,from,7,and,8,then,8,but,9,except,9,not,9 ' (End marker) DATA "",0 Prepnames: 'Starting with preposition zero (null) DATA . . .,inside,wrapped by,on,underneath,to,with ' (End marker) DATA ""