Fix up ui.offscreen

db4
Slava Pestov 2009-04-03 12:54:34 -05:00
parent 92cc670c28
commit c780457ddb
2 changed files with 17 additions and 11 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations ui.gadgets
images.bitmap strings ui.gadgets.worlds ;
images strings ui.gadgets.worlds ;
IN: ui.offscreen
HELP: <offscreen-world>
@ -26,9 +26,9 @@ HELP: do-offscreen
HELP: gadget>bitmap
{ $values
{ "gadget" gadget }
{ "bitmap" bitmap }
{ "image" image }
}
{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates a " { $link bitmap } " from its contents." } ;
{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates an " { $link image } " from its contents." } ;
HELP: offscreen-world
{ $class-description "The class of " { $link world } " objects that render to an offscreen buffer." } ;
@ -36,9 +36,9 @@ HELP: offscreen-world
HELP: offscreen-world>bitmap
{ $values
{ "world" offscreen-world }
{ "bitmap" bitmap }
{ "image" image }
}
{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link bitmap } " object." } ;
{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link image } " object." } ;
HELP: open-offscreen
{ $values

View File

@ -1,7 +1,7 @@
! (c) 2008 Joe Groff, see license for details
USING: accessors continuations images.bitmap kernel math
USING: accessors alien.c-types continuations images kernel math
sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
ui.private ui ui.backend destructors ;
ui.private ui ui.backend destructors locals ;
IN: ui.offscreen
TUPLE: offscreen-world < world ;
@ -19,18 +19,24 @@ M: offscreen-world ungraft*
: open-offscreen ( gadget -- world )
"" f <offscreen-world>
[ open-world-window dup relayout-1 ] keep
[ open-world-window ] [ relayout-1 ] [ ] tri
notify-queued ;
: close-offscreen ( world -- )
ungraft notify-queued ;
: offscreen-world>bitmap ( world -- bitmap )
offscreen-pixels bgra>bitmap ;
:: bgrx>bitmap ( alien w h -- image )
<image>
{ w h } >>dim
alien w h * 4 * memory>byte-array >>bitmap
BGRX >>component-order ;
: offscreen-world>bitmap ( world -- image )
offscreen-pixels bgrx>bitmap ;
: do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
[ open-offscreen ] dip
over [ slip ] [ close-offscreen ] [ ] cleanup ; inline
: gadget>bitmap ( gadget -- bitmap )
: gadget>bitmap ( gadget -- image )
[ offscreen-world>bitmap ] do-offscreen ;