home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format 67
/
af067a.adf
/
ACCESS.DMS
/
ACCESS.adf
/
Disc_Manager.AMOS
/
Disc_Manager.amosSourceCode
< prev
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
NeXTSTEP
RISC OS
UTF-8
Wrap
AMOS Source Code
|
1993-03-16
|
48.2 KB
|
1,679 lines
'----------------------------------
' AMOS Professional Disc Manager
' by Fran�ois Lionet
' (c) 1992 Europress Software Ltd.
'----------------------------------
' Set bigger buffer for better speed
Set Buffer 80
VER$="1.1"
' Maximum number of files looked for
Global MXFF
MXFF=2000
' Maximum number of files in displayed directory
Global MXFILE
MXFILE=350
' Never break out of the program!
Break Off
' More memory!
Close Editor
Dim MN$(55),FLAG(5),XDIR(1),XSLI(1),FILE$(1,MXFILE),SIZE(1,MXFILE),FLAG$(1)
Dim SDIR(1),PDIR(1),OPDIR(1),PATH$(1),XFILE(1),SSL(1),ESL(1),DFRI(1),DNAME$(1)
Dim OK(1),FILT$(1)
Dim FF$(MXFF)
Dim D$(12),R$(12)
Global MN$(),NMN,FLAG(),YMN,MNDOWN
Global FILE$(),SIZE(),FLAG$()
Global XDIR(),YDIR,SXDIR,SYDIR,SDIR(),PDIR(),DFRI(),DNAME$(),OK()
Global XFILE(),YFILE,SXFILE,NLINE,LFILE
Global XSLI(),YSLI,SXSLI,SYSLI,SSL(),ESL()
Global PATH$(),XPATH,YPATH,SXPATH,SYPATH,FILT$()
Global XINF,YINF,SXINF,SYINF
Global MX,MY,MZ,MK
Global C0,C1,C2,C3,C4,C5,C6,C7,CA,CNA,ACT
Global SYWORK,DEV$,ACT,NFILT$
Global FFERR,FF$(),NFF,PFF,NDD,NSP,TSIZE
Global BLOC,ALERT,PAL$
Global DBANK
DBANK=11
Global SREAD,BUF_L,LINE_END,SCR_TY,SCR_TL,SCR_V,PTEXTE,SCR_Y,Y_BASE
BUF_L=2000 : Y_BASE=45 : SREAD=4
SYWORK=256 : If Ntsc : SYWORK=200 : End If
CA=5 : CNA=4
C0=2 : C1=6 : C2=2 : C3=1 : C4=3 : C5=4 : C6=7 : C7=5
SAMSP=10169
Request Off
Resource Bank 16
BPIC=10 : MN1=15 : MNDOWN=41
N=20 : Repeat : N=N+1 : Read MN$(N) : Until MN$(N)="End" : NMN=N-1 : _SET_FLAGS
Data "A 01000004288016_Act","a 03352004288016_Act"," 02288004064016_MnQuit"
Data " 90000020272016_Path"," 05272020016008_Dn0"," 06272028016008_Up0"," 07288020032016_Par0"," 07320020032016_Par1"," 05352020016008_Dn1"," 06352028016008_Up1"," 91368020272016_Path"
Data "/ 00_Name","/ 00_Name","/ 00_Sl","/ 00_Sl"
Data " 11288037032012_All"
Data " 12320037032012_Clear"
Data "FA13288049032012_DInfo"
Data "FB14320049032012_Sizes"
Data " 15288061032012_Flip"
Data " 16320061032012_Infos"
Data " 17288073064012_Copy"
Data " 18288085064012_Ren"
Data " 19288097064012_Del"
Data " 20288109064012_MDir"
Data " 21288121064012_OBig"
Data " 22288133064012_Exam"
Data " 24288145064012_Format"
Data " 25288157064012_DCopy"
Data "End"
_DIA0: Data 100,3,"End"
_DIA1: Data 100,3," 28552016064012_DOut","End"
_DIA4: Data 92,5," 19360032064012_DGo"," 29424032064012_DGo"," 34488032064012_DGo"," 30552032064012_DOut","End"
_DIAD: Data 100,3," 30552016064012","End"
_DIA2: Data 92,5," 17488032064012"," 30552032064012","End"
_DIA1B: Data 100,4," 30552024064012","End"
_DIA2B: Data 92,3," 26488016064012"," 27552016064012","End"
_FNAME$="Empty" : FLAG(2)=1
SDRV$="Df0:" : SDRV=0 : DDRV$="Df0:" : DDRV=0
LFILE=48 : NFLT$=".info/*.info/*.*.info/*.*.*.info"
NFILT$=NFLT$ : If FLAG(0) : NFILT$="" : End If : Set Dir LFILE,NFILT$
ACT=-1 : _INIT_WORK
_DISPLAY_ACT[0]
' Main loop
Timer=999
ACT=1 : MK=2 : MZ=32 : MX=480 : Gosub _NAME
ACT=0 : MK=2 : MZ=32 : MX=160 : Gosub _NAME
Do
Repeat
_MOUSE
If FMK : MK=FMK : MZ=FMZ : MX=FMX : MY=FMY : FMK=FMK2 : FMK2=0 : FMZ=FMZ2 : End If
If ALERT
ALERT=ALERT-1
If ALERT=0 : _DISPLAY_INF[ACT] : End If
End If
Until MK<>0 and MZ<>0
MFLAG=0
Do
MFLAG=MFLAG+1
If MZ<>0 and MFLAG=1
If MZ<=NMN
A$=Left$(MN$(MZ),1) : B$="" : Z=MZ
If A$<>"/"
If A$=" "
If BREL<>MZ : BREL=MZ : _DISPLAY_MN[MZ,1] : End If
Else
C$=Upper$(A$) : D$=Lower$(A$)
If(C$<>A$) or(D$<>A$)
If A$="F" : B$="f" : STATE=0 : End If
If A$="f" : B$="F" : STATE=1 : End If
If B$=""
B$=C$
For N=1 To NMN
If Left$(MN$(N),1)=C$
Left$(MN$(N),1)=D$ : _DISPLAY_MN[N,0]
End If
Next
End If
End If
End If
If B$<>"" : Left$(MN$(MZ),1)=B$ : _DISPLAY_MN[MZ,-1] : End If
G$="" : P=Instr(MN$(MZ),"_") : If P : G$=Mid$(MN$(MZ),P) : End If
If G$<>"" : Gosub G$ : End If
Else
G$="" : P=Instr(MN$(MZ),"_") : If P : G$=Mid$(MN$(MZ),P) : End If
If G$<>"" : Gosub G$ : End If
End If
If G$<>"_Name" : DCLICK=-1 : FCLICK=-1 : End If
End If
End If
OMK=MK : OMZ=MZ : _MOUSE
If MK=0 : Exit : End If
If MZ<>OMZ : Exit : End If
Loop
If BREL : _DISPLAY_MN[BREL,0] : BREL=0 : End If
Loop
_DBUG:
Default : CPT=0
_BIG: Pop : CPT=CPT+1 : Goto _BIG
_MNQUIT:
_WAIT_NOMK : R=1
If MK=1
D$(2)=Resource$(89) : Restore _DIA2B : Gosub _DIALOG
Repeat : Gosub _DODIALOG : Until R
End If
If R=1
Fade 1 : Wait 16 : Screen Close 0
Request On
Edit
End If
_ERASE_DIALOG
Return
' Infos
_INFOS:
Restore _DIAI : D$(2)=Resource$(80)+VER$ : D$(4)=Resource$(81) : D$(5)=Resource$(82) : D$(7)=Resource$(83) : _WAIT_NOMK : Goto _DIALOG
_DIAI: Data 80,8," 28552056064012_DOut","End"
' Disk copy
_DCOPY:
_WAIT_NOMK
Restore _DIAC : D$(1)=Resource$(69) : D$(3)=Resource$(70) : D$(5)=Resource$(71) : Gosub _DIALOG : YC=Y Curs-2 : Gosub _CPM
FMK=1 : FMZ=1+SDRV : FMK2=1 : FMZ2=4+DDRV
If FLAG(2) : Left$(MN$(9),1)="F" : _DISPLAY_MN[9,-1] : End If : Return
_DIAC:
Data 92,8
Data "z 31160017064012_sDf0","z 32224017064012_sDf1","z 33288017064012_sDf2"
Data "y 31160034064012_dDf0","y 32224034064012_dDf1","y 33288034064012_dDf2"
Data " 05024052016008_Cpup"," 06040052016008_Cpdn"
Data "fC23384056064012_SFlag"," 25488056064012_DCop"," 30552056064012_DOut","End"
_DDF0: DDRV=0 : DDRV$="Df0:" : Return
_DDF1: DDRV=1 : DDRV$="Df1:" : Return
_DDF2: DDRV=2 : DDRV$="Df2:" : Return
_CPUP: MULT=MULT+1 : Goto _CPM
_CPDN: If MULT : MULT=MULT-1 : End If
_CPM: Locate 9,YC : Print Resource$(77);MULT+1;" "; : Return
_DCOP:
Gosub _DOUT : D$(1)=Resource$(72)+SDRV$+Resource$(73)+DDRV$+Resource$(6) : Gosub _IDISC : YN=Y Curs-5
E=79
_TRACK_OPEN[0,SDRV]
If Param=0
_TRACK_OPEN[1,DDRV]
If Param=0
_DISK_BUSY[SDRV,True] : If SDRV<>DDRV : _DISK_BUSY[DDRV,True] : End If
E=0 : TR=0 : TTW=0 : LP=0
Repeat
If LP=0 or SDRV=DDRV
Centre At(,YN)+Resource$(74)+SDRV$+Resource$(76)
Bell : _WAIT_MK : If Param$=Chr$(27) : E=90 : Exit : End If
Centre String$(" ",72)
Wait 50
End If
_TRACK_MOTOR[0,1]
Repeat
T=TR : Ink C7,C7,C7 : Gosub _DDISC
_TRACK_READ[0,TR] : If Param : E=79 : Exit 2 : End If
_TRACK_STORE[0,TR] : Exit If Param
TR=TR+1
If Chip Free+Fast Free<16*1024 : Exit : End If
If Inkey$=Chr$(27) : E=90 : Exit 2 : End If
Until TR=160
_TRACK_MOTOR[0,0]
For CD=0 To MULT
TW=TTW
If LP=0 or SDRV=DDRV or MULT<>0
Centre At(,YN)+Resource$(75)+DDRV$+Resource$(76)
If MULT
Centre At(,YN+1)+Resource$(78)+Str$(CD+1)+"!"
End If
Bell : _WAIT_MK : Centre At(,YN)+String$(" ",72) : Centre At(,YN+1)+String$(" ",72)
If Param$=Chr$(27) : E=90 : Exit 2 : End If
Wait 50
End If
If MULT : Ink C7,C7,C7 : For T=TTW To TR-1 : Gosub _DDISC : Next : End If
_TRACK_MOTOR[1,1]
Repeat
_TRACK_USTORE[1,TW]
If TW=80
Loke Start(_TDB+1)+106*4,Timer : Loke Start(_TDB+1)+107*4,Timer : _TRACK_CHECKSUM[1]
End If
For ESS=0 To 2
_TRACK_FORMAT[1,TW]
E=0 : If Param : E=79 : End If
If E=0
If FLAG(2)
T=TW : Ink C1,C1,C1 : Gosub _DDISC
_TRACK_VERIFY[1,TW] : If Param : E=67 : End If
End If
If E=0 : Exit : End If
End If
Next
If E : Exit 3 : End If
T=TW : Ink C4,C4,C4 : Gosub _DDISC
If Inkey$=Chr$(27) : Bell : E=90 : Exit 3 : End If
TW=TW+1
Until TW=TR
_TRACK_MOTOR[1,0]
Next
TTW=TW : _TRACK_FREE
LP=1
Until TR=_TDTRACKS
_TRACK_FREE
_TRACK_MOTOR[0,0] : _TRACK_MOTOR[1,0]
_DISK_BUSY[SDRV,False] : If SDRV<>DDRV : _DISK_BUSY[DDRV,False] : End If
End If
_TRACK_CLOSE[0] : _TRACK_CLOSE[1]
End If
Erase 13 : Erase 14
If E
Gosub _DOUT : D$(2)=Resource$(E) : Restore _DIA1 : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
End If
Gosub _DOUT : Goto _DCOPY
' Format
_FORMAT:
_WAIT_NOMK
Restore _DIAF : D$(1)="*"+Resource$(65) : Gosub _DIALOG
XN=12 : YN=Y Curs-3 : Print At(XN,YN);_FNAME$;
FMK=1 : FMZ=2+SDRV
If FLAG(2) : Left$(MN$(5),1)="F" : _DISPLAY_MN[5,-1] : End If
If FLAG(3) : Left$(MN$(6),1)="F" : _DISPLAY_MN[6,-1] : End If : Return
_DIAF: Data 92,5," 35024017064012_FName","Z 31024032064012_sDf0","z 32088032064012_sDf1","z 33152032064012_sDf2","fC23280032064012_SFlag","fD40344032064012_SFlag"," 24488032064012_FFor"," 30552032064012_DOut","End"
_DIAZ: Data 84,6,"End"
_SDF0: SDRV=0 : SDRV$="Df0:" : Return
_SDF1: SDRV=1 : SDRV$="Df1:" : Return
_SDF2: SDRV=2 : SDRV$="Df2:" : Return
_FNAME:
Locate XN,YN : Pen C4 : _LEDIT[_FNAME$,640,XN,YN,77-X Curs,0]
If Param$<>"_Esc_" and(Param$<>"") and Instr(Param$,":")=0 : _FNAME$=Left$(Param$,31) : End If
Pen C3 : Print At(XN,YN);String$(" ",77-X Curs);
Print At(XN,YN);_FNAME$ : Return
_FFOR:
Gosub _DOUT : D$(2)=Resource$(68)+SDRV$+Resource$(6) : Gosub _IDISC
E=0 : SYS=0 : If FLAG(3) : SYS=512*3 : End If
_TRACK_OPEN[0,SDRV]
If Param=0
_DISK_BUSY[SDRV,-1]
_TRACK_MOTOR[0,1] : E=0 : AMS$="@@@@"
For T=0 To _TDTRACKS-1
Ink C4,C4,C4 : Gosub _DDISC
If Inkey$=Chr$(27) : Bell : E=91 : Exit : End If
Fill Start(_TDB) To Start(_TDB)+_TDSIZE,Leek(Varptr(AMS$))
If T=0 : Copy Start(9)+SYS,Start(9)+SYS+512 To Start(_TDB) : End If
If T=80
Copy Start(9)+SYS+512,Start(9)+SYS+512+1024 To Start(_TDB)
Loke Start(_TDB)+106*4,Timer : Loke Start(_TDB)+123*4,Timer
Poke Start(_TDB)+108*4,Len(_FNAME$) : For N=1 To Len(_FNAME$) : Poke Start(_TDB)+108*4+N,Asc(Mid$(_FNAME$,N,1)) : Next
_TRACK_CHECKSUM[0]
End If
For ESS=0 To 2
_TRACK_FORMAT[0,T]
E=0 : If Param : E=66 : End If
If E=0
If FLAG(2)
_TRACK_VERIFY[0,T] : If Param : E=67 : End If
End If
If E=0 : Exit : End If
End If
Next
If E : Exit : End If
Next
_TRACK_MOTOR[0,0]
_DISK_BUSY[SDRV,0]
_TRACK_CLOSE[0]
Erase 13 : Erase 14
End If
If E
Gosub _DOUT : D$(2)=Resource$(E) : Restore _DIA1 : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
End If
Gosub _DOUT : Goto _FORMAT
_IDISC:
Restore _DIAZ : Gosub _DIALOG : YY=Y Curs*8-18 : XX=40
SXX=80*7 : SYY=16
Ink C3,C2,C3 : Set Pattern 1 : Set Paint 1 : BBAR[0,XX,YY,XX+SXX,YY+SYY]
Dec SXX
Return
_DDISC:
X1=(T*SXX)/_TDTRACKS : X2=((T+1)*SXX)/_TDTRACKS
BBAR[0,XX+X1+1,YY+1,XX+X2,YY+SYY-1] : Return
' Examine
_EXAM:
If OK(ACT)=0 : Return : End If
D=ACT : Gosub _ASK_DISC : If R : Return : End If : _GET_SELECTED_FILES
_EXNXT:
On Error Goto _EXERR0
Repeat
_GET_FF[" -.",ACT] : FF$=Param$
A$=Left$(FF$(PFF),1) : If A$="." or(A$=" ") : _UNLIGHT_FILE[PFF,1] : End If
Until A$<>"."
If FF$<>""
D$(2)=Resource$(40)+Right$(FF$,60)
Open In 1,FF$ : LF=Lof(1) : A$=Input$(1,Min(LF,$440)) : Close 1
Restore _HEAD
Do
Read PEX
Do
Read H$
If PEX=0
If H$<>"" : F=0 : Gosub H$ Else F=-1 : End If
Else
L=Len(H$) : B$=Mid$(A$,PEX,L)
F=H$=B$
End If
If F=0 : Exit : End If
Read PEX
If PEX<0
PEX=-PEX : Read G$,D,G$ : D$(3)=Resource$(D) : Restore G$ : Goto _DIALOG
End If
Loop
Do : Read P : If P=-100 : Exit : End If : Read G$ : Loop
Loop
_EXOUT: MZ=0 : Gosub _DOUT
End If
Return
_EXNX: Gosub _DOUT : Goto _EXNXT
_EXERR:
Gosub _DOUT
_EXERR0:
Close : Erase 5 : D$(2)=Resource$(56)+Right$(FF$,40) : Restore _DIAD : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
Resume _EXNX
' HEAR
_EXHEAR:
Volume 63
Gosub _DOUT : D$(2)=Resource$(20)+Right$(FF$,60) : Restore _DIA0 : Gosub _DIALOG
Timer=0 : On PEX Goto _EXMUS,_EXSAM,_EXSAM,_EXSAMB,_EXTR,_EXBT,_EXTMED
_EXBT:
On Error Goto _EXERR : Load FF$,3 : Track Play 3 : Goto _EXM2
_EXTR:
On Error Goto _EXERR : Track Load FF$,3 : Track Play : Goto _EXM2
_EXTMED:
On Error Goto _EXERR : Med Load FF$,3 : Med Play : Goto _EXM2
_EXMUS:
On Error Goto _EXERR : Load FF$,3 : Music 1
_EXM2:
While Timer<25 : Wend
Gosub _DOUT : D$(2)=Resource$(60)+Right$(FF$,60) : Restore _DIA1 : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
Music Off : Track Stop : Med Stop : Erase 3 : Goto _EXNX
_EXSAMB:
On Error Goto _EXERR
Load FF$,5 : Sam Bank 5 : NSAM=Deek(Start(5))
While Timer<25 : Wend
Gosub _DOUT : D$(2)=" "+Resource$(60)+Right$(FF$,60)
Restore _SAMB : Gosub _DIALOG : YS=Y Curs-3 : PSAM=-1
_SAMBP: PSAM=PSAM+1 : If PSAM>NSAM-1 : PSAM=NSAM-1 : End If : Goto _GSAM
_SAMBM: If PSAM : PSAM=PSAM-1 : End If
_GSAM: AA=Start(5)+Leek(Start(5)+2+PSAM*4)
A$=String$(" ",8) : Copy AA,AA+8 To Varptr(A$)
SAMSP=Deek(AA+8) : LL=Leek(AA+10)
Print At(8,YS);Resource$(63);PSAM+1;" : ";A$;" ";
Goto _SAMPLAY
_EXSAM:
On Error Goto _EXERR
Open In 1,FF$ : LL=Lof(1) : Close : Reserve As Chip Work 5,LL : Bload FF$,Start(5)
AA=Start(5) : If LL>65534 : LL=65534 : End If
If PEX=3 : SAMSP=Deek(Start(5)+32) : AA=AA+40 : LL=LL-40 : End If
While Timer<25 : Wend
Gosub _DOUT : D$(2)=" "+Resource$(60)+Right$(FF$,60)
Restore _SAM : Gosub _DIALOG : YS=Y Curs-3 : Goto _SAMPLAY
_SAMP: SAMSP=SAMSP+1000 : Goto _SAMPLAY
_SAMM: If SAMSP>1999 : SAMSP=SAMSP-1000 : End If
_SAMPLAY:
Print At(8,YS+1);Resource$(61);Str$(SAMSP);" ";
_WAIT_NOMK : Sam Raw 15,AA,LL,SAMSP : Return
_SAMOUT: Volume 0 : Sam Raw 15,Start(5),1024,10000 : Volume 63 : Erase 5 : MZ=0 : Goto _EXNX
_SAM: Data 92,5," 05024028016008_SAMp"," 06040028016008_SAMm"," 37488032064012_SAMPlay"," 30552032064012_SAMout","End"
_SAMB: Data 92,5," 05024020016008_SAMbp"," 06040020016008_SAMbm"," 05024028016008_SAMp"," 06040028016008_SAMm"," 37488032064012_SAMPlay"," 30552032064012_SAMout","End"
' Picture loading
_EXPIC:
Gosub _DOUT : D$(2)=Resource$(20)+Right$(FF$,60) : Restore _DIA0 : Gosub _DIALOG
Timer=0 : On PEX Goto _PIFF,_SPBK,_PCBK,_ANIM
_ANIM:
On Error Goto _EXERR
Iff Anim FF$ To 1
Screen 0 : Gosub _DOUT
Screen Close 1
Goto _EXNXT
_PCBK:
On Error Goto _EXERR : Load FF$,5
While Timer<25 : Wend
If Leek(Start(5))=$12031990
Unpack 5 To 1
Else
SX=Deek(Start(5)+8)*8 : SY=Deek(Start(5)+10)*Deek(Start(5)+12) : NP=Deek(Start(5)+14)
NC=1 : For N=1 To NP : NC=NC*2 : Next
If SX>480 and NC<=16 : Screen Open 1,SX,SY,NC,Hires Else Screen Open 1,SX,SY,NC,Lowres : End If
Curs Off : Flash Off : Unpack 5,0,0
End If
Erase 5 : Goto _EPC
_PIFF:
On Error Goto _EXERR : Load Iff FF$,1
While Timer<25 : Wend
_EPC: Screen Hide 0 : Wait Vbl : Screen 0 : Gosub _DOUT
Repeat : Until Mouse Key : _WAIT_NOMK : Screen Close 1 : Screen Show 0
Goto _EXNXT
_SPBK:
_LOAD_BANK[FF$] : NS=Param
While Timer<25 : Wend
NP=Dreg(4) : NC=1 : For N=1 To NP : NC=NC*2 : Next
Screen Open 1,288,SYWORK,NC,Lowres : Screen Display 1,128,,,
Reserve Zone 3 : Curs Off : Cls 0
Flash Off : For C=0 To 31 : Colour C,Deek(Varptr(PAL$)+C*2) : Next
DS=1
Do
Gosub _DSP
Repeat : MK=Mouse Key : MZ=Mouse Zone : Until MK<>0 and MZ<>0
If MZ=1 : DS=DS-NN : End If
If MZ=2 : Exit : End If
If MZ=3 : DS=DS+NN : End If
_WAIT_NOMK
Loop
_DEL_BANK : Screen 0 : Gosub _DOUT : Screen Close 1 : Goto _EXNXT
_DSP:
Cls 0 : For Z=1 To 3 : Reset Zone Z : Next
Ink 1,0,1 : Set Paint 1 : BTEXT[2,Resource$(58),118,SYWORK-12]
If DS>1 : BTEXT[1,Resource$(57),62,SYWORK-12] : End If
SX=48 : SY=52 : NN=0
For YY=0 To SYWORK/(SY+8)-1
Y=(SY+8)*YY+1
For XX=0 To 320/(SX+8)-1
X=(SX+8)*XX+8
If DS+NN>0 and DS+NN<=NS
Box X-1,Y To X+SX,Y+SY-9 : Box X-1,Y+SY-9 To X+SX,Y+SY : Text X+8,Y+SY-8+Text Base,Str$(DS+NN)
_REDUCE_BOB[DS+NN,X+1,Y+1,SX,SY-9]
End If
NN=NN+1
Next
Next
If DS+NN<NS : BTEXT[3,Resource$(59),174,SYWORK-12] : End If
Return
' ASCII checking
_EXASC:
C=0
For N=1 To Len(A$)
A=Asc(Mid$(A$,N,1)) : If A>=32 or A=10 or A=9 : C=C+1 : End If
Next
P=(C*100)/Len(A$) : If P>95 : F=-1 : End If
Return
_EXREAD:
Gosub _DOUT : Trap Read Text FF$
If Errtrap
D$(2)=Resource$(24) : Restore _DIAD : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
End If
Goto _EXNX
_EXPRINT:
Gosub _DOUT : D$(2)=Resource$(53) : Restore _DIAP : Goto _DIALOG
_PPRT:
Gosub _DOUT : D$(2)=Resource$(54)+Right$(FF$,60) : Restore _DIAD : Gosub _DIALOG
On Error Goto _PRERR
Open In 1,FF$ : Set Input 10,-1
While Not Eof(1)
Line Input #1,A$ : Lprint A$
_MOUSE : If MK=1 and MZ=1 : Close 1 : _DISPLAY_MN[1,1] : _WAIT_NOMK : Goto _EXPRINT : End If
Wend
Close 1
_POUT: Gosub _DOUT : Goto _EXNX
_PRERR:
Close : Gosub _DOUT : D$(2)=Resource$(55)+FF$ : Restore _DIAD : Gosub _DIALOG : Repeat : Gosub _DODIALOG : Until R
Resume _EXNX
_DIAP: Data 92,4," 39488024064012_PPRT"," 30552024064012_POUT","End"
'
_HEAD:
Data 1,"FORM",9,"ILBM",-1,"",41,"_DexI",-100
Data 1,"FORM",9,"SMUS",-2,"",42,"_DexR",-100
Data 1,"FORM",9,"8SVX",-3,"",43,"_DexH",-100
Data 1,"FORM",9,"ANIM",-4,"",96,"_DexI",-100
Data 1,"AmSp",-2,"",44,"_DexI",-100
Data 1,"AmIc",-5,"",45,"_DexI",-100
Data 1,"AmBk",13,"Music",-1,"",46,"_DexH",-100
Data $439,"M.K.",-5,"",84,"_DexH",-100
Data $439,"FLT4",-5,"",84,"_DexH",-100
Data 1,"MMD1",-7,"",95,"_DexH",-100
Data 1,"MMD0",-7,"",95,"_DexH",-100
Data 1,"AmBk",13,"Tracker",-6,"",85,"_DexH",-100
Data 1,"AmBk",13,"Pac.Pic.",-3,"",47,"_DexI",-100
Data 1,"AmBk",13,"Samples",-4,"",62,"_DexH",-100
Data 1,"AmBs",-8,"",48,"_DexR",-100
Data 1,Chr$(0)+Chr$(0)+Chr$(3)+Chr$($F3),-9,"",49,"_DexR",-100
Data 1,"AMOS Basic",-1,"",64,"_DexR",-100
Data 1,"AMOS Pro",-1,"",94,"_DexR",-100
Data 0,"_ExAsc",-9,"",50,"_DexL",-100
Data 0,"",-2,"",51,"_DexH",-100
_DEXR: Data 92,5," 29488032064012_ExNx"," 30552032064012_ExOut","End"
_DEXI: Data 92,5," 36424032064012_ExPic"," 29488032064012_ExNx"," 30552032064012_ExOut","End"
_DEXH: Data 92,5," 37424032064012_ExHear"," 29488032064012_ExNx"," 30552032064012_ExOut","End"
_DEXL: Data 92,5," 38360032064012_ExRead"," 39424032064012_ExPrint"," 29488032064012_ExNx"," 30552032064012_ExOut","End"
' Copy
_COPY:
Restore _DIA1
If DNAME$(0)="" or OK(0)=0 Then Return
If DNAME$(1)="" or OK(1)=0 Then Return
If DNAME$(0)=DNAME$(1) Then If PATH$(0)=PATH$(1) Then D$(2)=Resource$(30) : Goto _DIALOG
OACT=ACT : _DISPLAY_ACT[0]
D=ACT : Gosub _ASK_DISC : If R : _NOT_DONE : Return : End If : _GET_SELECTED_FILES
If NFF=0 Then Return
D$(2)=Str$(NFF-NSP-NDD)+Resource$(1)+Str$(NDD)+Resource$(2)+Str$(TSIZE)+Resource$(28)
If TSIZE/1024>DFRI(1) : D$(3)=Resource$(29) : End If
Restore _DIA2 : Gosub _DIALOG
Repeat : Gosub _DODIALOG : Until R
If R=2 : Return : End If
MB=Fast Free+Chip Free
If MB<42*1024 Then Restore _DIA1 : D$(2)=Resource$(24) : Goto _DIALOG
On Error Goto _CERR
_GET_FF["+",1]
If Param$<>""
D=1 : Gosub _ASK_DISC : If R : _NOT_DONE : Return : End If
While Param$<>""
F$=Param$
If Exist(F$)=0
_ALERT[Resource$(31)+Right$(F$,50),1] : Mkdir F$
End If
_GET_FF["+",1]
Wend
End If
On Error Goto _CERR
PFF=-1 : PF=0 : BK=1000 : BSTEP=4*1024
Repeat
PBK=-1
Do
If PF=0
Repeat
_GET_FF[" -.",0]
A$=Left$(FF$(PFF),1)
If A$="." or(A$=" ") : _UNLIGHT_FILE[PFF,1] : End If
Until A$<>"."
NS$=Param$ : If NS$="" : PF=-1 : Exit : End If
PFF=PFF-1 : _GET_FF[" -",1] : ND$=Param$
End If
_ALERT[Resource$(20)+Right$(NS$,60),1]
D=0 : Gosub _ASK_DISC : If R : _NOT_DONE : Exit 2 : End If
Open In 1,NS$ : LF=Lof(1) : Pof(1)=PF
Inc PBK : Reserve As Work BK+PBK,128
Poke$ Start(BK+PBK)-1,"N"
Loke Start(BK+PBK),PF : Poke$ Start(BK+PBK)+4,ND$+Chr$(0)
Repeat
L=Min(BSTEP,LF-PF)
Inc PBK : Trap Reserve As Work BK+PBK,L+4
Exit If Errtrap,2
Poke$ Start(BK+PBK)-1,"D"
Sload 1 To Start(BK+PBK),L
Add PF,L
Trap Reserve As Chip Work BK-1,1024*16
Exit If Errtrap,2
Erase BK-1
Until PF>=LF
Close
PF=0
Loop
Close
PBK=0
Do
Exit If Length(BK+PBK)=0
PFS=Leek(Start(BK+PBK))
N$=Peek$(Start(BK+PBK)+4,128,Chr$(0))
_ALERT[Resource$(21)+Right$(N$,60),1]
D=1 : Gosub _ASK_DISC : If R : _NOT_DONE : Exit 2 : End If
If PFS=0
Open Out 1,N$
Else
Append 1,N$
End If
Inc PBK
Do
L=Length(BK+PBK) : Exit If L=0,2
A$=Peek$(Start(BK+PBK)-1,1) : Exit If A$<>"D"
Add L,-4
If L
Ssave 1,Start(BK+PBK) To Start(BK+PBK)+L
End If
Inc PBK
Loop
Close
Loop
Close : Erase Temp
Until PF<0
Close : Erase Temp
_CBYE:
_DISPLAY_ACT[OACT] : _NO_FILES
D=1 : Gosub _ASK_DISC : _NEW_DIR[1]
Return
_CERR:
Close : Erase Temp
D$(2)=Resource$(32)+Right$(N$,50)+"!" : D$(3)=Resource$(33) : Restore _DIA1B : Gosub _DIALOG
Repeat : Gosub _DODIALOG : Until R
Resume _CBYE
_ASK_DISC:
R=0
If Exist(DNAME$(D))=0
D$(2)=Resource$(25)+DNAME$(D)+Resource$(26) : Restore _DIAD : Gosub _DIALOG
Repeat
Wait 5 : Gosub _DODIALOG
Until R<>0 or Exist(DNAME$(D))
Gosub _DOUT
End If
Return
' Rename
_REN:
If OK(ACT)=0 : Return : End If
NR=0 : _WAIT_NOMK
For F=1 To SDIR(ACT)
If Mid$(FLAG$(ACT),F,1)="1"
_UNPACK_DIALOG[100,3]
D=15 : If SIZE(ACT,F)>=0 : D=14 : End If
Pen C3 : Centre Resource$(D)+" "+Resource$(88)
Print At(3,Y Curs+2);Resource$(16);
_NOSPACE[FILE$(ACT,F)] : F$=Param$
Pen C4 : _LEDIT[F$,640,X Curs,Y Curs,77-X Curs,0] : FF$=Param$
E=0 : If FF$="_Esc_" : FF$="" : E=-1 : End If
If F$<>FF$
If FF$<>""
On Error Goto _RNERR
Rename PATH$(ACT)+F$ To PATH$(ACT)+FF$
FILE$(ACT,F)=String$(" ",LFILE) : Left$(FILE$(ACT,F),LFILE)=FF$
NR=-1
End If
End If
_ERASE_DIALOG
If E : Exit : End If
Mid$(FLAG$(ACT),F,1)="0"
If F>=PDIR(ACT) and F<=PDIR+NLINE : _DISPLAY_FILE[ACT,F-PDIR(ACT)] : End If
End If
Next
If NR : _NEW_DIR[ACT] : End If
_RNEX: On Error : Return
_RNERR:
Pen C4 : Print At(3,);Resource$(17);'"';Right$(F$,60);'"!';String$(" ",77-X Curs);
_WAIT_NOMK : _WAIT_MK
_ERASE_DIALOG : Resume _RNEX
' Delete
_DEL:
If OK(ACT)=0 : Return : End If
D=ACT : Gosub _ASK_DISC : If R : Return : End If : _GET_SELECTED_FILES
If NFF=0 : Return : End If
D$(1)="*"+Str$(NDD)+Resource$(8)+Str$(NFF-NSP-NDD)+Resource$(9)
Restore _DIA4 : R$(1)="_dlok" : R$(2)="_dlnx" : R$(3)="_dlgo" : R$(4)="_dlout"
Gosub _DIALOG : YDEL=Y Curs-3 : FLG=0 : Goto _DLNX
_DLOK:
On Error Goto _DLERR : Kill FF$ : _UNLIGHT_FILE[PFF,0] : FLG=FLG+1 : Goto _DLNX
_DLGO: _WAIT_NOMK : On Error Goto _DLERR
Repeat
If Mouse Key : _WAIT_NOMK : Return : End If
Kill FF$ : _UNLIGHT_FILE[PFF,0] : FLG=FLG+1
_GET_FF[" .-*",ACT] : FF$=Param$ : Gosub _DLP : Wait 2
Until FF$=""
MZ=4 : Goto _DOUT
_DLOUT: _NO_FILES
If FLG
_NEW_DIR[ACT] : _ALERT[Str$(FLG)+Resource$(11),100]
Else
_ALERT[Resource$(12),100]
End If
Return
_DLERR:
Print At(3,YDEL);Resource$(13);Right$(FF$,55);"!";String$(" ",77-X Curs)
_WAIT_NOMK : _WAIT_MK
Resume _DLNX
_DLNX:
_GET_FF[" .-*",ACT] : FF$=Param$ : If Param$="" : MZ=4 : Goto _DOUT : End If
_DLP: Print At(3,YDEL);Resource$(10);Right$(FF$,55);String$(" ",77-X Curs); : Return
' Make dir
_MDIR:
If OK(ACT)
_WAIT_NOMK
_UNPACK_DIALOG[100,3]
Centre Resource$(4+ACT)+Resource$(6) : Print At(3,Y Curs+2);Resource$(7);
_LEDIT[PATH$(ACT),100,X Curs,Y Curs,60,Len(PATH$(ACT))]
_ERASE_DIALOG
On Error Goto _MDERR
If Param$<>"_Esc_"
If Param$<>PATH$(ACT)
Mkdir Param$ : _NEW_DIR[ACT]
End If
End If
_MDEND:
On Error
End If
Return
_MDERR:
_UNPACK_DIALOG[100,5]
Centre At(,Y Curs+1)+Resource$(92)+'"'+Right$(PATH$(ACT),60)+'"'
Centre At(,Y Curs+2)+Resource$(87)
_WAIT_NOMK : _WAIT_MK : _ERASE_DIALOG
Resume _MDEND
' How big?
_OBIG:
If OK(ACT)
D=ACT : Gosub _ASK_DISC : If R : Return : End If : _GET_SELECTED_FILES
_NO_FILES
D$(2)=Str$(NFF-NSP-NDD)+Resource$(1)+Str$(NDD)+Resource$(2)+Str$(TSIZE)+Resource$(3)
Restore _DIA1 : Goto _DIALOG
End If
Return
' Dialog box
_DIALOG:
If BREL : _DISPLAY_MN[BREL,0] : BREL=0 : End If
Read Y,SY : _UNPACK_DIALOG[Y,SY] : YMN=Param : Pen C3 : Paper C1
For N=1 To SY
If D$(N)<>""
If Left$(D$(N),1)<>"*" : Print At(3,);D$(N); Else Centre Mid$(D$(N),2) : End If
End If
Print
Next
N=0 : Repeat : N=N+1 : Read MN$(N) : Until MN$(N)="End" : DNM=N
For N=1 To DNM : _DISPLAY_MN[N,0] : Next
Set Zone DNM+1,0,0 To 639,SYWORK-1
Return
_DODIALOG:
_MOUSE : R=0
If MK=1 and MZ<>0
If MN$(MZ)<>""
_DISPLAY_MN[MZ,1] : _WAIT_NOMK : _DISPLAY_MN[MZ,0] : R=MZ : Goto _DOUT
End If
End If
Return
_DOUT:
R$=R$(MZ)
_WAIT_NOMK : _ERASE_DIALOG
For N=1 To 19 : Reset Zone N : MN$(N)="" : Next : YMN=0 : BREL=0
For N=0 To 12 : D$(N)="" : R$(N)="" : Next
If R$<>"" Then Goto R$
Return
_DGO: If R$(MZ)<>"" Then Goto R$(MZ)
Return
' Click dans le path
_PATH:
Gosub _SIDE : If A : Return : End If
_WAIT_NOMK : _DISPLAY_MN[BREL,0] : BREL=0
X=(MX-XDIR(D))/8
_LEDIT[PATH$(D)+FILT$(D),X,XFILE(D),YPATH/8,SXFILE,0]
If Param$<>"_Esc_"
_FIND_FILTER[Param$]
PATH$(D)=Left$(Param$,Param-1) : FILT$(D)=Mid$(Param$,Param)
A$=Right$(PATH$(D),1) : If A$<>"" and(A$<>":") and(A$<>"/") : PATH$(D)=PATH$(D)+"/" : End If
_NEW_DIR[D] : If OK(D)=0 : _ALERT[Resource$(93),250] : End If
End If
_DISPLAY_PATH[D]
Return
' Show sizes?
_SIZES: Gosub _SFLAG
For D=0 To 1 : If OK(D) : _DISPLAY_DIR[D] : End If : Next
Return
' Show info?
_DINFO:
Gosub _SFLAG
NFILT$=NFLT$ : If FLAG(0) : NFILT$="" : End If : Set Dir LFILE,NFILT$
_REDIR: For D=0 To 1 : If OK(D) : _NEW_DIR[D] : End If : Next
Return
_SFLAG: _SET_FLAG[MN$(MZ)] : Return
' ALL / CLEAR / FLIP
_FLIP:
For N=0 To MXFILE
A$=FILE$(0,N) : FILE$(0,N)=FILE$(1,N) : FILE$(1,N)=A$
A=SIZE(0,N) : SIZE(0,N)=SIZE(1,N) : SIZE(1,N)=A
Next
A$=FLAG$(0) : FLAG$(0)=FLAG$(1) : FLAG$(1)=A$
A$=FILT$(0) : FILT$(0)=FILT$(1) : FILT$(1)=A$
A$=DNAME$(0) : DNAME$(0)=DNAME$(1) : DNAME$(1)=A$
A$=PATH$(0) : PATH$(0)=PATH$(1) : PATH$(1)=A$
A=SDIR(0) : SDIR(0)=SDIR(1) : SDIR(1)=A
A=PDIR(0) : PDIR(0)=PDIR(1) : PDIR(1)=A
A=DFRI(0) : DFRI(0)=DFRI(1) : DFRI(1)=A
A=OK(0) : OK(0)=OK(1) : OK(1)=A
MX=325-D*10 : ACT=-1
_DISPLAY_DIR[0] : _DISPLAY_PATH[0]
_DISPLAY_DIR[1] : _DISPLAY_PATH[1]
Goto _SIDE
_CLEAR: F1$="1" : F2$="0" : Goto _A
_ALL: F1$="0" : F2$="1"
_A:
For P=1 To Len(FLAG$(ACT))
If Mid$(FLAG$(ACT),P,1)=F1$ : Mid$(FLAG$(ACT),P,1)=F2$ : End If
Next
_DISPLAY_DIR[ACT]
Return
' Activate side
_ACT:
D=0 : If MX>320 : D=1 : End If
_DISPLAY_ACT[D] : Return
_SIDE:
D=0 : If MX>320 : D=1 : End If
A=0 : If ACT<>D : FMK=1 : FMX=MX : FMY=MY : FMZ=21+D : A=-1 : End If
If DCLICK>=0 and Timer<50
Z=(MY-YDIR)/8 : F=PDIR(D)+Z
G=-1 : If D=DSIDE and DCLICK<>F : G=0 : End If
If G
Mid$(FLAG$(DSIDE),DCLICK)="0" : _DISPLAY_FILE[DSIDE,DCLICK-PDIR(DSIDE)]
_NOSPACE[FILE$(DSIDE,DCLICK)]
PATH$(D)=PATH$(DSIDE)+Param$+"/" : _NEW_DIR[D]
A=-1
End If
End If
DCLICK=-1
Return
' Click into names
_NAME:
Gosub _SIDE : If A : Return : End If
If MK=2
If Left$(FLAG$(D),1)<>"D"
A$=Dev First$("**") : S=1
OPDIR(D)=PDIR(D) : PDIR(D)=1
While A$<>""
For F=SDIR(D)+1 To S+1 Step -1
FILE$(D,F)=FILE$(D,F-1) : SIZE(D,F)=SIZE(D,F-1)
Next
FLAG$(D)=Left$(FLAG$(D),S-1)+"D"+Mid$(FLAG$(D),S)
FILE$(D,S)=Mid$(A$,2) : SIZE(D,S)=-1
S=S+1 : SDIR(D)=SDIR(D)+1
A$=Dev Next$
Wend
Else
L=Len(FLAG$(D)) : FLAG$(D)=FLAG$(D)-"D" : L=L-Len(FLAG$(D))
SDIR(D)=SDIR(D)-L : PDIR(D)=OPDIR(D)
For F=1 To SDIR(D)
FILE$(D,F)=FILE$(D,F+L) : SIZE(D,F)=SIZE(D,F+L)
Next
End If
_DISPLAY_DIR[D]
Else
OF=-1 : X$=""
Z=(MY-YDIR)/8 : F=PDIR(D)+Z
If FCLICK=F and Timer<20
Mid$(FLAG$(D),F)=FX$ : _DISPLAY_FILE[D,Z]
A$=FILE$(D,F) : _NOSPACE[A$]
NFF=1 : PFF=-1 : FF$(0)=" "+Param$
Gosub _EXNXT : FCLICK=-1 : Return
End If
If Z>=0 and Z<NLINE
A$=Mid$(FLAG$(D),F,1)
If A$="0" : X$="1" : End If
If A$="1" : X$="0" : End If
If X$<>""
If SIZE(D,F)<0 : DCLICK=F : DSIDE=D : End If
If SIZE(D,F)>0 : FCLICK=F : FX$=Mid$(FLAG$(D),F) : End If
End If
If A$="D"
A$=FILE$(D,F) : _NOSPACE[A$] : PATH$(D)=Param$ : _NEW_DIR[D]
End If
End If
If X$<>""
Repeat
If F<>OF
If Z=-1 and PDIR(D)>1 : _SCROLL_DOWN[D] : Z=0 : End If
If Z=NLINE and PDIR(D)+NLINE<=SDIR(D) : _SCROLL_UP[D] : Z=Z-1 : End If
If Z>=0 and Z<NLINE
If OF>=0 : DCLICK=-1 : End If
If OF<0 or Abs(F-OF)=1
A$=Mid$(FLAG$(D),F,1)
If(A$="0") or(A$="1") : Mid$(FLAG$(D),F)=X$ : _DISPLAY_FILE[D,Z] : End If
Else
S=Sgn(F-OF)
For G=OF+S To F Step S
A$=Mid$(FLAG$(D),G,1)
If(A$="0") or(A$="1") : Mid$(FLAG$(D),G)=X$ : _DISPLAY_FILE[D,G-PDIR(D)] : End If
Next
End If
OF=F
End If
End If
_MOUSE
Z=(MY-YDIR)/8 : F=PDIR(D)+Z
Until MK=0
_DISPLAY_INF[D]
Timer=0
End If
End If
Return
' Parent
_PAR0: D=0 : Goto _PAR
_PAR1: D=1
_PAR:
If PATH$(D)<>""
For N=Len(PATH$(D))-1 To 1 Step -1
A$=Mid$(PATH$(D),N,1)
If(A$="/") or(A$=":") : PATH$(D)=Left$(PATH$(D),N) : Exit : End If
Next
_NEW_DIR[D]
End If
Return
' File sliders
_SL:
D=0 : If MX>320 : D=1 : End If
If MY<SSL(D) or MY>ESL(D)
If MY<SSL(D) : If PDIR(D)>1 : _SCROLL_DOWN[D] : End If : End If
If MY>ESL(D) : If PDIR(D)<=SDIR(D)-NLINE : _SCROLL_UP[D] : End If : End If
If MK=2 : MFLAG=0 : End If
Else
DY=MY-SSL(D) : _DISPLAY_SLIDER[D,C7]
Repeat
_MOUSE
Y=MY-YSLI-DY : P=(Y*(SDIR(D)+1))/SYSLI+1
If P<=0 : P=1 : End If
If P>SDIR(D)-NLINE+1 : P=SDIR(D)-NLINE+1 : End If
If P<>PDIR(D) : PDIR(D)=P : _DISPLAY_SLIDER[D,C7] : End If
Until MK=0
_DISPLAY_DIR[D]
End If
Return
' Scrolling icons
_UP0: D=0 : Goto _UP
_UP1: D=1
_UP: If PDIR(D)+NLINE<=SDIR(D) : _SCROLL_UP[D] : End If : MFLAG=0 : Return
_DN0: D=0 : Goto _DN
_DN1: D=1
_DN: If PDIR(D)>1 : _SCROLL_DOWN[D] : End If : MFLAG=0 : Return
Procedure _NEW_DIR[D]
If PATH$(D)=""
PATH$(D)=Dir$
End If
_DISPLAY_PATH[D]
_GET_DIR[D]
End Proc
Procedure _CLEAR_DIR[D]
PDIR(D)=1 : SDIR(D)=0 : FLAG$(D)="" : DNAME$(D)="" : DFRI(D)=0
For N=1 To MXFILE : FILE$(D,N)="" : SIZE(D,N)=0 : Next
OK(D)=0 : _DISPLAY_DIR[D]
End Proc
Procedure _GET_DIR[D]
Change Mouse 3 : _CLEAR_DIR[D] : _ALERT[Resource$(35),1]
On Error Goto _ERR
A$=Dir First$(PATH$(D)+FILT$(D))
While A$<>""
N=N+1
If Left$(A$,1)<>"*"
FILE$(D,N)=Mid$(Left$(A$,Len(A$)-8),2)
SIZE(D,N)=Val(Right$(A$,8))
Else
FILE$(D,N)=Mid$(A$,2)
SIZE(D,N)=-1
End If
A$=Dir Next$
Wend
SDIR(D)=N : FLAG$(D)=String$("0",N)
DNAME$(D)="" : DFRI(D)=0
A$=Disc Info$(PATH$(D))
DNAME$(D)=Left$(A$,Len(A$)-10)
DFRI(D)=Val(Right$(A$,10))/1024
OK(D)=1 : _DISPLAY_DIR[D]
_BYE: Change Mouse 1 : Pop Proc
_ERR: Resume _BYE
End Proc
Procedure _DISPLAY_ACT[D]
If ACT<>D
ACT=D
_DISPLAY_PATH[0] : _DISPLAY_PATH[1] : _DISPLAY_INF[D]
End If
End Proc
Procedure _DISPLAY_DIR[D]
Cls C1,XDIR(D),YDIR To XDIR(D)+SXDIR,YDIR+SYDIR
For N=0 To NLINE-1 : _DISPLAY_FILE[D,N] : Next
Wait Vbl : _DISPLAY_SLIDER[D,C6] : _DISPLAY_INF[D]
End Proc
Procedure _DISPLAY_FILE[D,N]
F=PDIR(D)+N
If F<=SDIR(D)
Locate XFILE(D),YFILE+N
A$=Mid$(FLAG$(D),F,1)
If A$="D"
Paper C5 : Pen C3
Else
If SIZE(D,F)>=0 : Pen C3 Else Pen C4 : End If
If A$="1" : Paper C2 Else Paper C1 : End If
End If
If FLAG(1)
Print Left$(FILE$(D,F),SXFILE-7);
If SIZE(D,F)>=0
Print Using " ######";SIZE(D,F);
Else
If A$<>"D" : Print " (Dir)"; Else Print " (Dev)"; : End If
End If
Else
If SIZE(D,F)>=0
Print Left$(FILE$(D,F),SXFILE);
Else
Print Left$(FILE$(D,F),SXFILE-7);
If A$<>"D" : Print " (Dir)"; Else Print " (Dev)"; : End If
End If
End If
End If
End Proc
Procedure _DISPLAY_PATH[D]
A=C1 : B=C3
If D=ACT : A=C2 : B=C3 : End If
Cls A,XDIR(D),YPATH To XDIR(D)+SXDIR,YPATH+SYPATH
Paper A : Pen B
Locate XFILE(D),YPATH/8 : Print Right$(PATH$(D)+FILT$(D),SXFILE);
End Proc
Procedure _SCROLL_UP[D]
Screen Copy 0,XDIR(D),YDIR+8,XDIR(D)+SXDIR,YDIR+SYDIR To 0,XDIR(D),YDIR
Cls C1,XDIR(D),YDIR+SYDIR-8 To XDIR(D)+SXDIR,YDIR+SYDIR
PDIR(D)=PDIR(D)+1 : _DISPLAY_FILE[D,NLINE-1] : _DISPLAY_SLIDER[D,C6]
End Proc
Procedure _SCROLL_DOWN[D]
Screen Copy 0,XDIR(D),YDIR,XDIR(D)+SXDIR,YDIR+SYDIR-8 To 0,XDIR(D),YDIR+8
Cls C1,XDIR(D),YDIR To XDIR(D)+SXDIR,YDIR+8
PDIR(D)=PDIR(D)-1 : _DISPLAY_FILE[D,0] : _DISPLAY_SLIDER[D,C6]
End Proc
Procedure _DISPLAY_SLIDER[D,C]
Reset Zone 34+D
Cls C0,XSLI(D),YSLI To XSLI(D)+SXSLI,YSLI+SYSLI
If SDIR(D)>=NLINE
SSL(D)=YSLI+(SYSLI*(PDIR(D)-1))/SDIR(D)
ESL(D)=Min(YSLI+SYSLI,SSL(D)+(SYSLI*NLINE)/(SDIR(D)))
Cls C,XSLI(D),SSL(D) To XSLI(D)+SXSLI,ESL(D)
Set Zone 34+D,XSLI(D),YSLI To XSLI(D)+SXSLI,YSLI+SYSLI
End If
End Proc
Procedure _DISPLAY_INF[D]
If D=ACT
Cls C1,XINF,YINF To XINF+SXINF,YINF+SYINF
Paper C1 : Pen C3 : Locate ,YINF/8
If OK(D)>0
S=0 : T=0 : ND=0 : NF=0
For F=1 To SDIR(D)
If SIZE(D,F)>=0
T=T+SIZE(D,F)
If Mid$(FLAG$(D),F,1)="1" : S=S+SIZE(D,F) : End If
NF=NF+1
Else
ND=ND+1
End If
Next
S=(S+1023)/1024 : T=(T+1023)/1024
A$=Right$(DNAME$(D),20)
A$=A$+Str$(NF)+" file" : If SDIR(D)>1 : A$=A$+"s" : End If
A$=A$+" -"+Str$(T)+"k listed"
A$=A$+" -"+Str$(S)+"k selected"
A$=A$+" -"+Str$(DFRI(D))+"k free"
Centre A$
End If
End If
End Proc
Procedure _ALERT[A$,N]
Cls C1,XINF,YINF To XINF+SXINF,YINF+SYINF
Paper C1 : Pen C3 : Locate ,YINF/8
If A$<>"" : Centre A$ : End If
ALERT=N
End Proc
Procedure _INIT_WORK
Screen Open 0,640,SYWORK,8,Hires
Curs Off : Flash Off
For C=0 To 7 : Colour C,0 : Next : Wait Vbl
Cls 0 : Cls C1,288,4 To 352,SYWORK-4
_UNPACK[8,0,37] : _UNPACK[9,272,37] : _UNPACK[9,352,37] : _UNPACK[8,368,37]
N=(SYWORK-72)/8 : Screen Copy 0,0,48,640,56 To 0,0,47+N*8
For Y=1 To N : Screen Copy 0,0,40,640,48 To 0,0,40+Y*8 : Next
_UNPACK[10,0,52+N*8]
XDIR(0)=8 : XDIR(1)=376 : YDIR=40 : SXDIR=256 : SYDIR=N*8+8 : NLINE=N+1
XFILE(0)=XDIR(0)/8 : XFILE(1)=XDIR(1)/8 : YFILE=YDIR/8 : SXFILE=SXDIR/8
YPATH=24 : SYPATH=8
XSLI(0)=276 : XSLI(1)=356 : YSLI=40 : SXSLI=8 : SYSLI=SYDIR+2
XINF=8 : YINF=56+N*8 : SXINF=624 : SYINF=8
Reserve Zone NMN
Set Zone 32,XDIR(0),YDIR To XDIR(0)+SXDIR,YDIR+SYDIR
Set Zone 33,XDIR(1),YDIR To XDIR(1)+SXDIR,YDIR+SYDIR
YMN=0
For N=1 To NMN
_DISPLAY_MN[N,0]
A$=Left$(MN$(N),1) : If(A$>="A") and(A$=<"Z") : _DISPLAY_MN[N,1] : End If
Next
If SYWORK>220 : _UNPACK[41,288,169] : End If
For D=0 To 1 : _CLEAR_DIR[D] : _DISPLAY_DIR[0] : Next
Fade 1,$0,$FFB,$77,$FFF,$C00,$DD,$AA,$FF3
Limit Mouse X Hard(0),Y Hard(4) To X Hard(640),Y Hard(SYWORK-4)
End Proc
Procedure _UNPACK_DIALOG[Y,N]
Y=(Y/8)*8-4
Get Block 1,0,Y-2,640,N*8+16 : BLOC=1
Cls 0,14,Y-1 To 626,Y+N*8+9
_UNPACK[8,16,Y]
Screen Copy 0,16,Y,288,Y+16 To 0,352,Y
Screen Copy 0,32,Y,256,Y+16 To 0,256,Y
If N>1
Screen Copy 0,16,Y+12,624,Y+16 To 0,16,Y+4+N*8
For NN=1 To N
Screen Copy 0,16,Y+4,624,Y+12 To 0,16,Y-4+NN*8
Next
End If
Locate 3,Y/8+1 : Pen C3 : Paper C1
End Proc[Y]
Procedure _ERASE_DIALOG
If BLOC : Put Block 1 : Del Block 1 : BLOC=0 : End If
End Proc
Procedure _DISPLAY_MN[N,F]
If MN$(N)<>""
If F<0
F=0 : A$=Left$(MN$(N),1) : If(A$>="A") and(A$=<"Z") : F=1 : End If
End If
I=Val(Mid$(MN$(N),3,2))
X=Val(Mid$(MN$(N),5,3)) : Y=Val(Mid$(MN$(N),8,3))+YMN
TX=Val(Mid$(MN$(N),11,3)) : TY=Val(Mid$(MN$(N),14,3))
If I
If F=0
If I<90
_UNPACK[I,X,Y]
Else
G$="_D"+Mid$(Str$(I),2) : Gosub G$
End If
Else
If I<90
_UNPACK[I+MNDOWN,X,Y]
Else
Screen Copy 0,X+2,Y+1,X+TX,Y+TY To 0,X,Y
Cls 0,X+TX-2,Y To X+TX,Y+TY
Cls 0,X,Y+TY-1 To X+TX,Y+TY
End If
End If
Set Zone N,X,Y To X+TX,Y+TY
End If
End If
Pop Proc
_D90: _UNPACK[4,X,Y] : _DISPLAY_PATH[0] : Return
_D91: _UNPACK[4,X,Y] : _DISPLAY_PATH[1] : Return
End Proc
Procedure _UNPACK[N,X,Y]
Global BPIC
A=Start(BPIC)+Deek(Start(BPIC)+2*(N-1))
Unpack A,X,Y
End Proc
Procedure _MOUSE
Multi Wait
MX=X Screen(X Mouse) : MY=Y Screen(Y Mouse) : MZ=Zone(MS,MX,MY)
MK=Mouse Key : If MK>3 : MK=3 : End If
End Proc
Procedure _WAIT_NOMK
While Inkey$<>"" : Wend
If FWT
Wait FWT : FWT=0
Else
Wait Vbl : While Mouse Key : Wend
End If
End Proc
Procedure _WAIT_MK
_WAIT_NOMK
Repeat : _MOUSE : A$=Inkey$ : Until A$<>"" or MK<>0
End Proc[A$]
Procedure _NOSPACE[A$]
For N=Len(A$) To 1 Step -1
If Mid$(A$,N,1)<>" " : Exit : End If
Next
A$=Left$(A$,N)
End Proc[A$]
Procedure _SET_FLAGS
For N=1 To NMN : If Upper$(Left$(MN$(N),1))="F" : _SET_FLAG[MN$(N)] : End If : Next
End Proc
Procedure _SET_FLAG[A$]
V=Asc(Mid$(A$,2,1))-65
FLAG(V)=0 : If Left$(A$,1)="F" : FLAG(V)=1 : End If
End Proc
Procedure _LEDIT[ED$,XC,XX,YY,SX,MN]
While Inkey$<>"" : Wend
PX=0 : L=Len(ED$) : If L>=SX : PX=L-SX : End If
XC=Max(0,XC) : XC=Min(XC,L)
Curs On
Do
Gosub _DED
Repeat
A$=Inkey$ : S=Scancode
If Mouse Key=1
X=(X Screen(X Mouse))/8-XX
If X>=MN and X<=L : XC=X : Gosub _DED : Wait Vbl : End If
End If
Until A$<>""
F=1
If A$=Chr$(13) : Exit : End If
If A$=Chr$(27) : ED$="_Esc_" : Exit : End If
If S=65 and XC+PX>MN
ED$=Left$(ED$,XC+PX-1)+Mid$(ED$,PX+XC+1) : E=1 : L=L-1
S=79
End If
If S=70 and XC+PX<L
ED$=Left$(ED$,XC+PX)+Mid$(ED$,PX+XC+2) : E=1 : L=L-1 : F=0
End If
If S=79 and PX+XC>MN
F=0
If XC=0
PX=PX-1
Else
XC=XC-1
End If
End If
If S=78 and PX+XC<L
F=0
If XC=SX
PX=PX+1
Else
XC=XC+1
End If
End If
If F
If A$>=" "
ED$=Left$(ED$,PX+XC)+A$+Mid$(ED$,PX+XC+1) : L=L+1
If L>SX
If XC>=SX
PX=PX+1
Else
XC=XC+1
End If
Else
XC=XC+1
End If
End If
End If
Loop
Curs Off
Goto _END
_DED:
Locate XX,YY : Print Mid$(ED$,PX+1,SX);
If E : If X Curs<XX+SX : Print " "; : E=0 : End If : End If
Locate Min(XX+XC,XX+SX-1),YY
Return
_END:
End Proc[ED$]
Procedure _FIND_FILTER[A$]
F=Len(A$)+1
For N=Len(A$) To 0 Step -1
B$=Mid$(A$,N,1)
If B$="/" or(B$=":") or N=0
For M=N+1 To Len(A$)
B$=Mid$(A$,M,1) : If B$="*" or(B$="?") : F=N+1 : Exit 2 : End If
Next
End If
Next
End Proc[F]
Procedure _NO_FILES
For N=0 To MXFF : FF$(N)="" : Next
End Proc
Procedure _UNLIGHT_FILE[F,G]
F=Val("$"+Mid$(FF$(F),2,3))
Mid$(FLAG$(ACT),F,1)="0"
If G
If F>=PDIR(ACT) and F-PDIR(ACT)<NLINE : _DISPLAY_FILE[ACT,F-PDIR(ACT)] : End If
End If
End Proc
Procedure _GET_SELECTED_FILES
Change Mouse 3 : _ALERT[Resource$(35),1]
NFF=0 : PFF=-1 : NDD=0 : NSP=0 : TSIZE=0 : FFERR=0
Set Dir LFILE,""
On Error Goto _ERR
For F=1 To SDIR(ACT)
A$=Mid$(FLAG$(ACT),F,1)
If A$="1"
If SIZE(ACT,F)>=0
A$=FILE$(ACT,F) : Gosub _NSPACE
FF$(NFF)=" "+A$
TSIZE=TSIZE+SIZE(ACT,F)
NFF=NFF+1
Else
A$=FILE$(ACT,F) : Gosub _NSPACE
_GET_FILES[A$,FILT$(ACT)] : If FFERR : Exit : End If
Left$(FF$(NFF-1),1)="."
End If
Mid$(FF$(NFF-1),2,3)=Mid$(Hex$(F,3),2)
End If
Next
_END:
If FFERR=11
_UNPACK_DIALOG[100,3] : Centre Resource$(86) : Locate ,Y Curs+2 : Centre Resource$(87) : _WAIT_MK : _ERASE_DIALOG
End If
If FFERR : NFF=0 : PFF=-1 : NDD=0 : NSP=0 : TSIZE=0 : End If
Change Mouse 1 : _DISPLAY_INF[ACT]
Set Dir LFILE,NFILT$
Pop Proc
_NSPACE: For N=Len(A$) To 1 Step -1 : If Mid$(A$,N,1)<>" " : Exit : End If : Next : A$=Left$(A$,N) : Return
_ERR: For N=0 To MXFF : FF$(N)="" : Next : FFERR=Errn : Resume _END
End Proc
Procedure _GET_FILES[P$,F$]
If FFERR : Pop Proc : End If
On Error Goto _ERR
FF$(NFF)="+ "+P$ : NFF=NFF+1 : NSP=NSP+1 : PDEB=NFF
A$=Dir First$(PATH$(ACT)+P$+"/"+F$)
While A$<>""
If Left$(A$,1)="*"
A$=Mid$(A$,2) : Gosub _NSPACE
FF$(NFF)="& "+P$+"/"+A$ : NFF=NFF+1
NDOS=NDOS+1
Else
TSIZE=TSIZE+Val(Mid$(A$,Len(A$)-10))
A$=Left$(A$,Len(A$)-10) : Gosub _NSPACE
FF$(NFF)="- "+P$+"/"+Mid$(A$,2)
NFF=NFF+1
End If
A$=Dir Next$
Wend
If NFF>PDEB
For N=PDEB To NFF-1
If Left$(FF$(N),1)="&"
_GET_FILES[Mid$(FF$(N),5),F$]
FF$(N)="" : NSP=NSP+1
End If
Next
End If
FF$(NFF)="* "+P$ : NFF=NFF+1 : NDD=NDD+1
Pop Proc
_NSPACE: For N=Len(A$) To 1 Step -1 : If Mid$(A$,N,1)<>" " : Exit : End If : Next : A$=Left$(A$,N) : Return
_ERR: For N=0 To MXFF : FF$(N)="" : Next : FFERR=Errn : Resume _END
_END:
End Proc
Procedure _GET_FF[F$,D]
Do
PFF=PFF+1 : If PFF>=NFF : Exit : End If
A$=Left$(FF$(PFF),1)
If Instr(F$,A$) : Exit : End If
Loop
If PFF<NFF
G$=PATH$(D)+Mid$(FF$(PFF),5)
End If
End Proc[G$]
Procedure _NOT_DONE
_ALERT[Resource$(27),100]
End Proc
Procedure _LOAD_BANK[N$]
On Error Goto _END
Reserve As Work 13,512*4 : Fill Start(13) To Start(13)+Length(13),0
Areg(1)=Start(13) : Dreg(1)=512 : Dreg(0)=0 : Call 12
Open In 1,N$
A$=Input$(1,4) : A$=Input$(1,2) : NN=Deek(Varptr(A$))
NB=0
For N=1 To NN
Dreg(1)=N : Dreg(0)=3 : Call 12
If Dreg(0)=0
A$=Input$(1,10) : A=Varptr(A$)
SX=Deek(A) : SY=Deek(A+2) : NP=Deek(A+4) : SZ=SX*2*SY*NP
Dreg(2)=SX*16 : Dreg(3)=SY : Dreg(4)=NP
Dreg(5)=Deek(A+6) : Dreg(6)=Deek(A+8)
Dreg(7)=0 : Dreg(0)=1 : Call 12
If Dreg(0) : Stop : End If
AC=Areg(0) : P=0
While P<SZ
L=Min(1024,SZ-P)
A$=Input$(1,L)
Copy Varptr(A$),Varptr(A$)+L To AC+P
P=P+L
Wend
NB=NB+1
End If
Next
PAL$=Input$(1,64)
Close 1
Dreg(0)=2 : Dreg(1)=1 : Dreg(7)=0 : Areg(0)=Screen Base : Call 12
Goto _END
_ERR: _DEL_BANK : NB=0
_END:
End Proc[NB]
Procedure _REDUCE_BOB[N,X,Y,SX,SY]
Dreg(0)=7 : Areg(0)=Screen Base
Dreg(1)=N : Dreg(2)=X : Dreg(3)=Y : Dreg(4)=SX : Dreg(5)=SY
Call 12
End Proc
Procedure _DEL_BANK
If Length(13)
Dreg(0)=6 : Call 12
Erase 13
End If
End Proc
Procedure BTEXT[Z,A$,X,Y]
Set Pattern 1 : BBAR[Z,X,Y,X+Len(A$)*8+4,Y+10]
Text X+3,Y+Text Base+2,A$
End Proc
Procedure BBAR[Z,X,Y,XX,YY]
Bar X,Y To XX,YY
If Z : Set Zone Z,(X+1),Y To XX,YY : End If
End Proc
Procedure _DISK_BUSY[S,D]
D$="Df"+Chr$(48+S)+":"+Chr$(0)
Dreg(1)=Varptr(D$) : DEV=Doscall(Lvo("DeviceProc"))
If DEV
Areg(1)=0 : TSK=Execall(Lvo("FindTask"))
PRT=TSK+Equ("pr_MsgPort")
_RESFREEBANK[Equ("dp_SIZEOF")] : B=Param : S=Start(B)
PKT=S+Equ("sp_Pkt") : MSG=S+Equ("sp_Msg")
Struc(MSG,"LN_NAME")=PKT
Struc(PKT,"dp_Link")=MSG
Struc(PKT,"dp_Port")=PRT
Struc(PKT,"dp_Type")=Equ("ACTION_INHIBIT")
Struc(PKT,"dp_Arg1")=D
Areg(0)=DEV : Areg(1)=MSG : A=Execall(Lvo("PutMsg"))
Areg(0)=PRT : A=Execall(Lvo("WaitPort"))
Areg(0)=PRT : A=Execall(Lvo("GetMsg"))
Erase B
Wait 50
End If
End Proc
Procedure _TRACK_OPEN[S,D]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
_TDB=1000 : E=1
Trap Dev Open S,"trackdisk.device",Equ("IOTD_SIZE"),D,0
If Errtrap=0
_TDNUMSEC=Equ("NUMSECS")
_TDSECTOR=Equ("TD_SECTOR")
Trap Lib Open 3,"intuition.library",36
If Errtrap=0
Lib Close 3
_RESFREEBANK[Equ("dg_SIZEOF")] : B=Param : A=Start(B)
Struc(Dev Base(S),"IO_DATA")=A
Dev Do S,Equ("TD_GETGEOMETRY")
_TDSECTOR=Struc(A,"dg_SectorSize")
_TDNUMSEC=Struc(A,"dg_TrackSectors")
Erase B
End If
_TDSIZE=_TDNUMSEC*_TDSECTOR
Dev Do S,Equ("TD_GETNUMTRACKS")
_TDTRACKS=Struc(Dev Base(S),"IO_ACTUAL")
Reserve As Chip Work _TDB+S,_TDSIZE
Reserve As Work _TDB+4,_TDSIZE*2
E=0
End If
End Proc[E]
Procedure _TRACK_CLOSE[S]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
Dev Close S
Erase _TDB+S
Erase _TDB+4
End Proc
Procedure _TRACK_PROTECTED[S]
Trap Dev Do S,Equ("TD_PROTSTATUS")
P=-1
If Errtrap=0
P=Sgn(Struc(Dev Base(S),"IO_ACTUAL"))
End If
End Proc[P]
Procedure _TRACK_MOTOR[S,M]
Struc(Dev Base(S),"IO_LENGTH")=M
Trap Dev Do S,Equ("TD_MOTOR")
P=-1
If Errtrap=0
P=Sgn(Struc(Dev Base(S),"IO_ACTUAL"))
End If
End Proc[P]
Procedure _TRACK_READ[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
T=_TDSIZE*T
Struc(Dev Base(S),"IO_DATA")=Start(_TDB+S)
Struc(Dev Base(S),"IO_OFFSET")=T
Struc(Dev Base(S),"IO_LENGTH")=_TDSIZE
Trap Dev Do S,Equ("CMD_READ")
End Proc[Errtrap]
Procedure _TRACK_WRITE[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
T=_TDSIZE*T
Struc(Dev Base(S),"IO_DATA")=Start(_TDB+S)
Struc(Dev Base(S),"IO_OFFSET")=T
Struc(Dev Base(S),"IO_LENGTH")=_TDSIZE
Trap Dev Do S,Equ("CMD_WRITE")
End Proc[Errtrap]
Procedure _TRACK_FORMAT[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
T=_TDSIZE*T
Struc(Dev Base(S),"IO_DATA")=Start(_TDB+S)
Struc(Dev Base(S),"IO_OFFSET")=T
Struc(Dev Base(S),"IO_LENGTH")=_TDSIZE
Trap Dev Do S,Equ("TD_FORMAT")
End Proc[Errtrap]
Procedure _TRACK_CHECKSUM[S]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
A=Start(_TDB+S)
Loke A+20,0
C=0
For B=A To A+_TDSECTOR-4 Step 4
Add C,-Leek(B)
Next
Loke A+20,C
End Proc
Procedure _TRACK_VERIFY[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
E=1
A=Start(_TDB+S) : B=Start(_TDB+4) : Copy A,A+_TDSIZE To B
_TRACK_READ[S,T]
If Param=0
Repeat
For C=0 To _TDSIZE-4 Step 4
Exit If Leek(A+C)<>Leek(B+C),2
Next
E=0
Until True
End If
End Proc[E]
Procedure _TRACK_STORE[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
_CRUNCHIT[0,_TDSIZE,Start(_TDB+S),Start(_TDB+4)] : L=Param
Trap Reserve As Work _TDB+5+T,L
If Errtrap=0
Copy Start(_TDB+4),Start(_TDB+4)+L To Start(_TDB+5+T)
End If
End Proc[Errtrap]
Procedure _TRACK_USTORE[S,T]
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
If Length(_TDB+4+T)
_CRUNCHIT[1,0,Start(_TDB+5+T),Start(_TDB+S)]
Else
Fill Start(_TDB+S) To Start(_TDB+S)+Length(_TDB+S),0
End If
End Proc
Procedure _TRACK_FREE
Global _TDB,_TDNUMSEC,_TDSECTOR,_TDTRACKS,_TDSIZE
For B=_TDB+5 To _TDB+5+_TDTRACKS
Erase B
Next
End Proc
Procedure _RESFREEBANK[S]
For B=65535 To 0 Step -1 : Exit If Length(B)=0 : Next
Reserve As Work B,S
Fill Start(B) To Start(B)+Length(B),0
End Proc[B]
Procedure _CRUNCHIT[A,B,C,D]
' COMPILED PROCEDURE -- can't convert this to AMOS code
End Proc