Create readable text `.bas' for each tokenized BASIC `,ffb' file.
[ssr] / StraySrc / Utilities / b / templaof.bas
1 REM
2 REM templAOF
3 REM
4 REM Mangle template files into an easily extractable form
5 REM
6 REM © 1995-1998 Straylight
7 REM
8
9 REM ----- Licensing note ----------------------------------------------------
10 REM
11 REM This file is part of Straylight's core utilities (coreutils)
12 REM
13 REM Coreutils is free software; you can redistribute it and/or modify
14 REM it under the terms of the GNU General Public License as published by
15 REM the Free Software Foundation; either version 2, or (at your option)
16 REM any later version
17 REM
18 REM Coreutils is distributed in the hope that it will be useful,
19 REM but WITHOUT ANY WARRANTY; without even the implied warranty of
20 REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 REM GNU General Public License for more details.
22 REM
23 REM You should have received a copy of the GNU General Public License
24 REM along with Coreutils. If not, write to the Free Software Foundation,
25 REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ON ERROR ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]"
28
29 SYS "OS_GetEnv" TO comm$
30 IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"templAOF must be started using *Run"
31 comm$=MID$(comm$,INSTR(comm$,"""")+1)
32 comm$=MID$(comm$,INSTR(comm$," ")+1)
33 comm$=LEFT$(comm$,INSTR(comm$,"""")-1)
34
35 tfile$=FNword(comm$)
36 out$=FNword(comm$)
37 header$=FNword(comm$)
38 IF tfile$="" OR out$="" THEN ERROR 0,"Syntax: templAOF <in> <out> [<header>]"
39
40 IF header$<>"" THEN
41 hdr%=OPENOUT(header$)
42 BPUT #hdr%,";"
43 BPUT #hdr%,"; Template symbols [generated by templAOF]"
44 BPUT #hdr%,";"
45 BPUT #hdr%,""
46 BPUT #hdr%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:tpl__dfn"
47 BPUT #hdr%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"tpl__dfn"
48 BPUT #hdr%,""
49 ON ERROR CLOSE #hdr%:ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]"
50 ELSE
51 hdr%=0
52 ENDIF
53
54 PROCassemble
55
56 LIBRARY "libs:bas"
57 PROCbas_init
58
59 SYS "OS_File",17,tfile$ TO ,,,,tsize%
60 DIM tfile% tsize%
61 SYS "OS_File",16,tfile$,tfile%,0
62
63 PROCbas_aofInit(tsize%*5)
64 FOR pass=4 TO 6 STEP 2
65 [ opt pass
66 FNpass
67 FNarea("Resources$$Data","CODE,READONLY")
68 ]
69 index%=tfile%+16
70 WHILE index%!0
71 CASE index%!8 OF
72 WHEN 1
73 PROCloadWindow(index%!0+tfile%,index%)
74 OTHERWISE
75 IF hdr% THEN CLOSE #hdr%
76 ERROR 1,"Template type "+STR$(index%!0)+" unrecognised"
77 ENDCASE
78 index%+=24
79 ENDWHILE
80 NEXT
81
82 PROCbas_aofSaveAs(out$)
83 IF hdr% THEN
84 BPUT #hdr%,""
85 BPUT #hdr%,CHR$(9)+CHR$(9)+"]"
86 BPUT #hdr%,""
87 BPUT #hdr%,CHR$(9)+CHR$(9)+"END"
88 CLOSE #hdr%
89 SYS "OS_File",1,header$,&FFFFFF3A,&BD896000,,3
90 ENDIF
91 END
92
93 DEF PROCloadWindow(addr%,index%)
94 name$=FNgetString(index%+12)
95
96 REM --- Build template info block ---
97
98 [ opt pass
99 .template
100 ]
101
102 A%=O%
103 B%=index%
104 C%=tfile%
105 l%=USR(tpl_window)-A%
106 P%+=l%
107 O%+=l%
108
109 [ opt pass
110 FNalign
111 FNexportAs("template","tpl_"+name$)
112 ]
113 IF hdr%<>0 AND pass=6 THEN BPUT #hdr%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+"tpl_"+name$
114 ENDPROC
115
116 DEF FNgetString(a%)
117 LOCAL s$
118 WHILE ?a%>=32
119 s$+=CHR$(?a%)
120 a%+=1
121 ENDWHILE
122 =s$
123
124 DEF FNword(RETURN line$)
125 LOCAL word$
126 IF INSTR(line$," ") THEN
127 word$=LEFT$(line$,INSTR(line$," ")-1)
128 line$=MID$(line$,INSTR(line$," ")+1)
129 ELSE
130 word$=line$
131 line$=""
132 ENDIF
133 =word$
134
135 DEF FNupper(line$)
136 LOCAL i%
137 $q%=line$
138 FOR i%=0 TO LEN(line$)-1
139 IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32
140 NEXT
141 =$q%
142
143 DEF PROCassemble
144 DIM code% 4096
145 FOR o=0 TO 2 STEP 2
146 P%=code%
147 [ opt o
148
149
150 ; --- tpl_window ---
151 ;
152 ; entry; r0 == output pointer
153 ; r1 == pointer to index entry
154 ; r2 == pointer to template file base
155 ; exit; r0 == new output pointer
156
157 .tpl_window
158 stmfd r13!,{r14}
159 add r11,r0,#12
160 mov r10,r0
161 mov r9,r2
162 ldr r14,[r1,#0]
163 add r8,r9,r14
164
165 ; --- Build relocation table ---
166
167 mov r14,#64
168 orr r14,r14,#1<<28
169 str r14,[r11],#4
170
171 ldr r0,[r8,#56]
172 add r1,r8,#72
173 bl tpl_doReloc
174
175 ldr r7,[r8,#84]
176 add r6,r8,#88
177
178 .loop
179 subs r7,r7,#1
180 ldrcs r0,[r6,#16]
181 addcs r1,r6,#20
182 blcs tpl_doReloc
183 addcs r6,r6,#32
184 bcs loop
185
186 ; --- Add in offset entry for window definition ---
187
188 sub r14,r11,r10
189 str r14,[r10,#0]
190
191 ; --- Now copy over the window definition ---
192
193 mov r14,r8
194 mov r7,#72
195
196 .loop
197 subs r7,r7,#16
198 ldmcsia r14!,{r0-r3}
199 stmcsia r11!,{r0-r3}
200 bcs loop
201 ldmia r14!,{r0,r1}
202 stmia r11!,{r0,r1}
203
204 ldr r0,[r8,#56]
205 add r1,r8,#72
206 mov r5,#0
207 bl tpl_writeData
208
209 ldr r7,[r8,#84]
210 str r7,[r11],#4
211 add r6,r8,#88
212
213 .loop
214 subs r7,r7,#1
215 ldmcsia r6,{r0-r3,r14}
216 stmcsia r11!,{r0-r3,r14}
217 ldrcs r0,[r6,#16]
218 addcs r1,r6,#20
219 blcs tpl_writeData
220 addcs r6,r6,#32
221 bcs loop
222
223 ; --- Add in offset for this ---
224
225 sub r14,r11,r10
226 str r14,[r10,#4]
227
228 ; --- Finally copy over the indirected data ---
229
230 ldr r0,[r8,#56]
231 add r1,r8,#72
232 bl tpl_copyData
233
234 ldr r7,[r8,#84]
235 add r6,r8,#88
236
237 .loop
238 subs r7,r7,#1
239 ldrcs r0,[r6,#16]
240 addcs r1,r6,#20
241 blcs tpl_copyData
242 addcs r6,r6,#32
243 bcs loop
244
245 ; --- Put in the last offset and return ---
246
247 sub r14,r11,r10
248 str r14,[r10,#8]
249
250 mov r0,r11
251 ldmfd r13!,{pc}^
252
253
254 ; --- tpl_doReloc ---
255 ;
256 ; entry; r0 == icon flags word
257 ; r1 == pointer to icon data
258 ; r8 == base of window definition
259 ; r11 == output pointer
260 ; exit; r0-r5 corrupted
261
262 .tpl_doReloc
263 tst r0,#&100
264 moveqs pc,r14
265
266 stmfd r13!,{r14}
267 sub r14,r1,r8
268 str r14,[r11],#4
269
270 and r14,r0,#&3
271 cmp r14,#&2
272 beq tpl_drSprite
273
274 ldr r14,[r1,#4]
275 cmn r14,#-(-1)
276 subne r14,r1,r8
277 addne r14,r14,#4
278 strne r14,[r11],#4
279 ldmfd r13!,{pc}^
280
281 .tpl_drSprite
282 sub r14,r8,r1
283 add r14,r14,#4
284 orr r14,r14,#(2<<28)
285 str r14,[r11],#4
286 ldmfd r13!,{pc}^
287
288
289 ; --- tpl_writeData ---
290 ;
291 ; entry; r0 == icon flags word
292 ; r1 == pointer to icon data
293 ; r5 == indirection offset
294 ; r8 == base of window definition
295 ; r11 == output pointer
296 ; exit; r5 updated
297 ; r0-r4 corrupted
298
299 .tpl_writeData
300 tst r0,#&100
301 beq tpl_wdNotInd
302
303 stmfd r13!,{r14}
304 str r5,[r11],#4
305 ldr r14,[r1,#8]
306 add r5,r5,r14
307
308 and r14,r0,#&3
309 cmp r14,#&2
310 beq tpl_wdSprite
311 ldr r14,[r1,#4]
312 cmn r14,#-(-1)
313 beq tpl_wdNoValid
314
315 str r5,[r11],#4
316 add r2,r8,r14
317
318 .loop
319 ldrb r14,[r2],#1
320 add r5,r5,#1
321 cmp r14,#&20
322 bcs loop
323
324 b tpl_wdCont
325
326 .tpl_wdSprite
327 mov r14,#1
328 .tpl_wdNoValid
329 str r14,[r11],#4
330
331 .tpl_wdCont
332 ldr r14,[r1,#8]
333 str r14,[r11],#4
334
335 ldmfd r13!,{pc}^
336
337 .tpl_wdNotInd
338 ldmia r1,{r0-r2}
339 stmia r11!,{r0-r2}
340 movs pc,r14
341
342
343 ; --- tpl_copyData ---
344 ;
345 ; entry; r0 == icon flags
346 ; r1 == pointer to icon data
347 ; r8 == base of window definition
348 ; r11 == output pointer
349 ; exit; r0-r5 corrupted
350
351 .tpl_copyData
352 tst r0,#&100
353 moveqs pc,r14
354
355 stmfd r13!,{r14}
356 mov r2,r11
357 ldr r14,[r1,#0]
358 add r3,r8,r14
359
360 .loop
361 ldrb r14,[r3],#1
362 cmp r14,#&20
363 movcc r14,#0
364 strb r14,[r2],#1
365 bcs loop
366
367 ldr r14,[r1,#8]
368 add r11,r11,r14
369 mov r14,#0
370
371 .loop
372 cmp r2,r11
373 strccb r14,[r2],#1
374 bcc loop
375
376 tst r0,#1
377 ldrne r14,[r1,#4]
378 cmnne r14,#-(-1)
379 beq tpl_cdSkip
380
381 add r2,r8,r14
382
383 .loop
384 ldrb r14,[r2],#1
385 cmp r14,#&20
386 movcc r14,#0
387 strb r14,[r11],#1
388 bcs loop
389
390 .tpl_cdSkip
391 ldmfd r13!,{pc}^
392
393 ]
394 NEXT
395 ENDPROC
396