{
CGA2GIF, written by Jim Leonard (Trixter / Hornet, trixter@oldskool.org)
for the Flopper project.

This program reads saved CGA image files and
displays them, then gives the option of saving the screenshot to disk
as a GIF file.

There are a couple of bugs in here, mainly due to my lack of knowledge
of the hardware.  For example, all attempts to write directly
to the CSR (port 03d9h) have failed on my VGA card, and I can't
tell if it's my code or the card.  And changing the palette in
640x200x2 shouldn't do anything, but it toggles the "white"
between green and cyan.  Anyone got any answers?

What I'm REALLY looking for is a definitive answer as to what
the colors should be in composite mode--I'm edu-guessing here!
If you have CGA composite mode info, email trixter@oldskool.org please!

I'm lazy; this requires a vga card.  I could make it work on lower
cards, but geez, if you've GOT a lower card, you most likely also
have the correct machine to run the games on anyway and don't need
flopper!  And yes, I know this is slow.  Hey, it was a quick hack!
}

Program cga2gif;

uses
  flprvdo,
  flprdisk,
  flprsprt,
  xgif2, {part of xlibp202.zip}
  palettes,
  crt;

const
  {screenmodes}
  mode_lowres=1;
  mode_highres=2;
  mode_composite=3;
  mode_unknown=0;
  curcgamode:byte=mode_unknown;

  curpalette:byte=0;
  curbackground:byte=0;
  picbuf:pointer=nil;
  gsx:word=0;
  optimizedgif:boolean=true;

  filename:string='';

Procedure LoadPic;
var
  idx:^byte;
  foo:byte;
  f:file;
begin
  idx:=picbuf;
  fillchar(picbuf^,16384,0);

  filename:=paramstr(1);
  if filename=''
    then fatalerror('You forgot to specify a filename!  Example: CGA2GIF IMAGE00.GIF');
  if not FileExists(filename)
    then fatalerror(filename+' not found!');
  Assign(f, filename); { Open input file }
  Reset(F, 1);  { Record size = 1 }
  BlockRead(F, picbuf^, 16384);
  Close(F);

  {set appropriate mode based on settings} {settings stored as last byte in dump}
  inc(idx,16384-1);
  {set internal settings}
  if ((idx^ and MCR_highres)=1)
    then curcgamode:=mode_highres
    else curcgamode:=mode_lowres;
  if (curcgamode=mode_highres) and ((idx^ and MCR_blackandwhite)=0)
    then curcgamode:=mode_composite;
  {set mode based on settings}
  case curcgamode of
    mode_lowres:   asm
                     mov  ax,0004h
                     int  10h
                   end;
    mode_highres,
    mode_composite:asm
                     mov  ax,0006h
                     int  10h
                   end;
  end;
  port[MCR]:=idx^;
  updatecsr(curbackground,curpalette);
  {move buffer to screen ram}
  move(picbuf^,ptr(segb800,0)^,16384);
end;

Procedure init2gif;

  procedure PrintWelcome;
  begin
    PrintHeader('cga2gif','Converts Flopper CGA screendumps to .GIF files','0.21',990120);

    writeln;
    writeln('Here are the keys you can use during this session:');
    writeln;
    writeln('Adjustment: (use these if the screen doesn''t look quite right)');
    writeln('  P   Cycle through the different palettes');
    writeln('  B   Cycle through the different background colors');
    writeln;
    writeln('File operations:');
    writeln('  S   Save the screenshot to disk as a GIF file');
    writeln;
    writeln('Hit a key to start.');
  end;

  Procedure PrintHelp;
  begin
    writeln('There are no additional command-line options at this time.');
    halt;
  end;

begin
  {init picbuffer}
  getmem(picbuf,16384);
  fillchar(picbuf^,16384,0);
  if getopt('?')<>#0
    then printhelp;

  PrintWelcome;
  readkey;
  LoadPic;
end;

function lowresNextPixel : integer; far;
{support function for gif saving}
begin
	inc(gsx);
	if gsx> 64000 then
		lowresNextPixel := -1
	else
		lowresNextPixel := mem[sega000:gsx-1];
end;

Procedure SavePic;
{general idea:  fill a 64K buffer of the "translated" picture,
preview on MCGA if desired, then dump that to a .gif file}
var
  translatbuf:pointer;
  idx:^byte;
  x,y:word;
  p:pvgapal;

const
  frq=200;
  dur=50;

begin
  {low-res procedure}
  if curcgamode=mode_lowres then begin

    getmem(translatbuf,64000);
    getmem(p,768);
    idx:=translatbuf;

    blip(frq,dur);

    for y:=0 to 200-1 do begin
      for x:=0 to 320-1 do begin
        idx^:=readpixelbios(x,y);
        writepixelbios(x,y,(y and 3));
        inc(idx);
      end;
    end;

    blip(frq*2,dur);

    asm
      mov  ax,0013h
      int  10h
    end;

    {the tricky part: make the palette match the CGA palette, background too}
    {pal 0 = low rgb}
    {pal 1 = low cmw}
    {pal 2 = low rgb}
    {pal 3 = low cmw}

    case curpalette of
      0:begin
          setrgb( 0, 0, 0, 0);
          setrgb( 1, 0,42, 0);
          setrgb( 2,42, 0, 0);
          setrgb( 3,42,21, 0);
        end;
      1:begin
          setrgb( 0, 0, 0, 0);
          setrgb( 1, 0,42,42);
          setrgb( 2,42, 0,42);
          setrgb( 3,42,42,42);
        end;
      2:begin
          setrgb( 0, 0, 0, 0);
          setrgb( 1,21,63,21);
          setrgb( 2,63,21,21);
          setrgb( 3,63,63,21);
        end;
      3:begin
          setrgb( 0, 0, 0, 0);
          setrgb( 1,21,63,63);
          setrgb( 2,63,21,63);
          setrgb( 3,63,63,63);
        end;
    end;

    case curbackground of
     $0:setrgb( 0, 0, 0, 0);
     $1:setrgb( 0, 0, 0,42);
     $2:setrgb( 0, 0,42, 0);
     $3:setrgb( 0, 0,42,42);
     $4:setrgb( 0,42, 0, 0);
     $5:setrgb( 0,42, 0,42);
     $6:setrgb( 0,42,21, 0);
     $7:setrgb( 0,42,42,42);
     $8:setrgb( 0,21,21,21);
     $9:setrgb( 0,21,21,63);
     $a:setrgb( 0,21,63,21);
     $b:setrgb( 0,21,63,63);
     $c:setrgb( 0,63,21,21);
     $d:setrgb( 0,63,21,63);
     $e:setrgb( 0,63,63,21);
     $f:setrgb( 0,63,63,63);
    end;

    {we'll need this for later}

    getpalette(p);
    move(translatbuf^,ptr(sega000,0)^,64000);

    blip(frq*4,dur);

    {save the screen to a gif here}
    move(p^,gifpalette,768);
    gsx:=0;
    GifInPixelProc := lowresNextPixel;
    {get filename ready:}
    delete(filename,length(filename)-3,4);
    filename:=filename+'.GIF';
  	if optimizedgif
      then savegif(filename,320,200,2,gifpalette)
      else savegif(filename,320,200,8,gifpalette);

    {okay, done, free up stuff}

    freemem(p,768);
    freemem(translatbuf,64000);

    blip(frq*8,dur);

    LoadPic;

    blip(frq*16,dur);
  end;
end;

Procedure do2gif;
const
  done:boolean=false;

  procedure mainloop;
  var
    ch:char;
  begin
    {get input}
    ch:=upcase(readkey);
    {process input}
    case ch of
      'P':begin
            if curcgamode=mode_lowres then begin
              Inc(curpalette); curpalette:=curpalette and 3;
              UpdateCSR(curbackground,curpalette);
            end;
          end;
      'B':begin
            if curcgamode=mode_lowres then begin
              Inc(curbackground); curbackground:=curbackground and 15;
              UpdateCSR(curbackground,curpalette);
            end;
          end;
      'S':begin
            SavePic;
          end;
      #27:done:=true;
    end; {case}
  end;

begin
  repeat
    mainloop;
  until done;
end;

Procedure done2gif;
begin
  freemem(picbuf,16384);
  asm
    mov  ax,0003h
    int  10h
  end;
end;

begin
  Init2gif;
  do2gif;
  done2gif;
end.