fhp - img
Descripción del contenido de la página
Módulo del programa fhp que permite crear imágenes en XHTML y añade herramientas relacionadas.
Código fuente
CR .( fhp-img )
\ Copyright (C) 2006,2010,2011 Marcos Cruz (programandala.net)
\ This file is part of
\ fhp ("Forth HTML Preprocessor") version B-00-201206
\ (http://programandala.net/en.program.fhp).
\ This module provides the image tags and tools.
\ fhp is free software; you can redistribute it and/or modify
\ it under the terms of the GNU General Public License as published by
\ the Free Software Foundation; either version 2 of the License, or
\ (at your option) any later version.
\
\ fhp is distributed in the hope that it will be useful, but
\ WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\ General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with fhp; if not, see <http://gnu.org/licenses>.
\ fhp is written in the Forth language
\ with Gforth (http://gnu.org/software/gforth/).
\ .............................................................
\ History
\ 2015-02-04: Header updated; layout a bit changed.
\
\ 2006-08-08: Added code written for my application alinome-bici.
\
\ 2010-10-07: First support for Simplilo's format output.
\ .............................................................
\ Init
MARKER fhp-img
\ -----------------------------------------
\ Code
false [IF] \ obsolete!!!
\ 2006-08-31: not used anymore
: img-size ( c-addr1 u1 -- c-addr2 u2 )
\ Return a string with the KiB size of the image.
\ c-addr1 u1 = image file, without img-dir and img-subdir
\ c-addr2 u2 = result
\ 2006 07 02
\ 2006 08 10 Now it calculates the whole local path.
\ 2006-08-31 Now it does not include parenthesis.
+img-disk-path
R/O OPEN-FILE ABORT" OPEN-FILE error in img-size"
DUP >R FILE-SIZE ABORT" FILE-SIZE error in img-size"
D>S 1024 / n>str
S" <abbr class='first' lang='en' xml:lang='en' title='Kibibytes'>KiB</abbr>" str+
R> CLOSE-FILE ABORT" CLOSE-FILE error in img-size"
;
[THEN]
: img-xy ( c-addr u -- x y )
\ Return an image's width and height in pixels.
\ 2006 06 29
\ 2006 08 10 Now it calculates the whole local path.
\ c-addr u = image file, without img-dir and img-subdir
\ x = width
\ y = height
+img-disk-path
jpg-open jpg-xy
ROT CLOSE-FILE ABORT" CLOSE-FILE error in img-xy"
;
: singlequotes>doublequotes ( a u -- )
\ Convert single to double quotes in a string.
\ 2011-02-11 First version.
s" '" str-quotes str-exchange-all
;
: attrs>attrs+alt ( a1 u1 -- a2 u2 a3 u3 )
\ Extract the alt attr content from image HTML attributes.
\ a1 u1 = image attrs, with possible alt the start.
\ a2 u2 = image attrs without the alt.
\ a3 u3 = content of the alt attribute, or empty string if no alt.
\ Note: the alt attribute, if present, is always at the start, and only single quotes are used, what make things much easier.
\ 2011-02-11 First version.
s" alt='" search
if \ alt text found
5 /string \ remove the string searched for
over >r \ save the start of the alt text
s" '" search
0= abort" Closing quote is missing in image 'alt' attribute."
1 /string \ remove the single quote searched for
over r@ - 1- r> swap \ calculate the content of the alt attribute
else
s" " \ alt text is empty
then
2swap singlequotes>doublequotes 2swap
;
defer img
svariable img-align-class \ used for exporting to Simplilo format
: default-img ( c-addr1 u1 c-addr2 u2 -- )
\ Insert a JPEG image in the HTML page.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = image file, without img-dir and img-subdir
\ 2006 04 01
\ 2006 08 10 Now it uses +img-url-path .
\ 2010-10-08 First support for Simplilo's format output. Unfinished.
\ 2011-02-10 Finnished the support for Simplilo's format output.
\ 2011-02-11 Fixed. Single quotes are changed to double quotes in the HTML parameters of the Simplilo's format output. Single quotes caused rendering problems later, I don't know why.
\ 2011-01-11 Factored out to attrs>attrs+alt .
simplilo? IF
S" {{ " >html +img-url-path >>html
attrs>attrs+alt
S" | " >>html >>html \ alt text
S" | " >>html
img-align-class count str+ >>html \ add the image align class to the remaining attrs
S" }}" >>html
ELSE
S" <img src='" >html
2DUP +img-url-path >>html tick>html
img-xy
n>str >height-attribute >>html
n>str >width-attribute >>html
space>html >>html S" />" >>html
THEN
;
' default-img is img
: leftimg{ ( -- )
simplilo?
IF
S\" class=\"left\"" img-align-class str!
\ S" <<div leftimg />>" >html
ELSE S" <div class='leftimg'>" >html
THEN
;
: rightimg{ ( -- )
simplilo?
IF
S\" class=\"right\"" img-align-class str!
\ S" <<div rightimg />>" >html
ELSE S" <div class='rightimg'>" >html
THEN
;
: centerimg{ ( -- )
simplilo?
IF
S\" class=\"center\"" img-align-class str!
\ S" <<div centerimg />>" >html
ELSE S" <div class='centerimg'>" >html
THEN
;
simplilo? [IF]
' noop
[ELSE]
' {/div}
[THEN]
DUP DUP
alias }leftimg
alias }rightimg
alias }centerimg
: |img ( c-addr1 u1 c-addr2 u2 -- )
\ Make an image on the left.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = image file, without img-dir and img-subdir
\ 2006-04-02 First and third version.
\ S" <div class='leftimg'>" >html img {/div}
\ 2006-10-09 Second version.
\ 2>R S" class='left'" str+ 2R> img
\ 2009-08-21 Fourth version.
leftimg{ img }leftimg
;
: img| ( c-addr1 u1 c-addr2 u2 -- )
\ Make an image on the right.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = image file, without img-dir and img-subdir
\ 2006 04 02 First and third version.
\ S" <div class='rightimg'>" >html img {/div}
\ 2006-10-09 Second version.
\ 2>R S" class='right'" str+ 2R> img
\ 2009-08-21 Fourth version.
rightimg{ img }rightimg
;
: |img| ( c-addr1 u1 c-addr2 u2 -- )
\ Make an image on the centre.
\ c-addr1 u1 = attributes
\ c-addr2 u2 = image file, without img-dir and img-subdir
\ 2006-04-02 First and third version.
\ S" <div class='centerimg'>" >html img {/div}
\ 2006-10-09 New version.
\ 2>R S" class='center'" str+ 2R> img
\ 2009-08-21 Fourth version.
centerimg{ img }centerimg
;
.( fhp-img ok!)