unmaintained/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 * <groups> ] 2bi@ [ copy-row ] 2each ;
  60
  61 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  62
  63 : update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ;
  64
  65 M:: <frame-buffer> layout* ( FRAME-BUFFER -- )
  66
  67   {
  68     {
  69       [ FRAME-BUFFER last-dim>> f = ]
  70       [
  71         FRAME-BUFFER init-frame-buffer-pixels
  72
  73         FRAME-BUFFER update-last-dim
  74       ]
  75     }
  76     {
  77       [ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ]
  78       [
  79         [let | OLD-PIXELS [ FRAME-BUFFER pixels>>         ]
  80                OLD-WIDTH  [ FRAME-BUFFER last-dim>> first ] |
  81
  82           FRAME-BUFFER init-frame-buffer-pixels
  83
  84           FRAME-BUFFER update-last-dim
  85
  86           [let | NEW-PIXELS [ FRAME-BUFFER pixels>>         ]
  87                  NEW-WIDTH  [ FRAME-BUFFER last-dim>> first ] |
  88
  89             OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ]
  90       ]
  91     }
  92     { [ t ] [ ] }
  93   }
  94   cond ;
  95
  96 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  97
  98 M:: <frame-buffer> draw-gadget* ( FRAME-BUFFER -- )
  99
 100   FRAME-BUFFER rect-dim { 0 1 } v* first2 glRasterPos2i
 101
 102   FRAME-BUFFER draw-pixels
 103
 104   FRAME-BUFFER update-frame-buffer
 105
 106   glFlush
 107
 108   FRAME-BUFFER read-pixels ;
 109
 110 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 111