unmaintained/ui/offscreen/offscreen.factor

   1 ! (c) 2008 Joe Groff, see license for details
   2 USING: accessors alien.c-types continuations images kernel math
   3 sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
   4 ui.private ui ui.backend destructors locals ;
   5 IN: ui.offscreen
   6
   7 TUPLE: offscreen-world < world ;
   8
   9 M: offscreen-world world-pixel-format-attributes
  10     { offscreen T{ depth-bits { value 16 } } } ;
  11
  12 : <offscreen-world> ( gadget title status -- world )
  13     offscreen-world new-world ;
  14
  15 M: offscreen-world graft*
  16     (open-offscreen-buffer) ;
  17
  18 M: offscreen-world ungraft*
  19     [ (ungraft-world) ]
  20     [ handle>> (close-offscreen-buffer) ]
  21     [ reset-world ] tri ;
  22
  23 : open-offscreen ( gadget -- world )
  24     "" f <offscreen-world>
  25     [ open-world-window ] [ relayout-1 ] [ ] tri
  26     notify-queued ;
  27
  28 : close-offscreen ( world -- )
  29     ungraft notify-queued ;
  30
  31 :: bgrx>bitmap ( alien w h -- image )
  32     <image>
  33         { w h } >>dim
  34         alien w h * 4 * memory>byte-array >>bitmap
  35         BGRX >>component-order ;
  36
  37 : offscreen-world>bitmap ( world -- image )
  38     offscreen-pixels bgrx>bitmap ;
  39
  40 : do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
  41     [ open-offscreen ] dip
  42     over [ slip ] [ close-offscreen ] [ ] cleanup ; inline
  43
  44 : gadget>bitmap ( gadget -- image )
  45     [ offscreen-world>bitmap ] do-offscreen ;