| |
|
| \ character recoding |
\ character recoding |
| |
|
| |
[IFDEF] 8-bit-io 8-bit-io [THEN] |
| |
\ UTF-8 IO fails with .type: |
| |
|
| : .type ( addr u -- ) |
: .type ( addr u -- ) |
| bounds ?DO I c@ |
bounds ?DO I c@ |
| case |
case |
| |
|
| Variable indentlevel |
Variable indentlevel |
| Variable tag-option |
Variable tag-option |
| |
Variable tag-class |
| s" " tag-option $! |
s" " tag-option $! |
| |
s" " tag-class $! |
| |
|
| : tag ( addr u -- ) '< emit type tag-option $@ type '> emit |
: tag ( addr u -- ) '< emit type |
| s" " tag-option $! ; |
tag-class $@len IF .\" class=\"" tag-class $@ type '" emit THEN |
| |
tag-option $@ type |
| |
'> emit |
| |
s" " tag-option $! s" " tag-class $! ; |
| : tag/ ( addr u -- ) s" /" tag-option $+! tag ; |
: tag/ ( addr u -- ) s" /" tag-option $+! tag ; |
| : /tag ( addr u -- ) '< emit '/ emit type '> emit ; |
: /tag ( addr u -- ) '< emit '/ emit type '> emit ; |
| : tagged ( addr1 u1 addr2 u2 -- ) 2dup 2>r tag .type 2r> /tag ; |
: tagged ( addr1 u1 addr2 u2 -- ) 2dup 2>r tag .type 2r> /tag ; |
| tag-option $+! s' ="' tag-option $+! tag-option $+! |
tag-option $+! s' ="' tag-option $+! tag-option $+! |
| s' "' tag-option $+! ; |
s' "' tag-option $+! ; |
| : n>string ( n -- addr u ) 0 <# #S #> ; |
: n>string ( n -- addr u ) 0 <# #S #> ; |
| |
: xy>string ( x y -- ) swap 0 <# #S 'x hold 2drop 0 #S 's hold #> ; |
| : opt# ( n opt u -- ) rot n>string 2swap opt ; |
: opt# ( n opt u -- ) rot n>string 2swap opt ; |
| : href= ( addr u -- ) s" href" opt ; |
: href= ( addr u -- ) s" href" opt ; |
| : id= ( addr u -- ) s" id" opt ; |
: id= ( addr u -- ) s" id" opt ; |
| : width= ( n -- ) s" width" opt# ; |
: width= ( n -- ) s" width" opt# ; |
| : height= ( n -- ) s" height" opt# ; |
: height= ( n -- ) s" height" opt# ; |
| : align= ( addr u -- ) s" align" opt ; |
: align= ( addr u -- ) s" align" opt ; |
| : class= ( addr u -- ) s" class" opt ; |
: class= ( addr u -- ) |
| |
tag-class $@len IF s" " tag-class $+! THEN |
| |
tag-class $+! ; |
| : indent= ( -- ) |
: indent= ( -- ) |
| indentlevel @ 0 <# #S 'p hold #> class= ; |
indentlevel @ 0 <# #S 'p hold #> class= ; |
| : mailto: ( addr u -- ) s' href="mailto:' tag-option $+! |
: mailto: ( addr u -- ) s' href="mailto:' tag-option $+! |
| |
|
| \ image handling |
\ image handling |
| |
|
| |
wordlist Constant img-sizes |
| |
|
| Create imgbuf $20 allot |
Create imgbuf $20 allot |
| |
|
| Create pngsig $89 c, $50 c, $4E c, $47 c, $0D c, $0A c, $1A c, $0A c, |
Create pngsig $89 c, $50 c, $4E c, $47 c, $0D c, $0A c, $1A c, $0A c, |
| png? IF png-size rdrop EXIT THEN |
png? IF png-size rdrop EXIT THEN |
| 0 0 rdrop ; |
0 0 rdrop ; |
| |
|
| |
3 set-precision |
| |
|
| |
: f.size ( r -- ) |
| |
f$ dup >r 0<= |
| |
IF '0 emit |
| |
ELSE scratch r@ min type r@ precision - zeros THEN |
| |
'. emit r@ negate zeros |
| |
scratch r> 0 max /string 0 max -zeros type ; |
| |
|
| |
: size-does> ( -- ) DOES> ( -- ) |
| |
." img." dup body> >name .name |
| |
2@ ." { width: " |
| |
s>d d>f 13.8e f/ f.size ." em; height: " |
| |
s>d d>f 13.8e f/ f.size ." em; }" cr ; |
| |
|
| |
: size-css ( file< > -- ) |
| |
outfile-id >r |
| |
bl sword r/w create-file throw to outfile-id |
| |
img-sizes wordlist-id |
| |
BEGIN @ dup WHILE |
| |
dup name>int execute |
| |
REPEAT drop |
| |
outfile-id close-file throw |
| |
r> to outfile-id |
| |
dup 0< IF throw ELSE drop THEN ; |
| |
|
| |
: size-class ( x y addr u -- x y ) |
| |
2dup class= |
| |
2dup img-sizes search-wordlist IF drop 2drop |
| |
ELSE |
| |
get-current >r img-sizes set-current |
| |
nextname Create 2dup , , size-does> |
| |
r> set-current |
| |
THEN ; |
| |
|
| : .img-size ( addr u -- ) |
: .img-size ( addr u -- ) |
| r/o open-file IF drop EXIT THEN >r |
r/o open-file IF drop EXIT THEN >r |
| imgbuf $20 r@ read-file throw drop |
imgbuf $20 r@ read-file throw drop |
| r@ img-size |
r@ img-size |
| r> close-file throw |
r> close-file throw |
| |
2dup or IF 2dup xy>string size-class THEN |
| ?dup IF width= THEN |
?dup IF width= THEN |
| ?dup IF height= THEN ; |
?dup IF height= THEN |
| |
; |
| |
|
| \ link creation |
\ link creation |
| |
|
| icon-tmp $@ THEN |
icon-tmp $@ THEN |
| dup >r '| -$split dup r> = IF 2swap THEN |
dup >r '| -$split dup r> = IF 2swap THEN |
| dup IF 2swap alt= ELSE 2drop THEN |
dup IF 2swap alt= ELSE 2drop THEN |
| tag-option $@len >r over c@ >align tag-option $@len r> = 1+ /string |
tag-class $@len >r over c@ >align tag-class $@len r> = 1+ /string |
| tag-option $@len >r over c@ >border tag-option $@len r> = 1+ /string |
tag-class $@len >r over c@ >border tag-class $@len r> = 1+ /string |
| 2dup .img-size src= s" img" tag/ ; |
2dup .img-size src= s" img" tag/ ; |
| : >img ( -- ) '{ parse type '} parse .img ; |
: >img ( -- ) '{ parse type '} parse .img ; |
| |
|
| |
|
| \ HTML trailer |
\ HTML trailer |
| |
|
| |
Variable public-key |
| Variable mail |
Variable mail |
| Variable mail-name |
Variable mail-name |
| Variable orig-date |
Variable orig-date |
| .lastmod |
.lastmod |
| ." by " |
." by " |
| s" Mail|@/mail.gif" .img mail $@ mailto: mail-name $@ s" a" tagged |
s" Mail|@/mail.gif" .img mail $@ mailto: mail-name $@ s" a" tagged |
| |
public-key @ IF |
| |
public-key $@ href= s" a" tag |
| |
s" PGP key|@/gpg.asc.gif" .img s" a" /tag |
| |
THEN |
| -envs ; |
-envs ; |
| |
|
| \ top word |
\ top word |
| |
|
| : maintainer ( -- ) |
: maintainer ( -- ) |
| '< sword -trailing mail-name $! '> sword mail $! ; |
'< sword -trailing mail-name $! '> sword mail $! ; |
| |
: pgp-key ( -- ) |
| |
bl sword -trailing public-key $! ; |
| : created ( -- ) |
: created ( -- ) |
| bl sword orig-date $! ; |
bl sword orig-date $! ; |
| : icons |
: icons |
