Cls
Deffn Cl=(Sec%-25)/8
Deffn Sec=8*Cl%+25
Deftext 1,0,0,4
Dim Com%(5),Me$(60),D$(1050),Df%(1),D%(1),Su%(1050)
Open "",#1,"AUX:"
Null$=String$(128,0)
Ff$=String$(256,255)
Len%=128
@Initall
Restore
For I%=0 To 60
  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,""
Data Disk 2 ,  Directory,  Save Disk,  Load Disk,  Format SD,  Format ED,------------,  Set,""
Data Printer ,  Direct,  Buffer,  List,  Print Buffer,  Show Buffer
Data   Clear Buffer,  Save Buffer,---------------,  Set,""
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.
'
Closew 1
Titlew 1,"Disk 1"        !Window 1 = Disk 1
Infow 1,"-"
Closew 2
Titlew 2,"Printer"       !Window 2 = Printer
Infow 2,"-"
Closew 3
Titlew 3,"Disk 2"        !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 proceduren initializeren.
'
D%=Xbios(15,0,0,-1,-1,-1,-1) !Baudrate instellen op 19200 baud.
Menu 48,2
Menu 47,2
For I%=20 To 24          !De menu items van het Disk 1 menu
  Menu I%,2              !uitschakelen.
Next I%
D%(1)=0         !Disk 2: Aktief.
D%(0)=1
Sn%=0        !Show sector# als default niet aktief.
Menu 26,1    !Disk 2: 'Set' het 'haakje' ervoor zetten.
P%=1         !Printer: Aktief.
Menu 37,1    !Printer: 'Set' haakje ervoor.
Sh%=1        !sh%=1 printer output naar window, sh%=0 niet naar window
Menu 31,1    !Printer: 'List' 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("1") Or D%(0)=0) ! AND (c%<>ASC("2") 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("1")  !OR c%=ASC("2")  !Is het gekozen device een drive?
  ' ******************  Disk Routines  *******************
  D%=C%-Asc("0")-1          !Gekozen disk bepalen.
  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$(Sec%)+Chr$(Su%(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$(Sec%)=Input$(128,#1)  !128 Bytes ophalen.
    Else
      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 ?
        Pu$=Pu$+P$     !ja: Tekst naar de buffer!
      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)<19)    !geselecteerd is.
  On Menu(0) Gosub Info
  On Menu(0)-10 Gosub Dir,Sav,Loa,Fmtsd,Fmtdd,X,Setd
  On Menu(0)-19 Gosub Dir,Sav,Loa,Fmtsd,Fmtdd,X,Setd
  On Menu(0)-28 Gosub Direkt,Puffer,List,Prpuf,Shpuf,Clpuf,Sapuf,X,Setp
  On Menu(0)-39 Gosub Dst,Dst,X,Std,Std
  On Menu(0)-46 Gosub Set128,Set256,Shownr,X,Clw,Clw,Clw,Clw
  Menu Off
  If Menu(0)=57        !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)-50
  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 47,1         !'128 BpS' haakje
      Menu 48,0         !'256 BpS' haakje weghalen.
      Len%=128          !Lengtevariabele goed zetten.
      @Initall          !Disk opnieuw initializeren en leeg maken.
    Endif
  Endif
Return
Procedure Set256        !256 Bytes/sector instellen
  If Len%=128
    @Sure
    If Sure%=2
      Null$=String$(256,0)
      Menu 47,0         !De haakjes ook hier weer
      Menu 48,1         !goed zetten
      Len%=256
      @Initall
    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 Shownr        !Sectornummer aan/uit zetten.
  If Sn%                !als deze ingeschakeld is
    Sn%=0               !moet het uitgezet worden.
  Else
    Sn%=1               !anders inschakelen.
  Endif
  Menu 49,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$(O%)),L%) !Bereken het met de ML-routine.
  Su%(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$(I%),J%+5,1)=Chr$(0)   !Einde van de directory?
        If Mid$(D$(I%),J%,1)<Chr$(128)        !File gewist?
          D$=Mid$(D$(I%),J%+5,11)             !nee: Filename ophalen
          Print Left$(D$,8);".";Right$(D$,3)'''; !en afdrukken.
          Print Asc(Mid$(D$(I%),J%+2,1))*256+Asc(Mid$(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$(I%),J%+5,1)=Chr$(0) !Geen files meer.
    Next I%
    Print
    Fr%=(Asc(Mid$(D$(360),4,1))+256*Asc(Mid$(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$(I%),J%+1,1)=Chr$(0)
        If Mid$(D$(I%),J%,1)<>Chr$(128)
          D$=Mid$(D$(I%),J%+1,11)
          Print Left$(D$,8);".";Right$(D$,3)'''Asc(Mid$(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$(I%),J%+1,1)=Chr$(0)
    Next I%
    Print
    Clr J%
    For I%=1 To 128
      If Mid$(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
  D%=0
  @Init
  ' NEXT d%
Return
Procedure Init      !De eigenlijke wis routine.
  For J%=1 To 3
    D$(J%)=String$(128,0)        !Sectoren 1-3 altijd 128 Bytes
    Su%(J%)=0
  Next J%
  For J%=4 To 1050
    D$(J%)=String$(Len%,0)       !De hele string met 0 vullen
    Su%(J%)=0                    !de checksum natuurlijk ook.
  Next J%
  Openw D%*2+1
  Cls
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$(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$(J%)
        Su$=Chr$(Su%(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$(Sec%)=Input$(Len%,#2)    !Sektorinhoud en
          Su%(Sec%)=Asc(Input$(1,#2)) !de checksum inlezen uit de file
        Next Sec%
        For Sec%=1 To 3
          D$(Sec%)=Left$(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.
  If D%=0
    Wi=2*D%+1
    Openw Wi
    If D%(D%)              !Als de drive aktief is
      D%(D%)=0             !dan deaktiveren en
      Menu 17+9*D%,0       !het haakje verwijderen.
      Infow Wi," Inactive" !Nieuwe status van de drive aangeven.
      For I%=11+D%*9 To 15+D%*9
        Menu I%,2
      Next I%
    Else
      D%(D%)=1             !Anders de drive activeren
      Menu 17+9*D%,1       !en het haakje zetten
      For I%=11+D%*9 To 15+D%*9
        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$(360),1,5)=Chr$(2)+Chr$(&HC3)+Chr$(2)+Chr$(&HC3)+Chr$(2)
    Mid$(D$(360),11,1)=Chr$(15)
    Mid$(D$(360),12,89)=String$(89,255)
    Mid$(D$(360),56,2)=Chr$(0)+Chr$(&H7F)    !Dir. sectors zijn bezet
    Su%(360)=28                              !Checksum van VTOC goed zetten
    Df%(D%)=1              !Diskstatus: SD
    @Dinfo                 !en aangeven
  Endif
Return
'
Procedure Fmtdd            !* Disk ED formatteren *
  @Fmtsure
  If Sure%=1
    Mid$(D$(16),15,2)=Chr$(&H7E)+Chr$(&HA5)
    Su%(16)=36
    For I%=1 To 128
      Mid$(D$(24),I%)=Chr$(&HFE)
    Next I%
    Su%(24)=127
    Df%(D%)=2
    @Dinfo
  Endif
Return
'
Procedure Fmtsure          !Wilt u de disk formatteren?
  D%=1+(Menu(0)<19)        !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 29,0
    O=0
  Else
    Menu 29,1
    O=1
  Endif
  @Pinfo            !Status opnieuw aangeven.
Return
'
Procedure Puffer    !Buffer in/uitschakelen
  Openw 2
  Cls
  If Pu%=1
    Menu 30,0
    Pu%=0
    Pu$=""
  Else
    Menu 30,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$    !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$   !Schrijf de buffer weg.
      Close #2       !Close file.
    Endif
  Endif
Return
'
Procedure Shpuf      !Bufferinhoud afdrukken op het scherm.
  Openw 2
  Print Pu$
Return
'
Procedure Clpuf      !Buffer leegmaken.
  Pu$=""
Return
'
Procedure Setp       !Printer routines in/uitschakelen.
  If P%=1            !Als ze ingeschakeld zijn
    Menu 37,0        !Haakje weg en
    For I%=29 To 31
      Menu I%,2      !de menu items uitschakelen.
    Next I%
    P%=0
  Else
    Menu 37,1        !anders inschakelen,het haakje zetten en
    For I%=29 To 31
      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 31,0        !Afhankelijk van de situatie uit-
    Sh%=0
  Else
    Menu 31,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
'
' ****  Kopie‰r procedures  ****
'
Procedure Dst                               !*** Disk to ST Copy ***
  D%=Menu(0)-40                             !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$(I%),J%+5,11)=A$ And Mid$(D$(I%),J%,1)<>"C"
            Sec%=Asc(Mid$(D$(I%),J%+3,1))+Asc(Mid$(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$(Sec%),Len%-3)   !Sector in de buffer inlezen.
          Sec%=(Asc(Mid$(D$(Sec%),Len%-2,1)) And 3)*256+Asc(Mid$(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$(I%),J%+1,11)=A$ And Mid$(D$(I%),J%,1)<>Chr$(128)
            Cl%=Asc(Mid$(D$(I%),J%+13,1))
            Siz%=Asc(Mid$(D$(I%),J%+14,1))+256*Asc(Mid$(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$(Sec%+I%),Len%)
          Next I%
          Cl%=Asc(Mid$(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)-43                             !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$=Left$(F$,I%-1)+Space$(9-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$(360),4,1))+256*Asc(Mid$(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$(I%),J%,1)>Chr$(128) Or Mid$(D$(I%),J%,1)=Chr$(0)
                Inc Fil%
              Next J%
              Exit If Mid$(D$(I%),J%,1)>Chr$(128) Or Mid$(D$(I%),J%,1)=Chr$(0)
            Next I%
            @Findfree(0)                                     !vrije sector zoeken.
            Mid$(D$(I%),J%,1)="B"                         !Status
            Mid$(D$(I%),J%+1,1)=Chr$(Siz%/(Len%-3)+0.99)       !Lengte LO
            Mid$(D$(I%),J%+2,1)=Chr$((Siz%/(Len%-3)+0.99)/256) !Lengte HI
            Mid$(D$(I%),J%+3,1)=Chr$(Sec%)                !Sector LO
            Mid$(D$(I%),J%+4,1)=Chr$(Sec%/256)            !Sector HI
            Mid$(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$(Sec%)=Input$((Len%-3),#2)                !sectoren inlesen.
              Secold%=Sec%
              @Findfree(Sec%)                                !Volgende vrije sector?
              D$(Secold%)=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$(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$(Sec%),4,1)=Chr$(Asc(Mid$(D$(Sec%),4,1))-(Siz%/(Len%-3)) And 255)
            Mid$(D$(Sec%),5,1)=Chr$(Asc(Mid$(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$(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$(I%),J%,1)=Chr$(128) Or Mid$(D$(I%),J%,1)=Chr$(0)
              Next J%
              Exit If Mid$(D$(I%),J%,1)=Chr$(128) Or Mid$(D$(I%),J%,1)=Chr$(0)
            Next I%
            @Findfre2(0)
            Mid$(D$(I%),J%,1)=Chr$(&HC0)
            Mid$(D$(I%),J%+1,11)=A$
            Mid$(D$(I%),J%+12,1)=Chr$(Siz%/1024+0.99)
            Mid$(D$(I%),J%+13,1)=Chr$(Cl%)
            Mid$(D$(I%),J%+14,1)=Chr$(Siz%)
            Mid$(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$(J%)=Input$(Len%,#2)
                  Siz%=Siz%-Len%
                Else
                  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$(24),Clold%+1,1)=Chr$(Cl%)
            Next I%
            Mid$(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$(360),I%,1)>Chr$(0)     !vrij byte in VTOC zoeken.
  Next I%
  For J%=7 Downto 0
    Exit If Asc(Mid$(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$(360),I%,1)=Chr$(Asc(Mid$(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$(24),Cl%+1,1)=Chr$(254) !Vrij cluster zoeken
  Next Cl%
Return