version 1.7, 2001/07/23 13:16:11
|
version 1.8, 2001/07/24 21:21:26
|
Line 84 Create jfif $FF c, $D8 c, $FF c, $E0 c
|
Line 84 Create jfif $FF c, $D8 c, $FF c, $E0 c
|
2. BEGIN |
2. BEGIN |
2dup r@ reposition-file throw |
2dup r@ reposition-file throw |
imgbuf $10 r@ read-file throw 0<> |
imgbuf $10 r@ read-file throw 0<> |
imgbuf bw@ $FFC0 <> and WHILE |
imgbuf bw@ $FFC0 $FFD0 within 0= and WHILE |
imgbuf 2 + bw@ 2 + 0 d+ REPEAT |
imgbuf 2 + bw@ 2 + 0 d+ REPEAT |
2drop imgbuf 5 + bw@ imgbuf 7 + bw@ rdrop ; |
2drop imgbuf 5 + bw@ imgbuf 7 + bw@ rdrop ; |
|
|
Line 110 Variable iconpath
|
Line 110 Variable iconpath
|
|
|
Variable do-size |
Variable do-size |
|
|
|
Defer parse-line |
|
|
: alt-suffix ( -- ) |
: alt-suffix ( -- ) |
link-suffix $@len 2 - link-suffix $!len |
link-suffix $@len 2 - link-suffix $!len |
s" [" link-suffix 0 $ins |
s" [" link-suffix 0 $ins |
Line 130 Variable do-size
|
Line 132 Variable do-size
|
r> close-dir throw ; |
r> close-dir throw ; |
|
|
: link-icon? ( -- ) iconpath @ IF iconpath $off THEN |
: link-icon? ( -- ) iconpath @ IF iconpath $off THEN |
link '. ['] get-icon $iter ; |
link $@ |
|
BEGIN '. $split 2swap 2drop dup WHILE |
|
2dup get-icon REPEAT 2drop ; |
|
|
: link-size? ( -- ) do-size @ 0= ?EXIT |
: link-size? ( -- ) do-size @ 0= ?EXIT |
link $@ r/o open-file IF drop EXIT THEN >r |
link $@ r/o open-file IF drop EXIT THEN >r |
Line 141 Variable do-size
|
Line 145 Variable do-size
|
do-size off |
do-size off |
over c@ '% = over 0> and IF do-size on 1 /string THEN ; |
over c@ '% = over 0> and IF do-size on 1 /string THEN ; |
|
|
|
: parse-string ( addr u -- ) |
|
evaluate-input cell new-tib #tib ! tib ! |
|
['] parse-line catch pop-file throw ; |
|
|
: .link ( -- ) '[ parse type '] parse '| $split |
: .link ( -- ) '[ parse type '] parse '| $split |
link-options link $! |
link-options link $! |
link $@len 0= IF 2dup link $! s" .html" link $+! THEN |
link $@len 0= IF 2dup link $! s" .html" link $+! THEN |
link-icon? link $@ href= s" a" tagged |
link-icon? link $@ href= s" a" tag |
link-size? ; |
parse-string s" a" /tag link-size? ; |
|
|
: .img ( -- ) '{ parse type '} parse '| $split |
: .img ( -- ) '{ parse type '} parse '| $split |
dup IF 2swap alt= ELSE 2drop THEN |
dup IF 2swap alt= ELSE 2drop THEN |
Line 179 char>tag # code
|
Line 187 char>tag # code
|
|
|
: do-word ( char -- ) cells do-words + perform ; |
: do-word ( char -- ) cells do-words + perform ; |
|
|
: parse-line ( -- ) |
:noname ( -- ) |
BEGIN char? do-word source nip >in @ = UNTIL ; |
BEGIN char? do-word source nip >in @ = UNTIL ; is parse-line |
|
|
: parse-to ( char -- ) >r |
: parse-to ( char -- ) >r |
BEGIN char? dup r@ <> WHILE |
BEGIN char? dup r@ <> WHILE |
Line 198 char>tag # code
|
Line 206 char>tag # code
|
|
|
\ handle global tags |
\ handle global tags |
|
|
|
Variable indentlevel |
|
: indent ( n -- ) indentlevel @ |
|
2dup < IF 2dup swap DO -env -env LOOP THEN |
|
2dup > IF 2dup DO s" dl" >env LOOP THEN |
|
2dup = IF -env THEN |
|
drop indentlevel ! s" dt" >env ; |
|
: +indent ( -- ) -env s" dd" >env ; |
|
|
wordlist constant longtags |
wordlist constant longtags |
|
|
Variable end-sec |
Variable end-sec |
|
|
longtags set-current |
longtags set-current |
|
|
: --- cr s" hr" tag cr ; |
: --- 1 indent cr s" hr" tag cr +indent ; |
: * s" h1" line ; |
: * 1 indent s" h1" line +indent ; |
: ** s" h2" line ; |
: ** 1 indent s" h2" line +indent ; |
: *** s" h3" line ; |
: *** 2 indent s" h3" line +indent ; |
: - s" ul" env s" li" par ; |
: - s" ul" env s" li" par ; |
: + s" ol" env s" li" par ; |
: + s" ol" env s" li" par ; |
: << +env ; |
: << +env ; |
: <* s" center" >env ; |
: <* s" center" >env ; |
: >> -env ; |
: >> -env ; |
: *> -env ; |
: *> -env ; |
: . end-sec on ; |
: :: also forth interpret previous ; |
|
: . end-sec on indentlevel off ; |
: \ postpone \ ; |
: \ postpone \ ; |
|
|
definitions |
definitions |
Line 248 definitions
|
Line 265 definitions
|
|
|
\ parse a section |
\ parse a section |
|
|
|
: section-line ( -- ) >in off |
|
bl sword find-name |
|
?dup IF name>int execute |
|
ELSE source nip IF >in off s" p" par THEN THEN ; |
: refill-loop ( -- ) end-sec off |
: refill-loop ( -- ) end-sec off |
BEGIN refill WHILE >in off |
BEGIN refill WHILE |
bl sword find-name |
section-line end-sec @ UNTIL THEN ; |
?dup IF name>int execute |
|
ELSE source nip IF >in off s" p" par THEN THEN |
|
end-sec @ UNTIL THEN ; |
|
: parse-section ( -- ) |
: parse-section ( -- ) |
get-order longtags 1 set-order refill-loop set-order ; |
get-order longtags 1 set-order refill-loop set-order ; |
|
|
Line 309 Variable style$
|
Line 327 Variable style$
|
r> to outfile-id |
r> to outfile-id |
dup 0< IF throw ELSE drop THEN ; |
dup 0< IF throw ELSE drop THEN ; |
|
|
|
: eval-par ( addr u -- ) |
|
s" wf-temp.wf" r/w create-file throw >r |
|
r@ write-file r> close-file throw |
|
push-file s" wf-temp.wf" r/o open-file throw loadfile ! |
|
parse-par parse-section |
|
loadfile @ close-file swap 2dup or |
|
pop-file drop throw throw |
|
s" wf-temp.wf" delete-file throw ; |
|
|
\ simple text data base |
\ simple text data base |
|
|
: get-rest ( addr -- ) 0 parse -trailing rot $! ; |
: get-rest ( addr -- ) 0 parse -trailing rot $! ; |
|
Create $lf 1 c, #lf c, |
|
: get-par ( addr -- ) >r s" " r@ $+! |
|
BEGIN 0 parse 2dup s" ." compare WHILE |
|
r@ $@len IF $lf count r@ $+! THEN r@ $+! |
|
refill 0= UNTIL ELSE 2drop THEN |
|
rdrop ; |
|
|
Variable last-entry |
Variable last-entry |
Variable field# |
Variable field# |
Line 327 Variable field#
|
Line 360 Variable field#
|
|
|
: field: Create field# @ , 1 field# +! |
: field: Create field# @ , 1 field# +! |
DOES> @ cells last-entry @ + get-rest ; |
DOES> @ cells last-entry @ + get-rest ; |
|
: par: Create field# @ , 1 field# +! |
|
DOES> @ cells last-entry @ + get-par ; |
|
|
: >field ' >body @ cells postpone Literal postpone + ; immediate |
: >field ' >body @ cells postpone Literal postpone + ; immediate |