]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/html/streams/streams.factor
factor: trim using lists
[factor.git] / basis / html / streams / streams.factor
index cf413dde1112f30204820f6756ef0c978532b182..1678d895bc4cb3d1a02d2ad371735227b1d1e939 100644 (file)
@@ -1,9 +1,8 @@
 ! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators destructors fry html io
-io.backend io.pathnames io.styles kernel macros make math
-math.order math.parser namespaces sequences strings words
-splitting xml xml.syntax ;
+USING: accessors assocs combinators destructors html io
+io.styles kernel make math math.functions math.parser sequences
+strings xml.syntax ;
 IN: html.streams
 
 GENERIC: url-of ( object -- url )
@@ -36,7 +35,7 @@ TUPLE: html-sub-stream < html-writer style parent ;
 
 : hex-color, ( color -- )
     [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
+    [ 255 * round >integer >hex 2 CHAR: 0 pad-head % ] tri@ ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;
@@ -77,11 +76,8 @@ MACRO: make-css ( pairs -- str )
 : emit-html ( stream quot -- )
     dip data>> push ; inline
 
-: icon-path ( path -- icons-path )
-    "vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ;
-
 : img-tag ( xml style -- xml )
-    image-style of [ nip icon-path simple-image ] when* ;
+    image-style of [ nip simple-image ] when* ;
 
 : format-html-span ( string style stream -- )
     [
@@ -111,17 +107,19 @@ M: html-span-stream dispose
 : padding-css, ( padding -- )
     first2 (padding-css,) ;
 
-CONSTANT: pre-css "white-space: pre; font-family: monospace; "
+: width-css, ( width -- )
+    "width: " % # "px; " % ;
 
 : div-css-style ( style -- str )
+    [ span-css-style ]
     [
         {
             { page-color bg-css, }
             { border-color border-css, }
             { inset padding-css, }
+            { wrap-margin width-css, }
         } make-css
-    ] [ wrap-margin of [ pre-css append ] unless ] bi
-    "display: inline-block; " append ;
+    ] bi "display: inline-block; " 3append ;
 
 : div-tag ( xml style -- xml' )
     div-css-style