Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/Factor.app/Contents/Resources/English.lproj/Factor.nib/info.nib b/Factor.app/Contents/Resources/English.lproj/Factor.nib/info.nib
index 1096a1224a31e0aa0314bb31653ebc4153c15373..1d9f641c1169ffc77bfe1664cc06464128c4d3f3 100644 (file)
--- a/Factor.app/Contents/Resources/English.lproj/Factor.nib/info.nib
+++ b/Factor.app/Contents/Resources/English.lproj/Factor.nib/info.nib
@@ -3,15 +3,13 @@
 <plist version="1.0">
 <dict>
        <key>IBFramework Version</key>
-       <string>629</string>
+       <string>677</string>
        <key>IBOldestOS</key>
        <integer>5</integer>
        <key>IBOpenObjects</key>
-       <array>
-               <integer>305</integer>
-       </array>
+       <array/>
        <key>IBSystem Version</key>
-       <string>9G55</string>
+       <string>9J61</string>
        <key>targetFramework</key>
        <string>IBCocoaFramework</string>
 </dict>

diff --git a/Factor.app/Contents/Resources/English.lproj/Factor.nib/keyedobjects.nib b/Factor.app/Contents/Resources/English.lproj/Factor.nib/keyedobjects.nib
index c30c9e4bfda079b3069b7a323ccf59063fcf199f..1659393f2e09f2c10eeb2c37f5afe96dadbe7f1c 100644 (file)
Binary files a/Factor.app/Contents/Resources/English.lproj/Factor.nib/keyedobjects.nib and b/Factor.app/Contents/Resources/English.lproj/Factor.nib/keyedobjects.nib differ

diff --git a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/classes.nib b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/classes.nib
index bf3d2a65608e45f465b0ee815204720924a36609..34be3452eedf1670c22977ef1389e62ee1b9f736 100644 (file)
--- a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/classes.nib
+++ b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/classes.nib
@@ -1,17 +1,32 @@
-{
-    IBClasses = (
-        {
-            ACTIONS = {
-                newFactorWorkspace = id; 
-                runFactorFile = id; 
-                saveFactorImage = id; 
-                saveFactorImageAs = id; 
-                showFactorHelp = id; 
-            }; 
-            CLASS = FirstResponder; 
-            LANGUAGE = ObjC; 
-            SUPERCLASS = NSObject; 
-        }
-    ); 
-    IBVersion = 1; 
-}
\ No newline at end of file
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+<dict>
+       <key>IBClasses</key>
+       <array>
+               <dict>
+                       <key>ACTIONS</key>
+                       <dict>
+                               <key>newFactorWorkspace</key>
+                               <string>id</string>
+                               <key>runFactorFile</key>
+                               <string>id</string>
+                               <key>saveFactorImage</key>
+                               <string>id</string>
+                               <key>saveFactorImageAs</key>
+                               <string>id</string>
+                               <key>showFactorHelp</key>
+                               <string>id</string>
+                       </dict>
+                       <key>CLASS</key>
+                       <string>FirstResponder</string>
+                       <key>LANGUAGE</key>
+                       <string>ObjC</string>
+                       <key>SUPERCLASS</key>
+                       <string>NSObject</string>
+               </dict>
+       </array>
+       <key>IBVersion</key>
+       <string>1</string>
+</dict>
+</plist>

diff --git a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/info.nib b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/info.nib
index 3a18202826189fe91a63a197992d376d63282cfb..86277eb8a864e73a148bb09191a2891a21ca45ad 100644 (file)
--- a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/info.nib
+++ b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/info.nib
@@ -1,21 +1,18 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
 <plist version="1.0">
 <dict>
-       <key>IBDocumentLocation</key>
-       <string>1266 155 525 491 0 0 2560 1578 </string>
-       <key>IBEditorPositions</key>
-       <dict>
-               <key>29</key>
-               <string>326 905 270 44 0 0 2560 1578 </string>
-       </dict>
        <key>IBFramework Version</key>
-       <string>439.0</string>
+       <string>677</string>
+       <key>IBOldestOS</key>
+       <integer>5</integer>
        <key>IBOpenObjects</key>
        <array>
-               <integer>29</integer>
+               <integer>293</integer>
        </array>
        <key>IBSystem Version</key>
-       <string>8R218</string>
+       <string>9J61</string>
+       <key>targetFramework</key>
+       <string>IBCocoaFramework</string>
 </dict>
 </plist>

diff --git a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/keyedobjects.nib b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/keyedobjects.nib
index 34abd139a62216d6d80944a25f3cb7b027239b57..992911439538aa237cb641d2cf23174faa42deb0 100644 (file)
Binary files a/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/keyedobjects.nib and b/Factor.app/Contents/Resources/English.lproj/MiniFactor.nib/keyedobjects.nib differ

diff --git a/basis/cairo/cairo.factor b/basis/cairo/cairo.factor
index 3a41f0bcf94af03502c454527c554278e27a6653..074798a1b21bad4ad62ab62bf2edf61e9bae2661 100755 (executable)
--- a/basis/cairo/cairo.factor
+++ b/basis/cairo/cairo.factor
@@ -31,7 +31,8 @@ ERROR: cairo-error message ;
         <cairo> &cairo_destroy
         @
     ] make-memory-bitmap
-    BGRA >>component-order ; inline
+    BGRA >>component-order
+    ubyte-components >>component-type ; inline
 
 : dummy-cairo ( -- cr )
     #! Sometimes we want a dummy context; eg with Pango, we want

diff --git a/basis/core-graphics/core-graphics.factor b/basis/core-graphics/core-graphics.factor
index 6612a43dca62f6f018dd90f1cee1de651af641df..a7bec0479846a6bb74cab4e0afe610dcf9547753 100644 (file)
--- a/basis/core-graphics/core-graphics.factor
+++ b/basis/core-graphics/core-graphics.factor
@@ -140,4 +140,5 @@ PRIVATE>
 
 : make-bitmap-image ( dim quot -- image )
     '[ <CGBitmapContext> &CGContextRelease @ ] make-memory-bitmap
-    ARGB >>component-order ; inline
+    ARGB >>component-order
+    ubyte-components >>component-type ; inline

diff --git a/basis/images/bitmap/loading/loading.factor b/basis/images/bitmap/loading/loading.factor
index b0bd501f090112343e9de61963a6f1902a110115..31975fa3f0aa962d4adac7858e12991452296d76 100644 (file)
--- a/basis/images/bitmap/loading/loading.factor
+++ b/basis/images/bitmap/loading/loading.factor
@@ -370,5 +370,5 @@ M: bitmap-image load-image* ( path bitmap-image -- bitmap )
         [ loading-bitmap>bytes >>bitmap ]
         [ header>> [ width>> ] [ height>> abs ] bi 2array >>dim ]
         [ header>> height>> 0 < not >>upside-down? ]
-        [ bitmap>component-order >>component-order ]
+        [ bitmap>component-order >>component-order ubyte-components >>component-type ]
     } cleave ;

diff --git a/basis/images/images-tests.factor b/basis/images/images-tests.factor
index 8918dcb38ce429644280594ef05a02cf62bd1cd8..ff49834a65a9dcb0eec8179a5d7946cd2b892ce0 100644 (file)
--- a/basis/images/images-tests.factor
+++ b/basis/images/images-tests.factor
@@ -3,7 +3,7 @@
 USING: images tools.test kernel accessors ;
 IN: images.tests
 
-[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA f B{
+[ B{ 57 57 57 255 } ] [ 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
     0 0 0 0 
     0 0 0 0 
     0 0 0 0 
@@ -19,7 +19,7 @@ IN: images.tests
     57 57 57 255
     0 0 0 0 
     0 0 0 0 
-} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA f B{
+} ] [ B{ 57 57 57 255 } 1 1 T{ image f { 2 3 } RGBA ubyte-components f B{
     0 0 0 0 
     0 0 0 0 
     0 0 0 0 

diff --git a/basis/images/images.factor b/basis/images/images.factor
index 4c76b85459ec14c62c8187e22419ede4cb292ab4..f74233c51526c9d60a05ca3106d36cf4996cbcc7 100755 (executable)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -3,12 +3,58 @@
 USING: combinators kernel accessors sequences math arrays ;
 IN: images
 
-SINGLETONS: L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
-R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
+SINGLETONS:
+    L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
+    ubyte-components ushort-components
+    half-components float-components
+    byte-integer-components ubyte-integer-components
+    short-integer-components ushort-integer-components
+    int-integer-components uint-integer-components ;
 
-UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
+UNION: component-order 
+    L LA BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR ;
 
-: bytes-per-pixel ( component-order -- n )
+UNION: component-type
+    ubyte-components ushort-components
+    half-components float-components
+    byte-integer-components ubyte-integer-components
+    short-integer-components ushort-integer-components
+    int-integer-components uint-integer-components ;
+
+UNION: unnormalized-integer-components
+    byte-integer-components ubyte-integer-components
+    short-integer-components ushort-integer-components
+    int-integer-components uint-integer-components ;
+
+UNION: alpha-channel BGRA RGBA ABGR ARGB ;
+
+TUPLE: image dim component-order component-type upside-down? bitmap ;
+
+: <image> ( -- image ) image new ; inline
+
+: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
+
+GENERIC: load-image* ( path class -- image )
+
+DEFER: bytes-per-pixel
+
+<PRIVATE
+
+: bytes-per-component ( component-type -- n )
+    {
+        { ubyte-components [ 1 ] }
+        { ushort-components [ 2 ] }
+        { half-components [ 2 ] }
+        { float-components [ 4 ] }
+        { byte-integer-components [ 1 ] }
+        { ubyte-integer-components [ 1 ] }
+        { short-integer-components [ 2 ] }
+        { ushort-integer-components [ 2 ] }
+        { int-integer-components [ 4 ] }
+        { uint-integer-components [ 4 ] }
+    } case ;
+
+: component-count ( component-order -- n )
     {
         { L [ 1 ] }
         { LA [ 2 ] }
@@ -22,25 +68,11 @@ UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
         { XRGB [ 4 ] }
         { BGRX [ 4 ] }
         { XBGR [ 4 ] }
-        { R16G16B16 [ 6 ] }
-        { R32G32B32 [ 12 ] }
-        { R16G16B16A16 [ 8 ] }
-        { R32G32B32A32 [ 16 ] }
     } case ;
 
-TUPLE: image dim component-order upside-down? bitmap ;
-
-: <image> ( -- image ) image new ; inline
-
-: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
-
-GENERIC: load-image* ( path class -- image )
-
-<PRIVATE
-
 : pixel@ ( x y image -- start end bitmap )
     [ dim>> first * + ]
-    [ component-order>> bytes-per-pixel [ * dup ] keep + ]
+    [ bytes-per-pixel [ * dup ] keep + ]
     [ bitmap>> ] tri ;
 
 : set-subseq ( new-value from to victim -- )
@@ -48,6 +80,10 @@ GENERIC: load-image* ( path class -- image )
 
 PRIVATE>
 
+: bytes-per-pixel ( image -- n )
+    [ component-order>> component-count ]
+    [ component-type>>  bytes-per-component ] bi * ;
+
 : pixel-at ( x y image -- pixel )
     pixel@ subseq ;
 

diff --git a/basis/images/jpeg/jpeg.factor b/basis/images/jpeg/jpeg.factor
index f61254c3cf84d89b2e561b6c1301aa059373343b..ca3ea8d2b456ca28988641537f1a29309938cd60 100644 (file)
--- a/basis/images/jpeg/jpeg.factor
+++ b/basis/images/jpeg/jpeg.factor
@@ -298,6 +298,7 @@ MEMO: dct-matrix-blas ( -- m ) dct-matrix >float-blas-matrix ;
 : setup-bitmap ( image -- )
     dup dim>> 16 v/n [ ceiling ] map 16 v*n >>dim
     BGR >>component-order
+    ubyte-components >>component-type
     f >>upside-down?
     dup dim>> first2 * 3 * 0 <array> >>bitmap
     drop ;

diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor
index bb470d8dd86880f2bc4df3e72b57c0ab9a750c54..2469a6a72cee023fa0e5ac8fe22aa46888a59d98 100755 (executable)
--- a/basis/images/png/png.factor
+++ b/basis/images/png/png.factor
@@ -85,7 +85,7 @@ ERROR: unimplemented-color-type image ;
     [ <image> ] dip {
         [ png-image-bytes >>bitmap ]
         [ [ width>> ] [ height>> ] bi 2array >>dim ]
-        [ drop RGB >>component-order ]
+        [ drop RGB >>component-order ubyte-components >>component-type ]
     } cleave ;
     
 : decode-indexed-color ( loading-png -- loading-png )

diff --git a/basis/images/processing/processing.factor b/basis/images/processing/processing.factor
index fc463731b3c67635cfb083ae7ba2fbf51388d039..cd6754550d3a7a5d11d4dfcf273a131bc80bdb7e 100755 (executable)
--- a/basis/images/processing/processing.factor
+++ b/basis/images/processing/processing.factor
@@ -17,7 +17,7 @@ IN: images.processing
     <image> over matrix-dim >>dim\r
     swap flip flatten\r
     [ 128 * 128 + 0 max 255 min  >fixnum ] map\r
-    >byte-array >>bitmap L >>component-order ;\r
+    >byte-array >>bitmap L >>component-order ubyte-components >>component-type ;\r
 \r
 :: matrix-zoom ( m f -- m' )\r
     m matrix-dim f v*n coord-matrix\r

diff --git a/basis/images/tesselation/tesselation-tests.factor b/basis/images/tesselation/tesselation-tests.factor
index 2ac8e37ae7157f791b4b2c7985377a9ff1b0631c..9db58649a0c42062bf92e6a96bc617facc2ca45c 100644 (file)
--- a/basis/images/tesselation/tesselation-tests.factor
+++ b/basis/images/tesselation/tesselation-tests.factor
@@ -10,12 +10,12 @@ IN: images.tesselation
 [
     {
         {
-            T{ image f { 2 2 } L f B{ 1 2 5 6 } }
-            T{ image f { 2 2 } L f B{ 3 4 7 8 } }
+            T{ image f { 2 2 } L ubyte-components f B{ 1 2 5 6 } }
+            T{ image f { 2 2 } L ubyte-components f B{ 3 4 7 8 } }
         }
         {
-            T{ image f { 2 2 } L f B{ 9 10 13 14 } }
-            T{ image f { 2 2 } L f B{ 11 12 15 16 } }
+            T{ image f { 2 2 } L ubyte-components f B{ 9 10 13 14 } }
+            T{ image f { 2 2 } L ubyte-components f B{ 11 12 15 16 } }
         }
     }
 ] [
@@ -23,18 +23,19 @@ IN: images.tesselation
         1 16 [a,b] >byte-array >>bitmap
         { 4 4 } >>dim
         L >>component-order
+        ubyte-components >>component-type
     { 2 2 } tesselate
 ] unit-test
 
 [
     {
         {
-            T{ image f { 2 2 } L f B{ 1 2 4 5 } }
-            T{ image f { 1 2 } L f B{ 3 6 } }
+            T{ image f { 2 2 } L ubyte-components f B{ 1 2 4 5 } }
+            T{ image f { 1 2 } L ubyte-components f B{ 3 6 } }
         }
         {
-            T{ image f { 2 1 } L f B{ 7 8 } }
-            T{ image f { 1 1 } L f B{ 9 } }
+            T{ image f { 2 1 } L ubyte-components f B{ 7 8 } }
+            T{ image f { 1 1 } L ubyte-components f B{ 9 } }
         }
     }
 ] [
@@ -42,5 +43,6 @@ IN: images.tesselation
         1 9 [a,b] >byte-array >>bitmap
         { 3 3 } >>dim
         L >>component-order
+        ubyte-components >>component-type
     { 2 2 } tesselate
-] unit-test
\ No newline at end of file
+] unit-test

diff --git a/basis/images/tesselation/tesselation.factor b/basis/images/tesselation/tesselation.factor
index cbdf396b4810066e99a3030e82950befe8e0ec2d..d01bad61ea815bd047d975daf47b1aa2c9ca94ec 100644 (file)
--- a/basis/images/tesselation/tesselation.factor
+++ b/basis/images/tesselation/tesselation.factor
@@ -19,7 +19,7 @@ IN: images.tesselation
     '[ _ tesselate-columns ] map ;
 
 : tile-width ( tile-bitmap original-image -- width )
-    [ first length ] [ component-order>> bytes-per-pixel ] bi* /i ;
+    [ first length ] [ bytes-per-pixel ] bi* /i ;
 
 : <tile-image> ( tile-bitmap original-image -- tile-image )
     clone
@@ -28,8 +28,8 @@ IN: images.tesselation
         [ [ over tile-width ] [ length ] bi 2array >>dim ] bi ;
 
 :: tesselate ( image tess-dim -- image-grid )
-    image component-order>> bytes-per-pixel :> bpp
+    image bytes-per-pixel :> bpp
     image dim>> { bpp 1 } v* :> image-dim'
     tess-dim { bpp 1 } v* :> tess-dim'
     image bitmap>> image-dim' tess-dim' tesselate-bitmap
-    [ [ image <tile-image> ] map ] map ;
\ No newline at end of file
+    [ [ image <tile-image> ] map ] map ;

diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor
index e00b05f2e7c2144341d74832adea178efc9d103d..7e12b03c132476b2c49c663be676994f54cecd32 100755 (executable)
--- a/basis/images/tiff/tiff.factor
+++ b/basis/images/tiff/tiff.factor
@@ -484,15 +484,15 @@ ERROR: unknown-component-order ifd ;
         [ unknown-component-order ]
     } case >>bitmap ;
 
-: ifd-component-order ( ifd -- byte-order )
+: ifd-component-order ( ifd -- component-order component-type )
     bits-per-sample find-tag {
-        { { 32 32 32 32 } [ R32G32B32A32 ] }
-        { { 32 32 32 } [ R32G32B32 ] }
-        { { 16 16 16 16 } [ R16G16B16A16 ] }
-        { { 16 16 16 } [ R16G16B16 ] }
-        { { 8 8 8 8 } [ RGBA ] }
-        { { 8 8 8 } [ RGB ] }
-        { 8 [ LA ] }
+        { { 32 32 32 32 } [ RGBA float-components ] }
+        { { 32 32 32 } [ RGB float-components ] }
+        { { 16 16 16 16 } [ RGBA ushort-components ] }
+        { { 16 16 16 } [ RGB ushort-components ] }
+        { { 8 8 8 8 } [ RGBA ubyte-components ] }
+        { { 8 8 8 } [ RGB ubyte-components ] }
+        { 8 [ LA ubyte-components ] }
         [ unknown-component-order ]
     } case ;
 
@@ -507,7 +507,7 @@ ERROR: unknown-component-order ifd ;
 : ifd>image ( ifd -- image )
     [ <image> ] dip {
         [ [ image-width find-tag ] [ image-length find-tag ] bi 2array >>dim ]
-        [ ifd-component-order >>component-order ]
+        [ ifd-component-order [ >>component-order ] [ >>component-type ] bi* ]
         [ bitmap>> >>bitmap ]
     } cleave ;
 

diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor
index be457dcd00076e145f15714d0f6363022b02deeb..6136115dbbe5ba17df6d2f1f25c43f667e7cc41e 100644 (file)
--- a/basis/opengl/gl/gl.factor
+++ b/basis/opengl/gl/gl.factor
@@ -1801,6 +1801,12 @@ CONSTANT: GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE_EXT HEX: 8D56
 CONSTANT: GL_MAX_SAMPLES_EXT HEX: 8D57
 
 
+! GL_ARB_half_float_pixel, GL_ARB_half_float_vertex
+
+
+CONSTANT: GL_HALF_FLOAT_ARB HEX: 140B
+
+
 ! GL_ARB_texture_float
 
 

diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor
index 2eabbd478be3292756103539153e887e74e10b9a..0a8fc945bfc227c26eb4953af0872e1480034e24 100755 (executable)
--- a/basis/opengl/textures/textures.factor
+++ b/basis/opengl/textures/textures.factor
@@ -4,7 +4,7 @@ USING: accessors assocs cache colors.constants destructors kernel
 opengl opengl.gl opengl.capabilities combinators images
 images.tesselation grouping specialized-arrays.float sequences math
 math.vectors math.matrices generalizations fry arrays namespaces
-system ;
+system locals ;
 IN: opengl.textures
 
 SYMBOL: non-power-of-2-textures?
@@ -22,16 +22,46 @@ SYMBOL: non-power-of-2-textures?
 
 : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;
 
-GENERIC: component-order>format ( component-order -- format type )
-
-M: RGB component-order>format drop GL_RGB GL_UNSIGNED_BYTE ;
-M: BGR component-order>format drop GL_BGR GL_UNSIGNED_BYTE ;
-M: RGBA component-order>format drop GL_RGBA GL_UNSIGNED_BYTE ;
-M: ARGB component-order>format drop GL_BGRA_EXT GL_UNSIGNED_INT_8_8_8_8_REV ;
-M: BGRA component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
-M: BGRX component-order>format drop GL_BGRA_EXT GL_UNSIGNED_BYTE ;
-M: LA component-order>format drop GL_LUMINANCE_ALPHA GL_UNSIGNED_BYTE ;
-M: L component-order>format drop GL_LUMINANCE GL_UNSIGNED_BYTE ;
+GENERIC: component-type>type ( component-type -- internal-format type )
+GENERIC: component-order>format ( type component-order -- type format )
+GENERIC: component-order>integer-format ( type component-order -- type format )
+
+ERROR: unsupported-component-order component-order ;
+
+M: ubyte-components component-type>type drop GL_RGBA8 GL_UNSIGNED_BYTE ;
+M: ushort-components component-type>type drop GL_RGBA16 GL_UNSIGNED_SHORT ;
+M: half-components component-type>type drop GL_RGBA16F_ARB GL_HALF_FLOAT_ARB ;
+M: float-components component-type>type drop GL_RGBA32F_ARB GL_FLOAT ;
+M: byte-integer-components component-type>type drop GL_RGBA8I_EXT GL_BYTE ;
+M: short-integer-components component-type>type drop GL_RGBA16I_EXT GL_SHORT ;
+M: int-integer-components component-type>type drop GL_RGBA32I_EXT GL_INT ;
+M: ubyte-integer-components component-type>type drop GL_RGBA8I_EXT GL_UNSIGNED_BYTE ;
+M: ushort-integer-components component-type>type drop GL_RGBA16I_EXT GL_UNSIGNED_SHORT ;
+M: uint-integer-components component-type>type drop GL_RGBA32I_EXT GL_UNSIGNED_INT ;
+
+M: RGB component-order>format drop GL_RGB ;
+M: BGR component-order>format drop GL_BGR ;
+M: RGBA component-order>format drop GL_RGBA ;
+M: ARGB component-order>format
+    swap GL_UNSIGNED_BYTE =
+    [ drop GL_UNSIGNED_INT_8_8_8_8_REV GL_BGRA_EXT ]
+    [ unsupported-component-order ] if ;
+M: BGRA component-order>format drop GL_BGRA_EXT ;
+M: BGRX component-order>format drop GL_BGRA_EXT ;
+M: LA component-order>format drop GL_LUMINANCE_ALPHA ;
+M: L component-order>format drop GL_LUMINANCE ;
+
+M: object component-order>format unsupported-component-order ;
+
+M: RGB component-order>integer-format drop GL_RGB_INTEGER_EXT ;
+M: BGR component-order>integer-format drop GL_BGR_INTEGER_EXT ;
+M: RGBA component-order>integer-format drop GL_RGBA_INTEGER_EXT ;
+M: BGRA component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
+M: BGRX component-order>integer-format drop GL_BGRA_INTEGER_EXT ;
+M: LA component-order>integer-format drop GL_LUMINANCE_ALPHA_INTEGER_EXT ;
+M: L component-order>integer-format drop GL_LUMINANCE_INTEGER_EXT ;
+
+M: object component-order>integer-format unsupported-component-order ;
 
 SLOT: display-list
 
@@ -50,18 +80,25 @@ TUPLE: single-texture image dim loc texture-coords texture display-list disposed
         [ dup 1 = [ next-power-of-2 ] unless ] map
     ] unless ;
 
-: tex-image ( image bitmap -- )
+: image-format ( image -- internal-format format type )
+    dup component-type>>
+    [ nip component-type>type ]
     [
-        [ GL_TEXTURE_2D 0 GL_RGBA ] dip
-        [ dim>> adjust-texture-dim first2 0 ]
-        [ component-order>> component-order>format ] bi
-    ] dip
-    glTexImage2D ;
+        unnormalized-integer-components?
+        [ component-order>> component-order>integer-format ]
+        [ component-order>> component-order>format ] if
+    ] 2bi swap ;
+
+:: tex-image ( image bitmap -- )
+    image image-format :> type :> format :> internal-format
+    GL_TEXTURE_2D 0 internal-format
+    image dim>> adjust-texture-dim first2 0
+    format type bitmap glTexImage2D ;
 
 : tex-sub-image ( image -- )
     [ GL_TEXTURE_2D 0 0 0 ] dip
     [ dim>> first2 ]
-    [ component-order>> component-order>format ]
+    [ image-format [ drop ] 2dip ]
     [ bitmap>> ] tri
     glTexSubImage2D ;
 

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index a9568d4f75d2a09932dcf3223bec6ccaa9214a0b..9fb83e48659d77c74f69587237da2c90b82bf89b 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -225,6 +225,26 @@ CLASS: {
     [ nip select-all-action send-action$ ]
 }
 
+{ "newDocument:" "id" { "id" "SEL" "id" }
+    [ nip new-action send-action$ ]
+}
+
+{ "openDocument:" "id" { "id" "SEL" "id" }
+    [ nip open-action send-action$ ]
+}
+
+{ "saveDocument:" "id" { "id" "SEL" "id" }
+    [ nip save-action send-action$ ]
+}
+
+{ "saveDocumentAs:" "id" { "id" "SEL" "id" }
+    [ nip save-as-action send-action$ ]
+}
+
+{ "revertDocumentToSaved:" "id" { "id" "SEL" "id" }
+    [ nip revert-action send-action$ ]
+}
+
 ! Multi-touch gestures: this is undocumented.
 ! http://cocoadex.com/2008/02/nsevent-modifications-swipe-ro.html
 { "magnifyWithEvent:" "void" { "id" "SEL" "id" }

diff --git a/basis/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor
index ebffb0bfbc8888f354328be505dee45980454504..91c5ea831252433af466782a6b243633b6335ecb 100644 (file)
--- a/basis/ui/gestures/gestures-docs.factor
+++ b/basis/ui/gestures/gestures-docs.factor
@@ -86,6 +86,30 @@ HELP: select-all-action
 { $class-description "Gesture sent when the " { $emphasis "select all" } " standard window system action is invoked." }
 { $examples { $code "select-all-action" } } ;
 
+HELP: new-action
+{ $class-description "Gesture sent when the " { $emphasis "new" } " standard window system action is invoked." }
+{ $examples { $code "new-action" } } ;
+
+HELP: open-action
+{ $class-description "Gesture sent when the " { $emphasis "open" } " standard window system action is invoked." }
+{ $examples { $code "open-action" } } ;
+
+HELP: save-action
+{ $class-description "Gesture sent when the " { $emphasis "save" } " standard window system action is invoked." }
+{ $examples { $code "save-action" } } ;
+
+HELP: save-as-action
+{ $class-description "Gesture sent when the " { $emphasis "save as" } " standard window system action is invoked." }
+{ $examples { $code "save-as-action" } } ;
+
+HELP: revert-action
+{ $class-description "Gesture sent when the " { $emphasis "revert" } " standard window system action is invoked." }
+{ $examples { $code "revert-action" } } ;
+
+HELP: close-action
+{ $class-description "Gesture sent when the " { $emphasis "close" } " standard window system action is invoked." }
+{ $examples { $code "close-action" } } ;
+
 HELP: C+
 { $description "Control key modifier." } ;
 
@@ -350,21 +374,34 @@ $nl
 { $subsection zoom-out-action } ;
 
 ARTICLE: "action-gestures" "Action gestures"
-"Action gestures exist to keep keyboard shortcuts for common clipboard operations consistent."
+"Action gestures exist to keep keyboard shortcuts for common application operations consistent."
+{ $subsection undo-action }
+{ $subsection redo-action }
 { $subsection cut-action }
 { $subsection copy-action }
 { $subsection paste-action }
 { $subsection delete-action }
 { $subsection select-all-action }
+{ $subsection new-action }
+{ $subsection open-action }
+{ $subsection save-action }
+{ $subsection save-as-action }
+{ $subsection revert-action }
+{ $subsection close-action }
 "The following keyboard gestures, if not handled directly, send action gestures:"
 { $table
     { { $strong "Keyboard gesture" } { $strong "Action gesture" } }
     { { $snippet "T{ key-down f { C+ } \"z\" }" } { $snippet "undo-action" } }
-    { { $snippet "T{ key-down f { C+ } \"Z\" }" } { $snippet "redo-action" } }
+    { { $snippet "T{ key-down f { C+ } \"y\" }" } { $snippet "redo-action" } }
     { { $snippet "T{ key-down f { C+ } \"x\" }" } { $snippet "cut-action" } }
     { { $snippet "T{ key-down f { C+ } \"c\" }" } { $snippet "copy-action" } }
     { { $snippet "T{ key-down f { C+ } \"v\" }" } { $snippet "paste-action" } }
     { { $snippet "T{ key-down f { C+ } \"a\" }" } { $snippet "select-all-action" } }
+    { { $snippet "T{ key-down f { C+ } \"n\" }" } { $snippet "new-action" } }
+    { { $snippet "T{ key-down f { C+ } \"o\" }" } { $snippet "open-action" } }
+    { { $snippet "T{ key-down f { C+ } \"s\" }" } { $snippet "save-action" } }
+    { { $snippet "T{ key-down f { C+ } \"S\" }" } { $snippet "save-as-action" } }
+    { { $snippet "T{ key-down f { C+ } \"w\" }" } { $snippet "close-action" } }
 }
 "Action gestures should be used in place of the above keyboard gestures if possible. For example, on Mac OS X, the standard " { $strong "Edit" } " menu items send action gestures." ;
 

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 073b2d5e2683ff20f2d084cd7d669888e87cbd8c..dcfb8d4d66b759015bf867e9d721fef1a4f549f6 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -82,23 +82,32 @@ undo-action redo-action
 cut-action copy-action paste-action
 delete-action select-all-action
 left-action right-action up-action down-action
-zoom-in-action zoom-out-action ;
+zoom-in-action zoom-out-action
+new-action open-action save-action save-as-action
+revert-action close-action ;
 
 UNION: action
 undo-action redo-action
 cut-action copy-action paste-action
 delete-action select-all-action
 left-action right-action up-action down-action
-zoom-in-action zoom-out-action ;
+zoom-in-action zoom-out-action
+new-action open-action save-action save-as-action
+revert-action close-action ;
 
 CONSTANT: action-gestures
     {
         { "z" undo-action }
-        { "Z" redo-action }
+        { "y" redo-action }
         { "x" cut-action }
         { "c" copy-action }
         { "v" paste-action }
         { "a" select-all-action }
+        { "n" new-action }
+        { "o" open-action }
+        { "s" save-action }
+        { "S" save-as-action }
+        { "w" close-action }
     }
 
 ! Modifiers

diff --git a/extra/images/normalization/normalization.factor b/extra/images/normalization/normalization.factor
index dcdf39a53ee52c532e6b65e84eafc94dd55ad123..0f4877055a6cbe40828a403e35cab11684d007ef 100755 (executable)
--- a/extra/images/normalization/normalization.factor
+++ b/extra/images/normalization/normalization.factor
@@ -3,7 +3,8 @@
 USING: kernel accessors grouping sequences combinators
 math specialized-arrays.direct.uint byte-arrays fry
 specialized-arrays.direct.ushort specialized-arrays.uint
-specialized-arrays.ushort specialized-arrays.float images ;
+specialized-arrays.ushort specialized-arrays.float images
+half-floats ;
 IN: images.normalization
 
 <PRIVATE
@@ -11,30 +12,31 @@ IN: images.normalization
 : add-dummy-alpha ( seq -- seq' )
     3 <groups> [ 255 suffix ] map concat ;
 
-: normalize-floats ( byte-array -- byte-array )
-    byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
+: normalize-floats ( float-array -- byte-array )
+    [ 255.0 * >integer ] B{ } map-as ;
 
+GENERIC: normalize-component-type* ( image component-type -- image )
 GENERIC: normalize-component-order* ( image component-order -- image )
 
 : normalize-component-order ( image -- image )
+    dup component-type>> '[ _ normalize-component-type* ] change-bitmap
     dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
 
-M: RGBA normalize-component-order* drop ;
-
-M: R32G32B32A32 normalize-component-order*
-    drop normalize-floats ;
-
-M: R32G32B32 normalize-component-order*
-    drop normalize-floats add-dummy-alpha ;
+M: float-components normalize-component-type*
+    drop byte-array>float-array normalize-floats ;
+M: half-components normalize-component-type*
+    drop byte-array>half-array normalize-floats ;
 
-: RGB16>8 ( bitmap -- bitmap' )
+: ushorts>ubytes ( bitmap -- bitmap' )
     byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
 
-M: R16G16B16A16 normalize-component-order*
-    drop RGB16>8 ;
+M: ushort-components normalize-component-type*
+    drop ushorts>ubytes ;
 
-M: R16G16B16 normalize-component-order*
-    drop RGB16>8 add-dummy-alpha ;
+M: ubyte-components normalize-component-type*
+    drop ;
+
+M: RGBA normalize-component-order* drop ;
 
 : BGR>RGB ( bitmap -- pixels )
     3 <sliced-groups> [ <reversed> ] map B{ } join ; inline

diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor
index 3de4147835f9b1cbb4c6c2c24449bc7989599ab3..975019bfd1b2bb613b082e2a202aa66ff0a9f172 100644 (file)
--- a/extra/noise/noise.factor
+++ b/extra/noise/noise.factor
@@ -64,7 +64,8 @@ HINTS: hashes { byte-array fixnum fixnum fixnum } ;
     image new
         swap >>dim
         swap >>bitmap
-        L >>component-order ;
+        L >>component-order
+        ubyte-components >>component-type ;
 
 :: perlin-noise-unsafe ( table point -- value )
     point unit-cube :> cube

diff --git a/extra/terrain/generation/generation.factor b/extra/terrain/generation/generation.factor
index 72221d7b0e4ca692a99e6a23ea194b7857faa522..661ea88de6df26d3932907680c77b505dce35cc5 100644 (file)
--- a/extra/terrain/generation/generation.factor
+++ b/extra/terrain/generation/generation.factor
@@ -36,6 +36,7 @@ TUPLE: segment image ;
     <image>
         swap >>bitmap
         RGBA >>component-order
+        ubyte-components >>component-type
         terrain-segment-size >>dim ;
 
 : terrain-segment ( terrain at -- image )