factor/extra/frame-buffer/frame-buffer.factor

113 lines
2.7 KiB
Factor

USING: accessors alien.c-types combinators grouping kernel
locals math math.geometry.rect math.vectors opengl.gl sequences
ui.gadgets ui.render ;
IN: frame-buffer
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TUPLE: <frame-buffer> < gadget pixels last-dim ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: update-frame-buffer ( <frame-buffer> -- )
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: init-frame-buffer-pixels ( frame-buffer -- )
dup
rect-dim product "uint[4]" <c-array>
>>pixels
drop ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: frame-buffer ( -- <frame-buffer> ) <frame-buffer> new-gadget ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: draw-pixels ( FRAME-BUFFER -- )
FRAME-BUFFER rect-dim first2
GL_RGBA
GL_UNSIGNED_INT
FRAME-BUFFER pixels>>
glDrawPixels ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: read-pixels ( FRAME-BUFFER -- )
0
0
FRAME-BUFFER rect-dim first2
GL_RGBA
GL_UNSIGNED_INT
FRAME-BUFFER pixels>>
glReadPixels ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: copy-row ( OLD NEW -- )
[let | LEN [ OLD NEW min-length ] |
OLD LEN head-slice 0 NEW copy ] ;
: copy-pixels ( old-pixels old-width new-pixels new-width -- )
[ 16 * <sliced-groups> ] 2bi@
[ copy-row ] 2each ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ;
M:: <frame-buffer> layout* ( FRAME-BUFFER -- )
{
{
[ FRAME-BUFFER last-dim>> f = ]
[
FRAME-BUFFER init-frame-buffer-pixels
FRAME-BUFFER update-last-dim
]
}
{
[ FRAME-BUFFER [ rect-dim ] [ last-dim>> ] bi = not ]
[
[let | OLD-PIXELS [ FRAME-BUFFER pixels>> ]
OLD-WIDTH [ FRAME-BUFFER last-dim>> first ] |
FRAME-BUFFER init-frame-buffer-pixels
FRAME-BUFFER update-last-dim
[let | NEW-PIXELS [ FRAME-BUFFER pixels>> ]
NEW-WIDTH [ FRAME-BUFFER last-dim>> first ] |
OLD-PIXELS OLD-WIDTH NEW-PIXELS NEW-WIDTH copy-pixels ] ]
]
}
{ [ t ] [ ] }
}
cond ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M:: <frame-buffer> draw-gadget* ( FRAME-BUFFER -- )
FRAME-BUFFER rect-dim { 0 1 } v* first2 glRasterPos2i
FRAME-BUFFER draw-pixels
FRAME-BUFFER update-frame-buffer
glFlush
FRAME-BUFFER read-pixels ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!