home *** CD-ROM | disk | FTP | other *** search
RISC OS BBC BASIC V Source | 1994-10-17 | 8.9 KB | 233 lines |
- > CaseSrc
- fDirSort - set to TRUE to force directories first/last in "Sort by date"
- - set to FALSE to sort directories with files
- fDirSort=
- Ignored if fDirSort=FALSE, otherwise:
- fDirLast - set to TRUE to force directories last in "Sort by date"
- - set to FALSE to force directories first in "Sort by date"
- fDirLast=
- fDownCaseRest - set to TRUE to force any unmatched tail to lower-case
- if wordlist matches start (eg SPRITELY -> Spritely)
- - set to FALSE to capitalise initial letter of tail
- (eg SPRITEFRED -> SpriteFred)
- fDownCaseRest=
- Jvsn$="0.04":fnm$="SpeclCase":date$="17 Oct 1994":
- or MID$(TIME$,5,11)
- -title$="SpecialCase":name$="Special Case"
- ;bl$=
- 0:cr$=
- 13:lfcr$=
- 10+cr$:tab$=
- 9:esc$=
- 27:hspc$=
- +GBPBV=&0C:
- Buffer Remove vector number
- <Service_Reset =&27:
- End of machine reset signalled
- 1codesize=&1000:
- org codesize:L%=org+codesize
- A%=%1100
- %1110
- %0010
- ?P%=0:O%=org :
- So that addresses are offsets within module
- [OPT A%
- G EQUD 0 ; Application start entry
- !D EQUD init ; Initialisation entry
- "B EQUD finalise ; Finalisation entry
- #B EQUD servicecall ; Service call entry
- $? EQUD titlestring ; -> Title string
- %> EQUD helpstring ; -> Help string
- &M EQUD 0 ; -> Help/Command keyword table
- '> ; And no SWIs...
- )K.helpstring EQUS name$+tab$+vsn$+" ("+date$+")
- Olly Betts"+bl$
- align
- ,F.servicecall TEQ r1,#Service_Reset ; End of machine reset ?
- -" MOVNES PC,r14
- /,.init STMFD r13!,{r0-r2,r14}
- 0% MOV r0,#GBPBV
- 1$ ADR r1,gbpbv
- 2! MOV r2,#0
- 3; SWI "XOS_Claim" ; Claim GBPBV
- 4+ LDMFD r13!,{r0-r2,PC}
- .finalise
- ; Release vector
- ; /X r0-r6
- 9" MOV R6,R14
- := MOV r0,#GBPBV ; Release RemV
- ;$ ADR r1,gbpbv
- <! MOV r2,#0
- =) SWI "XOS_Release"
- >! MOV PC,R6
- @"; Buffer remove vector routine
- AQ.gbpbv TEQ r0,#8 ; Exit if it's not the one we want
- B! TEQNE r0,#9
- CO TEQNE r0,#10 ; 10 used by RISC OS filer (3.5)
- D" TEQNE r0,#11
- E" TEQNE r0,#12
- FO STMEQFD r13!,{PC} ; PC gives PC 3 words in advance
- G" MOV PC,r14
- ;
- II.tab EQUB 0 ; Must be exactly one word
- EQUB 20
- EQUB 29
- EQUB 24
- ;
- NK LDMVSFD r13!,{PC} ; Exit if there was an error
- OH LDMCCFD r13!,{PC} ; Exit if no fnames found
- P( STMFD r13!,{r2-r4}
- Q! TEQ r0,#8
- R# BEQ awkward
- S$ ADR r4,tab-9
- T& LDRB r4,[r4,r0]
- UL.caseloop CMP r0,#10 ; OS_GBPB call used by filer?
- fDirSort
- [OPTA%
- YH LDREQ r14,[r2,#16] ; If so, is this object a
- Z; CMPEQ r14,#2 ; directory?
- fDirLast
- [OPT A%
- ^"
- Q r14,#0 :]
- [OPT A%
- a) MVNEQ r14,#
- (-1) :]
- [OPT A%
- dI STREQB r14,[r2,#0] ; If both, fudge returned
- e; STREQ r14,[r2,#4] ; timestamp
- [OPTA%
- i$ ADD r2,r2,r4
- j# BL chkleaf
- k! TEQ r0,#9
- l$ ADDNE r2,r2,#3
- m$ BICNE r2,r2,#3
- n$ SUBS r3,r3,#1
- oO BNE caseloop ; EQ => CS which is what's needed
- p+ LDMFD r13!,{r2-r4,PC}
- r0; different older format (with length bytes)
- s<; so shove in zeros and call chkleaf, then replace zeros
- t&.awkward LDRB r4,[r2],#1
- u&.awkloop LDRB r3,[r2,r4]
- vO CMP r3,#0 ; EQ => CS which is what's needed
- w+ LDMEQFD r13!,{r2-r4,PC}
- x" MOV r14,#0
- y' STRB r14,[r2,r4]
- z# BL chkleaf
- {' STRB r3,[r2,#-1]
- |! MOV r4,r3
- }# B awkloop
- %;/E R2->leafname, zero terminated
- ';/X R2->char after terminating zero
- ).chkleaf STMFD r13!,{r0,r14}
- ! MOV r0,r2
- I;B allcaps; Uncomment to turn on case translation for *all* filenames
- '.chkleaflp LDRB r14,[r2],#1
- # CMP r14,#32
- # BLE allcaps
- % CMP r14,#
- ) RSBGES r14,r14,#
- % BLT chkleaflp
- '.skiploop LDRB r14,[r2],#1
- # CMP r14,#32
- $ BGT skiploop
- ) LDMFD r13!,{r0,PC}^
- !.allcaps MOV R2,R0
- " BL doleaf
- ) LDMFD r13!,{r0,PC}^
- ).doleaf STMFD r13!,{r0,r14}
- & LDRB r0,[r2,#1]
- " CMP r0,#32
- N BLE leafloop ; One char name, so make lowercase
- &.skipplingslp LDRB r0,[r2],#1
- $ TEQ r0,#
- ( BEQ skipplingslp
- $ SUB R2,R2,#1
- ! MOV R0,R2
- ' BL trywordlist
- ! TEQ R0,#0
- ! MOVNE r2,r0
- fDownCaseRest
- [OPTA%
- $ BNE leafloop
- [OPTA%
- & LDRB r0,[r2],#1
- $ CMP r0,#
- ) LDMLEFD r13!,{r0,PC}^
- $ CMP r0,#
- ( RSBGES r14,r0,#
- , SUBGE r0,r0,#
- ' STRGEB r0,[r2,#-1]
- &.leafloop LDRB r0,[r2],#1
- $ CMP r0,#
- ( RSBGES r14,r0,#
- , ADDGE r0,r0,#
- ' STRGEB r0,[r2,#-1]
- " CMP r0,#32
- $ BGT leafloop
- ) LDMFD r13!,{r0,PC}^
- N; /E r0,r1 = chars to teq; /X Z set appropriately, other flags, r1 undef'd
- ".caselessteq
- S r1,r0,r1
- B
- Q PC,r14 ; Simple - exact match
- " TEQ r1,#32
- G MOVNE PC,r14 ; Simplish - can't match
- % BIC r0,r0,#32
- $ CMP r0,#
- ' RSBLTS r1,r0,#
- E TSTLT r0,#0 ; if LT, then force EQ
- " MOV PC,r14
- ; /E r0->leafname to try
- B; /X pointer to end of matched bits or 0 if not matched at all
- ,.trywordlist STMFD r13!,{r1-r5,r14}
- ' ADR r3,wordlist
- ! MOV r5,r0
- !.wordlistlp MOV r4,r3
- ! MOV r2,r5
- &.wordlistlp2 LDRB r0,[r3],#1
- ! TEQ r0,#0
- % BEQ wordmatch
- & LDRB r1,[r2],#1
- < BL caselessteq ; corrupts r1
- ' BEQ wordlistlp2
- &.wordlistlp3 LDRB r0,[r3],#1
- ! TEQ r0,#0
- ' BNE wordlistlp3
- # LDRB r0,[r3]
- ! TEQ r0,#0
- & BNE wordlistlp
- , LDMFD r13!,{r1-r5,PC}^
- &.wordmatch LDRB r0,[r4],#1
- ! TEQ r0,#0
- & STRNEB r0,[r5],#1
- % BNE wordmatch
- O LDMFD r13!,{r1-r4} ; Minimise stacking on recursion
- ! MOV r0,r5
- ' BL trywordlist
- ! TEQ r0,#0
-
- Q r0,r5
- ) LDMFD r13!,{r5,PC}^
- .wordlist
- P.titlestring EQUS title$+bl$ ; So we get our own name right ;)
- %[OPT A%: EQUS s$+bl$ :]
- s$=""
- [OPT A%:
- align :]
- "Size = ";P%" bytes"
- "OS_File",&0A,fnm$,&FFA,,org,O%
- "OS_Module",11,org,P%
- align
- next line allows shuffling of strings to reduce wastage
- 2)=0
- 3" byte(s) wasted by FNalign"
- 3:[OPTA%:EQUB0:]:
- Risc_PC,Sprites,Desktop,Printer
- RiscPC,Window,Source,ReadMe,Sprite,Config
- Image,LaTeX,Paint,Print,Mouse,Fonts,Demos,Games,Files,Utils,Tools
- Demo,Game,File,Util,Text,Icon,Wimp,Disk,Disc,Desk,Save,Load,Edit,Boot
- Tool,Make,Font,Test,RISC,HPGL,CMHG
- Run,Lib,PCL,DVI,TeX,Pro,DOS,GCC,Foo,Bar,DXF,Src,DTP,AMU,DDE,DDT
- WC,CC,PS,3D,OS,FS,PC
-