steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix screen capture

db4
Doug Coleman 2009-02-09 21:26:52 -06:00
parent efdd9946ac
commit d887ff6788
2 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
extra/cap/cap.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Joe Groff. ! Copyright (C) 2008 Doug Coleman, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays kernel math namespaces USING: accessors arrays byte-arrays kernel math namespaces
opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer opengl.gl sequences math.vectors ui images.bitmap images.viewer
models ui.gadgets.worlds ui.gadgets fry alien.syntax ; models ui.gadgets.worlds ui.gadgets fry alien.syntax ;
IN: cap IN: cap
@ -27,4 +27,4 @@ IN: cap
[ screenshot ] dip save-bitmap ; [ screenshot ] dip save-bitmap ;
: screenshot. ( window -- ) : screenshot. ( window -- )
[ screenshot <graphics-gadget> ] [ title>> ] bi open-window ; [ screenshot <image-gadget> ] [ title>> ] bi open-window ;

32
extra/images/bitmap/bitmap.factor
View File

@ -21,22 +21,6 @@ buffer ;
: array-copy ( bitmap array -- bitmap array' ) : array-copy ( bitmap array -- bitmap array' )
over size-image>> abs memory>byte-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 [ >>buffer ] [ >>color-index ] bi
_ >>bit-count
] ;
: bgr>bitmap ( array height width -- bitmap )
24 (nbits>bitmap) ;
: bgra>bitmap ( array height width -- bitmap )
32 (nbits>bitmap) ;
: 8bit>buffer ( bitmap -- array ) : 8bit>buffer ( bitmap -- array )
[ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ] [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
[ color-index>> >array ] bi [ swap nth ] with map concat ; [ color-index>> >array ] bi [ swap nth ] with map concat ;
@ -121,6 +105,22 @@ M: bitmap-image load-image* ( path bitmap -- bitmap-image )
drop load-bitmap drop load-bitmap
bitmap>image ; bitmap>image ;
MACRO: (nbits>bitmap) ( bits -- )
[ -3 shift ] keep '[
bitmap new
2over * _ * >>size-image
swap >>height
swap >>width
swap array-copy [ >>buffer ] [ >>color-index ] bi
_ >>bit-count bitmap>image
] ;
: bgr>bitmap ( array height width -- bitmap )
24 (nbits>bitmap) ;
: bgra>bitmap ( array height width -- bitmap )
32 (nbits>bitmap) ;
: write2 ( n -- ) 2 >le write ; : write2 ( n -- ) 2 >le write ;
: write4 ( n -- ) 4 >le write ; : write4 ( n -- ) 4 >le write ;