home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / KMAGV2.ZIP / CFEXAM.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-02  |  7KB  |  240 lines
  1. {CFEXAM.PAS / EXAMPLE FOR A CROSSFADE EFFECT}
  2. {WRITING BY THE KING IN 10/22/95            }
  3. Uses Crt;
  4. Type
  5.     PicType = Array[0..64000] Of Byte;     {Pointer To The Pictures}
  6.     PicTypeP = ^PicType;
  7.  
  8.     RGB = Record                           {A Record Of Red,Green,Blue}
  9.         R,G,B:Byte;
  10.     End;
  11.  
  12.     PalType = Array[0..255] Of RGB;        {256 Color Of Red Green Blue}
  13.  
  14.     CelHeader=Record                {A Cel File Header}
  15.         Sign:Word;
  16.         W,H:Word;
  17.         X,Y:Word;
  18.         Depth:Byte;
  19.         Compress:Byte;
  20.         Data:LongInt;
  21.         Filler:Array[1..16] OF Byte;
  22.         Pal:PalType;
  23.      End;
  24. Var
  25.     PalP1 : PalType;                        {Palette For Picture 1}
  26.     PalP2 : PalType;                        {Palette For Picture 2}
  27.     PalCP1: PalType;                        {Palette For CrossFade Pic 1}
  28.     PalCP2: PalType;                        {Palette For CrossFade Pic 2}
  29.  
  30.     Pic1,Pic2 : PicTypeP;            {The Pictures Array}
  31.  
  32. {--------------------------------------}
  33. {Wait For Vertical Retrace .           }
  34. {--------------------------------------}
  35. Procedure Retrace; Assembler;
  36. Asm
  37.     Mov dx,3dah
  38. @Vert1:
  39.     In Al,Dx
  40.     Test Al,8
  41.     Jz @Vert1
  42. @Vert2:
  43.     In Al,Dx
  44.     Test Al,8
  45.     Jnz @Vert2
  46. End;
  47.  
  48.  
  49. {------------------------------------------------}
  50. {Set Mode To Mode 3H , 80x25x16 Colors..         }
  51. {------------------------------------------------}
  52. Procedure SetTextMode;Assembler;
  53. Asm
  54.     Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
  55.     Mov Al,3h
  56.     Int 10h    {SET MODE TO MODE 3 / TEXT MODE}
  57. End;
  58. {-----------------------------------------}
  59. { Show Picture On Screen .                }
  60. {-----------------------------------------}
  61.  
  62. Procedure ShowPic(Pic:PicTypeP);Assembler;
  63.   Asm
  64.     Push Ds
  65.     Mov Ax,Word(Pic+2)                {Take The Segment Of Pic}
  66.     Mov Ds,Ax
  67.     Xor Si,Si                         {Si = 0}
  68.     Mov Ax,0a000h
  69.     Mov Es,Ax
  70.     Xor Di,Di                         {Di = 0}
  71.     Mov Cx,32000                      {32000*2 = 64000}
  72.     Rep MovSw                         {Move 32000*2 Bytes}
  73.     Pop Ds
  74.  End;
  75. {-------------------------------------------------------}
  76. {Set Red Green And Blue To a Color                      }
  77. {-------------------------------------------------------}
  78.  
  79. Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
  80. Asm
  81.     Mov Dx,3c8h                  {SET TO SET COLOR}
  82.     Mov Al,Col
  83.     Out Dx,Al
  84.     Inc Dx                       {DX = 3c9h}
  85.     Mov Al,R                     {Senting Red Value}
  86.     Out Dx,Al
  87.     Mov Al,G                     {Senting Green Value}
  88.     Out Dx,Al
  89.     Mov Al,B                     {Senting Blue Value}
  90.     Out Dx,Al
  91. End;
  92.  
  93. {---------------------------------------------------}
  94. { Show The Palette                                  }
  95. {---------------------------------------------------}
  96. Procedure ShowPal(Var Pal:PalType;StartP,EndP:Byte);
  97. Var T:Byte;
  98. Begin
  99.     For T:=StartP To EndP Do
  100.         SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
  101. End;
  102.  
  103. {---------------------------------------------------}
  104. { Fade To The Screen From Palette To Palette.       }
  105. {---------------------------------------------------}
  106. Procedure FadeTo(Pal,ToPal:PalType);
  107. Var
  108.     T,T1:Byte;
  109. Begin
  110.     For T1:=1 To 63 Do
  111.     Begin
  112.         For T:=1 To 255 Do
  113.         Begin
  114.             If Pal[T].R > ToPal[T].R Then
  115.                 Dec(Pal[T].R);
  116.             If Pal[T].R < ToPal[T].R Then
  117.                 Inc(Pal[T].R);
  118.             If Pal[T].G > ToPal[T].G Then
  119.                 Dec(Pal[T].G);
  120.             If Pal[T].G < ToPal[T].G Then
  121.                 Inc(Pal[T].G);
  122.             If Pal[T].B > ToPal[T].B Then
  123.                 Dec(Pal[T].B);
  124.             If Pal[T].B < ToPal[T].B Then
  125.                 Inc(Pal[T].B);
  126.         End;
  127.         ShowPal(Pal,1,255);
  128.         Delay(30);   {Can Be Change To What Speed You Want}
  129.         Retrace;
  130.     End;
  131. End;
  132. {------------------------------------------------}
  133. {Set Mode To Mode 13H , 320x200x256 Colors..     }
  134. {------------------------------------------------}
  135. Procedure SetMode;Assembler;
  136. Asm
  137.        Mov Ah,00h  {Function 00,13 Interrupt 10h / SET MODE}
  138.     Mov Al,13h
  139.     Int 10h     {SETING TO MODE 13H}
  140. End;
  141.  
  142. {------------------------------------------------}
  143. {Load Cel file .                                 }
  144. {------------------------------------------------}
  145. Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;
  146. Var F:File;
  147.     Cel:CelHeader;
  148. Begin
  149.     {$I-}
  150.     Assign(F,Name);
  151.     Reset(F,1);
  152.     {$I+}
  153.     If IoResult=0 Then
  154.         Begin
  155.             LoadCel:=True;
  156.             BlockRead(F,Cel,SizeOf(Cel));
  157.             BlockRead(F,Where,FileSize(F)-SizeOf(Cel));
  158.             Pal:=Cel.Pal;
  159.             Close(F);
  160.         End
  161.         Else
  162.         Begin
  163.             LoadCel:=False;
  164.         End;
  165. End;
  166. {---------------------------------------------}
  167. {Build The Picture Of The Cross Fade          }
  168. {---------------------------------------------}
  169. Procedure MakeCrossFade;
  170. Var
  171.     Colors : Array[0..255] Of Record
  172.         Pix1,Pix2:Byte;
  173. End;
  174.     T:Word;
  175.     T1:Word;
  176.     Num:Word;
  177.     Pix1,Pix2:Byte;
  178. Begin
  179.     T:=0;
  180.     Num := 1;
  181.     Repeat
  182.         Pix1 := PIC1^[T];
  183.         Pix2 := PIC2^[T];
  184.         For T1 := 0 To Num - 1 Do
  185.         Begin
  186.             If (Num <> 1) And (Pix1=Colors[T1].Pix1) And (Pix2=Colors[T1].Pix2) Then
  187.             Begin
  188.                 PIC1^[T] := T1;
  189.                 T1:=256;
  190.                 Break;
  191.             End
  192.         End;
  193.  
  194.         If T1 <> 256 Then
  195.         Begin
  196.               PIC1^[T] := Num;
  197.             PalCP1[Num] := PalP1[Pix1];
  198.             PalCP2[Num] := PalP2[Pix2];
  199.             Colors[Num].Pix1 := Pix1;
  200.             Colors[Num].Pix2 := Pix2;
  201.             Num := Num + 1;
  202.         End;
  203.         Inc(T);
  204.         If Num > 255 Then
  205.         Begin
  206.             Writeln('More Then 256 Colors . ');
  207.             Halt;
  208.         End;
  209.     Until(T=64000);
  210. End;
  211. {---------------------------------------------------}
  212. { Make a BLACK Palette                              }
  213. {---------------------------------------------------}
  214. Procedure ZeroPal(Var Pal:PalType);
  215. Begin
  216.     FillChar(Pal,SizeOf(Pal),0);
  217. End;
  218.  
  219. Begin
  220.     New(Pic1);                        {Allocate Memory For Pic1}
  221.     New(Pic2);                        {Allocate Memory For Pic1}
  222.  
  223.     LoadCel('Box.Cel' ,Pic1^,PalP1);  {Load Cel To Pic1 And Pal to PalP1}
  224.     LoadCel('Back.Cel',Pic2^,PalP2);  {Load Cel To Pic2 And Pal to PalP2}
  225.     MakeCrossFade;                    {Make The Cross Fade Picture And Pals}
  226.     SetMode;                          {Set to 320x200x256}
  227.     ZeroPal(PalP1);
  228.     ShowPal(PalP1,1,255);
  229.     ShowPic(Pic1);                    {Show Picture PIC1}
  230.     FadeTo(PalP1,PalCP1);
  231.     Repeat
  232.         FadeTo(PalCp1,PalCp2);        {Fade From PalCP1 To PalCP2}
  233.         FadeTo(PalCp2,PalCp1);        {Fade From PalCP2 To PalCP1}
  234.     Until(KeyPressed);                {Wait For KeyPressed}
  235.     FadeTo(PalCP1,PalP1);
  236.     SetTextMode;
  237. End.
  238.  
  239.  
  240.