Subversion Repositories NedoOS

program mkspr;

{$APPTYPE CONSOLE}

uses
  SysUtils, Graphics;

const
 bmphgt=4096;
 sprhgt=16;
 sprwid=16;
  maxhgt=1024;
  maxwid=1024;

var
 xbase,ybase,sprnr,curaddr,spraddr,sprpg,filenr:integer;
 bshift,bhgt:longword;
 bmp:array[0..bmphgt-1,0..255] of byte;
 tspraddr:array[0..255,0..2] of byte;
 foutbuf:array[0..16384] of byte;
 foutbufpos:integer;
 filename:string;
  dump: array [0..1048575]of byte;
  pic: array [0..(maxhgt-1),0..(maxwid-1)] of byte; //ърЁЄшэър [Y,X]
  pal: array [0..255] of byte;
  zeros: array [0..255] of byte;
  img1,imgresult: TBitMap;
  bmtex, bmbg: TBitMap;
  fin,fout: file of byte;
  frame:integer;
 pg,pgplane,i,j,picdisp,paldisp,addr,hgt,wid,x,y:integer;
 b,br,bg,bb:byte;
 plane:integer;

function atmcol(left,right:byte):byte;
begin //rlrrrlll
 atmcol:=(right and $08)shl 4 +
         (left and $08)shl 3 +
         (right and $07)shl 3 +
         (left and $07);
end;

procedure foutflush;
begin
      //sprites are listed as 0..254(255=exit) and accessed via table as 1..255
      //(inc e:ret z:ld a,(de)...)
      //thus, sprnr+1
  tspraddr[sprnr+1,0]:=spraddr and $ff;
  tspraddr[sprnr+1,1]:=(spraddr and $ff00)shr 8;
  tspraddr[sprnr+1,2]:=sprpg; //pg
  BlockWrite(fout,foutbuf,foutbufpos);
  foutbufpos:=0;
end;

procedure wrbyte(b:byte);
begin
  //BlockWrite(fout,b,1);
  foutbuf[foutbufpos]:=b;
  inc(foutbufpos);
  inc(curaddr);
end;

function sprisempty:boolean;
var
 isempty:boolean;
 x,y:integer;
begin
 isempty:=true;
 x:=xbase;
 while x<(xbase+sprwid) do
 begin
   y:=ybase;
   while y<(ybase+sprhgt) do
   begin
    if (bmp[y,x]<>16) //transparent_color
    then isempty:=false;
    inc(y);
   end;
   inc(x);
 end;
 sprisempty:=isempty;
end;

procedure mksprite(xbase,ybase,sprwid,sprhgt:integer);
var
 x,y:integer;
 mask,pixel:byte;
 curscraddr,oldscraddr,scraddrdelta,oldde:integer;

  function colisempty(col1,col2:byte):boolean;
  begin
   if (col1=16) and (col2=16) //transparent_color
   then colisempty:=true
   else colisempty:=false;
  end;

  function coltopixel(col1,col2:byte):byte;
  begin //transparent_color and $0f = 0!!!
   coltopixel:=(col1 and $08)shl 3 + (col1 and $07) + (col2 and $08)shl 4 + (col2 and $07)shl 3;
  end;

  function coltomask(col1,col2:byte):byte;
  var
   mask:byte;
  begin
   if col1=$10 then mask:=$47 else mask:=0;
   if col2=$10 then mask:=mask or $b8;
   coltomask:=mask;
  end;

begin
  x:=xbase+6;
  oldde:=65536; //false value
  while x>=xbase do //4 layers
  begin //start of the layer
    wrbyte(225); //pop hl
    oldscraddr:=0;
    curscraddr:=0;
    while x<(xbase+sprwid) do //layer columns
    begin
     for y:=ybase to ybase+15 do
     begin
      scraddrdelta:=curscraddr-oldscraddr;
      if not colisempty(bmp[y,x],bmp[y,x+1])
      then begin
        if (scraddrdelta<>0)
        then
          if (scraddrdelta<>40)
          then begin
           if (scraddrdelta<>oldde)
           then begin
             if (oldde<>65536) and ((scraddrdelta and $ff00)=(oldde and $ff00))
             then begin //ld e,N
               wrbyte(30); //ld e,N
               wrbyte(scraddrdelta and $ff);
             end
             else begin //ld de,N
               wrbyte(17); //ld de,N
               wrbyte(scraddrdelta and $ff);
               wrbyte((scraddrdelta and $ff00)shr 8);
             end;
             oldde:=scraddrdelta;
           end;
           wrbyte(25); //add hl,de
          end
          else begin //scraddrdelta=40
           wrbyte(9); //add hl,bc
          end;
        oldscraddr:=curscraddr;
        mask:=coltomask(bmp[y,x],bmp[y,x+1]);
        pixel:=coltopixel(bmp[y,x],bmp[y,x+1]);
        if (mask=0)
        then begin
          if (pixel=0)
          then wrbyte(112) //ld (hl),b
          else begin
            wrbyte(54); //ld (hl),N
            wrbyte(pixel);
          end;
        end
        else begin //mask<>0
          wrbyte(126); //ld a,(hl)
          wrbyte(230); //and N
          wrbyte(mask);
          if (pixel<>0)
          then begin
            wrbyte(246); //or N
            wrbyte(pixel);
          end;
          wrbyte(119); //ld (hl),a
        end;
      end; //nonempty
      curscraddr:=curscraddr+40;
     end; //y
     curscraddr:=curscraddr-(40*sprhgt)+1;
     inc(x,8);
    end; //x in layer
    x:=x-sprwid-2;
  end; //layers
  wrbyte($fd); //$fd
  wrbyte(233); //jp (iy)
end;

begin
  if paramcount<1
  then filename:='pic.bmp'
  else filename:=ParamStr(1);
  AssignFile(fin,filename); //256c 256x256
  Reset(fin);
  if(filesize(fin)=0)then Halt(1);
  writeln('input file=',filename);

  img1:=TBitMap.Create;
  img1.Height:=448;
  img1.Width:=320;
  img1.PixelFormat:=pf24bit;
  //bmtex:=TBitMap.Create;
//  bmtex.Height:=256;
//  bmtex.Width:=256;
  //bmtex.LoadFromFile(fn);
//  bmtex.PixelFormat:=pf24bit;
  //Image2.Picture.Assign(bmtex);

  BlockRead(fin,dump,FileSize(fin));
  CloseFile(fin);

  for i:=0 to 255 do zeros[i]:=0;

  picdisp:=dump[10] + dump[11] shl 8 + dump[12] shl 16 + dump[12] shl 24;
  paldisp:=dump[14] + dump[15] shl 8 + dump[16] shl 16 + dump[17] shl 24 + 14;
  wid:=dump[18] + dump[19] shl 8 + dump[20] shl 16 + dump[21] shl 24;
  hgt:=dump[22] + dump[23] shl 8 + dump[24] shl 16 + dump[25] shl 24;

//get pal
  addr:=paldisp;
  for i:=0 to 255 do begin
   bb:=dump[addr] and $c0;
   bg:=dump[addr+1] and $c0;
   br:=dump[addr+2] and $c0;
   b:=$ff;
   if (bb >= $80) then b:=b-$01;
   if (br >= $80) then b:=b-$02;
   if (bg >= $80) then b:=b-$10;
   if (bb and $40)>0 then b:=b-$20;
   if (br and $40)>0 then b:=b-$40;
   if (bg and $40)>0 then b:=b-$80;
   pal[i]:=b;
   inc(addr,4)
  end;

//4bpp
//get pic [Y,X]
  addr:=picdisp;
  for i:=0 to hgt-1 do begin
   y:=hgt-1-i;
   for j:=0 to (wid div 2)-1 do begin
    x:=j*2;
    pic[y,x]:=dump[addr] shr 4;
    pic[y,x+1]:=dump[addr] and $0f;
    inc(addr);
   end;
  end;

  for pg:=0 to 1 do begin
  AssignFile(fout,IntToStr(pg)+filename+'x');
  Rewrite(fout);
  for pgplane:=0 to 1 do begin
  plane:=pgplane*2+pg;
  for i:=0 to hgt-1 do begin
   for j:=0 to (wid div 8)-1 do begin
    x:=j*8+2*plane{0/2/4/6};
    b:=atmcol(pic[i,x],pic[i,x+1]);
    BlockWrite(fout,b,1);
   end;
  end;
  if pgplane=0
  then begin
   BlockWrite(fout,pal,16);
   BlockWrite(fout,zeros,192-16)
  end //if 0
  else BlockWrite(fout,zeros,192-16);
  end; //pgplane
  CloseFile(fout);
  end; //pg

end.