'* -------------------------------------------------------- *
'*                    A D S Version 1.0a                    *
'*                   --------------------                   *
'*                A D S  © 1994 by Testaware                *
'*  The Amos Disk Squasher  ® 10/03/94 by Volker Stepprath  *
'* -------------------------------------------------------- *
'
Set Buffer 50
XCL$=Command Line$+"-"
Break Off 
Fix 2
'
Global XDFN$,XDFN,XFILE$,XDISKREPLY,XMODUS,XHANDLE
Global XDISKREPLY$,XDEVICENAME$,IOREQ$,IOEXTTD0
Global XE,XT,XV,XA,XM,XC,XREAD$
'
Proc _CHECKLINE[XCL$]
Proc _CONOPEN
'
Reserve As Chip Data 7,90112
XREAD$=String$(Chr$(0),256)
XDISKREPLY$=String$(Chr$(0),41)
XDEVICENAME$="trackdisk.device"+Chr$(0)
XDISKREPLY=Varptr(XDISKREPLY$)
IOREQ$=String$(Chr$(0),81)
IOEXTTD0=Varptr(IOREQ$)
'
Proc _OPENDEVICE
If XM Then Proc _MEMCHECK
On XMODUS+1 Proc _DISKTOFILE,_FILETODISK
Proc _CLOSEDEVICE
'
Procedure _DISKTOFILE
   LF$=Chr$(10)
   '
   '* ADS File öffnen und makieren *
   '--------------------------------
   Dreg(1)=Varptr(XFILE$)
   Dreg(2)=1006
   LVOOPEN=Doscall(-30)
   '
   If LVOOPEN=0
      LVOIOERR=Doscall(-132)
      Proc _CONREAD[LF$+"I/O Error occurred - Error code"+Str$(LVOIOERR)]
      Pop Proc
   End If 
   '
   XADS2$="ADS2"+String$(Chr$(0),40)
   Dreg(1)=LVOOPEN
   Dreg(2)=Varptr(XADS2$)
   Dreg(3)=44
   LVOWRITE=Doscall(-48)
   '
   XTB=901120
   '
   Proc _CONWRITE[LF$+"Tracks to go...: 159"+LF$]
   Proc _CONWRITE["Tracks gained..: 0% (0 bytes)"+LF$]
   Proc _CONWRITE["Tracks out.....: 0% (0 bytes)"+LF$]
   Proc _CONWRITE["Disk gained....: 0% (0 bytes)"+LF$]
   Proc _CONWRITE["Filelength.....: 0 of 0 bytes"+LF$]
   Proc _CONWRITE[String$(Chr$(11),5)]
   Wait 5
   '
   XT$=Chr$(9)+Chr$(9)
   Timer=0
   '
   For I=0 To 9
      '
      Gosub _READTRACKS
      Proc _CONWRITE[XT$+Str$(160-(I*16+16))+" "+LF$]
      '
      If XT=False Then LVOFORBID=Execall(-132)
      '
      XPACK=4
      N=Leek(Start(7))
      For I2=Start(7) To Start(7)+90108 Step 4
         If Leek(I2)<>N
            XPACK=Squash(Start(7),90112,-1,XE,XC)
            Exit 
         End If 
      Next I2
      '
      If XT=False Then LVOPERMIT=Execall(-138)
      '
      Exit If Amos Here
      '
      If XPACK<1 Then Gosub _READTRACKS : XPACK=90112
      If XPACK=4 Then Loke Start(7),N
      '
      '* Offsets fÜr UnSquash installieren * 
      '------------------------------------- 
      Loke Varptr(XADS2$)+I*4+4,XPACK
      '
      '* Statistiken * 
      '--------------- 
      Add XLENGTH,XPACK : N#=Min(99.99,100.0-((100.0/90112)*XPACK))
      Proc _CONWRITE[XT$+Str$(N#)+"%"+" ("+Str$(90112-XPACK)-" "+" bytes)       "+LF$]
      Proc _CONWRITE[XT$+Str$(Max(0.01,100.0-N#))+"% ("+Str$(XPACK)-" "+" bytes)       "+LF$]
      Add XTB,-(90112-XPACK) : N#=Min(99.99,100.0-((100.0/901164)*XTB))
      Proc _CONWRITE[XT$+Str$(N#)+"%"+" ("+Str$(901120-XTB)-" "+" bytes)"+LF$]
      Proc _CONWRITE[XT$+Str$(XLENGTH+44)+" of"+Str$(I*90112+90112)+" bytes"+LF$]
      Proc _CONWRITE[String$(Chr$(11),5)]
      '
      '* Gepackte Daten in File schreiben *
      '------------------------------------
      Dreg(1)=LVOOPEN
      Dreg(2)=Start(7)
      Dreg(3)=XPACK
      LVOWRITE=Doscall(-48)
      '
      '* Fehler beim schreiben aufgetreten ? * 
      '--------------------------------------- 
      If LVOWRITE<>XPACK
         LVOIOERR=Doscall(-132)
         Proc _FLASH
         Proc _CONWRITE[String$(LF$,6)+Space$(50)+LF$+Chr$(11)]
         Proc _CONWRITE["I/O Error occurred - Error code"+Str$(LVOIOERR)+LF$]
         Proc _CONWRITE[String$(Chr$(11),7)]
         Exit 
      End If 
      '
      Wait 200
      '
      Next I
   '
_C:
   '* ADS File schließen *
   '----------------------
   Dreg(1)=LVOOPEN
   LVOCLOSE=Doscall(-36)
   '
   _CONWRITE[String$(LF$,8)]
   _CONWRITE["Operation SQUASHING finished !"]
   If Amos Here=False and LVOWRITE=XPACK
      Open Random 1,XFILE$
      Field 1,44 As N$
      N$=XADS2$
      Put 1,1
      Close 1
      N$=Chr$($9B)+"33mADS squashed diskdata ® by Volker Stepprath of Testaware !"+Chr$($9B)+"0m"+Chr$(0)
      XFILE$=XFILE$+Chr$(0)
      Dreg(1)=Varptr(XFILE$)
      Dreg(2)=Varptr(N$)
      LVOSETCOMMENT=Doscall(-180)
   Else 
      Amos To Back 
      Kill XFILE$
      Proc _CONWRITE[LF$+LF$+XFILE$+" removed !"]
   End If 
   '
   Proc _TIME[LF$+LF$]
   '
   Pop Proc
   '
_READTRACKS:
   '* CMD_READ aufrufen * 
   '--------------------- 
   Doke IOEXTTD0+28,2
   Loke IOEXTTD0+36,90112
   Loke IOEXTTD0+40,Start(7)
   Loke IOEXTTD0+44,I*90112
   Areg(1)=IOEXTTD0
   LVODOIO=Execall(-456)
   '
   '* Fehler aufgetreten ? *
   '------------------------
   If LVODOIO<>0
      Proc _FLASH
      Proc _CONWRITE[String$(LF$,6)+Space$(50)+LF$+Chr$(11)]
      Proc _CONREAD["TD Error #"+Str$(LVODOIO)-" "+" occurred... Abort y/n ?: "]
      Proc _CONWRITE[String$(Chr$(11),7)]
      If Asc(Upper$(XREAD$))=89
         LVOWRITE=True
         Pop 
         Goto _C
      End If 
   End If 
   Proc _TD_MOTOR
   Return 
End Proc
Procedure _FILETODISK
   Dim XADS2(9)
   LF$=Chr$(10)
   '
   '* ADS File öffnen und Offsets ermitteln * 
   '----------------------------------------- 
   Dreg(1)=Varptr(XFILE$)
   Dreg(2)=1005
   LVOOPEN=Doscall(-30)
   '
   '* Ist beim Öffnen ein Fehler aufgetreten *
   '------------------------------------------
   If LVOOPEN=0
      LVOIOERR=Doscall(-132)
      Proc _CONREAD[LF$+"I/O Error occurred - Error code"+Str$(LVOIOERR)]
      Pop Proc
   End If 
   '
   '* Maskierung ermitteln *
   '------------------------
   Dreg(1)=LVOOPEN
   Dreg(2)=Start(7)
   Dreg(3)=44
   LVOREAD=Doscall(-42)
   '
   '* Erster Eintrag <> ADS2 ? *
   '----------------------------
   If Leek(Start(7))<>$41445332
      Proc _CONWRITE[LF$+XFILE$+" is no ADS squashed datafile !"]
      Goto _BYE
   End If 
   '
   '* Offsets fÜr Unsquash ermitteln *
   '----------------------------------
   For I=1 To 10
      XADS2(I-1)=Leek(Start(7)+I*4)
   Next I
   '
   XTB=901120
   '
   Proc _CONWRITE[LF$+"Installed tracks: 0"+LF$]
   '
   '* Parameter -V1 Übergeben ? * 
   '----------------------------- 
   If XV
      Proc _CONWRITE["Verify track    : 0"+LF$]
      Proc _CONWRITE["Occurred errors : 0"+LF$+String$(Chr$(11),3)]
   Else 
      Proc _CONWRITE[Chr$(11)]
   End If 
   '
   Timer=0
   '
   For I=0 To 9
      '
      Exit If Amos Here
      '
      '* Gepackte Daten installieren * 
      '------------------------------- 
      Dreg(1)=LVOOPEN
      Dreg(2)=Start(7)
      Dreg(3)=XADS2(I)
      LVOREAD=Doscall(-42)
      '
      '* Daten entpacken !? *
      '----------------------
      If XADS2(I)<90112 and XADS2(I)>4
         XPACK=Unsquash(Start(7),XADS2(I))
      End If 
      If XADS2(I)=4 Then Fill Start(7) To Start(7)+90112,Leek(Start(7))
      '  
      Exit If Amos Here
      '
      '* TD_FORMAT aufrufen *  
      '----------------------  
      Doke IOEXTTD0+28,11
      Loke IOEXTTD0+36,90112
      Loke IOEXTTD0+40,Start(7)
      Loke IOEXTTD0+44,I*90112
      Areg(1)=IOEXTTD0
      LVODOIO=Execall(-456)
      '
      Proc _CONWRITE["Installed tracks:"+Str$(I*16+15)+LF$+Chr$(11)]
      '
      '* Tracks verifizieren ? * 
      '------------------------- 
      If XV
         Proc _CONWRITE[LF$]
         For I2=I*16 To I*16+15
            '
            Proc _CONWRITE["Verify track    :"+Str$(I2)+" "+LF$+Chr$(11)]
            Doke IOEXTTD0+28,2
            Loke IOEXTTD0+36,5632
            Loke IOEXTTD0+40,Start(7)
            Loke IOEXTTD0+44,I2*5632
            Areg(1)=IOEXTTD0
            LVODOIO=Execall(-456)
            '
            '* Ist Trackdisk-Error aufgetreten ? * 
            '------------------------------------- 
            If LVODOIO<>0
               Inc E
               Proc _FLASH
               Proc _CONWRITE[LF$+"Occurred errors :"+Str$(E)+LF$+LF$]
               Proc _CONWRITE[Space$(50)+LF$+Chr$(11)]
               Proc _CONREAD["TD Error #"+Str$(LVODOIO)-" "+" on track"+Str$(I2)+"... Abort y/n ?: "]
               Proc _CONWRITE[LF$+String$(Chr$(11),5)]
               Exit If Asc(Upper$(XREAD$))=89,2
            End If 
            '
         Next I2
         Proc _CONWRITE[Chr$(11)]
      End If 
      '
      Proc _TD_MOTOR
      '
   Next I
   '
_BYE:
   Amos To Back 
   Proc _TD_MOTOR
   Dreg(1)=LVOOPEN
   LVOCLOSE=Doscall(-36)
   Proc _CONWRITE[String$(LF$,7)]
   Proc _CONWRITE["Operation UNSQUASHING finished !"]
   Proc _TIME[LF$+LF$]
End Proc
Procedure _TD_MOTOR
   '* TD_MOTOR aus *
   '----------------
   Doke IOEXTTD0+28,9
   Loke IOEXTTD0+36,0
   Areg(1)=IOEXTTD0
   LVODOIO=Execall(-456)
End Proc
Procedure _OPENDEVICE
   Proc _CONREAD[Chr$(10)+"Please insert disks press RETURN when ready:"]
   '
   '* Eigene Taskadresse suchen * 
   '----------------------------- 
   Areg(0)=0
   Areg(1)=0
   Dreg(0)=0
   Dreg(1)=0
   LVOFINDTASK=Execall(-294)
   Loke XDISKREPLY+16,LVOFINDTASK
   '
   '* trackdisk.device öffnen * 
   '--------------------------- 
   Areg(0)=Varptr(XDEVICENAME$)
   Areg(1)=IOEXTTD0
   Dreg(0)=XDFN
   LVOOPENDEVICE=Execall(-444)
   '
   '* Eigene Taskadresse installieren * 
   '----------------------------------- 
   Loke IOEXTTD0+14,XDISKREPLY
   '
   '* Ist Diskette eingelegt oder schreibgeschÜtzt !? * 
   '--------------------------------------------------- 
   Doke IOEXTTD0+28,14
   Areg(1)=IOEXTTD0
   LVODOIO=Execall(-456)
   If Leek(IOEXTTD0+32)<>0
      Proc _CONREAD[Chr$(10)+"No disk in df0: !"]
      Proc _CLOSEDEVICE
   End If 
   If XMODUS=1
      Doke IOEXTTD0+28,15
      Areg(1)=IOEXTTD0
      LVODOIO=Execall(-456)
      If Leek(IOEXTTD0+32)<>0
         Proc _CONREAD[Chr$(10)+"Disk in "+XDFN$+" is write protected !"]
         Proc _CLOSEDEVICE
      End If 
   End If 
   '
End Proc
Procedure _CLOSEDEVICE
   '* TD_SEEK auf Track 0 * 
   '----------------------- 
   Doke IOEXTTD0+28,10
   Loke IOEXTTD0+44,0
   LVODOIO=Execall(-456)
   '
   Proc _TD_MOTOR
   '
   '* trackdisk.device schließen *
   '------------------------------
   Areg(1)=IOEXTTD0
   LVOCLOSEDEVICE=Execall(-450)
   '
   Erase 7
   Proc _CONCLOSE
   Request On 
   End 
End Proc
Procedure _TIME[N$]
   N=Timer
   S=N/50
   M=S/60
   S=S-M*60
   H=M/60
   M=M mod 60
   H$=String$("0",2-(Len(Str$(H))-1))+Str$(H)-" "
   M$=String$("0",2-(Len(Str$(M))-1))+Str$(M)-" "
   S$=String$("0",2-(Len(Str$(S))-1))+Str$(S)-" "
   _CONREAD[N$+"Elapsed time : "+H$+":"+M$+":"+S$]
End Proc
Procedure _CHECKLINE[XCL$]
   N$=Upper$(XCL$)
   If Len(N$)<10 Then Goto _FEHLER
   '
   XERROR=True
   N=Instr(N$,"-R")
   If N Then XMODUS=0
   N=Instr(N$,"-W")
   If N Then XMODUS=1
   A$=Mid$(N$,3,4)
   If A$="DF0:" : XDFN=0 : XERROR=False : End If 
   If A$="DF1:" : XDFN=1 : XERROR=False : End If 
   If A$="DF2:" : XDFN=2 : XERROR=False : End If 
   If A$="DF3:" : XDFN=3 : XERROR=False : End If 
   XDFN$=A$
   If XERROR=True Then Goto _FEHLER
   If Drive(XDFN$)=False
      Open Out 1,"*"
      Print #1,"Drive not available !"
      Close 1
      End 
   End If 
   '
   N=Instr(N$,"-F")
   If N=0 Then Goto _FEHLER
   N=N+Varptr(XCL$)+1
   Do 
      A=Peek(N)
      Exit If A=45 or A=32
      XFILE$=XFILE$+Chr$(A)
      Inc N
   Loop 
   XFILE$=XFILE$-"-"+Chr$(0)
   '
   '* Effizienz fÜr Squash *
   '------------------------
   N=Instr(N$,"-E")
   If N Then XE=Min(3,Max(0,Peek(Varptr(N$)+N+1)-48))
   If XE=0 Then XE=256
   If XE=1 Then XE=512
   If XE=2 Then XE=1024
   If XE=3 Then XE=2048
   '
   '* Task-Rescheduling verbieten ? * 
   '--------------------------------- 
   XT=1
   N=Instr(N$,"-T")
   If N Then XT=Max(0,Peek(Varptr(N$)+N+1)-48)
   '
   '* Tracks verifizieren ? * 
   '------------------------- 
   N=Instr(N$,"-V")
   If N Then XV=Max(0,Peek(Varptr(N$)+N+1)-48)
   '
   '* Requester ausschalten ? * 
   '--------------------------- 
   N=Instr(N$,"-A")
   If N Then XA=Max(0,Peek(Varptr(N$)+N+1)-48)
   If XA<1 and N>0 Then Request Off 
   '
   '* Memory nach Vieren durchsuchen ? *
   '------------------------------------
   N=Instr(N$,"-M")
   If N Then XM=Max(0,Peek(Varptr(N$)+N+1)-48)
   '
   '* Farbe fÜr Squash ? *
   '----------------------
   N=Instr(N$,"-C")
   If N Then XC=Min(3,Max(0,Peek(Varptr(N$)+N+1)-48)) Else XC=17
   '
   Pop Proc
   '
_FEHLER:
   Open Out 1,"*"
   For I=1 To 28
      Read N$
      Print #1,N$
   Next I
   Close 1
   End 
   Data ""
   Data "Usage: "+Chr$($9B)+"33mADS"+Chr$($9B)+"0m -Rdfn: or -Wdfn: -Ffile [options]"
   Data ""
   Data "   -Rdfn:  Reads & compress a disk to a file"
   Data "   -Wdfn:  Decompress & installs an ADS file on disk"
   Data "   -Ffile  ADS datafilename for out- or input"
   Data ""
   Data "Options are:"
   Data "   -e0     Fast compress (default)"
   Data "   -e1     Mediocre compress"
   Data "   -e2     Good compress"
   Data "   -e3     Best compress (take a little time)"
   Data "   -t0     Turn off multitasking (spare time)"
   Data "   -t1     Turn on multitasking (default)"
   Data "   -v0     Verify tracks off (default)"
   Data "   -v1     Verify tracks on"
   Data "   -a0     Turn off AlertRequester"
   Data "   -a1     Turn on AlertRequester (default)"
   Data "   -m0     Virus memcheck off (default)"
   Data "   -m1     Virus memcheck on"
   Data "   -c0     Flashcolour 0"
   Data "   -c1     Flashcolour 1"
   Data "   -c2     Flashcolour 2"
   Data "   -c3     Flashcolour 3"
   Data "   -c4     Flashcolour mousepointer (default)"+Chr$(10)
   Data "This version is SHARE WARE please refer the docfile !"
   Data "ADS V1.0a was written using Fran"+Chr$(231)+"ois Lionet's A M O S"
   Data ""
End Proc
Procedure _CONWRITE[N$]
   Dreg(1)=XHANDLE
   Dreg(2)=Varptr(N$)
   Dreg(3)=Len(N$)
   LVOWRITE=Doscall(-48)
End Proc
Procedure _CONREAD[N$]
   Proc _CONWRITE[N$]
   Dreg(1)=XHANDLE
   Dreg(2)=Varptr(XREAD$)
   Dreg(3)=256
   LVOREAD=Doscall(-42)
End Proc
Procedure _CONOPEN
   XFENSTER$="CON:0/0/640/200/ADS"+Chr$(0)
   Dreg(1)=Varptr(XFENSTER$)
   Dreg(2)=1006
   LVOOPENCON=Doscall(-30)
   If LVOOPENCON=0 Then End 
   XHANDLE=LVOOPENCON
   '
   N$=Chr$(9)
   _CONWRITE[Chr$(10)+N$+N$+N$+Chr$($9B)+"33m   A D S  "+Chr$($9B)+"32mVersion 1.0a"+Chr$($9B)+"0m"+Chr$(10)+Chr$(10)]
   _CONWRITE[N$+"  The Amos Disk Squasher ® 10/03/94 by Volker Stepprath"+Chr$(10)]
   _CONWRITE[N$+"  This product is SHARE WARE please refer the docfile !"+Chr$(10)]
End Proc
Procedure _CONCLOSE
   Dreg(1)=XHANDLE
   LVOCLOSE=Doscall(-36)
End Proc
Procedure _MEMCHECK
   Proc _CONWRITE[Chr$(10)]
   XEXECBASE=Leek(4)
   For I=1 To 6
      Read N$,N
      N=Leek(XEXECBASE+N)
      If N<>0
         I2=True
         _CONREAD[N$+" is abnormal ("+Hex$(N,8)+")... Clear system y/n ?: "]
         If Left$(Upper$(XREAD$),1)="Y"
            Restore _RESET
            For I=1 To 88
               Read N
               C$=C$+Chr$(N)
            Next 
            Call Varptr(C$)
         End If 
      End If 
   Next I
   If I2=False Then _CONWRITE["No virus found !"+Chr$(10)]
   '
   Data "ColdCapture",$2A
   Data "CoolCapture",$2E
   Data "WarmCapture",$32
   Data "KickMemPtr ",$222
   Data "KickTagPtr ",$226
   Data "KickChekSum",$22A
   '
_RESET:
   Data 51,252,64,0,0,223,240,154,44,121,0,0,0,4,34,60,170,170
   Data 187,187,45,65,0,36,45,65,0,38,45,65,0,62,45,65,0,78
   Data 45,65,0,82,45,65,2,42,12,110,0,36,0,20,109,4,78,238
   Data 253,42,75,250,0,8,78,174,255,226,0,0,32,124,1,0,0,0
   Data 145,232,255,236,32,104,0,4,85,136,78,112,78,208,0,0
End Proc
Procedure _FLASH
   Proc _TD_MOTOR
   For I=$FFF To 0 Step -2
      Doke $DFF180,I
   Next I
End Proc