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