113 lines
2.7 KiB
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 ;
|
||
|
|
|
||
|
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||
|
|
|