1 {//-------------------------------------------------------------------------}
\r
3 {Copyright (C) 2014 Jason Self <j@jxself.org> }
\r
5 {This file is free software: you may copy, redistribute and/or modify it }
\r
6 {under the terms of the GNU Affero General Public License as published by }
\r
7 {the Free Software Foundation, either version 3 of the License, or (at your }
\r
8 {option) any later version. }
\r
10 {This file is distributed in the hope that it will be useful, but WITHOUT }
\r
11 {ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or }
\r
12 {FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License}
\r
13 {for more details. }
\r
15 {You should have received a copy of the GNU Affero General Public License }
\r
16 {along with this program; if not, see https://gnu.org/licenses or write to: }
\r
17 { Free Software Foundation, Inc. }
\r
18 { 51 Franklin Street, Fifth Floor }
\r
19 { Boston, MA 02110-1301 }
\r
22 {This file incorporates work covered by the following copyright and }
\r
23 {permission notice: }
\r
25 {Copyright (C) 1990, 2009 - Apogee Software, Ltd. }
\r
27 {This file is part of Supernova. Supernova is free software; you can }
\r
28 {redistribute it and/or modify it under the terms of the GNU General Public }
\r
29 {License as published by the Free Software Foundation; either version 3 }
\r
30 {of the License, or (at your option) any later version. }
\r
32 {This program is distributed in the hope that it will be useful, }
\r
33 {but WITHOUT ANY WARRANTY; without even the implied warranty of }
\r
34 {MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. }
\r
36 {See the GNU General Public License for more details. }
\r
38 {You should have received a copy of the GNU General Public License }
\r
39 {along with this program; if not, see https://gnu.org/licenses or write to: }
\r
40 { Free Software Foundation, Inc. }
\r
41 { 51 Franklin Street, Fifth Floor }
\r
42 { Boston, MA 02110-1301 }
\r
45 {Original Source: 1990 Scott Miller }
\r
46 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }
\r
48 {//-------------------------------------------------------------------------}
\r
49 (****************************************************************************)
\r
50 (* DEFAULT ROUTINES *)
\r
51 (* >> Contains the default routines used by Supernova << *)
\r
52 (* Programmer: Scott Miller *)
\r
53 (* << Began February 2, 1985 >> *)
\r
54 (* Copyright 1985 Scott Miller *)
\r
55 (****************************************************************************)
\r
60 { N, S, E, W, etc. }
\r
66 if Prm>7 then writeln('There is not a path leading ',up(Dir[Vb]),'.')
\r
67 else writeln('There is not passage in that direction.')
\r
71 30:begin Brief:=Brief-[Prm];Describe(Prm);
\r
72 if(Prm=56)and(T[17]>4)then begin RS(114);RS(115);Pause;end;
\r
89 16:if not(Inv=[]) then
\r
91 writeln('You have in your possession...');
\r
96 if o=6 then write(' some ',FN(o)) else write(' a ',FN(o));
\r
97 if o in Wear then write(' (being worn)');
\r
99 5:if SatchCon<>Null then write(' (contains something)');
\r
100 7:if HolstCon<>Null then write(' (contains something)');
\r
101 29:if MugCon<>Null then write(' (has something in it)');
\r
102 end;if o in Inv then writeln;
\r
109 18:if not(30 in NounSet)then
\r
110 for o:=1 to NMax do
\r
111 if o in NounSet 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
119 else writeln('You don''t have the ',FN(o),'.')
\r
122 begin Min(17); { DROP ALL }
\r
123 for o:=1 to MMax do
\r
126 write(FN(o),': ');Add(17);
\r
128 writeln('First you must remove the ',FN(o),'.')
\r
129 else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;
\r
131 if not en(17)then RL(303)
\r
136 for o:=1 to MMax do
\r
137 if(o in Inv)and not(o in NounSet)then
\r
141 writeln('First you must remove the ',FN(o),'.')
\r
142 else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;
\r
149 procedure Default2;
\r
154 { ROOM DESCRIPTION }
\r
155 77:if not(en(1))then begin Add(1);RL(14)end
\r
156 else begin Min(1);RL(15)end;
\r
160 writeln('In ',Tic,' moves you scored ',Sc,
\r
161 ' out of a possible 1000 points.');
\r
162 writeln('If you want to continue this game at a later date you ',
\r
163 'should first use the');writeln('SAVE command.');
\r
164 write('Are you still sure you want to QUIT? ');
\r
167 if upcase(CFlag)='Y' then
\r
169 RL(12);delay(2200);
\r
170 close(R1);close(R2);close(S1);close(L1);close(C1);
\r
172 close(T1);if IOResult<>0 then begin end;
\r
173 close(T2);if IOResult<>0 then begin end;
\r
176 window(1,1,80,25);nosound;clrscr;Cur(1);Bor(0,0);gotoxy(2,2);
\r
177 Col(31,16);Bak(4,7);writeln('Good-bye!');halt;
\r
179 else RL(13);Bor(0,0);
\r
183 62:if(T[5]>32)and(T[8]<1)then
\r
184 if(N1 in[19,27,49,69,80,113])then
\r
185 begin T[2]:=6;Add(7);
\r
186 writeln('You lie down on the ',NStr,
\r
187 ' and fall asleep within a few minutes.');
\r
191 if N1 in[69,80] then
\r
193 T[5]:=230;PStat:=PStat-[5];Bor(0,0);Add(7);
\r
195 69:if T[8]<1 then begin RS(41);Add(128) end
\r
196 else begin RS(42);Add(7);Add(10)end;
\r
198 if not en(18)then RS(218)
\r
199 else case random(2)of 0:RS(218);1:RS(219)end
\r
200 else begin RS(220);Add(128) end
\r
203 else writeln('The ',FN(N1),' is not a suitable place to sleep.');
\r
206 35:if(N1 in[16,32,35,49,54,69,71,80,83..86,98,110])then
\r
209 69:if T[8]<1 then begin RS(41);Add(128) end
\r
210 else begin RS(42);T[5]:=160;PStat:=PStat-[5];Add(7);Add(10)end
\r
211 else writeln('You sit down on the ',NStr,'.')
\r
218 begin Min(7);Min(2);Min(3);Min(19);T[6]:=Null;RL(18)end
\r
222 9,51:if(N1 in[32,35,54,68,71,80,81,83..86,89,98,112,125])then
\r
224 writeln('You manage to climb up the ',NStr,'.');
\r
227 if(Vb=9)then writeln('There is not a path in that direction.')
\r
232 begin Min(8);RL(21)end
\r
233 else writeln('There is not a path in that direction.');
\r
236 11,13:writeln('Due to the multiple paths you will have to be more specific.');
\r
239 15:begin writeln('Time passes');y:=wherey;for x:=1 to 6 do
\r
240 begin gotoxy(11+x,y-1);write('.');sound(x*99);delay(30);end;
\r
241 nosound;writeln;if Region=4 then sound(20);if Region=5 then sound(60);
\r
247 procedure Default3;
\r
248 begin SFlag:=false;
\r
254 1:if en(41) then RS(116) else begin RS(116);RS(132);Score(5,41)end;
\r
258 5:begin RL(105);if SatchCon<>Null then
\r
259 if SatchCon=6 then writeln('The satchel contains ',FN(SatchCon),'.')
\r
260 else writeln('The satchel contains a ',FN(SatchCon),'.')
\r
262 6:begin RL(54);case FoodCon of 1:RL(55);2:RL(56);3:RL(57);4:RL(58)end end;
\r
263 7:begin RL(579);if HolstCon=Null then RL(580)else
\r
264 writeln('The gun strap contains a ',FN(HolstCon),'.')end;
\r
272 18:if en(34) then begin Score(5,116);RS(92)end else RL(267);
\r
273 19:begin RB(12,11);Pause end;
\r
275 22:begin RL(527);if 22 in Socket then RL(528)end;
\r
276 23:begin RL(529);if 23 in Socket then RL(528)end;
\r
277 24:begin RL(530);if 24 in Socket then RL(528)end;
\r
278 25:begin RL(531);if 25 in Socket then RL(528)end;
\r
280 28:if NStr='badge' then RL(406)else if Md=1 then RL(407)else RL(408);
\r
281 29:begin write('The mug is quite small. ');
\r
282 if MugCon=Null then RL(60)else RL(61)end;
\r
283 42:begin RS(195);RS(196)end;
\r
284 54:if NStr='column' then begin RS(195);RS(196)end;
\r
285 56:begin RL(92);if Prm in[81..88]then RL(423)end;
\r
286 62:case Prm of 21,25:RS(15);22,24:RS(246)end;
\r
288 103:case Prm of 24..34,59,60:RL(317)else RL(326)end;
\r
295 0..6:writeln('You can''t find anything unusual about the ',FN(N1),'.');
\r
296 7..14:writeln('You see nothing special about the ',FN(N1),'.');
\r
297 15..17:writeln('It looks like any other ',NStr,' you''ve ever seen.');
\r
298 18..20:writeln('It looks like an ordinary ',NStr,'.')
\r
304 begin RL(68);FoodCon:=FoodCon-1;T[3]:=175;PStat:=PStat-[2];Bor(0,0);
\r
305 if FoodCon=0 then begin Van(6);RL(69)end
\r
307 else writeln('The ',NStr,' would not do much for your digestive system.')
\r
312 procedure Default4;
\r
318 Weight:=Null;Min(17);
\r
319 for o:=1 to MMax do if o in Inv then
\r
320 begin Weight:=Weight+1;if o=11 then Weight:=Weight+3 end;
\r
321 if not(30 in NounSet)then
\r
322 for o:=1 to NMax do
\r
323 if o in NounSet then
\r
327 Weight:=Weight+1;if o=11 then Weight:=Weight+3;
\r
329 if not(o in Inv)then
\r
330 if(o in Socket)and not(26 in Wear)then RL(524) else
\r
331 begin if(o=PyraCon)and(o=9)then Walls(8);
\r
332 writeln('Taken.');Van(o);Inv:=Inv+[o];
\r
334 else writeln('You already have that.')
\r
337 if o=11 then Weight:=Weight-3;
\r
340 else begin write(FN(o),': ');
\r
341 if N1 in[32,35,80,83..86,90,121]then RL(502)else crazy;end
\r
345 for o:=1 to MMax do
\r
349 write(FN(o),': ');Add(17);
\r
350 Weight:=Weight+1;if o=11 then Weight:=Weight+3;
\r
352 if(o in Socket)and not(26 in Wear)then RL(524) else
\r
353 begin writeln('Taken.');Van(o);Inv:=Inv+[o]end
\r
356 if o=11 then Weight:=Weight-3;
\r
359 if not en(17)then RL(29)
\r
365 Weight:=Null;Min(17);
\r
366 for o:=1 to MMax do if o in Inv then
\r
367 begin Weight:=Weight+1;if o=11 then Weight:=Weight+3 end;
\r
368 for o:=1 to MMax do
\r
369 if(o in Mov)and not(o in NounSet)then
\r
373 Weight:=Weight+1;if o=11 then Weight:=Weight+3;
\r
375 if(o in Socket)and not(26 in Wear)then RL(524) else
\r
376 begin writeln('Taken.');Van(o);Inv:=Inv+[o];Add(17)end
\r
379 if o=11 then Weight:=Weight-3;
\r
382 if not en(17)then RL(29)
\r
388 procedure Default5;
\r
395 if N1=100 then RS(10) else
\r
396 if(N1 in[29,99])or(Pr=11)then
\r
398 if N2 in[8,111] then
\r
400 begin Inv:=Inv+[29];Van(8);Score(15,21);RS(11);T[1]:=21;Add(9);Add(16)
\r
406 if(N1 in[29,99,111,124])and(N2 in[29,99,111,124])then begin
\r
407 if(N1=111)xor(N2=111)then RL(196)else
\r
408 if(N1=124)xor(N2=124)then RL(197)
\r
413 if N2<>124 then RL(34) else RL(35)
\r
415 if Prm=AlienRm then RL(35) else
\r
416 if Prm=FriendRm then RL(36)
\r
422 if(Prm=8)and not(29 in Inv)then RL(67) else
\r
423 JUMP: if MugCon<>Null then
\r
425 99:begin MugCon:=Null;T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(64)end;
\r
426 79:begin MugCon:=Null;T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66);
\r
428 92:JUMP1:begin MugCon:=Null;
\r
429 if T[12]<2 then RL(162)else
\r
430 if en(42) then begin RS(136);Van(92);T[12]:=Null;Bor(0,0);
\r
431 PStat:=PStat-[3];Score(20,124)end
\r
437 if Here(98) then { For the Sink }
\r
438 if SinkRm=Prm then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66)end
\r
441 else { If N1 = something }
\r
443 29,99:if 29 in Inv then goto JUMP else RL(87);
\r
444 98:if SinkRm=Prm then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];RL(66)end
\r
446 121,66:begin RS(12);Add(128);end;
\r
449 if(Here(29)and(MugCon=79))then
\r
450 begin T[4]:=130;Bor(0,0);MugCon:=Null;Van(79);PStat:=PStat-[6];
\r
452 else if Here(79)then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];
\r
456 else writeln('The ',NStr,' would not quench your thirst.')
\r
462 procedure Default6;
\r
463 function Word(W:Str29):boolean;
\r
464 begin if pos(' '+W+' ',input)>0 then Word:=true else Word:=false end;
\r
468 { TALKING TO CHARACTERS}
\r
470 begin Spaces(input);
\r
471 if Vb=66 then { Bartender }
\r
473 if Word('follow')then RL(46)else
\r
474 if Word('go')or Word('east')or Word('south')then RL(567)else
\r
475 if Word('hi')or Word('hello')then RL(51)else
\r
476 if Word('infocom')then RL(498)else
\r
477 if Word('scott')or Word('miller')then RL(499)else
\r
478 if Word('what')or Word('why')or Word('where')or Word('who')or
\r
479 Word('how')or Word('which')or Word('when')then RL(463)else
\r
480 if(Word('ill')or Word('give')or Word('buy')or Word('get me')or
\r
481 Word('purchas'))and(Word('drink')or Word('glunk'))then RL(47)else
\r
482 if Word('ambross')or Word('pink')or Word('bloody')or Word('foeboz')or
\r
483 Word('ztulctw')then RL(565)else
\r
484 if Word('kill')or Word('fight')or Word('hit')then RL(566)else
\r
485 if Word('give')then RL(564)else
\r
486 if Word('help')or Word('tell me')then RL(479)else
\r
487 case random(3) of 0:RL(50); 1:RL(480); 2:RL(481)end
\r
489 if Vb=67 then { Two Aliens }
\r
491 if Word('follow')then RL(48)else
\r
492 if Word('go')or Word('south')or Word('east')then RL(568)else
\r
493 if Word('crystal')then RL(484)else
\r
494 if Word('coordin')or Word('where')or Word('world')or Word('sagan')or
\r
495 Word('planet')or Word('locatio')then RL(485)else
\r
496 if Word('what')or Word('why')or Word('who')or Word('tell me')or
\r
497 Word('how')or Word('which')or Word('when')then RL(464)else
\r
498 case random(3) of 0:RL(49); 1:RL(482); 2:RL(483)end
\r
500 if Vb=68 then { Scientist }
\r
502 if Word('follow')then RL(440)else
\r
503 if Word('hi')or Word('hello')or Word('bye')then RL(441)else
\r
504 if Word('wristba')then RL(442)else
\r
505 if Word('card')or Word('green')then RL(459)else
\r
506 if Word('give')then RL(456)else
\r
507 if Word('go')or Word('east')or Word('west')then RL(457)else
\r
508 if Word('help')then RL(462)else
\r
509 if Word('ship')or Word('planets')then RL(497)else
\r
510 if Word('star')or Word('superno')then RL(486)else
\r
511 if(Word('crystal')or Word('clear'))and((T[24]>1)and(T[24]<6))and
\r
512 (1 in Inv)then begin T[24]:=Null;T[25]:=7;RS(181)end else
\r
513 if(Word('crystal')or Word('clear'))and((T[23]>1)or(T[24]>5))then
\r
515 if Word('crystal')or Word('clear')then RL(487)else
\r
516 if(Word('who')or Word('what'))and Word('you')then RL(461)else
\r
517 if Word('what')or Word('why')or Word('where')or Word('who')or
\r
518 Word('how')or Word('which')or Word('when')or
\r
519 Word('tell me')then RL(458)else
\r
520 case random(3) of 0:RL(443); 1:RL(477); 2:RL(478)end
\r
522 if Vb=69 then { Robot }
\r
523 if here(46)then RL(508)
\r
525 if Vb=71 then { Computer }
\r
526 if here(37) then RL(545)
\r
533 procedure Default7;
\r
540 19:begin RB(12,7);Pause end
\r
541 else writeln('There is nothing on the ',FN(N1),' to read.')
\r
545 75:if 26 in Wear then RL(571)else
\r
547 1,22..25:if N1 in Socket then RL(569)else RL(570);
\r
550 34,103,115:writeln('You can''t reach the ',NStr,'.')
\r
551 else writeln('You feel nothing unusual about the ',NStr,'.')
\r
557 29,92,99:if MugCon=99 then RL(70) else RL(71);
\r
559 else writeln('It tastes like a ',NStr,' should taste.')
\r
565 29,99:if MugCon=99 then RL(72)else RL(599);
\r
568 if Prm in[42..50]then RL(572)
\r
569 else writeln('It smells like an ordinary ',NStr,'.')
\r
575 62:if Region=4 then RL(573)else RL(574);
\r
577 else writeln('The ',NStr,' is not making any sound.')
\r
581 80:if(word='hi')or(word='hello')then writeln('Hello to you.') else RL(74);
\r
584 81:RL(random(6)+75);
\r
587 95:begin RB(4,11);Pause;RB(6,11);Pause;end;
\r
591 if(N2 in Mov)or(N2=60)then
\r
593 60:begin Cur(2);write('Are you sure? ');CFlag:=Readkey;Cur(3);writeln;
\r
594 if upcase(CFlag)='Y' then begin RL(488);Add(128);end
\r
595 else writeln('Whew!')end;
\r
597 124:case random(6) of
\r
599 1:begin RL(176);Add(7)end;
\r
600 2:begin RL(177);Van(N2);R[N2]:=Prm;end;
\r
601 3:begin RS(33);T[3]:=26;T[4]:=23;T[5]:=33;end;
\r
602 4:begin RS(34);Van(N2);Prm:=13;Add(7)end;
\r
603 5:begin RS(36);T[7]:=9;PStat:=PStat+[4];Add(7)end
\r
605 else writeln('The ',FN(N1),' offers no resistance.')
\r
613 procedure Default8;
\r
619 50:if Pr=Null then {eg. turn knob}
\r
622 if Prm=SinkRm then begin SinkRm:=Null;L[Prm]:=L[Prm]-[79];RL(81)end
\r
623 else if Prm in[5,12] then
\r
624 begin SinkRm:=Prm;L[Prm]:=L[Prm]+[79];RL(82)end
\r
630 if input='' then {eg. turn sink on}
\r
632 2:begin RL(460);Score(5,123);
\r
634 0:for i:=20 to random(99)+50 do play(20,i,1);
\r
635 1:for i:=random(5000)+4500 downto 20 do begin sound(i);
\r
636 delay(1);sound(31)end;
\r
637 2:begin i:=random(9999)+1;x:=0;repeat j:=random(9999);play(j,i,0);
\r
638 i:=random(9999)+1;play(i,j,0);x:=x+1;until x>9 end;
\r
639 3:for x:=1 to 200 do begin i:=random(9999)+1;play(i,i,1);delay(16)end
\r
640 end;nosound;if Region=5 then sound(60);
\r
643 48,79,98:goto JUMP;
\r
645 127:if NStr<>'window' then RL(360);
\r
649 else {eg. turn dial to 123}
\r
658 { OPEN and UNLOCK }
\r
660 if N1=5 then RL(289)
\r
663 case N1 of { if N1 only }
\r
670 if Prm in[9,11] then
\r
671 if N2=3 then RL(101)
\r
675 if N2=3 then begin RL(102);Add(11)end
\r
679 if N1 in[32,38,45,55,62,68,69,78,89,90,119] then RL(103)
\r
686 procedure Default9;
\r
693 5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')
\r
695 7:if HolstCon=Null then RL(580)else
\r
696 writeln('The gun strap contains a ',FN(HolstCon),'.');
\r
697 18:if en(34)then RL(270)else RL(271);
\r
698 29:if MugCon<>Null then writeln('The mug contains ',FN(MugCon),'.')
\r
700 35:if NStr='toilet' then RL(114)else RL(113);
\r
701 10,26,28,32,62,64,69,98,113:writeln('The ',NStr,' is empty.');
\r
703 103..109,115,118:if Prm=63 then RL(113)else RL(115)
\r
707 { LOOK UNDER, LOOK BEHIND and REACH IN }
\r
710 5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')
\r
712 80:if not en(127) then begin RS(16);Add(127)end else RL(116);
\r
713 103..109,115,118:if Prm=63 then RL(113)else RL(115)
\r
722 103..109,115,118:if Prm=63 then RL(113)else RL(115)
\r
727 70:begin if Sc<25 then begin RL(302);goto JUMP;end;
\r
729 begin Add(15);RS(30);
\r
731 write('Do you still wish to see the clue? ');CFlag:=Readkey;writeln;
\r
732 if upcase(CFlag)='N' then
\r
733 begin writeln('OK, no clue will be shown.');goto JUMP;end
\r
735 Cn('---Here is your clue---');Sc:=Sc-25;
\r
736 if(Prm<>StoreC)then
\r
741 col(12,9);Cn(Text5);col(11,7); JUMP:
\r
747 procedure Default10;
\r
752 33:begin SFlag:=False;if VStr='fill' then begin x:=N1;N1:=N2;N2:=x;end;
\r
753 if((N1 in Mov)and(N1 in Inv))or(N1 in[66,79])then
\r
756 34:if N1 in[3,8,9] then
\r
758 if PyraCon=Null then
\r
759 begin Van(N1);R[N1]:=34;PyraCon:=N1;
\r
760 if N1=9then begin RS(83);Walls(8);Add(30)end else RL(224)
\r
767 if N1 in[3,8,9] then
\r
768 if Pr in[1,5,7,10] then
\r
769 if HingeCon=Null then
\r
770 begin Van(N1);R[N1]:=34;HingeCon:=N1;RL(231)end
\r
777 begin Van(16);Add(6);R[16]:=1;RL(144);Score(5,25)end
\r
778 else begin RL(143);Van(N1);R[N1]:=1;end;
\r
779 120:begin RL(550);Van(N1)end;
\r
780 62:if Prm in[22,24] then
\r
781 if en(23) then begin Van(N1);R[N1]:=2;RL(134)end else RL(99);
\r
782 66:begin if random(2)=0 then RL(375)else RL(376);Van(N1)end;
\r
784 29:if MugCon=Null then
\r
785 if N1 in[3,4,9,17,19,66,79,99] then begin
\r
786 writeln('The ',FN(N1),' is now in the mug.');
\r
787 if N1 in Mov then Van(N1);L[Prm]:=L[Prm]+[N1];MugCon:=N1;end
\r
788 else if N1 in Mov then RL(137)else crazy
\r
790 5 :if SatchCon=Null then
\r
791 if N1 in[3,4,6,8,9,12,17,19] then
\r
792 begin Van(N1);L[Prm]:=L[Prm]+[N1];SatchCon:=N1;
\r
793 writeln('The ',FN(N1),' is now in the brown satchel.')end
\r
794 else if N1 in Mov then RL(137)else crazy
\r
796 7 :if HolstCon=Null then
\r
797 if N1 in[3,4,8,9,12,17,19] then
\r
798 begin Van(N1);L[Prm]:=L[Prm]+[N1];HolstCon:=N1;
\r
799 writeln('The ',FN(N1),' is now in the holster.')end
\r
800 else if N1 in Mov then RL(137)else crazy
\r
803 else writeln('First you must have the ',FN(N1),'.');
\r
807 1:if N2 in[32..37,49,71,80,83..87,90,93,98,113,112,126,132] then
\r
808 begin Van(N1);R[N1]:=Prm;
\r
809 writeln('The ',FN(N1),' is now on the ',FN(N2),'.')end
\r
812 7:if N2 in[32,35,37,49,51,54,56,62,66..73,80..87,89,90,94..98,104,112,
\r
813 113,116,120..122,125..128,132] then
\r
814 begin Van(N1);R[N1]:=Prm;
\r
815 writeln('The ',FN(N1),' is now beside the ',FN(N2),'.')end
\r
817 10:if N2 in[80,81,83..86,98,104,112] then
\r
818 begin Van(N1);R[N1]:=Prm;
\r
819 writeln('The ',FN(N1),' is now under the ',FN(N2),'.')end
\r
829 procedure Default11;
\r
833 { PUSH and TURN ON }
\r
834 44:if(VStr='turn on')or(VStr='activat')then
\r
836 2:begin RL(460);Score(5,117);
\r
838 0:for i:=400 to random(250)+420 do play(400,i,1);
\r
839 1:begin y:=random(35)+2;for x:=1 to 99 do
\r
840 begin i:=random(9000)+60;play(i,i,y);delay(y)end end;
\r
841 2:for x:=1 to random(230)+21 do
\r
842 for y:=1 to random(230)+22 do sound(x*y);
\r
843 3:for i:=1 to random(9999)+999 do sound(random(i)+i);
\r
844 end;nosound;if Region=5 then sound(60);
\r
847 98,48:if Prm=SinkRm then say('water','flowing out')
\r
848 else begin SinkRm:=Prm;L[Prm]:=L[Prm]+[79];RL(82)end;
\r
849 127:if NStr<>'window' then RL(360)
\r
854 116:if Prm in[42..50]then RL(282)else RL(281);
\r
859 { PULL and TURN OFF }
\r
860 42:if(VStr='turn off')or(VStr='deactiv')then
\r
862 98,48,79:if Prm<>SinkRm then say('water','off')
\r
863 else begin SinkRm:=Null;L[Prm]:=L[Prm]-[79];RL(81)end;
\r
864 127:if NStr<>'window' then RL(360)else RL(165)
\r
871 18:if en(34) then RL(265) else
\r
872 begin if 18 in L[41] then R[18]:=41;Score(15,34);
\r
873 RS(91);n[18]:='glass ball\ball\glass\';;;end;
\r
874 126:if NStr='bar' then RL(167);
\r
877 else writeln('The ',NStr,' doesn''t need to be cleaned.');
\r
881 86:begin Bor(1,0);Cur(2);
\r
882 write('Are you sure you want to restart your game? ');
\r
884 if upcase(CFlag)<>'Y' then RL(169)
\r
886 begin RL(170);delay(2000);window(1,1,80,25);clrscr;Bor(0,0);nosound;
\r
887 close(R1);close(R2);close(S1);close(L1);close(C1);
\r
889 close(T1);if IOResult<>0 then begin end;
\r
890 close(T2);if IOResult<>0 then begin end;
\r
893 Halt(ExecuteProcess(ParamStr(0),''));
\r
901 90:if VStr='tie' then RL(172)else if VStr='untie' then RL(173)else RL(437);
\r
904 73:if N1 in Inv then
\r
905 writeln('You are carrying the ',NStr,'.')
\r
906 else writeln('The ',NStr,' is close by, just look around.');
\r
911 procedure Default12;
\r
916 54:if N2<>Null then
\r
917 if(N2 in Mov)or(N2=60)then
\r
921 1:if(Prm=56)and(1 in L[56])then RL(300)else RL(83);
\r
922 18:if N2 in[10,11,29] then begin RS(97);Van(18);R[4]:=Prm;end
\r
934 if random(3)=0 then
\r
935 writeln('At the last moment you decide to spare the ',NStr,'''s life!')
\r
936 else writeln('Hitting the ',NStr,' doesn''t help.')
\r
940 48:if N2<>Null then
\r
944 if Pr in[1..5] then
\r
946 if(N1=29)and(MugCon in[79,92,99])then begin
\r
947 MugCon:=Null;RL(585);SFlag:=false;end;
\r
948 if(N2=1)and(Prm=56)and(1 in L[56])then
\r
949 begin Van(N1);R[N1]:=56;RL(301)end;
\r
950 if(N2=49)and(Prm=56)and(N1 in[1,10,18,29])then
\r
951 begin RS(112);Add(128);end;
\r
952 if(N2=69)and(Prm=91)then begin RS(160);L[91]:=L[91]+[123];
\r
953 L[91]:=L[91]-[44,129];T[23]:=15;Add(51);Van(N1);R[N1]:=91;end;
\r
954 if(N1 in[1,22..25])then begin Van(N1);RL(430)end;
\r
955 if(N2=46)and(Prm in[99,101])then begin RL(514);Blast;
\r
956 if Prm=99 then T[27]:=2000 else T[28]:=2000;Van(N1)end;
\r
958 1,22..25:begin Van(N2);RL(431)end;
\r
959 42:begin Van(N1);RL(515)end;
\r
960 66:begin RL(375);Van(N1)end;
\r
961 111:begin RL(449);Van(N1)end;
\r
962 120:begin RL(550);Van(N1)end;
\r
963 123:begin RL(450);RL(451);Van(N1);R[N1]:=Prm;end;
\r
964 124:begin RL(452);RL(453);Van(N1);R[N1]:=Prm;end;
\r
965 127:if Prm=64 then if Md=3 then begin RL(537);Add(128);end else RL(538);
\r
967 if(N1=18)or(N2=18)then
\r
968 begin Van(N1);R[N1]:=Prm;Van(18);RS(97);R[4]:=Prm;end;
\r
969 if not SFlag then begin writeln('The ',FN(N1),' collides with the ',
\r
970 FN(N2),', but nothing interesting happens.');Van(N1);R[N1]:=Prm;end
\r
975 else writeln('First you must have the ',FN(N1),'.')
\r
977 begin Van(N1);R[N1]:=Prm;RL(275)end;
\r
982 procedure Default13;
\r
990 else writeln('The ',NStr,' is not something that can be closed.')
\r
994 78:begin col(11,7);
\r
995 write('In ');col(12,9);write(Tic);col(11,7);
\r
996 write(' moves you scored ');col(12,9);write(Sc);col(11,7);
\r
997 writeln(' out of a possible 1000 points.');
\r
998 write('This score earns you the rank of ');col(12,9);
\r
1000 0..9:writeln(Up('ABSOLUTE BEGINNER!'));
\r
1001 10..99:write('Rookie');
\r
1002 100..179:write('Struggling');
\r
1003 180..259:write('Novice');
\r
1004 260..349:write('Competent');
\r
1005 350..449:write('Fair');
\r
1006 450..549:write('Good');
\r
1007 550..649:write('Great');
\r
1008 650..744:write('Brilliant');
\r
1009 745..829:write('Genius');
\r
1010 830..899:write('Elite');
\r
1011 900..949:write('Champion');
\r
1012 950..1000:write('Galaxy Class')
\r
1014 if Sc>9 then writeln(' Adventurer.')
\r
1021 91:if VStr='follow' then
\r
1022 case N1 of 123:RL(358);124:RL(359)
\r
1023 else writeln('Why, did the ',NStr,' leave?')
\r
1024 end else RL(432+random(5)); { for Scott in VOCAB! }
\r
1027 72:if N1 in[7,20,26,28]then
\r
1029 if not(N1 in Wear)then
\r
1030 begin Wear:=Wear+[N1];writeln('You are now wearing the ',FN(N1),'.');
\r
1031 if(Prm in[102..105])and(N1=20)then RL(503);
\r
1033 else writeln('You are already wearing the ',FN(N1),'.')
\r
1034 else writeln('First you must have the ',FN(N1),'.')
\r
1038 19:if N1 in Wear then begin Wear:=Wear-[N1];
\r
1039 writeln('You are no longer wearing the ',FN(N1),'.');
\r
1040 if Prm in[102..105]then RL(492)end
\r
1041 else writeln('You are not wearing the ',FN(N1),' to begin with.');
\r
1044 56:if here(37)or here(52)then RL(273)else RL(361);
\r
1047 end; { Default13 }
\r
1049 procedure Default14;
\r
1054 49:if N2 in[46,111,123,124]then
\r
1058 111:if N1=8 then begin Inv:=Inv+[29];Van(8);Score(10,21);RS(11);
\r
1059 T[1]:=21;Add(9);Add(16)end
\r
1068 59:if N1<>Null then
\r
1069 if(VStr='jump over')or(VStr='leap over')or(VStr='jump across')then
\r
1070 if N1 in[1..29,36,49,51,69,71,73,132]then
\r
1071 writeln('You land on the other side of the ',NStr,'.')
\r
1074 if(VStr='jump off')and en(8)then begin RL(475);Min(8)end else
\r
1075 if N1 in[34,56,60,62,68,72,82,92] then crazy else
\r
1076 if(N1 in[1..29])and not(N1 in Inv)then
\r
1077 writeln('You land on the ',NStr,'.')
\r
1079 if NStr='quicksa' then begin RL(582);Add(128)end else
\r
1080 if NStr='swamp' then begin RL(583);Add(128)end
\r
1083 if(VStr='jump off')and en(8)then begin RL(475);Min(8)end
\r
1088 49,116,122:RL(556);
\r
1094 21:if VStr='greet' then
\r
1095 case N1 of 111:RL(51); 124:RL(46); 123:RL(441) else crazy end
\r
1097 if N1 in[111,123,124] then
\r
1098 begin writeln('To talk to the ',FN(N1),' enter:');
\r
1099 writeln(FN(N1),', < what you want to say goes here >')
\r
1106 end; { Default14 }
\r
1108 procedure DeadMain;
\r
1111 gotoxy(1,20);for x:=5 downto 1 do
\r
1112 begin writeln;delay(99);sound(300+(x*50));Bor(x,7)end;
\r
1113 repeat x:=random(14)+1 until not(x in [4,12]);
\r
1114 gotoxy(1,15);col(x,15);bak(4,7);
\r
1115 writeln('***************************************',
\r
1116 '***************************************');
\r
1117 delay(99);sound(300);Bor(6,0);
\r
1118 gotoxy(1,16);for x:=3 downto 1 do begin
\r
1121 delay(99);sound(100+(x*50));Bor(x+8,15)end;gotoxy(1,19);
\r
1122 write('***************************************',
\r
1123 '***************************************');
\r
1124 delay(99);sound(100);Bor(14,0);
\r
1125 gotoxy(30,17);col(16,31);write('YOU HAVE DIED!!!');delay(99);sound(50);
\r
1126 gotoxy(1,20);bak(0,0);col(11,7);Bor(12,7);writeln;delay(99);nosound;
\r
1127 delay(999);i:=random(3)+2;
\r
1128 tune(i,3,830);tune(i,3,770);tune(i,3,200);tune(i,3,0);delay(800);
\r
1129 tune(i,6,400);tune(i,5,400);tune(i,5,400);
\r
1130 tune(i,3,400);tune(i,3,400);tune(i,2,400);tune(i,3,810);
\r
1131 JUMP: Col(11,7);Cur(2);
\r
1133 write('Would you like to ');Col(14,15);write('S');Col(11,7);
\r
1134 write('tart a new game, ');Col(14,15);write('R');Col(11,7);
\r
1135 write('estore or ');Col(14,15);write('Q');Col(11,7);write('uit? ');
\r
1136 CFlag:=Readkey;CFlag:=upcase(CFlag);Col(9,15);writeln(CFlag);
\r
1137 play(500,500,40);Col(11,7);
\r
1138 until CFlag in['S','R','Q'];Bor(0,0);Cur(3);
\r
1140 'S':begin RL(170);delay(1500);window(1,1,80,25);clrscr;
\r
1141 close(R1);close(R2);close(S1);close(L1);close(C1);
\r
1143 close(T1);if IOResult<>0 then begin end;
\r
1144 close(T2);if IOResult<>0 then begin end;
\r
1147 Halt(ExecuteProcess(ParamStr(0),''));
\r
1149 'R':begin Min(126);Restore;if not en(126)then goto JUMP end;
\r
1150 'Q':begin window(1,1,80,25);clrscr;Col(3,7);
\r
1151 close(R1);close(R2);close(S1);close(L1);close(C1);
\r
1153 close(T1);if IOResult<>0 then begin end;
\r
1154 close(T2);if IOResult<>0 then begin end;
\r
1156 writeln('In ',Tic,' moves you scored ',Sc,
\r
1157 ' out of a possible 1000 points.');writeln;
\r
1158 Col(31,16);Bak(1,7);writeln('Good-bye!');writeln;Cur(1);
\r
1164 procedure DEAD; begin DEADMAIN end;
\r
1165 procedure Call13; begin Default13 end;
\r
1166 {************************* END OF DEFAULT ROUTINES **************************}
\r