{
 [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
 []                                                                    []
 [] The Squeeze/UnSqueeze CP/M routines.                               []
 []                                                                    []
 []   CP/M files are all multiples of 128 byte records. I/O must be    []
 []   handled with BlockRead and BlockWrite. Files opened for input    []
 []   only do not need to be closed. The file size in bytes (real)     []
 []   must be calculated as (turbo function) FileSize * 128.0          []
 []                                                                    []
 [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
 }

Const CommandLineLoc                  = $80;
      DisplayCharacter                = $02;
      PrintCharacter                  = $05;
      SearchForFirst                  = $11;
      SearchForNext                   = $12;
      ReturnLoggedDrive               = $19;
      SetDMA                          = $1A;

Type  AFile                           = File;
      FCBType                         = Array[0..31] of Char;
      DMAType                         = Record
                                          Drive: Byte;
                                          FName: Array[1..11] of Char;
                                          Extnt: Byte;
                                          Rsrvd: Array[0..1] of Byte;
                                          RcCnt: Byte;
                                          Block: Array[1..8] of Integer;
                                        end;

Var   CommandLine:                      String[127] Absolute CommandLineLoc;

      InFile, OutFile:                  AFile;

      DMA:                              Array[0..3] of DMAType;
      FCB:                              FCBType;

      InBuffer,
      OutBuffer:                        Array[1..128] of Char;

      InBuffPointer,
      OutBuffPointer:                   Byte;

Procedure GetLoggedDrive;
  begin
    LoggedDrive:=chr(BDOS(ReturnLoggedDrive)+ord('A'));
  end; { Procedure GetLoggedDrive }

Procedure FindFiles(FileMask: FileName);
  Var FoundFile:           FileName;
      FCBDone, DoingExt:   Boolean;
      SearchFunction,
      SearchReturn,
      NByte:               Byte;
  begin
    FillChar(FCB,SizeOf(FCB),0);
    For i:=1 to 11 do FCB[i]:=' ';
    FCB[0]:=Chr(Ord(FileMask[1])-Ord('@'));                { eg. A: -> 1 }
    FCBDone:=False; i:=2; NByte:=1; DoingExt:=False;
    While not FCBDone do
      begin
        i:=Succ(i);
        If i > Length(FileMask) then FCBDone:=true
        else
          Case FileMask[i] of
            ^@..' ',
                '_',
                ';',
                ':',
                '=',
                '<',
                '>': FCBDone:=true;
                '.': If DoingExt then FCBDone:=True
                     else begin DoingExt:=True; NByte:=9; end;
                '*': If DoingExt then
                       begin
                         FCBDone:=True;
                         While NByte<12 do
                           begin FCB[NByte]:='?'; NByte:=Succ(NByte); end;
                       end
                     else
                       begin
                         While NByte<9 do
                           begin FCB[NByte]:='?'; NByte:=Succ(NByte); end;
                       end;
                else If (DoingExt and (NByte<12)) or (NByte<9) then
                       begin
                         FCB[NByte]:=FileMask[i]; NByte:=Succ(NByte);
                       end;
          end;   { Case FileMask[i] }
      end;

    FFirst:=Nil; FLast:=Nil;
    BDOS(SetDMA,Addr(DMA));
    SearchFunction:=SearchForFirst;
    Repeat { Until SearchReturn>3 }
      SearchReturn:=BDOS(SearchFunction,Addr(FCB));
      If SearchReturn<4 then
        begin
          FoundFile:='';
          For i:=1 to 8 do
            If DMA[SearchReturn].FName[i]<> ' ' then
              FoundFile:=FoundFile+DMA[SearchReturn].FName[i];
          FoundFile:=FoundFile+'.';
          For i:=9 to 11 do
            If DMA[SearchReturn].FName[i]<> ' ' then
              FoundFile:=FoundFile+DMA[SearchReturn].FName[i];

          New(FCurrent);
          FCurrent^.FNme:=FoundFile; FCurrent^.NxtF:=Nil;
          If FFirst=Nil then FFirst:=      FCurrent
          else               FLast^.NxtF:= FCurrent;
          FLast:=FCurrent;

          SearchFunction:=SearchForNext;
        end;
    Until SearchReturn>3;
    FCurrent:=FFirst;
  end;   { Procedure FindFiles }

Function NextFile: FileName;
  begin
    If FCurrent=Nil then NextFile:=''
    else
      begin
        NextFile:=FCurrent^.FNme; FCurrent:=FCurrent^.NxtF;
      end;
  end;   { Function NextFile }

Procedure WriteCharToCon(AChar: Char);
  begin
    BDOS(DisplayCharacter,Ord(AChar));
    BDOS(PrintCharacter,  Ord(AChar));
  end;   { Procedure WriteCharToCon }

Procedure SetEchoToPrinter;
  begin
    ConOutPtr:=Addr(WriteCharToCon);
  end;   { Procedure SetEchoToPrinter }

Function TheSizeOf(Var TheFile: AFile): Real;           { CP/M must calculate }
  begin
    TheSizeOf:=(128.0*FileSize(TheFile));
  end; { Function TheSizeOf }

Procedure ResetInFile;                { CP/M: do reset and initialize pointer }
  begin
    Reset(InFile); InBuffPointer:=129;
  end; { Procedure ResetInFile }

Procedure ReadInFile(Var C: Char);   { CP/M move char from buffer, read block }
  begin
    If InBuffPointer>128 then
      begin
        BlockRead(InFile,InBuffer,1); InBuffPointer:=1;
      end;
    C:=InBuffer[InBuffPointer];
    InBuffPointer:=succ(InBuffPointer);
  end; { Procedure ReadInFile }

Function GetC: Char;                        { CP/M return next char or EOFile }
  var C: Char;
  begin
    If ((InBuffPointer>128) and EOF(InFile)) then EOFile:=true
    else begin ReadInFile(c); crc:=crc+ord(C); end;
    GetC:=C;
  end; { Function GetC }

Procedure CloseInFile;                           { CP/M doesn't need to close }
  begin
  end;   { Procedure CloseInFile }

Procedure InitializeOutBuffer;                        { Fill Buffer with ^Z's }
  begin
    FillChar(OutBuffer,SizeOf(OutBuffer),26); OutBuffPointer:=1;
  end;   { Procedure InitializeOutBuffer }

Procedure ReWriteOutFile;       { CP/M reset drives, do ReWrite, init pointer }
  begin
    BDOS(13); BDOS(14,ord(LoggedDrive)-ord('A'));
    ReWrite(OutFile); InitializeOutBuffer;
  end; { Procedure ReWriteOutFile }

Procedure WriteOutFile(Var C: Char);  { CP/M move char to buffer, write block }
  begin
    If OutBuffPointer>128 then
      begin
        BlockWrite(OutFile,OutBuffer,1); InitializeOutBuffer;
      end;
    OutBuffer[OutBuffPointer]:=C;
    OutBuffPointer:=succ(OutBuffPointer);
  end; { Procedure WriteOutFile }

Procedure CloseOutFile;                       { CP/M write block before close }
  begin
    If OutBuffPointer>1 then BlockWrite(OutFile,OutBuffer,1);
    Close(OutFile);
  end; { Procedure CloseOutFile }

Function GetSizeOfOutFile: Real;                 { CP/M doesn't need to close }
  begin
    Reset(OutFile);
    GetSizeOfOutFile:=TheSizeOf(OutFile);
  end;   { Function GetSizeOfOutFile }