home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB13.ZIP / NOFLASH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-05-19  |  4.3 KB  |  196 lines
  1.  
  2.  
  3. {$u-}
  4. {$c-}
  5. {$u-}
  6. {$c-}
  7. {$x+}
  8. {$k-}
  9. const
  10.   time_array : array[1..7] of array[1..50] of char =
  11.  
  12.     ('~~~~~~~~~~~~   ~~~~~~~~~~   ~~~~~    ~~~~~~~~~~~~ ',
  13.      '~~~~~~~~~~~~   ~~~~~~~~~~  ~~~~~~~   ~~~~~~~~~~~~ ',
  14.      '     ~~~       ~~~         ~~             ~~~     ',
  15.      '     ~~~       ~~~~~~~~     ~~~~~~        ~~~     ',
  16.      '     ~~~       ~~~               ~~       ~~~     ',
  17.      '     ~~~       ~~~~~~~~~~  ~~~~~~~~       ~~~     ',
  18.      '     ~~~       ~~~~~~~~~~   ~~~~~~        ~~~     ');
  19.  
  20. type
  21.   char_cell   = record
  22.                   code : char;
  23.                   attr : byte;
  24.                   end;
  25.  
  26.   screen_type = array[1..25] of array[1..80] of char_cell;
  27.  
  28. var
  29.   ch          : char;
  30.   i,j,k,l,m,n : byte;
  31.   screen      : screen_type;
  32.   real_screen : ^screen_type;
  33.   mode        : integer;
  34.  
  35. procedure update_screen(y,lines : byte);
  36.  
  37.   begin
  38.   if mode <> 1 then
  39.     repeat until (port[$3da] and 8) = 8;
  40.   if mode <> 1 then
  41.     port[$3d8] := 1;
  42.   move(screen[y],real_screen^[y],lines * 160);
  43.   if mode <> 1 then
  44.     port[$3d8] := 9;
  45.   end;
  46.  
  47. procedure read_screen(y,lines : byte);
  48.  
  49.   begin
  50.   if mode <> 1 then
  51.     repeat until (port[$3da] and 8) = 8;
  52.   if mode <> 1 then
  53.     port[$3d8] := 1;
  54.   move(real_screen^[y],screen[y],lines * 160);
  55.   if mode <> 1 then
  56.     port[$3d8] := 9;
  57.   end;
  58.  
  59. procedure march;
  60.  
  61. const first_half  : string[18] = 'n si sihT         ';
  62.       second_half : string[18] = 'ot a test         ';
  63.  
  64. var i,j : byte;
  65.     ch  : char;
  66.  
  67.  
  68. procedure position(i : integer;
  69.                    var x,y : byte);
  70. begin
  71.   if i <= 16
  72.   then begin
  73.          x := 1;
  74.          y := i;
  75.        end
  76.   else begin
  77.          x := i - 16;
  78.          y := 17;
  79.        end;
  80. end;
  81.  
  82. procedure print(num : byte);
  83. var x,y,
  84.     j,k   : byte;
  85.     i     : integer;
  86. begin
  87.   j := 0;
  88.   for i := num downto num - 17 do
  89.     if i > 0
  90.     then begin
  91.            j := j + 1;
  92.            position(i,x,y);
  93.            screen[y,x].code := first_half[j];
  94.            screen[y,81 - x].code := second_half[j];
  95.            if y < 16 then
  96.              k := y
  97.            else
  98.              k := 15;
  99.            if (k = 1) and (mode = 1) then
  100.              k := 2;
  101.            if (k = 9) and (mode = 1) then
  102.              k := 10;
  103.            screen[y,x].attr := k;
  104.            screen[y,81 - x].attr := k;
  105.          end;
  106.  
  107.   if y < 17 then
  108.     begin
  109.     update_screen(1,8);
  110.     update_screen(8,8);
  111.     update_screen(16,8);
  112.     end
  113.   else
  114.     update_screen(y,1);
  115. end;
  116.  
  117. begin
  118.   for i := 1 to 56 do
  119.     print(i);
  120.   delay(500);
  121. end;
  122.  
  123.  
  124. begin
  125.   ClrScr;
  126.   real_screen := ptr($b800,0);   {change to $b800 for color, $b000 for mono}
  127.   fillchar(screen,4000,0);
  128.   mode := 2;                     {change to 2 for color, 1 for mono}
  129.  
  130.   for i := 1 to 50 do                      {Display initial banner}
  131.     for j := 1 to 7 do
  132.       begin
  133.       screen[j,i].code := time_array[j,i];
  134.       screen[j,i].attr := 15;
  135.       end;
  136.  
  137.   update_screen(1,8);
  138.  
  139.   for i := 1 to 8 do
  140.     begin
  141.     for j := 7 downto 0 do
  142.       begin
  143.       move(screen[j + i],screen[j + i + 1],120);
  144.       fillchar(screen[j + i],120,0);
  145.       end;
  146.     update_screen(i,8);
  147.     end;
  148.  
  149.   delay(250);
  150.  
  151.   for i := 9 downto 1 do                       {Tilt banner}
  152.     begin
  153.     move(screen[i + 8,1],screen[i + 8,11 - i],120);
  154.     fillchar(screen[i + 8,1],19 - (2 * i),0);
  155.     end;
  156.  
  157.   update_screen(8,8);
  158.   delay(250);
  159.  
  160.   for k := 1 to 14 do                      {Center banner}
  161.     begin
  162.     for j := 9 to 17 do
  163.       move(screen[j,k],screen[j,k + 1],120);
  164.     update_screen(8,8);
  165.     end;
  166.  
  167.   for i := 9 downto 1 do                       {UnTilt banner}
  168.     move(screen[i + 8,11 - i],screen[i + 8,1],160);
  169.   update_screen(8,8);
  170.  
  171.   march;                                  {Bring in the rest of the title}
  172.  
  173.   gotoxy(28,25);
  174.   write('(Press Any Key To Start)');
  175.   read(kbd,ch);
  176.   read_screen(1,25);
  177.  
  178.   for i := 8 downto 1 do                       {Tilt banner}
  179.     begin
  180.     move(screen[i+8,1],screen[i + 8,11 - i],120);
  181.     fillchar(screen[i + 8,1],19 - (2 * i),0);
  182.     end;
  183.  
  184.   update_screen(8,8);
  185.   delay(250);
  186.  
  187.   for k := 11 to 79 do                    {Remove banner}
  188.     begin
  189.     for j := 9 to 15 do
  190.       move(screen[j,k],screen[j,k + 1],160 - k * 2);
  191.     update_screen(8,8);
  192.     end;
  193.  
  194. end.
  195.  
  196.