CLS
DEFFN cl=(sec%-25)/8
DEFFN sec=8*cl%+25
DEFTEXT 1,0,0,4
DIM com%(5),me$(63),d$(1,1050),df%(1),d%(1),su%(1,1050),e%(1)
OPEN "",#1,"AUX:"
null$=STRING$(128,0)
ff$=STRING$(256,255)
RESTORE
FOR i%=0 TO 63
  READ me$(i%)
  EXIT IF me$(i%)="***"
NEXT i%
me$(i%)=""
me$(i%+1)=""
DATA Desk , ATARI ST/XL Interface ,----------------------,1,2,3,4,5,6,""
DATA Disk 1 ,  Directory,  Save Disk,  Load Disk,  Format SD,  Format ED,------------,  Set,  Change Nr,""
DATA Disk 2 ,  Directory,  Save Disk,  Load Disk,  Format SD,  Format ED,------------,  Set,  Change Nr,""
DATA Printer ,  Direct,  Buffer,  List,  Print Buffer,  Show Buffer
DATA   Clear Buffer,  Save Buffer,---------------,  Set,  Buffer size,""
DATA Copy , Disk 1 to ST , Disk 2 to ST,--------------, ST to Disk 1, ST to Disk 2,""
DATA Settings ,  128 BpS,  256 BpS,  Show Sector# ,-----------------
DATA   Clearw Disk 1,  Clearw Printer ,  Clearw Disk 2,  Clearw Status,""
DATA End, * Quit * ,***
MENU me$()               !Menubalk aanzetten.
'
d2$="2"                  !Default device number disk 2
CLOSEW 1
TITLEW #1,"Disk "+d1$    !Window 1 = Disk 1
INFOW #1,"-"
CLOSEW 2
TITLEW #2,"Printer"      !Window 2 = Printer
INFOW #2,"-"
CLOSEW 3
TITLEW #3,"Disk "+d2$    !Window 3 = Disk 2
INFOW #3,"-"
CLOSEW 4
TITLEW #4,"Status"       !Window 4 = Status window
FOR i%=1 TO 4
  OPENW i%               !Alle windows openen
  CLS                    !en schoonmaken.
NEXT i%
ON MENU GOSUB menue     !Menu procedures initializeren.
'
d%=XBIOS(15,0,0,-1,-1,-1,-1) !Baudrate instellen op 19200 baud.
FOR i%=11 TO 15          !De menu items van het Disk 1 menu
  MENU i%,2              !uitschakelen.
NEXT i%
d%(1)=1      !Disk 2: Aktief.
len%=128
d%=1
@init        !Initialize disk 2
IF FRE()>204800
  e%(0)=1
  d%=0
  @init
  d1$="1"
  TITLEW #1,"Disk "+d1$
ENDIF
sn%=0        !Show sector# als default niet aktief.
MENU 27,1    !Disk 2: 'Set' het 'haakje' ervoor zetten.
p%=1         !Printer: Aktief.
MENU 39,1    !Printer: 'Set' haakje ervoor.
sh%=1        !sh%=1 printer output naar window, sh%=0 niet naar window
MENU 33,1    !Printer: 'List' haakje.
bu&=1        !Buffer size 32 k, 2=64 k, 3=128k
MENU 50,1    !Settings: '128 BpS' haakje.
@pinfo       !Printer Status aangeven.
@dinfo2      !Disk Status aangeven.
@setml       !Machinetaal subroutine initializeren.
'
go1:
SHOWM
WHILE BIOS(1,1)=-1 !Alle aanwezige tekens uit modempoort
  b%=INP(1)        !verwijderen.
  ON MENU
WEND
'
go:
SHOWM
WHILE BIOS(1,1)<>-1  !Wachten op een teken aan de modempoort.
  ON MENU            !Of op een menu keuze.
WEND
HIDEM
'
go2:
c%=INP(1)            !1 Byte van de modempoort halen.
IF (c%<>64 OR p%=0) AND (c%<>ASC(d1$) OR d%(0)=0) AND (c%<>ASC(d2$) OR d%(1)=0)
  GOTO go            !kijken of een van onze 'apparaten' aangesproken wordt
ENDIF                !en of ze aktief zijn. Als dit zo is doorgaan
s%=c%                !anders terug en wachten op andere informatie.
FOR i%=1 TO 3
  b%=INP(1)          !Commandoblok halen.
  com%(i%)=b%        !en opslaan om later te gebruiken.
  s%=s%+b%
  s1%=(s% AND 255)+INT(s%/256) !Checksum uitrekenen.
NEXT i%
b%=INP(1)            !De checksum ophalen.
IF b%<>s1%           !als deze niet klopt met de berekende
  OPENW 4            !waarde. Een error boodschap op het scherm zetten.
  PRINT " Invalid Command-Frame !"
  GOTO go1           !Dan terug en wachten op informatie van modempoort.
ENDIF
'
IF c%=ASC(d1$) OR c%=ASC(d2$)  !Is het gekozen device een drive?
  ' ******************  Disk Routines  *******************
  IF c%=ASC(d1$)
    d%=0
  ENDIF
  IF c%=ASC(d2$)
    d%=1
  ENDIF
  OUT 1,ASC("A")            !ACKNOWLEDGE (ACK) sturen.
  sec%=com%(2)+com%(3)*256  !Sectornummer berekenen uit het commandoblok.
  '
  IF com%(1)=ASC("R")       !Is de opdracht een Leesopdracht (READ).
    ' **********  Read Sector  **********
    OUT 1,ASC("A")          !ACK sturen.
    IF sn%                  !Moet het sectornummer geprint worden?
      OPENW d%*2+1          !zo ja, window openen en printen.
      PRINT AT(1,1);"Sending Sector $";HEX$(sec%);" (";sec%;")     "
    ENDIF
    PRINT #1,d$(d%,sec%)+CHR$(su%(d%,sec%))+"C" !Sectorinhoud en de
    GOTO go                 !bijbehorende checksum sturen.
  ENDIF                     !Dat was de leesopdracht (van de XL).
  '
  IF com%(1)=ASC("P") OR com%(1)=ASC("W") !Een schrijfopdracht (WRITE - PUT).
    ' **********  Put/ Write Sector **********
    OUT 1,ASC("A")                !ACK sturen
    IF sec%<4                     !De sectoren 1-3 zijn altijd 128 Bytes lang.
      d$(d%,sec%)=INPUT$(128,#1)  !128 Bytes ophalen.
    ELSE
      d$(d%,sec%)=INPUT$(len%,#1) !Anders kunnen het er ook 256 zijn.
    ENDIF
    b%=INP(1)                     !Checksum ophalen.
    OUT 1,ASC("A")                !ACK sturen.
    IF sn%                        !Moet het sectornummer geprint worden?
      OPENW d%*2+1
      PRINT AT(1,1);"Getting Sector $";HEX$(sec%);" (";sec%;")     "
    ENDIF
    @dosum(sec%)                  !Reken de checksum van de sector uit.
    IF s1%<>b%                    !klopt deze met de opgehaalde van de XL
      OPENW 4                     !Is dit niet zo, dan een error boodschap printen.
      PRINT " PUT: Checksum-Error in $";HEX$(sec%);" : $";HEX$(s1%);"<>$";HEX$(b%)
      OUT 1,ASC("E")              !und ERROR sturen naar de XL
      GOTO go1                    !en weer wachten.
    ENDIF
    OUT 1,ASC("C")                !anders COMPLETE sturen om het einde aan
    GOTO go                       !te geven van deze opdracht.
  ENDIF
  '
  IF com%(1)=ASC("S")             !STATUS opdracht gevraagd?
    ' **********  Disk Status  **********
    OPENW d%*2+1           !Window openen
    IF len%=128            !voor een bepaalde Sectorlengte
      RESTORE dstat1       !het bijbehorende statusblok sturen.
    ELSE
      RESTORE dstat2
    ENDIF
    FOR i%=1 TO 6          !6 Statusbytes
      READ b%              !Data lezen
      OUT 1,b%             !en naar de XL sturen.
    NEXT i%
    GOTO go                !En weer wachten.
    dstat1:
    DATA 67,16,0,1,0,17
    dstat2:
    DATA 67,48,0,1,0,49
  ENDIF
  '
  IF com%(1)=ASC("!") OR com%(1)=34    !Formatteer commando's.
    ' **********  Format Disk SD of ED  **********
    OUT 1,ASC("A")              !ACK sturen.
    df%(d%)=com%(1)-32          !Disk op SD of ED zetten.
    @dinfo                      !en aan gaan geven.
    PRINT " Formatting...."
    @init                       !Disk leegmaken.
    PRINT #1,STRING$(len%+1,255)!'alle Sectoren OK' sturen
    OUT 1,ASC("C")              !COMPLETE sturen.
    GOTO go2                    !op WRITE gaan wachten.
  ENDIF
  '
  OPENW 4                       !Onbekend commando en dit ook aangeven.
  PRINT "Unknown Command : ";HEX$(com%(1))'"(";CHR$(com%(1));")"
  GOTO go1
ENDIF
'
IF c%=64                        !Was de printer gekozen?
  ' *****************  Printer Routines  ******************
  '
  IF com%(1)=ASC("S")
    ' **********  Printer Status  **********
    RESTORE pstat    !Printer Statusblok sturen.
    FOR i%=1 TO 7    !ACK en de 6 Status bytes
      READ b%        !lezen.
      OUT 1,b%       !und sturen
    NEXT i%
    pstat:
    DATA 65,67,128,78,5,0,211
  ENDIF
  '
  IF com%(1)=ASC("W")         !Schrijf opdracht?
    ' **********  Printer Write  **********
    OUT 1,ASC("A")            !ACK sturen
    p$=INPUT$(40,#1)          !40 Bytes lezen
    b%=INP(1)                 !en dan de checksum lezen.
    OUT 1,ASC("A")            !ACK sturen.
    m%=VARPTR(m$)
    s1%=C:m%(L:VARPTR(p$),40) !Checksum zelf berekenen.
    IF b%<>s1%                !Klopt deze?
      OPENW 4                 !zo niet, error boodschap printen.
      PRINT " Printer: Checksum-Error : $";HEX$(s1%);"<>$";HEX$(b%)
      OUT 1,ASC("N")          !NO ACK (NACK)
      OUT 1,ASC("E")          !en ERROR sturen.
      GOTO go1
    ELSE
      i%=INSTR(p$,CHR$(155))  !zoek een CRLF ($9B)
      IF i%
        p$=LEFT$(p$,i%-1)+CHR$(10)+CHR$(13) !en verander deze in CR en LF ($0C - $0A)
      ENDIF
      IF sh%           !'List' gekozen ?
        OPENW 2
        PRINT p$;      !ja: Tekst in het window printen!
      ENDIF
      IF pu%           !Buffer ingeschakeld ?
        alr!=FALSE
        IF LEN(pu$)+LEN(p$)<32767 AND LEN(pu1$)=0
          pu$=pu$+p$     !ja: Tekst naar de buffer!
        ELSE
          SELECT bu&
          CASE 1
            alr!=TRUE
          CASE 2
            IF LEN(pu1$)+LEN(p$)<32766
              pu1$=pu1$+p$
            ELSE
              alr!=TRUE
            ENDIF
          CASE 3
            IF LEN(pu1$)+LEN(p$)<32766 AND LEN(pu2$)<>0
              pu1$=pu1$+p$
            ELSE
              IF LEN(pu2$)+LEN(p$)<32766 AND LEN(pu3$)<>0
                pu2$=pu2$+p$
              ELSE
                IF LEN(pu3$)+LEN(p$)<32766
                  pu3$=pu3$+p$
                ELSE
                  alr!=TRUE
                ENDIF
              ENDIF
            ENDIF
          ENDSELECT
          IF alr!=TRUE
            ALERT 1," Buffer full ",1," Exit ",dummy%
          ENDIF
        ENDIF
      ENDIF
      IF o             !Direct uitvoer gekozen ?
        LPRINT p$;     !dan ook meteen op de printer afdrukken!
      ENDIF
      OUT 1,ASC("C")   !COMPLETE sturen.
    ENDIF
  ENDIF
ENDIF
GOTO go                !Klaar dus nu weer wachten!
'
' *****************  Procedures  *****************
'
PROCEDURE menue        !Hier komt het programma als een menu item
  d%=1+(MENU(0)<20)    !geselecteerd is.
  ON MENU(0) GOSUB info
  ON MENU(0)-10 GOSUB dir,sav,loa,fmtsd,fmtdd,x,setd,change_devnr
  ON MENU(0)-20 GOSUB dir,sav,loa,fmtsd,fmtdd,x,setd,change_devnr
  ON MENU(0)-30 GOSUB direkt,puffer,list,prpuf,shpuf,clpuf,sapuf,x,setp,setbuff
  ON MENU(0)-42 GOSUB dst,dst,x,std,std
  ON MENU(0)-49 GOSUB set128,set256,shownr,x,clw,clw,clw,clw
  MENU OFF
  IF MENU(0)=60        !End gekozen?
    SHOWM
    DEFTEXT 1,0,0,13   ! * QUIT *
    ALERT 3," Are you sure you | want to quit ?",1," Yes | No ",dummy%
    IF dummy%=1        !Is OK gekozen dan naar de desktop.
      SYSTEM
    ENDIF
    DEFTEXT 1,0,0,4    !Anders de menubalk weer inschakelen.
    ON MENU GOSUB menue
  ENDIF
RETURN
'
PROCEDURE info         !Copyright boodschap. A.U.B. NIET veranderen.
  ALERT 0,"  ATARI ST/XL Interface  |     S.A.G.HARDWARE |       FREAKS 1988  ",1," OK ",dummy%
RETURN
'
PROCEDURE clw       !Clear Window, Scherm schoonmaken.
  OPENW MENU(0)-53
  CLS
RETURN
'
PROCEDURE setml     !Machinetaal subroutine initialisatie.
  RESTORE mprog     !Deze routine berekent heel snel de checksum van
  m$=""             !van de ingelezen data.
  FOR i%=1 TO 24    !Een routine in basic is te langzaam hiervoor.
    READ a$
    m$=m$+CHR$(VAL("&H"+a$))
  NEXT i%
  mprog:
  DATA 2a,6f,00,04,42,85,52,45,3a,2f,00,08,42,80,12,1d,d1,01,51,cd,ff,fa,4e,75
RETURN
'
' **********  Disk Procedures  **********
'
PROCEDURE set128        !128 Bytes/Sector instellen.
  IF len%=256
    @sure               !Bent u er zeker van?
    IF sure%=2          !OK
      null$=STRING$(128,0) !Null$ op de goede lengte brengen.
      MENU 50,1         !'128 BpS' haakje
      MENU 51,0         !'256 BpS' haakje weghalen.
      len%=128          !Lengtevariabele goed zetten.
      IF e%(1)=1
        @initall         !Disks opnieuw initializeren en leeg maken.
      ELSE
        d%=1             ! of alleen 1 disk
        @init
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE set256        !256 Bytes/sector instellen
  IF len%=128
    @sure
    IF sure%=2
      null$=STRING$(256,0)
      MENU 50,0         !De haakjes ook hier weer
      MENU 51,1         !goed zetten
      len%=256
      IF e%(0)=1
        @initall         !Disks opnieuw initializeren en leeg maken.
      ELSE
        ALERT 1," Not enough | Memory",1,"Sorry",dummy%
      ENDIF
    ENDIF
  ENDIF
RETURN
PROCEDURE sure          !De zekerheidsvraag om de sectorlengte te veranderen.
  ALERT 1," Changing Sector size| Erases ALL Data !|",1," STOP | OK ",sure%
  IF sure%=2
    ARRAYFILL df%(),0   !Beide disks zijn hierna leeg voor het programma.
    @dinfo2             !en geef dit ook aan.
  ENDIF
RETURN
'
PROCEDURE change_devnr  !Verander het device nummer
  exit!=FALSE
  DO
    OPENW 4
    PRINT AT(2,3);"New drive number : ";
    INPUT choice%
    IF MENU(0)-20<0
      IF choice%<>VAL(d2$) AND choice%<8 AND choice%>0
        d1$=STR$(choice%)
        TITLEW #1,"Disk "+d1$
        exit!=TRUE
      ENDIF
    ELSE
      IF choice%<>VAL(d1$) AND choice%<8 AND choice%>0
        d2$=STR$(choice%)
        TITLEW #3,"Disk "+d2$
        exit!=TRUE
      ENDIF
    ENDIF
  LOOP UNTIL exit!
RETURN
'
PROCEDURE shownr        !Sectornummer aan/uit zetten.
  IF sn%                !als deze ingeschakeld is
    sn%=0               !moet het uitgezet worden.
  ELSE
    sn%=1               !anders inschakelen.
  ENDIF
  MENU 52,sn%           !Het haakje zetten/weghalen.
RETURN
'
PROCEDURE dosum(o%)     !Sector checksum bereken.
  IF o%<4               !Sectors 1-3
    l%=128              !altijd 128 Bytes lang
  ELSE
    l%=len%             !een ander sectornummer krijgt de huidige
  ENDIF                 !sectorlengte.
  m%=VARPTR(m$)
  s1%=C:m%(L:VARPTR(d$(d%,o%)),l%) !Bereken het met de ML-routine.
  su%(d%,o%)=s1%        !en de checksum opslaan.
RETURN
'
PROCEDURE dir           !** Directory printen **
  OPENW 2*d%+1
  CLS
  PRINT TAB(0);
  co=-1
  '
  IF df%(d%)=1          ! *  Single Density *
    FOR i%=361 TO 368   !Directory sectoren
      FOR j%=1 TO 113 STEP 16 !helemaal doorlopen
        d$=""
        EXIT IF MID$(d$(d%,i%),j%+5,1)=CHR$(0)   !Einde van de directory?
        IF MID$(d$(d%,i%),j%,1)<CHR$(128)        !File gewist?
          d$=MID$(d$(d%,i%),j%+5,11)             !nee: Filename ophalen
          PRINT LEFT$(d$,8);".";RIGHT$(d$,3)'''; !en afdrukken.
          PRINT ASC(MID$(d$(d%,i%),j%+2,1))*256+ASC(MID$(d$(d%,i%),j%+1,1)); !file lengte
          co=NOT co
          IF co
            PRINT
          ELSE
            PRINT TAB(26);"| "; !Scheidingsteken printen.
          ENDIF
        ENDIF
      NEXT j%
      EXIT IF j%<114 AND MID$(d$(d%,i%),j%+5,1)=CHR$(0) !Geen files meer.
    NEXT i%
    PRINT
    fr%=(ASC(MID$(d$(d%,360),4,1))+256*ASC(MID$(d$(d%,360),5,1))) !vrije sectoren
    PRINT fr%'"Sectors ="'fr%*(len%-3)'" Bytes free"    !printen!
    '
  ELSE    ! * Double Density *
    FOR i%=16 TO 24
      FOR j%=1-(i%=16)*16 TO 113 STEP 16
        d$=""
        EXIT IF MID$(d$(d%,i%),j%+1,1)=CHR$(0)
        IF MID$(d$(d%,i%),j%,1)<>CHR$(128)
          d$=MID$(d$(d%,i%),j%+1,11)
          PRINT LEFT$(d$,8);".";RIGHT$(d$,3)'''ASC(MID$(d$(d%,i%),j%+12,1));
          co=NOT co
          IF co
            PRINT
          ELSE
            PRINT TAB(26);"| ";
          ENDIF
        ENDIF
      NEXT j%
      EXIT IF j%<114 AND MID$(d$(d%,i%),j%+1,1)=CHR$(0)
    NEXT i%
    PRINT
    CLR j%
    FOR i%=1 TO 128
      IF MID$(d$(d%,24),i%,1)=CHR$(254)
        INC j%
      ENDIF
    NEXT i%
    PRINT j%'"Blocks ="'j%*8*len%'"Bytes free"
  ENDIF
  PRINT
RETURN
'
PROCEDURE initall   !Allebei de disks initializeren en leegmaken.
  FOR d%=0 TO 1
    @init
  NEXT d%
RETURN
PROCEDURE init      !De eigenlijke wis routine.
  FOR j%=1 TO 3
    d$(d%,j%)=STRING$(128,0)        !Sectoren 1-3 altijd 128 Bytes
    su%(d%,j%)=0
  NEXT j%
  FOR j%=4 TO 1050
    d$(d%,j%)=STRING$(len%,0)       !De hele string met 0 vullen
    su%(d%,j%)=0                    !de checksum natuurlijk ook.
  NEXT j%
  OPENW d%*2+1
  CLS
  e%(d%)=1     !Disk is geinitialiseerd
RETURN
'
PROCEDURE sav                       !* Een hele disk opslaan *
  IF df%(d%)
    @file                           !Geef een filenaam.
    IF f$<>""
      DEFMOUSE 2                    !Muis = Busy bee!
      FOR i%=1050 DOWNTO 1
        EXIT IF d$(d%,i%)<>STRING$(len%,0) !Vanaf de eerste volle sector
      NEXT i%                              !vanaf het einde opslaan.
      OPEN "R",#2,f$,len%+1
      FIELD #2,len% AS a$,1 AS su$
      a1$=STR$(i%)+"D"+STR$(df%(d%))+"L"+STR$(len%) !eerst alle parameters.
      su$=" "
      LSET a$=a1$
      PUT #2,1
      FOR j%=1 TO i%         !daarna de inhoud van alle Sectoren
        LSET a$=d$(d%,j%)
        su$=CHR$(su%(d%,j%)) !en hun checksum opslaan.
        PUT #2,j%+1
      NEXT j%
      CLOSE #2
      DEFMOUSE 0             !Muis = pijltje
    ENDIF
  ENDIF
RETURN
'
PROCEDURE loa           !* Een hele disk laden *
  w=1
  IF df%(d%)            !Een boodschap als de disk al data bevat.
    ALERT 1," Loading clears | current contents |",1," OK | CANCEL ",w
  ENDIF
  IF w=1
    @file               !Geef een filenaam.
    IF f$<>""
      DEFMOUSE 2        !Muis = busy bee,
      @init
      OPEN "I",#2,f$
      a$=INPUT$(129,#2) !Parameters laden.
      i%=VAL(a$)        !Aantal sectoren bepalen.
      df%(d%)=VAL(MID$(a$,INSTR(a$,"D")+1,4)) !Diskette formaat terughalen.
      IF len%=VAL(MID$(a$,INSTR(a$,"L")+1,4)) !komt het BpS getal overeen
        IF len%=256                           !met de huidige lengte?
          a$=INPUT$(128,#2)
        ENDIF
        FOR sec%=1 TO i%
          d$(d%,sec%)=INPUT$(len%,#2)    !Sektorinhoud en
          su%(d%,sec%)=ASC(INPUT$(1,#2)) !de checksum inlezen uit de file
        NEXT sec%
        FOR sec%=1 TO 3
          d$(d%,sec%)=LEFT$(d$(d%,sec%),128) !Sectoren 1-3 inlezen.
        NEXT sec%
      ELSE               !Was de sectorlengte verschillend?
        ALERT 1," Invalid Sector Length |",1," Stop ",dummy%
      ENDIF
      CLOSE #2
      @dinfo
    ENDIF
    DEFMOUSE 0      !Muis weer een pijltje
    @dir            !Directory printen
  ENDIF
RETURN
'
PROCEDURE file      !Filenaam ingeven in een FileSelectorBox
  FILESELECT CHR$(GEMDOS(25)+65)+":\*.DSK","",f$
  IF INSTR(f$,".")=0 AND f$<>""
    f$=f$+".DSK"
  ENDIF
RETURN
'
PROCEDURE setd           !Drive activeren/deactiveren.
  wi=2*d%+1
  OPENW wi
  IF d%(d%)              !Als de drive aktief is
    d%(d%)=0             !dan deaktiveren en
    MENU 17+10*d%,0       !het haakje verwijderen.
    INFOW #wi," Inactive" !Nieuwe status van de drive aangeven.
    FOR i%=11+d%*10 TO 15+d%*10
      MENU i%,2
    NEXT i%
    ~FRE()
  ELSE
    IF e%(0)=0
      ALERT 1," Not enough | memory |",1,"Sorry",dummy%
    ELSE
      d%(d%)=1              !Anders de drive activeren
      MENU 17+10*d%,1       !en het haakje zetten
      FOR i%=11+d%*10 TO 15+d%*10
        MENU i%,3
      NEXT i%
      @dinfo                !Nieuwe instelling aangeven.
    ENDIF
  ENDIF
RETURN
'
PROCEDURE fmtsd          !* Disk SD formatteren *
  @fmtsure               !Weet je het wel zeker ?
  IF sure%=1             !Ja, dan 707 vrije sectoren in VTOC
    MID$(d$(d%,360),1,5)=CHR$(2)+CHR$(&HC3)+CHR$(2)+CHR$(&HC3)+CHR$(2)
    MID$(d$(d%,360),11,1)=CHR$(15)
    MID$(d$(d%,360),12,89)=STRING$(89,255)
    MID$(d$(d%,360),56,2)=CHR$(0)+CHR$(&H7F)    !Dir. sectors zijn bezet
    su%(d%,360)=28                              !Checksum van VTOC goed zetten
    df%(d%)=1              !Diskstatus: SD
    @dinfo                 !en aangeven
  ENDIF
RETURN
'
PROCEDURE fmtdd            !* Disk ED formatteren *
  IF e%(0)=0
    ALERT 1," Not enough | Memory",1,"Sorry",dummy%
  ENDIF
  @fmtsure
  IF sure%=1
    MID$(d$(d%,16),15,2)=CHR$(&H7E)+CHR$(&HA5)
    su%(d%,16)=36
    FOR i%=1 TO 128
      MID$(d$(d%,24),i%)=CHR$(&HFE)
    NEXT i%
    su%(d%,24)=127
    df%(d%)=2
    @dinfo
  ENDIF
RETURN
'
PROCEDURE fmtsure          !Wilt u de disk formatteren?
  d%=1+(MENU(0)<20)        !Bepaal drive nr.
  sure%=1
  IF df%(d%)               !Als de disk al geformatteerd is, nog een vraagje
    ALERT 1," Formatting erases everything ! |",1," OK | STOP ",sure%
  ENDIF
  IF sure%=1               !'OK' start het formatteren.
    @init                  !Roep de procedure daarvoor aan.
  ENDIF
RETURN
'
PROCEDURE dinfo2           !De status van de beide drives
  FOR d%=0 TO 1            !aangeven.
    @dinfo
  NEXT d%
RETURN
'
PROCEDURE dinfo            !De status van ‚‚n drive
  IF d%(d%)=0              !aangeven.
    INFOW #d%*2+1," Inactive"
  ELSE
    IF df%(d%)=0
      INFOW #2*d%+1," Active : Unformatted"
    ELSE
      IF df%(d%)=1
        INFOW #d%*2+1," Active : Single Density"
      ELSE
        INFOW #d%*2+1," Active : Enhanced Density"
      ENDIF
    ENDIF
  ENDIF
RETURN
'
' **********  Printer procedures  **********
'
PROCEDURE direkt    !Direct uitvoer in/uitschakelen.
  IF o=1
    MENU 31,0
    o=0
  ELSE
    MENU 31,1
    o=1
  ENDIF
  @pinfo            !Status opnieuw aangeven.
RETURN
'
PROCEDURE puffer    !Buffer in/uitschakelen.
  OPENW 2
  CLS
  IF pu%=1
    MENU 32,0
    pu%=0
    @clpuf          !Buffer leeg maken.
  ELSE
    MENU 32,1
    pu%=1
  ENDIF
  @pinfo            !Status opnieuw aangeven.
RETURN
'
PROCEDURE prpuf     !Bufferinhoud afdrukken op papier
  IF pu$<>""        !alleen als de buffer gevuld is.
    ALERT 1," Print buffer | Printer on-line ?|",2," OK | CANCEL ",w
    IF w=1
      LPRINT pu$;pu1$;pu2$;pu3$ !click OK om het zaakje uit te printen.
    ENDIF
  ENDIF
RETURN
'
PROCEDURE sapuf     !Bufferinhoud op disk opslaan.
  IF pu$<>""        !ook alleen als er iets in staat
    FILESELECT CHR$(GEMDOS(25)+65)+":\*.*","",f$
    IF f$<>""
      OPEN "O",#2,f$ !Open file.
      PRINT #2,pu$;pu1$;pu2$;pu3$   !Schrijf de buffer weg.
      CLOSE #2       !Close file.
    ENDIF
  ENDIF
RETURN
'
PROCEDURE shpuf      !Bufferinhoud afdrukken op het scherm.
  OPENW 2
  PRINT pu$;pu1$;pu2$;pu3$
RETURN
'
PROCEDURE clpuf      !Buffer leegmaken.
  pu$=""
  pu1$=""
  pu2$=""
  pu3$=""
RETURN
'
PROCEDURE setp       !Printer routines in/uitschakelen.
  IF p%=1            !Als ze ingeschakeld zijn
    MENU 39,0        !Haakje weg en
    FOR i%=31 TO 33
      MENU i%,2      !de menu items uitschakelen.
    NEXT i%
    p%=0
  ELSE
    MENU 39,1        !anders inschakelen,het haakje zetten en
    FOR i%=31 TO 33
      MENU i%,3      !de menu items weer inschakelen.
    NEXT i%
    p%=1
  ENDIF
  @pinfo             !De nieuwe printerstatus aangeven.
RETURN
'
PROCEDURE list       !List funktie in/uitschakelen
  IF sh%=1
    MENU 33,0        !Afhankelijk van de situatie uit-
    sh%=0
  ELSE
    MENU 33,1        !of inschakelen.
    sh%=1
  ENDIF
  @pinfo             !De nieuwe status aan gaan geven.
RETURN
'
PROCEDURE pinfo      !Printerstatus aangeven.
  a$=""
  IF o               !Direct printen?
    a$=" Direct Printing"
  ENDIF
  IF pu%
    a$=a$+" Buffer " !Naar de buffer?
  ENDIF
  IF sh%
    a$=a$+" List "   !Op het scherm?
  ENDIF
  IF p%=0
    a$=" Inactive"   !Inaktief?
  ENDIF
  INFOW #2,a$         !zet alle informatie op de statusregel.
RETURN
'
PROCEDURE setbuff
  ALERT 2," Give new buffer size ",1," 32 k | 64 k | 128 k ",si&
  SELECT si&
  CASE 1
    bu&=1
  CASE 2
    IF FRE()>65564
      bu&=2
    ELSE
      bu&=1
      ALERT 1," Not enough memory ",1," Sorry ",dummy%
    ENDIF
  CASE 3
    IF FRE()>132000
      bu&=3
    ELSE
      bu&=1
      ALERT 1," Not enough memory ",1," Sorry ",dummy%
    ENDIF
  ENDSELECT
RETURN
'
' ****  Kopie‰r procedures  ****
'
PROCEDURE dst                               !*** Disk to ST Copy ***
  d%=MENU(0)-43                             !Welke drive ?
  IF df%(d%)                                !Als de drive geformatteerd is
    OPENW 2*d%+1
    INPUT "Select file to copy:";f$         !Filename ingeven
    INPUT "$9B => 10,13 (y/n) ";r$          !Moet CRLF in LF en CR verandert
    f$=UPPER$(f$)                           !worden?
    i%=INSTR(f$,".")                        !Is er een extender ?
    IF i%                                   !zo ja, Filenaam formatteren.
      a$=LEFT$(f$,i%-1)+SPACE$(9-i%)+RIGHT$(f$,LEN(f$)-i%)+SPACE$(3-(LEN(f$)-i%))
    ELSE
      a$=f$+SPACE$(11-LEN(f$))              !anders moeten er spaties achter.
    ENDIF
    '
    IF df%(d%)=1
      ' ** Single Density **
      sec%=0
      FOR i%=361 TO 369                     !Directory sectoren
        FOR j%=1 TO 113 STEP 16             !doorzoeken voor de file.
          IF MID$(d$(d%,i%),j%+5,11)=a$ AND MID$(d$(d%,i%),j%,1)<>"C"
            sec%=ASC(MID$(d$(d%,i%),j%+3,1))+ASC(MID$(d$(d%,i%),j%+4,1))*256
          ENDIF
          EXIT IF sec%
        NEXT j%
        EXIT IF sec%
      NEXT i%
      IF sec%=0                             !Als de file er niet is!!
        ALERT 1," File not found! |",1," CONTINUE ",w
      ENDIF
      IF sec%                               !
        a$=""                               !Maak de buffer leeg.
        REPEAT
          a$=a$+LEFT$(d$(d%,sec%),len%-3)   !Sector in de buffer inlezen.
          sec%=(ASC(MID$(d$(d%,sec%),len%-2,1)) AND 3)*256+ASC(MID$(d$(d%,sec%),len%-1,1))
        UNTIL sec%=0                        !Ga door totdat de volgende te lezen sector 0 is.
        IF LEFT$(UPPER$(r$),1)="Y"          !Omzetting van CRLF in LF,CR nodig
          b$=a$+CHR$(155)                   !Buffer kopie‰ren
          a$=""
          j%=1
          FOR i%=1 TO LEN(b$)               !en dan zoeken naar de combinatie.
            IF MID$(b$,i%,1)=CHR$(155)      !Als CRLF gevonden is omzetten naar
              a$=a$+MID$(b$,j%,i%-j%)+CHR$(10)+CHR$(13)  !LF en CR.
              j%=i%+1
            ENDIF
          NEXT i%
        ENDIF
        FILESELECT CHR$(GEMDOS(25)+65)+":\*.*","",f$ !Filenaam voor het opslaan.
        IF f$<>""
          BSAVE f$,VARPTR(a$),LEN(a$)       !Opslaan onder deze naam.
        ENDIF
      ENDIF
      '
    ELSE
      ' ** Double Density ** voor DD geldt hetzelfde verhaal als SD
      sec%=0
      FOR i%=16 TO 24
        FOR j%=1-(i%=16)*16 TO 113 STEP 16
          IF MID$(d$(d%,i%),j%+1,11)=a$ AND MID$(d$(d%,i%),j%,1)<>CHR$(128)
            cl%=ASC(MID$(d$(d%,i%),j%+13,1))
            siz%=ASC(MID$(d$(d%,i%),j%+14,1))+256*ASC(MID$(d$(d%,i%),j%+15,1))
          ENDIF
          EXIT IF cl%
        NEXT j%
        EXIT IF cl%
      NEXT i%
      IF cl%=0
        ALERT 1," File not found! |",1," CONTINUE ",dummy%
      ENDIF
      IF cl%
        a$=""
        REPEAT
          sec%=&H19+cl%*8
          FOR i%=0 TO 7
            a$=a$+LEFT$(d$(d%,sec%+i%),len%)
          NEXT i%
          cl%=ASC(MID$(d$(d%,24),cl%+1,1))
        UNTIL cl%=&HFD
        '
        IF siz%<LEN(a$)
          FILESELECT CHR$(GEMDOS(25)+65)+":\*.*","",f$
          BSAVE f$,VARPTR(a$),siz%
        ELSE
          ALERT 1,"  Error:  | File too short!|",1," Tough! ",dummy%
        ENDIF
      ENDIF
    ENDIF
  ENDIF
RETURN
'
PROCEDURE std      !*** ST to Disk Copy ***
  d%=MENU(0)-46                             !Welke disk?
  IF df%(d%)=0                              !Is de disk geformatteerd?
    ALERT 1," Disk not formatted!|",1," CONTINUE ",dummy%
  ELSE
    OPENW 2*d%+1
    FILESELECT CHR$(GEMDOS(25)+65)+":\*.*","",f$ !Filenaam kiezen
    IF f$<>""
      IF LEFT$(f$,1)="\"
        f$=RIGHT$(f$,LEN(f$)-1)             !Filenaam corrigeren.
      ENDIF
      OPEN "I",#2,f$                        !File openen.
      siz%=LOF(#2)                          !Lengte ophalen.
      IF siz%>(len%/128)*80000              !Is de file te groot
        CLOSE #2                            !zo ja, file sluiten
        ALERT 1,"  File too large | for your ATARI !|",1," CANCEL ",dummy%
      ELSE
        CLR a$
        i%=INSTR(f$,".")                    !Filenaam formatteren.
        IF i%
          a$=MID$(f$,4,i%-4)+SPACE$(12-i%)+RIGHT$(f$,LEN(f$)-i%)+SPACE$(3-(LEN(f$)-i%))
        ELSE
          a$=f$+SPACE$(11-LEN(f$))
        ENDIF
        '
        IF df%(d%)=1
          ' ** Single Density **
          IF siz%>(len%-3)*(ASC(MID$(d$(d%,360),4,1))+256*ASC(MID$(d$(d%,360),5,1)))
            ALERT 1,"  File too large | for your disk!|",1," CANCEL ",dummy%
          ELSE
            CLR fil%,sec%
            FOR i%=361 TO 369                !vrije plaats in de directory zoeken.
              FOR j%=1 TO 113 STEP 16
                EXIT IF MID$(d$(d%,i%),j%,1)>CHR$(128) OR MID$(d$(d%,i%),j%,1)=CHR$(0)
                INC fil%
              NEXT j%
              EXIT IF MID$(d$(d%,i%),j%,1)>CHR$(128) OR MID$(d$(d%,i%),j%,1)=CHR$(0)
            NEXT i%
            @findfree(0)                                     !vrije sector zoeken.
            MID$(d$(d%,i%),j%,1)="B"                         !Status
            MID$(d$(d%,i%),j%+1,1)=CHR$(siz%/(len%-3)+0.99)       !Lengte LO
            MID$(d$(d%,i%),j%+2,1)=CHR$((siz%/(len%-3)+0.99)/256) !Lengte HI
            MID$(d$(d%,i%),j%+3,1)=CHR$(sec%)                !Sector LO
            MID$(d$(d%,i%),j%+4,1)=CHR$(sec%/256)            !Sector HI
            MID$(d$(d%,i%),j%+5,11)=a$                       !Filenaam invoegen
            @dosum(i%)                                       !en de checksum berekenen.
            FOR i%=1 TO siz%-(len%-3) STEP (len%-3)
              d$(d%,sec%)=INPUT$((len%-3),#2)                !sectoren inlesen.
              secold%=sec%
              @findfree(sec%)                                !Volgende vrije sector?
              d$(d%,secold%)=d$(d%,secold%)+CHR$(sec%/256+4*fil%)+CHR$(sec%)+CHR$((len%-3))
              @dosum(secold%)                                !Checksum berekenen.
            NEXT i%
            i%=siz% MOD (len%-3)                             !De rest in de laatste sector
            d$(d%,sec%)=INPUT$(i%,#2)+SPACE$((len%-3)-i%)+CHR$(fil%*4)+CHR$(0)+CHR$(i%)
            @dosum(sec%)                         !Checksum berekenen.
            ' ** VTOC korrigieren **
            sec%=360                                         !VTOC sector
            MID$(d$(d%,sec%),4,1)=CHR$(ASC(MID$(d$(d%,sec%),4,1))-(siz%/(len%-3)) AND 255)
            MID$(d$(d%,sec%),5,1)=CHR$(ASC(MID$(d$(d%,sec%),5,1))-INT(siz%/(len%-3)/256))
            @dosum(sec%)                                     !Checksum VTOC berekenen
          ENDIF    !SD File zu grož
          '
        ELSE
          ' ** Double Density ** ook hier weer hetzelfde verhaal.
          CLR j%
          FOR i%=1 TO 128
            IF MID$(d$(d%,24),i%,1)=CHR$(254)
              INC j%
            ENDIF
          NEXT i%
          IF siz%>j%*1024
            ALERT 1,"  File too large | for your disk!|",1," CANCEL ",dummy%
          ELSE
            sec%=0
            FOR i%=16 TO 24
              FOR j%=1-(i%=16)*16 TO 113 STEP 16
                EXIT IF MID$(d$(d%,i%),j%,1)=CHR$(128) OR MID$(d$(d%,i%),j%,1)=CHR$(0)
              NEXT j%
              EXIT IF MID$(d$(d%,i%),j%,1)=CHR$(128) OR MID$(d$(d%,i%),j%,1)=CHR$(0)
            NEXT i%
            @findfre2(0)
            MID$(d$(d%,i%),j%,1)=CHR$(&HC0)
            MID$(d$(d%,i%),j%+1,11)=a$
            MID$(d$(d%,i%),j%+12,1)=CHR$(siz%/1024+0.99)
            MID$(d$(d%,i%),j%+13,1)=CHR$(cl%)
            MID$(d$(d%,i%),j%+14,1)=CHR$(siz%)
            MID$(d$(d%,i%),j%+15,1)=CHR$(siz%/256)
            @dosum(i%)
            '
            FOR i%=1 TO siz% STEP 1024
              sec%=FN sec
              FOR j%=sec% TO sec%+7
                IF siz%>=len%
                  d$(d%,j%)=INPUT$(len%,#2)
                  siz%=siz%-len%
                ELSE
                  d$(d%,j%)=INPUT$(siz%,#2)
                ENDIF
                @dosum(j%)
                EXIT IF EOF(#2)
              NEXT j%
              EXIT IF EOF(#2)
              clold%=cl%
              INC cl%
              @findfre2(cl%)
              MID$(d$(d%,24),clold%+1,1)=CHR$(cl%)
            NEXT i%
            MID$(d$(d%,24),cl%+1,1)=CHR$(&HFD)
            sec%=24
            @dosum(sec%)
            '
          ENDIF
        ENDIF
        @dir      !Directory afdrukken
        CLOSE #2
      ENDIF
    ENDIF
  ENDIF
RETURN
'
PROCEDURE findfree(o%) !eerstvolgende vrije sector zoeken.
  LOCAL i%,j%
  CLR sec%
  FOR i%=11+o%/8 TO len%
    EXIT IF MID$(d$(d%,360),i%,1)>CHR$(0)     !vrij byte in VTOC zoeken.
  NEXT i%
  FOR j%=7 DOWNTO 0
    EXIT IF ASC(MID$(d$(d%,360),i%,1))>=2^j%  !In dit byte een vrij bit zoeken
  NEXT j%                                     !dit is nl. een vrijke sector.
  sec%=(i%-11)*8+(7-j%)                       !geef nu aan dat de sector bezet is.
  MID$(d$(d%,360),i%,1)=CHR$(ASC(MID$(d$(d%,360),i%,1))-2^j%)
RETURN
'
PROCEDURE findfre2(o%) !eerstvolgende vrije cluster in ED vinden
  FOR cl%=o% TO 128
    EXIT IF MID$(d$(d%,24),cl%+1,1)=CHR$(254) !Vrij cluster zoeken
  NEXT cl%
RETURN