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 ]
-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 ;
[ 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 ;