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