// Rasta Converter 2 MCH v1.2 (20.08.2012 .. 16.11.2012)

// Free Pascal Compiler, http://www.freepascal.org/
// Compile: fpc -Mdelphi -vh -O3 rc2mch.pas

program rc2mch;

uses
  SysUtils;


type
     raster = record
                cod, arg: byte;
               end;


     araster = array [0..27] of raster;

var

 txt: textfile;
 a: string;

 line, px: integer;

 pmg: array [0..$600] of byte;

 tras, traster: array [0..239] of araster;

 tgtia: record
          hposp0, hposp1, hposp2, hposp3: byte;
          hposm0, hposm1, hposm2, hposm3: byte;
          sizep0, sizep1, sizep2, sizep3: byte;
          sizem: byte;
          grafp0, grafp1, grafp2, grafp3: byte;
          grafm: byte;
          colpm0, colpm1, colpm2, colpm3: byte;
          color0, color1, color2, color3: byte;
          colbak: byte;
          gtictl: byte;
          pmcntl: byte;
          regA, regX, regY: byte;
        end;


const

 areg: array [0..31] of record
                              n: string[6];
                              a: integer
                             end =
 (
 (n:'HPOSP0'; a:$D000),
 (n:'HPOSP1'; a:$D001),
 (n:'HPOSP2'; a:$D002),
 (n:'HPOSP3'; a:$D003),

 (n:'HPOSM0'; a:$D004),
 (n:'HPOSM1'; a:$D005),
 (n:'HPOSM2'; a:$D006),
 (n:'HPOSM3'; a:$D007),

 (n:'SIZEP0'; a:$D008),
 (n:'SIZEP1'; a:$D009),
 (n:'SIZEP2'; a:$D00A),
 (n:'SIZEP3'; a:$D00B),
 
 (n:'SIZEM';  a:$D00C),

 (n:'GRAFP0'; a:$D00D),
 (n:'GRAFP1'; a:$D00E),
 (n:'GRAFP2'; a:$D00F),
 (n:'GRAFP3'; a:$D010),
 
 (n:'GRAFM'; a:$D011),

 (n:'COLPM0'; a:$D012),
 (n:'COLPM1'; a:$D013),
 (n:'COLPM2'; a:$D014),
 (n:'COLPM3'; a:$D015),
 
 (n:'COLOR0'; a:$D016),
 (n:'COLOR1'; a:$D017),
 (n:'COLOR2'; a:$D018),
 (n:'COLOR3'; a:$D019),
 
 (n:'COLBAK'; a:$D01A),

 (n:'GTICTL'; a:$D01B),
 (n:'VDELAY'; a:$D01C),
 (n:'PMCNTL'; a:$D01D),
 (n:'HITCLR'; a:$D01E),
 (n:'CONSOL'; a:$D01F)

 );


procedure omin_spacje(var i: integer; var a: string);
begin

 while a[i] in [' ',#9] do inc(i);

end;


function Registry(var a: string): integer;
var i: integer;
begin

 Result:=-1;

 for i := 0 to 31 do
  if areg[i].n=a then begin Result:=areg[i].a-$d000; Break end;


 if Result<0 then begin writeln('Error'); writeln(a); halt end;

end;


procedure SaveReg(r, v: byte);
begin

 case r of
  $00: tgtia.hposp0:=v;
  $01: tgtia.hposp1:=v;
  $02: tgtia.hposp2:=v;
  $03: tgtia.hposp3:=v;

  $04: tgtia.hposm0:=v;
  $05: tgtia.hposm1:=v;
  $06: tgtia.hposm2:=v;
  $07: tgtia.hposm3:=v;

  $08: tgtia.sizep0:=v;
  $09: tgtia.sizep1:=v;
  $0a: tgtia.sizep2:=v;
  $0b: tgtia.sizep3:=v;

  $0c: tgtia.sizem:=v;

  $0d: tgtia.grafp0:=v;
  $0e: tgtia.grafp1:=v;
  $0f: tgtia.grafp2:=v;
  $10: tgtia.grafp3:=v;

  $11: tgtia.grafm:=v;

  $12: tgtia.colpm0:=v;
  $13: tgtia.colpm1:=v;
  $14: tgtia.colpm2:=v;
  $15: tgtia.colpm3:=v;

  $16: tgtia.color0:=v;
  $17: tgtia.color1:=v;
  $18: tgtia.color2:=v;
  $19: tgtia.color3:=v;

  $1a: tgtia.colbak:=v;

  $1b: tgtia.gtictl:=v;
 end;

end;


procedure ReadPMG(a: string);
var i, err: integer;
    txt: string;
begin

 i:=1;

 if a<>'' then begin

  omin_spacje(i,a);

  if a[i]=';' then exit;

  if pos('.ds', a)>1 then begin
   fillchar(pmg[px], 256, 0);

   inc(px, 256);
   exit;
  end;


  if pos('.he', a)>1 then begin
   inc(i, 3);

   while i<=length(a) do begin
    omin_spacje(i,a);

    txt:='$';
    while UpCase(a[i]) in ['0'..'9', 'A'..'F'] do begin txt:=txt+a[i]; inc(i) end;

    val(txt, pmg[px], err);

    inc(px);
   end;

   exit;
  end;



 end;

end;


procedure ReadLine(a: string);
var i, err: integer;
    m, lab: string;
    v: byte;
begin

 i:=1;

 if a<>'' then begin

  omin_spacje(i,a);

  if a[i]=';' then exit;

  if pos('LINE', AnsiUpperCase(a))>0 then begin
   line:=StrToInt(copy(a,5, length(a)));
   px:=0;
   exit; 
  end;


  if line<0 then exit;

  
  m:=AnsiUpperCase(copy(a,i,3));
  inc(i, 3);

  if m='NOP' then begin
   tras[line, px].cod:=0;
   tras[line, px].arg:=2;

   inc(px);
   exit;
  end;


  if (m='LDA') or (m='LDX') or (m='LDY') then begin
   omin_spacje(i,a);

   if a[i]<>'#' then begin writeln('Error ',a[i]); writeln(a); halt end;

   inc(i);

   val(copy(a,i,3), v, err);

   if m='LDA' then begin tras[line, px].cod:=1; tgtia.regA:=v end;
   if m='LDX' then begin tras[line, px].cod:=2; tgtia.regX:=v end;
   if m='LDY' then begin tras[line, px].cod:=3; tgtia.regY:=v end;

   tras[line, px].arg:=v;

   inc(px);
   exit;
  end;


  if (m='STA') or (m='STX') or (m='STY') then begin
   omin_spacje(i,a);

   lab:='';
   while UpCase(a[i]) in ['0'..'9','A'..'Z'] do begin lab:=lab+UpCase(a[i]); inc(i) end;

   v:=Registry(lab);

   if m='STA' then begin tras[line, px].cod:=$81; SaveReg(v, tgtia.regA) end;
   if m='STX' then begin tras[line, px].cod:=$82; SaveReg(v, tgtia.regX) end;
   if m='STY' then begin tras[line, px].cod:=$83; SaveReg(v, tgtia.regY) end;

   tras[line, px].arg:=v;

   inc(px);
   exit;
  end;


  if m='CMP' then begin
   omin_spacje(i,a);

   lab:='';
   while UpCase(a[i]) in ['0'..'9','A'..'Z'] do begin lab:=lab+UpCase(a[i]); inc(i) end;

   if (lab='0') or (lab='BYT2') then begin
    tras[line, px].cod:=0;
    tras[line, px].arg:=3;

    inc(px);
    exit;
   end;

  end;

  writeln(a);

 end;

end;



procedure SaveMCH;
(*----------------------------------------------------------------------------*)
(* SAVE MIC CHAR                                                              *)
(*----------------------------------------------------------------------------*)
var i, j, k, f, p: integer;
    v: byte;
    head: Boolean;

    tab: array [0..$ffff] of byte;

const
    Bajt = 40;

begin

 f:=FileCreate('output.mch');

 fillchar(tab, sizeof(tab), 0);

 p:= FileOpen('output.png.mic', fmOpenRead);
 FileSeek(p, 0, 0);

 FileRead(p, tab, sizeof(tab));

 FileClose(p);


 head:=false;

 for i:=0 to 29 do
  for k:=0 to Bajt-1 do begin

   v:=0;

   if not(head) then begin

    v:=v or 3;   // PGR

    v:=v or (1 shl 2) or (0 shl 4);

    head:=true;
   end;

   FileWrite(f, v, 1);

   for j:=0 to 7 do FileWrite(f,tab[(i*8+j)*Bajt+k],1);

  end;


 fillchar(tab, 240, tgtia.colbak); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.color0); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.color1); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.color2); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.color3); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.colpm0); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.colpm1); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.colpm2); FileWrite(f, tab,240);
 fillchar(tab, 240, tgtia.colpm3); FileWrite(f, tab,240);

 fillchar(tab, sizeof(tab), 0);

 FileWrite(f, tab, 240*8);

 FileWrite(f, tab, 240*2);

 fillchar(tab, $100, tgtia.gtictl);
 FileWrite(f, tab, 240);

 FileWrite(f, pmg[8], $500);


 for j := 0 to 239 do begin
  tab[0] := 0;
  tab[1] := 0;

  FileWrite(f, tab, 2);

  FileWrite(f, traster[j], sizeof(traster[0]));
 end;

 v:=-5+24;

 FileWrite(f, v, 1);

 FileWrite(f, tgtia, sizeof(tgtia));

 FileClose(f);
end;


procedure Syntax;
begin

 writeln('RC2MCH v1.2'#13#10);

 writeln('Files ''output.png.rp'', ''output.png.rp.ini'', ''output.png.pmg'' -> ''OUTPUT.MCH'' ');

 
 halt;
end;



begin

(*----------------------------------------------------------------------------*)

 px:=0;
 line:=-1;

 if not FileExists('output.png.rp') then Syntax;

 assignfile(txt, 'output.png.rp'); reset(txt);

 while not eof(txt) do begin
  readln(txt, a);

  ReadLine(a);

 end;

 closefile(txt);


 for line := 0 to 239 do begin

  px:=27;
  while (tras[line, px].cod=0) and (px>=0) do begin
   tras[line, px].cod:=0;
   tras[line, px].arg:=0;
   dec(px);
  end;

 end;

 move(tras, traster, sizeof(tras));


(*----------------------------------------------------------------------------*)

 px:=0;
 line:=0;

 if not FileExists('output.png.rp.ini') then Syntax;

 assignfile(txt, 'output.png.rp.ini'); reset(txt);

 while not eof(txt) do begin
  readln(txt, a);

  ReadLine(a);

 end;

 closefile(txt);


 tgtia.pmcntl:=2;
 tgtia.gtictl:=$14;

 tgtia.sizep0:=3;
 tgtia.sizep1:=3;
 tgtia.sizep2:=3;
 tgtia.sizep3:=3;

 tgtia.grafm:=$ff;
 tgtia.sizem:=$ff;

 tgtia.hposm0:=$20;
 tgtia.hposm1:=$28;
 tgtia.hposm2:=$d0;
 tgtia.hposm3:=$d8; 

(*----------------------------------------------------------------------------*)

 px:=0;

 if not FileExists('output.png.pmg') then Syntax;

 assignfile(txt, 'output.png.pmg'); reset(txt);

 while not eof(txt) do begin
  readln(txt, a);

  ReadPMG(a);

 end;

 closefile(txt);


 SaveMCH;

end.
