program vgp2u;
var
        typed :char;
        ptype,itype,slotn,frmat,bit0,bit1,bit2,subpage,page :integer;
        buffer :packed array[0..511] of char;

procedure pagdis (pageno :integer); external;
procedure subpg (oneorzero :integer); external;
procedure format (config :integer); external;
procedure dump (printer_type,iface_type,iface_slot :integer); external;
procedure code_init; external;
function encode (var buffer) :integer; external;
procedure decode (var buffer); external;


        procedure heading;
        begin
                gotoxy(0,0);
                write ('Vgp: G(et S(ave D(ump F(mrt Q(uit [1.1]');
        end;
        
        
        procedure clear_screen;
        begin
                write (chr(12));
                gotoxy (0,0);
        end;
        
        
        procedure quit;
        begin
                clear_screen;
                exit (program);
        end;
        
        
        function yesorno :boolean;
        begin
                repeat
                        read (typed);
                        if typed = 'n' then typed := 'N';
                        if typed = 'y' then typed := 'Y';
                until (typed = 'N') OR (typed = 'Y');
                writeln (' ');
                yesorno := (typed <> 'N');
        end;
        
        
        procedure vgpformat;
        begin
        repeat
                clear_screen;
                writeln ('VGP format:');
                gotoxy (0,2);
                if frmat = 0 then
                begin
                        write ('Use page 1 ? ');
                        page := 0;
                        if yesorno = false then page := 1;
                        write ('Colour ? ');
                        bit2 := 0;
                        if yesorno = true then bit2 := 4;
                        write ('US mode ? ');
                        bit0 := 0;
                        if yesorno = false then bit0 := 1;
                        write ('Interlaced ? ');
                        bit1 := 0;
                        subpage := 0;
                        if yesorno = false then
                        begin
                                bit1 := 2;
                                write ('Sub-page 1 ? ');
                                if yesorno = false then subpage := 1;
                        end;
                        frmat := 1;
                end
                else
                begin
                        format (bit0+bit1+bit2);
                        subpg (subpage);
                        pagdis (page);
                        write ('Page ',page+1,',');
                        if bit2 = 0 then writeln ('monochrome,')
                        else writeln ('colour,');
                        if bit0 = 0 then write ('US,')
                        else write ('UK,');
                        if bit1 <> 0 then write ('non-');
                        write ('interlaced,');
                        if bit1 <> 0 then write ('sub-page ',subpage+1,',');
                        write (' OK ? ');
                        if yesorno = true then exit (vgpformat);
                        frmat := 0;
                end;
        until true = false;
        end;
        
        
        procedure save;
        var
                blocks :integer;
                save_file :file;
                file_name :string;
        
        begin
                clear_screen;
                heading;
                writeln (' ');
                write ('Save as ? ');
                readln (file_name);
                blocks := length (file_name);
                if blocks = 0 then exit (save);
                if (pos ('.pic',file_name) = 0) AND
                   (pos ('.PIC',file_name) = 0) then
                   file_name := concat (file_name,'.PIC');
                (*$I-*)
                reset (save_file,file_name);
                (*$I+*)
                if ioresult = 0 then begin
                        close (save_file);
                        write ('Remove old ',filename,' ? ');
                        if yesorno = false then exit (save);
                end;
                rewrite (save_file,file_name); (* open for write *)
                WRITE ('Saving.');
                code_init;
                blocks := 1;
                while (encode (buffer)<>0) AND (blocks=1) AND (ioresult=0) do
                begin
                        blocks := blockwrite (save_file,buffer,1);
                        write ('.');
                end;
                close (save_file,lock);
                writeln (' ');
                writeln ('VGP screen --> ',file_name);
        end;


        procedure getf;
        var
                blocks :integer;
                get_file :file;
                file_name :string;
        begin
                clear_screen;
                heading;
                writeln (' ');
                write ('Get ? ');
                readln (file_name);
                blocks := length (file_name);
                if blocks = 0 then exit (getf);
                if (pos ('.pic',file_name) = 0) AND
                   (pos ('.PIC',file_name) = 0) then
                file_name := concat (file_name,'.PIC');
                (*$I-*)
                reset (get_file,file_name);
                (*$I+*)
                if ioresult <> 0 then begin
                        writeln ('*** File not found ***');
                        exit (getf);
                end;
                code_init;
                write ('Loading.');
                repeat
                        blocks := blockread (get_file,buffer,1);
                        write ('.');
                        if blocks = 1 then decode (buffer);
                until (eof (get_file)) OR (ioresult<>0) OR (blocks=0);
                close (get_file);
                writeln (' ');
                writeln (file_name,' --> VGP screen');
        end;
        
        
        procedure print;
        begin
                repeat
                        clear_screen;
                        if (ptype >= 0) AND (ptype < 6) then
                        if (itype >= 0) AND (itype < 3) then
                        if (slotn >= 1) AND (slotn < 6) then
                        begin
                                write ('Dump using an ');
                                case ptype of
                                0: write ('MX80 ');
                                1: write ('MX100 ');
                                2: write ('RX80 ');
                                3: write ('RX100 ');
                                4: write ('MX82 ');
                                5: write ('FX80 ');
                                end;
                                writeln ('printer,');
                                write ('via a');
                                case itype of
                                0: write (' Grappler');
                                1: write (' Grappler+');
                                2: write ('n Epson');
                                end;
                                write (' card in slot ',slotn,' OK ?');
                                if yesorno = true then begin
                                        dump (ptype,itype,slotn);
                                        clear_screen;
                                        exit (print);
                                end;
                        end;
                        gotoxy(0,2);
                        writeln ('Printer (0:MX80 1:MX100 2:RX80');
                        write ('         3:RX100 4:MX82 5:FX80) Q(uit ?');
                        read (typed);
                        if (typed = 'q') OR (typed = 'Q') then
                        begin
                                clear_screen;
                                exit (print);
                        end;
                        ptype := ord (typed) - 48;
                        gotoxy (0,4);
                        write ('Card (0:Grappler 1:Grappler+ 2:Epson) ?');
                        read (typed);
                        itype := ord (typed) - 48;
                        gotoxy(0,5);
                        write ('Card slot no. (1 - 5) ?');
                        read (typed);
                        slotn := ord (typed) - 48;
                until true = false;
        end;


begin
        ptype := 2; (* fx80 *)
        itype := 1; (* grappler+ *)
        slotn := 1; (* interface slot no. *)
        frmat := 0;
        vgpformat;
        repeat
                heading;
                read (typed);
                case typed of
                        'g': getf;
                        's': save;
                        'd': print;
                        'f': vgpformay;
                        'q': quit;
                        'G': getf;
                        'S': save;
                        'D': print;
                        'F': vgpformat;
                        'Q': quit;
                end;
        until true = false;
end.