commit a97ff1d

Add a program to display fonts using the SCOBF bitmap font format.

  1@@ -0,0 +1,197 @@
  2+\\ Show text using fonts with SCOBF format
  3+\\ (public domain)
  4+
  5+\\ This program is a rather simple one with several limitations:
  6+\\ - Only one plane is possible.
  7+\\ - The maximum raster size is 16x127.
  8+\\ - It does not properly deal with unrecognized characters.
  9+\\ - Possibly some others.
 10+
 11+\\ (If you really want to use this font format with uxn, then you might
 12+\\ instead want to write a conversion program, and use that instead.)
 13+
 14+|00
 15+  @head
 16+    &magic $8
 17+    &xsize $1
 18+    &ysize $1
 19+    &xadj $1
 20+    &yadj $1
 21+    &defl $1
 22+    &defh $1
 23+    &asc $1
 24+    &desc $1
 25+    &numl $1
 26+    &numh $1
 27+    &plane $1
 28+    &volume $1
 29+  @chead
 30+    &adv $1
 31+    &codel $1
 32+    &codeh $1
 33+    &xsize $1
 34+    &ysize $1
 35+    &xadj $1
 36+    &yadj $1
 37+  @indata
 38+    &adv $1
 39+    &offset $4
 40+    &xadj $1
 41+    &yadj $1
 42+    &size $1 \\ high bit set for 16 pixels width, low 7-bits is height
 43+
 44+|0100
 45+  #17 DEI [? error "usage: 20 "showscobf.tal 20 "<font-filename> 0a ]@
 46+  \\ Colours
 47+  #9000 #08 DEO2k INC INC DEO2k INC INC DEO2
 48+  \\ Screen
 49+  #0140 #22 DEO2
 50+  #00c8 #24 DEO2
 51+  \\ Read file name
 52+  LIT2r :memory DUP2r
 53+  [; #10 DEO2 BRK ]@
 54+  #0217 DEI LTH ?load
 55+  #12 DEI STH2rk STA INC2r BRK
 56+
 57+@load
 58+  #00 STH2r STA LITr a8 DEO2r
 59+  #0020 #aa DEO2
 60+  ;head #ac DEO2
 61+  \\ Check header
 62+  .head/magic
 63+  LDZ2k #ff01 NEQ2 ?badform
 64+  INC INC LDZ2k #7363 NEQ2 ?badform
 65+  INC INC LDZ2k #6f62 NEQ2 ?badform
 66+  INC INC LDZ2 #6600 NEQ2 ?badform
 67+  \\ Copy parts of header
 68+  .head/xsize LDZ2 .chead/xsize STZ2k POP2 #80 ADD .chead/adv STZ
 69+  .head/xadj LDZ2 .chead/xadj STZ2
 70+@bloc
 71+  \\ Read all blocks
 72+  #01ab DEO
 73+  [; #ac DEO2 #a3 DEI [? error "Unexpected 20 "end 20 "of 20 "file 0a ]@ LIT ]@ $1
 74+  DUP #f0 ( end of file ) EQU ?ready
 75+  DUP #80 ( non-mandatory extension ) LTH [?
 76+    #0f AND #ab DEO ;memory #ac DEO2 !bloc
 77+  ]@
 78+  \\ Character glyph definition
 79+  DUP #01 GTH ?badform
 80+  [? ;chead #07 ][ ;chead/codel #02 ]@ #ab DEO #ac DEO2
 81+  \\ Set address
 82+  .chead/codel LDZ2
 83+  DUP #05 SFT INC ,extcopy1/p STR
 84+  SWP #30 SFT2 ,extcopy1/a STR2
 85+  \\ Set offset and heading data
 86+  LIT2 a3 -indata/adv STZ ;indata #02 DEO2
 87+  .chead/adv LDZ .indata/adv STZ
 88+  ;chead/ysize LDZ .chead/yadj LDZ ADD SUB .indata/yadj STZ
 89+  .chead/xadj LDZ .indata/xadj STZ
 90+  \\ Size
 91+  LIT2 ff -chead/xsize LDZ ADD DUP #0f GTH ?badform #73 SFT
 92+  .chead/ysize LDZ DUP #80 AND ?badform
 93+  ORA .indata/size STZ
 94+  \\ Copy to expanded memory
 95+  ;extcopy1 #02 DEO2
 96+  \\ Skip raster data
 97+  .indata/size LDZ DUP #7f AND SWP #07 SFT INC MUL #ab DEO
 98+  ;memory #ac DEO2
 99+  \\ Next item
100+  !bloc
101+
102+@extcopy1
103+  01 0008 0000 :indata 00 &p 01 &a 0000
104+
105+@extcopy2
106+  01 0008 00 &p 00 &a 0000 0000 :indata
107+
108+@ready
109+  #0002 #28 DEO2 ;head/asc LDZ INC2 #2a DEO2 \\ X/Y coordinates
110+@next
111+  getc
112+  DUP #0a NEQ [?
113+    #0002 #28 DEO2
114+    #2a DEI2 ;head/asc LDZ ADD2 ;head/desc LDZ ADD2 #2a DEO2
115+    ?next
116+  ]@
117+  DUP #20 NEQ [?
118+    \\ This currently assumes the space width is always eight pixels
119+    #28 DEI2 #0008 ADD2 #28 DEO2
120+    ?next
121+  ]@
122+  DUP #fe NEQ [?
123+    [@ getc #fe NEQ ]? ?next
124+  ]@
125+  \\ Normal character
126+  getc
127+  \\ Find index entry for specified character
128+  OVR #05 SFT INC ,extcopy2/p STR
129+  #30 SFT2 ,extcopy2/a STR2
130+  ;extcopy2 #02 DEO2
131+  \\ Advancement
132+  ;indata/adv LDZ #0080 SUB2 #28 DEI2 ADD2 ( newx* : saved for later )
133+  \\ Adjust Y coordinate
134+  ;indata/yadj LDZ #0080 SUB2 #2a DEI2 STH2k ADD2 #2a DEO2
135+  \\ Read raster data from file
136+  LIT2 a0 -indata/adv STZ
137+  ;indata/adv #02 DEO2
138+  ;indata/size LDZ STHk #07 SFT INC STHrk #7f AND MUL #aa DEO2
139+  ;memory DUP2 #2c DEO2 #ac DEO2
140+  \\ Set graphics state
141+  STHrk #47 SFT #06 ADD #26 DEO
142+  \\ Convert glyph format if necessary
143+  STHrk #80 LTH [?
144+    ;memory
145+    LITr 81 OVRr SUBr LITr 03 SFTr LITr f8 ORAr [@
146+      DUP2 rearrange #0010 ADD2
147+    INCr STHrk ]? POPr POP2
148+  ]@
149+  \\ Draw character glyph
150+  #81 STHr SUB #03 SFT #f8 ORA
151+  [@ #012f DEO INC DUP ]? POP
152+  \\ Reset Y coordinate
153+  LITr 2a DEO2r
154+  \\ Update X coordinate
155+  #28 DEO2
156+  \\ Next character
157+  !next
158+
159+@rearrange
160+  \\ Read fourteen bytes
161+  INC2 STH2k DUP2r LDA
162+  INC2r STH2rk LDA2
163+  INC2r INC2r STH2rk LDA2
164+  INC2r INC2r STH2rk LDA2
165+  INC2r INC2r STH2rk LDA2
166+  INC2r INC2r STH2rk LDA2
167+  INC2r INC2r STH2rk LDA2
168+  INC2r INC2r STH2rk LDA
169+  ( 1 2 3 4 5 6 7 8 9 a b c d e -- 2 4 6 8 a c e 1 3 5 7 9 b d )
170+  \\ Write fourteen bytes
171+  SWP STH2r STA ( 1 2 3 4 5 6 7 8 9 a b c e )
172+  STH2rk #0006 ADD2 STA ( 1 2 3 4 5 6 7 8 9 a b c )
173+  STH2rk #0005 ADD2 STA ( 1 2 3 4 5 6 7 8 9 a b )
174+  STH2rk #000c ADD2 STA ( 1 2 3 4 5 6 7 8 9 a )
175+  STH2rk #0004 ADD2 STA ( 1 2 3 4 5 6 7 8 9 )
176+  STH2rk #000b ADD2 STA ( 1 2 3 4 5 6 7 8 )
177+  STH2rk #0003 ADD2 STA ( 1 2 3 4 5 6 7 )
178+  STH2rk #000a ADD2 STA ( 1 2 3 4 5 6 )
179+  STH2rk INC2 INC2 STA ( 1 2 3 4 5 )
180+  STH2rk #0009 ADD2 STA ( 1 2 3 4 )
181+  STH2rk INC2 STA ( 1 2 3 )
182+  STH2rk #0008 ADD2 STA ( 1 2 )
183+  STH2rk STA ( 1 )
184+  STH2r #0007 ADD2 STA
185+  \\ Done
186+  JMP2r
187+
188+@badform
189+  error "Improper 20 "file 20 "format 0a
190+
191+@error
192+  [@ LDArk STHrk #19 DEO STHr #0a EOR INC2r ]? #010f DEO
193+
194+@getc
195+  [; #10 DEO2 BRK ]@ #12 DEI JMP2r
196+
197+@memory
198+