home *** CD-ROM | disk | FTP | other *** search
/ The Equalizer BBS / equalizer-bbs-collection_2004.zip / equalizer-bbs-collection / DEMOSCENE-STUFF / HQ_WATER.ZIP / MAKEPAL.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-15  |  1KB  |  72 lines
  1. {$N+}
  2.  
  3. type
  4.     RGBr = array[0..2] of byte;
  5.  
  6. var T : Text;
  7.     F : File;
  8.     PAL : array[0..255] of RGBr;
  9.     is, os : string;
  10.     gamma : array[0..2] of single;
  11.  
  12.     colptr, nextptr : byte;
  13.     n : RGBr;
  14.  
  15.  
  16. procedure MakePalette( i : byte; c : RGBr );
  17. var
  18.   oc : RGBr;
  19.   dr : array[0..2] of single;
  20.   di, s : single;
  21.   k,j : integer;
  22. begin
  23.   if i=0 then
  24.     PAL[0] := c
  25.   else begin
  26.     oc := PAL[colptr];
  27.     di := i-colptr;
  28.     for j := 0 to 2 do dr[j] := (c[j] - oc[j])/di;
  29.     for k := colptr to i do for j := 0 to 2 do begin
  30.       s := (oc[j] + dr[j]*(k-colptr))/63;
  31.       if s > 0 then s := exp(gamma[j]*ln(s)) else s := 0;
  32.       PAL[k,j] := round( s*63 );
  33.     end;
  34.   end;
  35.   PAL[i] := c;
  36.   colptr := i;
  37. end;
  38.  
  39.  
  40. begin
  41.  
  42.   if ParamCount = 1 then
  43.      is := ParamStr(1)
  44.   else begin
  45.      write('File name (no extension): '); readln(is);
  46.   end;
  47.  
  48.   os := is + '.bin';
  49.   is := is + '.def';
  50.  
  51.  
  52.   assign( T, is ); reset( T );
  53.  
  54.   FillChar( PAL, sizeof(PAL), 0 );
  55.  
  56.   readln( T, gamma[0], gamma[1], gamma[2] );
  57.  
  58.   colptr := 0;
  59.   while not eof(T) do begin
  60.     readln( T, nextptr, n[0], n[1], n[2] );
  61.     MakePalette( nextptr, n );
  62.   end;
  63.  
  64.   close(T);
  65.  
  66.   assign( F, os ); rewrite( F,1 );
  67.   blockwrite( F, PAL, sizeof(PAL) );
  68.   close(F);
  69.  
  70. end.
  71.  
  72.