src/COMMANDS.PAS

   1 {//-------------------------------------------------------------------------}
   2 {/*                                                                         }
   3 {Copyright (C) 2014 Jason Self <j@jxself.org>                               }
   4 {                                                                           }
   5 {This file is free software: you may copy, redistribute and/or modify it    }
   6 {under the terms of the GNU Affero General Public License as published by   }
   7 {the Free Software Foundation, either version 3 of the License, or (at your }
   8 {option) any later version.                                                 }
   9 {                                                                           }
  10 {This file is distributed in the hope that it will be useful, but WITHOUT   }
  11 {ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or      }
  12 {FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License}
  13 {for more details.                                                          }
  14 {                                                                           }
  15 {You should have received a copy of the GNU Affero General Public License   }
  16 {along with this program; if not, see https://gnu.org/licenses or write to: }
  17 {  Free Software Foundation, Inc.                                           }
  18 {  51 Franklin Street, Fifth Floor                                          }
  19 {  Boston, MA 02110-1301                                                    }
  20 {  USA                                                                      }
  21 {                                                                           }
  22 {This file incorporates work covered by the following copyright and         }
  23 {permission notice:                                                         }
  24 {                                                                           }
  25 {Copyright (C) 1990, 2009 - Apogee Software, Ltd.                           }
  26 {                                                                           }
  27 {This file is part of Beyond The Titanic. Beyond The Titanic is free        }
  28 {software; you can redistribute it and/or modify it under the terms of the  }
  29 {GNU General Public License as published by the Free Software Foundation;   }
  30 {either version 3 of the License, or (at your option) any later version.    }
  31 {                                                                           }
  32 {This program is distributed in the hope that it will be useful, but WITHOUT}
  33 {ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or      }
  34 {FITNESS FOR A PARTICULAR PURPOSE.                                          }
  35 {                                                                           }
  36 {See the GNU General Public License for more details.                       }
  37 {                                                                           }
  38 {You should have received a copy of the GNU General Public License          }
  39 {along with this program; if not, write to:                                 }
  40 {  Free Software Foundation, Inc.                                           }
  41 {  51 Franklin Street, Fifth Floor                                          }
  42 {  Boston, MA 02110-1301                                                    }
  43 {  USA                                                                      }
  44 {                                                                           }
  45 {Original Source: 1990 Scott Miller                                         }
  46 {Prepared for public release: 03/19/09 - Joe Siegler, Apogee Software, Ltd. }
  47 {*/                                                                         }
  48 {//-------------------------------------------------------------------------}
  49 {****************************************************************************}
  50 {*                                COMMANDS                                  *}
  51 {*                            by Scott Miller                               *}
  52 {*  These are misc procedures and functions used with the main file: AdGame *}
  53 {*                        Copyright 1984 Pending                            *}
  54 {****************************************************************************}
  55
  56
  57
  58 procedure SA;
  59    begin FlagSA:='s' end;
  60
  61 function En(c : char) : boolean;
  62    begin
  63      if(c in Ev)then En:=True else En:=False
  64    end;
  65
  66 function Here(noun : integer): Boolean;
  67    begin
  68      if(noun=-1) then Here:=False
  69      else
  70        begin
  71          if(noun in Inven)or(r[noun]=Prm)or(noun in p[Prm])then Here:=True
  72          else Here:=False;
  73        end;
  74    end;
  75
  76 procedure Crazy;
  77    begin SA;
  78     if(random(2)=1)then RL(107+random(7))else RL(300+random(6));
  79    end;
  80
  81 procedure DEAD;
  82     var FileName : file;
  83     var x,b,c:Integer;
  84    begin SA; NoSound;
  85      gotoxy(1,25);for x:=1 to 7 do writeln;
  86      Textcolor(1);TextBackground(m9);
  87      gotoxy(1,18);
  88      write('*********************************************************',
  89            '***********************');writeln;
  90      gotoxy(1,19); for x:=1 to 3 do
  91      write('*                                                        ',
  92              '                      *');writeln;
  93      gotoxy(1,22);
  94      write('*********************************************************',
  95            '***********************');writeln;
  96      TextColor(m0);gotoxy(32,20);writeln('YOU HAVE DIED!!!');
  97      Textcolor(m2);Textbackground(0);
  98      for c:=700 downto 20 do
  99         for b:=70 downto 1 do sound(b*c);nosound;
 100      close(Rooms1);close(rooms2);close(special1);close(special2);close(line1);
 101      gotoxy(1,23);DelLine;DelLine;writeln;write('Do you wish to play again? ');
 102      flag:=ReadKey;
 103      if(upcase(flag)<>'N')then
 104       begin
 105        writeln('Restarting...');window(1,1,80,25);
 106        SysUtils.ExecuteProcess('beyond', '', []);
 107        end
 108      else
 109       begin
 110        textcolor(7);
 111        textbackground(0);
 112        window(1,1,80,25);
 113        clrscr;
 114        writeln('    Beyond the Titanic');
 115        writeln('A Scott Miller Production');
 116        writeln('    Have a nice day...');
 117        delay(2000);
 118        assign(FileName,'MENU.COM');
 119        {$I-}
 120        {execute(FileName);}
 121        {$I+}
 122        if IOResult <> 0 then HALT;
 123       end
 124    end;
 125
 126 procedure Home;
 127   var b,c,x,y,o:Integer;
 128    begin SA;
 129      gotoxy(1,25);for x:=1 to 7 do writeln;
 130      Textcolor(25);Textbackground(m7);
 131      gotoxy(1,18);
 132      write('#########################################################',
 133            '#######################');writeln;
 134      gotoxy(1,19); for x:=1 to 3 do
 135      write('#                                                        ',
 136              '                      #');writeln;
 137      gotoxy(1,22);
 138      write('#########################################################',
 139            '#######################');writeln;
 140      TextColor(31);gotoxy(25,20);writeln('Y O U   H A V E   W O N ! ! !');
 141      Textcolor(m2);Textbackground(0);
 142      gotoxy(1,23);DelLine;DelLine;writeln;
 143      for x:=150 downto 1 do begin sound(x*55);delay(8);nosound;delay(20)end;
 144      if(Sc>1000)then Sc:=1000;
 145      write('You finished with a score of ',Sc,', which makes you a ');
 146      if(Sc=1000)then
 147       begin writeln('Perfect Adventurer!!!');
 148         for y:=1 to 7 do
 149          for o:=0 to 20 do
 150            for x:= 99+(o*430)to 998+(o*430)do begin sound(25);sound(x)end
 151       end
 152      else writeln('Master Adventurer!');
 153      for c:=1 to 999 do for b:=1 to 61 do sound(b*c);nosound;
 154      writeln;nosound;
 155      writeln('Reboot your computer to regain control...')
 156   end;
 157
 158 procedure Say(o : integer; p : str14);
 159    begin
 160      writeln('The ',n[o,1],' is already ',p,'.'); SA
 161    end;
 162
 163 procedure Diagnose;
 164    begin
 165      RL(191);
 166      if((tic>42)and not(en('c')))or((tic>146)and not(en('n')))or(en('r'))then
 167       begin
 168        if(tic>42)and (not(en('c')))then RL(192)
 169         else if(tic>146)and not(en('n'))then RL(192);
 170        if(en('r'))then RL(51)
 171       end
 172      else RL(207)
 173    end;
 174
 175 procedure Monster(var NewRm : integer);
 176    begin
 177     if(NewRm=MnRm)and(MnRm=25)then begin Attack:=False;RL(384)end else
 178     if(NewRm<>35)or not(en('v'))then
 179      begin
 180       p[Prm]:=p[Prm]-[23];p[NewRm]:=p[NewRm]+[23];MnRm:=NewRm;Attack:=False;
 181        if not((NewRm=30)and(Verb in[27,28]))then
 182         case random(7) of
 183          0:RS(71);1:RS(72);2:RL(359);3:RL(360);4:RL(361);5:RL(362);6:RL(363)
 184         end
 185      end
 186     else begin RL(383);Attack:=False end
 187    end;
 188
 189 procedure DescribeRm;
 190    var o : integer;
 191   procedure s(r : str14);
 192      begin TextColor(m8);writeln(r);TextColor(m2);loc:=r;end;
 193    begin SA;
 194 if((en('a'))and(here(29)))or not(Prm in [6..24])then begin
 195      case Prm of
 196 0:s('Ship''s Fore');1:s('Ship Mid-Deck');2:s('Rear of Ship');
 197 3:s('Life Boat');4:s('Ocean Surface');5:s('Huge Cavern');
 198 6:s('Cave of Pins');7:s('Ocean Bottom');8:s('Squeaky Cave');
 199 9:s('Stream Bend');10:s('Waterfall');13:s('Sloppy Cave');
 200 11:s('Hex Cave');12:s('Shallow Cleft');20:s('Zoo');
 201 14:s('Winding Tunnel');15:s('Chasm');17:s('Chasm Bottom');
 202 18:s('Tiny Opening');19:s('Etched Stairs');
 203 21:s('Edge of Saucer');22:s('Side of Saucer');
 204 23:s('Top of Saucer');24:s('Airlock');16:s('End of Rope');
 205 76:s('Locked Cabin');25:s('Central Entry');
 206 26:s('Lower Entry');27:s('Ship''s Systems');
 207 30:s('Time Chamber');28:s('Ship''s Lab');34:s('Bridge');
 208 29:s('Inside Tube');31:s('Life Support');58,69:s('Inside Shuttle');
 209 32:s('Supply Chamber');33:s('Sleep Chamber');
 210 35:s('Engine Room');36:s('Cargo Deck #1');37:s('Cargo Deck #2');
 211 38:s('Cargo Deck #3');39:s('Cargo Deck #4');40:s('Large Cage');
 212 41:s('Wooden Bridge');42:s('Broken End');43:s('South End');
 213 44..46:s('Deserted Road');47:s('Crater Edge');48:s('Crater Floor');
 214 49:s('Building Front');50:s('Lobby');51..54:s('Office Room');
 215 55:s('Basement');56:s('Ladder Room');57:s('Building Roof');
 216 59:case ShRm of 0:s('Above Mud Lake');
 217 1:s('Above Rubble');2:s('Above Desert');3:s('Above Pits');
 218 4:s('Above River');5:s('Above Stream');6:s('Above Town');
 219 7:s('Above Mountain');8:s('Above Crator');9:s('Above Hills');
 220 10:s('Above Canyon');11:s('Above Flatland');12:s('Above Dry Lake');
 221 13:s('Above Desert');14:s('Above Bridge')end;{of Above Rooms}
 222 63,64:s('Above Clouds');65..68:s('Outside City');70:s('Landing Bay');
 223 71:s('Power Plant');72..74:s('Dark Corridor');75:s('Food Supply')
 224      end; {of case}
 225
 226     if Verbose then begin FlagSA:='r';
 227       case Prm of
 228        2 :if(40 in p[2])then begin RR(2);RL(416)end;
 229        4 :if(en('B'))then RR(4)else begin RR(4);
 230            writeln('There is a safety harness here.')end;
 231        11:if(en('C'))then RS(15);
 232        40:if(en('g'))then RS(17);
 233        12:if not(en('G'))then begin RR(12);RL(146)end;
 234        31:if not(en('I'))then begin RR(31);RL(156)end;
 235        34:if(74 in p[34])then begin RR(34);RL(273)end;
 236        35:if(77 in p[35])then begin RR(35);RL(381);RL(382)end else
 237            if(en('W'))then begin RR(35);RL(381)end;
 238        42:if(13 in p[42])then begin RR(42);RL(214)end;
 239        48:if(27 in p[48])then begin RR(48);RL(276)end;
 240        59..69:begin SA;
 241                if(Prm=59)and not(ShRm in RmSh)then
 242                 begin RmSh:=RmSh+[ShRm];RS(ShRm+46)end
 243                else if(Prm<>59)then RR(Prm);
 244                if KeyHole and here(63)then
 245                 writeln('The shiny key is in the keyhole.')
 246               end
 247        else RR(Prm)
 248       end; {of case}
 249       if(FlagSA='r')and(Prm<>59)then RR(Prm)end;
 250
 251      for o:= 0 to NMax do begin
 252        if(o in Mov)then
 253          if(r[o]=Prm)then
 254           if not((Prm in[59..69])and(KeyHole)and(o=63))then
 255            begin writeln('There is a ',n[o,1],' here.');
 256             if(here(ropecon))and(o=ropecon)and not(ropecon in inven)then
 257              writeln('  The rope is attatched to the ',n[o,1],'.');
 258             if(en('d'))and(o=70)and(here(70))then RL(147);
 259             if(o=SlotCon)and(here(o))then RL(388);
 260             if(o in CabiSet)and(here(o))then RL(389);
 261             if(o=PanelCon)and(here(o))then RL(390);
 262             if(o in KitSet)and(here(o))then RL(391);
 263            end
 264      end end
 265     else RL(54)
 266    end;  {of DescribeRm}
 267
 268 procedure SAVE;
 269    begin SA; for x:=1 to 24 do writeln; nosound;
 270    window(1,3,80,25);
 271    gotoxy(1,4);
 272    if(Drive='A:')then
 273     writeln('Remove the GAME disk and insert your SAVE/RESTORE disk ',
 274             'in drive A:')else
 275     writeln('Make sure your SAVE/RESTORE disk is in drive B:');
 276    writeln('  (Press any key to continue...)');flag:=ReadKey;
 277    writeln;writeln;
 278    write('Save under what name? ');
 279    {BufLen:=8;}
 280    readln(input);
 281    while pos(' ',input)>0 do delete(input,pos(' ',input),1);
 282    while pos('.',input)>0 do delete(input,pos('.',input),1);
 283    if(input='')then input:='LastRoom';
 284    writeln;writeln;input:=Drive+input;
 285    writeln('If your SAVE/RESTORE disk is in drive ',Drive,
 286             ' then press any key to start.');
 287    flag:=ReadKey;
 288    with DiskSave do
 289     begin
 290      aInven:=Inven;aKitSet:=KitSet;aCabiSet:=CabiSet;aPanelCon:=PanelCon;
 291      aSlotCon:=SlotCon;aCompCon:=CompCon;aRopeCon:=RopeCon;aTic:=Tic;
 292      aYearDial:=YearDial;aPrm:=Prm;aMnRm:=MnRm;aSc:=Sc;aShots:=Shots;
 293      aShRm:=ShRm;aRx:=Rx;aEv:=Ev;aCode:=Code;aLoc:=Loc;aKeyHole:=KeyHole;
 294     end;
 295    assign(GameSave,input+'.a');
 296    rewrite(GameSave);
 297    write(GameSave,DiskSave);
 298    close(GameSave);
 299    assign(Objects,input+'.b');
 300    rewrite(Objects);
 301    for x:=0 to RMax do write(Objects,p[x]);
 302    close(Objects);
 303    assign(WordList,input+'.c');
 304    rewrite(Wordlist);
 305    for x:= 0 to NMax do
 306     for y:= 1 to 5 do
 307      write(WordList,n[x,y]);
 308    for x:= 0 to VMax do
 309     for y:= 1 to 5 do
 310      write(WordList,v[x,y]);
 311    close(WordList);
 312    assign(Things,input+'.d');
 313    rewrite(Things);
 314    for x:= 0 to NMax do write(Things,r[x]);
 315    close(Things);
 316    writeln; delete(input,1,2);
 317    writeln('Your present game location is now',
 318            ' SAVED to disk under the name ''',input,'.''');
 319    if(Drive='A:')then begin writeln;
 320     writeln('Remove the SAVE/RESTORE disk and insert your GAME disk.')end;
 321    writeln('  (Press any key to continue...)');flag:=ReadKey;
 322    writeln;writeln;
 323    if(Verb<>54)then writeln('You may now resume your game...');
 324    if(Line='')then Line:='look';Tic:=Tic-2;Back:=True;
 325    if(Prm in[59..68])then sound(20);
 326    window(1,2,80,25)
 327    end; {of Save}
 328
 329 procedure RESTORE;
 330  function Exist:Boolean;
 331  begin
 332  assign(GameSave,input+'.a');
 333  {$I-}
 334  Reset(GameSave);
 335  {$I+}
 336  Exist:=(IOresult=0)
 337  end;
 338    begin SA; for x:=1 to 24 do writeln; nosound;
 339    window(1,3,80,25);gotoxy(1,4);
 340    if(Drive='A:')then
 341     writeln('Remove the GAME disk and insert your SAVE/RESTORE disk ',
 342             'in drive ',Drive)else
 343     writeln('Make sure your SAVE/RESTORE disk is in drive B:');
 344    writeln('  (Press any key to continue...)');flag:=ReadKey;
 345    writeln;writeln;
 346    write('Which file name do you want to RESTORE? ');
 347    {BufLen:=8;}
 348    readln(input);
 349    while pos(' ',input)>0 do delete(input,pos(' ',input),1);
 350    while pos('.',input)>0 do delete(input,pos('.',input),1);
 351    if(input='')then input:='LastRoom';
 352    writeln;writeln;input:=Drive+input;
 353    writeln('If your SAVE/RESTORE disk is now in drive ',Drive,
 354            ' then press any key to start.');
 355    flag:=ReadKey;
 356    if Exist then
 357     begin
 358      close(GameSave);
 359      assign(GameSave,input+'.a');
 360      reset(GameSave);
 361      read(GameSave,DiskSave);
 362      close(GameSave);
 363      with DiskSave do
 364       begin
 365        Inven:=aInven;KitSet:=aKitSet;CabiSet:=aCabiSet;PanelCon:=aPanelCon;
 366        SlotCon:=aSlotCon;CompCon:=aCompCon;RopeCon:=aRopeCon;Tic:=aTic;
 367        YearDial:=aYearDial;Prm:=aPrm;MnRm:=aMnRm;Sc:=aSc;Shots:=aShots;
 368        ShRm:=aShRm;Rx:=aRx;Ev:=aEv;Code:=aCode;Loc:=aLoc;KeyHole:=aKeyHole;
 369       end;
 370      assign(Objects,input+'.b');
 371      reset(Objects);
 372      for x:=0 to RMax do read(Objects,p[x]);
 373      close(Objects);
 374      assign(WordList,input+'.c');
 375      reset(Wordlist);
 376      for x:= 0 to NMax do
 377       for y:= 1 to 5 do
 378        read(WordList,n[x,y]);
 379      for x:= 0 to VMax do
 380       for y:= 1 to 5 do
 381        read(WordList,v[x,y]);
 382      close(WordList);
 383      assign(Things,input+'.d');
 384      reset(Things);
 385      for x:= 0 to NMax do read(Things,r[x]);
 386      close(Things);
 387      writeln; delete(input,1,2);
 388      writeln('Your previously SAVED game location is now',
 389              ' RESTORED from the file ''',input,'.''');
 390      if(Drive='A:')then begin writeln;
 391       writeln('Remove the SAVE/RESTORE disk and insert your GAME disk.')end;
 392      writeln('  (Press any key to continue...)');flag:=ReadKey;
 393     end
 394    else
 395     begin writeln;TextColor(28);
 396      writeln('             That name does not exist on this',
 397              ' SAVE/RESTORE disk.',^g);
 398      TextColor(m2);writeln;
 399      if(Drive='A:')then
 400       writeln('Put your GAME disk back in the disk drive and press any key.')
 401      else writeln('  (Press any key to continue...)');
 402      flag:=ReadKey;
 403     end;
 404    writeln;writeln;writeln('You may now resume you game...');
 405    if(Line='')then Line:='look';Tic:=Tic-2;Back:=True;
 406    if(Prm in[59..68])then sound(20);
 407    window(1,2,80,25)
 408    end; {of Restore}
 409
 410 procedure Vanish(o : integer);
 411    begin SA;
 412      inven:=inven-[o];
 413      r[o]:=Null;
 414      p[Prm]:=p[Prm]-[o];
 415      if(o=7)and not(en('I'))then Ev:=Ev+['I'];
 416      if(o=13)and(13 in p[42])then p[42]:=p[42]-[13];
 417      if(o=PanelCon)then PanelCon:=Null;
 418      if(o=SlotCon)then SlotCon:=Null;
 419      if(o in CabiSet)then CabiSet:=CabiSet-[o];
 420      if(o in kitset)then kitset:=kitset-[o];
 421      if(o=63)and KeyHole then KeyHole:=False;
 422      if(o=74)then Ev:=Ev-['p'];
 423      if(o=89)then Ev:=Ev-['i'];
 424      if(o=RopeCon)and(verb=36)then begin RopeCon:=Null;RL(402)end;
 425      if(o=RopeCon)and not(Verb in[9,14])then RopeCon:=Null
 426    end;
 427
 428 procedure Play( Start, Stop, Wait: integer);
 429    var x : integer;
 430    begin
 431     if(Start<=Stop)then
 432      for x:= Start to Stop do
 433       begin sound(x); delay(Wait); end
 434     else
 435      for x:= Start downto Stop do
 436       begin sound(x); delay(Wait); end;
 437     if(Prm in[59..68])then sound(20)else nosound
 438    end; {of Play}
 439
 440 procedure DropAll;
 441    var o : integer;
 442    begin
 443      for o:= 0 to NMax do
 444        if(o in inven)then
 445          begin
 446            r[o]:=Prm;
 447            inven:=inven-[o];writeln(n[o,1],': Dropped.');
 448          end;
 449      RL(106);
 450    end;  {of DropAll}
 451
 452 function FlasOff : Boolean;
 453    begin
 454      if not(En('a'))then FlasOff:=True
 455      else
 456        if(r[29]=Prm)or(29 in inven)then FlasOff:=False
 457        else FlasOff:=True;
 458    end;
 459
 460 procedure  MoveTo(NewRm : integer);
 461  var o : integer;
 462  begin
 463    if(57 in inven)and(ropecon<>Null)and not(ropecon in inven)
 464      and(ropecon in mov)and not(ropecon=70)then
 465       begin r[ropecon]:=Prm;RL(158);end
 466    else if(57 in inven)and(ropecon<>Null)and(not(ropecon in mov)or
 467         ((ropecon=70)and(en('d'))))then
 468           begin RL(55);inven:=inven-[57];r[57]:=Prm;end
 469    else if not(57 in inven)and((ropecon in inven)or
 470           (ropecon in[60,56,44]))then r[57]:=NewRm
 471    else if not(57 in inven)and(r[57]=Prm)and(r[ropecon]=NewRm)then
 472           begin r[57]:=NewRm;RopeOld:=Prm;end
 473    else if not(57 in inven)and(r[57]=Prm)and(NewRm=RopeOld)and
 474               (r[ropecon]=Prm)then
 475           begin r[57]:=RopeOld;RopeOld:=Null;end;
 476    if(ropecon=Null)or((NewRm<>RopeOld)and(Prm<>RopeOld))then RopeOld:=Null;
 477    if(MnRm<>Null)then Monster(NewRm);
 478    if(Prm in[63..68])and not(NewRm in[59,69])then RL(343);
 479    if(Prm in[59,63..68])then for o:=0 to NMax do if(r[o]=Prm)then r[o]:=NewRm;
 480    Prm:=NewRm;
 481    DescribeRm
 482  end;  {of MoveTo}
 483
 484 procedure Time;
 485    begin
 486      Tic:=Tic+1;
 487   case Tic of
 488     3:RL(280);
 489     4:RS(1);
 490     17:if not(en('A'))then begin RS(3);DEAD end else RS(5);
 491     19:RL(4);
 492     20:RL(5);
 493     21:RL(6);
 494     23:RS(6);
 495     24:if(en('B'))then begin RS(8);writeln;RL(16);moveto(5);Sc:=Sc+25;
 496          n[64,5]:='ship';v[26,2]:='pick' end
 497        else begin RS(7);DEAD;end;
 498     43:if(not(en('c'))and not(en('n')))then RL(31);
 499     73:if(not(en('c'))and not(en('n')))then RL(32);
 500     93:if(not(en('c'))and not(en('n')))then begin RL(33); DEAD end;
 501     99:if(Prm in[6..24])and(here(29))and not(flasoff)and(not(en('s')))then
 502          begin RL(41);Ev:=Ev+['s'] end;
 503     147:if not(en('n'))then RL(31);
 504     149:if(here(29))and not(flasoff)then RL(59);
 505     153:if(Prm in[6..23])and(here(29))and not(flasoff)then
 506           begin RS(14);vanish(29) end;
 507     170:if not(en('n'))then RL(32);
 508     181:if not(en('n'))then begin RL(33); DEAD end;
 509     549:RL(281);
 510     586:RL(282);
 511     598:RL(283);
 512     607:begin RL(284);DEAD;end;
 513   end; {of case}
 514
 515 case Prm of
 516     1..3:if(tic>4)and(random(4)=1)then RL(405);
 517   36..39:if(random(5)=2)then RL(219);
 518      7  :if(random(8)=2)then RL(266);
 519      8  :if(random(3)=2)then begin RL(265);play(6666,7000,0);end;
 520   13..24:if(random(16)=2)then RL(246);
 521   25..35:if(random(30)=2)then RL(267);
 522    47,48:if(random(5)=2)and(inven <>[])then
 523            begin
 524             if(Prm=48)then begin writeln;RS(40)end
 525             else begin writeln;RS(44);moveto(48)end;
 526             o:=1;flag:='?';
 527             repeat o:=o+1;
 528              if(o in inven)then
 529              begin vanish(o);r[o]:=random(9)+41;flag:='g';end;
 530             until Flag = 'g';
 531            end;
 532 end;
 533 case Prm of
 534   5,6,9,10:if(random(9)=2)then RL(268);
 535   7,8,11..40:if(here(84))and(random(20)=2)then RL(269)
 536         else if(random(75)=2)then RS(36)
 537         else if(Prm in[5..22])and(random(33)=2)then
 538          begin RL(265);play(6500,6950,0)end;
 539   41..49:if(random(27)=2)then RL(285);
 540     59  :if(random(15)=1)then RL(406);
 541 end;
 542 if Attack and(MnRm=Prm)and(not Back)then
 543  begin case random(3) of 0:RS(80); 1:RS(81); 2:RS(82)end;DEAD end
 544 else if(MnRm=Prm)then Attack:=True
 545    end;  {of Time}
 546
 547 function Present : Boolean;
 548    begin
 549     if(noun<>Null)and(noun<>1)then
 550      if(here(noun))then
 551       if(noun2<>Null)then
 552        if(here(noun2))then Present:=true
 553        else begin
 554          writeln('You can''t see any ',n[noun2,1],' here.');Present:=false end
 555       else Present:=true
 556      else begin
 557        writeln('You can''t see any ',n[noun,1],' here.');Present:=false end
 558     else Present:=true
 559    end;
 560
 561 procedure Initialize;
 562  var S: string;
 563
 564  procedure Cn(S : Str80);
 565  begin
 566   gotoxy(40-(length(S)div 2),wherey);
 567   writeln(S);
 568  end;
 569   begin
 570    textcolor(15);
 571    writeln('Prepare to engage yourself in a most exciting adventure.');
 572    writeln('But first, two simple questions:');
 573    gotoxy(1,4);write('Are you using a COLOR screen (Y/N)? ');
 574    nosound; play(72,80,45);
 575    flag:='N'; play(2500,2490,6);
 576    m0:=20;m1:=14;m2:=11;m3:=4;m4:=15;m5:=28;m6:=1;m7:=4;m8:=10;m9:=10;
 577    if upcase(flag)='N' then
 578     begin
 579      writeln('No, I don''t have a color screen.');
 580      m0:=31;m1:=15;m2:=15;m3:=7;m4:=0;m5:=31;m6:=7;m7:=8;m8:=7;m9:=0;
 581     end else writeln('Yes, I do have a color screen.');writeln;
 582    write('How many disk drives do you have (1/2)? ');
 583    play(80,88,30);
 584    flag:='2';play(2500,2490,6);
 585    Drive:='B:';
 586    if(upcase(flag)='O')or(flag='1')then
 587     begin Drive:='A:';writeln('I have ONE disk drive.')end else
 588     writeln('I have TWO disk drives.');
 589    delay(999);clrscr;textcolor(15);gotoxy(1,5);writeln;textcolor(7);
 590    cn('Beyond the Titanic');textcolor(6);cn('------------------');writeln;
 591    textcolor(7);
 592    cn('A Text & Sound Adventure Fantasy');writeln;writeln;
 593    cn('An Apogee Software Production');writeln;writeln;writeln;
 594    cn('Written and Programmed by Scott Miller');
 595    textcolor(11);
 596    gotoxy(32,24);textcolor(7);
 597    write('Press any key...');{flag:=ReadKey;}clrscr;
 598
 599    {                      *** SHAREWARE SCREEN ***                            }
 600
 601    textcolor(15);
 602    writeln('Please note that Beyond the Titanic is a SHAREWARE game.');
 603    writeln;
 604    textcolor(7);
 605    writeln('This game has been placed in the public domain for your enjoyment.');
 606    writeln;
 607    writeln('If you like the game the author (Scott Miller) asks that you please');
 608    writeln('contribute $5 or $10 (your discretion) to him.  This minimal payment');
 609    writeln('will help compensent the author for the year of work that went into');
 610    writeln('Beyond the Titanic.  It will also encourage the author to make new and');
 611    writeln('better games, like Supernova and Kingdom of Kroz, both of which are');
 612    writeln('also shareware games recently released.');
 613    writeln;
 614    writeln('This fee also registers the payer for telephone support and clues.');
 615    writeln;writeln;
 616    writeln('Please make checks payable to Scott Miller.');
 617    writeln;
 618    textcolor(15);
 619    writeln('        Scott Miller           (214) 240-0614');
 620    writeln('        4206 Mayflower Dr.');
 621    writeln('        Garland, TX  75043');
 622    writeln;
 623    textcolor(7);
 624    writeln('Thanks, enjoy the game...');
 625    gotoxy(23,25);
 626    {delay(12000);}
 627    while keypressed do flag:=ReadKey;
 628    write('Press any key to start the game...');
 629    {flag:=ReadKey;}
 630    while keypressed do flag:=ReadKey;
 631    clrscr;
 632    {                      ************************                            }
 633    window(1,2,80,25);
 634    gotoxy(1,1);
 635    TextColor(m1);
 636 cn('APRIL 14, 1912    11:43 PM');
 637 cn('You never knew the black canvas of the night was so full'+
 638    ' of twinkling detail.');
 639 cn('Standing on deck of the White Star''s new super luxury liner, deep at sea,');
 640 cn('where the bright lights of San Francisco don''t fade the night, you');
 641 cn('can view thousands of stars you never realized existed.');
 642 cn('Looking out over the icy sea you can barely see small pieces of'+
 643    ' broken ice');
 644 cn('bobbing in the water.  Rumor has it that icebergs the size of small');
 645 cn('mountains can be found in this region.  You don''t feel');
 646 cn('too worried, though, the Titanic has been touted as');
 647 cn('"unsinkable," and every single passenger knows');
 648 cn('that White Star, the premier ship builder,');
 649 cn('knows their stuff...');
 650 for x:= 1 to 3 do writeln;
 651 Line        :='';
 652 LastNoun    :='';
 653 KitSet      :=[2,29,57];
 654 CabiSet     :=[89,63];
 655 CompCon     :=Null;
 656 PanelCon    :=8;
 657 RopeCon     :=Null;
 658 SlotCon     :=Null;
 659 RopeOld     :=Null;
 660 RmSh        :=[];
 661 Mov         :=[2,7,8,13,27,29,32,34,40,52,51,57,63,70,74,77,89];
 662 OneWordCommands:=[1,4,5,7,8,16,18,19,22,31,33..35,41,43..54,56..59,61..65];
 663 Ev          :=[];
 664 Inven       :=[];
 665 Prm         :=0;
 666 MnRm        :=Null;
 667 Tic         :=Prm;
 668 Sc          :=0;
 669 Shots       :=6;
 670 KeyHole     :=false;
 671 Verbose     :=true;
 672 Attack      :=False;
 673 YearDial    :=135;
 674 DayDial     :=60;
 675 assignfile(rooms1,'ROOMS1');
 676 assignfile(rooms2,'ROOMS2');
 677 assignfile(special1,'SPECIAL1');
 678 assignfile(special2,'SPECIAL2');
 679 assignfile(line1,'LINE');
 680
 681 getdir(0,S);
 682 chdir(S);
 683 {Writeln ('Current directory is : ',S);}
 684
 685
 686 {$I+}
 687
 688 {filemode:=1;}
 689 reset(rooms1);
 690
 691 reset(rooms2);
 692 reset(special1);
 693 reset(special2);
 694 reset(line1);
 695
 696
 697 Str(Random(9998)+1,Code);
 698
 699    DescribeRm;
 700    writeln;
 701    randomize;
 702    gotoxy(1,1);
 703    TextBackGround(m6);
 704    for x:=1 to 80 do write(' ');
 705    writeln;
 706    TextColor(m4);
 707
 708    gotoxy(4,1);
 709    writeln('Move');
 710
 711    gotoxy(68,1);
 712    writeln('Score');
 713    TextColor(m2);
 714    TextBackGround(0);
 715    Window(1,2,80,25);
 716
 717   end; {of Initialize}
 718 {***************************** END OF COMMANDS *****************************}