version 1.15, 2002/07/26 08:35:15
|
version 1.16, 2002/09/14 08:20:20
|
Line 99 Create jfif $FF c, $D8 c, $FF c, $E0 c
|
Line 99 Create jfif $FF c, $D8 c, $FF c, $E0 c
|
: bw@ ( addr -- x ) 0 swap 2 bounds ?DO 8 lshift I c@ + LOOP ; |
: bw@ ( addr -- x ) 0 swap 2 bounds ?DO 8 lshift I c@ + LOOP ; |
|
|
: gif? ( -- flag ) |
: gif? ( -- flag ) |
s" GIF89a" imgbuf over compare 0= |
s" GIF89a" imgbuf over str= |
s" GIF87a" imgbuf over compare 0= or ; |
s" GIF87a" imgbuf over str= or ; |
: gif-size ( -- w h ) |
: gif-size ( -- w h ) |
imgbuf 8 + c@ imgbuf 9 + c@ 8 lshift + |
imgbuf 8 + c@ imgbuf 9 + c@ 8 lshift + |
imgbuf 6 + c@ imgbuf 7 + c@ 8 lshift + ; |
imgbuf 6 + c@ imgbuf 7 + c@ 8 lshift + ; |
|
|
: png? ( -- flag ) |
: png? ( -- flag ) |
pngsig 8 imgbuf over compare 0= ; |
pngsig 8 imgbuf over str= ; |
: png-size ( -- w h ) |
: png-size ( -- w h ) |
imgbuf $14 + b@ imgbuf $10 + b@ ; |
imgbuf $14 + b@ imgbuf $10 + b@ ; |
|
|
: jpg? ( -- flag ) |
: jpg? ( -- flag ) |
jfif 10 imgbuf over compare 0= ; |
jfif 10 imgbuf over str= ; |
: jpg-size ( fd -- w h ) >r |
: jpg-size ( fd -- w h ) >r |
2. BEGIN |
2. BEGIN |
2dup r@ reposition-file throw |
2dup r@ reposition-file throw |
Line 195 Defer parse-line
|
Line 195 Defer parse-line
|
over c@ '% = over 0> and IF do-size on 1 /string THEN |
over c@ '% = over 0> and IF do-size on 1 /string THEN |
over c@ '\ = over 0> and IF do-icon off 1 /string THEN ; |
over c@ '\ = over 0> and IF do-icon off 1 /string THEN ; |
|
|
s" Gforth" environment? [IF] s" 0.5.0" compare 0= [IF] |
s" Gforth" environment? [IF] s" 0.5.0" str= [IF] |
: parse-string ( c-addr u -- ) \ core,block |
: parse-string ( c-addr u -- ) \ core,block |
loadfilename# @ >r |
loadfilename# @ >r |
1 loadfilename# ! \ "*evaluated string*" |
1 loadfilename# ! \ "*evaluated string*" |
Line 297 wordlist Constant autoreplacements
|
Line 297 wordlist Constant autoreplacements
|
: get-rest ( addr -- ) 0 parse -trailing rot $! ; |
: get-rest ( addr -- ) 0 parse -trailing rot $! ; |
Create $lf 1 c, #lf c, |
Create $lf 1 c, #lf c, |
: get-par ( addr -- ) >r s" " r@ $+! |
: get-par ( addr -- ) >r s" " r@ $+! |
BEGIN 0 parse 2dup s" ." compare WHILE |
BEGIN 0 parse 2dup s" ." str= 0= WHILE |
r@ $@len IF $lf count r@ $+! THEN r@ $+! |
r@ $@len IF $lf count r@ $+! THEN r@ $+! |
refill 0= UNTIL ELSE 2drop THEN |
refill 0= UNTIL ELSE 2drop THEN |
rdrop ; |
rdrop ; |
Line 405 longtags set-current
|
Line 405 longtags set-current
|
: . end-sec on 0 indent ; |
: . end-sec on 0 indent ; |
: :code s" pre" >env |
: :code s" pre" >env |
BEGIN source >in @ /string type cr refill WHILE |
BEGIN source >in @ /string type cr refill WHILE |
source s" :endcode" compare 0= UNTIL THEN |
source s" :endcode" str= UNTIL THEN |
-env ; |
-env ; |
: \ postpone \ ; |
: \ postpone \ ; |
|
|