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 strings
   7 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         } cleave
  56         "/BaseFont " prepend ,
  57         ">>" ,
  58     ] { } make "\n" join ;
  59
  60 M: timestamp pdf-value
  61     "%Y%m%d%H%M%S" strftime "D:" prepend ;
  62
  63 M: string pdf-value
  64     escape-string "(" ")" surround ;
  65
  66 M: sequence pdf-value
  67     [ "[" % [ pdf-value % " " % ] each "]" % ] "" make ;
  68
  69 M: hashtable pdf-value
  70     [
  71         "<<\n" %
  72         [ swap % " " % pdf-value % "\n" % ] assoc-each
  73         ">>" %
  74     ] "" make ;
  75
  76 : pdf-write ( obj -- )
  77     pdf-value write ;