304e3531437d6f55125600fb9ef68463bc9b8fbf
[supernova.git] / src / DEFAULT.PAS
1 {//-------------------------------------------------------------------------}\r
2 {/*                                                                         }\r
3 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }\r
4 {                                                                           }\r
5 {This file is part of Supernova.  Supernova is free software; you can       }\r
6 {redistribute it and/or modify it under the terms of the GNU General Public }\r
7 {License as published by the Free Software Foundation; either version 2     }\r
8 {of the License, or (at your option) any later version.                     }\r
9 {                                                                           }\r
10 {This program is distributed in the hope that it will be useful,            }\r
11 {but WITHOUT ANY WARRANTY; without even the implied warranty of             }\r
12 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }\r
13 {                                                                           }\r
14 {See the GNU General Public License for more details.                       }\r
15 {                                                                           }\r
16 {You should have received a copy of the GNU General Public License          }\r
17 {along with this program; if not, write to the Free Software                }\r
18 {Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.}\r
19 {                                                                           }\r
20 {Original Source: 1990 Scott Miller                                         }\r
21 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
22 {*/                                                                         }\r
23 {//-------------------------------------------------------------------------}\r
24 (****************************************************************************)\r
25 (*                             DEFAULT ROUTINES                             *)\r
26 (*          >> Contains the default routines used by Supernova <<           *)\r
27 (*                        Programmer: Scott Miller                          *)\r
28 (*                      << Began February 2, 1985 >>                        *)\r
29 (*                      Copyright 1985 Scott Miller                         *)\r
30 (****************************************************************************)\r
31 procedure Default0;\r
32 begin\r
33 case Vb of\r
34 \r
35 { N, S, E, W, etc. }\r
36 1..8:case Prm of\r
37      14..19:RL(26);\r
38      21:RL(27);\r
39      42..50:RL(279)\r
40      else\r
41       if Prm>7 then writeln('There is not a path leading ',up(Dir[Vb]),'.')\r
42       else writeln('There is not passage in that direction.')\r
43      end;\r
44 \r
45 { LOOK }\r
46 30:begin Brief:=Brief-[Prm];Describe(Prm);\r
47     if(Prm=56)and(T[17]>4)then begin RS(114);RS(115);Pause;end;\r
48    end;\r
49 \r
50 { SAVE }\r
51 82:Save;\r
52 \r
53 { RESTORE }\r
54 87:Restore;\r
55 \r
56  end {main case}\r
57 end; { Default0 }\r
58 {----------}\r
59 overlay procedure Default1;\r
60 begin\r
61 case Vb of\r
62 \r
63 { INVENTORY }\r
64 16:if not(Inv=[]) then\r
65     begin\r
66      writeln('You have in your possession...');\r
67      for o:=1 to MMax do\r
68       begin\r
69        if o in Inv then\r
70         begin\r
71          if o=6 then write('  some ',FN(o)) else write('  a ',FN(o));\r
72          if o in Wear then write('  (being worn)');\r
73          case o of\r
74            5:if SatchCon<>Null then write('  (contains something)');\r
75            7:if HolstCon<>Null then write('  (contains something)');\r
76           29:if MugCon<>Null then write('  (has something in it)');\r
77          end;if o in Inv then writeln;\r
78         end;\r
79       end;\r
80     end\r
81    else RL(28);\r
82 \r
83 { DROP }\r
84 18:if not(30 in NounSet)then\r
85     for o:=1 to NMax do\r
86      if o in NounSet then\r
87       if o in Inv then\r
88         begin\r
89          write(FN(o),':  ');\r
90          if o in Wear then\r
91           writeln('First you must remove the ',FN(o),'.')\r
92          else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;\r
93         end\r
94       else writeln('You don''t have the ',FN(o),'.')\r
95      else begin;end\r
96    else\r
97     begin Min(17); { DROP ALL }\r
98      for o:=1 to MMax do\r
99       if o in Inv then\r
100        begin\r
101         write(FN(o),':  ');Add(17);\r
102         if o in wear then\r
103          writeln('First you must remove the ',FN(o),'.')\r
104         else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;\r
105        end;\r
106      if not en(17)then RL(303)\r
107     end;\r
108 \r
109 { DROP ALL BUT }\r
110 17:begin\r
111     for o:=1 to MMax do\r
112      if(o in Inv)and not(o in NounSet)then\r
113       begin\r
114        write(FN(o),':  ');\r
115        if o in Wear then\r
116         writeln('First you must remove the ',FN(o),'.')\r
117        else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;\r
118       end;\r
119    end;\r
120 \r
121  end; {main case}\r
122 end; { Default1 }\r
123 {----------}\r
124 overlay procedure Default2;\r
125  label JUMP;\r
126 begin\r
127 case Vb of\r
128 \r
129 { ROOM DESCRIPTION }\r
130 77:if not(en(1))then begin Add(1);RL(14)end\r
131    else begin Min(1);RL(15)end;\r
132 \r
133 { QUIT }\r
134 79:begin Bor(1,0);\r
135     writeln('In ',Tic,' moves you scored ',Sc,\r
136             ' out of a possible 1000 points.');\r
137     writeln('If you want to continue this game at a later date you ',\r
138             'should first use the');writeln('SAVE command.');\r
139     write('Are you still sure you want to QUIT?  ');\r
140     Cur(2);\r
141     read(kbd,CFlag);\r
142     if upcase(CFlag)='Y' then\r
143      begin\r
144       RL(12);delay(2200);\r
145       close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
146       window(1,1,80,25);nosound;clrscr;Cur(1);Bor(0,0);gotoxy(2,2);\r
147       Col(31,16);Bak(4,7);writeln('Good-bye!');halt;\r
148      end\r
149     else RL(13);Bor(0,0);\r
150    end;\r
151 \r
152 { SLEEP }\r
153 62:if(T[5]>32)and(T[8]<1)then\r
154     if(N1 in[19,27,49,69,80,113])then\r
155      begin T[2]:=6;Add(7);\r
156       writeln('You lie down on the ',NStr,\r
157               ' and fall asleep within a few minutes.');\r
158      end\r
159     else RL(16)\r
160    else\r
161     if N1 in[69,80] then\r
162      begin\r
163       T[5]:=230;PStat:=PStat-[5];Bor(0,0);Add(7);\r
164       case N1 of\r
165        69:if T[8]<1 then begin RS(41);Add(128) end\r
166           else begin RS(42);Add(7);Add(10)end;\r
167        80:if T[8]<1 then\r
168            if not en(18)then RS(218)\r
169            else case random(2)of 0:RS(218);1:RS(219)end\r
170           else begin RS(220);Add(128) end\r
171       end;\r
172      end\r
173     else writeln('The ',FN(N1),' is not a suitable place to sleep.');\r
174 \r
175 { SIT }\r
176 35:if(N1 in[16,32,35,49,54,69,71,80,83..86,98,110])then\r
177     begin Add(7);\r
178      case N1 of\r
179       69:if T[8]<1 then begin RS(41);Add(128) end\r
180          else begin RS(42);T[5]:=160;PStat:=PStat-[5];Add(7);Add(10)end\r
181       else writeln('You sit down on the ',NStr,'.')\r
182      end\r
183     end\r
184    else RL(17);\r
185 \r
186 { STAND }\r
187 32:if(en(7))then\r
188     begin Min(7);Min(2);Min(3);Min(19);T[6]:=Null;RL(18)end\r
189    else RL(19);\r
190 \r
191 { UP and CLIMB }\r
192 9,51:if(N1 in[32,35,54,68,71,80,81,83..86,89,98,112,125])then\r
193       begin Add(8);\r
194        writeln('You manage to climb up the ',NStr,'.');\r
195       end\r
196      else\r
197       if(Vb=9)then writeln('There is not a path in that direction.')\r
198       else RL(20);\r
199 \r
200 { DOWN }\r
201 10:if(en(8))then\r
202     begin Min(8);RL(21)end\r
203    else writeln('There is not a path in that direction.');\r
204 \r
205 { IN and OUT }\r
206 11,13:writeln('Due to the multiple paths you will have to be more specific.');\r
207 \r
208 { WAIT }\r
209 15:begin writeln('Time passes');y:=wherey;for x:=1 to 6 do\r
210     begin gotoxy(11+x,y-1);write('.');sound(x*99);delay(30);end;\r
211     nosound;writeln;if Region=4 then sound(20);if Region=5 then sound(60);\r
212    end;\r
213 \r
214  end; {main case}\r
215 end; { Default2 }\r
216 {----------}\r
217 overlay procedure Default3;\r
218 begin SFlag:=false;\r
219 case Vb of\r
220 \r
221 { EXAMINE }\r
222 28:begin\r
223    case N1 of\r
224    1:if en(41) then RS(116) else begin RS(116);RS(132);Score(5,41)end;\r
225    2:RL(454);\r
226    3:RL(45);\r
227    4:RL(294);\r
228    5:begin RL(105);if SatchCon<>Null then\r
229       if SatchCon=6 then writeln('The satchel contains ',FN(SatchCon),'.')\r
230       else writeln('The satchel contains a ',FN(SatchCon),'.')\r
231      end;\r
232    6:begin RL(54);case FoodCon of 1:RL(55);2:RL(56);3:RL(57);4:RL(58)end end;\r
233    7:begin RL(579);if HolstCon=Null then RL(580)else\r
234       writeln('The gun strap contains a ',FN(HolstCon),'.')end;\r
235    8:RL(59);\r
236    9:RL(374);\r
237    10:RL(262);\r
238    11:RL(311);\r
239    12:RB2(6,13);\r
240    16:RL(151);\r
241    17:RL(263);\r
242    18:if en(34) then begin Score(5,116);RS(92)end else RL(267);\r
243    19:begin RB(12,11);Pause end;\r
244    20:RL(372);\r
245    22:begin RL(527);if 22 in Socket then RL(528)end;\r
246    23:begin RL(529);if 23 in Socket then RL(528)end;\r
247    24:begin RL(530);if 24 in Socket then RL(528)end;\r
248    25:begin RL(531);if 25 in Socket then RL(528)end;\r
249    26:RL(455);\r
250    28:if NStr='badge' then RL(406)else if Md=1 then RL(407)else RL(408);\r
251    29:begin write('The mug is quite small.  ');\r
252        if MugCon=Null then RL(60)else RL(61)end;\r
253    42:begin RS(195);RS(196)end;\r
254    54:if NStr='column' then begin RS(195);RS(196)end;\r
255    56:begin RL(92);if Prm in[81..88]then RL(423)end;\r
256    62:case Prm of 21,25:RS(15);22,24:RS(246)end;\r
257    99:RL(63);\r
258    103:case Prm of 24..34,59,60:RL(317)else RL(326)end;\r
259    113:RR(Prm);\r
260    123:RS(159);\r
261    124:RL(62)\r
262    end; {case}\r
263    if not SFlag then\r
264     case random(20) of\r
265     0..6:writeln('You can''t find anything unusual about the ',FN(N1),'.');\r
266     7..14:writeln('You see nothing special about the ',FN(N1),'.');\r
267     15..17:writeln('It looks like any other ',NStr,' you''ve ever seen.');\r
268     18..20:writeln('It looks like an ordinary ',NStr,'.')\r
269     end\r
270    end;\r
271 \r
272 { EAT }\r
273 47:if N1=6 then\r
274     begin RL(68);FoodCon:=FoodCon-1;T[3]:=175;PStat:=PStat-[2];Bor(0,0);\r
275      if FoodCon=0 then begin Van(6);RL(69)end\r
276     end\r
277    else writeln('The ',NStr,' would not do much for your digestive system.')\r
278 \r
279  end {main case}\r
280 end; { Default3 }\r
281 {----------}\r
282 overlay procedure Default4;\r
283 begin\r
284 case VB of\r
285 \r
286 { GET }\r
287 39:begin\r
288     Weight:=Null;Min(17);\r
289     for o:=1 to MMax do if o in Inv then\r
290      begin Weight:=Weight+1;if o=11 then Weight:=Weight+3 end;\r
291     if not(30 in NounSet)then\r
292      for o:=1 to NMax do\r
293       if o in NounSet then\r
294        if o in Mov then\r
295         begin\r
296          write(FN(o),':  ');\r
297          Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
298          if Weight<9 then\r
299           if not(o in Inv)then\r
300            if(o in Socket)and not(26 in Wear)then RL(524) else\r
301             begin if(o=PyraCon)and(o=9)then Walls(8);\r
302              writeln('Taken.');Van(o);Inv:=Inv+[o];\r
303             end\r
304           else writeln('You already have that.')\r
305          else\r
306           begin RL(587);\r
307            if o=11 then Weight:=Weight-3;\r
308           end\r
309         end\r
310        else begin write(FN(o),':  ');\r
311         if N1 in[32,35,80,83..86,90,121]then RL(502)else crazy;end\r
312       else begin;end\r
313     else\r
314      begin  { GET ALL }\r
315       for o:=1 to MMax do\r
316        if o in Mov then\r
317         if r[o]=Prm then\r
318          begin\r
319           write(FN(o),':  ');Add(17);\r
320           Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
321           if Weight<9 then\r
322            if(o in Socket)and not(26 in Wear)then RL(524) else\r
323             begin writeln('Taken.');Van(o);Inv:=Inv+[o]end\r
324           else\r
325            begin RL(587);\r
326             if o=11 then Weight:=Weight-3;\r
327            end\r
328          end;\r
329       if not en(17)then RL(29)\r
330      end\r
331    end;\r
332 \r
333 { GET ALL BUT }\r
334 37:begin\r
335     Weight:=Null;Min(17);\r
336     for o:=1 to MMax do if o in Inv then\r
337       begin Weight:=Weight+1;if o=11 then Weight:=Weight+3 end;\r
338      for o:=1 to MMax do\r
339       if(o in Mov)and not(o in NounSet)then\r
340        if r[o]=Prm then\r
341         begin\r
342          write(FN(o),':  ');\r
343          Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
344          if Weight<9 then\r
345           if(o in Socket)and not(26 in Wear)then RL(524) else\r
346            begin writeln('Taken.');Van(o);Inv:=Inv+[o];Add(17)end\r
347          else\r
348           begin RL(587);\r
349            if o=11 then Weight:=Weight-3;\r
350           end\r
351         end;\r
352      if not en(17)then RL(29)\r
353    end;\r
354 \r
355  end; {main case}\r
356 end; { Default4 }\r
357 {----------}\r
358 overlay procedure Default5;\r
359  label JUMP,JUMP1;\r
360 begin\r
361 case Vb of\r
362 \r
363 { PURCHASE }\r
364 64:if Prm=8 then\r
365     if N1=100 then RS(10) else\r
366     if(N1 in[29,99])or(Pr=11)then\r
367      if Pr in[6,9] then\r
368       if N2 in[8,111] then\r
369        if Here(8) then\r
370         begin Inv:=Inv+[29];Van(8);Score(15,21);RS(11);T[1]:=21;Add(9);Add(16)\r
371         end\r
372        else RL(39)\r
373       else RL(40)\r
374      else\r
375       if Pr=11 then\r
376        if(N1 in[29,99,111,124])and(N2 in[29,99,111,124])then begin\r
377         if(N1=111)xor(N2=111)then RL(196)else\r
378         if(N1=124)xor(N2=124)then RL(197)\r
379         else crazy end\r
380        else crazy\r
381       else NoSense\r
382     else\r
383      if N2<>124 then RL(34) else RL(35)\r
384    else\r
385     if Prm=AlienRm then RL(35) else\r
386     if Prm=FriendRm then RL(36)\r
387     else RL(38);\r
388 \r
389 { DRINK }\r
390 46:if N1=Null then\r
391     if Here(29) then\r
392      if(Prm=8)and not(29 in Inv)then RL(67) else\r
393 JUMP: if MugCon<>Null then\r
394        case MugCon of\r
395         99:begin MugCon:=Null;T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(64)end;\r
396         79:begin MugCon:=Null;T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66);\r
397             Van(79)end;\r
398         92:JUMP1:begin MugCon:=Null;\r
399             if T[12]<2 then RL(162)else\r
400             if en(42) then begin RS(136);Van(92);T[12]:=Null;Bor(0,0);\r
401              PStat:=PStat-[3];Score(20,124)end\r
402             else RL(162)\r
403            end;\r
404        end\r
405       else RL(65)\r
406     else\r
407      if Here(98) then  { For the Sink }\r
408       if SinkRm=Prm then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66)end\r
409       else RL(67)\r
410      else RL(67)\r
411    else  { If N1 = something }\r
412     case N1 of\r
413      29,99:if 29 in Inv then goto JUMP else RL(87);\r
414      98:if SinkRm=Prm then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66)end\r
415         else RL(67);\r
416      121,66:begin RS(12);Add(128);end;\r
417      92:goto JUMP1;\r
418      79:begin\r
419          if(Here(29)and(MugCon=79))then\r
420           begin T[4]:=130;Bor(0,0);MugCon:=Null;Van(79);PStat:=PStat-[6];\r
421            RL(66)end\r
422          else if Here(79)then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];\r
423                RL(66)end\r
424               else RL(67);\r
425         end\r
426      else writeln('The ',NStr,' would not quench your thirst.')\r
427     end;\r
428 \r
429  end; {main case}\r
430 end; { Default5 }\r
431 {----------}\r
432 overlay procedure Default6;\r
433  function Word(W:Str29):boolean;\r
434   begin if pos(' '+W+' ',input)>0 then Word:=true else Word:=false end;\r
435 begin\r
436 case Vb of\r
437 \r
438 { TALKING TO CHARACTERS}\r
439 66..69,71:\r
440   begin Spaces(input);\r
441    if Vb=66 then  { Bartender }\r
442     if Here(111)then\r
443      if Word('follow')then RL(46)else\r
444      if Word('go')or Word('east')or Word('south')then RL(567)else\r
445      if Word('hi')or Word('hello')then RL(51)else\r
446      if Word('infocom')then RL(498)else\r
447      if Word('scott')or Word('miller')then RL(499)else\r
448      if Word('what')or Word('why')or Word('where')or Word('who')or\r
449         Word('how')or Word('which')or Word('when')then RL(463)else\r
450      if(Word('ill')or Word('give')or Word('buy')or Word('get me')or\r
451         Word('purchas'))and(Word('drink')or Word('glunk'))then RL(47)else\r
452      if Word('ambross')or Word('pink')or Word('bloody')or Word('foeboz')or\r
453         Word('ztulctw')then RL(565)else\r
454      if Word('kill')or Word('fight')or Word('hit')then RL(566)else\r
455      if Word('give')then RL(564)else\r
456      if Word('help')or Word('tell me')then RL(479)else\r
457      case random(3) of 0:RL(50); 1:RL(480); 2:RL(481)end\r
458     else RL(52);\r
459    if Vb=67 then  { Two Aliens }\r
460     if Here(124)then\r
461      if Word('follow')then RL(48)else\r
462      if Word('go')or Word('south')or Word('east')then RL(568)else\r
463      if Word('crystal')then RL(484)else\r
464      if Word('coordin')or Word('where')or Word('world')or Word('sagan')or\r
465         Word('planet')or Word('locatio')then RL(485)else\r
466      if Word('what')or Word('why')or Word('who')or Word('tell me')or\r
467         Word('how')or Word('which')or Word('when')then RL(464)else\r
468      case random(3) of 0:RL(49); 1:RL(482); 2:RL(483)end\r
469     else RL(53);\r
470    if Vb=68 then  { Scientist }\r
471     if here(123)then\r
472      if Word('follow')then RL(440)else\r
473      if Word('hi')or Word('hello')or Word('bye')then RL(441)else\r
474      if Word('wristba')then RL(442)else\r
475      if Word('card')or Word('green')then RL(459)else\r
476      if Word('give')then RL(456)else\r
477      if Word('go')or Word('east')or Word('west')then RL(457)else\r
478      if Word('help')then RL(462)else\r
479      if Word('ship')or Word('planets')then RL(497)else\r
480      if Word('star')or Word('superno')then RL(486)else\r
481      if(Word('crystal')or Word('clear'))and((T[24]>1)and(T[24]<6))and\r
482        (1 in Inv)then begin T[24]:=Null;T[25]:=7;RS(181)end else\r
483      if(Word('crystal')or Word('clear'))and((T[23]>1)or(T[24]>5))then\r
484       RL(446)else\r
485      if Word('crystal')or Word('clear')then RL(487)else\r
486      if(Word('who')or Word('what'))and Word('you')then RL(461)else\r
487      if Word('what')or Word('why')or Word('where')or Word('who')or\r
488         Word('how')or Word('which')or Word('when')or\r
489         Word('tell me')then RL(458)else\r
490      case random(3) of 0:RL(443); 1:RL(477); 2:RL(478)end\r
491     else RL(439);\r
492     if Vb=69 then  { Robot }\r
493      if here(46)then RL(508)\r
494      else RL(584);\r
495     if Vb=71 then  { Computer }\r
496      if here(37) then RL(545)\r
497      else RL(546)\r
498   end; {characters}\r
499 \r
500  end; {main case}\r
501 end; { Default6 }\r
502 {----------}\r
503 overlay procedure Default7;\r
504 begin\r
505 case Vb of\r
506 \r
507 { READ }\r
508 31:case N1 of\r
509     12:RB2(6,13);\r
510     19:begin RB(12,7);Pause end\r
511     else writeln('There is nothing on the ',FN(N1),' to read.')\r
512    end;\r
513 \r
514 { TOUCH }\r
515 75:if 26 in Wear then RL(571)else\r
516     case N1 of\r
517      1,22..25:if N1 in Socket then RL(569)else RL(570);\r
518      79:RL(552);\r
519      120:RL(551);\r
520      34,103,115:writeln('You can''t reach the ',NStr,'.')\r
521      else writeln('You feel nothing unusual about the ',NStr,'.')\r
522     end;\r
523 \r
524 { TASTE }\r
525 84:case N1 of\r
526     6:RL(377);\r
527     29,92,99:if MugCon=99 then RL(70) else RL(71);\r
528     111:RL(466)\r
529     else writeln('It tastes like a ',NStr,' should taste.')\r
530    end;\r
531 \r
532 { SMELL }\r
533 83:case N1 of\r
534     6:RL(378);\r
535     29,99:if MugCon=99 then RL(72)else RL(599);\r
536     111:RL(466)\r
537     else\r
538      if Prm in[42..50]then RL(572)\r
539      else writeln('It smells like an ordinary ',NStr,'.')\r
540    end;\r
541 \r
542 { LISTEN }\r
543 65:case N1 of\r
544     42:RL(501);\r
545     62:if Region=4 then RL(573)else RL(574);\r
546     111:RL(73)\r
547     else writeln('The ',NStr,' is not making any sound.')\r
548    end;\r
549 \r
550 { HELLO }\r
551 80:if(word='hi')or(word='hello')then writeln('Hello to you.') else RL(74);\r
552 \r
553 { YES/NO/MAYBE }\r
554 81:RL(random(6)+75);\r
555 \r
556 { COMMANDS }\r
557 95:begin RB(4,11);Pause;RB(6,11);Pause;end;\r
558 \r
559 { ATTACK }\r
560 93:if Pr=6 then\r
561     if(N2 in Mov)or(N2=60)then\r
562      case N1 of\r
563       60:begin Cur(2);write('Are you sure? ');read(kbd,CFlag);Cur(3);writeln;\r
564           if upcase(CFlag)='Y' then begin RL(488);Add(128);end\r
565           else writeln('Whew!')end;\r
566       123:RL(465);\r
567       124:case random(6) of\r
568            0:RL(175);\r
569            1:begin RL(176);Add(7)end;\r
570            2:begin RL(177);Van(N2);R[N2]:=Prm;end;\r
571            3:begin RS(33);T[3]:=26;T[4]:=23;T[5]:=33;end;\r
572            4:begin RS(34);Van(N2);Prm:=13;Add(7)end;\r
573            5:begin RS(36);T[7]:=9;PStat:=PStat+[4];Add(7)end\r
574           end\r
575       else writeln('The ',FN(N1),' offers no resistance.')\r
576      end\r
577     else crazy\r
578    else NoSense;\r
579 \r
580  end; {main case}\r
581 end; { Default7 }\r
582 {----------}\r
583 overlay procedure Default8;\r
584  label JUMP;\r
585 begin\r
586 case Vb of\r
587 \r
588 { TURN }\r
589 50:if Pr=Null then   {eg. turn knob}\r
590     case N1 of\r
591      48:JUMP:begin\r
592          if Prm=SinkRm then begin SinkRm:=Null;L[Prm]:=L[Prm]-[79];RL(81)end\r
593          else if Prm in[5,12] then\r
594                begin SinkRm:=Prm;L[Prm]:=L[Prm]+[79];RL(82)end\r
595               else RL(540)\r
596         end\r
597      else RL(83)\r
598     end {case}\r
599    else\r
600     if input='' then  {eg. turn sink on}\r
601      case N1 of\r
602       2:begin RL(460);Score(5,123);\r
603         case random(4)of\r
604          0:for i:=20 to random(99)+50 do play(20,i,1);\r
605          1:for i:=random(5000)+4500 downto 20 do begin sound(i);\r
606             delay(1);sound(31)end;\r
607          2:begin i:=random(9999)+1;x:=0;repeat j:=random(9999);play(j,i,0);\r
608             i:=random(9999)+1;play(i,j,0);x:=x+1;until x>9 end;\r
609          3:for x:=1 to 200 do begin i:=random(9999)+1;play(i,i,1);delay(16)end\r
610         end;nosound;if Region=5 then sound(60);\r
611        end;\r
612       37,38:RL(373);\r
613       48,79,98:goto JUMP;\r
614       46:RL(360);\r
615       127:if NStr<>'window' then RL(360);\r
616       131:RL(84)\r
617       else crazy\r
618      end\r
619     else             {eg. turn dial to 123}\r
620      if Pr=1 then\r
621       if N1=48 then\r
622        case Prm of\r
623         79:begin;end;\r
624        end\r
625       else crazy\r
626      else NoSense;\r
627 \r
628 { OPEN and UNLOCK }\r
629 41,88:\r
630   if N1=5 then RL(289)\r
631   else\r
632    if N2=Null then\r
633     case N1 of { if N1 only }\r
634      56:RL(409)\r
635      else RL(100)\r
636     end\r
637    else\r
638     if Pr=6 then\r
639      if N1=56 then\r
640       if Prm in[9,11] then\r
641        if N2=3 then RL(101)\r
642        else crazy\r
643       else\r
644        if Prm=10 then\r
645         if N2=3 then begin RL(102);Add(11)end\r
646         else crazy\r
647        else RL(103)\r
648      else\r
649       if N1 in[32,38,45,55,62,68,69,78,89,90,119] then RL(103)\r
650       else crazy\r
651     else NoSense;\r
652 \r
653  end; {main case}\r
654 end; { Default8 }\r
655 {----------}\r
656 overlay procedure Default9;\r
657  label JUMP;\r
658 begin\r
659 case Vb of\r
660 \r
661 { LOOK INSIDE }\r
662 24:case N1 of\r
663     5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')\r
664       else RL(110);\r
665     7:if HolstCon=Null then RL(580)else\r
666        writeln('The gun strap contains a ',FN(HolstCon),'.');\r
667     18:if en(34)then RL(270)else RL(271);\r
668     29:if MugCon<>Null then writeln('The mug contains ',FN(MugCon),'.')\r
669        else RL(111);\r
670     35:if NStr='toilet' then RL(114)else RL(113);\r
671     7,10,26,28,32,62,64,69,98,113:writeln('The ',NStr,' is empty.');\r
672     119:RL(112);\r
673     103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
674     else RL(113)\r
675    end;\r
676 \r
677 { LOOK UNDER, LOOK BEHIND and REACH IN }\r
678 20,26,76:\r
679    case N1 of\r
680     5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')\r
681       else RL(110);\r
682     80:if not en(127) then begin RS(16);Add(127)end else RL(116);\r
683     103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
684     else RL(116)\r
685    end;\r
686 \r
687 { LOOK ON TOP }\r
688 22:case N1 of\r
689     66:RL(117);\r
690     80:RL(118);\r
691     99:RL(119);\r
692     103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
693     else RL(120)\r
694    end;\r
695 \r
696 { CLUE }\r
697 70:begin if Sc<25 then begin RL(302);goto JUMP;end;\r
698     if not en(15) then\r
699      begin Add(15);RS(30);\r
700       Cur(2);\r
701       write('Do you still wish to see the clue? ');read(kbd,CFlag);writeln;\r
702       if upcase(CFlag)='N' then\r
703        begin writeln('OK, no clue will be shown.');goto JUMP;end\r
704      end;\r
705     Cn('---Here is your clue---');Sc:=Sc-25;\r
706     if(Prm<>StoreC)then\r
707      begin StoreC:=Prm;\r
708       seek(C1,Prm);\r
709       read(C1,Text5)\r
710      end;\r
711     col(12,9);Cn(Text5);col(11,7); JUMP:\r
712    end; { Read Clue }\r
713 \r
714  end; {main case}\r
715 end; { Default9 }\r
716 {----------}\r
717 overlay procedure Default10;\r
718 begin\r
719 case Vb of\r
720 \r
721 { PUT }\r
722 33:begin SFlag:=False;if VStr='fill' then begin x:=N1;N1:=N2;N2:=x;end;\r
723     if((N1 in Mov)and(N1 in Inv))or(N1 in[66,79])then\r
724      case N2 of\r
725       64:case Prm of\r
726          34:if N1 in[3,8,9] then\r
727              if Pr=5 then\r
728               if PyraCon=Null then\r
729                begin Van(N1);R[N1]:=34;PyraCon:=N1;\r
730                 if N1=9then begin RS(83);Walls(8);Add(30)end else RL(224)\r
731                end\r
732               else RL(223)\r
733              else RL(222)\r
734             else RL(221);\r
735          end;\r
736      126:if en(31) then\r
737           if N1 in[3,8,9] then\r
738            if Pr in[1,5,7,10] then\r
739             if HingeCon=Null then\r
740              begin Van(N1);R[N1]:=34;HingeCon:=N1;RL(231)end\r
741             else RL(230)\r
742            else NoSense\r
743           else RL(229)\r
744          else RL(232);\r
745       35:if Prm=1 then\r
746           if N1=16 then\r
747            begin Van(16);Add(6);R[16]:=1;RL(144);Score(5,25)end\r
748           else begin RL(143);Van(N1);R[N1]:=1;end;\r
749       120:begin RL(550);Van(N1)end;\r
750       62:if Prm in[22,24] then\r
751           if en(23) then begin Van(N1);R[N1]:=2;RL(134)end else RL(99);\r
752       66:begin if random(2)=0 then RL(375)else RL(376);Van(N1)end;\r
753       42:RL(495);\r
754       29:if MugCon=Null then\r
755           if N1 in[3,4,9,17,19,66,79,99] then begin\r
756            writeln('The ',FN(N1),' is now in the mug.');\r
757            if N1 in Mov then Van(N1);L[Prm]:=L[Prm]+[N1];MugCon:=N1;end\r
758           else if N1 in Mov then RL(137)else crazy\r
759          else RL(136);\r
760       5 :if SatchCon=Null then\r
761           if N1 in[3,4,6,8,9,12,17,19] then\r
762            begin Van(N1);L[Prm]:=L[Prm]+[N1];SatchCon:=N1;\r
763             writeln('The ',FN(N1),' is now in the brown satchel.')end\r
764           else if N1 in Mov then RL(137)else crazy\r
765          else RL(138);\r
766       7 :if HolstCon=Null then\r
767           if N1 in[3,4,8,9,12,17,19] then\r
768            begin Van(N1);L[Prm]:=L[Prm]+[N1];HolstCon:=N1;\r
769             writeln('The ',FN(N1),' is now in the holster.')end\r
770           else if N1 in Mov then RL(137)else crazy\r
771          else RL(581);\r
772      end {main N2 case}\r
773     else writeln('First you must have the ',FN(N1),'.');\r
774 \r
775      if not SFlag then\r
776       case Pr of\r
777        1:if N2 in[32..37,49,71,80,83..87,90,93,98,113,112,126,132] then\r
778           begin Van(N1);R[N1]:=Prm;\r
779            writeln('The ',FN(N1),' is now on the ',FN(N2),'.')end\r
780          else RL(139);\r
781        5:RL(139);\r
782        7:if N2 in[32,35,37,49,51,54,56,62,66..73,80..87,89,90,94..98,104,112,\r
783                   113,116,120..122,125..128,132] then\r
784           begin Van(N1);R[N1]:=Prm;\r
785            writeln('The ',FN(N1),' is now beside the ',FN(N2),'.')end\r
786          else RL(139);\r
787       10:if N2 in[80,81,83..86,98,104,112] then\r
788           begin Van(N1);R[N1]:=Prm;\r
789            writeln('The ',FN(N1),' is now under the ',FN(N2),'.')end\r
790          else RL(139)\r
791        else crazy\r
792       end\r
793 \r
794    end\r
795 \r
796  end; {main case}\r
797 end; { Default10 }\r
798 {----------}\r
799 overlay procedure Default11;\r
800 begin\r
801 case Vb of\r
802 \r
803 { PUSH and TURN ON }\r
804 44:if(VStr='turn on')or(VStr='activat')then\r
805     case N1 of\r
806      2:begin RL(460);Score(5,117);\r
807         case random(4)of\r
808          0:for i:=400 to random(250)+420 do play(400,i,1);\r
809          1:begin y:=random(35)+2;for x:=1 to 99 do\r
810             begin i:=random(9000)+60;play(i,i,y);delay(y)end end;\r
811          2:for x:=1 to random(230)+21 do\r
812             for y:=1 to random(230)+22 do sound(x*y);\r
813          3:for i:=1 to random(9999)+999 do sound(random(i)+i);\r
814         end;nosound;if Region=5 then sound(60);\r
815        end;\r
816      37,38:RL(373);\r
817      98,48:if Prm=SinkRm then say('water','flowing out')\r
818         else begin SinkRm:=Prm;L[Prm]:=L[Prm]+[79];RL(82)end;\r
819      127:if NStr<>'window' then RL(360)\r
820      else RL(164)\r
821     end\r
822    else\r
823     case N1 of\r
824      116:if Prm in[42..50]then RL(282)else RL(281);\r
825      123:RL(472)\r
826      else RL(103)\r
827     end;\r
828 \r
829 { PULL and TURN OFF }\r
830 42:if(VStr='turn off')or(VStr='deactiv')then\r
831     case N1 of\r
832      98,48,79:if Prm<>SinkRm then say('water','off')\r
833         else begin SinkRm:=Null;L[Prm]:=L[Prm]-[79];RL(81)end;\r
834      127:if NStr<>'window' then RL(360)else RL(165)\r
835      else RL(165)\r
836     end\r
837    else RL(103);\r
838 \r
839 { CLEAN }\r
840 94:case N1 of\r
841     18:if en(34) then RL(265) else\r
842         begin if 18 in L[41] then R[18]:=41;Score(15,34);\r
843          RS(91);n[18]:='glass ball\ball\glass\';;;end;\r
844     126:if NStr='bar' then RL(167);\r
845     80:RL(166);\r
846     98:RL(168)\r
847     else writeln('The ',NStr,' doesn''t need to be cleaned.');\r
848    end;\r
849 \r
850 { RESTART }\r
851 86:begin Bor(1,0);Cur(2);\r
852     write('Are you sure you want to restart your game? ');\r
853     read(kbd,CFlag);\r
854     if upcase(CFlag)<>'Y' then RL(169)\r
855     else\r
856      begin RL(170);delay(2000);window(1,1,80,25);clrscr;Bor(0,0);nosound;\r
857       close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
858       assign(R1,'nova.com');execute(R1)\r
859      end;Bor(0,0);\r
860    end;\r
861 \r
862 { SHOOT }\r
863 89:RL(171);\r
864 \r
865 { TIE and UNTIE }\r
866 90:if VStr='tie' then RL(172)else if VStr='untie' then RL(173)else RL(437);\r
867 \r
868 { FIND }\r
869 73:if N1 in Inv then\r
870     writeln('You are carrying the ',NStr,'.')\r
871    else writeln('The ',NStr,' is close by, just look around.');\r
872 \r
873  end; {main case}\r
874 end; { Default11 }\r
875 {----------}\r
876 overlay procedure Default12;\r
877 begin\r
878 case Vb of\r
879 \r
880 { HIT and BREAK }\r
881 54:if N2<>Null then\r
882     if(N2 in Mov)or(N2=60)then\r
883      if N1<>N2 then\r
884       if Pr in[3,6] then\r
885        case N1 of\r
886         1:if(Prm=56)and(1 in L[56])then RL(300)else RL(83);\r
887         18:if N2 in[10,11,29] then begin RS(97);Van(18);R[4]:=Prm;end\r
888            else RL(272);\r
889         123:RL(416)\r
890         else RL(273)\r
891        end {case}\r
892       else NoSense\r
893      else crazy\r
894     else crazy\r
895    else { N2=Null }\r
896     case N1 of\r
897      18:RL(274)\r
898      else\r
899       if random(3)=0 then\r
900        writeln('At the last moment you decide to spare the ',NStr,'''s life!')\r
901       else writeln('Hitting the ',NStr,' doesn''t help.')\r
902     end;\r
903 \r
904 { THROW }\r
905 48:if N2<>Null then\r
906     if N1 in Inv then\r
907      if N1 in Mov then\r
908       if N1<>N2 then\r
909        if Pr in[1..5] then\r
910         begin\r
911          if(N1=29)and(MugCon in[79,92,99])then begin\r
912           MugCon:=Null;RL(585);SFlag:=false;end;\r
913          if(N2=1)and(Prm=56)and(1 in L[56])then\r
914           begin Van(N1);R[N1]:=56;RL(301)end;\r
915          if(N2=49)and(Prm=56)and(N1 in[1,10,18,29])then\r
916           begin RS(112);Add(128);end;\r
917          if(N2=69)and(Prm=91)then begin RS(160);L[91]:=L[91]+[123];\r
918           L[91]:=L[91]-[44,129];T[23]:=15;Add(51);Van(N1);R[N1]:=91;end;\r
919          if(N1 in[1,22..25])then begin Van(N1);RL(430)end;\r
920          if(N2=46)and(Prm in[99,101])then begin RL(514);Blast;\r
921           if Prm=99 then T[27]:=2000 else T[28]:=2000;Van(N1)end;\r
922          case N2 of\r
923           1,22..25:begin Van(N2);RL(431)end;\r
924           42:begin Van(N1);RL(515)end;\r
925           66:begin RL(375);Van(N1)end;\r
926           111:begin RL(449);Van(N1)end;\r
927           120:begin RL(550);Van(N1)end;\r
928           123:begin RL(450);RL(451);Van(N1);R[N1]:=Prm;end;\r
929           124:begin RL(452);RL(453);Van(N1);R[N1]:=Prm;end;\r
930           127:if Prm=64 then if Md=3 then begin RL(537);Add(128);end else RL(538);\r
931          end;\r
932          if(N1=18)or(N2=18)then\r
933           begin Van(N1);R[N1]:=Prm;Van(18);RS(97);R[4]:=Prm;end;\r
934          if not SFlag then begin writeln('The ',FN(N1),' collides with the ',\r
935          FN(N2),', but nothing interesting happens.');Van(N1);R[N1]:=Prm;end\r
936         end\r
937        else NoSense\r
938       else crazy\r
939      else crazy\r
940     else writeln('First you must have the ',FN(N1),'.')\r
941    else { N2=Null }\r
942     begin Van(N1);R[N1]:=Prm;RL(275)end;\r
943 \r
944  end; {main case}\r
945 end; { Default12 }\r
946 {----------}\r
947 overlay procedure Default13;\r
948 begin\r
949 case Vb of\r
950 \r
951 { CLOSE }\r
952 53:case N1 of\r
953     5:RL(289);\r
954     56:RL(92)\r
955     else writeln('The ',NStr,' is not something that can be closed.')\r
956    end;\r
957 \r
958 { SCORE }\r
959 78:begin col(11,7);\r
960     write('In ');col(12,9);write(Tic);col(11,7);\r
961     write(' moves you scored ');col(12,9);write(Sc);col(11,7);\r
962     writeln(' out of a possible 1000 points.');\r
963     write('This score earns you the rank of ');col(12,9);\r
964     case Sc of\r
965     0..9:writeln(Up('ABSOLUTE BEGINNER!'));\r
966     10..99:write('Rookie');\r
967     100..179:write('Struggling');\r
968     180..259:write('Novice');\r
969     260..349:write('Competent');\r
970     350..449:write('Fair');\r
971     450..549:write('Good');\r
972     550..649:write('Great');\r
973     650..744:write('Brilliant');\r
974     745..829:write('Genius');\r
975     830..899:write('Elite');\r
976     900..949:write('Champion');\r
977     950..1000:write('Galaxy Class')\r
978     end;\r
979     if Sc>9 then writeln(' Adventurer.')\r
980    end;\r
981 \r
982 { REPAIR }\r
983 74:RL(357);\r
984 \r
985 { FOLLOW }\r
986 91:if VStr='follow' then\r
987     case N1 of 123:RL(358);124:RL(359)\r
988      else writeln('Why, did the ',NStr,' leave?')\r
989     end else RL(432+random(5)); { for Scott in VOCAB! }\r
990 \r
991 { WEAR }\r
992 72:if N1 in[7,20,26,28]then\r
993     if N1 in Inv then\r
994      if not(N1 in Wear)then\r
995       begin Wear:=Wear+[N1];writeln('You are now wearing the ',FN(N1),'.');\r
996        if(Prm in[102..105])and(N1=20)then RL(503);\r
997       end\r
998      else writeln('You are already wearing the ',FN(N1),'.')\r
999     else writeln('First you must have the ',FN(N1),'.')\r
1000    else crazy;\r
1001 \r
1002 { REMOVE }\r
1003 19:if N1 in Wear then begin Wear:=Wear-[N1];\r
1004     writeln('You are no longer wearing the ',FN(N1),'.');\r
1005     if Prm in[102..105]then RL(492)end\r
1006    else writeln('You are not wearing the ',FN(N1),' to begin with.');\r
1007 \r
1008 { TYPE }\r
1009 56:if here(37)or here(52)then RL(273)else RL(361);\r
1010 \r
1011  end; {main case}\r
1012 end; { Default13 }\r
1013 {----------}\r
1014 overlay procedure Default14;\r
1015 begin\r
1016 case Vb of\r
1017 \r
1018 { SHOW / GIVE }\r
1019 49:if N2 in[46,111,123,124]then\r
1020     if Pr=1 then\r
1021      case N2 of\r
1022       46:RL(447);\r
1023       111:if N1=8 then begin Inv:=Inv+[29];Van(8);Score(10,21);RS(11);\r
1024            T[1]:=21;Add(9);Add(16)end\r
1025           else RL(444);\r
1026       124:RL(445);\r
1027       123:RL(446)\r
1028      end\r
1029     else nosense\r
1030    else crazy;\r
1031 \r
1032 { JUMP }\r
1033 59:if N1<>Null then\r
1034     if(VStr='jump over')or(VStr='leap over')or(VStr='jump across')then\r
1035      if N1 in[1..29,36,49,51,69,71,73,132]then\r
1036       writeln('You land on the other side of the ',NStr,'.')\r
1037      else crazy\r
1038     else\r
1039      if(VStr='jump off')and en(8)then begin RL(475);Min(8)end else\r
1040      if N1 in[34,56,60,62,68,72,82,92] then crazy else\r
1041      if(N1 in[1..29])and not(N1 in Inv)then\r
1042       writeln('You land on the ',NStr,'.')\r
1043      else\r
1044       if NStr='quicksa' then begin RL(582);Add(128)end else\r
1045       if NStr='swamp' then begin RL(583);Add(128)end\r
1046       else RL(476)\r
1047    else\r
1048     if(VStr='jump off')and en(8)then begin RL(475);Min(8)end\r
1049     else RL(539);\r
1050 \r
1051 { DIG }\r
1052 92:case N1 of\r
1053     49,116,122:RL(556);\r
1054     120:RL(557)\r
1055     else crazy\r
1056    end;\r
1057 \r
1058 { TALK / GREET }\r
1059 21:if VStr='greet' then\r
1060     case N1 of 111:RL(51); 124:RL(46); 123:RL(441) else crazy end\r
1061    else\r
1062     if N1 in[111,123,124] then\r
1063      begin writeln('To talk to the ',FN(N1),' enter:');\r
1064       writeln(FN(N1),', < what you want to say goes here >')\r
1065      end\r
1066     else crazy;\r
1067 \r
1068 25:RS(245);\r
1069 \r
1070  end; {main case}\r
1071 end; { Default14 }\r
1072 {----------}\r
1073 overlay procedure DeadMain;\r
1074   label JUMP;\r
1075  begin writeln;\r
1076   gotoxy(1,20);for x:=5 downto 1 do\r
1077    begin writeln;delay(99);sound(300+(x*50));Bor(x,7)end;\r
1078   repeat x:=random(14)+1 until not(x in [4,12]);\r
1079   gotoxy(1,15);col(x,15);bak(4,7);\r
1080   writeln('***************************************',\r
1081           '***************************************');\r
1082   delay(99);sound(300);Bor(6,0);\r
1083   gotoxy(1,16);for x:=3 downto 1 do begin\r
1084   write('*                                      ',\r
1085         '                                      *');\r
1086         delay(99);sound(100+(x*50));Bor(x+8,15)end;gotoxy(1,19);\r
1087   write('***************************************',\r
1088         '***************************************');\r
1089   delay(99);sound(100);Bor(14,0);\r
1090   gotoxy(30,17);col(16,31);write('YOU HAVE DIED!!!');delay(99);sound(50);\r
1091   gotoxy(1,20);bak(0,0);col(11,7);Bor(12,7);writeln;delay(99);nosound;\r
1092   delay(999);i:=random(3)+2;\r
1093   tune(i,3,830);tune(i,3,770);tune(i,3,200);tune(i,3,0);delay(800);\r
1094   tune(i,6,400);tune(i,5,400);tune(i,5,400);\r
1095   tune(i,3,400);tune(i,3,400);tune(i,2,400);tune(i,3,810);\r
1096   JUMP: Col(11,7);Cur(2);\r
1097   repeat\r
1098    write('Would you like to ');Col(14,15);write('S');Col(11,7);\r
1099    write('tart a new game, ');Col(14,15);write('R');Col(11,7);\r
1100    write('estore or ');Col(14,15);write('Q');Col(11,7);write('uit? ');\r
1101    read(kbd,CFlag);CFlag:=upcase(CFlag);Col(9,15);writeln(CFlag);\r
1102    play(500,500,40);Col(11,7);\r
1103   until CFlag in['S','R','Q'];Bor(0,0);Cur(3);\r
1104   case CFlag of\r
1105    'S':begin RL(170);delay(1500);window(1,1,80,25);clrscr;\r
1106         close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
1107         assign(R1,'nova.com');execute(R1)\r
1108        end;\r
1109    'R':begin Min(126);Restore;if not en(126)then goto JUMP end;\r
1110    'Q':begin window(1,1,80,25);clrscr;Col(3,7);\r
1111         close(R1);close(R2);close(S1);close(L1);close(C1);close(T1);close(T2);\r
1112         writeln('In ',Tic,' moves you scored ',Sc,\r
1113                 ' out of a possible 1000 points.');writeln;\r
1114         Col(31,16);Bak(1,7);writeln('Good-bye!');writeln;Cur(1);\r
1115         HALT;\r
1116        end\r
1117   end {case}\r
1118  end; {DEAD}\r
1119 \r
1120 procedure DEAD; begin DEADMAIN end;\r
1121 procedure Call13; begin Default13 end;\r
1122 {************************* END OF DEFAULT ROUTINES **************************}\r
1123 \1a