DataMuseum.dk

top - download

    Length: 5504 (0x1580)
    Types: TextFile
    Names: »TCOPY.PAS«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »TCOPY.PAS« 

TextFile

PROGRAM RAWREAD;

TYPE
  BUF=STRINGÆ128Å;
  STR=STRINGÆ10Å;
VAR 
  INITIAL:ARRAY Æ1..50Å OF BYTE;
  SECTBUF:BYTE AT $4000;
  SUM,J,N,ERROR,NUMOFSEC,TRACK,SECTOR:INTEGER;
  COLON,BLKS,LENGH,DPH,DMA:INTEGER;
  FTS,RUNFLG1,RUNFLG2,RUNFLG3:BOOLEAN;
  IOFILE: FILE;
  FILENAME:STR;
  YN,DRIVE:CHAR;
  ADDRPOINT:^INTEGER;
  
æ***************************************************************************å

PROCEDURE SELECT_DISK(VAR DPH:INTEGER;DRIVE:CHAR);
  VAR P:INTEGER;
  BEGIN
    P:=ORD(DRIVE)-65;
    DPH:=BIOS(8,P);  
  END;    

PROCEDURE NO_OF_SEC(VAR NUMOFSEC:INTEGER;DRIVE:CHAR);
  BEGIN
   SELECT_DISK(DPH,DRIVE);
   ADDRPOINT:=PTR(DPH+10);
   ADDRPOINT:=PTR(ADDRPOINT^);
   NUMOFSEC:=ADDRPOINT^;
  END;

PROCEDURE RDSEC(SECTOR,TRACK,DMA:INTEGER);
  BEGIN
    BIOS(9,TRACK);      æSET TRACKå
    BIOS(10,SECTOR);    æSET SECTORå
    BIOS(11,DMA);       æSET DMAADDRESSå                
    BIOS(12);           æREAD SECTORå
    æDATA FROM TRACK,SECTOR NOW TRANSFERRED TO DMAå
  END;

PROCEDURE RENAME;
   BEGIN
    WRITELN;
    FOR N:=1 TO 13 DO
    BEGIN
     INITIALÆNÅ:=INITIALÆNÅ+30;
     WRITE(CHR(INITIALÆNÅ));    
    END;
   WRITELN;
   END;

PROCEDURE WRSEC(SECTOR,TRACK,DMA:INTEGER);
  BEGIN
    BIOS(9,TRACK);      æSET TRACKå
    BIOS(10,SECTOR);    æSET SECTORå
    BIOS(11,DMA);       æSET DMAADDRESSå                
    BIOS(13,1);         æWRITE SECTOR,AS DIR WRITE BC:=0å
    æDATA FROM DMA NOW TRANSFERRED TO TRACK,SECTOR å
  END;

PROCEDURE CLEAR;
  VAR
  N:INTEGER;
  P:REAL;
  BEGIN
   P:=0;
   FOR N:=0 TO 5000 DO
    P:=P*SIN(PI);
   FOR N:=0 TO 36 DO
   WRITELN;
  END;   
   
PROCEDURE LOGIN(VAR DRIVE:CHAR);
  VAR
  P:INTEGER;
  BEGIN
  P:=BDOSB(25);
  P:=P+65;
  DRIVE:=CHR(P);
  END;
æ***************************************************************************å



BEGIN
    SUM:=0;    
    CLEAR;
    WRITELN('This program transfers systemtrack(s) to a file and back ');
    CLEAR;
    WRITE('Source written 850422 in Pascal by Henning Mentz');
   BEGIN 
    CLEAR;
    RUNFLG2:=FALSE;              æTHIS IS FLAG FOR FILE OK IN ALL WAYESå
    REPEAT
     RUNFLG1:=FALSE;             æTHIS IS FLAG FOR FILE ID. FALSE=NO ID. YETå
     WHILE RUNFLG1=FALSE DO
      BEGIN
       LOGIN(DRIVE);
       WRITE('Enter drive and workfile as <drive:filename>......');
       READLN(FILENAME);
       IF FILENAME='&:' THEN RENAME; 
       COLON:=POS(':',FILENAME);
       IF COLON <> 0 THEN
       BEGIN                             
        DRIVE:=FILENAMEÆCOLON-1Å;          
        IF DRIVE IN Æ'A'..'F','a'..'f'Å THEN IF LEN(FILENAME)-COLON<>0 THEN RUNFLG1:=TRUE;
        END
        ELSE IF LEN(FILENAME)<> 0 THEN RUNFLG1:=TRUE;   
       END;
      WRITE('Enter desired worktrack...........................');
      READLN(TRACK);
      IF TRACK < 0  THEN TRACK:=0;
      ASSIGN(IOFILE,FILENAME);
      (*$I-*) RESET(IOFILE) (*$I+*);
      ERROR:=IORES;  
      IF ERROR = 0 THEN RUNFLG2:=TRUE;   
      IF ERROR = 1 THEN   
      BEGIN
       WRITELN(^G'..................................................File is wrong type');
       RUNFLG2:=FALSE;    
      END;     
     IF ERROR = 2 THEN 
     BEGIN
      REWRITE(IOFILE);
      WRITELN('..................................................New workfile created ');
      RUNFLG2:=TRUE;  
     END  
    UNTIL RUNFLG2=TRUE;    
       
   RESET(IOFILE);               æOPEN FILEå     
   LENGH:=LENGTH(IOFILE);
   WRITELN('Filesize in cp/m sectors..........................',LENGH);
   NO_OF_SEC(NUMOFSEC,DRIVE);
   WRITELN('No. of sectors per track on selected drive .......',NUMOFSEC);
   FTS:=TRUE;
     WRITE('Copy sectors from track ',TRACK,' to file (Y/N)...........');
   READLN(YN);
   IF YN IN Æ'N','n'Å THEN FTS:=FALSE;     
   RUNFLG3:=FALSE;
   REPEAT
     WRITE('How man sectors to be copied ?....................');
    READLN(BLKS);
    CASE FTS OF
     FALSE: BEGIN
             IF LENGH < BLKS THEN   
             BEGIN
              WRITELN(^G'..................................................File is not that large ');
              RUNFLG3:=FALSE;        
             END 
             ELSE
             BEGIN           
              WRITELN('Ready for copying file to track ',TRACK,' hit <RET> to procede ');  
              RUNFLG3:=TRUE;
             END    
            END;
     TRUE: BEGIN
            WRITE('Ready for copying track ',TRACK,' to file, hit <RET> to procede ');    
            RUNFLG3:=TRUE;
           END
     END
    UNTIL RUNFLG3=TRUE;  

    READLN(YN);   æAWAIT USER PRESS <RET>å         
    CASE FTS OF
     FALSE:
      IF LENGH <> 0 THEN
      BEGIN               æSTART OF COPY TO TRACK 0 FROM FILEå
       DMA:=$4000;
       SECTOR:=00;
       BLOCKREAD(IOFILE,SECTBUF,BLKS);
       REPEAT
       WRSEC(SECTOR,TRACK,DMA);
       SECTOR:=SECTOR+1;
       DMA:=DMA+128;
       UNTIL SECTOR=BLKS;     
      END; 
     TRUE:                 æSTART OF COPY TO FILE FROM TRACK 0å     
      IF BLKS <> 0 THEN 
      BEGIN
       DMA:=$4000;
       SECTOR:=00;
       REPEAT  
       RDSEC(SECTOR,TRACK,DMA);
       SECTOR:=SECTOR+1;
       DMA:=DMA+128;
       UNTIL SECTOR=BLKS;
       BLOCKWRITE(IOFILE,SECTBUF,BLKS);
            END;
    END;
    WRITELN(^G'............................................Transferred');
    CLOSE(IOFILE);
    END

END.
«eof»