PROGRAM Generate_transparent_pointers;
USES crt;
type
    mempointer = ^memtype;
    memtype = array[1..65535] of byte;
        transparent_type = ^Transparent_lookup;
     Transparent_lookup = Array[0..250,0..250] of byte;
     palettearray =array[0..768] of byte;



const
 square_size = 20;
 brightness_adjust= 10;
 max_colours= 250;
 pcxfile ='empire.pcx';
 palfile ='empire.pal';

VAR
tp:transparent_lookup;
trndata:transparent_type;
    segmem:word;
   memptr:mempointer;

 index,count,ticks:integer;
 diff:integer;
 counter:word;
{   Colour_pointer:array[0..max_colours,0..max_colours] of byte;}
   pal:palettearray;
   filename:string;
 f:file;
 f2:file of transparent_lookup;
 col1,col2:integer;
 c1r,c1g,c1b:integer;
 c2r,c2g,c2b:integer;
 ir,ig,ib:integer;
 ideal_col:integer;

 nearest_col:integer;
 nerest_total:integer;
 nearest_col_no:integer;
 nr,ng,nb:integer;
 cr,cg,cb:integer;
 temp:integer;
 error:longint;
{***** LOAD PALETTE taken from Kevin A Lee's excellent MCGA256 library *}
function LoadPalette(FileName: string; var Pal: PaletteArray): boolean;
label quit;
var
	f: file;
  	i, NumRead: word;
begin
	assign(f, FileName);
    {$I-} reset(f, 1); {$I+}
    if (IOResult <> 0) then
	begin
    	{ ErrFileNotFound }
		LoadPalette := FALSE;
        exit;
    end;

    {$I-} BlockRead(f, Pal, 768, NumRead); {$I+}
    if (IOResult <> 0) then goto quit;

    for i := 0 to 768 do Pal[i] := Pal[i] DIV 4;

quit:
	close(f);
    LoadPalette := (IOResult = 0);
end; {LoadPalette}
procedure DACRemapColour(index, red, green, blue: byte); assembler;
asm
	{ N.B. no wiat for vertical retrace is done }
				mov 	dx, 3c8h		{ DAC set write mode }
				mov 	al, index
				out 	dx, al			{ set to write mode }
				mov 	dx, 3c9h	    { address of DAC read data }
				mov 	al, red			
	        	out 	dx, al			{ set new red value }
				mov 	al, green
	       		out 	dx, al			{ set new green value }
				mov 	al, blue
	       		out 	dx, al			{ set new blue value }
end; {DACRemapColour}

procedure SetPalette(Pal: PaletteArray);
var	i: word;
begin
    for i := 0 to 255 do
		DACRemapColour(i, Pal[i*3], Pal[i*3+1], Pal[i*3+2]);
end; {SetPalette}

{**************** GET THE COLOURS TOTAL *************************************}
Function Col_total(offset:integer):integer;
VAR
   buffer:integer;
BEGIN
offset:=offset*3;
buffer:=pal[offset];
buffer:=buffer+ pal[offset+1];
buffer:=buffer+ pal[offset+2];
col_total:=buffer;
End;

FunCtion Red_val(offset:integer):byte;
BEGIN
 red_val:=pal[offset*3];
End;

Function green_val(offset:integer):byte;
BEGIN
 green_val:=pal[(offset*3)+1];
End;

Function blue_val(offset:integer):byte;
BEGIN
 blue_val:=pal[(offset*3)+2];
End;

procedure putpixel(d:word;x,y,c:integer);
begin
 mem[d:x+y*320]:=c;
end;
{******************* PRESET COLOUR POINTERS *********************************}
PROCEDURE colour_pointers;
var
ypos:integer;
BEGIN
error:=0;
{Cycle through the first max_colours colours }
{for count := 0 to 199 do mem[$A000:max_colours+(count*320)] := 15;}

For index:=0 to max_colours do
BEGIN
writeln(max_colours-index,' colours to go ');

{line(index,0,index,70,index);}

  ypos:=71;
   For count:=0 to max_colours DO
    BEGIN
{    putpixel($A000,index,ypos,count);}
    inc(ypos);
    if count = index then mem[segmem:index*256+count]:=index;
    if count <> index then
    BEGIN
     c1r:=red_val(index);
     c1g:=green_val(index);
     c1b:=blue_val(index);
     c2r:=red_val(count);
     c2g:=green_val(count);
     c2b:=blue_val(count);
     if (c1r =c2r) and (c1g =c2g) and (c1b =c2b) then
        BEGIN
        col1 := col2;
        mem[segmem:index*256+count]:= count;
        End;


     if (c1r > c2r) then ir := c2r+(c1r-c2r) div 2;
     if (c1r < c2r) then ir := c1r+(c2r-c1r) div 2;


     if (c1g > c2g) then ig := c2g+(c1g-c2g) div 2;
     if (c1g < c2g) then ig := c1g+(c2g-c1g) div 2;

     if (c1b > c2b) then ib := c2b+(c1b-c2b) div 2;
     if (c1b < c2b) then ib := c1b+(c2b-c1b) div 2;
     diff := 32000;
     nearest_col:=index;
     {Find the nearest colour}
     For ticks := 0 to 255 do
      BEGIN


        cr:=red_val(ticks);
        cg:=green_val(ticks);
        cb:=blue_val(ticks);
       temp :=0;
       temp := abs(cr-ir);
       temp := temp + abs(cg-ig);
       temp := temp + abs(cb-ib);
        if temp < diff then
                  BEGIN
                   diff := temp;
                   nearest_col:=ticks;
                  End;
      End;
      error:=error+diff;
     trndata^[count,index]:=nearest_col;
    END;
    end;
End;
End;

BEGIN
   New(memptr);
  segmem:=seg(memptr^);
  new(trndata);

 writeln('Palette File ?');
 readln(filename);
 if not loadpalette(filename,pal) then halt;

 writeln('Save file (*.TRN)');
 readln(filename);
 assign(f2,filename);
 rewrite(f2);


colour_pointers;
counter:=0;
tp:=trndata^;
write(f2,tp);
close(f2);

textmode(co80);
writeln('Error level=',diff);

end.