?login_element?

Subversion Repositories NedoOS

Rev

Blame | Last modification | View Log | Download

  1. program mkspr;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils, Graphics;
  7.  
  8. const
  9.  bmphgt=4096;
  10.  sprhgt=16;
  11.  sprwid=16;
  12.   maxhgt=1024;
  13.   maxwid=1024;
  14.  
  15. var
  16.  xbase,ybase,sprnr,curaddr,spraddr,sprpg,filenr:integer;
  17.  bshift,bhgt:longword;
  18.  bmp:array[0..bmphgt-1,0..255] of byte;
  19.  tspraddr:array[0..255,0..2] of byte;
  20.  foutbuf:array[0..16384] of byte;
  21.  foutbufpos:integer;
  22.  filename:string;
  23.   dump: array [0..1048575]of byte;
  24.   pic: array [0..(maxhgt-1),0..(maxwid-1)] of byte; //ърЁЄшэър [Y,X]
  25.   pal: array [0..255] of byte;
  26.   zeros: array [0..255] of byte;
  27.   img1,imgresult: TBitMap;
  28.   bmtex, bmbg: TBitMap;
  29.   fin,fout: file of byte;
  30.   frame:integer;
  31.  pg,pgplane,i,j,picdisp,paldisp,addr,hgt,wid,x,y:integer;
  32.  b,br,bg,bb:byte;
  33.  plane:integer;
  34.  
  35. function atmcol(left,right:byte):byte;
  36. begin //rlrrrlll
  37.  atmcol:=(right and $08)shl 4 +
  38.          (left and $08)shl 3 +
  39.          (right and $07)shl 3 +
  40.          (left and $07);
  41. end;
  42.  
  43. procedure foutflush;
  44. begin
  45.       //sprites are listed as 0..254(255=exit) and accessed via table as 1..255
  46.       //(inc e:ret z:ld a,(de)...)
  47.       //thus, sprnr+1
  48.   tspraddr[sprnr+1,0]:=spraddr and $ff;
  49.   tspraddr[sprnr+1,1]:=(spraddr and $ff00)shr 8;
  50.   tspraddr[sprnr+1,2]:=sprpg; //pg
  51.   BlockWrite(fout,foutbuf,foutbufpos);
  52.   foutbufpos:=0;
  53. end;
  54.  
  55. procedure wrbyte(b:byte);
  56. begin
  57.   //BlockWrite(fout,b,1);
  58.   foutbuf[foutbufpos]:=b;
  59.   inc(foutbufpos);
  60.   inc(curaddr);
  61. end;
  62.  
  63. function sprisempty:boolean;
  64. var
  65.  isempty:boolean;
  66.  x,y:integer;
  67. begin
  68.  isempty:=true;
  69.  x:=xbase;
  70.  while x<(xbase+sprwid) do
  71.  begin
  72.    y:=ybase;
  73.    while y<(ybase+sprhgt) do
  74.    begin
  75.     if (bmp[y,x]<>16) //transparent_color
  76.     then isempty:=false;
  77.     inc(y);
  78.    end;
  79.    inc(x);
  80.  end;
  81.  sprisempty:=isempty;
  82. end;
  83.  
  84. procedure mksprite(xbase,ybase,sprwid,sprhgt:integer);
  85. var
  86.  x,y:integer;
  87.  mask,pixel:byte;
  88.  curscraddr,oldscraddr,scraddrdelta,oldde:integer;
  89.  
  90.   function colisempty(col1,col2:byte):boolean;
  91.   begin
  92.    if (col1=16) and (col2=16) //transparent_color
  93.    then colisempty:=true
  94.    else colisempty:=false;
  95.   end;
  96.  
  97.   function coltopixel(col1,col2:byte):byte;
  98.   begin //transparent_color and $0f = 0!!!
  99.    coltopixel:=(col1 and $08)shl 3 + (col1 and $07) + (col2 and $08)shl 4 + (col2 and $07)shl 3;
  100.   end;
  101.  
  102.   function coltomask(col1,col2:byte):byte;
  103.   var
  104.    mask:byte;
  105.   begin
  106.    if col1=$10 then mask:=$47 else mask:=0;
  107.    if col2=$10 then mask:=mask or $b8;
  108.    coltomask:=mask;
  109.   end;
  110.  
  111. begin
  112.   x:=xbase+6;
  113.   oldde:=65536; //false value
  114.   while x>=xbase do //4 layers
  115.   begin //start of the layer
  116.     wrbyte(225); //pop hl
  117.     oldscraddr:=0;
  118.     curscraddr:=0;
  119.     while x<(xbase+sprwid) do //layer columns
  120.     begin
  121.      for y:=ybase to ybase+15 do
  122.      begin
  123.       scraddrdelta:=curscraddr-oldscraddr;
  124.       if not colisempty(bmp[y,x],bmp[y,x+1])
  125.       then begin
  126.         if (scraddrdelta<>0)
  127.         then
  128.           if (scraddrdelta<>40)
  129.           then begin
  130.            if (scraddrdelta<>oldde)
  131.            then begin
  132.              if (oldde<>65536) and ((scraddrdelta and $ff00)=(oldde and $ff00))
  133.              then begin //ld e,N
  134.                wrbyte(30); //ld e,N
  135.                wrbyte(scraddrdelta and $ff);
  136.              end
  137.              else begin //ld de,N
  138.                wrbyte(17); //ld de,N
  139.                wrbyte(scraddrdelta and $ff);
  140.                wrbyte((scraddrdelta and $ff00)shr 8);
  141.              end;
  142.              oldde:=scraddrdelta;
  143.            end;
  144.            wrbyte(25); //add hl,de
  145.           end
  146.           else begin //scraddrdelta=40
  147.            wrbyte(9); //add hl,bc
  148.           end;
  149.         oldscraddr:=curscraddr;
  150.         mask:=coltomask(bmp[y,x],bmp[y,x+1]);
  151.         pixel:=coltopixel(bmp[y,x],bmp[y,x+1]);
  152.         if (mask=0)
  153.         then begin
  154.           if (pixel=0)
  155.           then wrbyte(112) //ld (hl),b
  156.           else begin
  157.             wrbyte(54); //ld (hl),N
  158.             wrbyte(pixel);
  159.           end;
  160.         end
  161.         else begin //mask<>0
  162.           wrbyte(126); //ld a,(hl)
  163.           wrbyte(230); //and N
  164.           wrbyte(mask);
  165.           if (pixel<>0)
  166.           then begin
  167.             wrbyte(246); //or N
  168.             wrbyte(pixel);
  169.           end;
  170.           wrbyte(119); //ld (hl),a
  171.         end;
  172.       end; //nonempty
  173.       curscraddr:=curscraddr+40;
  174.      end; //y
  175.      curscraddr:=curscraddr-(40*sprhgt)+1;
  176.      inc(x,8);
  177.     end; //x in layer
  178.     x:=x-sprwid-2;
  179.   end; //layers
  180.   wrbyte($fd); //$fd
  181.   wrbyte(233); //jp (iy)
  182. end;
  183.  
  184. begin
  185.   if paramcount<1
  186.   then filename:='pic.bmp'
  187.   else filename:=ParamStr(1);
  188.   AssignFile(fin,filename); //256c 256x256
  189.   Reset(fin);
  190.   if(filesize(fin)=0)then Halt(1);
  191.   writeln('input file=',filename);
  192.  
  193.   img1:=TBitMap.Create;
  194.   img1.Height:=448;
  195.   img1.Width:=320;
  196.   img1.PixelFormat:=pf24bit;
  197.   //bmtex:=TBitMap.Create;
  198. //  bmtex.Height:=256;
  199. //  bmtex.Width:=256;
  200.   //bmtex.LoadFromFile(fn);
  201. //  bmtex.PixelFormat:=pf24bit;
  202.   //Image2.Picture.Assign(bmtex);
  203.  
  204.   BlockRead(fin,dump,FileSize(fin));
  205.   CloseFile(fin);
  206.  
  207.   for i:=0 to 255 do zeros[i]:=0;
  208.  
  209.   picdisp:=dump[10] + dump[11] shl 8 + dump[12] shl 16 + dump[12] shl 24;
  210.   paldisp:=dump[14] + dump[15] shl 8 + dump[16] shl 16 + dump[17] shl 24 + 14;
  211.   wid:=dump[18] + dump[19] shl 8 + dump[20] shl 16 + dump[21] shl 24;
  212.   hgt:=dump[22] + dump[23] shl 8 + dump[24] shl 16 + dump[25] shl 24;
  213.  
  214. //get pal
  215.   addr:=paldisp;
  216.   for i:=0 to 255 do begin
  217.    bb:=dump[addr] and $c0;
  218.    bg:=dump[addr+1] and $c0;
  219.    br:=dump[addr+2] and $c0;
  220.    b:=$ff;
  221.    if (bb >= $80) then b:=b-$01;
  222.    if (br >= $80) then b:=b-$02;
  223.    if (bg >= $80) then b:=b-$10;
  224.    if (bb and $40)>0 then b:=b-$20;
  225.    if (br and $40)>0 then b:=b-$40;
  226.    if (bg and $40)>0 then b:=b-$80;
  227.    pal[i]:=b;
  228.    inc(addr,4)
  229.   end;
  230.  
  231. //4bpp
  232. //get pic [Y,X]
  233.   addr:=picdisp;
  234.   for i:=0 to hgt-1 do begin
  235.    y:=hgt-1-i;
  236.    for j:=0 to (wid div 2)-1 do begin
  237.     x:=j*2;
  238.     pic[y,x]:=dump[addr] shr 4;
  239.     pic[y,x+1]:=dump[addr] and $0f;
  240.     inc(addr);
  241.    end;
  242.   end;
  243.  
  244.   for pg:=0 to 1 do begin
  245.   AssignFile(fout,IntToStr(pg)+filename+'x');
  246.   Rewrite(fout);
  247.   for pgplane:=0 to 1 do begin
  248.   plane:=pgplane*2+pg;
  249.   for i:=0 to hgt-1 do begin
  250.    for j:=0 to (wid div 8)-1 do begin
  251.     x:=j*8+2*plane{0/2/4/6};
  252.     b:=atmcol(pic[i,x],pic[i,x+1]);
  253.     BlockWrite(fout,b,1);
  254.    end;
  255.   end;
  256.   if pgplane=0
  257.   then begin
  258.    BlockWrite(fout,pal,16);
  259.    BlockWrite(fout,zeros,192-16)
  260.   end //if 0
  261.   else BlockWrite(fout,zeros,192-16);
  262.   end; //pgplane
  263.   CloseFile(fout);
  264.   end; //pg
  265.  
  266. end.
  267.