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

View File

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