Add textures without alpha channels, cropping; update usages of <texture>; don't...

diff --git a/basis/images/images.factor b/basis/images/images.factor
old mode 100644 (file)
new mode 100755 (executable)
index 08fbdd4..b32953f
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -1,11 +1,13 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators kernel ;
+USING: combinators kernel accessors ;
 IN: images
 
 SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
 
+UNION: alpha-channel BGRA RGBA ABGR ARGB R16G16B16A16 R32G32B32A32 ;
+
 : bytes-per-pixel ( component-order -- n )
     {
         { L [ 1 ] }
@@ -29,4 +31,6 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
+: has-alpha? ( image -- ? ) component-order>> alpha-channel? ;
+
 GENERIC: load-image* ( path tuple -- image )
\ No newline at end of file

diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor
index 67094200d1d58449e86d3901818c58505ad8bc3a..3efe924fb54ffed760b417b483c8ff2a6914c709 100755 (executable)
--- a/basis/opengl/textures/textures.factor
+++ b/basis/opengl/textures/textures.factor
@@ -3,7 +3,7 @@
 USING: accessors assocs cache colors.constants destructors fry kernel
 opengl opengl.gl combinators images images.tesselation grouping
 specialized-arrays.float locals sequences math math.vectors
-math.matrices generalizations fry columns ;
+math.matrices generalizations fry columns arrays ;
 IN: opengl.textures
 
 : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
@@ -25,7 +25,7 @@ GENERIC: draw-scaled-texture ( dim texture -- )
 
 <PRIVATE
 
-TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
+TUPLE: single-texture image loc dim texture-coords texture display-list disposed ;
 
 : repeat-last ( seq n -- seq' )
     over peek pad-tail concat ;
@@ -45,7 +45,7 @@ TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
     tri * group ; inline
 
 : power-of-2-image ( image -- image )
-    dup dim>> [ 0 = ] all? [
+    dup dim>> [ [ 0 = ] [ power-of-2? ] bi or ] all? [
         clone dup
         [ image-rows ]
         [ dim>> [ next-power-of-2 ] map ]
@@ -93,26 +93,30 @@ TUPLE: single-texture loc dim texture-coords texture display-list disposed ;
 
 : draw-textured-rect ( dim texture -- )
     [
-        (draw-textured-rect)
-        GL_TEXTURE_2D 0 glBindTexture
+        [ image>> has-alpha? [ GL_BLEND glDisable ] unless ]
+        [ (draw-textured-rect) GL_TEXTURE_2D 0 glBindTexture ]
+        [ image>> has-alpha? [ GL_BLEND glEnable ] unless ]
+        tri
     ] with-texturing ;
 
-: texture-coords ( dim -- coords )
-    [ dup next-power-of-2 /f ] map
-    { { 0 0 } { 1 0 } { 1 1 } { 0 1 } } [ v* ] with map
+: texture-coords ( texture -- coords )
+    [
+        [ dim>> ] [ image>> dim>> ] bi v/
+        { { 0 0 } { 1 0 } { 1 1 } { 0 1 } }
+        [ v* ] with map
+    ] keep
+    image>> upside-down?>> [ [ first2 1 swap - 2array ] map ] when
     float-array{ } join ;
 
 : make-texture-display-list ( texture -- dlist )
     GL_COMPILE [ [ dim>> ] keep draw-textured-rect ] make-dlist ;
 
-: <single-texture> ( image loc -- texture )
-   single-texture new swap >>loc
-    swap
-    [ dim>> >>dim ] keep
-    [ dim>> product 0 = ] keep '[
-        _
-        [ dim>> texture-coords >>texture-coords ]
-        [ power-of-2-image make-texture >>texture ] bi
+: <single-texture> ( image loc dim -- texture )
+    [ power-of-2-image ] 2dip
+    single-texture new swap >>dim swap >>loc swap >>image
+    dup image>> dim>> product 0 = [
+        dup texture-coords >>texture-coords
+        dup image>> make-texture >>texture
         dup make-texture-display-list >>display-list
     ] unless ;
 
@@ -134,19 +138,20 @@ TUPLE: multi-texture grid display-list loc disposed ;
 
 : <texture-grid> ( image-grid loc -- grid )
     [ dup image-locs ] dip
-    '[ [ _ v+ <single-texture> |dispose ] 2map ] 2map ;
+    '[ [ _ v+ over dim>> <single-texture> |dispose ] 2map ] 2map ;
 
 : draw-textured-grid ( grid -- )
     [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ;
 
+: grid-has-alpha? ( grid -- ? )
+    first first image>> has-alpha? ;
+
 : make-textured-grid-display-list ( grid -- dlist )
     GL_COMPILE [
         [
-            [
-                [
-                    [ dim>> ] keep (draw-textured-rect)
-                ] each
-            ] each
+            [ grid-has-alpha? [ GL_BLEND glDisable ] unless ]
+            [ [ [ [ dim>> ] keep (draw-textured-rect) ] each ] each ]
+            [ grid-has-alpha? [ GL_BLEND glEnable ] unless ] tri
             GL_TEXTURE_2D 0 glBindTexture
         ] with-texturing
     ] make-dlist ;
@@ -164,11 +169,14 @@ M: multi-texture draw-texture display-list>> [ glCallList ] when* ;
 
 M: multi-texture dispose* grid>> [ [ dispose ] each ] each ;
 
-CONSTANT: max-texture-size { 256 256 }
+CONSTANT: max-texture-size { 512 512 }
 
 PRIVATE>
 
-: <texture> ( image loc -- texture )
-    over dim>> max-texture-size [ <= ] 2all?
+: small-texture? ( dim -- ? )
+    max-texture-size [ <= ] 2all? ;
+
+: <texture> ( image loc dim -- texture )
+    pick dim>> small-texture?
     [ <single-texture> ]
-    [ [ max-texture-size tesselate ] dip <multi-texture> ] if ;
\ No newline at end of file
+    [ drop [ max-texture-size tesselate ] dip <multi-texture> ] if ;
\ No newline at end of file

diff --git a/basis/ui/images/images.factor b/basis/ui/images/images.factor
old mode 100644 (file)
new mode 100755 (executable)
index 2b1caa8..8e36f2a
--- a/basis/ui/images/images.factor
+++ b/basis/ui/images/images.factor
@@ -20,7 +20,7 @@ PRIVATE>
 
 : rendered-image ( path -- texture )
     world get image-texture-cache
-    [ cached-image { 0 0 } <texture> ] cache ;
+    [ cached-image [ { 0 0 } ] keep dim>> <texture> ] cache ;
 
 : draw-image ( image-name -- )
     rendered-image draw-texture ;

diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor
index 514d918e2fe2d4186e3cacf177134f4940694711..404624da955125ee2a41b895ce5a779e5fd4e835 100755 (executable)
--- a/basis/ui/text/core-text/core-text.factor
+++ b/basis/ui/text/core-text/core-text.factor
@@ -19,9 +19,11 @@ M: core-text-renderer flush-layout-cache
     cached-lines get purge-cache ;
 
 : rendered-line ( font string -- texture )
-    world get world-text-handle
-    [ cached-line [ image>> ] [ loc>> ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-line
+        [ image>> ] [ loc>> ] [ image>> dim>> ] tri
+        <texture>
+    ] 2cache ;
 
 M: core-text-renderer draw-string ( font string -- )
     rendered-line draw-texture ;

diff --git a/basis/ui/text/pango/pango.factor b/basis/ui/text/pango/pango.factor
index 3f4808a208a63684e76697fcdf3e898145ff4543..46328d11d57f65c071f870ce947771ec94556c94 100755 (executable)
--- a/basis/ui/text/pango/pango.factor
+++ b/basis/ui/text/pango/pango.factor
@@ -15,9 +15,11 @@ M: pango-renderer flush-layout-cache
     cached-layouts get purge-cache ;
 
 : rendered-layout ( font string -- texture )
-    world get world-text-handle
-    [ cached-layout [ image>> ] [ text-position vneg ] bi <texture> ]
-    2cache ;
+    world get world-text-handle [
+        cached-layout
+        [ image>> ] [ text-position vneg ] [ image>> dim>> ] tri
+        <texture>
+    ] 2cache ;
 
 M: pango-renderer draw-string ( font string -- )
     rendered-layout draw-texture ;

diff --git a/basis/ui/text/uniscribe/summary.txt b/basis/ui/text/uniscribe/summary.txt
index 2480a4e98b5ae52a23746a8fa48757e1951d2040..6fe24d9f74d54ad3b2334e6ced8a82fb992641ec 100755 (executable)
--- a/basis/ui/text/uniscribe/summary.txt
+++ b/basis/ui/text/uniscribe/summary.txt
@@ -1 +1 @@
-UI text rendering implementation using MS Windows Uniscribe library\r
+UI text rendering implementation using the MS Windows Uniscribe library\r

diff --git a/basis/ui/text/uniscribe/uniscribe.factor b/basis/ui/text/uniscribe/uniscribe.factor
index f7d4207927b8817489a82574d0342123cbd61b1b..dcec4ab17eb633dce74caaec1ca32340ac71fa24 100755 (executable)
--- a/basis/ui/text/uniscribe/uniscribe.factor
+++ b/basis/ui/text/uniscribe/uniscribe.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors assocs cache kernel math.vectors sequences\r
+USING: accessors assocs cache kernel math math.vectors sequences fonts\r
 namespaces opengl.textures ui.text ui.text.private ui.gadgets.worlds \r
 windows.uniscribe ;\r
 IN: ui.text.uniscribe\r
@@ -16,15 +16,16 @@ M: uniscribe-renderer flush-layout-cache
 \r
 : rendered-script-string ( font string -- texture )\r
     world get world-text-handle\r
-    [ cached-script-string [ image>> ] [ text-position vneg ] bi <texture> ]\r
+    [ cached-script-string [ image>> { 0 0 } ] [ size>> ] bi <texture> ]\r
     2cache ;\r
 \r
 M: uniscribe-renderer draw-string ( font string -- )\r
-    [ drop ] [ rendered-script-string draw-texture ] if-empty ;\r
+    dup dup selection? [ string>> ] when empty?\r
+    [ 2drop ] [ rendered-script-string draw-texture ] if ;\r
 \r
 M: uniscribe-renderer x>offset ( x font string -- n )\r
     [ 2drop 0 ] [\r
-        cached-script-string x>line-offset drop\r
+        cached-script-string x>line-offset 0 = [ 1+ ] unless\r
     ] if-empty ;\r
 \r
 M: uniscribe-renderer offset>x ( n font string -- x )\r