home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TUT11.ZIP / TUTPRO11.PAS < prev   
Pascal/Delphi Source File  |  1994-04-25  |  8KB  |  216 lines
  1. {$X+}
  2. USES GFX2,crt;  { Please use the GFX2 unit from now on! The GFX unit had
  3.                   quite a big bug in it, and less routines... }
  4.  
  5. Type Pallette = Array [0..255,1..3] of byte;
  6.  
  7. VAR source,dest:Pallette;
  8.     VirScr2 : VirtPtr;                     { Our second Virtual screen }
  9.     Vaddr2 : Word;                      { The segment of our 2nd virt. screen}
  10.     dir:boolean;     { Fade up or fade down? }
  11.     loop1:integer;
  12.  
  13. {──────────────────────────────────────────────────────────────────────────}
  14. Procedure LoadCELPal (FileName : String; Var Palette : Pallette);
  15.   { This loads in the pallette of the .CEL file into the variable Palette }
  16. Var
  17.   Fil : file;
  18. Begin
  19.   Assign (Fil, FileName);
  20.   Reset (Fil, 1);
  21.   Seek(Fil,32);
  22.   BlockRead (Fil, Palette, 768);
  23.   Close (Fil);
  24. End;
  25.  
  26.  
  27. {──────────────────────────────────────────────────────────────────────────}
  28. Procedure Init;
  29.   { We get memory for our pointers here }
  30. BEGIN
  31.   fillchar (source,sizeof(source),0);
  32.   fillchar (dest,sizeof(dest),0);
  33.   GetMem (VirScr2,64000);
  34.   vaddr2 := seg (virscr2^);
  35. END;
  36.  
  37. {──────────────────────────────────────────────────────────────────────────}
  38. Procedure SetItUp;
  39.   { We define our third screen here }
  40. VAR loop1,loop2,loop3:integer;
  41.     pal1,pal2:pallette;
  42.     change:boolean;
  43.     where:integer;
  44.     r,g,b,r1,g1,b1:byte;
  45. BEGIN
  46.   cls (vaddr2,0);
  47.  
  48.   For loop1:=0 to 255 do
  49.     pal (loop1,0,0,0);
  50.  
  51.   loadcel ('to.cel',virscr);
  52.   loadcelpal ('to.cel',pal2);
  53.   flip (vaddr,vga);
  54.   loadcel ('from.cel',virscr);
  55.   loadcelpal ('from.cel',pal1);
  56.  
  57.   where:=0;
  58.  
  59.   For loop1:=0 to 319 do
  60.     for loop2:=0 to 199 do BEGIN
  61.       if (getpixel(loop1,loop2,vaddr)<>0) or (getpixel (loop1,loop2,vga)<>0) then BEGIN
  62.         change:=false;
  63.         r:=pal1[getpixel(loop1,loop2,vaddr),1];
  64.         g:=pal1[getpixel(loop1,loop2,vaddr),2];
  65.         b:=pal1[getpixel(loop1,loop2,vaddr),3];
  66.         r1:=pal2[getpixel(loop1,loop2,vga),1];
  67.         g1:=pal2[getpixel(loop1,loop2,vga),2];
  68.         b1:=pal2[getpixel(loop1,loop2,vga),3];
  69.  
  70.         for loop3:=0 to where do
  71.           if (source[loop3,1]=r) and (source[loop3,2]=g) and (source[loop3,3]=b) and
  72.              (dest[loop3,1]=r1) and (dest[loop3,2]=g1) and (dest[loop3,3]=b1) then BEGIN
  73.              putpixel (loop1,loop2,loop3,vaddr2);
  74.              change:=TRUE;
  75.           END;
  76.           { Here we check that this combination hasn't occured before. If it
  77.             has, put the appropriate pixel onto the third screen (vaddr2) }
  78.  
  79.         if not (change) then BEGIN
  80.           inc (where);
  81.           if where=256 then BEGIN
  82.             settext;
  83.             writeln ('Pictures have too many colors! Squeeze then retry!');
  84.             Halt;
  85.             { There were too many combinations of colors. Alter picture and
  86.               then retry }
  87.           END;
  88.           putpixel(loop1,loop2,where,vaddr2);
  89.           source[where,1]:=pal1[getpixel(loop1,loop2,vaddr),1];
  90.           source[where,2]:=pal1[getpixel(loop1,loop2,vaddr),2];
  91.           source[where,3]:=pal1[getpixel(loop1,loop2,vaddr),3];
  92.           dest[where,1]:=pal2[getpixel(loop1,loop2,vga),1];
  93.           dest[where,2]:=pal2[getpixel(loop1,loop2,vga),2];
  94.           dest[where,3]:=pal2[getpixel(loop1,loop2,vga),3];
  95.             { Create a new color and set it's from and to pallette values }
  96.         END;
  97.       END;
  98.     END;
  99.   cls (vga,0);
  100. END;
  101.  
  102. {──────────────────────────────────────────────────────────────────────────}
  103. Procedure Crossfade (direction:boolean;del,farin:word);
  104.   { This fades from one picture to the other in the direction specified
  105.     with a del delay. It crossfades one degree for every value in farin.
  106.     If farin=63, then a complete crossfade occurs }
  107. VAR loop1,loop2:integer;
  108.     temp:pallette;
  109. BEGIN
  110.   if direction then BEGIN
  111.     temp:=source;
  112.     for loop1:=0 to 255 do
  113.       pal (loop1,source[loop1,1],source[loop1,2],source[loop1,3]);
  114.     flip (vaddr2,vga);
  115.     For loop1:=0 to farin do BEGIN
  116.       waitretrace;
  117.       for loop2:=0 to 255 do
  118.         pal (loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]);
  119.       for loop2:=0 to 255 do BEGIN
  120.         if temp[loop2,1]<dest[loop2,1] then inc (temp[loop2,1]);
  121.         if temp[loop2,1]>dest[loop2,1] then dec (temp[loop2,1]);
  122.         if temp[loop2,2]<dest[loop2,2] then inc (temp[loop2,2]);
  123.         if temp[loop2,2]>dest[loop2,2] then dec (temp[loop2,2]);
  124.         if temp[loop2,3]<dest[loop2,3] then inc (temp[loop2,3]);
  125.         if temp[loop2,3]>dest[loop2,3] then dec (temp[loop2,3]);
  126.           { Move temp (the current pallette) from source to dest }
  127.       END;
  128.       delay (del);
  129.     END;
  130.   END
  131.   else BEGIN
  132.     temp:=dest;
  133.     for loop1:=0 to 255 do
  134.       pal (loop1,dest[loop1,1],dest[loop1,2],dest[loop1,3]);
  135.     flip (vaddr2,vga);
  136.     For loop1:=0 to farin do BEGIN
  137.       waitretrace;
  138.       for loop2:=0 to 255 do
  139.         pal (loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]);
  140.       for loop2:=0 to 255 do BEGIN
  141.         if temp[loop2,1]<source[loop2,1] then inc (temp[loop2,1]);
  142.         if temp[loop2,1]>source[loop2,1] then dec (temp[loop2,1]);
  143.         if temp[loop2,2]<source[loop2,2] then inc (temp[loop2,2]);
  144.         if temp[loop2,2]>source[loop2,2] then dec (temp[loop2,2]);
  145.         if temp[loop2,3]<source[loop2,3] then inc (temp[loop2,3]);
  146.         if temp[loop2,3]>source[loop2,3] then dec (temp[loop2,3]);
  147.           { Move temp (the current pallette) from dest to source }
  148.       END;
  149.       delay (del);
  150.     END;
  151.   END
  152. END;
  153.  
  154. BEGIN
  155.   clrscr;
  156.   writeln ('Hello there! This trainer program is on cross fading. What will happen');
  157.   writeln ('is this : The program will load in two .CEL files, FROM.CEL and TO.CEL');
  158.   writeln ('into the virtual screen at vaddr and to the VGA screen. The pallettes');
  159.   writeln ('of these two pictures are loaded into pal1 and pal2. Note that you');
  160.   writeln ('could easily rewrite this to load in other types of files if you do');
  161.   writeln ('not own Autodesk Animator to draw your files (The pictures presented');
  162.   writeln ('here were drawn by Fubar, sqeezed by me ;)). A third screen is then');
  163.   Writeln ('generated into vaddr2 (this takes 5-10 seconds on my 386-40). Note');
  164.   writeln ('that you could dump vaddr2 to disk as a file instead of calculating it');
  165.   writeln ('each time...it would be faster and be half the size of the two pictures.');
  166.   Writeln ('The picture will then crossfade between the two. Hit a key and it will');
  167.   writeln ('crossfade halfway and then exit.');
  168.   writeln;
  169.   writeln ('After one particular comment E-Mailed to me, I thought I should just add');
  170.   writeln ('this : I am not an employee of Autodesk, and they do not pay me to promote');
  171.   writeln ('their product. You have no idea how much I wish they would :)  I recieve');
  172.   writeln ('absolutely _nothing_ for writing the trainer...');
  173.   writeln;
  174.   writeln;
  175.   write ('Hit any key to continue ...');
  176.   readkey;
  177.   randomize;
  178.   setupvirtual;
  179.   setmcga;
  180.   init;
  181.   SetItUp;
  182.   for loop1:=0 to 255 do
  183.     pal (loop1,source[loop1,1],source[loop1,2],source[loop1,3]);
  184.   flip (vaddr2,vga);
  185.   delay (3000);
  186.  
  187.   dir:=TRUE;
  188.   while keypressed do readkey;
  189.   repeat
  190.     crossfade(dir,20,63);
  191.     dir:=not (dir);
  192.     delay (1000);
  193.   until keypressed;
  194.   Readkey;
  195.   crossfade(dir,20,20);
  196.   readkey;
  197.   settext;
  198.   Writeln ('All done. This concludes the eleventh sample program in the ASPHYXIA');
  199.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  200.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  201.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  202.   Writeln ('    smith9@batis.bis.und.ac.za');
  203.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  204.   Writeln ('             Grant Smith');
  205.   Writeln ('             P.O. Box 270');
  206.   Writeln ('             Kloof');
  207.   Writeln ('             3640');
  208.   Writeln ('             Natal');
  209.   Writeln ('             South Africa');
  210.   Writeln ('I hope to hear from you soon!');
  211.   Writeln; Writeln;
  212.   Write   ('Hit any key to exit ...');
  213.   readkey;
  214.   shutdown;
  215.   FreeMem (VirScr2,64000);
  216. END.