extra/frame-buffer/frame-buffer.factor

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