    Dim Version$/"*** FORMAT V1.1a ***"/

! parameters
    Dim verifyonly
    Dim maxcyl
    Dim maxside
    Dim DiskType
    Dim DoubleTrackDrive
    Dim DoubleTrackDisk
    Dim DDTrack0
    Dim DDTrack1
    Dim IBM
    Dim numberofsectors
    Dim steprate
    Dim errorsector

! disk types
    Dim FiveInch/0/
    Dim EightInch/4/

! Variables used to manage track buffer
    Dim trackbuffer$(12000)
    Dim Track1built
    Dim Track1read

! Miscellaneous Variables
    Dim CR$/:0D/
    Dim Answer$(3)

! error codes
    dim errargcount/27/
    dim errdatalate/100/
    dim errdevicetimedout/:412/
    dim errdiskread/:415/
    dim errdiskwrite/:416/
    dim errdiskseek/:417/
    dim errdiskwrtprot/:418/
    dim errdevicenotready/:424/

Subroutine Build5InchSDSector(B5SDSectorNumber)
    for TBI=TBI to TBI+5 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FE \ ! address mark
    if B5SDSectorNumber=IBM then TrackIndex=TBI
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! track number
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! side
    for TBI=TBI to TBI do TrackBuffer$(TBI)=B5SDSectorNumber \ ! sector
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! sector length=128
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+10 do TrackBuffer$(TBI)=:FF
    for TBI=TBI to TBI+5 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FB \ ! data mark
    for TBI=TBI to TBI+127 do TrackBuffer$(TBI)=:E5 \ ! data
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+9 do TrackBuffer$(TBI)=:FF
    exit subroutine
end

Subroutine Build5InchDDSector(B5DDSectorNumber)
    for TBI=TBI to TBI+11 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI+2 do TrackBuffer$(TBI)=:F5
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FE \ ! address mark
    if B5DDSectorNumber=IBM then TrackIndex=TBI
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! track number
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! side
    for TBI=TBI to TBI do TrackBuffer$(TBI)=B5DDSectorNumber \ ! sector
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:01 \ ! sector length=256
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+21 do TrackBuffer$(TBI)=:4E
    for TBI=TBI to TBI+11 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI+2 do TrackBuffer$(TBI)=:F5
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FB \ ! data mark
    for TBI=TBI to TBI+255 do TrackBuffer$(TBI)=:E5 \ ! data
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+23 do TrackBuffer$(TBI)=:4E
    exit subroutine
end

Subroutine Build8InchSDSector(B8SDSectorNumber)
    for TBI=TBI to TBI+5 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FE \ ! address mark
    if B8SDSectorNumber=IBM then TrackIndex=TBI
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! track number
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! side
    for TBI=TBI to TBI do TrackBuffer$(TBI)=B8SDSectorNumber \ ! sector
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! sector length=128
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+10 do TrackBuffer$(TBI)=:FF
    for TBI=TBI to TBI+5 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FB \ ! data mark
    for TBI=TBI to TBI+127 do TrackBuffer$(TBI)=:E5 \ ! data
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+26 do TrackBuffer$(TBI)=:FF
    exit subroutine
end

Subroutine Build8InchDDSector(B8DDSectorNumber)
    for TBI=TBI to TBI+11 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI+2 do TrackBuffer$(TBI)=:F5
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FE \ ! address mark
    if B8DDSectorNumber=IBM then TrackIndex=TBI
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! track number
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:00 \ ! side
    for TBI=TBI to TBI do TrackBuffer$(TBI)=B8DDSectorNumber \ ! sector
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:01 \ ! sector length=256
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+21 do TrackBuffer$(TBI)=:4E
    for TBI=TBI to TBI+11 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI+2 do TrackBuffer$(TBI)=:F5
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FB \ ! data mark
    for TBI=TBI to TBI+255 do TrackBuffer$(TBI)=:E5 \ ! data
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:F7 \ ! checksum byte
    for TBI=TBI to TBI+53 do TrackBuffer$(TBI)=:4E
    exit subroutine
end

Subroutine Build5InchSDTrack
    ! single density 5" track
    for TBI=1 to 40 do TrackBuffer$(TBI)=:FF
    sectorsize=TBI
    Build5InchSDSector(IBM)
    sectorsize=TBI-sectorsize
    for i=IBM+1 to IBM+17 do Build5InchSDSector(i)
    lastsector=TBI
    for TBI=TBI to TBI+399 do TrackBuffer$(TBI)=:FF
    exit subroutine
end

Subroutine Build5InchDDTrack
    ! double density 5" track
    for TBI=1 to 60 do TrackBuffer$(TBI)=:4E
    sectorsize=TBI
    Build5InchDDSector(IBM)
    sectorsize=TBI-sectorsize
    for i=IBM+1 to IBM+17 do Build5InchDDSector(i)
    lastsector=TBI
    for TBI=TBI to TBI+799 do TrackBuffer$(TBI)=:4E
    exit subroutine
end

Subroutine Build8InchSDTrack
    ! single density 8" track
    for TBI=1 to 40 do TrackBuffer$(TBI)=:FF
    for TBI=TBI to TBI+5 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FC
    for TBI=TBI to TBI+25 do TrackBuffer$(TBI)=:FF
    sectorsize=TBI
    Build8InchSDSector(IBM)
    sectorsize=TBI-sectorsize
    for i=IBM+1 to IBM+25 do Build8InchSDSector(i)
    lastsector=TBI
    for TBI=TBI to TBI+299 do TrackBuffer$(TBI)=:FF
    exit subroutine
end

Subroutine Build8InchDDTrack
    ! double density 8" track
    for TBI=1 to 80 do TrackBuffer$(TBI)=:4E
    for TBI=TBI to TBI+11 do TrackBuffer$(TBI)=:00
    for TBI=TBI to TBI+2 do TrackBuffer$(TBI)=:F6
    for TBI=TBI to TBI do TrackBuffer$(TBI)=:FC
    for TBI=TBI to TBI+49 do TrackBuffer$(TBI)=:4E
    sectorsize=TBI
    Build8InchDDSector(IBM)
    sectorsize=TBI-sectorsize
    for i=IBM+1 to IBM+25 do Build8InchDDSector(i)
    lastsector=TBI
    for TBI=TBI to TBI+599 do TrackBuffer$(TBI)=:4E
    exit subroutine
end

Subroutine BuildTrack(DDTrack)
    if DiskType=FiveInch
    then
        ! it's an 5 inch disk
        if DDTrack
        then call Build5InchDDTrack
        else call Build5InchSDTrack
    else
        ! it's an 8 inch disk
        if DDTrack
        then call Build8InchDDTrack
        else call Build8InchSDTrack
    fi
    exit subroutine
end

Subroutine dumpparams
    input 'print trackbuffer (y or n, <CR>=yes)? ' answer$
    printtrackbuffer=find(lowercase$(answer$),'n')<>1

    print 'verifyonly='; verifyonly
    print 'DiskType='; disktype
    print 'maxcyl='; maxcyl
    print 'maxside='; maxside
    print 'DoubleTrackDisk='; doubletrackdisk
    print 'DoubleTrackDrive='; doubletrackdrive
    print 'DDTrack0='; ddtrack0
    print 'DDTrack1='; ddtrack1
    print 'IBM='; ibm
    print 'steprate='; steprate
    print 'numberofsectors='; numberofsectors
    exit subroutine
end

Subroutine Getparams
    getformatenable:...
&   repeat
        input 'Format, verify, or quit (f, v, or q, <CR>=format)? ' answer$
        if find(lowercase$(answer$),'q')=1 then exit
        verifyonly=find(lowercase$(answer$),'v')=1
        if not verifyonly
        then
            print 'Formatting a disk will destroy all data on that disk.'
            input 'Are you sure you want to format a disk? ' Answer$
            if find(lowercase$(Answer$),'yes')=1 then exit getformatenable fi
        else exit getformatenable
    end
    getdisktype:...
&   repeat
        if verifyonly then print 'Verify'; else print 'Format';
        input ' 5" or 8" (5 or 8, <CR>=5)? ' answer$
        if find(answer$,'5')=1 or answer$=''
        then DiskType=FiveInch \ exit getdisktype
        elseif find(answer$,'8')=1
        then DiskType=EightInch \ exit getdisktype
    end

    input 'Double side (y or n, <CR>=yes)? ' answer$
    if not find(lowercase$(answer$),'n')=1
    then maxside=1 else maxside=0

    if DiskType=FiveInch
    then
        steprate=0
        numberofsectors=18
        input 'Double track diskette (y or n, <CR>=yes)? ' answer$
        DoubleTrackDisk=find(lowercase$(answer$),'n')<>1

        input 'Double track drive (y or n, <CR>=yes)? ' Answer$
        DoubleTrackDrive=find(lowercase$(answer$),'n')<>1

        print 'Extended track addressing ';
        if DoubleTrackDisk
        then
            if not DoubleTrackDrive then print 'Capability mismatch.' \ exit
            input '(y or n, n=70, y=80, <CR>=80)? ' answer$
            if find(lowercase$(answer$),'n')=1 then maxcyl=69 else maxcyl=79
        else
            input '(y or n, n=35, y=40, <CR>=40)? ' answer$
            if find(lowercase$(answer$),'n')=1 then maxcyl=34 else maxcyl=39
        fi
    else
        DoubleTrackDrive=false
        DoubleTrackDisk=false
        steprate=1
        numberofsectors=26
        maxcyl=76
    fi

    input 'Double density track 0 (y or n, <CR>=yes)? ' answer$
    DDTrack0=find(lowercase$(answer$),'n')<>1

    print 'Double density track 1 through end of disk ';
    input '(y or n, <CR>=yes)? ' answer$
    DDTrack1=find(lowercase$(answer$),'n')<>1

    input 'IBM (origin 1) sector numbering (y or n, <CR>=yes)? ' answer$
    IBM=find(lowercase$(answer$),'n')<>1

    !D!dumpparams
    exit subroutine
end

Subroutine trackdump
    if printtrackbuffer
    then
        print 'trackdump, buffersize='; TBI
        i=1
        repeat
            while trackbuffer$(i)<>:FE do
                if i<TBI
                then
                    charcount=0
                    newchar=trackbuffer$(i)
                    while trackbuffer$(i)=newchar do
                        charcount=charcount+1
                        i=i+1
                    end
                    print num$(charcount);' '; hex$(newchar)[4,2];
                else print \ exit subroutine
            end
            print
            print 'FE';
            print ' c=' ; hex$(trackbuffer$(i+1))[4,2];
            print ' t='; hex$(trackbuffer$(i+2))[4,2];
            print ' s='; hex$(trackbuffer$(i+3))[4,2];
            i=i+4
        end
    fi
    exit subroutine
end

Subroutine printerror
    print
    if err=errargcount then print 'Wrong number of arguments to sub/fcn';
    elseif err=errdatalate then print 'Data late';
    elseif err=errdevicetimedout then print 'Device timed out';
    elseif err=errdiskread then print 'Disk read error';
    elseif err=errdiskwrite then print 'Disk write error';
    elseif err=errdiskseek then print 'Disk seek error';
    elseif err=errdiskwrtprot then print 'Disk write protect error';
    elseif err=errdevicenotready then print 'Device not ready';
    else print 'Error number';err;
    print ' occured while attempting to ';
    exit subroutine
end

Subroutine restoreerror
    printerror
    print 'restore the drive'
    exit subroutine
end

Subroutine stepinerror
    printerror
    print 'step the head'
    exit subroutine
end

Subroutine writeerror
    printerror
    print 'format a track'
    print 'Track= '; hex$(cyl)[4,2]; ', side= '; hex$(side)[4,2]
    exit subroutine
end

Subroutine readerror
    printerror
    print 'read sectors'
    print 'Track= '; hex$(cyl)[4,2]; ', side= '; hex$(side)[4,2];
    print ', sector= '; hex$(errorsector)[4,2]
    exit subroutine
end

Subroutine fdselect(xunit,xside,xdensity) external
Subroutine fdrestore(rsteprate) external
Subroutine fdstepin(xupdatetrackregister,xsteprate) external
Subroutine fdwritetrack(xtrackbuffer$) external
Subroutine fdreadsectors(rside,xibm,xnumberofsectors,xerrorsector) external

Subroutine formatdisk
    if verifyonly then exit subroutine
    print 'Formatting tracks'
    Track1Built=false
    for cyl=0 to maxcyl do
        write #0, CR$, hex$(cyl)[4,2]
        for side=0 to maxside do
            if not Track1Built
            then
                if cyl=0 and side=0
                then
                    Buildtrack(DDTrack0)
                    fdselect(DiskType,side,DDTrack0)
                    if error when call fdrestore(steprate)
                    then call restoreerror \ error fi
                else
                    if DDTrack0<>DDTrack1 then Buildtrack(DDTrack1)
                    fdselect(DiskType,side,DDTrack1)
                    Track1Built=true
                fi
            else fdselect(DiskType,side,DDTrack1)
            for i=trackindex to lastsector step sectorsize do
                TrackBuffer$(i)=cyl
                TrackBuffer$(i+1)=side
            end
            !D!trackdump
            if error when fdwritetrack(trackbuffer$)
            then call writeerror \ error
        end
        if error when fdstepin(true,steprate) then call stepinerror \ error
        if DoubleTrackDrive<>DoubleTrackDisk
        then
            if error when fdstepin(false,steprate)
            then call stepinerror \ error fi
        fi
    end
    exit subroutine
end

Subroutine verifyformat
    if not verifyonly then print
    print 'Verifying tracks'
    Track1read=false
    for cyl=0 to maxcyl do
        write #0, CR$, hex$(cyl)[4,2]
        for side=0 to maxside do
            if not Track1read
            then
                if cyl=0 and side=0
                then
                    fdselect(DiskType,side,DDTrack0)
                    if error when call fdrestore(steprate)
                    then call restoreerror fi
                else
                    fdselect(DiskType,side,DDTrack1)
                    Track1read=true
                fi
            else fdselect(DiskType,side,DDTrack1)
            if error when
                fdreadsectors(side,ibm,numberofsectors,errorsector)
            then call readerror
        end
        if error when fdstepin(true,steprate) then call stepinerror
        if DoubleTrackDrive<>DoubleTrackDisk
        then if error when fdstepin(false,steprate) then call stepinerror
    end
    exit subroutine
end

    print version$
    len(TrackBuffer$)=maxlen(TrackBuffer$)
    Getparams

    repeat
        if error when formatdisk
        then ! do nothing
        else call verifyformat
        print
        if verifyonly then print 'Verify'; else print 'Format';
        input ' another disk (y or n, <CR>=yes)? ' answer$
        if find(lowercase$(answer$),'n')=1 then exit
        input 'Use same parameters (y or n, <CR>=yes)? ' answer$
        if find(lowercase$(answer$),'n')=1 then call Getparams
    end

end
