{$A+,B-,D+,E-,F-,I+,L+,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
program TextGraf;
Uses Dos,       { Turbo Pascal DOS Unit    }
     Crt,       { Turbo Pascal CRT Unit    }
     Tplus,     { Turbo Plus TPlus Unit    }
     TpWindow,  { Turbo Plus TpWindow Unit }
     TpGraph,   { Turbo Plus TpGraph Unit  }
     NSamp20A;  { Window/Screens Unit      }
const
  XGraph : array[4..19] of integer = (320,320,640,-1,160,320,640,-1,
                                      -1,320,640,640,640,640,640,320);
  YGraph : array[4..19] of integer = (200,200,200,-1,200,200,200,-1,
                                      -1,200,200,350,350,480,480,200);

type
    ErrorsType = array[1..25] of string[12]; { Array of bad files }
    String3 = String[3];

var
   Prev_Mode : byte; { Last Graphics Mode }
   ErrorsCnt : Byte;
   ErrorsFile : ErrorsType;
   I : Integer;
   SaveAttr : String1;           { File Save Type }
   GMaxX,GMaxY : integer;

procedure Setmode(mode:byte); { Set a graphics mode }

VAR Regs : REGISTERS;

BEGIN
   WITH Regs DO
      BEGIN
         Ah := $00;
         al := mode;
         INTR ($10, Regs);
      END;
END;

procedure Getmode(var mode:byte); { Get the last display mode }

VAR Regs : REGISTERS;

BEGIN
   WITH Regs DO
      BEGIN
         Ah := $0f; {set mode}
         al := 0;
         bx := 0;
         cx := 0;
         dx := 0;
         INTR ($10, Regs);
         mode:=al;
      END;
END;

procedure ConvertFile(Path : PathStr); { Convert SG to PCC }
const
     BufferSize = 8192; { Buffer Size for PCC compression buffer }
var
   Window : WindowPointer;
   sX1,sY1,eX2,eY2 : integer;
   Buffer : array[1..BufferSize] of byte;
   Filename : NameStr;
   Ext : ExtStr;
   Dir : DirStr;
begin
  FSplit(Path,Dir,Filename,Ext);  { Split into name,ext,dir }
  LoadWindow(Path,Window);        { Load a SG window in to pointer Window }
  If SaveAttr='P' then
  begin
     GraphCoord(sX1,sY1,eX2,eY2,Window);  { Get Coor. for window in graphics }
     Path := Dir+Filename+'.PCC';    { Name of PCC file }
  end
  else begin
         sX1 := 0; sY1 := 0;
         eX2 := GMaxX; eY2 := GMaxY;
         Path := Dir+Filename+'.PCX';    { Name of PCX file }
       end;
  GraphShowWindow(Normal,Window); { Show SG window in graphics }
  WritePcc(Path,sX1,sY1,eX2,eY2,@Buffer,BufferSize); { Save in PCX format }
  If PCCResult <> PCCOk then { Check if successful }
  begin
    FreeWindow(Window); { Free the window pointer }
    Inc(ErrorsCnt);
    ErrorsFile[ErrorsCnt] := FileOnly(Filename);
  end;
  FreeWindow(Window); { Free the window pointer }
end;

procedure Init(Gm : String3); { Initialize Graphics }
begin
  GetMode(Prev_Mode);
  Case Gm[1] of
       'C': begin
              SetMode($06); { CGA 640 x 200, 02-color }
              GMaxX := XGraph[$06]-1;
              GMaxY := YGraph[$06]-1;
            end;
       'E': begin
              SetMode($10); { EGA 640 x 350, 16-color }
              GMaxX := XGraph[$10]-1;
              GMaxY := YGraph[$10]-1;
            end;
       'V': begin
              SetMode($12); { VGA 640 x 480, 16-color }
              GMaxX := XGraph[$12]-1;
              GMaxY := YGraph[$12]-1;
            end;
  End;

end;

procedure Help(i : byte); { Help windows }
begin
  case i of
       1:PushShowWindow(Normal,Screen(4));
       2:PushShowWindow(Normal,Screen(5));
       3:PushShowWindow(Normal,Screen(6));
  end;
  Repeat
  Until KeyStruck;
  PopWindow(Normal);
end;

procedure ShowErrors; { Show bad files }
var
   ErrorWindow : WindowPointer;
   I : integer;
begin
  ErrorWindow := Screen(7);
  PushShowWindow(Normal,ErrorWindow);
  TieWindow(1,ErrorWindow);
  For I := 1 to ErrorsCnt do
      FastString(LeftJustify(14,ErrorsFile[I]),3);
  PauseKb;
  UnTieWindow(ErrorWindow);
  PopWindow(Normal);
end;

procedure SelectFiles; { Select files to convert and converts them }
const
     Fg = White;
     Bg = Blue;
     Afg = Yellow;
     Abg = Black;
     Bfg = Fg;
     Bbg = Bg;
var
   FileMask : String65;          { Filename or Wild cards }
   
   GraphicsMode : String[3];     { Graphics adapter }
   RetCode,                      { Return Code for Map functions }
   I : integer;                  { Counter for AutoDir Tags }
   Flag : Boolean;               { Boolean Flag }
   Cur_Mode : byte;              { Current Mode }

{ The following procedure was created with Screen Genie's program generation
  option.  Some of this procedure has been modified for this example. }

   Procedure ScanMapper(X1,Y1,X2,Y2 : integer); { Procedure to use ScanMap }
   var
     Buf : array[1..255] of longint; { Buffer for Scan map data }
     CurPos,                         { Cursor Position }
     item,                           { Field or Map function to use }
     x,y : integer;                  { x,y coord. for map function }
     MapOp : Char;                   { Map Option (R,W) }
     Scan : Byte;
     Ascii : String1;
   Begin
     MapOp := 'W';
     CurPos := 1;
     item := 1;
   { Make sure to display your input screen before
                                            calling ScanMap w/ option 'I' }
     CursorOff;
     ScanMap(X1,Y1,X2,Y2,'I',x,y,item,'{',RetCode,Buf); { Initialize ScanMap }
     CursorOn;
     Repeat
        ScanMap(X1,Y1,X2,Y2,'R',x,y,item,'{',RetCode,Buf); { Use ScanMap }
        Case item Of
           1:  MapString(MapOp,x,y,0,0,0,0,0,RetCode,CurPos,FileMask,
                 '>>>>>>>>>>>>>>>>>>>>');
           2:  if MapOp ='W' then
                  MapString(MapOp,x,y,0,0,0,0,0,RetCode,CurPos,SaveAttr,
                           '>')
               else begin
                 MoveCursor(x,y);
                 ReadKB(Scan,Ascii); Ascii[1] := UpCase(Ascii[1]);
                 Case Ascii[1] of
                      'F','f': SaveAttr := 'F';
                      'P','p': SaveAttr := 'P';
                 end;
                 FastString(SaveAttr,3);
                 RetCode := Scan;
               end;
           3:  if MapOp = 'W' then
                  MapString(MapOp,x,y,0,0,0,0,0,RetCode,CurPos,GraphicsMode,
                           '>>>')
               else begin
                 MoveCursor(x,y);
                 ReadKB(Scan,Ascii); Ascii[1] := UpCase(Ascii[1]);
                 Case Ascii[1] of
                      'C','c': GraphicsMode := 'CGA';
                      'E','e': GraphicsMode := 'EGA';
                      'V','v': GraphicsMode := 'VGA';
                 end;
                 FastString(GraphicsMode,3);
                 RetCode := Scan;
               end;
        End; { Case }
        if MapOp = 'W' then
        begin
           Inc(item);
           if item = 4 then
           begin
             item := 1;
             MapOp := 'R';
           end;
        end;
        Case RetCode of
                EnterKey: RetCode := ArrowDnKey;
                F1Key : Help(item);
        End; { End of Case }

     Until (RetCode = EscKey) or ((RetCode = F2Key) and (SaveAttr[1] in ['F','P']) and
           ((GraphicsMode = 'CGA') or (GraphicsMode = 'EGA') or
           (GraphicsMode = 'VGA'))); { Exit Keys }
   End; { End Procedure }

begin
  ErrorsCnt := 0;
  SaveAttr := 'F';

  if Active_Video = 1 then
     GraphicsMode := 'CGA'
  else if Active_Video = 5 then
          GraphicsMode := 'EGA'
       else if Active_Video = 6 then
               GraphicsMode := 'VGA'
            else begin
                   Writeln('You must have a CGA, EGA or VGA adapter to Run this program');
                   Halt(1);
                 end;
  Repeat
     ScreenOff;
     ClearScn;
     MoveCursor(1,1);
     ChangeBAtt(2000,Red);
     ScreenOn;
     Repeat
        FileMask := '*.win';
        ShowWindow(Normal,Screen(1)); { Must show before ScanMapper }
        If ErrorsCnt > 0 then
           ShowErrors;
        ScanMapper(2,5,49,9);         { Scan Mapping }
        If RetCode <> EscKey then     { Check if ESC has been pressed }
        begin
          AutoDirTagFlag := True;
          PushShowWindow(Normal,Screen(2));
          PushShowWindow(Normal,Screen(3));
          AutoDir(DoubleLine,55,5,Fg,Bg,Afg,Abg,Bfg,Bbg,1,10,False,FileMask);
          PopWindow(Normal);
          PopWindow(Normal);
          Flag := True;
          If FileMask <> '' Then { Convert all files }
          Begin
            Init(GraphicsMode); { Graphics }
            If AutoDirTagPtr = NIL Then
               ConvertFile(FileMask)
            else begin
                   I := 0;
                   While AutoDirTagPtr^.Entry[I].Tag Do
                   Begin
                     ConvertFile(PathOnly(FileMask)+AutoDirTagPtr^.Entry[I].FileName);
                     Inc(I);
                     If SaveAttr = 'F' then
                     begin
                       GetMode(Cur_Mode);
                       SetMode(Cur_Mode);
                     end;
                   End;
                   TpFreeMem(Pointer( AutoDirTagPtr ), AutoDirTagPtrSize ); { Free AutoDirTagPtr }
                 end;
            SetMode(Prev_Mode);
          End else Flag := False;
        end else Flag := True;
     Until Flag;
  Until RetCode = EscKey;
end;

begin
  System_Resources;
  ScreenType(SType);
  If SType = 'M' then
  begin
    Writeln('Not a CGA, EGA, or VGA display adapter');
    Writeln('Monochrome not supported.');
    Halt(1);
  end else if ParamCount > 0 then
              if (ParamStr(1) = '-M') or (ParamStr(1) = '-m') then
                 for I := 1 to 7 do
                     MonoMap(Screen(I));
  SelectFiles;
  ClearScn;
end.