home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / HQ_WATER.ZIP / COLORS.PAS < prev    next >
Pascal/Delphi Source File  |  1994-07-26  |  3KB  |  128 lines
  1.  
  2. UNIT Colors;
  3.  
  4. interface
  5.  
  6. uses Global;
  7.  
  8.   procedure InitColors;
  9.  
  10.   procedure GetPalette( var RGB; from : byte; count : word);
  11.   procedure SetPalette( var RGB; from : byte; count : word);
  12.   procedure DimPalette( var RGB; col : byte );
  13.  
  14.  
  15. { ... }
  16.   procedure FadeToColor(   var FromPalette : PAL;
  17.                                r, g, b : byte;
  18.                                Steps : byte );
  19.   procedure FadeFromColor( var ToPalette : PAL;
  20.                                r, g, b : byte;
  21.                               Steps : byte );
  22.   procedure WaitVR;
  23. { ... }
  24.  
  25.  
  26. implementation
  27.  
  28. procedure GetPalette( var RGB; from : byte; count : word); external;
  29. procedure SetPalette( var RGB; from : byte; count : word); external;
  30. procedure DimPalette( var RGB; col : byte ); external;
  31. {$L pal.obj}
  32.  
  33.  
  34. procedure RGBPalette; external;
  35. {$L colors.oop}
  36.  
  37. procedure InitColors;
  38. begin
  39.   Move( @RGBPalette^, RGB, sizeof(RGB) );
  40. end;
  41.  
  42.  
  43. { ... }
  44. { // WaitVR : wait for vertical retrace to start // }
  45.  
  46. procedure WaitVR; assembler;    { must preserve cx, and ds:si }
  47. asm
  48.   mov dx, $3da
  49. @1:
  50.   in al, dx
  51.   test al, 8   { wait till out of VR }
  52.   jnz @1
  53. @2:
  54.   in al, dx
  55.   test al, 8   { wait till in VR }
  56.   jz @2
  57. end;
  58.  
  59. { // CrossFade : fade from one palette to another // }
  60.  
  61. procedure CrossFade( var FromPalette, ToPalette : PAL;
  62.                          Steps : byte );
  63. var  Palette : PAL;
  64.      k : word;
  65. begin
  66.   Palette := FromPalette;
  67.   if Steps < 0 then Steps := 0;
  68.   if Steps > 64 then Steps := 64;
  69.   for k := Steps downto 1 do begin
  70.      asm
  71.        les di, ToPalette
  72.        lea si, Palette
  73.        mov bx, K
  74.        mov cx, 3*256
  75.     @1:
  76.        mov al, [es:di]
  77.        mov bh, [ss:si]
  78.        sub al, bh
  79.        cbw
  80.        idiv bl
  81.        add bh, al
  82.        test bh, $c0
  83.        jnz @2
  84.        mov [ss:si], bh
  85.      @2:
  86.        inc di
  87.        inc si
  88.        loop @1
  89.      end;
  90.      WaitVR;
  91.      SetPalette( Palette, 0, 256 );
  92.   end;
  93. end;
  94.  
  95. { // FadeToColor : fade palette to a single color // }
  96.  
  97. procedure FadeToColor( var FromPalette : PAL;
  98.                            r, g, b : byte;
  99.                            Steps : byte );
  100. var  Palette : PAL;
  101.      C : CRGB;
  102.      i : byte;
  103. begin
  104.    C[0] := r;   C[1] := g;   C[2] := b;
  105.    for i := 0 to 255 do Palette[i] := C;
  106.    CrossFade( FromPalette, Palette, Steps );
  107. end;
  108.  
  109. { // FadeFromColor : fade from a single color to palette // }
  110.  
  111. procedure FadeFromColor(var ToPalette : PAL;
  112.                             r, g, b : byte;
  113.                             Steps : byte );
  114. var Palette : PAL;
  115.      C : CRGB;
  116.      i : byte;
  117. begin
  118.    C[0] := r;   C[1] := g;   C[2] := b;
  119.    for i := 0 to 255 do Palette[i] := C;
  120.    CrossFade( Palette, ToPalette, Steps );
  121. end;
  122.  
  123. { ... }
  124.  
  125.  
  126. END.
  127.  
  128.