]> gitweb.factorcode.org Git - factor.git/commitdiff
cap: make screenshots work on retina.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 1 Nov 2012 23:30:20 +0000 (16:30 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 1 Nov 2012 23:30:20 +0000 (16:30 -0700)
extra/cap/cap.factor

index 8beea056cfa633b04c57384b23090a9cae179805..f558342bb19b6c958b6b1cd99475793c3c8c3d39 100644 (file)
@@ -1,12 +1,14 @@
 ! Copyright (C) 2008 Doug Coleman, Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays kernel math namespaces
-opengl.gl sequences math.vectors ui images images.normalization
-images.viewer models ui.gadgets.worlds ui.gadgets fry alien.syntax ;
+USING: accessors alien.syntax arrays byte-arrays fry images
+images.normalization images.viewer kernel math math.vectors
+models namespaces opengl opengl.gl sequences ui ui.gadgets
+ui.gadgets.worlds ;
 IN: cap
 
 : 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 )
     [
@@ -15,14 +17,16 @@ IN: cap
             GL_PACK_ALIGNMENT 4 glPixelStorei
             0 0
         ] dip
-        dim>> first2 GL_RGBA GL_UNSIGNED_BYTE
+        dim>> first2 [ gl-scale >fixnum ] bi@
+        GL_RGBA GL_UNSIGNED_BYTE
     ]
     [ screenshot-array ] bi
     [ glReadPixels ] keep ;
 
 : screenshot ( window -- bitmap )
-    [ <image> ] dip
-    [ gl-screenshot >>bitmap ] [ dim>> >>dim ] bi
+    [ <image> t >>2x? ] dip
+    [ gl-screenshot >>bitmap ]
+    [ dim>> [ gl-scale >fixnum ] map >>dim ] bi
     ubyte-components >>component-type
     RGBA >>component-order
     t >>upside-down?