home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / PHRO.ZIP / CREDITS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-21  |  4KB  |  157 lines
  1. {   Credits Screen Source file                 }
  2. {   PHRO!                                      }
  3. {   Phred/OTM                                  }
  4. {   achalfin@uceng.uc.edu                      }
  5. {   DO NOT DISTRIBUTE THIS SOURCE FILE         }
  6. Unit Credits;
  7.  
  8. Interface
  9.  
  10. Procedure Creditz;
  11.  
  12. Implementation
  13.  
  14. Uses Crt;
  15.  
  16. Type
  17.   tArray = Array[0..255*255-2] of Byte;
  18.   pArray = ^tArray;
  19.   RGB = Record
  20.     r,g,b : Byte;
  21.   End;
  22.   Palette = Array[0..255] of RGB;
  23.  
  24. Var
  25.   CreditsPtr : Pointer;
  26.   PCXBuffer : pArray;
  27.  
  28. {$F+}
  29. {$L Credits.Obj}
  30. Procedure CreditsPCX; External;
  31. {$F-}
  32.  
  33.  
  34. Procedure Creditz;
  35.  
  36. Var
  37.   PcxSeg, PcxOfs : Word;
  38.   TOffset : Word;
  39.   RunLen, Value : Byte;
  40.   Pal1, Pal2 : Palette;
  41.   Count, Count1 : Integer;
  42.  
  43. Begin
  44.   New(PcxBuffer);
  45.   PcxSeg := Seg(CreditsPtr^);
  46.   PcxOfs := Ofs(CreditsPtr^) + 128;
  47.   TOffset := 0;
  48.   While tOffset < 64000 do
  49.     Begin
  50.       RunLen := Mem[PcxSeg:PcxOfs];
  51.       Inc(PcxOfs);
  52.       If (RunLen and $C0) = $C0
  53.         Then Begin
  54.           RunLen := RunLen And $3f;
  55.           Value := Mem[PcxSeg:PcxOfs];
  56.           Inc(PcxOfs);
  57.         End
  58.         Else Begin
  59.           Value := RunLen;
  60.           RunLen := 1;
  61.         End;
  62.       While (RunLen >= 1) and (TOffset < 64000) do
  63.         Begin
  64.           PcxBuffer^[tOffset] := Value;
  65.           TOffset:= TOffset + 1;
  66.           RunLen := RunLen - 1;
  67.         End;
  68.     End;
  69.     PcxOfs := PcxOfs + 1; { the "12" byte }
  70.   Move(Mem[PcxSeg:PcxOfs], Pal1, 768);
  71.   For Count := 0 to 255 do
  72.     Begin
  73.       Pal1[Count].r := Pal1[Count].r Div 4;
  74.       Pal1[Count].g := Pal1[Count].g Div 4;
  75.       Pal1[Count].b := Pal1[Count].b Div 4;
  76.     End;
  77.   FillChar(Pal2, 768, 0);
  78.   For Count := 0 to 255 do
  79.     Begin
  80.       Port[$3c8] := Count;
  81.       Port[$3c9] := Pal2[Count].r;
  82.       Port[$3c9] := Pal2[Count].g;
  83.       Port[$3c9] := Pal2[Count].b;
  84.     End;
  85.   Move(PcxBuffer^[0], Mem[$A000:0], 64000);
  86.   For Count := 0 to 63 do
  87.     Begin
  88.       For Count1 := 0 to 255 do
  89.         Begin
  90.           If Pal2[Count1].r < Pal1[Count1].r
  91.             Then Inc(Pal2[Count1].r);
  92.           If Pal2[Count1].r > Pal1[Count1].r
  93.             Then Dec(Pal2[Count1].r);
  94.           If Pal2[Count1].g < Pal1[Count1].g
  95.             Then Inc(Pal2[Count1].g);
  96.           If Pal2[Count1].g > Pal1[Count1].g
  97.             Then Dec(Pal2[Count1].g);
  98.           If Pal2[Count1].b < Pal1[Count1].b
  99.             Then Inc(Pal2[Count1].b);
  100.           If Pal2[Count1].b > Pal1[Count1].b
  101.             Then Dec(Pal2[Count1].b);
  102.         End;
  103.       Asm
  104.         Mov  dx,$3da
  105.        @Looper:
  106.         In   al,dx
  107.         And  al,8
  108.         Jz  @Looper
  109.       End;
  110.       For Count1 := 0 to 255 do
  111.         Begin
  112.           Port[$3c8] := Count1;
  113.           Port[$3c9] := Pal2[Count1].r;
  114.           Port[$3c9] := Pal2[Count1].g;
  115.           Port[$3c9] := Pal2[Count1].b;
  116.         End;
  117.     End;
  118.   Delay(5000);
  119.   FillChar(Pal1, 768, 0);
  120.   For Count := 0 to 63 do
  121.     Begin
  122.       For Count1 := 0 to 255 do
  123.         Begin
  124.           If Pal2[Count1].r < Pal1[Count1].r
  125.             Then Inc(Pal2[Count1].r);
  126.           If Pal2[Count1].r > Pal1[Count1].r
  127.             Then Dec(Pal2[Count1].r);
  128.           If Pal2[Count1].g < Pal1[Count1].g
  129.             Then Inc(Pal2[Count1].g);
  130.           If Pal2[Count1].g > Pal1[Count1].g
  131.             Then Dec(Pal2[Count1].g);
  132.           If Pal2[Count1].b < Pal1[Count1].b
  133.             Then Inc(Pal2[Count1].b);
  134.           If Pal2[Count1].b > Pal1[Count1].b
  135.             Then Dec(Pal2[Count1].b);
  136.         End;
  137.       Asm
  138.         Mov  dx,$3da
  139.        @Looper:
  140.         In   al,dx
  141.         And  al,8
  142.         Jz  @Looper
  143.       End;
  144.       For Count1 := 0 to 255 do
  145.         Begin
  146.           Port[$3c8] := Count1;
  147.           Port[$3c9] := Pal2[Count1].r;
  148.           Port[$3c9] := Pal2[Count1].g;
  149.           Port[$3c9] := Pal2[Count1].b;
  150.         End;
  151.     End;
  152.   Dispose(PcxBuffer);
  153. End;
  154.  
  155. Begin
  156.   CreditsPtr := @CreditsPCX;
  157. End.