extra/pdf/streams/streams.factor

   1 ! Copyright (C) 2011-2012 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors arrays assocs destructors fry io io.styles
   5 kernel pdf.layout sequences splitting strings ;
   6
   7 IN: pdf.streams
   8
   9 <PRIVATE
  10
  11 ! FIXME: what about "proper" tab support?
  12
  13 : string>texts ( string style -- seq )
  14     [ string-lines ] dip '[ _ <text> 1array ] map
  15     <br> 1array join ;
  16
  17 PRIVATE>
  18
  19
  20 TUPLE: pdf-writer style data ;
  21
  22 : new-pdf-writer ( class -- pdf-writer )
  23     new H{ } >>style V{ } clone >>data ;
  24
  25 : <pdf-writer> ( -- pdf-writer )
  26     pdf-writer new-pdf-writer ;
  27
  28 : with-pdf-writer ( quot -- pdf )
  29     <pdf-writer> [ swap with-output-stream* ] keep data>> ; inline
  30
  31 TUPLE: pdf-sub-stream < pdf-writer parent ;
  32
  33 : new-pdf-sub-stream ( style stream class -- stream )
  34     new-pdf-writer
  35         swap >>parent
  36         swap >>style
  37     dup parent>> style>> '[ _ swap assoc-union ] change-style ;
  38
  39 TUPLE: pdf-block-stream < pdf-sub-stream ;
  40
  41 M: pdf-block-stream dispose
  42     [ data>> ] [ parent>> ] bi
  43     [ data>> push-all ] [ stream-nl ] bi ;
  44
  45 TUPLE: pdf-span-stream < pdf-sub-stream ;
  46
  47 M: pdf-span-stream dispose
  48     [ data>> ] [ parent>> data>> ] bi push-all ;
  49
  50
  51
  52 ! Stream protocol
  53
  54 M: pdf-writer stream-flush drop ;
  55
  56 M: pdf-writer stream-write1
  57     dup style>> '[ 1string _ <text> ] [ data>> ] bi* push ;
  58
  59 M: pdf-writer stream-write
  60     dup style>> '[ _ string>texts ] [ data>> ] bi* push-all ;
  61
  62 M: pdf-writer stream-format
  63     swap [ dup style>> ] dip assoc-union
  64     '[ _ string>texts ] [ data>> ] bi* push-all ;
  65
  66 M: pdf-writer stream-nl
  67     <br> swap data>> push ; ! FIXME: <br> needs style?
  68
  69 M: pdf-writer make-span-stream
  70     pdf-span-stream new-pdf-sub-stream ;
  71
  72 M: pdf-writer make-block-stream
  73     pdf-block-stream new-pdf-sub-stream ;
  74
  75 M: pdf-writer make-cell-stream
  76     pdf-sub-stream new-pdf-sub-stream ;
  77
  78 ! FIXME: real table cells
  79 M: pdf-writer stream-write-table ! FIXME: needs style?
  80     nip swap [
  81         [ data>> <table-cell> ] map <table-row>
  82     ] map <table> swap data>> push ;
  83
  84 M: pdf-writer dispose drop ;
  85