home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / utilities / utilss / speclcase / Casesrc (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1994-10-17  |  9KB  |  233 lines
  1.  > CaseSrc
  2.  fDirSort - set to TRUE to force directories first/last in "Sort by date"
  3.           - set to FALSE to sort directories with files
  4. fDirSort=
  5.  Ignored if fDirSort=FALSE, otherwise:
  6.  fDirLast - set to TRUE to force directories last in "Sort by date"
  7.           - set to FALSE to force directories first in "Sort by date"
  8. fDirLast=
  9.  fDownCaseRest - set to TRUE to force any unmatched tail to lower-case
  10.                  if wordlist matches start (eg SPRITELY -> Spritely)
  11.                - set to FALSE to capitalise initial letter of tail
  12.                  (eg SPRITEFRED -> SpriteFred)
  13. fDownCaseRest=
  14. Jvsn$="0.04":fnm$="SpeclCase":date$="17 Oct 1994":
  15.  or MID$(TIME$,5,11)
  16. -title$="SpecialCase":name$="Special Case"
  17. ;bl$=
  18. 0:cr$=
  19. 13:lfcr$=
  20. 10+cr$:tab$=
  21. 9:esc$=
  22. 27:hspc$=
  23. +GBPBV=&0C:
  24.  Buffer Remove vector number
  25. <Service_Reset      =&27:
  26.  End of machine reset signalled
  27. 1codesize=&1000:
  28.  org codesize:L%=org+codesize
  29.  A%=%1100 
  30.  %1110 
  31.  %0010
  32. ?P%=0:O%=org : 
  33.  So that addresses are offsets within module
  34. [OPT A%
  35.  G                EQUD    0                 ; Application start entry
  36. !D                EQUD    init              ; Initialisation entry
  37. "B                EQUD    finalise          ; Finalisation entry
  38. #B                EQUD    servicecall       ; Service call entry
  39. $?                EQUD    titlestring       ; -> Title string
  40. %>                EQUD    helpstring        ; -> Help string
  41. &M                EQUD    0                 ; -> Help/Command keyword table
  42. '>                                          ; And no SWIs...
  43. )K.helpstring     EQUS    name$+tab$+vsn$+" ("+date$+") 
  44.  Olly Betts"+bl$
  45. align
  46. ,F.servicecall    TEQ     r1,#Service_Reset ; End of machine reset ?
  47. -"                MOVNES  PC,r14
  48. /,.init           STMFD   r13!,{r0-r2,r14}
  49. 0%                MOV     r0,#GBPBV
  50. 1$                ADR     r1,gbpbv
  51. 2!                MOV     r2,#0
  52. 3;                SWI     "XOS_Claim"       ; Claim GBPBV
  53. 4+                LDMFD   r13!,{r0-r2,PC}
  54. .finalise
  55. ; Release vector
  56. ; /X r0-r6
  57. 9"                MOV     R6,R14
  58. :=                MOV     r0,#GBPBV          ; Release RemV
  59. ;$                ADR     r1,gbpbv
  60. <!                MOV     r2,#0
  61. =)                SWI     "XOS_Release"
  62. >!                MOV     PC,R6
  63. @"; Buffer remove vector routine
  64. AQ.gbpbv          TEQ     r0,#8              ; Exit if it's not the one we want
  65. B!                TEQNE   r0,#9
  66. CO                TEQNE   r0,#10             ; 10 used by RISC OS filer (3.5)
  67. D"                TEQNE   r0,#11
  68. E"                TEQNE   r0,#12
  69. FO                STMEQFD r13!,{PC}          ; PC gives PC 3 words in advance
  70. G"                MOV     PC,r14
  71.                 ;
  72. II.tab            EQUB    0                  ; Must be exactly one word
  73.                 EQUB    20
  74.                 EQUB    29
  75.                 EQUB    24
  76.                 ;
  77. NK                LDMVSFD r13!,{PC}          ; Exit if there was an error
  78. OH                LDMCCFD r13!,{PC}          ; Exit if no fnames found
  79. P(                STMFD   r13!,{r2-r4}
  80. Q!                TEQ     r0,#8
  81. R#                BEQ     awkward
  82. S$                ADR     r4,tab-9
  83. T&                LDRB    r4,[r4,r0]
  84. UL.caseloop       CMP     r0,#10             ; OS_GBPB call used by filer?
  85.  fDirSort 
  86. [OPTA%
  87. YH                LDREQ   r14,[r2,#16]       ; If so, is this object a
  88. Z;                CMPEQ   r14,#2             ; directory?
  89.  fDirLast 
  90. [OPT A%
  91. ^"                
  92. Q   r14,#0 :]
  93. [OPT A%
  94. a)                MVNEQ   r14,#
  95. (-1) :]
  96. [OPT A%
  97. dI                STREQB  r14,[r2,#0]         ; If both, fudge returned
  98. e;                STREQ   r14,[r2,#4]         ; timestamp
  99. [OPTA%
  100. i$                ADD     r2,r2,r4
  101. j#                BL      chkleaf
  102. k!                TEQ     r0,#9
  103. l$                ADDNE   r2,r2,#3
  104. m$                BICNE   r2,r2,#3
  105. n$                SUBS    r3,r3,#1
  106. oO                BNE     caseloop          ; EQ => CS which is what's needed
  107. p+                LDMFD   r13!,{r2-r4,PC}
  108. r0; different older format (with length bytes)
  109. s<; so shove in zeros and call chkleaf, then replace zeros
  110. t&.awkward        LDRB    r4,[r2],#1
  111. u&.awkloop        LDRB    r3,[r2,r4]
  112. vO                CMP     r3,#0             ; EQ => CS which is what's needed
  113. w+                LDMEQFD r13!,{r2-r4,PC}
  114. x"                MOV     r14,#0
  115. y'                STRB    r14,[r2,r4]
  116. z#                BL      chkleaf
  117. {'                STRB    r3,[r2,#-1]
  118. |!                MOV     r4,r3
  119. }#                B       awkloop
  120. %;/E R2->leafname, zero terminated
  121. ';/X R2->char after terminating zero
  122. ).chkleaf        STMFD   r13!,{r0,r14}
  123. !                MOV     r0,r2
  124. I;B allcaps; Uncomment to turn on case translation for *all* filenames
  125. '.chkleaflp      LDRB    r14,[r2],#1
  126. #                CMP     r14,#32
  127. #                BLE     allcaps
  128. %                CMP     r14,#
  129. )                RSBGES  r14,r14,#
  130. %                BLT     chkleaflp
  131. '.skiploop       LDRB    r14,[r2],#1
  132. #                CMP     r14,#32
  133. $                BGT     skiploop
  134. )                LDMFD   r13!,{r0,PC}^
  135. !.allcaps        MOV     R2,R0
  136. "                BL      doleaf
  137. )                LDMFD   r13!,{r0,PC}^
  138. ).doleaf         STMFD   r13!,{r0,r14}
  139. &                LDRB    r0,[r2,#1]
  140. "                CMP     r0,#32
  141. N                BLE     leafloop        ; One char name, so make lowercase
  142. &.skipplingslp   LDRB    r0,[r2],#1
  143. $                TEQ     r0,#
  144. (                BEQ     skipplingslp
  145. $                SUB     R2,R2,#1
  146. !                MOV     R0,R2
  147. '                BL      trywordlist
  148. !                TEQ     R0,#0
  149. !                MOVNE   r2,r0
  150.  fDownCaseRest 
  151. [OPTA%
  152. $                BNE     leafloop
  153. [OPTA%
  154. &                LDRB    r0,[r2],#1
  155. $                CMP     r0,#
  156. )                LDMLEFD r13!,{r0,PC}^
  157. $                CMP     r0,#
  158. (                RSBGES  r14,r0,#
  159. ,                SUBGE   r0,r0,#
  160. '                STRGEB  r0,[r2,#-1]
  161. &.leafloop       LDRB    r0,[r2],#1
  162. $                CMP     r0,#
  163. (                RSBGES  r14,r0,#
  164. ,                ADDGE   r0,r0,#
  165. '                STRGEB  r0,[r2,#-1]
  166. "                CMP     r0,#32
  167. $                BGT     leafloop
  168. )                LDMFD   r13!,{r0,PC}^
  169. N; /E r0,r1 = chars to teq; /X Z set appropriately, other flags, r1 undef'd
  170. ".caselessteq    
  171. S    r1,r0,r1
  172. B                
  173. Q   PC,r14             ; Simple - exact match
  174. "                TEQ     r1,#32
  175. G                MOVNE   PC,r14             ; Simplish - can't match
  176. %                BIC     r0,r0,#32
  177. $                CMP     r0,#
  178. '                RSBLTS  r1,r0,#
  179. E                TSTLT   r0,#0              ; if LT, then force EQ
  180. "                MOV     PC,r14
  181. ; /E r0->leafname to try
  182. B; /X pointer to end of matched bits or 0 if not matched at all
  183. ,.trywordlist    STMFD   r13!,{r1-r5,r14}
  184. '                ADR     r3,wordlist
  185. !                MOV     r5,r0
  186. !.wordlistlp     MOV     r4,r3
  187. !                MOV     r2,r5
  188. &.wordlistlp2    LDRB    r0,[r3],#1
  189. !                TEQ     r0,#0
  190. %                BEQ     wordmatch
  191. &                LDRB    r1,[r2],#1
  192. <                BL      caselessteq        ; corrupts r1
  193. '                BEQ     wordlistlp2
  194. &.wordlistlp3    LDRB    r0,[r3],#1
  195. !                TEQ     r0,#0
  196. '                BNE     wordlistlp3
  197. #                LDRB    r0,[r3]
  198. !                TEQ     r0,#0
  199. &                BNE     wordlistlp
  200. ,                LDMFD   r13!,{r1-r5,PC}^
  201. &.wordmatch      LDRB    r0,[r4],#1
  202. !                TEQ     r0,#0
  203. &                STRNEB  r0,[r5],#1
  204. %                BNE     wordmatch
  205. O                LDMFD   r13!,{r1-r4}       ; Minimise stacking on recursion
  206. !                MOV     r0,r5
  207. '                BL      trywordlist
  208. !                TEQ     r0,#0
  209.                 
  210. Q   r0,r5
  211. )                LDMFD   r13!,{r5,PC}^
  212. .wordlist
  213. P.titlestring    EQUS    title$+bl$         ; So we get our own name right ;)
  214. %[OPT A%:        EQUS    s$+bl$ :]
  215.  s$=""
  216. [OPT A%:        
  217. align :]
  218. "Size = ";P%" bytes"
  219.  "OS_File",&0A,fnm$,&FFA,,org,O%
  220.  "OS_Module",11,org,P%
  221. align
  222.  next line allows shuffling of strings to reduce wastage
  223. 2)=0 
  224. 3" byte(s) wasted by FNalign"
  225. 3:[OPTA%:EQUB0:]:
  226.  Risc_PC,Sprites,Desktop,Printer
  227.  RiscPC,Window,Source,ReadMe,Sprite,Config
  228.  Image,LaTeX,Paint,Print,Mouse