extra/ui/gadgets/frame-buffer/frame-buffer.factor

   1
   2 USING: kernel alien.c-types combinators sequences splitting grouping
   3        opengl.gl ui.gadgets ui.render
   4        math math.vectors accessors ;
   5
   6 IN: ui.gadgets.frame-buffer
   7
   8 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   9
  10 TUPLE: frame-buffer action dim last-dim graft ungraft pixels ;
  11
  12 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  13
  14 : init-frame-buffer-pixels ( frame-buffer -- frame-buffer )
  15   dup
  16     rect-dim product "uint[4]" <c-array>
  17   >>pixels ;
  18
  19 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  20
  21 : <frame-buffer> ( -- frame-buffer )
  22   frame-buffer construct-gadget
  23     [ ]         >>action
  24     { 100 100 } >>dim
  25     [ ]         >>graft
  26     [ ]         >>ungraft ;
  27
  28 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  29
  30 : draw-pixels ( fb -- fb )
  31   dup >r
  32   dup >r
  33   rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glDrawPixels
  34   r> ;
  35
  36 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  37
  38 : read-pixels ( fb -- fb )
  39   dup >r
  40   dup >r
  41       >r
  42   0 0 r> rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glReadPixels
  43   r> ;
  44
  45 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  46
  47 M: frame-buffer pref-dim* dim>> ;
  48 M: frame-buffer graft*    graft>>   call ;
  49 M: frame-buffer ungraft*  ungraft>> call ;
  50
  51 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  52
  53 : copy-row ( old new -- )
  54   2dup min-length swap >r head-slice 0 r> copy ;
  55
  56 ! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
  57 !   [ group ] 2bi@
  58 !   [ copy-row ] 2each ;
  59
  60 ! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
  61 !   [ 16 * group ] 2bi@
  62 !   [ copy-row ] 2each ;
  63
  64 : copy-pixels ( old-pixels old-width new-pixels new-width -- )
  65   [ 16 * <sliced-groups> ] 2bi@
  66   [ copy-row ] 2each ;
  67
  68 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  69
  70 M: frame-buffer layout* ( fb -- )
  71    {
  72      {
  73        [ dup last-dim>> f = ]
  74        [
  75          init-frame-buffer-pixels
  76          dup
  77            rect-dim >>last-dim
  78          drop
  79        ]
  80      }
  81      {
  82        [ dup [ rect-dim ] [ last-dim>> ] bi = not ]
  83        [
  84          dup [ pixels>> ] [ last-dim>> first ] bi
  85
  86          rot init-frame-buffer-pixels
  87          dup rect-dim >>last-dim
  88
  89          [ pixels>> ] [ rect-dim first ] bi
  90
  91          copy-pixels
  92        ]
  93      }
  94      { [ t ] [ drop ] }
  95    }
  96    cond ;
  97
  98 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  99
 100 M: frame-buffer draw-gadget* ( fb -- )
 101
 102    dup rect-dim { 0 1 } v* first2 glRasterPos2i
 103
 104    draw-pixels
 105
 106    dup action>> call
 107
 108    glFlush
 109
 110    read-pixels
 111
 112    drop ;
 113