| : 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 |
| 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*" |
| : 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 ; |
| : . 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 \ ; |
| |
|
