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

cap: make screenshots work on retina.

db4
John Benediktsson 2012-11-01 16:30:20 -07:00
parent fcce5a2af9
commit 4e4dd58c40
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/cap/cap.factor
View File

@ -1,12 +1,14 @@
! 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 alien.syntax arrays byte-arrays fry images
opengl.gl sequences math.vectors ui images images.normalization images.normalization images.viewer kernel math math.vectors
images.viewer models ui.gadgets.worlds ui.gadgets fry alien.syntax ; models namespaces opengl opengl.gl sequences ui ui.gadgets
ui.gadgets.worlds ;
IN: cap IN: cap
: screenshot-array ( world -- byte-array ) : screenshot-array ( world -- byte-array )
dim>> [ first 4 * ] [ second ] bi * <byte-array> ; dim>> [ first 4 * ] [ second ] bi
[ gl-scale ] bi@ * >fixnum <byte-array> ;
: gl-screenshot ( gadget -- byte-array ) : gl-screenshot ( gadget -- byte-array )
[ [
@ -15,14 +17,16 @@ IN: cap
GL_PACK_ALIGNMENT 4 glPixelStorei GL_PACK_ALIGNMENT 4 glPixelStorei
0 0 0 0
] dip ] dip
dim>> first2 GL_RGBA GL_UNSIGNED_BYTE dim>> first2 [ gl-scale >fixnum ] bi@
GL_RGBA GL_UNSIGNED_BYTE
] ]
[ screenshot-array ] bi [ screenshot-array ] bi
[ glReadPixels ] keep ; [ glReadPixels ] keep ;
: screenshot ( window -- bitmap ) : screenshot ( window -- bitmap )
[ <image> ] dip [ <image> t >>2x? ] dip
[ gl-screenshot >>bitmap ] [ dim>> >>dim ] bi [ gl-screenshot >>bitmap ]
[ dim>> [ gl-scale >fixnum ] map >>dim ] bi
ubyte-components >>component-type ubyte-components >>component-type
RGBA >>component-order RGBA >>component-order
t >>upside-down? t >>upside-down?