{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
{ This program convert *.BMP (160x200 in 256 colors) from PC
                    to *.GFX for ATARI XL/XE }
USES
  CRT;
TYPE
  GFX_HEADER=RECORD
    NAME:ARRAY[1..3] OF CHAR;
    TRYB:BYTE;
    WIDTH:WORD;
    HIGH:WORD;
    COLOR_0:BYTE;
    COLOR_1:BYTE;
    COLOR_2:BYTE;
    COLOR_3:BYTE;
    COLOR_4:BYTE;
    COLOR_5:BYTE;
    COLOR_6:BYTE;
    COLOR_7:BYTE;
    COLOR_8:BYTE;
END;
VAR
  TAB_COLOR,TAB_NUMBER:ARRAY[1..256] OF WORD;
  GFX:GFX_HEADER;
  FBMP,FGFX:FILE;
  GET_COLOR,GET_COLOR1,GET_COLOR2,GET_COLOR3,GET_COLOR4,COLOR:BYTE;
  TITLE,PALETTE,BITMAP,BUFFOR:POINTER;
  COLORS,I,II,BITPLAN,XX,YY:INTEGER;
  NUMBER_1,NUMBER_2,FIRST,SECOND,WIDTH,HIGH,SIZE:LONGINT;
  RR,GG,BB,RRR,GGG,BBB:BYTE;
  WSP1,WSP2,OBL1,OBL2,OBL3,OBL4:LONGINT;
  WSP:ARRAY[1..4] OF LONGINT;
  CHOOSE:BYTE;
  PIXELS:BYTE;
LABEL
  SKIP;

{ znajduje najbli¾szy podobny kolor }
PROCEDURE TEST(VAR COL:BYTE);BEGIN
  IF COL=TAB_NUMBER[1] THEN BEGIN COL:=0;Exit; END;
  IF COL=TAB_NUMBER[2] THEN BEGIN COL:=1;Exit; END;
  IF COL=TAB_NUMBER[3] THEN BEGIN COL:=2;Exit; END;
  IF COL=TAB_NUMBER[4] THEN BEGIN COL:=3;Exit; END;
  RR:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(TAB_NUMBER[COL]*4)+2];
  GG:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(TAB_NUMBER[COL]*4)+1];
  BB:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(TAB_NUMBER[COL]*4)+0];
  WSP1:=RR+GG*256+BB*65536;
  OBL1:=WSP[1]-WSP1;IF OBL1<0 THEN OBL1:=OBL1*-1;
  OBL2:=WSP[2]-WSP1;IF OBL2<0 THEN OBL2:=OBL2*-1;
  OBL3:=WSP[3]-WSP1;IF OBL3<0 THEN OBL3:=OBL3*-1;
  OBL4:=WSP[4]-WSP1;IF OBL4<0 THEN OBL4:=OBL4*-1;
  IF OBL1<OBL2 THEN BEGIN WSP1:=OBL1;CHOOSE:=1; END ELSE BEGIN WSP1:=OBL2;CHOOSE:=2; END;
  IF WSP1>OBL3 THEN BEGIN WSP1:=OBL3;CHOOSE:=3; END;
  IF WSP1>OBL4 THEN BEGIN WSP1:=OBL4;CHOOSE:=4; END;
  COL:=CHOOSE-1;
END;

BEGIN
 COLOR:=TextAttr;
  IF PARAMCOUNT<>2 THEN BEGIN
    TextColor(LIGHTRED);
    Writeln('BMP_GFX v1.0');
    Writeln('Convert *.BMP file into *.GFX file');
    Writeln('The *.BMP must be 160x200 in 256 colors');
    Writeln;
    TextColor(YELLOW);
    Writeln('Use:  BMP_GFX  file.bmp file.gfx');
    Writeln;
    TextColor(Color);Writeln;
    HALT;
  END;
  ASSIGN(FBMP,PARAMSTR(1));
  {$I-}
  RESET(FBMP,1);
  {$I+}
  IF IORESULT<>0 THEN BEGIN
     TextColor(LIGHTRED);
     Writeln('Error by opening file : ',PARAMSTR(1));
     TextColor(Color);Writeln;
     Halt;
  END;
  ASSIGN(FGFX,PARAMSTR(2));
  {$I-}
  REWRITE(FGFX,1);
  {$I+}
  IF IORESULT<>0 THEN BEGIN
     TextColor(LIGHTRED);
     Writeln('Error by creating file : ',PARAMSTR(2));
     TextColor(Color);Writeln;
     Halt;
  END;

  GetMem(TITLE,54);
  GetMem(PALETTE,1024);
  GetMem(BITMAP,64000);
  GetMem(BUFFOR,16000);
  BlockRead(FBMP,TITLE^,54);
  WIDTH:=MEMW[Seg(TITLE^):Ofs(TITLE^)+18];
  HIGH:=MEMW[Seg(TITLE^):Ofs(TITLE^)+22];
  BITPLAN:=MEM[Seg(TITLE^):Ofs(TITLE^)+28];

  IF BITPLAN<>8 THEN BEGIN
     Erase(FGFX);
     TextColor(LIGHTRED);
     Writeln('File ',PARAMSTR(1),' has not 256 colors.');
     TextColor(Color);Writeln;
     Halt;
  END;

  GFX.NAME:='GFX';GFX.TRYB:=15;GFX.WIDTH:=WIDTH;GFX.HIGH:=HIGH;
  GFX.COLOR_0:=0;GFX.COLOR_1:=18;GFX.COLOR_2:=20;GFX.COLOR_3:=22;
  GFX.COLOR_4:=0;GFX.COLOR_5:=0;GFX.COLOR_6:=0;GFX.COLOR_7:=0;
  GFX.COLOR_8:=0;
  BlockWrite(FGFX,GFX,SizeOf(GFX));
  BlockRead(FBMP,PALETTE^,1024);{Palette}
  BlockRead(FBMP,BITMAP^,WIDTH*HIGH);{Bitmap}
  { Clear TAB_COLOR, Init TAB_NUMBER }
  FOR I:=1 TO 256 DO BEGIN TAB_COLOR[I]:=0;TAB_NUMBER[I]:=I-1; END;
  { Test number of colors }
  FOR I:=0 TO WIDTH*HIGH-1 DO BEGIN
    GET_COLOR:=MEM[Seg(BITMAP^):Ofs(BITMAP^)+I];
    INC(TAB_COLOR[GET_COLOR+1]);
  END;
  { Sorting... TAB_COLOR, TAB_NUMBER }
FOR II:=1 TO 256 DO BEGIN
  FOR I:=1 TO 255 DO BEGIN
    FIRST:=TAB_COLOR[I];
    SECOND:=TAB_COLOR[I+1];
    NUMBER_1:=TAB_NUMBER[I];
    NUMBER_2:=TAB_NUMBER[I+1];
    IF FIRST < SECOND THEN BEGIN
      TAB_COLOR[I]:=SECOND;TAB_COLOR[I+1]:=FIRST;
      TAB_NUMBER[I]:=NUMBER_2;TAB_NUMBER[I+1]:=NUMBER_1;
    END;
  END;
END;

  FOR I:=1 TO 4 DO BEGIN
    II:=TAB_NUMBER[I];
    RRR:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(II*4)+2];
    GGG:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(II*4)+1];
    BBB:=MEM[Seg(PALETTE^):Ofs(PALETTE^)+(II*4)+0];
    WSP2:=RRR+GGG*256+BBB*65536;
    WSP[I]:=WSP2;
  END;
  II:=0;
  SIZE:=0;
FOR YY:=HIGH-1 DOWNTO 0 DO
  FOR XX:=0 TO WIDTH-1 DO BEGIN
    GET_COLOR1:=MEM[Seg(BITMAP^):Ofs(BITMAP^)+YY*WIDTH+XX+0];TEST(GET_COLOR1);
    GET_COLOR2:=MEM[Seg(BITMAP^):Ofs(BITMAP^)+YY*WIDTH+XX+1];TEST(GET_COLOR2);
    GET_COLOR3:=MEM[Seg(BITMAP^):Ofs(BITMAP^)+YY*WIDTH+XX+2];TEST(GET_COLOR3);
    GET_COLOR4:=MEM[Seg(BITMAP^):Ofs(BITMAP^)+YY*WIDTH+XX+3];TEST(GET_COLOR4);
    PIXELS:=((GET_COLOR1 AND 3) SHL 6)+((GET_COLOR2 AND 3) SHL 4)+((GET_COLOR3 AND 3) SHL 2)+((GET_COLOR4 AND 3) SHL 0);
    MEM[Seg(BUFFOR^):Ofs(BUFFOR^)+II]:=PIXELS;INC(II);
    INC(SIZE);IF SIZE>=WIDTH*HIGH THEN GOTO SKIP;
    XX:=XX+3;
END;

SKIP:
  BlockWrite(FGFX,BUFFOR^,(WIDTH*HIGH DIV 4));
  FreeMem(TITLE,54);
  FreeMem(PALETTE,1024);
  FreeMem(BITMAP,64000);
  FreeMem(BUFFOR,16000);
 TextColor(WHITE);Writeln('OK!');
 Close(FBMP);Close(FGFX);
 TextColor(COLOR);Writeln;
END.