'-------------------------------------------------- ' AMOSCopy V3.23 ' AMOSCopy © 2002 by Testaware ' AMOSCopy ® 10-03-02 01:26:09 by Volker Stepprath 'Source was written using AMOSPro_Explode.Lib V2.00 '-------------------------------------------------- Set Buffer 40 Break Off Request Off Key Speed 12,1 Fix(2) Dim XDRV(3) Global XT$,XN$,XE$,XFN$,XPW$,XACD$ Global XDRV(),XSTP,XDI,XFX,XMU,XVC,XCT,XFN,XFQ,XMF,XCD,XRC,XVFY,XLOW,XUPP,XMAB,XMEN,XOPT Reserve As Work 10,160 Reserve As Chip Work 7,5632 Trap Screen Close False Proc _TDDEVSOPEN Proc _PREFSDFLT Proc _PREFSLOAD Proc _INSTALLAC Proc _UPDATEAC Proc _MAINLOOP Procedure _MAINLOOP Ink 1,0 Timer=False Every 50 Proc _SYSTIME : _SYSTIME Amos To Front If XPW$<>"" Every Off Do _I["Password:",""] If XE$<>XPW$ _EXIT Else Exit End If Loop Ink 1,False _SYSTIME End If Do Clear Key Wait 10 Ink 1,False Timer=Timer+T _SYSTIME XSTP=False Repeat If Amos Here M=Mouse Key N=Asc(Inkey$) Else Every Off Repeat Multi Wait Until Amos Here Every On End If Until M or N Every Off T=Timer Timer=False X=X Screen(X Mouse) Y=Y Screen(Y Mouse) 'Symbol Gadgets If X>7 and X<97 and Y>3 and Y<16 X=(X-8)/30 _G[8+X*30,4,37+X*30,15,True] Request On If X=False _EXIT Else If X=1 Wait 10 Amos To Back Repeat Multi Wait Until Amos Here Else If X=2 _ICONIFY End If Request Off _G[8+X*30,4,37+X*30,15,False] End If 'Source & Target If X>25 and X<201 and Y>50 and Y<64 or X>25 and X<201 and Y>87 and Y<101 X=(X-26)/44 If Y<65 If XDRV(X)=False XDRV(X)=1 Else If XDRV(X)=1 XDRV(X)=False Else If XDRV(X)=2 XDRV(X)=3 Else If XDRV(X)=3 XDRV(X)=2 End If Else If XDRV(X)=False XDRV(X)=2 Else If XDRV(X)=1 XDRV(X)=3 Else If XDRV(X)=2 XDRV(X)=False Else If XDRV(X)=3 XDRV(X)=1 End If End If _SELECTDRIVES End If If Y>114 and Y<128 'DI Diskinterrupt If X>15 and X<40 _TOOLS[False] 'VC Viruscheck Else If X>39 and X<64 _TOOLS[4] 'WB Workbench Else If X>63 and X<88 _TOOLS[3] 'RM Restore memory Else If X>87 and X<112 _TOOLS[5] 'RC Repeat copy Else If X>111 and X<136 _TOOLS[15] Else If X>140 and X<207 _G[141,115,206,127,True] _TOOLS[True] _G[141,115,206,127,False] End If End If 'AMOSCopy TrackMap If X>15 and X<67 and Y>131 and Y<162 _TRKMN 'Verify Else If X>74 and X<141 and Y>131 and Y<145 Add XVFY,1,False To 1 _G[75,132,140,144,XVFY] 'Bitmap selektieren Else If X>242 and X<631 and Y>44 and Y<149 If M=1 : A=1 : B=False Else A=False : B=1 : End If Repeat X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If Y>44 and Y<149 If X>242 and X<423 X=(X-243)/18 Y=(Y-45)/13 N=(Y*10+X)*2 Cls A*5,245+X*18,46+Y*13 To 259+X*18,57+Y*13 _G[243+X*18,45+Y*13,260+X*18,57+Y*13,B] Else If X>450 and X<631 X=(X-451)/18 Y=(Y-45)/13 N=(Y*10+X)*2+1 Cls A*5,453+X*18,46+Y*13 To 467+X*18,57+Y*13 _G[451+X*18,45+Y*13,468+X*18,57+Y*13,B] End If Poke Start(10)+N,B Doke Start(7),N*11 Doke Start(7)+2,N*11+10 _N[347+(N mod 2)*208,157,Format$("%4d-%-4d",Start(7)),False] End If Until Mouse Key=False End If 'Bitmaps einstellen If Y>152 and Y<166 'On If X>242 and X<272 Add XLOW,1,False To 1 _G[243,153,271,165,XLOW] Else If X>450 and X<480 Add XUPP,1,False To 1 _G[451,153,479,165,XUPP] 'Clr Else If X>271 and X<309 _G[272,153,308,165,True] For I=False To 158 Step 2 : Bset False,Start(10)+I : Next _BITMAP[1] _G[272,153,308,165,False] Else If X>479 and X<517 _G[480,153,516,165,True] For I=1 To 159 Step 2 : Bset False,Start(10)+I : Next _BITMAP[True] _G[480,153,516,165,False] 'Swp Else If X>308 and X<344 _G[309,153,343,165,True] For I=False To 158 Step 2 : Bchg False,Start(10)+I : Next _BITMAP[1] _G[309,153,343,165,False] Else If X>516 and X<552 _G[517,153,551,165,True] For I=1 To 159 Step 2 : Bchg False,Start(10)+I : Next _BITMAP[True] _G[517,153,551,165,False] End If End If 'Menüitems einstellen If X>522 and X<613 and Y>169 and Y<183 XMEN=((X-523)/18)+1 : X=False _MENU 'Menüebene Else If X>613 and X<632 and Y>169 and Y<183 _G[613,170,630,182,True] Add XMAB,1,False To 1 XMEN=1 XOPT=1 _MENU 'Option Else If X>7 and X<523 and Y>169 and Y<183 _G[8+(XOPT-1)*103,170,7+XOPT*103,182,False] XOPT=((X-8)/103)+1 _G[8+(XOPT-1)*103,170,7+XOPT*103,182,True] End If 'Option starten If X>74 and X<141 and Y>148 and Y<162 _G[75,149,140,161,True] _O[""] _VIRUSTEST[True] If XSTP=False _SEEKMOTOR If XCT : _BITMAP[False] : End If Timer=False _TIME If XMEN=1 If XMAB=False On XOPT Proc _DOSCOPY,_BAMCOPY,_FORMAT,_BFORMAT,_QFORMAT Else On XOPT Proc _BITMAPEDIT,_CALCBITMAP,_SHOWBITMAP,_SETBITMAP,_TRACKMAP End If Else If XMEN=2 If XMAB=False On XOPT Proc _ERASE,_CHECKDISK,_COMPARE,_INSTALL,_BOOTTOLIB Else On XOPT Proc _FILESECLAB,_SECLABFILE,_NOTESECLAB,_SHOWSECLAB,_CLRSECLAB End If Else If XMEN=3 If XMAB=False On XOPT Proc _CLEANDISK,_PACKDISK,_DEPACK,_CRYPTDISK,_DECRYPT Else On XOPT Proc _DISKINFO,_SHOWDIR,_RELABEL,_REPAIR,_KILLFILE End If Else If XMEN=4 If XMAB=False On XOPT Proc _BLKTOFILE,_FILETOBLK,_DSKTOFILE,_FILETODSK,_BOOTMENU Else On XOPT Proc _CLI,_ABOUT,_ICONIFY,_EXIT,_HARDRESET End If Else If XMEN=5 If XMAB=False On XOPT Proc _BLOCKEDIT,_SEARCH,_PLAYBLOCK,_VIEWBLOCK,_SCANIFF Else On XOPT Proc _X,_X,_X,_X,_X End If End If _TIME _MOTOROFF _SEEKMOTOR _VIRUSTEST[False] End If _G[75,149,140,161,False] _SFX If XSTP : _O["Process Aborted!"] : End If Erase 8 _G[141,149,206,161,False] End If Clear Key Clear Mouse Loop End Proc Procedure _DOSCOPY For I=False To 3 If XDRV(I)=1 or XDRV(I)=3 Then Inc N : XSOURCE=I Next If N<>1 Then _ACERR[9] : Pop Proc If XDRV(XSOURCE)=3 Then _DOSCOPY2 : Pop Proc For I=False To 3 If XDRV(I)>False _DISKINSERT[I] : Exit If Param If XDRV(I)>1 _PROTECTION[I] : Exit If Param End If End If Next If Param Then Pop Proc Reserve As Chip Work 8,5632 For A=False To 159 _TRKON[A] Exit If Param Next If Param=False Then Pop Proc B=A Timer=False Gosub _DCA Do Exit If XOK=False Dev Abort(XSOURCE) : _TRKCK[XSOURCE,A] : Exit If Param B=A Inc A Copy Start(7),Finish(7) To Start(8) For XDFN=False To 3 If XDRV(XDFN)>1 Then _TRKSD[XDFN,B,5632,Start(8),11] Next Gosub _DCA For XDFN=False To 3 If XDRV(XDFN)>1 Then Dev Abort(XDFN) Next If XVFY For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,B,5632,Start(8),2] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,B] : Exit If Param,2 End If Next End If If Mouse Key Then _ABORT : Exit If Param Loop Pop Proc _DCA: XOK=False Do Exit If A>159 _TRKON[A] If Param Then _TRKSD[XSOURCE,A,5632,Start(7),2] : XOK=True : Exit Inc A Loop Return End Proc Procedure _DOSCOPY2 For I=False To 3 If XDRV(I)=3 Then XSOURCE=I Next For XTRK=160 To False Step True Trap Reserve As Work 8,XTRK*5632 Exit If Errtrap=False Next A=False If XRC=False Then G=True Timer=False Repeat _R["Insert Sourcedisk In DF"+Chr$(48+XSOURCE)+":","",True] _DISKINSERT[XSOURCE] : Exit If Param B=False Repeat _TRKON[A] If Param _TRKSD[XSOURCE,A,5632,Start(7),2] Dev Abort(XSOURCE) : _TRKCK[XSOURCE,A] : Exit If Param,2 Copy Start(7),Finish(7) To Start(8)+B*5632 _1[A,False] Inc B End If If Mouse Key Then _ABORT : Exit If Param,2 Inc A Until A=160 or B=XTRK _SEEKMOTOR _MOTOROFF _TIME E=D : Rem * Für Repeat copy Repeat _R["Insert Targetdisk!","",True] _DISKTEST : Exit If Param,2 C=False If G>True For I=D To A-1 _TRKON[I] If Param : _1[I,False] : End If Next End If Repeat _TRKON[D] If Param Copy Start(8)+C*5632,Start(8)+(C+1)*5632 To Start(7) For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,D,5632,Start(7),11] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,D] : Exit If Param,3 End If Next If XVFY For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,D,5632,Start(7),2] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,D] : Exit If Param,4 End If Next End If Inc C End If If Mouse Key Then _ABORT : Exit If Param,3 Inc D Until D=A _SEEKMOTOR _MOTOROFF _TIME If G>True _R["Repeat Copy Of Tracks?","",False] If Not Param : Dec G : Exit Else D=E : G=1 : End If End If Until G<1 Until A=160 End Proc Procedure _BAMCOPY For I=False To 3 If XDRV(I)=1 or XDRV(I)=3 Then Inc N : XDFN=I Next If N<>1 Then _ACERR[9] : Pop Proc Dim A(3) A=XDRV(XDFN) For I=False To 3 : A(I)=XDRV(I) : XDRV(I)=False : Next XDRV(XDFN)=2 _SHOWBITMAP For I=False To 3 : XDRV(I)=A(I) : Next If XSTP Then Pop Proc _DOSCOPY End Proc Procedure _FORMAT _DISKTEST : If XSTP Then Pop Proc _TRKON[80] If Param If XFN A$=Str$(XFN)-" " : Inc XFN End If _I["Diskname:",XFN$+A$] If Param : Pop Proc : End If End If Fill Start(7) To Finish(7),False Timer=False For I=False To 159 _TRKON[I] If Param For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,I,5632,Start(7),11] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,I] : Exit If Param,2 End If Next If XVFY For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,I,5632,Start(7),2] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,I] : Exit If Param,2 End If Next End If End If If Mouse Key Then _ABORT Exit If XSTP Next If XSTP=False For I=False To 3 If XDRV(I)>1 _TRKON[80] If Param _ROOTBLOCK _TRKSD[I,440,1024,Start(7),3] : Dev Abort(I) : Trap Dev Do I,4 End If _TRKON[False] : If Param : _INSTALL : End If End If Next End If End Proc Procedure _BFORMAT For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _TRKON[80] : If Not Param Then _ACERR[2] : Pop Proc If XFN Then A$=Str$(XFN)-" " : Inc XFN _I["Diskname:",XFN$+A$] : If Param Then Pop Proc Reserve As Work 8,160 Fill Start(7) To Finish(7),False Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XDFN,I,5632,Start(7),11] _TRKDO[XDFN,I,5632,Start(7),2] A=Peek(Dev Base(XDFN)+31) mod 19 _2[I,A] If A Inc B Poke Start(8)+I,1 _O["Track"+Str$(I)+" Locked!"] End If End If If Mouse Key Then _ABORT : Exit If Param Next If XSTP Then Pop Proc _O["Tracks Locked:"+Str$(B)-" "+"!"] _ROOTBLOCK A=False : B=512 : C=False : D=2 : N=True For I=False To 159 Repeat If Peek(Start(8)+I) Then Bclr A,N If A=31 Add B,4 Loke Start(7)+B,N N=True End If Add A,1,False To 31 Add D,1,False To 11 Until D>10 D=False Next P=Start(7)+512 Poke P+114,$3F Loke P,False For I=False To 220 Step 4 Add C,-Leek(P+I) Next Loke P,C _TRKDO[XDFN,80,5632,Start(7),11] _TRKON[False] : If Param : _INSTALL : End If End Proc Procedure _QFORMAT _DISKTEST : If Param Then Pop Proc _TRKON[80] : If Not Param Then _ACERR[2] : Pop Proc If XFN Then A$=Str$(XFN)-" " : Inc XFN _I["Diskname:",XFN$+A$] : If Param Then Pop Proc Timer=False For I=False To 3 If XDRV(I)>1 _ROOTBLOCK _TRKDO[I,440,1024,Start(7),3] : Trap Dev Do I,4 _TRKCK[I,80] : Exit If Param _TRKON[False] : If Param : _INSTALL : End If End If Next End Proc Procedure _ERASE _DISKTEST : If Param Then Pop Proc Reserve As Chip Work 7,14716 Timer=False For I=False To 159 _TRKON[I] If Param For XDFN=False To 3 If XDRV(XDFN)>1 _TRKRW[XDFN,I,17] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,I] : Exit If Param,2 End If Next End If If Mouse Key Then _ABORT : Exit If Param Next Reserve As Chip Work 7,5632 End Proc Procedure _CHECKDISK 'Test nach Targets For I=False To 3 If XDRV(I)>1 _DISKINSERT[I] : If Param : Pop Proc : End If End If Next Timer=False For I=False To 159 _TRKON[I] If Param For XDFN=False To 3 If XDRV(XDFN)>1 _TRKSD[XDFN,I,5632,Start(7),2] End If Next For XDFN=False To 3 If XDRV(XDFN)>1 Dev Abort(XDFN) : _TRKCK[XDFN,I] : Exit If Param,2 End If Next End If If Mouse Key Then _ABORT : Exit If Param Next End Proc Procedure _COMPARE For I=False To 3 If XDRV(I)=1 or XDRV(I)=3 Then Inc N : XSOURCE=I If XDRV(I)>1 Then Inc I2 Next If N<>1 Then _ACERR[9] : Pop Proc If I2<1 Then _ACERR[3] : Pop Proc For I=False To 3 If XDRV(I)>False _DISKINSERT[I] : If Param : Pop Proc : End If End If Next Reserve As Chip Work 8,5632 Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XSOURCE,I,5632,Start(7),2] _TRKCK[XSOURCE,I] : Exit If Param For I2=False To 3 If XDRV(I2)>1 _TRKDO[I2,I,5632,Start(8),2] _TRKCK[I2,I] : Exit If XSTP,2 For V=False To 5628 Step 4 If Leek(Start(7)+V)<>Leek(Start(8)+V) _1[I,False] _O["Track"+Str$(I)+" Of DF"+Chr$(48+XSOURCE)+": And DF"+Chr$(48+I2)+": Are Different!"] Exit End If Next End If Next End If If Mouse Key Then _ABORT : Exit If Param Next End Proc Procedure _INSTALL If XMEN=1 Then Goto A : Rem * Für Format-Optionen _DISKTEST : If Param Then Pop Proc _TRKON[False] : If Not Param Then _ACERR[4] : Pop Proc _BOOTBLOCK A=Start(12) B=False Do A=Hunt(A To Finish(12),"ACBB") Exit If A=False Add A,26 Add B,20 Loop Reserve As Work 8,B A=Start(12) B=False Do A=Hunt(A To Finish(12),"ACBB") Exit If A=False Poke$ Start(8)+B,Peek$(A+4,20,Chr$(0)) Add A,26 Add B,20 Loop _SELECTOR["CHOOSE BOOTBLOCK"] If Param>True A=Start(12) B=False Do A=Hunt(A To Finish(12),"ACBB") Exit If B=Param Add A,26 Inc B Loop Fill Start(7) To Finish(7),False Copy A+26,A+26+Deek(A+24) To Start(7) End If If Param=True Then XSTP=True : Pop Proc A: If XMEN=1 Fill Start(7) To Finish(7),False Loke Start(7),$444F5300 End If For I=False To 3 If XDRV(I)>1 _TRKDO[I,False,1024,Start(7),3] : Trap Dev Do I,4 _TRKCK[I,False] : Exit If Param End If Next End Proc Procedure _BOOTTOLIB For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _I["Name Of BootBlock [20]:",""] : If Param Then Pop Proc A$=Left$(XE$,20) A$=A$+String$(Chr$(0),20-Len(A$)) 'BootBlock einlesen _TRKDO[XDFN,False,1024,Start(7),2] _MOTOROFF 'Real-Größe von BB ermitteln For I=1023 To False Step True Exit If Peek(Start(7)+I) Next Inc I B$=XACD$+"BootBlocks.AC" If Not Exist(B$) _BOOTBLOCK _FSAVE[B$,Start(12),Finish(12)] If Param : Pop Proc : End If End If Trap Append 1,B$ If Errtrap Then _ERR : Pop Proc Trap Print #1,"ACBB"+A$+Word$(I); Trap Ssave 1,Start(7) To Start(7)+I If Errtrap Then _ERR Close Erase 12 Wait 200 End Proc Procedure _CLEANDISK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _TRKDO[XDFN,880,512,Start(7),2] If Leek(Start(7)+312)<>True _MOTOROFF _ACERR[1] Pop Proc End If _TRKDO[XDFN,Leek(Start(7)+316),512,Start(7),2] _MOTOROFF _SEEKMOTOR Loke Dev Base(XDFN)+40,Start(7)+512 A=2 : C=2 : I=False Timer=False Repeat _TRKON[A/11] If B=False Then Add I,4 : N=Leek(Start(7)+I) If Btst(B,N) and Param _0[A/11,C] Loke Dev Base(XDFN)+44,A*512 Trap Dev Do XDFN,3 Inc F End If Inc A Add B,1,False To 31 Inc C If C=11 Inc D C=False End If If Mouse Key Then _ABORT : Exit If Param Until A=1760 Trap Dev Do XDFN,4 Loke Start(7),F Loke Start(7)+4,F*512 _O[Format$("Cleaned Blocks:%ld Bytes:%ld!",Start(7))] End Proc Procedure _PACKDISK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _R["Pack Disk in XPK Mode?","",False] If Param Then Proc _XPKDISK[XDFN] : Pop Proc _FREQ["Pack Disk To File"] If Param$="" Then XSTP=True : Pop Proc XFILE$=Param$ _I["Efficiency = [0] Fast - [1] Mediocre - [2] Good - [3] Best:","3"] If Param Then Pop Proc N=Val(XE$) : N=Min(3,N) : Bset 8+N,XE Reserve As Work 8,320 Trap Open Out 1,XFILE$ If Errtrap Then _ERR : Pop Proc Print #1,"ACPK"; Ssave 1,Start(8) To Finish(8) _O["[CTRL+C] = Abort Packing Process!"] Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param _1[I,False] _MOTOROFF A=Leek(Start(7)) For B=4 To 5628 Step 4 If Leek(Start(7)+B)<>A B=True : Exit End If Next If B=True C=Squash(Start(7),5632,True,XE,4) If C=-2 : XSTP=True : Exit : End If If C1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _FREQ["Depack File To Disk"] If Param$="" Then XSTP=True : Pop Proc A$=Param$ Timer=False Reserve As Work 8,320 Trap Open In 1,A$ If Errtrap Then _ERR : Pop Proc B$=Input$(1,4) If Left$(B$,2)<>"AC" Then _ACERR[5] : Close : Pop Proc If Right$(B$,2)<>"PK" Then XPK=True Trap Sload 1 To Start(8),320 If Errtrap Then _ERR : Close : Pop Proc For A=False To 318 Step 2 If Deek(Start(8)+A) Bset False,Start(10)+A/2 Else Bclr False,Start(10)+A/2 End If Next _BITMAP[False] _O["Installing Packed Diskdatas Of "+A$+"!"] For I=False To 159 _TRKON[I] If Param A=Deek(Start(8)+I*2) Sload 1 To Start(7),A If A=4 Fill Start(7) To Finish(7),Leek(Start(7)) Else If A<5632 If XPK Bank Clone 7 To 9 Bank Shrink 9 To A Xpk Unpack 9 If Xpk Errn _R["Fatal XPK Error "+Str$(Xpk Errn),Xpk Err$,True] XSTP=True : Exit End If Bank Swap 7,9 Erase 9 Else B=Unsquash(Start(7),A) End If End If _TRKDO[XDFN,I,5632,Start(7),11] _TRKCK[XDFN,I] : Exit If Param If XVFY _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param End If End If If Mouse Key Then _ABORT : Exit If Param Next Close If XSTP=False Then _O["Packed Datas Succsessfull Installed!"] End Proc Procedure _CRYPTDISK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc If XOPT=4 Then N$="Crypt" Else N$="Decrypt" _I[N$+"-Code:",""] : If Param Then Pop Proc _R["Are You Sure To "+N$+" Disk?","",False] If Not Param Then XSTP=True : Pop Proc C$=XE$ C=Len(C$) N=C mod 4 If N Then C$=C$+String$(Chr$(255-C),4-N) C=Len(C$)-4 V=Varptr(C$) Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param _0[I,False] For A=5628 To False Step -4 N=Leek(Start(7)+A) If N D=Leek(V+B) N=N xor D N=N xor $414D4F53 Loke Start(7)+A,N Add B,4,False To C End If Next _TRKDO[XDFN,I,5632,Start(7),11] _TIME End If If Mouse Key Then _ABORT : Exit If Param Next End Proc Procedure _DECRYPT _CRYPTDISK End Proc Procedure _BLKTOFILE For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _FREQ["Save Blocks"] : Print Param$ : Pop Proc : Rem ******************** If Param$="" Then XSTP=True : Pop Proc _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) A=E-S+1 For I=A To False Step True Trap Reserve As Work 8,I*512 Exit If Errtrap=False Next Trap Open Out 1,Param$ If Errtrap Then _ERR : Pop Proc _O["Save Blocks In: "+Param$] Timer=False For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] Copy Start(7),Start(7)+512 To Start(8)+B Add B,512,False To Length(8)-512 End If If B=False or I=E _MOTOROFF If B=False : N=Length(8) Else N=B : End If Trap Ssave 1,Start(8) To Start(8)+N If Errtrap : _ERR : Exit : End If _TIME End If If Mouse Key Then _ABORT : Exit If Param Next Close End Proc Procedure _FILETOBLK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _FREQ["Load Blocks"] If Param$="" Then XSTP=True : Pop Proc _I["Startblock [0-1759]:",""] : If Param Then Pop Proc N=Val(XE$) : S=Min(1759,Abs(N)) Trap Open In 1,Param$ If Errtrap Then _ERR : Pop Proc A=Align(Lof(1),512) B=Start(7) Timer=False For I=S To 1759 _TRKON[I/11] If Param _0[I/11,I mod 11] Fill Start(7) To Start(7)+512,False Trap Sload 1 To Start(7),512 If Errtrap : _ERR : Exit : End If _TRKDO[XDFN,I,512,Start(7),3] : Trap Dev Do XDFN,4 Add C,512 Loke B,C/512 Loke B+4,A/512 Loke B+8,C Loke B+12,A _O[Format$("Installed Blocks:%ld/%ld Bytes:%ld/%ld!",B)] Exit If C=A End If If Mouse Key Then _ABORT : Exit If Param Next Close End Proc Procedure _DSKTOFILE For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _FREQ["Save Tracks"] If Param$="" Then XSTP=True : Pop Proc Trap Open Out 1,Param$ If Errtrap Then _ERR : Pop Proc _O["Save Tracks In: "+Param$] Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param _MOTOROFF Trap Ssave 1,Start(7) To Finish(7) If Errtrap : _ERR : Exit : End If _TIME End If If Mouse Key Then _ABORT : Exit If Param Next Close End Proc Procedure _FILETODSK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _FREQ["Load Tracks"] If Param$="" Then XSTP=True : Pop Proc Trap Open In 1,Param$ If Errtrap Then _ERR : Pop Proc A=Align(Lof(1),5632)/5632 B=Start(7) Timer=False For I=False To 159 _TRKON[I] If Param Trap Sload 1 To B,5632 If Errtrap : _ERR : Exit : End If _TRKDO[XDFN,I,5632,B,11] _TRKCK[XDFN,I] : Exit If Param If XVFY _TRKDO[XDFN,I,5632,B,2] _TRKCK[XDFN,I] : Exit If Param End If Inc C Doke B,C Doke B+2,A Loke B+4,C*5632 Loke B+8,A*5632 _O[Format$("Installed Tracks:%d/%d Bytes:%ld/%ld!",B)] Exit If C=A _MOTOROFF _TIME End If If Mouse Key Then _ABORT : Exit If Param Next Close End Proc Procedure _BOOTMENU For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc Dim T$(39) _O["TEXT = Message - @TEXT = Choseable - * = Install"] _WAIT For I=False To 39 If I<4 Then N$="Logotext #" Else N$="Linetext #" _I[N$+Str$(I+1)-" "+":",""] If XE$="!" Then XSTP=True : Pop Proc T$(I)=Upper$(Left$(XE$,22)) Exit If XE$="*" Next Reserve As Chip Work 8,11264 For I=False To 28 : Read N : Loke Start(8)+I*4,N : Next P=Start(8)+116 For I=False To 39 N$=T$(I) Exit If N$="*" If I=False : Rem * 1. Logolinie N$=N$-"@" Poke$ P,N$ Else If Instr(N$,"@")>False : Rem * CLI Befehl? N$=N$-"@" N$=Word$($102)+N$ Poke$ P,N$ Else N$=Chr$(1)+N$ : Rem * Mitteilung Poke$ P,N$ End If End If Add P,Len(N$) Next N$=Chr$(0)+"*"+Chr$(1) Poke$ P,N$ Areg(0)=Start(8) : Call Start(14) : Rem * Bootblock Checksumme Copy Start(15),Start(15)+10208 To Start(8)+1024 : Rem * Kefrens installieren _R["Insert New Formatted Disk In DF"+Chr$(48+XDFN)+":","",True] _DISKTEST : If Param Then Pop Proc _TRKDO[XDFN,False,11264,Start(8),11] 'Bitmap installieren XE$="Christina" _ROOTBLOCK P=Start(7)+512 Loke P+4,%11111111111000000000000000000000 Loke P,False For I=0 To 220 Step 4 Add C,-Leek(P+I) Next Loke P,C _TRKDO[XDFN,80,5632,Start(7),11] _MOTOROFF Drive Busy XDFN,False Wait 200 'Dirs & Files installieren N$="DF"+Chr$(48+XDFN)+":" Trap Mkdir N$+"C" If Errtrap Then _ERR : Pop Proc Trap Mkdir N$+"S" _FSAVE[N$+"C/KefLoad",Start(15)+10208,Start(15)+10416] _FSAVE[N$+"C/Run",Start(15)+10416,Start(15)+12792] Trap Open Out 1,N$+"S/Startup-Sequence" Trap Print #1,"KefLoad"+Chr$(10); Close _O["Copy Your Programs Named 1 To ? Onto Disk!"] Wait 200 If XDI=False Then Drive Busy XDFN,True '28 datas Data $444F5300,$0,$370,$337C0002,$1C237C,$2800,$24237C,$40000,$28237C Data $400,$2C4EAE,$FE38207C,$7C800,$43FA003E,$303C0100,$20D951C8,$FFFC4EB9 Data $40000,$13C00000,$802C79,$4,$43FA0010,$4EAEFFA0,$20402068,$167000 Data $4E75646F,$732E6C69,$62726172,$79000000 End Proc Procedure _BLOCKEDIT For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc Gosub _IN If XE$="" Then XSTP=True : Pop Proc Gosub _LOADBLK Trap Screen Open 1,640,149,Screen Colour,Hires If Errtrap Then _ERR : Pop Proc Change Bank Font 17 Screen Hide Screen Display 1,,85,, Flash Off Curs Off Cls False Get Palette False _G[False,False,639,148,False] : _GG[7,3,533,145] For I=False To 5 If I<>4 Then _GG[537,3+I*16,632,15+I*16] Next _N[549,7,"T:",False] _N[549,23,"B:",False] _N[549,39,"O:",False] _N[549,55,"P:",False] _GG[537,67,582,79] : Rem * Asc _GG[587,67,632,79] : Rem * Hex _GG[537,100,582,113] : _N[544,104,"FILL",False] _GG[587,100,632,113] : _N[594,104,"CSUM",False] _GG[537,116,582,129] : _N[544,120,"PRNT",False] _GG[587,116,632,129] : _N[594,120,"SAVE",False] _GG[537,132,582,145] : _N[544,136,"UNDO",False] _GG[587,132,632,145] : _N[594,136,"EXIT",False] Gosub _DISPLAYBLK : Screen Show Do Clear Key K=Wait Loop XM=X Screen(X Mouse) YM=Y Screen(Y Mouse) If K=8 Add B,True,False To 1758 P=B*512 Gosub _LOADBLK Gosub _DISPLAYBLK Else If K=9 Sam Raw %1111,Start(7),1024,XFQ Else If K=13 Add B,1,False To 1758 P=B*512 Gosub _LOADBLK Gosub _DISPLAYBLK End If If XM>536 and XM<633 and K2 and YM<95 A=(YM-3)/16 If A<>4 : _G[538,4+A*16,631,14+A*16,True] : End If If A=False : Rem * T _I["Track [0-159]:",""] T=Val(XE$) : T=Max(False,Min(159,T)) B=T*11 P=B*512 Gosub _LOADBLK Gosub _DISPLAYBLK Else If A=1 : Rem * B Gosub _IN Gosub _LOADBLK Gosub _DISPLAYBLK Else If A=2 : Rem * O _I["Offset [0-1023]:",""] O=Val(XE$) : O=Max(False,Min(1023,O)) X=O mod 64 Y=O/64 Gosub _CURS Else If A=3 : Rem * P _I["Position [0-900607]:",""] P=Val(XE$) P=Max(False,Min(P,900607)) : Rem * max 1759*512 N=P mod 512 X=N mod 64 : XA=X Y=N/64 : YA=Y B=Min(1758,P/512) P=B*512 Gosub _LOADBLK Gosub _DISPLAYBLK Else If A=4 : Rem * D/H If XM<583 _G[538,68,581,78,True] _I["Dec-Code [0-255]:",""] _G[538,68,581,78,False] Else _G[588,68,631,78,True] _I["Hex-Code [$0-$FF]:","$"] _G[588,68,631,78,False] End If Poke Start(7)+YA*64+XA,Val(XE$) : K=28 Else If A=5 : Rem * % _I["Bin-Code [%0-%11111111]:","%"] Poke Start(7)+YA*64+XA,Val(XE$) : K=28 End If If A<>4 : _G[538,4+A*16,631,14+A*16,False] : End If Else If YM>101 and YM<146 If XM<582 and YM>101 and YM<113 : Rem * FILL _G[538,101,581,112,True] _I["ASCII-Code [0-255] To Fill Block"+Str$(B)+":",""] If XE$<>"" A=Val(XE$) For I=False To 511 Poke Start(7)+(B2-B)*512+I,A Next Gosub _DISPLAYBLK End If _G[538,101,581,112,False] Else If XM>587 and YM>101 and YM<113 : Rem * CSUM _G[588,101,631,112,True] If B=False and B2<2 : Rem * BB CheckSum Areg(0)=Start(7) Call Start(14) N=Leek(Start(7)+4) Else If B2>1 A=Start(7)+(B2-B)*512 N=Leek(A) If N=1 or N=2 or N=8 or N=16 I2=A+20 : Rem * File-System Else I2=A : Rem * Evtl. Bit-Map End If Loke I2,False N=False For I=False To 508 Step 4 Add N,-Leek(A+I) Next Loke I2,N End If _O["Checksum:"+Hex$(N,8)] Gosub _DISPLAYBLK _G[588,101,631,112,False] Else If XM<582 and YM>116 and YM<129 : Rem * PRNT _G[538,117,581,128,True] _R["Really Print Out Block?","",False] If Param Trap Open Port 1,"PRT:" If Errtrap _O["Can`t Open Printer.Device!"] Else _O["Print Block"+Str$(B)+" - [ESC] = Abort!"] Print #1,"Block"+Str$(B) For I=False To 31 Wait 30 : N$="" : A$="" For I2=False To 15 Exit If Asc(Inkey$)=27,2 N=Peek(Start(7)+I*16+I2) N$=N$+Hex$(N,2)-"$"+" " If N<32 or N>127 and N<161 N=46 End If A$=A$+Chr$(N) Next Print #1,Hex$(B*512+I*16,5)-"$"+": "+N$+" "+A$ Next End If Close End If _G[538,117,581,128,False] Else If XM>587 and YM>116 and YM<129 : Rem * SAVE _G[588,117,631,128,True] _PROTECTION[XDFN] If XSTP=False If B=False : Rem * BB CheckSum Areg(0)=Start(7) Call Start(14) Gosub _DISPLAYBLK End If Loke Dev Base(XDFN)+36,1024 Loke Dev Base(XDFN)+40,Start(7) Loke Dev Base(XDFN)+44,B*512 Trap Dev Do XDFN,3 Trap Dev Do XDFN,4 _O["Block"+Str$(B2)+" Installed!"] End If _MOTOROFF _G[588,117,631,128,False] Else If XM<581 and YM>131 and YM<146 : Rem * UNDO _G[538,133,581,144,True] A=Start(7) Copy A+1024,A+2048 To A Gosub _DISPLAYBLK _G[538,133,581,144,False] Else If XM>587 and YM>131 and YM<146 : Rem * EXIT _G[588,133,631,144,True] : Wait 15 : _O[""] : Exit End If End If End If If XM>13 and XM<525 and YM>10 and YM<139 and K31 Poke Start(7)+YA*64+XA,K K=28 End If If K>27 and K<32 If K=28 If X<63 Inc X Else If X=63 X=False : Add Y,1,False To 15 End If Else If K=29 If X>False Dec X Else If X=False X=63 : Add Y,True,False To 15 End If Else If K=30 Add Y,True,False To 15 Else If K=31 Add Y,1,False To 15 End If Gosub _CURS End If Loop Screen Close 1 : Wait Vbl XSTP=False Pop Proc _IN: _I["Block [0-1758]:",""] B=Val(XE$) B=Min(1758,Abs(B)) P=B*512 Return _LOADBLK: XSTP=False _DISKINSERT[XDFN] N=Start(7) If XSTP=False Fill N To Finish(7),False Loke Dev Base(XDFN)+36,1024 Loke Dev Base(XDFN)+40,N Loke Dev Base(XDFN)+44,P Trap Dev Do XDFN,2 Copy N,N+1024 To N+1024 End If _MOTOROFF Z=Peek(N) Return _DISPLAYBLK: Ink 1,False For I2=False To 15 N$="" For I=False To 63 N=Peek(Start(7)+I2*64+I) If N<32 or N>127 and N<160 Then N=46 N$=N$+Chr$(N) Next Text 13,I2*8+17,N$ Next Ink False For I2=False To 3 Text 564,12+I2*16,Space$(5) Next _CURS: Z=Peek(Start(7)+Y*64+X) ZA=Peek(Start(7)+YA*64+XA) O=Y*64+X P=B*512+Y*64+X If Y<8 Then B2=B Else B2=B+1 T=B2/11 Ink 1,False A$=Str$(T) : Text 620-Len(A$)*8,12,A$ A$=Str$(B2) : Text 620-Len(A$)*8,28,A$ A$=" "+Str$(O) : Text 620-Len(A$)*8,44,A$ A$=Str$(P) : Text 620-Len(A$)*8,60,A$ A$=Str$(Z)-" " : Text 547,76,String$("0",3-Len(A$))+A$ Text 598,76,Hex$(Z,2) Text 549,92,Bin$(Z,8) If Z<32 or Z>127 and Z<160 Then Z=46 If ZA<32 or ZA>127 and ZA<160 Then ZA=46 Text 13+XA*8,17+YA*8,Chr$(ZA) Ink ,7 : Text 13+X*8,17+Y*8,Chr$(Z) XA=X YA=Y Return End Proc Procedure _SEARCH For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _I["Search String:",""] : If Param Then Pop Proc N$=XE$ _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) _O["Search For: "+N$] Timer=False For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] F=Hunt(Start(7) To Start(7)+512,N$) Exit If F End If If Mouse Key Then _ABORT : Exit If Param Next If F A=Start(7) Doke A,I/11 Doke A+2,I Loke A+4,I*512+F-A _O[Format$("String Found In Track:%d Block:%d Position:%ld!",A)] Else _O["String Not Found: "+N$+"!"] End If End Proc Procedure _PLAYBLOCK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) Trap Reserve As Chip Work 8,(E-S)*512 If Errtrap Then _ERR : Pop Proc For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] Copy Start(7),Start(7)+512 To Start(8)+I2 Add I2,512 End If If Mouse Key Then _ABORT : Exit If Param Next _MOTOROFF _G[141,149,206,161,False] XE$=Str$(XFQ)-" " Repeat _I["Frequency For Blocks"+Str$(S)+" To"+Str$(E)+" [0 = End]:",XE$] N=Val(XE$) : If N>999 Then Sam Raw %1111,Start(8),I2,N Until N=False Sam Stop %1111 End Proc Procedure _VIEWBLOCK For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc Gosub B : If XSTP Then Pop Proc Gosub C : If XSTP Then Pop Proc Trap Screen Open 1,640,149,Screen Colour,Hires If Errtrap Then _ERR : Pop Proc Change Bank Font 17 Screen Display 1,,85,, Flash Off Curs Off Cls False Get Palette False _GG[False,137,102,148] : _GG[106,137,208,148] _GG[212,137,284,148] : _GG[288,137,360,148] _GG[567,137,639,148] : _N[588,140,"EXIT",False] Gosub D Gosub E Do Clear Key Clear Mouse Do If X<>X Screen(X Mouse) or Y<>Y Screen(Y Mouse) Gosub E X=X Screen(X Mouse) Y=Y Screen(Y Mouse) End If B=Mouse Key : Exit If B B=Asc(Inkey$) : Exit If B Wait Vbl Loop If B<3 X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If Y<137 Gosub D Else If X>211 and X<285 : Rem * S _G[213,138,283,147,True] B=A : Gosub B If XSTP=False If XE$="" A=B Else Gosub C If XSTP B=A Else Gosub D End If End If End If _G[213,138,283,147,False] Else If X>566 : Rem * EXIT _G[568,138,638,147,True] : Exit End If End If Else If B=13 B=A Add A,1,False To 1737 Gosub C : If XSTP=False : Gosub D Else A=B : End If Else If B=8 B=A Add A,True,False To 1737 Gosub C : If XSTP=False : Gosub D Else A=B : End If Else If B=28 Copy Start(8),Finish(8)-1 To Start(8)+1 : Gosub D Else If B=29 Copy Start(8)+1,Finish(8)-1 To Start(8) : Gosub D Else If B=30 Copy Start(8)+80,Finish(8)-80 To Start(8) : Gosub D Else If B=31 Copy Start(8),Finish(8)-80 To Start(8)+80 : Gosub D End If Loop XSTP=False Wait 15 Screen Close 1 : Wait Vbl Pop Proc A: Doke Varptr(B),W*8+8 Doke Varptr(B)+2,H _N[8,140,Format$("W:%03d H:%03d",Varptr(B)),False] Doke Varptr(B),A _N[225,140,Format$("S:%04d",Varptr(B)),False] Doke Varptr(B),A+(W*H)/512 _N[301,140,Format$("E:%04d",Varptr(B)),False] Return B: XSTP=False _I["View Block [0-1737]:",""] If Not Param A=Val(XE$) A=Min(1737,Abs(A)) End If Return C: XSTP=False _DISKINSERT[XDFN] If XSTP=False Reserve As Chip Work 8,11264 Loke Dev Base(XDFN)+36,Length(8) Loke Dev Base(XDFN)+40,Start(8) Loke Dev Base(XDFN)+44,A*512 Trap Dev Do XDFN,2 _MOTOROFF End If Return D: Repeat Cls False,False,False To 640,137 W=Min(640,Max(False,X Screen(X Mouse)))/8 H=Min(136,Max(False,Y Screen(Y Mouse))) P=Phybase(False) For I=False To H Copy Start(8)+I*W,Start(8)+I*W+W+1 To P Add P,80 Next Gosub A Until Mouse Key=False Return E: X=Align(Min(640,Max(8,X Screen(X Mouse))),8) Y=Min(136,Max(False,Y Screen(Y Mouse))) Doke Varptr(B),X Doke Varptr(B)+2,Y _N[114,140,Format$("X:%03d Y:%03d",Varptr(B)),False] Return End Proc Procedure _SCANIFF For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc If Exist("DF"+Chr$(48+XDFN)+":") Then _ACERR[6] : Pop Proc _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) Timer=False For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] P=Hunt(Start(7) To Start(7)+508,"FORM") If P and Leek(P+4)<200000 _MOTOROFF If Leek(P+8)=Long("ILBM") B=(1024+Leek(P+4))/512 A$="IFF-ILBM Picture" Else If Leek(P+8)=Long("8SVX") B=(512+Leek(P+4))/512 A$="IFF-8SVX Sample" End If _SIA: _I[A$+" Scan In Block"+Str$(I)+": [S]ave - [V]iew/Play:",""] A=Asc(Upper$(XE$)) If A=83 or A=86 Trap Reserve As Chip Work 8,B*512 If Errtrap _ERR Else Loke Dev Base(XDFN)+36,Length(8) Loke Dev Base(XDFN)+40,Start(8) Loke Dev Base(XDFN)+44,I*512 Trap Dev Do XDFN,2 _MOTOROFF P=Hunt(Start(8) To Finish(8),"FORM") If P<>Start(8) Copy P,Finish(8) To Start(8) Bank Shrink 8 To Length(8)-(P-Start(8)) End If If A=83 _FREQ["Save "+A$] If Param$<>"" If Exist(Param$) _R["File Already Exist, Overwrite?","",False] If Param=False : XSTP=True : Pop Proc : End If End If _FSAVE[Param$,Start(8),Finish(8)] End If Else If Leek(Start(8)+8)=Long("ILBM") Trap Iff Bank 8 To 1 If Errtrap _ERR Else Screen Hide False Colour Back Colour(False) _WAIT Screen Close 1 : Wait Vbl Colour Back Colour(False) Screen Show False Clear Mouse End If Else Sam Raw %1111,Start(8),Finish(8),XFQ Wait 200 Sam Stop End If End If Goto _SIA End If End If End If End If If Mouse Key Then _ABORT : Exit If Param Next End Proc Procedure _BITMAPEDIT For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If XSTP Then Pop Proc Timer=False _TRKDO[XDFN,880,512,Start(7),2] _MOTOROFF If Leek(Start(7)+312)<>True Then _ACERR[1] : Pop Proc E=Leek(Start(7)+316)*512 Gosub _LBM Trap Screen Open 1,640,149,Screen Colour,Hires If Errtrap Then _ERR : Pop Proc Change Bank Font 17 Screen Display 1,,85,, Flash Off Curs Off Cls False Get Palette False _G[False,False,638,148,False] : _GG[7,3,632,127] _GG[7,131,79,144] : _N[15,135,"T:",False] _GG[84,131,156,144] : _N[92,135,"B:",False] _GG[161,131,233,144] : _N[169,135,"S:",False] _GG[337,131,382,144] : _N[344,135,"LOAD",False] _GG[387,131,432,144] : _N[394,135,"SWAP",False] _GG[437,131,482,144] : _N[444,135,"FREE",False] _GG[487,131,532,144] : _N[494,135,"USED",False] _GG[537,131,582,144] : _N[544,135,"SAVE",False] _GG[587,131,632,144] : _N[594,135,"EXIT",False] Gosub _SBM Do M=Mouse Key X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If X<>X1 or Y<>Y1 or M X1=X : Y1=Y If X>14 and X<624 and Y>7 and Y<122 X=(X-14)/10 : Y=(Y-7)/4 : P=Y*61+X If P<1758 B=P/32 : C=P mod 32 D=Leek(A+(P/32)*4) If M If M=1 Bset C,D Else Bclr C,D End If Loke A+(P/32)*4,D _G[X*10+14,Y*4+7,X*10+23,Y*4+10,M-1] End If If Btst(C,D) N$="Free" Else N$="Used" End If Ink 1,False Text 189,140,N$ D=Start(7)+512 Doke D,(P+2)/11 : Text 35,140,Format$("%4d",D) Doke D,P+2 : Text 112,140,Format$("%4d",D) Screen 1 End If Else If Y>131 and Y<144 and M>False If X>337 and X<382 : Rem * LOAD _G[338,132,381,143,True] Gosub _LBM Gosub _SBM _G[338,132,381,143,False] Else If X>387 and X<432 : Rem * SWAP _G[388,132,431,143,True] For I=False To 54 N=Leek(A+I*4) For I2=False To 31 Bchg I2,N Next Loke A+I*4,N Next Gosub _SBM _G[388,132,431,143,False] Else If X>437 and X<482 : Rem * FREE _G[438,132,481,143,True] Fill A To A+220,True Gosub _SBM _G[438,132,481,143,False] Else If X>487 and X<532 _G[488,132,531,143,True] Fill A To A+220,False : Rem * FILL Gosub _SBM _G[488,132,531,143,False] Else If X>537 and X<582 : Rem * SAVE _G[538,132,581,143,True] A$="DF"+Chr$(48+XDFN)+":" _R["Really Set New BitMap On "+A$,"",False] If Param _PROTECTION[XDFN] If Param=False _CKSMBM Trap Dev Do XDFN,3 Trap Dev Do XDFN,4 _MOTOROFF End If End If _G[538,132,581,143,False] Else If X>587 and X<632 : Rem * EXIT _G[588,132,631,143,True] Wait 15 Exit End If End If End If Multi Wait Loop Screen Close 1 : Wait Vbl Pop Proc _LBM: Loke Dev Base(XDFN)+44,E Trap Dev Do XDFN,2 _MOTOROFF Return _SBM: A=Start(7)+4 X=False : Y=False : C=False For I=False To 54 B=Leek(A+I*4) For I2=False To 31 _G[X+14,Y+7,X+23,Y+10, Not(Btst(I2,B))] Add X,10,False To 600 If X=False Then Add Y,4 Inc C : Exit If C>1757 Next Next Return End Proc Procedure _CALCBITMAP For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If XSTP Then Pop Proc Timer=False A$="DF"+Chr$(48+XDFN)+":" P=Start(7) _TRKDO[XDFN,880,512,P,2] _MOTOROFF If Leek(P+312)<>True Then _ACERR[1] : Pop Proc E=Leek(P+316)*512 Loke Dev Base(XDFN)+44,E Trap Dev Do XDFN,2 A=P+512 Loke Dev Base(XDFN)+40,A _TRKON[False] : If Param Then _1[False,False] For I=2 To 1759 _TRKON[I/11] If Param If I mod 11=False _1[I/11,False] : F=False End If Loke Dev Base(XDFN)+44,I*512 Trap Dev Do XDFN,2 B=True For I2=False To 508 Step 4 If Leek(A+I2) : B=False : Exit : End If Next If B D=Leek(P+4+((I-2)/32)*4) C=(I-2) mod 32 Bset C,D Loke P+4+((I-2)/32)*4,D Inc F : Inc G _0[I/11,F] End If End If If Mouse Key Then _ABORT : Exit If Param Next If XSTP=False _CKSMBM Loke Dev Base(XDFN)+40,P Loke Dev Base(XDFN)+44,E Trap Dev Do XDFN,3 Trap Dev Do XDFN,4 Loke Start(7),G Loke Start(7)+4,G*512 _O[Format$("Allocated As Free Blocks:%ld Bytes:%ld!",Start(7))] End If End Proc Procedure _SHOWBITMAP For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _TRKDO[XDFN,880,512,Start(7),2] If Leek(Start(7)+312)<>True Then _MOTOROFF : _ACERR[1] : Pop Proc _TRKDO[XDFN,Leek(Start(7)+316),512,Start(7),2] _MOTOROFF _SEEKMOTOR Fill Start(10) To Finish(10),False A=2 : B=False For I=4 To 220 Step 4 N=Leek(Start(7)+I) Repeat If Not Btst(B,N) Bset False,Start(10)+A/11 End If Inc A Add B,1,False To 31 Until B=False Next Bset False,Start(10) : Rem * BootBlock _BITMAP[False] If XOPT=2 Then Pop Proc : Rem * BAMCOPY A=False : I=False : B=False : C=2 Repeat If B=False Then Add I,4 : N=Leek(Start(7)+I) If Btst(B,N) Then Inc A If C=10 If A and A<$B E=D mod 2 X=(D mod 20)/2 Y=D/20 _T[248+E*208+X*18,48+Y*13,Hex$(A)-"$",False] End If A=False Inc D End If Add B,1,False To 31 Add C,1,False To 10 Until I=224 End Proc Procedure _SETBITMAP _DISKTEST : If Param Then Pop Proc Timer=False For XDFN=False To 3 If XDRV(XDFN)>1 N$="DF"+Chr$(48+XDFN)+":" _TRKDO[XDFN,880,512,Start(7),2] _MOTOROFF If Leek(Start(7)+312)<>True _ACERR[1] Else _R["Really Set New BitMap On "+N$,"",False] If Param _PROTECTION[XDFN] Exit If XSTP E=Leek(Start(7)+316) Fill Start(7) To Finish(7),False A=False : B=False : C=False : D=2 For I=False To 159 Repeat If Peek(Start(10)+I) Bclr A,N Else Bset A,N End If If A=31 Add B,4 Loke Start(7)+B,N End If Add A,1,False To 31 Add D,1,False To 11 Until D>10 D=False Next _CKSMBM _TRKDO[XDFN,E,512,Start(7),3] : Trap Dev Do XDFN,4 _O["BitMap On "+N$+" Installed!"] End If End If End If Next End Proc Procedure _TRACKMAP For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc Timer=False For I=False To 159 _TRKON[I] If Param _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param Bclr False,Start(10)+I For I2=False To 5628 Step 4 If Leek(Start(7)+I2) : Bset False,Start(10)+I : Exit : End If Next End If If Mouse Key Then _ABORT : Exit If Param Next _MOTOROFF _BITMAP[False] End Proc Procedure _FILESECLAB For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _FREQ["File To Sectorlabel"] If Param$="" Then XSTP=True : Pop Proc _I["Startblock [0-1759]:",""] : If Param Then Pop Proc S=Val(XE$) : S=Min(1759,Abs(S)) _FLOAD[Param$,8,False] : If Param Then Pop Proc Dev Do XDFN,13 Loke Dev Base(XDFN)+48,Dev Base(XDFN)+32 Loke Dev Base(XDFN)+52,Start(7)+512 A=Start(8) For I=S To 1759 _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] B=A+16 If B>Finish(8) B=Finish(8) Fill Start(7)+512 To Start(7)+528,False End If Copy A,B To Start(7)+512 Add A,16 Trap Dev Do XDFN,32771 Exit If B=Finish(8) End If If Mouse Key Then _ABORT : Exit If Param Next If XSTP=False Then Trap Dev Do XDFN,32772 Loke Dev Base(XDFN)+48,False Loke Dev Base(XDFN)+52,False End Proc Procedure _SECLABFILE For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _FREQ["Sectorlabel To File"] If Param$="" Then XSTP=True : Pop Proc _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) Trap Reserve As Chip Work 8,(E-S+1)*16 If Errtrap Then _ERR : Pop Proc Dev Do XDFN,13 Loke Dev Base(XDFN)+48,Dev Base(XDFN)+32 A=Start(8) For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] Loke Dev Base(XDFN)+52,A : Add A,16 _TRKDO[XDFN,I,512,Start(7),32770] End If If Mouse Key Then _ABORT : Exit If Param Next Loke Dev Base(XDFN)+48,False Loke Dev Base(XDFN)+52,False _MOTOROFF _FSAVE[Param$,Start(8),A] Wait 200 End Proc Procedure _NOTESECLAB For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc 's. Clr SecLab If XE$<>Chr$(0) _I["Note To Sectorlabel [16]:",""] If Param : Pop Proc : End If End If A$=XE$ _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) Fill Start(7) To Finish(7),False Poke$ Start(7)+512,Left$(A$,16) Dev Do XDFN,13 Loke Dev Base(XDFN)+48,Dev Base(XDFN)+32 Loke Dev Base(XDFN)+52,Start(7)+512 For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] _TRKDO[XDFN,I,512,Start(7),2] Trap Dev Do XDFN,32771 End If If Mouse Key Then _ABORT : Exit If Param Next If XSTP=False Then Trap Dev Do XDFN,32772 Loke Dev Base(XDFN)+48,False Loke Dev Base(XDFN)+52,False End Proc Procedure _SHOWSECLAB For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKINSERT[XDFN] : If Param Then Pop Proc _SEBLK : If Param Then Pop Proc S=Deek(Start(7)) E=Deek(Start(7)+2) Trap Reserve As Chip Work 8,(E-S+1)*20 If Errtrap Then _ERR : Pop Proc Dev Do XDFN,13 Loke Dev Base(XDFN)+48,Dev Base(XDFN)+32 A=Start(8) For I=S To E _TRKON[I/11] If Param _0[I/11,I mod 11] Poke$ A,Format$("%-4ld",Varptr(I)) Loke Dev Base(XDFN)+52,A+4 Add A,20 _TRKDO[XDFN,I,512,Start(7),32770] End If If Mouse Key Then _ABORT : Exit If Param Next If A1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc N$="DF"+Chr$(48+XDFN)+":" If Not Exist(N$) Then _ACERR[1] : Pop Proc N$=N$+Chr$(0) Dreg(1)=Varptr(N$) Dreg(2)=-2 L=Doscall(-84) Dreg(1)=L Dreg(2)=Start(7) I=Doscall(-102) N$=Peek$(Start(7)+8,108,Chr$(0))+Chr$(0) Dreg(1)=L Dreg(2)=Start(7) I=Doscall(-114) Dreg(1)=L U=Doscall(-90) N=Leek(Start(7)+8) : Rem * Diskstate If N=80 : S$="Read Only" Else If N=81 : S$="Validating" Else If N=82 : S$="Read/Write" End If S$=S$+Chr$(0) B=Leek(Start(7)+12)-Leek(Start(7)+16) : Rem * Free blocks N=B*Leek(Start(7)+20) : Rem * Free bytes A=Start(7) Loke A,Varptr(N$) Loke A+4,B Loke A+8,N Loke A+12,Varptr(S$) _O[Format$("Name:%s Blocks:%ld Bytes:%ld State:%s!",A)] End Proc Procedure _SHOWDIR _FLOPPYTEST : If Param Then Pop Proc _I["Path:",""] : If Param Then Pop Proc XDIR$=XE$+Chr$(0) Dreg(1)=Varptr(XDIR$) Dreg(2)=-2 L=Doscall(-84) If L=False Then _ACERR[7] : Pop Proc Trap Screen Open 1,640,149,Screen Colour,Hires If Errtrap Then _ERR : Pop Proc Change Bank Font 17 Screen Display 1,,85,, Flash Off Curs Off Cls False Get Palette False _G[False,False,638,148,False] : _GG[7,3,632,17] : _GG[7,20,632,145] _N[15,8,"NAME"+Space$(29)+"TYPE BYTES BLOCKS PROTECTION KEY",False] Dreg(1)=L Dreg(2)=Start(7) E=Doscall(-102) I=1 Ink ,False Gosub _SDA If Leek(Start(7)+4)1 Then _WAIT _SDB: Dreg(1)=L U=Doscall(-90) Screen Close 1 : Wait Vbl Pop Proc _SDA: If Leek(Start(7)+4)1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _FLOPPYTEST : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc If Not Exist("DF"+Chr$(48+XDFN)+":") Then _ACERR[1] : Pop Proc _I["Diskname:",""] : If Param Then Pop Proc Fill Start(7) To Finish(7),False _TRKDO[XDFN,880,512,Start(7),2] N=Start(7) Poke N+$1B0,Min(25,Len(XE$)) XE$=Left$(XE$,26) XE$=XE$+String$(Chr$(0),26-Len(XE$)) Poke$ N+$1B1,XE$ _CKSMRB _TRKDO[XDFN,880,512,Start(7),3] : Trap Dev Do XDFN,4 End Proc Procedure _REPAIR For I=False To 3 If XDRV(I)>1 Then Inc N : XDFN=I Next _TARGETS[N] : If Param Then Pop Proc _DISKTEST : If Param Then Pop Proc _TRKON[False] If Param _0[False,False] _TRKDO[XDFN,False,1024,Start(7),2] A=Leek(Start(7)+4) _CKSMBB If Leek(Start(7)+4)<>A D=2 Trap Dev Do XDFN,3 : Trap Dev Do XDFN,4 _O["BootBlock Repaired!"] End If End If For I=2 To 1759 _TRKON[I/11] If Param _0[I/11,I mod 11] C=False _TRKDO[XDFN,I,512,Start(7),2] If I=880 Loke Start(7)+312,True B=Leek(Start(7)+316) End If A=Leek(Start(7)) If A=2 or A=8 or A=16 A=Leek(Start(7)+20) _CKSMRB If Leek(Start(7)+20)<>A C=True End If End If If I=B A=Leek(Start(7)) _CKSMBM If Leek(Start(7))<>A C=True End If End If If C Inc D Trap Dev Do XDFN,3 : Trap Dev Do XDFN,4 _O["Block"+Str$(I)+" Repaired!"] End If End If If Mouse Key Then _ABORT : Exit If Param Next If D Doke Start(7),D _O[Format$("Blocks Repaired:%d!",Start(7))] Else _O["No Checksum Error Found!"] End If End Proc Procedure _KILLFILE _FLOPPYTEST : If Param Then Pop Proc _FREQ["File To Delete"] If Param$="" XSTP=True Else Trap Kill Param$ If Errtrap _ERR Else _O[Param$+" Deleted!"] End If End If End Proc Procedure _CLI _FLOPPYTEST : If Param Then Pop Proc If Not Exist("C:Run") Then _ACERR[8] : Pop Proc Repeat _I["1>",""] If Not Param N$=XE$+Chr$(0) Dreg(1)=Varptr(N$) Dreg(2)=False Dreg(3)=False A=Doscall(-222) End If Until Param End Proc Procedure _ABOUT Trap Screen Open 1,640,149,Screen Colour,Hires If Errtrap Then _ERR : Pop Proc Change Bank Font 17 Screen Hide Screen Display 1,,85,, Flash Off Curs Off Cls False Get Palette False _G[False,False,638,148,False] : _GG[7,3,632,145] Ink 1,0 For I=1 To 14 Read N$ Text 320-Len(N$)*4,10+I*9,N$ Next Screen Show Amos To Front Stop Loop Screen Close 1 : Wait Vbl Data "Giftware condition for users of AMOSCopy:" Data "Users should send me a little token as acknowledgement" Data "for this program. The token can be everything you mean that" Data "will respect my work for creating AMOSCopy V3.23" Data "" Data "Volker Stepprath" Data "Tegeler Str.7" Data "40789 Monheim" Data "Germany" Data "" Data "E-Mail: Peacefloete"+Chr$(64)+"aol.com" Data "" Data "AMOSCopy V3.23 was written using Francois Lionets AMOSPro & APCmp" Data "AMOSPro V2.0 and APCmp V2.0 is copyrighted by Europress Software Ltd." End Proc Procedure _ICONIFY Open Workbench Erase 98 Erase 99 Dev Close Fill Start(7) To Finish(7),False Wait 25 A$="AMOSCopy"+Chr$(0) A=Start(7) Doke A+4,Len(A$)*8+77 Doke A+6,10 Poke A+8,2 Poke A+9,3 Loke A+10,$200 Loke A+14,14 Loke A+26,Varptr(A$) Doke A+46,1 Amos Lock Amos To Back Screen Close False Wait Vbl Areg(0)=A A=Intcall(-204) Areg(0)=Leek(A+86) B=Execall(-384) A$="Wait.."+Chr$(0) Areg(0)=A Areg(1)=Varptr(A$) Areg(2)=True B=Intcall(-276) _TDDEVSOPEN _INSTALLAC _UPDATEAC Areg(0)=A A=Intcall(-72) Amos Unlock Amos To Front End Proc Procedure _EXIT _R["Really Quit AMOSCopy V3.23?","",False] If Not Param Then XSTP=True : Pop Proc If XMU Then _PLAYMUSIC If XDI=False Then _DISKBUSY[False] Wait 20 Dev Close Request On Wait 10 If Prg State140 and X<207 and Y>148 and Y<162 _G[141,149,206,161,True] XSTP=True End If End Proc[XSTP] Procedure _ACERR[A] If A=1 : A$="BitMap Not Valid, No AmigaDOS Disk" Else If A=2 : A$="RootBlock Locked, Track #80 Lowerside" Else If A=3 : A$="No Targetdrive Selected" Else If A=4 : A$="BootBlock Locked, Track #0 Lowerside" Else If A=5 : A$="Not An AMOSCopy Packed Diskfile" Else If A=6 : A$="Disk In Normal AmigaDOS Format" : B$="Use Standart Filesystem!" Else If A=7 : A$="Cannot Access To Path" Else If A=8 : A$="Need C:Run" Else If A=9 : A$="Illegal Number Of Sourcedrives" Else If A=10 : A$="Illegal Number Of Targetdrives" Else If A=11 : A$="Diskinterrupt Must Be Turned On" Else If A=12 : A$="No XPK Sublibs found" End If If A$="" Then A$="AMOSCopy Error #"+Str$(A)-" "+" Occurred" _R[A$+"!",B$,True] XSTP=True End Proc Procedure _BITMAP[A] For I=False To 159 B=Btst(False,Start(10)+I) If B Then Ink False Else Ink 5 X=(I mod 20)/2 Y=I/20 C=I mod 2 If C and A<1 Bar 453+X*18,46+Y*13 To 466+X*18,56+Y*13 _G[451+X*18,45+Y*13,468+X*18,57+Y*13,B] Else If C=False and A>True Bar 245+X*18,46+Y*13 To 258+X*18,56+Y*13 _G[243+X*18,45+Y*13,260+X*18,57+Y*13,B] End If Next End Proc Procedure _BOOTBLOCK If Length(12)=False A$=XACD$+"BootBlocks.AC" If Exist(A$)=True : _FLOAD[A$,12,False] : End If End If If Length(12)=False Reserve As Work 12,1518 A=Start(12) For I=False To 4 Read A$,B Poke$ A,"ACBB"+A$+String$(Chr$(0),20-Len(A$))+Word$(B*4+4) Add A,26 For I2=False To B Read C : Loke A,C Add A,4 Next Next End If Data "BB_AMOSCopy",52 Data $444F5300,$330F65C6,$370,$43FA00A6,$70254EAE,$FDD84A80,$670C2240 Data $8E90006,$224EAE,$FE6243FA,$9E4EAE,$FFA02040,$20680016,$70000C2E Data $3C0212,$67264AAE,$2A6620,$4AAE002E,$661A4AAE,$326614,$4AAE0222 Data $660E4AAE,$2266608,$4AAE022A,$66024E75,$33FC4000,$DFF09A,$223CAAAA Data $BBBB2D41,$242D41,$262D41,$3E2D41,$4E2D41,$522D41,$22A0C6E Data $240014,$6D044EEE,$FD2A4BFA,$84EAE,$FFE20000,$207C0100,$91E8 Data $FFEC2068,$45588,$4E704ED0,$65787061,$6E73696F,$6E2E6C69,$62726172 Data $7900646F,$732E6C69,$62726172,$79000000 Data "BB_DOS Mark",0 Data $444F5300 Data "BB_OS1.3",12 Data $444F5300,$C0200F19,$370,$43FA0018,$4EAEFFA0,$4A80670A,$20402068 Data $167000,$4E7570FF,$60FA646F,$732E6C69,$62726172,$79000000 Data "BB_OS2.0",23 Data $444F5303,$E33D0E70,$370,$43FA003E,$70254EAE,$FDD84A80,$670C2240 Data $8E90006,$224EAE,$FE6243FA,$184EAE,$FFA04A80,$670A2040,$20680016 Data $70004E75,$70FF4E75,$646F732E,$6C696272,$61727900,$65787061,$6E73696F Data $6E2E6C69,$62726172,$79000000 Data "BB_Quartex2.0",255 Data $444F5300,$1C2238A9,$370,$48E7FF7E,$70026100,$22E7009,$42A90024 Data $6100023A,$41FA03CC,$22690014,$20A9003C,$22690038,$2F0943FA,$2B8303C Data $4E20222E,$3E0481,$80004,$6B043340,$1E4AAE,$4E6704,$3340000A Data $43FA02B6,$207A0394,$41E80034,$4A986604,$33400008,$4A986604,$33400012 Data $4A986604,$3340001C,$4AAE002A,$660C4AAE,$2E6606,$4AAE022A,$671A43FA Data $3237020,$1340001A,$12C012BC,$4145FA,$2D424FC,$56495249,$43F90007 Data $80002449,$4299B3FC,$7F000,$66F62C57,$33FC01A0,$DFF096,$43FA01CE Data $2D490032,$41F90007,$1000214A,$87001,$223C0000,$300243C,$100 Data $4EAEFE7A,$43F90007,$11004EAE,$FF3A43F9,$71100,$237C0007,$10000004 Data $70014EAE,$FEAA4BFA,$1C87800,$7632181D,$672E610E,$6830000,$1806106 Data $4BED001F,$60E843F9,$71100,$20032204,$4EAEFF10,$43F90007,$1100204D Data $701F4EAE,$FFC44E75,$33FC8380,$DFF096,$283C000F,$F0002C78,$45384 Data $670000B8,$43FA025A,$C110041,$661243FA,$1663011,$2400F00,$6400100 Data $32805284,$4BF900BF,$E0010815,$66700,$8E102D,$C00422D,$C004600 Data $B03C00A0,$670000D4,$B03C00A2,$660A203C,$80000,$600000C8,$B03C00A4 Data $66164BF9,$FC00D0,$42AE0026,$4EAEFFE2,$41F80002,$4E704ED0,$B03C00A6 Data $6738B03C,$A86606,$4BFAFFEA,$60DEB03C,$AA6756,$B03C00AC,$66040855 Data $1B03C,$AE6612,$47FA020C,$32130841,$53681,$33C100DF,$F1DC6000 Data $FF52207A,$1F241E8,$3470FF,$20C020C0,$20806112,$43FA01E6,$4EAEFFA0 Data $20402068,$167000,$4E75205F,$588F4CDF,$7EFF2F08,$4E7561F2,$700541F9 Data $50000,$610C7003,$61087004,$61046000,$FDCC41F9,$30000,$23480028 Data $237C0000,$4000024,$42A9002C,$3340001C,$4EAEFE38,$4E75202E,$3E204E Data $4BF900FC,$2800C65,$21FC66FA,$99CC4DF8,$6762640,$43F900DF,$F096203C Data $7FFF7FFF,$22C022C0,$4EE8FFE2,$1002200,$1020001,$920020,$9400D8 Data $8E3000,$9030FF,$E00007,$E28870,$E40007,$E688A0,$1860AAA Data $1840EEE,$1820777,$1800002,$FFFFFFFE,$223C3C3C,$3C3C3C20,$5554494C Data $49545920,$424F4F54,$2056322E,$30203E3E,$3E3E3E3E,$35464153,$544D454D Data $3A4F4646,$20202020,$20203120,$4D454720,$43484950,$3A4F4646,$2C202044 Data $46313A4F,$46462020,$20444632,$3A4F4646,$20202044,$46333A4F,$46462020 Data $43463120,$46415354,$4D454D20,$4F464620,$46322043,$4849502F,$46415354 Data $204F4646,$4C463320,$414C4C20,$4D454D20,$4F4E2020,$4634204B,$494C4C20 Data $44524956,$45532120,$55463520,$48415244,$20524553,$45542020,$46362049 Data $4E535441,$4C4C2042,$4F4F5420,$5E463720,$544F4747,$4C45204C,$45442020 Data $46382054,$4F472050,$414C2F4E,$54534320,$6C20204E,$4F205649,$52555320 Data $48415320,$4245454E,$20444554,$45435445,$44212020,$75424F4F,$54204259 Data $20204E2E,$4F2E4D2E,$412E4420,$204F4620,$51554152,$54455821,$0 Data $0,$646F732E,$6C696272,$61727900 End Proc Procedure _CKSMBB Areg(0)=Start(7) Call Start(14) End Proc Procedure _CKSMBM Loke Start(7),False For I=False To 508 Step 4 Add A,-Leek(Start(7)+I) Next Loke Start(7),A End Proc Procedure _CKSMRB Loke Start(7)+20,False For I=False To 508 Step 4 Add A,-Leek(Start(7)+I) Next Loke Start(7)+20,A End Proc Procedure _DISKBUSY[A] 'A=False:An True:Aus For I=False To 3 If XDRV(I)<>True Then Drive Busy I,A : Wait 50 Next End Proc Procedure _DISKINSERT[A] '255 Nicht eingelegt - 0 Eingelegt A: Trap Dev Do A,14 B=Leek(Dev Base(A)+32) If B _R["No Disk In DF"+Chr$(48+A)+":","Trying Disktest Again?",False] If Param Goto A End If End If If B Then XSTP=True End Proc[B] Procedure _DISKTEST 'Test Insert & Protect Fill Start(7) To Finish(7),False XSTP=False For I=False To 3 If XDRV(I)>1 _PROTECTION[I] Exit If Param End If Next End Proc Procedure _ERR A=Errtrap If A=24 or A=172 or A=166 : A$="Out Of Memory" Else If A=81 : A$="File Not Found" Else If A=82 : A$="Illegal File Name" Else If A=83 : A$="Disc Not Validated" Else If A=84 : A$="Disc Is Write Protected" Else If A=86 : A$="Device Not Available" Else If A=88 : A$="Disc Full" Else If A=89 : A$="File Is Protected Against Deletion" Else If A=92 : A$="Not An AmigaDOS Disc" Else If A=93 : A$="No Disc In Drive" Else If A=94 : A$="I/O Error" Else If A=101 : A$="Disc Error" Else If A=170 : A$="Cannot Open Med.Library" End If If A$="" Then A$="AMOSPro Error #"+Str$(A)-" "+" Occurred" _R[A$+"!","",True] XSTP=True End Proc Procedure _FLOAD[A$,A,B] Trap Open In 1,A$ If Errtrap Then Goto A If B Trap Reserve As Chip Work A,Lof(1) Else Trap Reserve As Work A,Lof(1) End If If Errtrap Then Goto A Trap Sload 1 To Start(A),Length(A) If Errtrap Then Goto A Close Trap Ppk Unpack A : If Errtrap Then Goto A Trap Xpk Unpack A A: If Errtrap Then _ERR : Close : Erase A : C=True End Proc[C] Procedure _FLOPPYTEST If XDI=False Then _ACERR[11] : A=True End Proc[A] Procedure _FREQ[A$] X=(Screen Width/2-130)/16*16+8 Y=(Screen Height/2-70)/16*16-14 Get Cblock 1,X,Y,288,168 Gr Writing False Set Pattern 2 Ink 1,False : Bar X+18,Y+9 To X+284,Y+161 Gr Writing 1 Set Pattern False Cls False,X,Y To X+269,Y+153 Text X+30,Y+9,Left$(A$,29) Text X+82,Y+147,"DISKS" Text X+144,Y+147,"PARENT" Text X+226,Y+147,"OK" _T[X+252,Y+115,"©",True] _T[X+252,Y+125,"®",True] For I=False To 17 Read A,B,C,D,N _G[X+A,Y+B,X+C,Y+D,N] Next 'Verzeichnis bereits eingelesen (Bank 98 & 99) If Length(98) XA=Deek(Start(98)+200) XP=Deek(Start(98)+202) F$=Peek$(Start(98),100,Chr$(0)) Ink 1 Text X+10,Y+132,Left$(F$,29) Text X+10,Y+120,Right$(Cd Path$,29) Gosub _FRC Else Trap Reserve As Work 98,204 Trap Reserve As Work 99,9300 If Errtrap : Goto _FRZ : End If Gosub _FRA End If 'Hauptschleife Do N=Wait Loop Bclr 5,N XM=X Screen(X Mouse)-X YM=Y Screen(Y Mouse)-Y 'Close If N=27 or XM>False and XM<24 and YM>False and YM<13 _G[X,Y,X+23,Y+12,True] Poke$ Start(98),F$+Chr$(0) F$="" Goto _FRZ '[D] Disks Else If N=68 or XM>71 and XM<132 and YM>137 and YM<150 _G[X+74,Y+139,X+129,Y+149,True] Wait 10 Gosub _FRA _G[X+74,Y+139,X+129,Y+149,False] '[P] Parent Else If N=80 or XM>137 and XM<198 and YM>137 and YM<150 _G[X+140,Y+139,X+195,Y+149,True] Cd Parent Gosub _FRB _G[X+140,Y+139,X+195,Y+149,False] '[Return] Ok Else If N=13 or XM>203 and XM<264 and YM>137 and YM<150 _G[X+206,Y+139,X+261,Y+149,True] Poke$ Start(98),F$+Chr$(0) Goto _FRZ '[CSR] Zeile hoch Else If N=30 or XM>248 and XM<264 and YM>111 and YM<124 _G[X+249,Y+112,X+263,Y+123,True] Ink 1 Repeat If XP>False Screen Copy Screen,X+7,Y+17,X+245,Y+100 To Screen,X+7,Y+25 Dec XP Text X+10,Y+26,Peek$(Start(99)+XP*31,29,Chr$(0)) Gosub _FRE End If Until Mouse Key=False _G[X+249,Y+112,X+263,Y+123,False] '[CSR] Zeile runter Else If N=31 or XM>248 and XM<264 and YM>123 and YM<136 _G[X+249,Y+124,X+263,Y+135,True] Ink 1 Repeat If XP5 and XM<247 and YM>19 and YM<108 A=(YM-20)/8 N$=Peek$(Start(99)+(A+XP)*31,29,Chr$(0)) Ink 3,1 : Text X+10,Y+A*8+26,N$ If Instr(N$,":") Gosub _FRD If Exist(N$) Cd Set N$ Gosub _FRB Else Gosub _FRA End If Else If Peek(Varptr(N$))=42 N$=Right$(N$,Len(N$)-1) Gosub _FRD N$=Cd Path$+N$ If Exist(N$) Cd Set N$ Gosub _FRB Else Gosub _FRC End If Else Ink 1,False : Text X+10,Y+132,N$ Clear Mouse Text X+10,Y+A*8+26,N$ Gosub _FRD If F$=N$ and Timer-T<30 Poke$ Start(98),F$+Chr$(0) Goto _FRZ Else F$=N$ T=Timer End If End If 'Dir eintragen Else If XM>5 and XM<247 and YM>111 and YM<124 A$=Cd Path$ YM=Y+120 Gosub _FRF If A$<>"" If Exist(A$) Cd Set A$ Gosub _FRB End If End If Cls False,X+8,Y+113 To X+245,Y+123 Ink 1 : Text X+10,Y+120,Right$(Cd Path$,29) 'File eintragen Else If XM>5 and XM<247 and YM>123 and YM<136 A$=F$ YM=Y+132 Gosub _FRF F$=A$ End If Loop 'Ausgabe der Devs _FRA: N=Start(99) Fill N To Finish(99),False XA=False XP=False N$=Dev First$("") Do N$=Left$(N$,30) N$=Right$(N$,Len(N$)-1) Poke$ N,Left$(N$,29)+Chr$(0) Add N,31 N$=Dev Next$ Inc XA Exit If N$="" Loop Goto _FRC 'Files ermitteln _FRB: N=Start(99) Fill N To Finish(99),False XA=False XP=False N$=Dir First$(Cd Path$) Do Exit If N$="" If Left$(N$,1)<>"*" N$=Right$(N$,Len(N$)-1) End If Poke$ N,Left$(N$,29)+Chr$(0) N$=Dir Next$ Add N,31 Inc XA Exit If XA>299 Loop Cls False,X+8,Y+113 To X+245,Y+123 Ink 1,False : Text X+10,Y+120,Right$(Cd Path$,29) Goto _FRC 'Ausgabe der Eintragungen _FRC: N=Start(99) Cls False,X+8,Y+17 To X+245,Y+111 Ink 1,False For I=False To 10 N$=Peek$(N+(I+XP)*31,29,Chr$(0)) Exit If N$="" Text X+10,Y+26+I*8,N$ Next Text X+24,Y+147,Format$("%03ld",Varptr(XA)) Goto _FRE 'Namen ermitteln _FRD: A=Varptr(N$)+Len(N$)-1 Repeat N=Peek(A) If N=32 Then Poke A,False : Dec A Until N<>32 N$=Peek$(Varptr(N$),29,Chr$(0)) Return 'Scrollbalken _FRE: N=Max(1,XA) If N>10 Then N#=(91.0/N)*(N-11) Else N#=False A=Y+18+XP*(91.0/N) B=Y+109-N#+XP*(91.0/N) Cls False,X+252,Y+18 To X+261,Y+110 Cls 1,X+253,A To X+260,B+1 Return 'Devs/Datei eingeben _FRF: Do Ink 1,False : Text X+10,YM,Right$(A$,28) Ink ,3 : Text X+10+Min(Len(A$)*8,28*8),YM," " N=Wait Loop Exit If N=13 If N>31 and Len(A$)<100 A$=A$+Chr$(N) Else If N=8 and Len(A$)>False Ink ,False Text X+10+Min(Len(A$)*8,28*8),YM," " A$=Left$(A$,Len(A$)-1) End If Loop Ink ,False : Text X+10+Min(Len(A$)*8,28*8),YM," " Return 'Hintergrund restaurieren/Ende _FRZ: Doke Start(98)+200,XA Doke Start(98)+202,XP Wait 10 Put Cblock 1,X,Y Del Cblock 1 If F$="" Then A$="" Else A$=Cd Path$+F$ 'Datas Req-Grafik Data 0,0,23,12,0 Data 9,4,15,8,0 Data 24,0,269,12,0 Data 0,13,269,153,0 Data 6,16,246,111,1 Data 6,112,246,123,1 Data 6,124,246,135,1 Data 249,16,263,111,0 Data 249,112,263,123,0 Data 249,124,263,135,0 Data 6,138,65,150,1 Data 8,139,63,149,0 Data 72,138,131,150,1 Data 74,139,129,149,0 Data 138,138,197,150,1 Data 140,139,195,149,0 Data 204,138,263,150,1 Data 206,139,261,149,0 End Proc[A$] Procedure _FSAVE[A$,A,B] Trap Bsave A$,A To B If Errtrap Then _ERR : C=True End Proc[C] Procedure _G[X,Y,A,B,N] If N Then C=2 : D=5 Else C=5 : D=2 Ink C : Polyline X,B To X,Y To A,Y : Draw X-True,Y To X-True,B+True Ink D : Polyline A,Y To A,B To X,B : Draw A+True,Y To A+True,B+True If N Ink False : Draw X+2,Y-True To X+6,Y-True Else Ink 3 : Draw X+2,Y-True To X+4,Y-True : Plot X+4,Y-True,5 End If End Proc Procedure _GG[X,Y,A,B] _G[X,Y,A,B,True] : _G[X+2,Y-True,A-2,B+True,False] End Proc Procedure _I[A$,B$] A=Screen _O[""] : Screen False Text 15,194,A$+" "+B$ : Ink ,7 : Text 23+Len(A$+B$)*8,194," " Repeat Clear Key : B=Wait Loop If B>31 and B<123 and Len(A$+B$)<73 Then B$=B$+Chr$(B) If B=8 and Len(B$)>False Then B$=Left$(B$,Len(B$)-1) Ink ,4 : Text 23+Len(A$)*8,194,B$+" " Ink ,7 : Text 23+Len(A$+B$)*8,194," " Until B=13 XE$=B$ If B$="" Then XSTP=True Else XSTP=False _O[""] Screen A End Proc[XSTP] Procedure _INSTALLAC Iff Bank 16 To 0 Screen Display 0,,52,,201 Change Bank Font 17 Colour 17,$FFF Colour 18,$E33 Colour 19,$0 Colour Back Colour(False) XN$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-: " XT$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.!?:,-+*#&%$©®/= " For I=False To 3 If XDRV(I)False A=Leek(Dev Base(I)+36) Loke Dev Base(I)+36,False Trap Dev Do I,9 Loke Dev Base(I)+36,A End If Next End Proc Procedure _O[A$] A=Screen Screen False Ink 7,4 : Cls 4,10,188 To 629,196 Text 320-(Text Length(A$)/2),194,A$ Screen A End Proc Procedure _PLAYMUSIC 'Musik abschalten _PMA: If XMU If XMU=1 Music Off Else If XMU=2 N=Lib Call(1,-$36) Areg(0)=Dreg(7) N=Lib Call(1,-$4E) N=Lib Call(1,-$24) Lib Close 1 Else If XMU=3 Pt Stop End If XMU=False Erase 3 Pop Proc End If N$=XACD$+"Music.AC" If Not Exist(N$) _FREQ["Play Abk/Med/Mod Music"] N$=Param$ : If Param$="" : Pop Proc : End If End If Trap Open In 1,N$ If Errtrap Then _ERR : Pop Proc A$=Input$(1,4) Close A$=Upper$(A$) If A$="AMBK" Trap Load N$,3 If Errtrap : _ERR : Pop Proc : End If Music 1 XMU=1 Else If A$="MMD0" or A$="MMD1" Trap Lib Open 1,"medplayer.library",0 If Errtrap : _ERR : Pop Proc : End If XMU=2 N=Lib Call(1,-$1E) Areg(0)=Varptr(N$) Dreg(7)=Lib Call(1,-$48) If Dreg(7)=False : _R["Can`t Load As Med Module!","",True] : Goto _PMA : End If Areg(0)=Dreg(7) N=Lib Call(1,-$2A) Else _FLOAD[N$,3,False] If Param : Pop Proc : End If Bank To Chip 3 Pt Play 3 XMU=3 End If End Proc Procedure _PREFSDFLT Fill Start(10) To Finish(10),$1010101 For I=False To 3 If XDRV(I)<>True Then XDRV(I)= Not Drive("DF"+Chr$(48+I)+":") Next If Drive("DF1:") If XDRV(0)<>True : XDRV(0)=1 : End If If XDRV(1)<>True : XDRV(1)=2 : End If Else If XDRV(0)<>True : XDRV(0)=3 : End If End If XDI=1 XFX=1 XVC=False XCT=1 XRC=False XCD=1 XVFY=False XLOW=1 XUPP=1 XMAB=False XMEN=1 XOPT=1 XFQ=8000 XMF=1 XFN=False XFN$="Empty" XACD$="DEVS:" XPW$="" End Proc Procedure _PREFSLOAD _FLOAD[XACD$+"Prefs.AC",8,False] : If Param Then Pop Proc A=Start(8) If Leek(A)<>Long("ACPS") _R["Not An AMOSCopy Prefsfile!","",False] Else Add A,4 : Copy A,A+160 To Start(10) Add A,160 For I=False To 3 B=Peek(A) If B=$FF : B=True : End If XDRV(I)=B : Inc A Next XLOW=Peek(A) : Inc A XUPP=Peek(A) : Inc A XMAB=Peek(A) : Inc A B=Peek(A) : Inc A If Not B : Close Workbench : End If XVC=Peek(A) : Inc A XVFY=Peek(A) : Inc A XMEN=Peek(A) : Inc A XOPT=Peek(A) : Inc A XFX=Peek(A) : Inc A XFQ=Long(Peek$(A,4)) : Add A,4 XMF=Peek(A) : Inc A XCT=Peek(A) : Inc A XRC=Peek(A) : Inc A XCD=Peek(A) : Inc A XFN=Peek(A) : Inc A XFN$=Peek$(A,128,Chr$(0)) : Add A,Len(XFN$)+1 XACD$=Peek$(A,128,Chr$(0)) : Add A,Len(XACD$)+1 XPW$=Peek$(A,128,Chr$(0)) End If Erase 8 End Proc Procedure _PREFSSAVE A$=XACD$+"Prefs.AC" A=Start(7) 'ID Poke$ A,"ACPS" : Add A,4 'TrkMap Copy Start(10),Finish(10) To A : Add A,160 'Drives For I=False To 3 : Poke A,XDRV(I) : Inc A : Next Poke A,XLOW : Inc A Poke A,XUPP : Inc A Poke A,XMAB : Inc A Poke A,Workbench : Inc A Poke A,XVC : Inc A Poke A,XVFY : Inc A Poke A,XMEN : Inc A Poke A,XOPT : Inc A Poke A,XFX : Inc A Poke$ A,Long$(XFQ) : Add A,4 Poke A,XMF : Inc A Poke A,XCT : Inc A Poke A,XRC : Inc A Poke A,XCD : Inc A Poke A,XFN : Inc A Poke$ A,XFN$ : Add A,Len(XFN$)+1 Poke$ A,XACD$ : Add A,Len(XACD$)+1 Poke$ A,XPW$ : Add A,Len(XPW$)+1 _FSAVE[A$,Start(7),A] If Not Param Then _O["Settings Saved In: "+A$] End Proc Procedure _PROTECTION[A] '255 Nicht gesetzt - 0 Gesetzt A: _DISKINSERT[A] : If Param Then Pop Proc Trap Dev Do A,15 B=Leek(Dev Base(A)+32) If B _R["Disk In DF"+Chr$(48+A)+": Is Write Protected!","Trying Disktest Again?",False] If Param Goto A End If End If If B Then XSTP=True End Proc[B] Procedure _R[A$,B$,A] If Screen107+YR and Y<122+YR If X>136 and X<207 A=27 Else If X>433 and X<503 A=13 End If End If End If If A=27 Then _G[139,108+YR,207,121+YR,True] : A=False : Exit If A=13 Then _G[435,108+YR,501,121+YR,True] : A=True : Exit Loop Wait 15 Clear Key Put Cblock 1,128,50+YR Del Cblock 1 R0: Data "NO","YES" R1: Data "OK","OK" End Proc[A] Procedure _ROOTBLOCK A=Start(7) Fill A To Finish(7),False Poke A+$1B0,Min(25,Len(XE$)) Poke$ A+$1B1,Left$(XE$,25) For I=$204 To $2DF Poke A+I,$FF Next Doke A+2,$2 Poke A+15,$48 Loke A+$138,True Doke A+$13E,$371 Poke A+$1FF,$1 Loke A+$200,$C037 Poke A+$272,$3F If XCD Then Dreg(1)=A+484 : A=Doscall(-192) _CKSMRB End Proc Procedure _SEBLK A=Start(7) _I["Startblock [0-1759]:",""] : Gosub B B=Val(XE$) : B=Min(1759,Abs(B)) _I["Endblock ["+Str$(B)-" "+"-1759]:",""] : Gosub B C=Val(XE$) : C=Min(1759,Abs(C)) If B>C Then Swap B,C Doke A,B Doke A+2,C Doke A+4,C-B+1 Loke A+6,Deek(A+4)*512 _O[Format$("Blocks:%d To %d (%d = %ld Bytes)!",Start(7))] Wait 50 A: Pop Proc[XSTP] B: If Param Then Pop : Goto A Return End Proc Procedure _SEEKMOTOR For I=False To 3 If XDRV(I)>True Loke Dev Base(I)+44,False Trap Dev Do I,10 End If Next End Proc Procedure _SELECTDRIVES 'Source- Targetdrives For I=False To 3 A=24+I*44 : B=A+43 If XDRV(I)<1 C=False : D=False Else If XDRV(I)=1 C=True : D=False Else If XDRV(I)=2 C=False : D=True Else If XDRV(I)=3 C=True : D=True End If _G[A,51,B,63,C] _G[A,88,B,100,D] Next End Proc Procedure _SELECTOR[A$] 'Anzahl der Übergabe XA=(Length(8)/20)-1 'Selector installieren Get Cblock 1,6,35,216,134 Cls False,6,35 To 217,167 _N[112-Len(A$)*4,44,A$,True] _N[26,153,"CANCEL",False] _N[166,153,"OK",False] _T[195,124,"©",True] _T[195,134,"®",True] For I=1 To 14 Read X,Y,A,B,N _G[X,Y,A,B,N] Next N#=60.0/Max(8,XA) Cls 1,194,60 To 203,60+N#*8 Ink 1,False A=False P=True Gosub _STA Do N=Wait Loop Clear Key X=X Screen(X Mouse) Y=Y Screen(Y Mouse) If X>13 and X<186 and Y>58 and Y<130 : Rem * Selektion N=(Y-59)/8 If N<=XA P=N+A B=P : Gosub _STC Ink 3,1 : Text 20,65+N*8,N$ Ink 1,False : Text 20,141,N$ Clear Mouse Text 20,65+N*8,N$ End If Else If X>15 and X<82 and Y>150 and Y<162 : Rem * Cancel _G[16,149,81,161,True] P=True Wait 25 Goto _STD Else If X>139 and X<206 and Y>150 and Y<162 : Rem * Ok _G[140,149,205,161,True] Wait 25 Goto _STD End If If X>191 and X<207 If Y>59 and Y<120 : Rem * Balken scrollen If Point(X,Y) N=A Ink 1 Cls False,194,60 To 203,120 Cls 3,194,60+A*N# To 203,60+A*N#+N#*8 Repeat If A<>N A=N Cls False,194,60 To 203,120 Cls 3,194,60+A*N# To 203,60+A*N#+N#*8 Gosub _STA End If N=(Y Screen(Y Mouse)-60)/N# N=Min(XA-Min(XA,8),Max(False,N)) Until Mouse Key=False Gosub _STB End If Else If Y>121 and Y<133 : Rem * Zeile hoch _G[192,122,206,132,True] Ink 1 Wait 5 Repeat If A Dec A B=A : Gosub _STC Screen Copy False,20,59,182,123 To False,20,67 Text 20,65,N$ Gosub _STB End If Until Mouse Key=False _G[192,122,206,132,False] Else If Y>132 and Y<144 : Rem * Zeile runter _G[192,133,206,143,True] Ink 1 Wait 5 Repeat If A+8XA B=A+I : Gosub _STC Text 20,65+I*8,N$ Next Return _STB: Cls False,194,60 To 203,120 : Cls 1,194,60+A*N# To 203,60+A*N#+N#*8 Return _STC: N$=Peek$(Start(8)+B*20,20,Chr$(0))+Chr$(0) B=Varptr(N$) : N$=Format$("%-20s",Varptr(B)) Return _STD: Put Cblock 1,6,35 : Del Cblock 1 'Umrandung Data 6,35,216,166,1 Data 8,36,214,165,0 'Header Data 14,39,208,54,1 Data 16,40,206,53,0 'Databox Data 14,57,185,132,1 'Selektionsbox Data 14,133,185,144,1 'Scrollumrandung Data 190,57,208,144,1 'Scrollbox Data 192,58,206,121,0 'Hoch Data 192,122,206,132,0 'Runter Data 192,133,206,143,0 'Cancel Data 14,148,83,162,1 Data 16,149,81,161,0 'Ok Data 138,148,207,162,1 Data 140,149,205,161,0 End Proc[P] Procedure _SFX If XFX and XMU=False If Length(5) Sam Raw %1111,Start(5),Length(5),XFQ Else Play 1,7,50 End If End If End Proc Procedure _SORT[A,B] 'A:Bank - B:Stringlen N=Length(A)/B-1 For I=False To N-1 For I2=I To N C=Start(A)+I*B D=Start(A)+I2*B If Leek(C)>Leek(D) Copy C,C+B To Start(7) Copy D,D+B To C Copy Start(7),Start(7)+B To D End If Next Next End Proc Procedure _SYSTIME 'Looptime A$=Space$(6) A=Varptr(A$) B=Timer/50 C=B/60 Doke A,C/60 Doke A+2,C mod 60 Doke A+4,B mod 60 Text 458,12,Format$("%02d:%02d:%02d",A) 'Systime Dreg(1)=Start(7) B=Doscall(-192) C=Leek(B+4) Doke A,C/60 Doke A+2,C mod 60 Doke A+4,Leek(B+8)/50 Text 458,24,Format$("%02d:%02d:%02d",A) 'Sysfree Loke A,Chip Free : Text 546,12,Format$("C:%08ld",A) Loke A,Avail Free : Text 546,24,Format$("T:%08ld",A) Every On End Proc Procedure _T[X,Y,A$,A] A=Abs(A)*9 B=Len(A$) For I=1 To B C=Instr(XT$,Mid$(A$,I,1)) If C Then Screen Copy False,(C-1)*8,202+A,C*8,211+A To Screen,X+(I-1)*8,Y Next End Proc Procedure _TARGETS[A] If A<>1 Then _ACERR[10] : Pop Proc[True] End Proc[False] Procedure _TDDEVSOPEN 'XDRV() -> NOT AVAIL:-1 OFF:0 SOURCE:1 TARGET:2 SOURCE&TARGET:3 For I=False To 3 If Drive("DF"+Chr$(48+I)+":") Dev Open I,"trackdisk.device",56,I,False Else XDRV(I)=True End If Next End Proc Procedure _TDERROR[A] If A>8 Then A=1 For I=1 To A Read A$ Next Data "Not Specified","No Sector Header","Bad Sector Preamble","Bad Sector ID" Data "Bad Header Summ","Bad Sector Sum","Too Few Sectors","Bad Sector Header" End Proc[A$] Procedure _TIME A=Timer/50 Doke Varptr(B),A/60 Doke Varptr(B)+2,A mod 60 _N[154,136,Format$("%02d:%02d",Varptr(B)),False] End Proc Procedure _TOOLS[N] Dim N$(1) N$(0)=" On" N$(1)=" Off" If N=True Restore _TA Do Read A$ : Exit If A$="" Inc A Loop Reserve As Work 8,A*20 Restore _TA For I=False To A Read A$ Poke$ Start(8)+I*20,A$ Next _SORT[8,20] _SELECTOR["TOOLMENU"] If Param2 A=Screen Colour Ror.b 1,A Trap Screen Open 1,Screen Width,Screen Height,A,Hires If Errtrap=False Change Bank Font 17 Screen Hide 1 Flash Off Screen Copy False To 1 Screen Close False : Wait Vbl Screen Open False,Screen Width,Screen Height,A,Hires Screen Hide False Flash Off Palette $79,$0,$FFF,$FF0 Screen Copy 1 To False Screen Close 1 : Wait Vbl Screen Display False,,,,201 Screen Show False Change Bank Font 17 Else _ERR End If Else If N=10 Add XCT,1,False To 1 Else If N=11 _I["Def Format Name:",XFN$] XFN$=XE$ Else If N=12 Add XFN,1,False To 1 Else If N=13 _I["AMOSCopy Path:",XACD$] XACD$=XE$ Else If N=14 _I["Password:",""] XPW$=XE$ Else If N=15 Add XRC,1,False To 1 _G[112,115,135,127,XRC] Else If N=16 _FREQ["Load SFX Sample"] If Param$<>"" _FLOAD[Param$,5,True] : If Param : Pop Proc : End If _SFX End If Else If N=17 _I["SFX Frequency:",Str$(XFQ)-" "] If Not Param XFQ=Val(XE$) XFQ=Max(1000,XFQ) End If _SFX Else If N=18 Add XCD,1,False To 1 Else If N=19 Add XMF,1,False To 1 If XMF : Led On Else Led Off : End If Else If N=20 For I=False To 3 If XDRV(I)=3 XDRV(I)=True Cls False,26+I*44,55 To 66+I*44,61 Cls False,26+I*44,92 To 66+I*44,98 _N[35+I*44,55,"OFF",False] _N[35+I*44,92,"OFF",False] End If Next _SELECTDRIVES Else If N=21 For I=False To 3 If XDRV(I)>1 _O["Initializing DF"+Chr$(48+I)+":!"] Drive Busy I,True : Wait 30 Drive Busy I,False : Wait 30 If XDI=False : Drive Busy I,True : Wait 30 : End If End If Next Else If N=22 Close Editor Else If N=23 Kill Editor End If _TA: Data "Diskinterrupt"+N$(XDI) Data "SFX Sample"+N$(XFX) Data "Music"+N$(Min(1,XMU)) Data "Workbench"+N$(Abs(Workbench)) Data "Viruscheck"+N$(XVC) Data "Restore Memory" Data "Prefs Default" Data "Prefs Load" Data "Prefs Save" Data "Sub Maskplane" Data "Clean Trackmap"+N$(XCT) Data "Format Name Def" Data "Format Name Inc"+N$(XFN) Data "AMOSCopy Path" Data "Password Protection" Data "Repeat Copy"+N$(XRC) Data "SFX Sample Load" Data "SFX Frequency" Data "Create Date"+N$(XCD) Data "Music Filter"+N$(XMF) Data "Close S & T Drive" Data "Initialize Target" Data "{Close Editor}" Data "{Kill Editor}" Data "" End Proc Procedure _TRKCK[A,B] 'Hardtrack-Fehler? C=Peek(Dev Base(A)+31) mod 19 _2[B,C] If C>False _MOTOROFF _SFX _TDERROR[C] _R["Error On DF"+Chr$(48+A)+":, Track #"+Str$(B)-" ",Param$+", Abort Process?",False] If Param XSTP=True End If End If End Proc[XSTP] Procedure _TRKDO[A,B,C,D,E] 'A:DFn B:Blk/Trk C:Bts D:Mem E:Cmd Loke Dev Base(A)+36,C Loke Dev Base(A)+40,D Loke Dev Base(A)+44,B*C Trap Dev Do A,E End Proc Procedure _TRKMN A$=XACD$+"TrackMaps.AC" X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) If X>15 and X<67 X=(X-16)/17 If Y>131 and Y<145 _G[16+X*16+X,132,32+X*16+X,144,True] If X=False : Rem * L _FLOAD[A$,13,False] If Param=False _O["Installed TrackMaps:"+Str$(Length(13)/40)-" "] End If Else If X=1 and Length(13) : Rem * S _FSAVE[A$,Start(13),Finish(13)] If Param=False _O["TrackMaps Saved In: "+A$] End If Else If X=2 and Length(13) : Rem * E N=Length(13)/40 Reserve As Work 8,N*20 For I=False To N-1 Poke$ Start(8)+I*20,Peek$(Start(13)+I*40,20,Chr$(0)) Next _SELECTOR["ERASE TRACKMAP"] If Param>True _O["TrackMap Erased: "+Peek$(Start(13)+Param*40,20,Chr$(0))] If Length(13)>40 and Param=Length(13)/40-1 Bank Shrink 13 To Length(13)-40 Else If Length(13)>40 Copy Start(13)+(Param+1)*40,Finish(13) To Start(13)+Param*40 Bank Shrink 13 To Length(13)-40 Else If Length(13)=40 Erase 13 End If End If End If _G[16+X*16+X,132,32+X*16+X,144,False] Else If Y>148 and Y<162 _G[16+X*16+X,149,32+X*16+X,161,True] If Length(13) N=Length(13)/40 Reserve As Work 8,N*20 For I=False To N-1 Poke$ Start(8)+I*20,Peek$(Start(13)+I*40,20,Chr$(0)) Next End If If X=False and Length(13) : Rem * R _SELECTOR["RENAME TRACKMAP"] If Param>True _I["Rename TrackMap As:",Peek$(Start(13)+Param*40,20,Chr$(0))] If Not Param XE$=Left$(XE$,20) XE$=XE$+String$(Chr$(0),20-Len(XE$)) Poke$ Start(13)+Param*40,XE$ End If _SORT[13,40] End If Else If X=1 : Rem * I _I["Name Of TrackMap:",""] If Not Param N$=Left$(XE$,20) N=Length(13) Reserve As Work 8,N+40 If N Copy Start(13),Finish(13) To Start(8) End If Poke$ Start(8)+Length(13),N$ For I=False To 4 N=False For I2=False To 31 If Peek(Start(10)+I*32+I2) Bset I2,N End If Next Loke Start(8)+Length(13)+20+I*4,N Next Bank Swap 8,13 _O["Installed TrackMaps:"+Str$(Length(13)/40)-" "] _SORT[13,40] End If Else If X=2 and Length(13) : Rem * P _SELECTOR["PUT TRACKMAP"] If Param>True For I=False To 4 N=Leek(Start(13)+Param*40+20+I*4) For I2=False To 31 Poke Start(10)+I*32+I2,Abs(Btst(I2,N)) Next Next _BITMAP[False] _O["TrackMap Installed: "+Peek$(Start(13)+Param*40,20,Chr$(0))] _SFX End If End If _G[16+X*16+X,149,32+X*16+X,161,False] End If End If End Proc Procedure _TRKON[A] 'Param=True wenn Track offen If Btst(False,Start(10)+A) A=A mod 2 If A=False and XLOW B=True Else If A=1 and XUPP B=True End If End If End Proc[B] Procedure _TRKRW[A,B,C] Loke Dev Base(A)+36,14716 Loke Dev Base(A)+40,Start(7) Loke Dev Base(A)+44,B Trap Dev Send A,C End Proc Procedure _TRKSD[A,B,C,D,E] 'A:DFn B:Blk/Trk C:Bts D:Mem E:Cmd Loke Dev Base(A)+36,C Loke Dev Base(A)+40,D Loke Dev Base(A)+44,B*C Trap Dev Send A,E End Proc Procedure _UPDATEAC _SELECTDRIVES _G[16,115,39,127,XDI] If XDI=False Then _DISKBUSY[True] _G[40,115,63,127,XVC] _G[64,115,87,127,Workbench] _G[112,115,135,127,XRC] _G[75,132,140,144,XVFY] _G[142,132,206,144,False] _N[154,136,"00:00",False] _BITMAP[False] 'Upp & Low On - Off _G[243,153,271,165,XLOW] _G[451,153,479,165,XUPP] _MENU If XMF Then Led On Else Led Off End Proc Procedure _VIRUSTEST[A] If XVC=False Then Pop Proc If Vectorptr For I=False To 5 Read A$,B B=Leek(Leek(4)+B) If B A$=A$+" Is Abnormal, "+Hex$(B,8) If A _R[A$,"Maybe A Virus, Abort Process?",False] XSTP=Param Exit If Param Else _R[A$,"Be Carefull Or Choose Option Hardreset!",True] End If End If Next End If Data "ColdCapture",$2A Data "CoolCapture",$2E Data "WarmCapture",$32 Data "KickMemPtr",$222 Data "KickTagPtr",$226 Data "KickCheckSum",$22A End Proc Procedure _WAIT Wait 50 Clear Key Clear Mouse While A=False A=Asc(Inkey$) If Mouse Key Then _ABORT : Exit Multi Wait Wend If A=27 Then XSTP=True End Proc Procedure _XPKDISK[XDFN] XDIR$="LIBS:Compressors" If File Type(XDIR$)=False Then _ACERR[12] : Pop Proc If Length(11)=False Reserve As Work 11,4000 A=Start(11) A$=Dir First$(XDIR$) Do Poke$ A+B*20,Peek$(Varptr(A$)+4,4) Exit If A$="" Add B,1,0 To 199 A$=Dir Next$ Loop Bank Shrink 11 To B*20 End If Bank Swap 11,8 Proc _SELECTOR["SELECT XPK MODE"] If Param=True Then XSTP=True : Pop Proc XPK$=Peek$(Start(8)+Param*20,4) _FREQ["XPK Disk To File"] If Param$="" Then XSTP=True : Pop Proc XFILE$=Param$ _I["Xpk "+XPK$+" Method:","100"] If Param Then Pop Proc XM=Val(XE$) Bank Swap 8,11 Reserve As Work 8,320 Trap Open Out 1,XFILE$ If Errtrap Then _ERR : Pop Proc Print #1,"ACXP"; Ssave 1,Start(8) To Finish(8) Timer=False For I=False To 159 _TRKON[I] If Param Reserve As Chip Work 7,5632 _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param _1[I,False] _MOTOROFF A=Leek(Start(7)) For B=4 To 5628 Step 4 If Leek(Start(7)+B)<>A B=True : Exit End If Next If B=True Xpk Pack 7,XPK$,XM C=Length(7) If Xpk Errn or C>5632 If Xpk Errn _R["Fatal XPK Error "+Str$(Xpk Errn),Xpk Err$,True] XSTP=True : Exit End If Reserve As Chip Work 7,5632 C=5632 _TRKDO[XDFN,I,5632,Start(7),2] _TRKCK[XDFN,I] : Exit If Param End If Else C=4 End If Doke Start(8)+I*2,C Add D,C Add E,5632 A#=100.0-((100.0/5632)*C) _O["Track:"+Str$(I)-" "+" Gain:"+Str$(A#)-" "+"% ("+Str$(5632-C)-" "+" Bytes) Out:"+Str$(C)-" "+" Bytes!"] Trap Ssave 1,Start(7) To Start(7)+C If Errtrap : _ERR : Exit : End If _0[I,False] Wait 10 _TIME End If If Mouse Key Then _ABORT : Exit If Param Next Close If XSTP Then Trap Kill XFILE$ : Pop Proc Append 1,XFILE$ Pof(1)=4 Ssave 1,Start(8) To Finish(8) Close A#=100.0-((100.0/E)*D) _O["Total Gained:"+Str$(A#)-" "+"% ("+Str$(E-D)-" "+" Bytes) Out:"+Str$(324+D)-" "+" Of"+Str$(E)+" Bytes!"] Wait 100 End Proc