src/DEFAULT.PAS

   1 {//-------------------------------------------------------------------------}\r
   2 {/*                                                                         }\r
   3 {Copyright (C) 2014 Jason Self <j@jxself.org>                               }\r
   4 {                                                                           }\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
   9 {                                                                           }\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
  14 {                                                                           }\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
  20 {  USA                                                                      }\r
  21 {                                                                           }\r
  22 {This file incorporates work covered by the following copyright and         }\r
  23 {permission notice:                                                         }\r
  24 {                                                                           }\r
  25 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }\r
  26 {                                                                           }\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
  31 {                                                                           }\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
  35 {                                                                           }\r
  36 {See the GNU General Public License for more details.                       }\r
  37 {                                                                           }\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
  43 {  USA                                                                      }\r
  44 {                                                                           }\r
  45 {Original Source: 1990 Scott Miller                                         }\r
  46 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }\r
  47 {*/                                                                         }\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
  56 procedure Default0;\r
  57 begin\r
  58 case Vb of\r
  59 \r
  60 { N, S, E, W, etc. }\r
  61 1..8:case Prm of\r
  62      14..19:RL(26);\r
  63      21:RL(27);\r
  64      42..50:RL(279)\r
  65      else\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
  68      end;\r
  69 \r
  70 { LOOK }\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
  73    end;\r
  74 \r
  75 { SAVE }\r
  76 82:Save;\r
  77 \r
  78 { RESTORE }\r
  79 87:Restore;\r
  80 \r
  81  end {main case}\r
  82 end; { Default0 }\r
  83 {----------}\r
  84 procedure Default1;\r
  85 begin\r
  86 case Vb of\r
  87 \r
  88 { INVENTORY }\r
  89 16:if not(Inv=[]) then\r
  90     begin\r
  91      writeln('You have in your possession...');\r
  92      for o:=1 to MMax do\r
  93       begin\r
  94        if o in Inv then\r
  95         begin\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
  98          case o of\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
 103         end;\r
 104       end;\r
 105     end\r
 106    else RL(28);\r
 107 \r
 108 { DROP }\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
 112       if o in Inv 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       else writeln('You don''t have the ',FN(o),'.')\r
 120      else begin;end\r
 121    else\r
 122     begin Min(17); { DROP ALL }\r
 123      for o:=1 to MMax do\r
 124       if o in Inv then\r
 125        begin\r
 126         write(FN(o),':  ');Add(17);\r
 127         if o in wear then\r
 128          writeln('First you must remove the ',FN(o),'.')\r
 129         else begin writeln('Dropped.');Inv:=Inv-[o];r[o]:=Prm;end;\r
 130        end;\r
 131      if not en(17)then RL(303)\r
 132     end;\r
 133 \r
 134 { DROP ALL BUT }\r
 135 17:begin\r
 136     for o:=1 to MMax do\r
 137      if(o in Inv)and not(o in NounSet)then\r
 138       begin\r
 139        write(FN(o),':  ');\r
 140        if o in Wear 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
 143       end;\r
 144    end;\r
 145 \r
 146  end; {main case}\r
 147 end; { Default1 }\r
 148 {----------}\r
 149 procedure Default2;\r
 150 { label JUMP;}\r
 151 begin\r
 152 case Vb of\r
 153 \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
 157 \r
 158 { QUIT }\r
 159 79:begin Bor(1,0);\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
 165     Cur(2);\r
 166     CFlag:=Readkey;\r
 167     if upcase(CFlag)='Y' then\r
 168      begin\r
 169       RL(12);delay(2200);\r
 170       close(R1);close(R2);close(S1);close(L1);close(C1);\r
 171       {$I-}\r
 172       close(T1);if IOResult<>0 then begin end;\r
 173       close(T2);if IOResult<>0 then begin end;\r
 174       {$I+}\r
 175       DoneScrKbd;\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
 178      end\r
 179     else RL(13);Bor(0,0);\r
 180    end;\r
 181 \r
 182 { SLEEP }\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
 188      end\r
 189     else RL(16)\r
 190    else\r
 191     if N1 in[69,80] then\r
 192      begin\r
 193       T[5]:=230;PStat:=PStat-[5];Bor(0,0);Add(7);\r
 194       case N1 of\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
 197        80:if T[8]<1 then\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
 201       end;\r
 202      end\r
 203     else writeln('The ',FN(N1),' is not a suitable place to sleep.');\r
 204 \r
 205 { SIT }\r
 206 35:if(N1 in[16,32,35,49,54,69,71,80,83..86,98,110])then\r
 207     begin Add(7);\r
 208      case N1 of\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
 212      end\r
 213     end\r
 214    else RL(17);\r
 215 \r
 216 { STAND }\r
 217 32:if(en(7))then\r
 218     begin Min(7);Min(2);Min(3);Min(19);T[6]:=Null;RL(18)end\r
 219    else RL(19);\r
 220 \r
 221 { UP and CLIMB }\r
 222 9,51:if(N1 in[32,35,54,68,71,80,81,83..86,89,98,112,125])then\r
 223       begin Add(8);\r
 224        writeln('You manage to climb up the ',NStr,'.');\r
 225       end\r
 226      else\r
 227       if(Vb=9)then writeln('There is not a path in that direction.')\r
 228       else RL(20);\r
 229 \r
 230 { DOWN }\r
 231 10:if(en(8))then\r
 232     begin Min(8);RL(21)end\r
 233    else writeln('There is not a path in that direction.');\r
 234 \r
 235 { IN and OUT }\r
 236 11,13:writeln('Due to the multiple paths you will have to be more specific.');\r
 237 \r
 238 { WAIT }\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
 242    end;\r
 243 \r
 244  end; {main case}\r
 245 end; { Default2 }\r
 246 {----------}\r
 247 procedure Default3;\r
 248 begin SFlag:=false;\r
 249 case Vb of\r
 250 \r
 251 { EXAMINE }\r
 252 28:begin\r
 253    case N1 of\r
 254    1:if en(41) then RS(116) else begin RS(116);RS(132);Score(5,41)end;\r
 255    2:RL(454);\r
 256    3:RL(45);\r
 257    4:RL(294);\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
 261      end;\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
 265    8:RL(59);\r
 266    9:RL(374);\r
 267    10:RL(262);\r
 268    11:RL(311);\r
 269    12:RB2(6,13);\r
 270    16:RL(151);\r
 271    17:RL(263);\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
 274    20:RL(372);\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
 279    26:RL(455);\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
 287    99:RL(63);\r
 288    103:case Prm of 24..34,59,60:RL(317)else RL(326)end;\r
 289    113:RR(Prm);\r
 290    123:RS(159);\r
 291    124:RL(62)\r
 292    end; {case}\r
 293    if not SFlag then\r
 294     case random(20) of\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
 299     end\r
 300    end;\r
 301 \r
 302 { EAT }\r
 303 47:if N1=6 then\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
 306     end\r
 307    else writeln('The ',NStr,' would not do much for your digestive system.')\r
 308 \r
 309  end {main case}\r
 310 end; { Default3 }\r
 311 {----------}\r
 312 procedure Default4;\r
 313 begin\r
 314 case VB of\r
 315 \r
 316 { GET }\r
 317 39:begin\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
 324        if o in Mov then\r
 325         begin\r
 326          write(FN(o),':  ');\r
 327          Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
 328          if Weight<9 then\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
 333             end\r
 334           else writeln('You already have that.')\r
 335          else\r
 336           begin RL(587);\r
 337            if o=11 then Weight:=Weight-3;\r
 338           end\r
 339         end\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
 342       else begin;end\r
 343     else\r
 344      begin  { GET ALL }\r
 345       for o:=1 to MMax do\r
 346        if o in Mov then\r
 347         if r[o]=Prm then\r
 348          begin\r
 349           write(FN(o),':  ');Add(17);\r
 350           Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
 351           if Weight<9 then\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
 354           else\r
 355            begin RL(587);\r
 356             if o=11 then Weight:=Weight-3;\r
 357            end\r
 358          end;\r
 359       if not en(17)then RL(29)\r
 360      end\r
 361    end;\r
 362 \r
 363 { GET ALL BUT }\r
 364 37:begin\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
 370        if r[o]=Prm then\r
 371         begin\r
 372          write(FN(o),':  ');\r
 373          Weight:=Weight+1;if o=11 then Weight:=Weight+3;\r
 374          if Weight<9 then\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
 377          else\r
 378           begin RL(587);\r
 379            if o=11 then Weight:=Weight-3;\r
 380           end\r
 381         end;\r
 382      if not en(17)then RL(29)\r
 383    end;\r
 384 \r
 385  end; {main case}\r
 386 end; { Default4 }\r
 387 {----------}\r
 388 procedure Default5;\r
 389  label JUMP,JUMP1;\r
 390 begin\r
 391 case Vb of\r
 392 \r
 393 { PURCHASE }\r
 394 64:if Prm=8 then\r
 395     if N1=100 then RS(10) else\r
 396     if(N1 in[29,99])or(Pr=11)then\r
 397      if Pr in[6,9] then\r
 398       if N2 in[8,111] then\r
 399        if Here(8) then\r
 400         begin Inv:=Inv+[29];Van(8);Score(15,21);RS(11);T[1]:=21;Add(9);Add(16)\r
 401         end\r
 402        else RL(39)\r
 403       else RL(40)\r
 404      else\r
 405       if Pr=11 then\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
 409         else crazy end\r
 410        else crazy\r
 411       else NoSense\r
 412     else\r
 413      if N2<>124 then RL(34) else RL(35)\r
 414    else\r
 415     if Prm=AlienRm then RL(35) else\r
 416     if Prm=FriendRm then RL(36)\r
 417     else RL(38);\r
 418 \r
 419 { DRINK }\r
 420 46:if N1=Null then\r
 421     if Here(29) then\r
 422      if(Prm=8)and not(29 in Inv)then RL(67) else\r
 423 JUMP: if MugCon<>Null then\r
 424        case MugCon of\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
 427             Van(79)end;\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
 432             else RL(162)\r
 433            end;\r
 434        end\r
 435       else RL(65)\r
 436     else\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
 439       else RL(67)\r
 440      else RL(67)\r
 441    else  { If N1 = something }\r
 442     case N1 of\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
 445         else RL(67);\r
 446      121,66:begin RS(12);Add(128);end;\r
 447      92:goto JUMP1;\r
 448      79:begin\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
 451            RL(66)end\r
 452          else if Here(79)then begin T[4]:=130;Bor(0,0);PStat:=PStat-[6];\r
 453                RL(66)end\r
 454               else RL(67);\r
 455         end\r
 456      else writeln('The ',NStr,' would not quench your thirst.')\r
 457     end;\r
 458 \r
 459  end; {main case}\r
 460 end; { Default5 }\r
 461 {----------}\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
 465 begin\r
 466 case Vb of\r
 467 \r
 468 { TALKING TO CHARACTERS}\r
 469 66..69,71:\r
 470   begin Spaces(input);\r
 471    if Vb=66 then  { Bartender }\r
 472     if Here(111)then\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
 488     else RL(52);\r
 489    if Vb=67 then  { Two Aliens }\r
 490     if Here(124)then\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
 499     else RL(53);\r
 500    if Vb=68 then  { Scientist }\r
 501     if here(123)then\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
 514       RL(446)else\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
 521     else RL(439);\r
 522     if Vb=69 then  { Robot }\r
 523      if here(46)then RL(508)\r
 524      else RL(584);\r
 525     if Vb=71 then  { Computer }\r
 526      if here(37) then RL(545)\r
 527      else RL(546)\r
 528   end; {characters}\r
 529 \r
 530  end; {main case}\r
 531 end; { Default6 }\r
 532 {----------}\r
 533 procedure Default7;\r
 534 begin\r
 535 case Vb of\r
 536 \r
 537 { READ }\r
 538 31:case N1 of\r
 539     12:RB2(6,13);\r
 540     19:begin RB(12,7);Pause end\r
 541     else writeln('There is nothing on the ',FN(N1),' to read.')\r
 542    end;\r
 543 \r
 544 { TOUCH }\r
 545 75:if 26 in Wear then RL(571)else\r
 546     case N1 of\r
 547      1,22..25:if N1 in Socket then RL(569)else RL(570);\r
 548      79:RL(552);\r
 549      120:RL(551);\r
 550      34,103,115:writeln('You can''t reach the ',NStr,'.')\r
 551      else writeln('You feel nothing unusual about the ',NStr,'.')\r
 552     end;\r
 553 \r
 554 { TASTE }\r
 555 84:case N1 of\r
 556     6:RL(377);\r
 557     29,92,99:if MugCon=99 then RL(70) else RL(71);\r
 558     111:RL(466)\r
 559     else writeln('It tastes like a ',NStr,' should taste.')\r
 560    end;\r
 561 \r
 562 { SMELL }\r
 563 83:case N1 of\r
 564     6:RL(378);\r
 565     29,99:if MugCon=99 then RL(72)else RL(599);\r
 566     111:RL(466)\r
 567     else\r
 568      if Prm in[42..50]then RL(572)\r
 569      else writeln('It smells like an ordinary ',NStr,'.')\r
 570    end;\r
 571 \r
 572 { LISTEN }\r
 573 65:case N1 of\r
 574     42:RL(501);\r
 575     62:if Region=4 then RL(573)else RL(574);\r
 576     111:RL(73)\r
 577     else writeln('The ',NStr,' is not making any sound.')\r
 578    end;\r
 579 \r
 580 { HELLO }\r
 581 80:if(word='hi')or(word='hello')then writeln('Hello to you.') else RL(74);\r
 582 \r
 583 { YES/NO/MAYBE }\r
 584 81:RL(random(6)+75);\r
 585 \r
 586 { COMMANDS }\r
 587 95:begin RB(4,11);Pause;RB(6,11);Pause;end;\r
 588 \r
 589 { ATTACK }\r
 590 93:if Pr=6 then\r
 591     if(N2 in Mov)or(N2=60)then\r
 592      case N1 of\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
 596       123:RL(465);\r
 597       124:case random(6) of\r
 598            0:RL(175);\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
 604           end\r
 605       else writeln('The ',FN(N1),' offers no resistance.')\r
 606      end\r
 607     else crazy\r
 608    else NoSense;\r
 609 \r
 610  end; {main case}\r
 611 end; { Default7 }\r
 612 {----------}\r
 613 procedure Default8;\r
 614  label JUMP;\r
 615 begin\r
 616 case Vb of\r
 617 \r
 618 { TURN }\r
 619 50:if Pr=Null then   {eg. turn knob}\r
 620     case N1 of\r
 621      48:JUMP:begin\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
 625               else RL(540)\r
 626         end\r
 627      else RL(83)\r
 628     end {case}\r
 629    else\r
 630     if input='' then  {eg. turn sink on}\r
 631      case N1 of\r
 632       2:begin RL(460);Score(5,123);\r
 633         case random(4)of\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
 641        end;\r
 642       37,38:RL(373);\r
 643       48,79,98:goto JUMP;\r
 644       46:RL(360);\r
 645       127:if NStr<>'window' then RL(360);\r
 646       131:RL(84)\r
 647       else crazy\r
 648      end\r
 649     else             {eg. turn dial to 123}\r
 650      if Pr=1 then\r
 651       if N1=48 then\r
 652        case Prm of\r
 653         79:begin;end;\r
 654        end\r
 655       else crazy\r
 656      else NoSense;\r
 657 \r
 658 { OPEN and UNLOCK }\r
 659 41,88:\r
 660   if N1=5 then RL(289)\r
 661   else\r
 662    if N2=Null then\r
 663     case N1 of { if N1 only }\r
 664      56:RL(409)\r
 665      else RL(100)\r
 666     end\r
 667    else\r
 668     if Pr=6 then\r
 669      if N1=56 then\r
 670       if Prm in[9,11] then\r
 671        if N2=3 then RL(101)\r
 672        else crazy\r
 673       else\r
 674        if Prm=10 then\r
 675         if N2=3 then begin RL(102);Add(11)end\r
 676         else crazy\r
 677        else RL(103)\r
 678      else\r
 679       if N1 in[32,38,45,55,62,68,69,78,89,90,119] then RL(103)\r
 680       else crazy\r
 681     else NoSense;\r
 682 \r
 683  end; {main case}\r
 684 end; { Default8 }\r
 685 {----------}\r
 686 procedure Default9;\r
 687  label JUMP;\r
 688 begin\r
 689 case Vb of\r
 690 \r
 691 { LOOK INSIDE }\r
 692 24:case N1 of\r
 693     5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')\r
 694       else RL(110);\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
 699        else RL(111);\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
 702     119:RL(112);\r
 703     103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
 704     else RL(113)\r
 705    end;\r
 706 \r
 707 { LOOK UNDER, LOOK BEHIND and REACH IN }\r
 708 20,26,76:\r
 709    case N1 of\r
 710     5:if SatchCon<>Null then writeln('The satchel contains ',FN(SatchCon),'.')\r
 711       else RL(110);\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
 714     else RL(116)\r
 715    end;\r
 716 \r
 717 { LOOK ON TOP }\r
 718 22:case N1 of\r
 719     66:RL(117);\r
 720     80:RL(118);\r
 721     99:RL(119);\r
 722     103..109,115,118:if Prm=63 then RL(113)else RL(115)\r
 723     else RL(120)\r
 724    end;\r
 725 \r
 726 { CLUE }\r
 727 70:begin if Sc<25 then begin RL(302);goto JUMP;end;\r
 728     if not en(15) then\r
 729      begin Add(15);RS(30);\r
 730       Cur(2);\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
 734      end;\r
 735     Cn('---Here is your clue---');Sc:=Sc-25;\r
 736     if(Prm<>StoreC)then\r
 737      begin StoreC:=Prm;\r
 738       seek(C1,Prm);\r
 739       read(C1,Text5)\r
 740      end;\r
 741     col(12,9);Cn(Text5);col(11,7); JUMP:\r
 742    end; { Read Clue }\r
 743 \r
 744  end; {main case}\r
 745 end; { Default9 }\r
 746 {----------}\r
 747 procedure Default10;\r
 748 begin\r
 749 case Vb of\r
 750 \r
 751 { PUT }\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
 754      case N2 of\r
 755       64:case Prm of\r
 756          34:if N1 in[3,8,9] then\r
 757              if Pr=5 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
 761                end\r
 762               else RL(223)\r
 763              else RL(222)\r
 764             else RL(221);\r
 765          end;\r
 766      126:if en(31) then\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
 771             else RL(230)\r
 772            else NoSense\r
 773           else RL(229)\r
 774          else RL(232);\r
 775       35:if Prm=1 then\r
 776           if N1=16 then\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
 783       42:RL(495);\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
 789          else RL(136);\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
 795          else RL(138);\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
 801          else RL(581);\r
 802      end {main N2 case}\r
 803     else writeln('First you must have the ',FN(N1),'.');\r
 804 \r
 805      if not SFlag then\r
 806       case Pr of\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
 810          else RL(139);\r
 811        5:RL(139);\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
 816          else RL(139);\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
 820          else RL(139)\r
 821        else crazy\r
 822       end\r
 823 \r
 824    end\r
 825 \r
 826  end; {main case}\r
 827 end; { Default10 }\r
 828 {----------}\r
 829 procedure Default11;\r
 830 begin\r
 831 case Vb of\r
 832 \r
 833 { PUSH and TURN ON }\r
 834 44:if(VStr='turn on')or(VStr='activat')then\r
 835     case N1 of\r
 836      2:begin RL(460);Score(5,117);\r
 837         case random(4)of\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
 845        end;\r
 846      37,38:RL(373);\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
 850      else RL(164)\r
 851     end\r
 852    else\r
 853     case N1 of\r
 854      116:if Prm in[42..50]then RL(282)else RL(281);\r
 855      123:RL(472)\r
 856      else RL(103)\r
 857     end;\r
 858 \r
 859 { PULL and TURN OFF }\r
 860 42:if(VStr='turn off')or(VStr='deactiv')then\r
 861     case N1 of\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
 865      else RL(165)\r
 866     end\r
 867    else RL(103);\r
 868 \r
 869 { CLEAN }\r
 870 94:case N1 of\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
 875     80:RL(166);\r
 876     98:RL(168)\r
 877     else writeln('The ',NStr,' doesn''t need to be cleaned.');\r
 878    end;\r
 879 \r
 880 { RESTART }\r
 881 86:begin Bor(1,0);Cur(2);\r
 882     write('Are you sure you want to restart your game? ');\r
 883     CFlag:=Readkey;\r
 884     if upcase(CFlag)<>'Y' then RL(169)\r
 885     else\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
 888       {$I-}\r
 889       close(T1);if IOResult<>0 then begin end;\r
 890       close(T2);if IOResult<>0 then begin end;\r
 891       {$I+}\r
 892       DoneScrKbd;\r
 893       Halt(ExecuteProcess(ParamStr(0),''));\r
 894      end;Bor(0,0);\r
 895    end;\r
 896 \r
 897 { SHOOT }\r
 898 89:RL(171);\r
 899 \r
 900 { TIE and UNTIE }\r
 901 90:if VStr='tie' then RL(172)else if VStr='untie' then RL(173)else RL(437);\r
 902 \r
 903 { FIND }\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
 907 \r
 908  end; {main case}\r
 909 end; { Default11 }\r
 910 {----------}\r
 911 procedure Default12;\r
 912 begin\r
 913 case Vb of\r
 914 \r
 915 { HIT and BREAK }\r
 916 54:if N2<>Null then\r
 917     if(N2 in Mov)or(N2=60)then\r
 918      if N1<>N2 then\r
 919       if Pr in[3,6] then\r
 920        case N1 of\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
 923            else RL(272);\r
 924         123:RL(416)\r
 925         else RL(273)\r
 926        end {case}\r
 927       else NoSense\r
 928      else crazy\r
 929     else crazy\r
 930    else { N2=Null }\r
 931     case N1 of\r
 932      18:RL(274)\r
 933      else\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
 937     end;\r
 938 \r
 939 { THROW }\r
 940 48:if N2<>Null then\r
 941     if N1 in Inv then\r
 942      if N1 in Mov then\r
 943       if N1<>N2 then\r
 944        if Pr in[1..5] then\r
 945         begin\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
 957          case N2 of\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
 966          end;\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
 971         end\r
 972        else NoSense\r
 973       else crazy\r
 974      else crazy\r
 975     else writeln('First you must have the ',FN(N1),'.')\r
 976    else { N2=Null }\r
 977     begin Van(N1);R[N1]:=Prm;RL(275)end;\r
 978 \r
 979  end; {main case}\r
 980 end; { Default12 }\r
 981 {----------}\r
 982 procedure Default13;\r
 983 begin\r
 984 case Vb of\r
 985 \r
 986 { CLOSE }\r
 987 53:case N1 of\r
 988     5:RL(289);\r
 989     56:RL(92)\r
 990     else writeln('The ',NStr,' is not something that can be closed.')\r
 991    end;\r
 992 \r
 993 { SCORE }\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
 999     case Sc of\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
1013     end;\r
1014     if Sc>9 then writeln(' Adventurer.')\r
1015    end;\r
1016 \r
1017 { REPAIR }\r
1018 74:RL(357);\r
1019 \r
1020 { FOLLOW }\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
1025 \r
1026 { WEAR }\r
1027 72:if N1 in[7,20,26,28]then\r
1028     if N1 in Inv 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
1032       end\r
1033      else writeln('You are already wearing the ',FN(N1),'.')\r
1034     else writeln('First you must have the ',FN(N1),'.')\r
1035    else crazy;\r
1036 \r
1037 { REMOVE }\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
1042 \r
1043 { TYPE }\r
1044 56:if here(37)or here(52)then RL(273)else RL(361);\r
1045 \r
1046  end; {main case}\r
1047 end; { Default13 }\r
1048 {----------}\r
1049 procedure Default14;\r
1050 begin\r
1051 case Vb of\r
1052 \r
1053 { SHOW / GIVE }\r
1054 49:if N2 in[46,111,123,124]then\r
1055     if Pr=1 then\r
1056      case N2 of\r
1057       46:RL(447);\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
1060           else RL(444);\r
1061       124:RL(445);\r
1062       123:RL(446)\r
1063      end\r
1064     else nosense\r
1065    else crazy;\r
1066 \r
1067 { JUMP }\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
1072      else crazy\r
1073     else\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
1078      else\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
1081       else RL(476)\r
1082    else\r
1083     if(VStr='jump off')and en(8)then begin RL(475);Min(8)end\r
1084     else RL(539);\r
1085 \r
1086 { DIG }\r
1087 92:case N1 of\r
1088     49,116,122:RL(556);\r
1089     120:RL(557)\r
1090     else crazy\r
1091    end;\r
1092 \r
1093 { TALK / GREET }\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
1096    else\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
1100      end\r
1101     else crazy;\r
1102 \r
1103 25:RS(245);\r
1104 \r
1105  end; {main case}\r
1106 end; { Default14 }\r
1107 {----------}\r
1108 procedure DeadMain;\r
1109   label JUMP;\r
1110  begin writeln;\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
1119   write('*                                      ',\r
1120         '                                      *');\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
1132   repeat\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
1139   case CFlag of\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
1142         {$I-}\r
1143         close(T1);if IOResult<>0 then begin end;\r
1144         close(T2);if IOResult<>0 then begin end;\r
1145         {$I+}\r
1146         DoneScrKbd;\r
1147         Halt(ExecuteProcess(ParamStr(0),''));\r
1148        end;\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
1152         {$I-}\r
1153         close(T1);if IOResult<>0 then begin end;\r
1154         close(T2);if IOResult<>0 then begin end;\r
1155         {$I+}\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
1159         HALT;\r
1160        end\r
1161   end {case}\r
1162  end; {DEAD}\r
1163 \r
1164 procedure DEAD; begin DEADMAIN end;\r
1165 procedure Call13; begin Default13 end;\r
1166 {************************* END OF DEFAULT ROUTINES **************************}\r
1167 \1a\r