program stadconv;

uses dos, gemaes, bios;

{$L fromstad}
{$L tostad}
{$M 32,32,120,32}

var buffer_32k  : array [1..32000] of byte;
    buffer_stad : array [1..32507] of byte;
    outlength   : integer;
    path        : string;
    filename    : string;
    cstring     : string;
    button      : integer;
    picture     : file;
    screenadr   : pointer;
    

function fromstad(buffer_32k  : pointer;
                  buffer_stad : pointer):integer;
  external;
  
function tostad(buffer_stad : pointer;
                buffer_32k  : pointer): integer;
  external;
  

begin
    clrscr;
    writeln('If you select a compressed STAD-picture *.PAC the filename will be loaded,');
    writeln('uncompressed an saved as an unpacked 32k-picture *.PIC (screenformat)...');
    writeln('(and vice versa)');
    
    path := 'C:\*.P?C'#00;
    filename := ''#00;
    fsel_input( path[1], filename[1], button);
    if button=1 then begin
        path[0] := #255;                  {from original help-text!}
        path[0] := Chr(Pos(#00, path)-1);
        while path[length(path)] <> '\' do
            delete(path, Length(path), 1);
        filename[0] := #255;
        filename[0] := Chr(Pos(#00, filename)-1);
        filename    := path + filename;
        if (copy(filename, length(filename)-3, 4)) = '.PAC' then begin
            assign(picture, filename);
            reset(picture);
            blockread(picture, buffer_stad, 32000);
            close(picture);
            if (fromstad(addr(buffer_32k), addr(buffer_stad)) <> 0) then begin
                writeln('Error: this is not a packed STAD-picture');
                halt(1);
            end;
            screenadr:=PhysBase;
            move(buffer_32k, screenadr^, 32000);
            filename[length(filename)-1] := 'I';
            assign(picture, filename);
            {$I-} reset(picture); {$I+}
            if (ioresult = 0) then begin
                close(picture);
                cstring:='[2][ Output-filename | already exists...][ Write | Cancel ]'#00;
                if (form_alert(2, cstring[1]) = 2) then
                    halt(2);
            end;
            {$I-} rewrite(picture); {$I+}
            if (ioresult <> 0) then begin
                writeln('Error: cannot open output-filename...');
                halt(-36);
            end;
            blockwrite(picture, buffer_32k, 32000);
            close(picture);
        end
        else if (copy(filename, length(filename)-3, 4)) = '.PIC' then begin
            reset(picture, filename);
            blockread(picture, buffer_32k, 32000);
            close(picture);
            screenadr:=PhysBase;
            move(buffer_32k, screenadr^, 32000);
            outlength:=tostad(addr(buffer_stad), addr(buffer_32k));
            filename[length(filename)-1] := 'A';
            assign(picture, filename);
            {$I-} reset(picture); {$I+}
            if (ioresult = 0) then begin
                close(picture);
                cstring:='[2][ Output-filename | already exists...][ Write | Cancel ]'#00;
                if (form_alert(2, cstring[1]) = 2) then
                    halt(2);
            end;
            {$I-} rewrite(picture); {$I+}
            if (ioresult <> 0) then begin
                writeln('Error: cannot open output-filename...');
                halt(-36);
            end;
            blockwrite(picture, buffer_stad, outlength);
            close(picture);
        end;
    end;
end.