src/COMMANDS.PAS

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