home *** CD-ROM | disk | FTP | other *** search
/ The Party 1994: Try This At Home / disk_image.bin / source / gallery / subdirs.exe / TEXTURE / PIX2BIN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-21  |  2KB  |  111 lines
  1. {$N+}
  2. uses dos;
  3.  
  4. {$IFOPT N+} type real = single; {$ENDIF}
  5.  
  6. const TexRes = 128;
  7.  
  8. Type
  9.    PIX = array[0..199,0..319] of byte;
  10.    BIN = array[0..TexRes-1,0..TexRes-1] of byte;
  11.    hue = (red, green, blue);
  12.    rgb = array[hue] of byte;
  13.  
  14.    Palette = array[0..255] of rgb;
  15.  
  16.  
  17. { Fits palette taking into account human eye sensitivity: }
  18.  
  19. const
  20.    hueFac : array[hue] of real = (1, 4.59, 0.061);
  21.  
  22.  
  23. var I, O : File;
  24.     N : string;
  25.  
  26.     SrcPal, DestPal : Palette;
  27.  
  28.     Xlate : array[0..255] of byte;
  29.  
  30.     c : byte;
  31.     B : BIN;
  32.     P : ^PIX;
  33.  
  34.     k,j : integer;
  35.  
  36. procedure fitpalette;
  37. var bestcol : byte;
  38.     besterr, err : real;
  39.     i,j : byte;
  40.     h : hue;
  41.     r : rgb;
  42. begin
  43.   for j := 0 to 255 do begin
  44.     write('[',j:3,']',#13);
  45.     r := SrcPal[j];
  46.     bestcol := 0;
  47.     besterr := sqr(64)*3+1;
  48.     for i := 0 to 255 do if ((i mod 16)<>0) or (i=0) then begin
  49.       err := 0;
  50.       for h := red to blue do
  51.         err := err + sqr( integer(r[h])-DestPal[i,h] ){/hueFac[h]};
  52.       if err < besterr then begin
  53.         besterr := err;
  54.         bestcol := i
  55.       end;
  56.     end;
  57.     Xlate[j] := bestcol;
  58.   end;
  59.   writeln('     ');
  60. end;
  61.  
  62.  
  63. begin
  64.   writeln('PIX2BIN converter (for BINOBJ.EXE)  //  A.R-M. 7/93.');
  65.   writeln;
  66.  
  67.   GetMem( P, SizeOf(PIX) );
  68.  
  69.   if ParamCount<>1 then begin
  70.     write ('.PIX file name: '); readln( N );
  71.     writeln;
  72.   end else N := ParamStr(1);
  73.  
  74.   assign(I,N+'.PAL'); reset(I,1);
  75.   blockread( I, SrcPal, SizeOf(SrcPal) );
  76.   close(I);
  77.  
  78.   assign(I,'PIX2BIN.PAL'); reset(I,1);
  79.   blockread( I, DestPal, SizeOf(DestPal) );
  80.   close(I);
  81.  
  82.   writeln('Fitting palette ',N,'.PAL to PIX2BIN.PAL...');
  83.   FitPalette;
  84.  
  85.   assign(I, N+'.PIX'); reset(I,1);
  86.   blockread( I, P^, SizeOf(P^) );
  87.   close(I);
  88.  
  89.   writeln('Scaling image...');
  90.   for j := 0 to TexRes-1 do begin
  91.    write('[',j:3,']',#13);
  92.    for k := 0 to TexRes-1 do begin
  93.      c := P^[ round(k/(TexRes-1)*199), round(j/(TexRes-1)*319) ];
  94.      B[j,k] := Xlate[c];
  95.    end;
  96.   end;
  97.   writeln('     ');
  98.  
  99.   assign( O, N+'.BIN'); rewrite(O,1);
  100.   blockwrite( O, B, SizeOf(B) );
  101.   close(O);
  102.  
  103.   FreeMem( P, SizeOf(P^) );
  104.  
  105.   writeln;
  106.   writeln(N+'.BIN file successfully created from ',N,'.PIX');
  107.  
  108. end.
  109.  
  110.  
  111.