(* 1---Module 02---1 *)

  PROCEDURE box(x1, y1, x2, y2 : integer);

    VAR
      i              : integer;

    BEGIN (* box *)
    gotoxy(x1, y1);
    FOR i := x1 TO x2 DO write('*');
    FOR i := y1 TO y2 DO BEGIN
      gotoxy(x2, i); write('*'); END;
    gotoxy(x1, y2);
    FOR i := x2 DOWNTO x1 DO write('*');
    FOR i := y2 DOWNTO y1 DO BEGIN
      gotoxy(x1, i); write('*'); END;
    END; (* box *)

  (* 1---------------1 *)

  FUNCTION mainselection : char;

    VAR
      ch             : char;

    BEGIN (* mainselection *)
    clrscr; box(13, 5, 60, 22);
    writeln('* TRANSFER - vers ', vers: 0: 1, ' ');
    gotoxy(menumargin, 8);
    write('CP/M= ' : 9, chr(cpm_drive+ord('A')), ':');
    write('MS-DOS= ' : 21, chr(ms_dos_drive+ord('A')), ':');

    gotoxy(menumargin, 10); write('1. Transfer File:  CP/M ==> MS-DOS');
    gotoxy(menumargin, 11); write('2. Transfer File:  MS-DOS ==> CP/M');
    gotoxy(menumargin, 12); write('3. Directory of      MS-DOS Disk');
    gotoxy(menumargin, 13); write('4. Allocation Map    MS-DOS Disk');
    gotoxy(menumargin, 14); write('5. Directory of      CP/M Disk');
    gotoxy(menumargin, 15); write('6. Erase File        MS-DOS Disk');
    gotoxy(menumargin, 16); write('7. Restore FAT');
    gotoxy(menumargin, 17); write('8. Quit');

    REPEAT
      gotoxy(menumargin, 19);
      write('   Enter Your Selection? ');
      read(kbd, ch);
    UNTIL (ch IN ['1'..'9']);
    mainselection := ch;
    END; (* mainselection *)

  (* 1---------------1 *)

  PROCEDURE continue;

    BEGIN (* continue *)
    write('Press [Return] to Continue..');
    REPEAT
      read(kbd, selection);
    UNTIL (selection = cr);
    END; (* continue *)

  (* 1---------------1 *)

  PROCEDURE pause;

    VAR
      ch   : char;

    BEGIN (* pause *)
    write('[More]'); read(kbd, ch);
    write(cr, '      ', cr);
    END; (* pause *)

  (* 1---------------1 *)

  FUNCTION break : boolean;

    VAR
      ch             : char;

    BEGIN (* break *)
    IF keypressed THEN BEGIN
      read(kbd, ch);
      IF (ch = dc3) THEN BEGIN
        WHILE NOT keypressed DO (* wait *);
        read(kbd, ch); END;
      break := (ch = esc); END
    ELSE break := false;
    END; (* break *)

  (* 1---------------1 *)

  PROCEDURE nextsector(VAR s : integer; VAR t : integer);

    BEGIN (* nextsector *)
    s := succ(s);
    IF (s >= nsectors) THEN BEGIN
      s := minsector; t := succ(t); END;
    END; (* nextsector *)

  (* 1---------------1 *)

  PROCEDURE diskerror;

    BEGIN (* diskerror *)
    writeln; write('Disk I/O Error, '); continue;
    END; (* diskerror *)

  (* 1---------------1 *)

  PROCEDURE biosselect(drivecode : integer);

    BEGIN (* biosselect *)
    bioserror := (bioshl(8, drivecode) = 0);
    END; (* biosselect *)

  (* 1---------------1 *)

  PROCEDURE readsector(sector, track, address : integer);
  (* cannot use sector translation, bioshl does not pass de reg *)

    VAR
      rps            : integer;
      i              : integer;

    BEGIN (* readsector *)
    IF singlesided THEN track := track * 2;
    rps := sectorsize DIV 128;
    biosselect(ms_dos_drive); bioserror := false;
    FOR i := 0 TO pred(rps) DO BEGIN
      bios(9, track);                              (* select track   *)
      bios(10, sector * rps + i + so);             (* select sector  *)
      bios(11, (i * 128) + address);               (* set dma addr   *)
      bioserror := (bioserror OR (bios(12) <> 0)); (* read 128 bytes *)
      END;
    bios(8, defaultdisk);
    IF bioserror THEN diskerror;
    END; (* readsector *)

  (* 1---------------1 *)

  PROCEDURE writesector(sector, track, address : integer;
                        immediate : boolean);
  (* cannot use sector translation, bioshl does not pass de reg *)
  (* immediate causes bios system to flush buffers after write. *)
  (* Essential when file is closed.  The directory wrt suffices *)

    LABEL 10;  (* stop further fouling on write error *)

    VAR
      rps            : integer;
      i              : integer;

    BEGIN (* writesector *)
    IF singlesided THEN track := track * 2;
    rps := sectorsize DIV 128;
    biosselect(ms_dos_drive);
    FOR i := 0 TO pred(rps) DO BEGIN
      bios(9, track);                               (* select track  *)
      bios(10, sector * rps + i + so);              (* select sector *)
      bios(11, (i * 128) + address);                (* set dma addr  *)
      bioserror := (bios(13, ord(immediate)) <> 0); (* wrt 128 bytes *)
      IF bioserror THEN GOTO 10; END;
10: bios(8, defaultdisk);
    IF bioserror THEN diskerror;
    END; (* writesector *)

  (* 1---------------1 *)

  PROCEDURE getfat;

    BEGIN (* getfat *)
    readsector(firstfatsector, 0, addr(fat));
    readsector(succ(firstfatsector), 0, addr(fat) + sectorsize);
    END; (* getfat *)

  (* 1---------------1 *)

  PROCEDURE putfat;

    VAR
      s, t, i        : integer;

    BEGIN (* putfat *)
    s := firstfatsector; t := 0;
    FOR i := 0 TO pred(fatsize) DO BEGIN
      writesector(s, t, addr(fat) + (sectorsize * i), true);
      nextsector(s, t); END;
    END; (* putfat *)

  (* 1---------------1 *)

  PROCEDURE readcluster(cl : integer);

    VAR
      i              : integer;
      sector         : integer;
      track          : integer;

    BEGIN (* readcluster *)
    cl := cl - 2;
    track := (cl * secspercluster) DIV nsectors;
    sector := (cl * secspercluster) MOD nsectors;
    sector := sector + firstdatasector;
    track := track + firstdatatrack + (sector DIV nsectors);
    sector := sector MOD nsectors;
    FOR i := 0 TO pred(secspercluster) DO BEGIN
      readsector(sector, track,
                 addr(clusterbuffer[succ(i * sectorsize)]));
      nextsector(sector, track); END;
    END; (* readcluster *)

  (* 1---------------1 *)

  PROCEDURE writecluster(cl : integer);
  (* assumes file closing will force buffer flush *)

    VAR
      i              : integer;
      sector         : integer;
      track          : integer;

    BEGIN (* writecluster *)
    cl := cl - 2;
    track := (cl * secspercluster) DIV nsectors;
    sector := (cl * secspercluster) MOD nsectors;
    sector := sector + firstdatasector;
    track := track + firstdatatrack + (sector DIV nsectors);
    sector := sector MOD nsectors;
    FOR i := 0 TO pred(secspercluster) DO BEGIN
      writesector(sector, track,
                  addr(clusterbuffer[succ(i * sectorsize)]), false);
      nextsector(sector, track); END;
    END; (* writecluster *)

  (* 1---------------1 *)

  FUNCTION fatpointer(index : integer) : integer; (* 2..NClusters + 2 *)

    VAR
      result, i      : integer;
      oddnum         : boolean;

    BEGIN (* fatpointer *)
    i := succ((index * 3) DIV 2);
    result := (fat[i] + (256 * fat[succ(i)]));
    IF odd(index) THEN result := result shr 4;
    fatpointer := (result AND $fff);
    END; (* fatpointer *)

  (* 1---------------1 *)

  FUNCTION checkdriver : boolean;
  (* ensure that a suitable diskdriver exists.  Coded for use of *)
  (* DSKDRIVE (See DSKDRV16.LBR), configured for MS-DOS 9 sector *)

    TYPE
      infoarray    = RECORD
        stuff        : ARRAY[0..100] OF byte;
        idstring     : ARRAY[1..27] OF char;
        END; 

    VAR
      info         : ^infoarray;

    BEGIN (* checkdriver *)
    checkdriver := false;            (* default failure *)
    info := ptr(bdoshl(115, 1));     (* check the RSX is mounted *)
    IF info = NIL THEN writeln('DSKDRIVE RSX system not active')
    ELSE IF info^.idstring = 'IBM PC (MSDOS 9 Sect DSDD)$' THEN
      checkdriver := true
    ELSE write('DSKDRIVE not configured for MSDOS 9 sector DSDD');
    END; (* checkdriver *)

  (* 1-End Module 01-1 *)