home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / LADDERS.ZIP / LADDERS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-21  |  37KB  |  939 lines
  1. {$X+R+}
  2. PROGRAM ladders;          { Last update 6/21/95 }
  3.                         { FreeWare by Stan Ockers }
  4.  
  5. USES ANIVGA,MUSIC,CRT,DOS;
  6.  
  7. CONST
  8.       MAXmazeh = 26 ; { max # of rooms horizontally }
  9.       MAXmazev = 26 ; { max # of rooms vertically }
  10.       MOVEBKG = 96; { Number of pixels from edge to start scrolling }
  11.       BLANK = 20;   { Sprite Load # of blank square }
  12.       vanish = 'MST200L8O3dO4CGO5D';
  13.       birdsnd  = 'MST150L16O5CEDCDFCDECDFCDEC';
  14.       rollsnd = 'MLO3L32CEGBDFACFADBCEGBDFACFADBCEGBDFACFADBCEGBDFACFADB'+
  15.              'CEGBDFACFADBCEGBDFACFADBCEGBDFACFADBCEGBDFACFADB';
  16.       uhuh = 'MST100L12O1EL4C';
  17.       picksnd = 'MNT200L8O4DA';
  18.       hallking='MST150O2L8EFGABGL4BL8A+FL4A+L8AFL4AL8EFGABGB>E>DBGBL2>D'+
  19.                  'O3L8EFGABGL4BL8A+FL4A+L8AFL4AL8EFGABGB>E>DBGBL2>D';
  20.       funeral='MNT100O2L4FFF8FA-G8GF8FE8F2';
  21.  TYPE Str80 = String[80];
  22.  
  23. VAR j,k,           { general counting variables }
  24.     vsize,hsize,   { current sizes of maze ) }
  25.     row,           { row # of current room ( 1 to mazev ) }
  26.     col,           { column # of current room ( 1 to mazeh ) }
  27.     level           { holds current level }
  28.     :Integer;
  29.  
  30.     maze           { holds #'s indicating rooms exits ... }
  31.                    { bit 0 = 1 means an exit up }
  32.                    { bit 1 = 1 means an exit right }
  33.                    { bit 2 = 1 means an exit down }
  34.                    { bit 3 = 1 means an exit left }
  35.                    { bit 4 = 1 means a carry item in room }
  36.                    { bit 5 = 1 means a blocker object in room }
  37.                    { bit 6 = 1 means room is a dead end }
  38.                    { bit 7 = 1 means there is a torch in room }
  39.     : ARRAY[1..MAXmazev,1..MAXmazeh] OF Byte;
  40.     nextsprite : Word;  { holds number of next sprite to allocate }
  41.     roomsprite : ARRAY[1..60,1..2] OF word;  {matches room# and sprite in it}
  42.     reg : Registers;   { from Dos unit }
  43.     ch : Char;
  44.     faceleft : Boolean;  { is man facing left? }
  45.     quitgame,founddoor : Boolean;  { to get out cleanly }
  46.     blockedarray : ARRAY[1..60,1..3] OF Byte;  { holds row,col & }
  47.                                             { direction of blocked wall }
  48.  
  49.     oops : Byte;     { how many times giving wrong item }
  50.     roll : Boolean;   { is man rolling ? }
  51.     ladderpnt,graybrkpnt : Pointer;  { pointers to images }
  52.     temppal,blackpal : Palette;
  53.   LABEL NewLevel,    { point to start a new level }
  54.         Dejavu;      { restart at the same level }
  55. {**********************************************************************}
  56.   { Return a string nbr long of characters ch. }
  57.  
  58.   FUNCTION Replicate(nbr:Byte;ch:Char) : Str80;
  59.     VAR temp : Str80;
  60.     BEGIN
  61.       IF nbr = 0 THEN temp :=''
  62.       ELSE BEGIN
  63.         IF nbr >80 THEN nbr:=1;
  64.         FillChar(temp,nbr+1,ch);
  65.         temp[0]:=Chr(nbr)
  66.       END;  { Else }
  67.       Replicate := temp;
  68.     END;  { Replicate }
  69.  
  70. {**********************************************************************}
  71.     { Convert an integer into a string }
  72.  
  73.   FUNCTION IntToStr(I : LongInt; places : Byte) : Str80;
  74.     VAR temp : String[11];
  75.         len : Byte;
  76.     BEGIN
  77.       Str(i,temp);  len := Length(temp);
  78.       IF len < places THEN
  79.          temp := Replicate(places - len, #32) + temp;
  80.       IntToStr := temp;
  81.     END;  { Int_To_Str }
  82.  
  83. {**********************************************************************}
  84.  
  85.    PROCEDURE makemaze;
  86. TYPE
  87.     shortarray = ARRAY[1..4] OF ShortInt;
  88. CONST
  89.      delx : shortarray = (0,1,0,-1);
  90.      dely : shortarray = (-1,0,1,0);
  91.      pwrs2 : shortarray = (1,2,4,8);
  92. VAR
  93.    j,k,q,y,x,d,nd,repcount : ShortInt;
  94.    rmcnt,totroom,deadendtotal : Word;
  95.    t : ARRAY[1..6] OF Byte;
  96. PROCEDURE adjacent;
  97. BEGIN
  98.      q := 0;
  99.      IF y>1 THEN
  100.         IF maze[y-1,x] = 0 THEN
  101.            BEGIN Inc(q); t[q]:=0; END;
  102.      IF x<hsize THEN
  103.         IF maze[y,x+1] = 0 THEN
  104.            BEGIN Inc(q); t[q]:=1; END;
  105.      IF y<vsize THEN
  106.         IF maze[y+1,x] = 0 THEN
  107.            BEGIN Inc(q); t[q]:=2; END;
  108.      IF x>1 THEN
  109.         IF maze[y,x-1] = 0 THEN
  110.            BEGIN Inc(q); t[q]:=3; END;
  111. END;   { adjacent }
  112.  
  113. BEGIN
  114.      Randomize;
  115.      totroom := hsize * vsize;
  116.      FOR j:=1 to vsize DO           { zero out maze }
  117.          FOR k:=1 to hsize DO
  118.              maze[j,k] := 0;
  119.      rmcnt := 1; repcount := 0;
  120.      x := Random(hsize)+1;
  121.      y := Random(vsize)+1;
  122.      WHILE rmcnt < totroom DO
  123.      BEGIN
  124.           adjacent;
  125.           IF (q = 0) OR (repcount > 5) THEN
  126.           BEGIN
  127.                repcount := 0;
  128.                REPEAT
  129.                       REPEAT
  130.                        Inc(y);
  131.                        IF y > vsize THEN
  132.                             BEGIN y:=1; inc(x); END;  {IF}
  133.                        IF x > hsize THEN
  134.                             x := 1;
  135.                 UNTIL maze[y,x] > 0;
  136.                 adjacent;
  137.                 UNTIL q > 0;
  138.           END; {IF}
  139.      d:= t[Random(q)+1];
  140.      maze[y,x]:=maze[y,x]+pwrs2[d+1];
  141.      y:=y+dely[d+1];
  142.      x:=x+delx[d+1];
  143.      nd:=d-2;
  144.      IF nd<0 THEN
  145.         nd:=nd+4;
  146.      maze[y,x]:=maze[y,x]+pwrs2[nd+1];
  147.      Inc(rmcnt); Inc(repcount);
  148.    END;  {WHILE}
  149.         { randomly open up some rooms (otherwise too frustrating) }
  150.         FOR j := 1 TO 3*level DO
  151.           BEGIN
  152.              x := 2 + random(hsize-2);   { don't select outside rooms }
  153.              y := 2 + random(vsize-2);   { find random point }
  154.              d := random(4);
  155.              CASE d OF
  156.                0 : BEGIN
  157.                 maze[y,x]:= maze[y,x] OR 1;
  158.                         Dec(y);
  159.                 maze[y,x]:= maze[y,x] OR 4;
  160.                    END;
  161.                1 : BEGIN
  162.                 maze[y,x]:= maze[y,x] OR 2;
  163.                         Inc(x);
  164.                 maze[y,x]:= maze[y,x] OR 8;
  165.                    END;
  166.                2 : BEGIN
  167.                 maze[y,x]:= maze[y,x] OR 4;
  168.                         Inc(y);
  169.                 maze[y,x]:= maze[y,x] OR 1;
  170.                    END;
  171.                3 : BEGIN
  172.                 maze[y,x]:= maze[y,x] OR 8;
  173.                         Dec(x);
  174.                 maze[y,x]:= maze[y,x] OR 2;
  175.                    END;
  176.              END;  { Case }
  177.           END;   { For }
  178.   END;  { makemaze }
  179.  
  180. {**********************************************************************}
  181.  
  182.   PROCEDURE DeadEnds(endsNeeded:Word);
  183.   VAR deadendtotal : Word;
  184.     BEGIN   { DeadEnds }
  185.      REPEAT
  186.        MakeMaze;
  187.        deadendtotal := 0;    { reset counter }
  188.           { set bit 6 of rooms that are dead ends }
  189.        FOR j := 1 TO vsize DO
  190.          FOR k:= 1 TO hsize DO
  191.            IF {(((maze[j,k] AND 15) =1) AND (maze[j-1,k] IN [12,6])) OR }
  192.             (((maze[j,k] AND 15) =2) AND (maze[j,k+1] IN [10,12])) OR
  193.             (((maze[j,k] AND 15) =4) AND (maze[j+1,k] IN [9,3])) OR
  194.             (((maze[j,k] AND 15) =8) AND (maze[j,k-1] IN [6,10]))
  195.             THEN IF
  196.               NOT ((j IN [1,2]) AND (k IN [1,2])) { not the upper left corner }
  197.             THEN BEGIN
  198.                maze[j,k] := maze[j,k] OR 64;
  199.                inc(deadendtotal);
  200.             END;  { THEN }
  201.      UNTIL deadendtotal >= EndsNeeded ;    { not enough valid ones }
  202.     END;  { DeadEnds }
  203.  
  204. {**********************************************************************}
  205.  
  206. PROCEDURE CheckFileErr(name:STRING);
  207. { in: Error = error value}
  208. {     name  = file to deal with}
  209. {out: If there was an error with the file, the program stops in a clean way}
  210. BEGIN
  211.  IF Error<>Err_None
  212.   THEN BEGIN
  213.         CloseRoutines;
  214.         WRITELN('Couldn''t access file '+name+' : '+GetErrorMessage);
  215.         halt(1)
  216.        END;
  217. END;
  218.  
  219. {**********************************************************************}
  220.      {  Get a free deadend position }
  221.   PROCEDURE GetDeadEnd;   { col,row are changed (global variables) }
  222.     BEGIN
  223.      REPEAT
  224.        row := Random(vsize) + 1;
  225.        col := Random(hsize) + 1;
  226.       UNTIL (maze[row,col] AND 64 = 64);   { dead end }
  227.       maze[row,col] := maze[row,col] AND $BF;  { remove as dead end }
  228.     END;   { GetDeadEnd }
  229.  
  230. {**********************************************************************}
  231.      {  Go back one room from deadend room and block entrance }
  232.   PROCEDURE GoBackOne;   { col,row are changed (global variables) }
  233.     VAR direction,j : Byte;
  234.     BEGIN
  235.       CASE (maze[row,col] AND 15) OF    { go to previous room }
  236.         1 : BEGIN Dec(row); direction := 4; END;    { up }
  237.         2 : BEGIN Inc(col); direction := 8; END;    { right }
  238.         4 : BEGIN Inc(row); direction := 1; END;    { down }
  239.         8 : BEGIN Dec(col); direction := 2; END;    { left }
  240.       END;  { Case }
  241.       maze[row,col] := maze[row,col] XOR direction; { put up invisible wall }
  242.       j := 1;                     { find an opening in blocked array }
  243.       WHILE (j<31) AND (blockedarray[j,1] > 0) DO Inc(j);
  244.       blockedarray[j,1] := row;  blockedarray[j,2] := col;
  245.       blockedarray[j,3] := direction;        { fill in values }
  246.     END;   { GoBackOne }
  247.  
  248. {**********************************************************************}
  249.    PROCEDURE PutGlyph(col,row,block : Integer);
  250.    VAR
  251.       j:Integer;
  252.    BEGIN
  253.         IF ((maze[row,col] AND 1)=0) THEN      { No top exit }
  254.             BEGIN
  255.               PutTile(64*col,64*row,block);
  256.               PutTile(64*col+16,64*row,block);
  257.               PutTile(64*col+32,64*row,block);
  258.               PutTile(64*col+48,64*row,block);
  259.             END
  260.         ELSE
  261.         BEGIN                                 { Draw ladder }
  262.            PutTile(64*col,64*row,block);
  263.            PutTile(64*col+32,64*row,10);
  264.            PutTile(64*col+32,64*row+16,10);
  265.            PutTile(64*col+32,64*row+32,10);
  266.            PutTile(64*col+32,64*row+48,10);
  267.            IF ((maze[Pred(row),col] AND 1) = 0) OR   { extend floor }
  268.                ((maze[Pred(row),col] AND 10) > 0)    { to ladder }
  269.             THEN
  270.              BEGIN
  271.                PutTile(64*col+16,64*row,block);
  272.                PutTile(64*col+48,64*row,block);
  273.              END;
  274.         END;  { Else }
  275.         FOR j:= 0 TO 3 DO
  276.         IF((maze[row,col] AND 8)=0) THEN        { No left exit }
  277.           BEGIN
  278.               PutTile(64*col,64*row+16*j,block);
  279.           END
  280.         ELSE
  281.            ;
  282. END;  { PutGlyph }
  283.  
  284. {**********************************************************************}
  285.  
  286.    PROCEDURE drawmaze;
  287.      VAR row,col,block : Integer;
  288.      BEGIN
  289.      block := 10+level;
  290.      MakeTileArea(27,1,1);      { clear out the background }
  291.      FOR row := 0 TO 100 DO SpriteN[row] := 0;  { no sprites }
  292.      FOR row := 1 TO vsize DO
  293.          FOR col := 1 TO hsize DO
  294.              PutGlyph(col,row,block);
  295.         FOR col:=1 TO hsize DO           { last horiz wall }
  296.           BEGIN
  297.               PutTile(64*col,64*vsize+64,block);
  298.               PutTile(64*col+16,64*vsize+64,block);
  299.               PutTile(64*col+32,64*vsize+64,block);
  300.               PutTile(64*col+48,64*vsize+64,block);
  301.           END;
  302.         FOR row:=1 TO vsize DO
  303.           BEGIN
  304.            PutTile(64*hsize+64,64*row,block);    { last vert wall }
  305.            PutTile(64*hsize+64,64*row+16,block);
  306.            PutTile(64*hsize+64,64*row+32,block);
  307.            PutTile(64*hsize+64,64*row+48,block);
  308.           END;
  309.         PutTile(64*hsize+64,64*vsize+64,block);          { one final chunk }
  310.  
  311.      END;  { DrawMaze }
  312.  
  313.  
  314. {**********************************************************************}
  315.  
  316.    PROCEDURE setsprite(index,x,y: word);
  317.      VAR freepos:Word;
  318.      BEGIN
  319.       Inc(nextsprite);
  320.       SpriteN[nextsprite] := 42+index;
  321.       SpriteX[nextsprite] := 64*col+x;
  322.       SpriteY[nextsprite] := 64*row+y;
  323.       { find free pos in roomsprite array and insert room#, sprite# }
  324.       freepos := 1;
  325.       While roomsprite[freepos,1] > 0 DO Inc(freepos);
  326.       roomsprite[freepos,1] := hsize*Pred(row)+col;
  327.       roomsprite[freepos,2] := nextsprite;
  328.      END;  { SetSprite }
  329.  
  330.  
  331. {**********************************************************************}
  332.  
  333.   PROCEDURE Init;
  334.  
  335.   VAR
  336.      j : Integer;
  337.   BEGIN
  338.     level := 1;
  339.       { load all sprites }
  340.     LoadSprite('lasprite.lib',1); CheckFileErr('lasprite.lib');
  341.      { Sprite LOAD numbers:                                                }
  342.      {  1 - 13 climber images:                                             }
  343.      {    1 face left, 2 face right, 3-5 climb, 6-9 walk left, 10-13 right }
  344.      {  14 torch, no flame  15-19 torch with flame (linked)                }
  345.      {  20 black blank area to clear carry square                          }
  346.      {  21 pow image used when blocker hit                                 }
  347.      {  22 wall lit by torch ( will be used with getimage )                }
  348.      {  23 open door image                                                 }
  349.      {  24-27 images showing climber rolling                               }
  350.      {  28-30 stunned climber images (linked)                              }
  351.      {  31-38 vanish images for disappearing blocker                       }
  352.      {  39  locked message for door                                        }
  353.      {  40  ladder image ( will be used with getimage for static bkgd )    }
  354.      {  41  block image ( also used with getimage )                        }
  355.      {  42-131 pairs of blocker-carry item images (42 is door 43 is key)   }
  356.     LoadFont('modernfo.fnt');  CheckFileErr('modernfo.fnt');
  357.     InitGraph;
  358.       { load all tiles }
  359.     LoadTile('latile.lib',10); CheckFileErr('latile.lib');
  360.      {  Tile load numbers:                                                }
  361.      {  10 ladder image                                                   }
  362.      {  11-25 fifteen different block images for making maze              }
  363.      {  26 image of wall lit by torch                                     }
  364.      {  27 black 16X16 image used to blank out background                 }
  365.     LoadPalette('ladders.pal',0,temppal);  CheckFileErr('ladders.pal');
  366.     FillChar(blackpal,SizeOF(blackpal),0);
  367.     SetSpriteCycle(15,5);        { tie torches together }
  368.     SetSpriteCycle(28,3);       { tie dizzy together }
  369.     SetSpriteCycle(31,8);       { tie fades together }
  370.     SetSplitIndex(1);
  371.   END;   { Init }
  372. {**********************************************************************}
  373.  
  374.   PROCEDURE MakeLevel;
  375.   CONST MAXSPRITECHOICE = 89;
  376.   VAR
  377.      j,spriteord  : Integer;
  378.      usedsprite : ARRAY[1..100] OF Boolean;
  379.  
  380.     PROCEDURE PlacePairs(nbr: integer);
  381.      { activate nbr carry items & blockers - blocker goes with next carry }
  382.      VAR
  383.         j  : Word;
  384.      BEGIN
  385.        j := 1;
  386.        WHILE j < nbr DO
  387.           BEGIN
  388.             { find dead end for carry item ,spriteord holds ordinal of .. }
  389.              GetDeadEnd;
  390.              SetSprite(spriteord,16,48);      { last chosen carry item }
  391.              maze[row,col] := maze[row,col] OR 16;
  392.              { choose next carry item }
  393.              REPEAT
  394.                spriteord := Random(MAXSPRITECHOICE) +1;
  395.              UNTIL Odd(spriteord) AND (usedsprite[spriteord] = FALSE);
  396.              usedsprite[spriteord] := TRUE;
  397.              { place Blocker in position ( to block previous carry item ) }
  398.              GoBackOne;               { back up one room }
  399.              SetSprite(spriteord-1,32,24);  { activate blocker }
  400.              maze[row,col] := maze[row,col] OR 32;   { room contains blocker }
  401.              Inc(j);
  402.            END; { While }
  403.       { now last carry item ( with no blocker ) }
  404.         REPEAT
  405.           row := 1+Random(vsize);
  406.           col := 1+Random(hsize);
  407.         UNTIL maze[row,col] AND 53 = 0;    { no carry,blocker or stairs }
  408.         SetSprite(spriteord,16,48);        { activate carry item }
  409.         usedsprite[spriteord] := TRUE;     { we have used this carry item }
  410.         maze[row,col] := maze[row,col] OR 16;  { room contains carry item }
  411.    END;  { PlacePairs }
  412.  
  413.   BEGIN   { makelevel }
  414.     founddoor := FALSE;  roll := FALSE;  oops := 0;
  415.     FOR j := 1 TO 100 DO  SpriteN[j] := 0; { make sure no sprites left over }
  416.     FillChar(roomsprite,Sizeof(roomsprite),0);    { init roomsprite array }
  417.     FillChar(blockedarray,Sizeof(blockedarray),0); { init blocked array }
  418.     FOR j := 1 to 100 DO usedsprite[j] := FALSE;
  419.     vsize := 6+level; hsize := 6+level;
  420.     SetBackgroundMode(scrolling);
  421.     StartVirtualX := 0;  StartVirtualY := 0;
  422.     SetBackgroundScrollRange(0,0,64*hsize+128,64*vsize+128);
  423.     SetCycleTime(60);       { 0.06 sec ? }
  424.     SetAnimateWindow(16,4,XMAX-4,YMAX-28);
  425.     quitgame := FALSE; ch := #0;
  426.     Color := 206;
  427.     FillBackground(Color);
  428.     GraphTextOrientation := vertical;
  429.     GraphTextColor := 42; GraphTextBackground := 206;
  430.     BackgroundOutTextXY(3,11,'LADDERS');
  431.     GraphTextColor := 45; GraphTextBackground := 45;
  432.     BackgroundOutTextXY(2,10,'LADDERS');
  433.     GraphTextOrientation := horizontal;
  434.     GraphTextColor := 42; GraphTextBackground := 206;
  435.     BackgroundOutTextXY(116,181,'Level:'+ IntToStr(level,2));
  436.     GraphTextColor := 45; GraphTextBackground := 45;
  437.     BackgroundOutTextXY(115,180,'Level:'+ IntToStr(level,2));
  438.     GraphTextColor := 42; GraphTextBackground := 206;
  439.     BackgroundOutTextXY(201,181,'Carrying:');
  440.     GraphTextColor := 45; GraphTextBackground := 45;
  441.     BackgroundOutTextXY(200,180,'Carrying:');
  442.     Color := 168;
  443.     Line(15,3,XMAX-3,3,2);                     { line around scoll window }
  444.     Line(15,YMAX-27,XMAX-3,YMAX-27,2);
  445.     Line(15,4,15,YMAX-28,2);
  446.     Line(XMAX-3,4,XMAX-3,YMAX-27,2);
  447.     Line(275,179,308,179,2);                    { line around carry box }
  448.     Line(308,180,308,196,2);
  449.     Line(275,196,307,196,2);
  450.     Line(275,180,275,196,2);
  451.     Color := 25;  { black }
  452.     FOR j := 180 TO 195 DO  Line(276,j,307,j,2);   { clear out carry window }
  453.     FOR j := 4 TO YMAX-28 DO  Line(16,j,Xmax-4,j,2);{ clear out scroll window }
  454.     FadeIn(BACKGNDPAGE,500,Fade_Moiree2);
  455.     UpdateOuterArea := 2;
  456.     Randomize;
  457.     DeadEnds(level+3); { make a maze with at least specified # of deadends }
  458.     DrawMaze;
  459.     {  Normal sprite numbers ( not load numbers ):     }
  460.     {   #0 = object being carried BLANK or odd # 43 up }
  461.     {   #1 = climber from load #'s 1-13 or 24-30       }
  462.     {   #2 = vanish sequence #'s 31-38                 }
  463.     {   #3 = locked message # 39                       }
  464.     {   #18 - #49  torches from load #'s 14-19         }
  465.     {   #50 up  blocker-carryitem pairs                }
  466.        { place man in first room row =1 , col = 1 }
  467.     SpriteN[1]:=1; SpriteX[1]:=96;   SpriteY[1]:=104;
  468.     SpriteN[0] := BLANK;    { object being carried }
  469.     { choose carry items and set in position with blockers }
  470.     nextsprite := 49;                    { start #  -1 for carry sprites }
  471.     GetDeadEnd;                            { find dead end for door }
  472.     SetSprite(0,16,8);                       { insert door in screen }
  473.     SpriteX[3] := 64*col+20;   { set up 'locked' message coordinates }
  474.     SpriteY[3] := 64*row+32;
  475.     maze[row,col] := maze[row,col] OR 32;   { door marked as blocker }
  476.     spriteord :=1;                         { first carry item is key }
  477.     usedsprite[1] := TRUE;                  { don't choose key again }
  478.     PlacePairs(level);    { now place key & level # blocker & carry items }
  479.      FOR j := 1 TO pred(level) DO     { now some more random carry items  }
  480.        BEGIN
  481.           REPEAT                            { choose next carry item }
  482.             spriteord := Random(MAXSPRITECHOICE) +1;
  483.           UNTIL Odd(spriteord) AND (usedsprite[spriteord] = FALSE);
  484.           usedsprite[spriteord] := TRUE;              { mark as used }
  485.           REPEAT
  486.             row := 1+Random(vsize);                  { random placement }
  487.             col := 1+Random(hsize);
  488.           UNTIL maze[row,col] AND 53 = 0;    { but no sprites or ladders }
  489.           SetSprite(spriteord,16,48);                   { o.k. insert it }
  490.           maze[row,col] := maze[row,col] OR 16;          { and mark room }
  491.        END;   { For }
  492.      { set up torch sprites }
  493.      FOR j := 18 TO 49 DO  { get random rooms for torches }
  494.        BEGIN
  495.          REPEAT
  496.            row := Random(vsize) + 1;
  497.            col := Random(hsize) + 1;
  498.           UNTIL maze[row,col] AND 240 = 0;     { room without sprites }
  499.                                                    { and not dead end }
  500.          maze[row,col] := maze[row,col] + 128; { mark room as having torch }
  501.          SpriteN[j] := 14;                      { torch sprite load # }
  502.          SpriteX[j] := 64*Pred(col)+114;
  503.          SpriteY[j] := 64*Pred(row)+84;
  504.        END;   { For }
  505.      row := 1;  col := 1;
  506.      faceleft := FALSE;
  507.    END;   { MakeLevel }
  508.  
  509. {**********************************************************************}
  510.  
  511.       FUNCTION GetKey : Char;  { Get a key add 128 to non-ASCII keys }
  512.         VAR ch : Char;
  513.         BEGIN
  514.           ch := ReadKey;
  515.           IF ch = #0 THEN BEGIN
  516.             ch := ReadKey;
  517.             ch := Chr( Ord(ch) + 128 );
  518.           END;  { If }
  519.           GetKey := ch;
  520.         END;    { GetKey }
  521.  
  522. {**********************************************************************}
  523.         { Flush keyboard buffer }
  524.  
  525.   PROCEDURE FlushKey;
  526.   BEGIN
  527.     reg.ah := 1;                               { check for keystroke }
  528.     Intr ($16,reg);
  529.     IF (reg.flags AND $0040) = 0 THEN      { if chars in buffer }
  530.       REPEAT
  531.         reg.ah := 0;                       { char is ready to go, read it }
  532.         Intr ($16, reg);
  533.         reg.ah := 1;                       { check for another }
  534.         Intr ($16, reg);
  535.       UNTIL (reg.flags AND $0040) <> 0;
  536.   END;  { FlushKey }
  537.  
  538. {**********************************************************************}
  539.  
  540.   PROCEDURE LightTorch;
  541.   BEGIN
  542.     FOR j := 18 to 49 DO        { for each torch sprite }
  543.       IF (SpriteX[j]  = 64 * Pred(col) + 114) AND    { if x & y match }
  544.          (SpriteY[j]  = 64 * Pred(row) + 84 ) THEN
  545.            IF SpriteN[j] = 14 THEN          { if not lit }
  546.              BEGIN
  547.               PutTile(64*col+48,64*row+16,26);  { light background }
  548.               SpriteN[j] := 15 + Random(5);     { light torch }
  549.              END;
  550.   END;  { LightTorch }
  551.  
  552. {**********************************************************************}
  553.  
  554.   PROCEDURE UnBlock;
  555.   VAR j : Integer;
  556.   BEGIN
  557.     j := 1;
  558.      WHILE blockedarray[j,1] > 0 DO
  559.       BEGIN
  560.         IF blockedarray[j,1] = row THEN
  561.           IF blockedarray[j,2] = col THEN
  562.              maze[row,col] := maze[row,col] + blockedarray[j,3];
  563.         Inc(j);
  564.       END;  { while }
  565.   END;  { UnBlock }
  566.  
  567. {**********************************************************************}
  568.  
  569.    PROCEDURE UpOne;
  570.      VAR
  571.      j : Integer;
  572.      BEGIN
  573.        REPEAT
  574.            FOR j:=1 TO 16 DO
  575.              BEGIN
  576.                Dec(SpriteY[1],4);
  577.                IF SpriteY[1] < StartVirtualY + MOVEBKG THEN
  578.                     Dec(StartVirtualY,4);
  579.                IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
  580.                                 SpriteN[1] := 3+j MOD 3;
  581.                SpriteX[0] := StartVirtualX + 276;
  582.                SpriteY[0] := StartVirtualY + 180;
  583.                Animate;
  584.              END;   { For }
  585.            Dec(row);
  586.            IF maze[row,col] AND 128 = 128 THEN LightTorch;
  587.            IF maze[row,col] AND 48 > 0 THEN Exit;   { exit if sprite }
  588.            IF  (maze[row,col] AND 10) > 0 THEN Exit;  { exit if side paths }
  589.            IF KeyPressed THEN Exit;
  590.          UNTIL maze[row,col] AND 1 = 0
  591.      END;   { UpOne }
  592.  
  593. {**********************************************************************}
  594.  
  595.    PROCEDURE DnOne;
  596.      VAR
  597.      j : Integer;
  598.      BEGIN
  599.        REPEAT
  600.            FOR j:=1 TO 16 DO
  601.              BEGIN
  602.                Inc(SpriteY[1],4);
  603.                IF SpriteY[1] > StartVirtualY + 200 - MOVEBKG THEN
  604.                        Inc(StartVirtualY,4);
  605.                IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
  606.                                SpriteN[1] := 3+j MOD 3;
  607.                SpriteX[0] := StartVirtualX + 276;
  608.                SpriteY[0] := StartVirtualY + 180;
  609.                Animate;
  610.              END;  { For }
  611.            Inc(row);
  612.            IF maze[row,col] AND 128 = 128 THEN LightTorch;
  613.            IF maze[row,col] AND 48 > 0 THEN Exit;   { exit if sprite }
  614.            IF  (maze[row,col] AND 10) > 0 THEN Exit;  { exit if side paths }
  615.            IF KeyPressed THEN Exit;
  616.        UNTIL maze[row,col] AND 4 = 0
  617.      END;   { DnOne }
  618.  
  619. {**********************************************************************}
  620.  
  621.    PROCEDURE LtOne;
  622.      VAR
  623.      j : Integer;
  624.      BEGIN
  625.        faceleft := TRUE; SpriteN[1] := 1;
  626.        REPEAT
  627.            FOR j:=1 TO 16 DO
  628.            BEGIN
  629.              Dec(SpriteX[1],4);
  630.              IF SpriteX[1] < StartVirtualX + MOVEBKG THEN
  631.                Dec(StartVirtualX,4);
  632.              IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
  633.                       SpriteN[1] := 6+j MOD 4;
  634.              SpriteX[0] := StartVirtualX + 276;
  635.              SpriteY[0] := StartVirtualY + 180;
  636.              Animate;
  637.            END;  { For }
  638.            Dec(col);
  639.            IF maze[row,col] AND 128 = 128 THEN LightTorch;
  640.            IF maze[row,col] AND 48 > 0 THEN Exit;   { exit if sprite }
  641.            IF  (maze[row,col] AND 5) > 0 THEN Exit;  { exit if vert paths }
  642.            IF KeyPressed THEN Exit;
  643.        UNTIL maze[row,col] AND 8 = 0
  644.      END;   { LtOne }
  645.  
  646. {**********************************************************************}
  647.  
  648.    PROCEDURE RtOne;
  649.      VAR
  650.      j : Integer;
  651.      BEGIN
  652.        faceleft := FALSE; SpriteN[1] := 2;
  653.        REPEAT
  654.            FOR j:=1 TO 16 DO
  655.            BEGIN
  656.              Inc(SpriteX[1],4);
  657.              IF SpriteX[1] > StartVirtualX + 320 - MOVEBKG THEN
  658.                Inc(StartVirtualX,4);
  659.              IF roll THEN SpriteN[1] := 24+j MOD 4 ELSE
  660.                          SpriteN[1] := 10+j MOD 4;
  661.              SpriteX[0] := StartVirtualX + 276;
  662.              SpriteY[0] := StartVirtualY + 180;
  663.              Animate;
  664.            END;  { For }
  665.            Inc(col);
  666.            IF maze[row,col] AND 128 = 128 THEN LightTorch;
  667.            IF maze[row,col] AND 48 > 0 THEN Exit;   { exit if sprite }
  668.            IF  (maze[row,col] AND 5) > 0 THEN Exit;  { exit if vert paths }
  669.            IF KeyPressed THEN Exit;
  670.        UNTIL maze[row,col] AND 2 = 0     { While clear Right }
  671.        END;   { RtOne }
  672.  
  673. {**********************************************************************}
  674.  
  675.    PROCEDURE Sparkle;   { disappear sequence }
  676.    VAR k : Byte;
  677.      BEGIN
  678.        PlayMusic(vanish);
  679.        SpriteN[2] := 31;       { vanish sequence }
  680.        SpriteX[2] := 64*col+32;
  681.        SpriteY[2] := 64*row+16;
  682.        FOR k := 1 TO 8 DO BEGIN Animate; Delay(150); END;
  683.        SpriteN[2] := 0;    { remove fade sequence }
  684.        Animate;
  685.      END;
  686.  
  687. {**********************************************************************}
  688.  
  689.    PROCEDURE HitSprite;
  690.      VAR j,k : Byte;
  691.          room,tone : word;
  692.      BEGIN
  693.         room := hsize*Pred(row)+col;
  694.         j := 1;
  695.         WHILE roomsprite[j,1] > 0 DO  { check all rooms containing sprites }
  696.         BEGIN
  697.           IF (roomsprite[j,1] = room) THEN
  698.           BEGIN
  699.         { man runs into obstacle and is carring proper item ... }
  700.              IF ((maze[row,col] AND 32) = 32) AND
  701.                          (SpriteN[0] = SpriteN[roomsprite[j,2]]+1)
  702.                THEN BEGIN
  703.                  IF j = 1 THEN
  704.                     BEGIN
  705.                       founddoor := TRUE;
  706.                       { put open door sequence here }
  707.                      END
  708.                   ELSE
  709.                   BEGIN
  710.                     SpriteN[0] := BLANK;   { blank out carried object from bkgd }
  711.                     SpriteN[roomsprite[j,2]] := 0;   { ... and from screen }
  712.                     Sparkle;               { disappear sequence }
  713.                     maze[row,col] := maze[row,col] XOR 32;  { remove sprite mark }
  714.                     UnBlock;     { remove invisible wall }
  715.                   END;
  716.                END
  717.         { man runs into obstacle and is NOT carring proper item ... }
  718.                ELSE
  719.                 BEGIN
  720.                  IF j = 1 THEN
  721.                     BEGIN
  722.                       PlayMusic(uhuh);    {start uhuh }
  723.                       SpriteN[3] := 39;   { locked message }
  724.                       Animate;
  725.                       Delay(900);
  726.                       SpriteN[3] := 0;     { remove message }
  727.                      END
  728.                   ELSE
  729.                   BEGIN
  730.                     Inc(oops);
  731.                     GraphTextColor := 42; GraphTextBackground := 206;
  732.                     BackgroundOutTextXY(StartVirtualX+21,StartVirtualY+181,
  733.                                           'That''s '+ IntToStr(oops,1));
  734.                     GraphTextColor := 45; GraphTextBackground := 45;
  735.                     BackgroundOutTextXY(StartVirtualX+20,StartVirtualY+180,
  736.                                           'That''s '+ IntToStr(oops,1));
  737.                     UpDateOuterArea := 2;
  738.                     SpriteN[1] := 21;     { pow }
  739.                     Animate;
  740.                     FOR k := 1 TO 3 DO
  741.                       BEGIN
  742.                         tone := 400;
  743.                         FOR j := 1 TO 16 DO
  744.                           BEGIN
  745.                              Sound(tone);
  746.                              Delay(15);
  747.                              Dec(tone,30);
  748.                           END;
  749.                         NoSound;
  750.                       END;
  751.                     roll := True;
  752.                     PlayMusic(rollsnd);     {start roll }
  753.                     CASE (maze[row,col] AND 15) OF
  754.                       1: UpOne;
  755.                       2: RtOne;
  756.                       4: DnOne;
  757.                       8: LtOne;
  758.                     END;  { Case }
  759.                     SpriteN[1] := 28;
  760.                     PlayMusic(birdsnd);       {start bird }
  761.                     FOR j := 1 TO 30 DO  Animate;
  762.                     roll := FALSE;
  763.                   END;
  764.                END;  { If }
  765.          END;  { If }
  766.          Inc(j);  {  Next roomsprite row  }
  767.        END;  { While }
  768.      END;  { HitSprite }
  769.  
  770. {**********************************************************************}
  771.  
  772.    PROCEDURE Pickup;
  773.      VAR
  774.       j,room,temp : Integer;
  775.      BEGIN
  776.        IF maze[row,col] AND 16 = 16 THEN    { carry item in room }
  777.          BEGIN
  778.            PlayMusic(picksnd);      {start pick }
  779.            room := hsize*Pred(row)+col; j := 1;   { find room }
  780.            WHILE roomsprite[j,1] <> room DO Inc(j); { and item }
  781.            IF SpriteN[0] = BLANK THEN  { not carrying anything }
  782.              BEGIN
  783.                SpriteN[0] := SpriteN[roomsprite[j,2]]; {carry #=sprite load #}
  784.                SpriteN[roomsprite[j,2]] := 0;  { sprite no longer appears }
  785.                maze[row,col] := maze[row,col] XOR 16;  { remove sprite mark }
  786.              END
  787.              ELSE      { must be carrying something }
  788.              BEGIN     { switch carry items }
  789.                temp := SpriteN[roomsprite[j,2]];  { save room sprite load # }
  790.                SpriteN[roomsprite[j,2]] :=  SpriteN[0];  { carried into room }
  791.                SpriteN[0] := BLANK; Animate;  { wipe out screen image }
  792.                Animate;  { from both pages }
  793.                SpriteN[0] := temp;  { room sprite load # into carry }
  794.              END;
  795.            END;
  796.      END;  { Pickup }
  797.  
  798. {**********************************************************************}
  799.  
  800.    PROCEDURE SelectLevel;
  801.      VAR  j : Byte;
  802.       ch  : Char;
  803.      BEGIN
  804.        FOR j := 0 TO 100 DO SpriteN[j] := 0;  { get rid of all sprites }
  805.        Animate;
  806.        SetBackgroundMode(static);
  807.        StartVirtualX := 0;  StartVirtualY := 0;
  808.        FillBackground(33);
  809.        GraphTextColor := 5; GraphTextBackground := 0;
  810.        FOR j := 0 TO 12 DO
  811.          BEGIN
  812.            BackgroundOutTextXY(3,12*j+22,#32#16);
  813.            BackgroundOutTextXY(299,12*j+22,#17#32);
  814.          END;
  815.        BackgroundOutTextXY(3,6,#32+Replicate(37,#31)+#32);
  816.        BackgroundOutTextXY(3,180,#32+Replicate(37,#30)+#32);
  817.        Color := 3;
  818.        Line(10,10,306,10,2);
  819.        Line(10,190,306,190,2);
  820.        Line(10,10,10,190,2);
  821.        Line(306,10,306,190,2);
  822.        GraphTextBackground := 33;  GraphTextColor := 15;
  823.        BackgroundOutTextXY(100,40,'Next Level: '+IntToStr(level,2));
  824.        BackgroundOutTextXY(75,60,#24#32#25+' : Change level.');
  825.        BackgroundOutTextXY(80,80,'Press Enter to start.');
  826.        BackgroundOutTextXY(45,110,'Use Spacebar to pick up items');
  827.        BackgroundOutTextXY(60,130,'Higher levels add objects');
  828.        BackgroundOutTextXY(70,150,'and increase maze size');
  829.        UpdateOuterArea := 2;
  830.        FadeIn(BACKGNDPAGE,1000,Fade_Moiree1);
  831.        Animate;
  832.        FlushKey;
  833.        REPEAT
  834.          ch := GetKey;
  835.          CASE ch OF
  836.            #200 : IF level < 15 THEN Inc(level);
  837.            #208 : IF level >1 THEN Dec(level);
  838.          END;  { Case }
  839.          IF ch IN[#200,#208] THEN
  840.            BEGIN
  841.              BackgroundOutTextXY(100,40,'Next Level: '+IntToStr(level,2));
  842.              Animate;
  843.            END;  { If }
  844.        UNTIL ch = #13;
  845.   END;  { Selectlevel }
  846.  
  847. {**********************************************************************}
  848.   PROCEDURE TitleScreen;
  849.   VAR x,y : Byte;
  850.   BEGIN
  851.     PlayMusic(hallking);
  852.     SetPalette(blackpal,FALSE);
  853.     SpriteN[0] := 40;     { put block wall image on screen and make a copy }
  854.     SpriteX[0] := 0;
  855.     SpriteY[0] := 0;
  856.     Animate;
  857.     LadderPnt :=GetImage(0,0,15,15,1-Page);
  858.     SpriteN[0] := 41;     { put ladder image on screen and make a copy }
  859.     SpriteX[0] := 0;
  860.     SpriteY[0] := 0;
  861.     Animate;
  862.     graybrkPnt :=GetImage(0,0,15,15,1-Page);
  863.     SpriteN[0] := 14;     { put torches by title }
  864.     SpriteX[0] := 80;
  865.     SpriteY[0] := 20;
  866.     SpriteN[1] := 14;
  867.     SpriteX[1] := 230;
  868.     SpriteY[1] := 20;
  869.     SpriteX[2] := 80;     { torch shadows }
  870.     SpriteY[2] := 15;
  871.     SpriteX[3] := 230;
  872.     SpriteY[3] := 15;
  873.     FOR x := 0 TO 19 DO PutImage(x*16,0,graybrkpnt,2);      { draw ceiling }
  874.     FOR y := 1 TO 11 DO PutImage(20,y*16,ladderpnt,2);      { draw ladder }
  875.     FOR x := 0 TO 19 DO PutImage(x*16,184,graybrkpnt,2);    { draw floor }
  876.     GraphTextColor := 200; GraphTextBackground := Black;
  877.     BackgroundOutTextXY(131,28,'LADDERS');
  878.     GraphTextColor := 79;
  879.     BackgroundOutTextXY(100,50,'by Stan Ockers');
  880.     GraphTextColor := 54;
  881.     BackgroundOutTextXY(60,80,'written in Turbo Pascal 6.0');
  882.     BackgroundOutTextXY(50,100,'using ANI-VGA by Kai Rohrbacher');
  883.     GraphTextColor := 200;
  884.     BackgroundOutTextXY(130,130,'FreeWare');
  885.     GraphTextColor := 100;
  886.     BackgroundOutTextXY(70,160,'press spacebar to start');
  887.     UpdateOuterArea := 2;
  888.     Animate;
  889.     FadeToPalette(temppal,100);
  890.     SpriteN[0] := 15;  SpriteN[1] := 15;   { light torches }
  891.     SpriteN[2] := 22;  SpriteN[3] := 22;   { with background }
  892.     WHILE NOT KeyPressed DO Animate;
  893.   END;   { TitleScreen }
  894.  
  895. {**********************************************************************}
  896. BEGIN       { Main Program }
  897.   Init;
  898.   TitleScreen;
  899.   NewLevel:
  900.   SelectLevel;
  901.   Dejavu:
  902.   MakeLevel;
  903.   LightTorch;                             { in case one at room #1 }
  904.   REPEAT
  905.    IF KeyPressed THEN
  906.     BEGIN
  907.       ch := UpCase(GetKey);
  908.       j := maze[row,col];
  909.       CASE ch OF
  910.           #203 : IF j AND 8 > 0 THEN  LtOne;
  911.           #205 : IF j AND 2 > 0 THEN  RtOne;
  912.           #200 : IF j AND 1 > 0 THEN  UpOne;
  913.           #208 : IF j AND 4 > 0 THEN  DnOne;
  914.           #32  : Pickup;
  915.       END;  { Case }
  916.       IF{ (maze[row,col] AND 16 = 16) OR } (maze[row,col] AND 32 = 32)
  917.                       THEN Hitsprite; { deal with sprites }
  918.       flushkey;
  919.     END;  { If KeyPressed }
  920.   IF oops = 3 THEN
  921.      BEGIN PlayMusic(funeral); Goto Dejavu; END;
  922.   SpriteX[0] := StartVirtualX + 276;
  923.   SpriteY[0] := StartVirtualY + 180;
  924.   IF faceleft THEN SpriteN[1] := 1   { face forward }
  925.         ELSE SpriteN[1] := 2;
  926.   Animate;
  927.  UNTIL (ch='Q') OR (ch=#27) OR (founddoor);  {'Q' or ESC to quit}
  928.    IF founddoor THEN
  929.      BEGIN
  930.        PlayMusic(hallking);
  931.        SpriteN[50] := 23;      { open door }
  932.        Animate;
  933.        Inc( level);
  934.        Delay(2000);
  935.        Goto NewLevel;
  936.      END;
  937.  CloseRoutines;
  938. END.
  939.