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