extra/pdf/values/values.factor

   1 ! Copyright (C) 2011-2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors arrays assocs calendar colors colors.gray
   5 combinators combinators.short-circuit fonts formatting
   6 hashtables io kernel make math math.parser sequences splitting
   7 strings xml.entities ;
   8
   9 IN: pdf.values
  10
  11 <PRIVATE
  12
  13 : escape-string ( str -- str' )
  14     H{
  15         { 0x08    "\\b"  }
  16         { 0x0c    "\\f"  }
  17         { CHAR: \n   "\\n"  }
  18         { CHAR: \r   "\\r"  }
  19         { CHAR: \t   "\\t"  }
  20         { CHAR: \\   "\\\\" }
  21         { CHAR: (    "\\("  }
  22         { CHAR: )    "\\)"  }
  23     } escape-string-by ;
  24
  25 PRIVATE>
  26
  27 GENERIC: pdf-value ( obj -- str )
  28
  29 M: number pdf-value number>string ;
  30
  31 M: t pdf-value drop "true" ;
  32
  33 M: f pdf-value drop "false" ;
  34
  35 M: color pdf-value
  36     >rgba-components drop "%f %f %f" sprintf ;
  37
  38 M: font pdf-value
  39     [
  40         "<<" ,
  41         "/Type /Font" ,
  42         "/Subtype /Type1" ,
  43         {
  44             [
  45                 name>> {
  46                     { "sans-serif" [ "/Helvetica" ] }
  47                     { "serif"      [ "/Times"     ] }
  48                     { "monospace"  [ "/Courier"   ] }
  49                     [ " is unsupported" append throw ]
  50                 } case
  51             ]
  52             [ [ bold?>> ] [ italic?>> ] bi or [ "-" append ] when ]
  53             [ bold?>> [ "Bold" append ] when ]
  54             [ italic?>> [ "Italic" append ] when ]
  55             [
  56                 name>> { "sans-serif" "monospace" } member?
  57                 [ "Italic" "Oblique" replace ] when
  58             ]
  59         } cleave
  60         "/BaseFont " prepend ,
  61         ">>" ,
  62     ] { } make unlines ;
  63
  64 M: timestamp pdf-value
  65     "%Y%m%d%H%M%S" strftime "D:" prepend ;
  66
  67 M: string pdf-value
  68     escape-string "(" ")" surround ;
  69
  70 M: sequence pdf-value
  71     [ "[" % [ pdf-value % " " % ] each "]" % ] "" make ;
  72
  73 M: hashtable pdf-value
  74     [
  75         "<<\n" %
  76         [ swap % " " % pdf-value % "\n" % ] assoc-each
  77         ">>" %
  78     ] "" make ;
  79
  80 : pdf-write ( obj -- )
  81     pdf-value write ;