home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / SQZTURBO.LBR / CPM.INC < prev    next >
Text File  |  2000-06-30  |  8KB  |  230 lines
  1.  {
  2.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  3.  []                                                                    []
  4.  [] The Squeeze/UnSqueeze CP/M routines.                               []
  5.  []                                                                    []
  6.  []   CP/M files are all multiples of 128 byte records. I/O must be    []
  7.  []   handled with BlockRead and BlockWrite. Files opened for input    []
  8.  []   only do not need to be closed. The file size in bytes (real)     []
  9.  []   must be calculated as (turbo function) FileSize * 128.0          []
  10.  []                                                                    []
  11.  [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
  12.  }
  13.  
  14. Const CommandLineLoc                  = $80;
  15.       DisplayCharacter                = $02;
  16.       PrintCharacter                  = $05;
  17.       SearchForFirst                  = $11;
  18.       SearchForNext                   = $12;
  19.       ReturnLoggedDrive               = $19;
  20.       SetDMA                          = $1A;
  21.  
  22. Type  AFile                           = File;
  23.       FCBType                         = Array[0..31] of Char;
  24.       DMAType                         = Record
  25.                                           Drive: Byte;
  26.                                           FName: Array[1..11] of Char;
  27.                                           Extnt: Byte;
  28.                                           Rsrvd: Array[0..1] of Byte;
  29.                                           RcCnt: Byte;
  30.                                           Block: Array[1..8] of Integer;
  31.                                         end;
  32.  
  33. Var   CommandLine:                      String[127] Absolute CommandLineLoc;
  34.  
  35.       InFile, OutFile:                  AFile;
  36.  
  37.       DMA:                              Array[0..3] of DMAType;
  38.       FCB:                              FCBType;
  39.  
  40.       InBuffer,
  41.       OutBuffer:                        Array[1..128] of Char;
  42.  
  43.       InBuffPointer,
  44.       OutBuffPointer:                   Byte;
  45.  
  46. Procedure GetLoggedDrive;
  47.   begin
  48.     LoggedDrive:=chr(BDOS(ReturnLoggedDrive)+ord('A'));
  49.   end; { Procedure GetLoggedDrive }
  50.  
  51. Procedure FindFiles(FileMask: FileName);
  52.   Var FoundFile:           FileName;
  53.       FCBDone, DoingExt:   Boolean;
  54.       SearchFunction,
  55.       SearchReturn,
  56.       NByte:               Byte;
  57.   begin
  58.     FillChar(FCB,SizeOf(FCB),0);
  59.     For i:=1 to 11 do FCB[i]:=' ';
  60.     FCB[0]:=Chr(Ord(FileMask[1])-Ord('@'));                { eg. A: -> 1 }
  61.     FCBDone:=False; i:=2; NByte:=1; DoingExt:=False;
  62.     While not FCBDone do
  63.       begin
  64.         i:=Succ(i);
  65.         If i > Length(FileMask) then FCBDone:=true
  66.         else
  67.           Case FileMask[i] of
  68.             ^@..' ',
  69.                 '_',
  70.                 ';',
  71.                 ':',
  72.                 '=',
  73.                 '<',
  74.                 '>': FCBDone:=true;
  75.                 '.': If DoingExt then FCBDone:=True
  76.                      else begin DoingExt:=True; NByte:=9; end;
  77.                 '*': If DoingExt then
  78.                        begin
  79.                          FCBDone:=True;
  80.                          While NByte<12 do
  81.                            begin FCB[NByte]:='?'; NByte:=Succ(NByte); end;
  82.                        end
  83.                      else
  84.                        begin
  85.                          While NByte<9 do
  86.                            begin FCB[NByte]:='?'; NByte:=Succ(NByte); end;
  87.                        end;
  88.                 else If (DoingExt and (NByte<12)) or (NByte<9) then
  89.                        begin
  90.                          FCB[NByte]:=FileMask[i]; NByte:=Succ(NByte);
  91.                        end;
  92.           end;   { Case FileMask[i] }
  93.       end;
  94.  
  95.     FFirst:=Nil; FLast:=Nil;
  96.     BDOS(SetDMA,Addr(DMA));
  97.     SearchFunction:=SearchForFirst;
  98.     Repeat { Until SearchReturn>3 }
  99.       SearchReturn:=BDOS(SearchFunction,Addr(FCB));
  100.       If SearchReturn<4 then
  101.         begin
  102.           FoundFile:='';
  103.           For i:=1 to 8 do
  104.             If DMA[SearchReturn].FName[i]<> ' ' then
  105.               FoundFile:=FoundFile+DMA[SearchReturn].FName[i];
  106.           FoundFile:=FoundFile+'.';
  107.           For i:=9 to 11 do
  108.             If DMA[SearchReturn].FName[i]<> ' ' then
  109.               FoundFile:=FoundFile+DMA[SearchReturn].FName[i];
  110.  
  111.           New(FCurrent);
  112.           FCurrent^.FNme:=FoundFile; FCurrent^.NxtF:=Nil;
  113.           If FFirst=Nil then FFirst:=      FCurrent
  114.           else               FLast^.NxtF:= FCurrent;
  115.           FLast:=FCurrent;
  116.  
  117.           SearchFunction:=SearchForNext;
  118.         end;
  119.     Until SearchReturn>3;
  120.     FCurrent:=FFirst;
  121.   end;   { Procedure FindFiles }
  122.  
  123. Function NextFile: FileName;
  124.   begin
  125.     If FCurrent=Nil then NextFile:=''
  126.     else
  127.       begin
  128.         NextFile:=FCurrent^.FNme; FCurrent:=FCurrent^.NxtF;
  129.       end;
  130.   end;   { Function NextFile }
  131.  
  132. Procedure WriteCharToCon(AChar: Char);
  133.   begin
  134.     BDOS(DisplayCharacter,Ord(AChar));
  135.     BDOS(PrintCharacter,  Ord(AChar));
  136.   end;   { Procedure WriteCharToCon }
  137.  
  138. Procedure SetEchoToPrinter;
  139.   begin
  140.     ConOutPtr:=Addr(WriteCharToCon);
  141.   end;   { Procedure SetEchoToPrinter }
  142.  
  143. Function TheSizeOf(Var TheFile: AFile): Real;           { CP/M must calculate }
  144.   begin
  145.     TheSizeOf:=(128.0*FileSize(TheFile));
  146.   end; { Function TheSizeOf }
  147.  
  148. Procedure ResetInFile;                { CP/M: do reset and initialize pointer }
  149.   begin
  150.     Reset(InFile); InBuffPointer:=129;
  151.   end; { Procedure ResetInFile }
  152.  
  153. Procedure ReadInFile(Var C: Char);   { CP/M move char from buffer, read block }
  154.   begin
  155.     If InBuffPointer>128 then
  156.       begin
  157.         BlockRead(InFile,InBuffer,1); InBuffPointer:=1;
  158.       end;
  159.     C:=InBuffer[InBuffPointer];
  160.     InBuffPointer:=succ(InBuffPointer);
  161.   end; { Procedure ReadInFile }
  162.  
  163. Function GetC: Char;                        { CP/M return next char or EOFile }
  164.   var C: Char;
  165.   begin
  166.     If ((InBuffPointer>128) and EOF(InFile)) then EOFile:=true
  167.     else begin ReadInFile(c); crc:=crc+ord(C); end;
  168.     GetC:=C;
  169.   end; { Function GetC }
  170.  
  171. Procedure CloseInFile;                           { CP/M doesn't need to close }
  172.   begin
  173.   end;   { Procedure CloseInFile }
  174.  
  175. Procedure InitializeOutBuffer;                        { Fill Buffer with ^Z's }
  176.   begin
  177.     FillChar(OutBuffer,SizeOf(OutBuffer),26); OutBuffPointer:=1;
  178.   end;   { Procedure InitializeOutBuffer }
  179.  
  180. Procedure ReWriteOutFile;       { CP/M reset drives, do ReWrite, init pointer }
  181.   begin
  182.     BDOS(13); BDOS(14,ord(LoggedDrive)-ord('A'));
  183.     ReWrite(OutFile); InitializeOutBuffer;
  184.   end; { Procedure ReWriteOutFile }
  185.  
  186. Procedure WriteOutFile(Var C: Char);  { CP/M move char to buffer, write block }
  187.   begin
  188.     If OutBuffPointer>128 then
  189.       begin
  190.         BlockWrite(OutFile,OutBuffer,1); InitializeOutBuffer;
  191.       end;
  192.     OutBuffer[OutBuffPointer]:=C;
  193.     OutBuffPointer:=succ(OutBuffPointer);
  194.   end; { Procedure WriteOutFile }
  195.  
  196. Procedure CloseOutFile;                       { CP/M write block before close }
  197.   begin
  198.     If OutBuffPointer>1 then BlockWrite(OutFile,OutBuffer,1);
  199.     Close(OutFile);
  200.   end; { Procedure CloseOutFile }
  201.  
  202. Function GetSizeOfOutFile: Real;                 { CP/M doesn't need to close }
  203.   begin
  204.     Reset(OutFile);
  205.     GetSizeOfOutFile:=TheSizeOf(OutFile);
  206.   end;   { Function GetSizeOfOutFile }
  207.  
  208. Pointer:=1;
  209.   end;   { Procedure InitializeOutBuffer }
  210.  
  211. Procedure ReWriteOutFile;       { CP/M reset drives, do ReWrite, init pointer }
  212.   begin
  213.     BDOS(13); BDOS(14,ord(LoggedDrive)-ord('A'));
  214.     ReWrite(OutFile); InitializeOutBuffer;
  215.   end; { Procedure ReWriteOutFile }
  216.  
  217. Procedure WriteOutFile(Var C: Char);  { CP/M move char to buffer, write block }
  218.   begin
  219.     If OutBuffPointer>128 then
  220.       begin
  221.         BlockWrite(OutFile,OutBuffer,1); InitializeOutBuffer;
  222.       end;
  223.     OutBuffer[OutBuffPointer]:=C;
  224.     OutBuffPointer:=succ(OutBuffPointer);
  225.   end; { Procedure WriteOutFile }
  226.  
  227. Procedure CloseOutFile;                       { CP/M write block before close }
  228.   begin
  229.     If OutBuffPointer>1 then BlockWrite(OutFile,OutBuffer,1);
  230.     Clo