do-offscreen combinator for managing resources while running a gadget offscreen. tweak bgr[a]>bitmap to copy the pixel memory

db4
Joe Groff 2008-12-09 15:27:30 -08:00
parent c3c50d2cda
commit a0618d46b9
2 changed files with 28 additions and 18 deletions

View File

@ -4,32 +4,35 @@
USING: alien arrays byte-arrays combinators summary io.backend
graphics.viewer io io.binary io.files kernel libc math
math.functions math.bitwise namespaces opengl opengl.gl
prettyprint sequences strings ui ui.gadgets.panes
io.encodings.binary accessors grouping ;
prettyprint sequences strings ui ui.gadgets.panes fry
io.encodings.binary accessors grouping macros alien.c-types ;
IN: graphics.bitmap
! Currently can only handle 24bit bitmaps.
! Currently can only handle 24/32bit bitmaps.
! Handles row-reversed bitmaps (their height is negative)
TUPLE: bitmap magic size reserved offset header-length width
height planes bit-count compression size-image
x-pels y-pels color-used color-important rgb-quads color-index array ;
: (array-copy) ( bitmap array -- bitmap array' )
over size-image>> abs memory>byte-array ;
MACRO: (nbits>bitmap) ( bits -- )
[ -3 shift ] keep '[
bitmap new
2over * _ * >>size-image
swap >>height
swap >>width
swap (array-copy) [ >>array ] [ >>color-index ] bi
_ >>bit-count
] ;
: bgr>bitmap ( array height width -- bitmap )
bitmap new
2over * 3 * >>size-image
swap >>height
swap >>width
swap [ >>array ] [ >>color-index ] bi
24 >>bit-count ;
24 (nbits>bitmap) ;
: bgra>bitmap ( array height width -- bitmap )
bitmap new
2over * 4 * >>size-image
swap >>height
swap >>width
swap [ >>array ] [ >>color-index ] bi
32 >>bit-count ;
32 (nbits>bitmap) ;
: 8bit>array ( bitmap -- array )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]

View File

@ -1,5 +1,5 @@
USING: accessors graphics.bitmap kernel math sequences
ui.gadgets ui.gadgets.worlds ui ui.backend ;
USING: accessors continuations graphics.bitmap kernel math
sequences ui.gadgets ui.gadgets.worlds ui ui.backend ;
IN: ui.offscreen
TUPLE: offscreen-world < world ;
@ -16,9 +16,16 @@ M: offscreen-world ungraft*
[ reset-world ] tri ;
: open-offscreen ( gadget -- world )
"" f <offscreen-world> [ open-world-window ] keep ;
"" f <offscreen-world> [ open-world-window ] keep
notify-queued ;
: close-offscreen ( world -- )
ungraft notify-queued ;
: offscreen-world>bitmap ( world -- bitmap )
[ handle>> offscreen-pixels ] [ dim>> first2 neg ] bi
bgra>bitmap ;
: do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
[ open-offscreen ] dip
over [ slip ] [ close-offscreen ] [ ] cleanup ;