Merge branch 'master' into euler

db4
Aaron Schaefer 2008-10-30 22:09:11 -04:00
commit bc9bf6839b
2 changed files with 44 additions and 5 deletions

31
extra/cap/cap.factor Normal file
View File

@ -0,0 +1,31 @@
USING: accessors arrays byte-arrays kernel math namespaces
opengl.gl sequences math.vectors ui graphics.bitmap graphics.viewer
models opengl.framebuffers ui.gadgets.worlds ui.gadgets fry ;
IN: cap
: screenshot-array ( world -- byte-array )
dim>> product 3 * <byte-array> ;
: gl-screenshot ( gadget -- byte-array )
[
GL_BACK glReadBuffer
GL_PACK_ALIGNMENT 1 glPixelStorei
0 0
] dip
[ dim>> first2 GL_BGR GL_UNSIGNED_BYTE ]
[ screenshot-array ] bi
[ glReadPixels ] keep ;
: screenshot ( window -- bitmap )
[ gl-screenshot ]
[ dim>> first2 ] bi
bgr>bitmap ;
: save-screenshot ( window path -- )
[ screenshot ] dip save-bitmap ;
: screenshot. ( window -- )
[ screenshot <graphics-gadget> ] [ title>> ] bi open-window ;

View File

@ -15,6 +15,14 @@ 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 ;
: bgr>bitmap ( array height width -- bitmap )
bitmap new
2over * 3 * >>size-image
swap >>height
swap >>width
swap [ >>array ] [ >>color-index ] bi
24 >>bit-count ;
: raw-bitmap>string ( str n -- str )
{
{ 32 [ "32bit" throw ] }
@ -74,7 +82,7 @@ M: bitmap-magic summary
: save-bitmap ( bitmap path -- )
binary [
"BM" write
"BM" >byte-array write
dup array>> length 14 + 40 + 4 >le write
0 4 >le write
54 4 >le write
@ -87,10 +95,10 @@ M: bitmap-magic summary
[ bit-count>> 24 or 2 >le write ]
[ compression>> 0 or 4 >le write ]
[ size-image>> 4 >le write ]
[ x-pels>> 4 >le write ]
[ y-pels>> 4 >le write ]
[ color-used>> 4 >le write ]
[ color-important>> 4 >le write ]
[ x-pels>> 0 or 4 >le write ]
[ y-pels>> 0 or 4 >le write ]
[ color-used>> 0 or 4 >le write ]
[ color-important>> 0 or 4 >le write ]
[ rgb-quads>> write ]
[ color-index>> write ]
} cleave