Create readable text `.bas' for each tokenized BASIC `,ffb' file.
[ssr] / StraySrc / Utilities / b / templaof.bas
diff --git a/StraySrc/Utilities/b/templaof.bas b/StraySrc/Utilities/b/templaof.bas
new file mode 100644 (file)
index 0000000..37cf705
--- /dev/null
@@ -0,0 +1,396 @@
+REM
+REM templAOF
+REM
+REM Mangle template files into an easily extractable form
+REM
+REM © 1995-1998 Straylight
+REM
+
+REM ----- Licensing note ----------------------------------------------------
+REM
+REM This file is part of Straylight's core utilities (coreutils)
+REM
+REM Coreutils is free software; you can redistribute it and/or modify
+REM it under the terms of the GNU General Public License as published by
+REM the Free Software Foundation; either version 2, or (at your option)
+REM any later version
+REM
+REM Coreutils is distributed in the hope that it will be useful,
+REM but WITHOUT ANY WARRANTY; without even the implied warranty of
+REM MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+REM GNU General Public License for more details.
+REM
+REM You should have received a copy of the GNU General Public License
+REM along with Coreutils.  If not, write to the Free Software Foundation,
+REM 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+ON ERROR ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]"
+
+SYS "OS_GetEnv" TO comm$
+IF INSTR(comm$,"-quit")=0 THEN ERROR 1,"templAOF must be started using *Run"
+comm$=MID$(comm$,INSTR(comm$,"""")+1)
+comm$=MID$(comm$,INSTR(comm$," ")+1)
+comm$=LEFT$(comm$,INSTR(comm$,"""")-1)
+
+tfile$=FNword(comm$)
+out$=FNword(comm$)
+header$=FNword(comm$)
+IF tfile$="" OR out$="" THEN ERROR 0,"Syntax: templAOF <in> <out> [<header>]"
+
+IF header$<>"" THEN
+  hdr%=OPENOUT(header$)
+  BPUT #hdr%,";"
+  BPUT #hdr%,"; Template symbols [generated by templAOF]"
+  BPUT #hdr%,";"
+  BPUT #hdr%,""
+  BPUT #hdr%,CHR$(9)+CHR$(9)+"["+CHR$(9)+":LNOT::DEF:tpl__dfn"
+  BPUT #hdr%,CHR$(9)+CHR$(9)+"GBLL"+CHR$(9)+"tpl__dfn"
+  BPUT #hdr%,""
+  ON ERROR CLOSE #hdr%:ERROR EXT 0,REPORT$+" ["+STR$(ERL)+"]"
+ELSE
+  hdr%=0
+ENDIF
+
+PROCassemble
+
+LIBRARY "libs:bas"
+PROCbas_init
+
+SYS "OS_File",17,tfile$ TO ,,,,tsize%
+DIM tfile% tsize%
+SYS "OS_File",16,tfile$,tfile%,0
+
+PROCbas_aofInit(tsize%*5)
+FOR pass=4 TO 6 STEP 2
+  [ opt pass
+    FNpass
+    FNarea("Resources$$Data","CODE,READONLY")
+  ]
+  index%=tfile%+16
+  WHILE index%!0
+    CASE index%!8 OF
+      WHEN 1
+        PROCloadWindow(index%!0+tfile%,index%)
+      OTHERWISE
+        IF hdr% THEN CLOSE #hdr%
+        ERROR 1,"Template type "+STR$(index%!0)+" unrecognised"
+    ENDCASE
+    index%+=24
+  ENDWHILE
+NEXT
+
+PROCbas_aofSaveAs(out$)
+IF hdr% THEN
+  BPUT #hdr%,""
+  BPUT #hdr%,CHR$(9)+CHR$(9)+"]"
+  BPUT #hdr%,""
+  BPUT #hdr%,CHR$(9)+CHR$(9)+"END"
+  CLOSE #hdr%
+  SYS "OS_File",1,header$,&FFFFFF3A,&BD896000,,3
+ENDIF
+END
+
+DEF PROCloadWindow(addr%,index%)
+name$=FNgetString(index%+12)
+
+REM --- Build template info block ---
+
+[ opt pass
+.template
+]
+
+A%=O%
+B%=index%
+C%=tfile%
+l%=USR(tpl_window)-A%
+P%+=l%
+O%+=l%
+
+[ opt pass
+  FNalign
+  FNexportAs("template","tpl_"+name$)
+]
+IF hdr%<>0 AND pass=6 THEN BPUT #hdr%,CHR$(9)+CHR$(9)+"IMPORT"+CHR$(9)+"tpl_"+name$
+ENDPROC
+
+DEF FNgetString(a%)
+LOCAL s$
+WHILE ?a%>=32
+  s$+=CHR$(?a%)
+  a%+=1
+ENDWHILE
+=s$
+
+DEF FNword(RETURN line$)
+LOCAL word$
+IF INSTR(line$," ") THEN
+  word$=LEFT$(line$,INSTR(line$," ")-1)
+  line$=MID$(line$,INSTR(line$," ")+1)
+ELSE
+  word$=line$
+  line$=""
+ENDIF
+=word$
+
+DEF FNupper(line$)
+LOCAL i%
+$q%=line$
+FOR i%=0 TO LEN(line$)-1
+  IF q%?i%>=97 AND q%?i%<=122 THEN q%?i%-=32
+NEXT
+=$q%
+
+DEF PROCassemble
+DIM code% 4096
+FOR o=0 TO 2 STEP 2
+P%=code%
+[ opt o
+
+
+; --- tpl_window ---
+;
+; entry; r0 == output pointer
+;        r1 == pointer to index entry
+;        r2 == pointer to template file base
+; exit;  r0 == new output pointer
+
+.tpl_window
+  stmfd r13!,{r14}
+  add r11,r0,#12
+  mov r10,r0
+  mov r9,r2
+  ldr r14,[r1,#0]
+  add r8,r9,r14
+
+  ; --- Build relocation table ---
+
+  mov r14,#64
+  orr r14,r14,#1<<28
+  str r14,[r11],#4
+
+  ldr r0,[r8,#56]
+  add r1,r8,#72
+  bl tpl_doReloc
+
+  ldr r7,[r8,#84]
+  add r6,r8,#88
+
+.loop
+  subs r7,r7,#1
+  ldrcs r0,[r6,#16]
+  addcs r1,r6,#20
+  blcs tpl_doReloc
+  addcs r6,r6,#32
+  bcs loop
+
+  ; --- Add in offset entry for window definition ---
+
+  sub r14,r11,r10
+  str r14,[r10,#0]
+
+  ; --- Now copy over the window definition ---
+
+  mov r14,r8
+  mov r7,#72
+
+.loop
+  subs r7,r7,#16
+  ldmcsia r14!,{r0-r3}
+  stmcsia r11!,{r0-r3}
+  bcs loop
+  ldmia r14!,{r0,r1}
+  stmia r11!,{r0,r1}
+
+  ldr r0,[r8,#56]
+  add r1,r8,#72
+  mov r5,#0
+  bl tpl_writeData
+
+  ldr r7,[r8,#84]
+  str r7,[r11],#4
+  add r6,r8,#88
+
+.loop
+  subs r7,r7,#1
+  ldmcsia r6,{r0-r3,r14}
+  stmcsia r11!,{r0-r3,r14}
+  ldrcs r0,[r6,#16]
+  addcs r1,r6,#20
+  blcs tpl_writeData
+  addcs r6,r6,#32
+  bcs loop
+
+  ; --- Add in offset for this ---
+
+  sub r14,r11,r10
+  str r14,[r10,#4]
+
+  ; --- Finally copy over the indirected data ---
+
+  ldr r0,[r8,#56]
+  add r1,r8,#72
+  bl tpl_copyData
+
+  ldr r7,[r8,#84]
+  add r6,r8,#88
+
+.loop
+  subs r7,r7,#1
+  ldrcs r0,[r6,#16]
+  addcs r1,r6,#20
+  blcs tpl_copyData
+  addcs r6,r6,#32
+  bcs loop
+
+  ; --- Put in the last offset and return ---
+
+  sub r14,r11,r10
+  str r14,[r10,#8]
+
+  mov r0,r11
+  ldmfd r13!,{pc}^
+
+
+; --- tpl_doReloc ---
+;
+; entry; r0 == icon flags word
+;        r1 == pointer to icon data
+;        r8 == base of window definition
+;        r11 == output pointer
+; exit;  r0-r5 corrupted
+
+.tpl_doReloc
+  tst r0,#&100
+  moveqs pc,r14
+
+  stmfd r13!,{r14}
+  sub r14,r1,r8
+  str r14,[r11],#4
+
+  and r14,r0,#&3
+  cmp r14,#&2
+  beq tpl_drSprite
+
+  ldr r14,[r1,#4]
+  cmn r14,#-(-1)
+  subne r14,r1,r8
+  addne r14,r14,#4
+  strne r14,[r11],#4
+  ldmfd r13!,{pc}^
+
+.tpl_drSprite
+  sub r14,r8,r1
+  add r14,r14,#4
+  orr r14,r14,#(2<<28)
+  str r14,[r11],#4
+  ldmfd r13!,{pc}^
+
+
+; --- tpl_writeData ---
+;
+; entry; r0 == icon flags word
+;        r1 == pointer to icon data
+;        r5 == indirection offset
+;        r8 == base of window definition
+;        r11 == output pointer
+; exit;  r5 updated
+;        r0-r4 corrupted
+
+.tpl_writeData
+  tst r0,#&100
+  beq tpl_wdNotInd
+
+  stmfd r13!,{r14}
+  str r5,[r11],#4
+  ldr r14,[r1,#8]
+  add r5,r5,r14
+
+  and r14,r0,#&3
+  cmp r14,#&2
+  beq tpl_wdSprite
+  ldr r14,[r1,#4]
+  cmn r14,#-(-1)
+  beq tpl_wdNoValid
+
+  str r5,[r11],#4
+  add r2,r8,r14
+
+.loop
+  ldrb r14,[r2],#1
+  add r5,r5,#1
+  cmp r14,#&20
+  bcs loop
+
+  b tpl_wdCont
+
+.tpl_wdSprite
+  mov r14,#1
+.tpl_wdNoValid
+  str r14,[r11],#4
+
+.tpl_wdCont
+  ldr r14,[r1,#8]
+  str r14,[r11],#4
+
+  ldmfd r13!,{pc}^
+
+.tpl_wdNotInd
+  ldmia r1,{r0-r2}
+  stmia r11!,{r0-r2}
+  movs pc,r14
+
+
+; --- tpl_copyData ---
+;
+; entry; r0 == icon flags
+;        r1 == pointer to icon data
+;        r8 == base of window definition
+;        r11 == output pointer
+; exit;  r0-r5 corrupted
+
+.tpl_copyData
+  tst r0,#&100
+  moveqs pc,r14
+
+  stmfd r13!,{r14}
+  mov r2,r11
+  ldr r14,[r1,#0]
+  add r3,r8,r14
+
+.loop
+  ldrb r14,[r3],#1
+  cmp r14,#&20
+  movcc r14,#0
+  strb r14,[r2],#1
+  bcs loop
+
+  ldr r14,[r1,#8]
+  add r11,r11,r14
+  mov r14,#0
+
+.loop
+  cmp r2,r11
+  strccb r14,[r2],#1
+  bcc loop
+
+  tst r0,#1
+  ldrne r14,[r1,#4]
+  cmnne r14,#-(-1)
+  beq tpl_cdSkip
+
+  add r2,r8,r14
+
+.loop
+  ldrb r14,[r2],#1
+  cmp r14,#&20
+  movcc r14,#0
+  strb r14,[r11],#1
+  bcs loop
+
+.tpl_cdSkip
+  ldmfd r13!,{pc}^
+
+]
+NEXT
+ENDPROC
+