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