commit 8a46c25

Add incomplete uhsview program (it will (hopefully) be completed in future)

  1@@ -0,0 +1,294 @@
  2+\\ UHS viewer (public domain)
  3+\\ Requires some nonstandard features of uxn38.
  4+
  5+\\ (This program is currently incomplete.)
  6+
  7+|0000
  8+  @Jstate $1
  9+  @Mstate $1
 10+  @MouseX $2
 11+  @MouseY $2
 12+  \\ Pointers into line index
 13+  @Active $2
 14+  @Scroll $2
 15+  @Cursor $2
 16+  @Break $2
 17+|0022
 18+  @Width $1
 19+|0024
 20+  @Height $1
 21+  @Tend $1
 22+|0028
 23+  @Title
 24+
 25+|0100
 26+  started
 27+@makeindex
 28+  \\ Load the list of lines
 29+  LIT2r :line-1 LIT2r :lines
 30+  &go
 31+    \\ Update parent address if necessary
 32+    OVR2r STH2r #06 ADD LDA2 STH2rk GTH2 [?
 33+      SWP2r LDA2r
 34+      STH2rk #05 ADD LDA .typ/subject EOR ;&in STA
 35+      SWP2r !&go
 36+    ]@
 37+    \\ File position
 38+    #a3 STH2rk STA STH2rk #02 DEO2
 39+    \\ Parent address
 40+    STA2rk
 41+    \\ Number of lines, or - or =
 42+    #0000 #ac DEI
 43+    ( number* char // parent* addr* )
 44+    isword "- -typ/break 0d
 45+    isword "= -typ/inner 0d
 46+    DUP #1a EQU ?&eof
 47+  &ch
 48+    DUP #0a EQU ?&el
 49+    DUP #20 EQU ?&sp
 50+    #30 SUB DUP #09 GTH ?&nn
 51+    STH #000a MUL2 #00 STHr ADD2
 52+    #ac DEI !&ch
 53+  &sp
 54+    POP #ac DEI
 55+    DUP LIT "c NEQ [?
 56+      POP #ac DEI
 57+      isword "r -typ/credit "edit 0d
 58+      isword "o -typ/comment "mment 0d
 59+    ]@
 60+    isword "s -typ/subject "ubject 0d
 61+    isword "h -typ/hint "int 0d
 62+    isword "n -typ/nesthint "esthint 0d
 63+    isword "l -typ/link "ink 0d
 64+    isword "b -typ/blank "lank 0d
 65+    \\ None match, so fall through
 66+  &nn
 67+    POP #ac DEI DUP #0a NEQ ?&nn \\ fall through
 68+  &el
 69+    DUP EOR \\ fall through
 70+  &set
 71+    \\ Update parent address if applicable
 72+    LIT &in 00 [? NIP2r DUP2r DUP .typ/subject EOR ,&in STR ]@
 73+    DUP .typ/inner NEQ [? ,&in LDR DUP .subxnest NEQ MUL ,&in STR ]@
 74+    \\ Send record
 75+    STH2rk #05 ADD STA
 76+    ORAk [? INC ]@
 77+    #30 SFT2 STH2rk ADD2 STH2rk #06 ADD STA2
 78+    LIT2r 0008 ADD2r !&go
 79+  &eof
 80+    POP POP2 LIT2r :line-1/final STA2r POP2r \\ continue
 81+\\ Load and encrypt title
 82+  ;line2 seek
 83+  ;line3z LDA2 ;line2z LDA2 SUB2 #0002 SUB2
 84+  DUP .Title ADD .Tend STZ #aa DEO2
 85+  LIT2r :Title STHrk LITr ac DEO2r
 86+  [@
 87+    LDZk STH LIT2r :Tkey STHk LITr 03 DIVrk MULr SUBr ADDr LDAr STHk EORr ADDr
 88+    STHrk #80 LTH [? DUPr LITr df GTHr INCr LITr 60 MULr SUBr ]@ STHk STZr
 89+    INC DUP
 90+  ]?
 91+  POP ;line-1
 92+\\ This must end not before 0x0200
 93+\_1@8>/[1E]
 94+
 95+@gonode ( address* -- )
 96+  ( clear screen ) DUP2k EOR2 #28 DEO2k INC INC DEO2 #802e DEO
 97+  DUP2 .Active STZ2 DUP2 .Scroll STZ2 .Cursor STZ2
 98+  showtitle
 99+  
100+  BRK
101+
102+@seek ( node* -- )
103+  STH2k LDA2 #a000 STH2rk STA2 STH2rk #02 DEO2 STH2r STA2 JMP2r
104+
105+@locate ( x y -- )
106+  #0005 SFT2 #2a DEO2 #0005 SFT2 #28 DEO2 JMP2r
107+
108+@drawch ( char -- )
109+  #0005 SFT2 ;Font ADD2 #2c DEO2 LIT2 &ink 012f DEO JMP2r
110+
111+@rvon ( -- )
112+  LIT2 04 \,drawch/ink STR JMP2r
113+
114+@rvoff ( -- )
115+  LIT2 01 \,drawch/ink STR JMP2r
116+
117+@showtitle ( -- )
118+  rvon #0100 locate
119+  #ff drawch \\ TODO: change it to draw the icon for the block type
120+  .Active LDZ2 seek
121+  [@ #ac DEI DUP #0d NEQ [? POP JMP2r ]@ drawch ]!
122+
123+@error
124+  [@ STH2rk INC2r LDA DUP #19 DEO #0a EOR ]?
125+  #010f DEO BRK
126+
127+@isword ( char -- )
128+  DUP LDArk STHr INC2r EQU [?
129+    [@ LDArk STHr INC2r #0d NEQ ]? JMP2r
130+  ]@
131+  POP LDArk STHr
132+  [@
133+    INC2r
134+    #ac DEI
135+    DUP #0a NEQ [? POP2r ?makeindex/el ]@
136+    DUP LDArk STHr EQU [? POP2r ?makeindex/nn ]@
137+    #0d NEQ [? POP2r #ac DEI ?makeindex/set ]@
138+  ]!
139+
140+@decode ( char -- char )
141+  DUP #21 LTH [?
142+    DUP ADD DUP #9f GTH #5f MUL SUB
143+  ]@ JMP2r
144+
145+@vkey
146+  #92 DEI2 #28 DEO2 #94 DEI2 #2a DEO2 #402f DEO
147+  
148+  #82 DEI .Jstate STH2k LDZ STZr EQU ?&brk
149+    
150+  &brk BRK
151+
152+@vmouse
153+  .MouseX LDZ2 #28 DEO2
154+  .MouseY LDZ2 #2a DEO2
155+  #402f DEO
156+  #92 DEI2 DUP2 .MouseX STZ2 #28 DEO2
157+  #94 DEI2 DUP2 .MouseY STZ2 #2a DEO2
158+  ;mouseshape #2c DEO2 #c12f DEO
159+  #96 DEI .Mstate STH2k LDZ STZr EQU ?vkey/brk
160+    
161+  BRK
162+
163+\_@2+fe'&(@2+!) \\ alignment
164+@Tkey "yke
165+
166+\_@8@7&-7&+! ( alignment )
167+
168+@mouseshape
169+  \=2222222.
170+  \=2333332.
171+  \=2332222.
172+  \=23232...
173+  \=232232..
174+  \=232.232.
175+  \=222..232
176+  \=......22;
177+
178+( 1c )
179+  \-...1....
180+  \-..1.1...
181+  \-.1...1..
182+  \-1.....1.
183+  \-1.....1.
184+  \-.1...1..
185+  \-..1.1...
186+  \-...1....;
187+
188+( 1d )
189+  \-........
190+  \-........
191+  \-........
192+  \-........
193+  \-1.....1.
194+  \-.1...1..
195+  \-..1.1...
196+  \-...1....;
197+
198+( 1e )
199+  \-...1....
200+  \-..1.1...
201+  \-.1...1..
202+  \-1.....1.
203+  \-........
204+  \-........
205+  \-........
206+  \-........;
207+
208+( 1f )
209+  \-........
210+  \-.11.....
211+  \-.1111...
212+  \-.111111.
213+  \-.1111...
214+  \-.11.....
215+  \-........
216+  \-........;
217+
218+\_@20'8*- \@Font \~ascii.font
219+
220+\\ Extra records (explained below)
221+@line-1 :line-1 00 00 00 -typ/subject &final ffff
222+@line0 0000 00 00 00 -typ/inner :lines
223+
224+@lines
225+  \\ List of lines of UHS file is stored in here.
226+  \\ (This area is also used for some things only used during initialization)
227+  \\ The format is:
228+  \\   Address of record for parent node (two bytes)
229+  \\   File offset (three bytes)
230+  \\   Item type (one byte)
231+  \\   Address of record for line following end of block (two bytes)
232+  \_@8+ \@line2
233+  \_@b+ \@line2z
234+  \_@8+b+ \@line3z
235+
236+@endof88a
237+  0a "** 20 "END 20 "OF 20 "88A 20 "FORMAT 20 "** 0d0a &end
238+
239+@notuhs
240+  error "Not 20 "a 20 "UHS 20 "file 0a
241+
242+@started
243+  #17 DEI [?
244+    error "usage: 20 "uhsview.rom 20 "<uhsfile> 0a
245+  ]@
246+  \\ Read file name
247+  LIT2r :filename DUP2r
248+  [; #10 DEO2 BRK ]@
249+  #17 DEI #02 GTH [? #12 DEI STH2rk INC2r STA BRK ]@
250+  \\ Finish with file name
251+  #00 DUPk STH2r STA #10 DEO2
252+  LITr a8 DEO2r
253+  \\ Check file existence and if it is UHS
254+  #ac DEI2
255+  #a3 DEI [? error "Cannot 20 "read 20 "file 0a ]@
256+  LIT2 "UH NEQ2 ?notuhs
257+  #ac DEI2 LIT2 "S 0d NEQ2 ?notuhs
258+  #ac DEI #0a NEQ ?notuhs
259+  \\ Find the "** END OF 88A FORMAT **"
260+  LIT2r :endof88a DUP2r
261+  [@
262+    #a3 DEI [?
263+      error "This 20 "program 20 "is 20 "not 20 "compatible 20 "with 20 "88a 20 "format 0a
264+    ]@
265+    #ac DEI STH2rk INC2r LDA EQU [? POP2r DUP2r ]@
266+    STH2rk ;endof88a/end NEQ2
267+  ]?
268+  POP2r POP2r
269+  \\ Device initialization
270+  #d0f0 #08 DEO2
271+  #d0f2 #0a DEO2
272+  #c0f1 #0c DEO2
273+  #0200 #22 DEO2
274+  #00c8 #24 DEO2
275+  #0126 DEO
276+  ;vkey #80 DEO2
277+  ;vmouse #90 DEO2
278+  #2224 [& ]@ DEI2k #03 SFT2 SWP #00 NEQ #ff MUL ORA SWP STZ JMP2r
279+
280+@filename
281+  \\ File name storage
282+
283+@typ |00
284+  &none $1
285+  &subject $1
286+  &hint $1
287+  &nesthint $1
288+  &comment $1
289+  &credit $1
290+  &link $1
291+  &blank $1
292+  &break $1
293+  &inner $1
294+  \:typ/subject \:typ/nesthint \_^ \@subxnest
295+