more UI paint cleanups, gradient paint added

library/sdl/sdl-utils.factor

@@ -24,9 +24,9 @@ SYMBOL: surface
 : rgb ( [ r g b ] -- n )
     3unlist
     255
-    swap 8 shift bitor
-    swap 16 shift bitor
-    swap 24 shift bitor ;
+    swap >fixnum 8 shift bitor
+    swap >fixnum 16 shift bitor
+    swap >fixnum 24 shift bitor ;
 
 : make-color ( r g b -- color )
     #! Make an SDL_Color struct. This will go away soon in favor

library/test/gadgets/gradients.factor

@@ -0,0 +1,22 @@
+IN: temporary
+USING: gadgets namespaces styles test ;
+
+[
+    0 x set
+    0 y set
+    
+    [ [ 255 0 0 ] ] [ { 1 0 0 } red green <gradient> 0 gradient-color ] unit-test
+    [ [ 0 255 0 ] ] [ { 1 0 0 } red green <gradient> 1 gradient-color ] unit-test
+    
+    [ 0 100 0 [ 255 0 0 ] ]
+    [ { 0 1 0 } red green <gradient> { 100 200 0 } 0 (gradient-x) ] unit-test
+    
+    [ 0 100 100 [ 255/2 255/2 0 ] ]
+    [ { 0 1 0 } red green <gradient> { 100 200 0 } 100 (gradient-x) ] unit-test
+    
+    [ 0 0 200 [ 255 0 0 ] ]
+    [ { 1 0 0 } red green <gradient> { 100 200 0 } 0 (gradient-y) ] unit-test
+    
+    [ 50 0 200 [ 255/2 255/2 0 ] ]
+    [ { 1 0 0 } red green <gradient> { 100 200 0 } 50 (gradient-y) ] unit-test
+] with-scope

library/test/test.factor

@@ -91,7 +91,8 @@ SYMBOL: failures
         "crashes" "sbuf" "threads" "parsing-word"
         "inference" "interpreter"
         "alien"
-        "gadgets/line-editor" "gadgets/rectangles" "memory"
+        "gadgets/line-editor" "gadgets/rectangles"
+        "gadgets/gradients" "memory"
         "redefine" "annotate" "sequences" "binary" "inspector"
     ] run-tests ;
 

library/ui/editors.factor

@@ -94,4 +94,4 @@ M: editor layout* ( editor -- )
     dup editor-caret swap caret-loc swap set-shape-loc ;
 
 M: editor draw-gadget* ( editor -- )
-    dup editor-text over [ draw-string ] with-trans ;
+    dup editor-text draw-string ;

library/ui/labels.factor

@@ -17,4 +17,4 @@ M: label pref-dim ( label -- dim )
     dup label-text label-size ;
 
 M: label draw-gadget* ( label -- )
-    dup label-text over [ draw-string ] with-trans ;
+    dup label-text draw-string ;

library/ui/paint.factor

@@ -30,7 +30,8 @@ GENERIC: draw-gadget* ( gadget -- )
 : draw-gadget ( gadget -- )
     dup gadget-visible? [
         dup [
-            dup draw-gadget* dup [
+            dup [
+                dup draw-gadget*
                 gadget-children [ draw-gadget ] each
             ] with-trans
         ] with-clip
@@ -61,13 +62,6 @@ GENERIC: draw-gadget* ( gadget -- )
         dup rollover paint-prop rollover-bg background ?
     ] ifte paint-prop ;
 
-: filled-rect
-    >r surface get r> [ rect>screen ] keep bg rgb boxColor ;
-
-: etched-rect
-    >r surface get r> [ rect>screen >r 1 - r> 1 - ] keep
-    fg rgb rectangleColor ;
-
 ! Paint properties
 SYMBOL: interior
 SYMBOL: boundary
@@ -80,6 +74,10 @@ M: f draw-boundary 2drop ;
 
 TUPLE: solid ;
 
+: rect>screen ( shape -- x1 y1 x2 y2 )
+    >r x get y get r> dup shape-w swap shape-h
+    >r pick + r> pick + ;
+
 M: solid draw-interior
     drop >r surface get r> [ rect>screen ] keep bg rgb boxColor ;
 
@@ -87,6 +85,37 @@ M: solid draw-boundary
     drop >r surface get r> [ rect>screen >r 1 - r> 1 - ] keep
     fg rgb rectangleColor ;
 
+TUPLE: gradient vector from to ;
+
+: gradient-color ( gradient prop -- color )
+    over gradient-from 1 pick - v*n
+    >r swap gradient-to n*v r> v+ ;
+
+: (gradient-x) ( gradient dim y -- x1 x2 y color )
+    dup pick second / >r rot r> gradient-color >r
+    >r >r x get r> first x get + r> y get + r> ;
+
+: gradient-x ( gradient dim y -- )
+    >r >r >r surface get r> r> r> (gradient-x) rgb hlineColor ;
+
+: vert-gradient ( gradient dim -- )
+    dup second [ 3dup gradient-x ] repeat 2drop ;
+
+: (gradient-y) ( gradient dim x -- x y1 y2 color )
+    dup pick first / >r rot r> gradient-color
+    >r x get + y get rot second y get + r> ;
+
+: gradient-y ( gradient dim x -- )
+    >r >r >r surface get r> r> r> (gradient-y) rgb vlineColor ;
+
+: horiz-gradient ( gradient dim -- )
+    dup first [ 3dup gradient-y ] repeat 2drop ;
+
+M: gradient draw-interior ( gadget gradient -- )
+    swap shape-dim { 1 1 1 } vmax
+    over gradient-vector { 1 0 0 } =
+    [ horiz-gradient ] [ vert-gradient ] ifte ;
+
 M: gadget draw-gadget* ( gadget -- )
     dup
     dup interior paint-prop* draw-interior

library/ui/shapes.factor

@@ -65,9 +65,3 @@ M: rectangle inside? ( loc rect -- ? )
     >r shape-extent r> shape-extent
     swapd vmin >r vmax dup r> swap v- { 0 0 0 } vmax
     <rectangle> ;
-
-: rect>screen ( shape -- x1 y1 x2 y2 )
-    [ shape-x x get + ] keep
-    [ shape-y y get + ] keep
-    [ shape-w pick + ] keep
-    shape-h pick + ;

library/ui/text.factor

@@ -32,9 +32,8 @@ strings styles io ;
         2drop
     ] [
         >r [ gadget-font ] keep r> swap
-        [ fg 3unlist make-color ] keep
-        bg 3unlist make-color
-        TTF_RenderUNICODE_Shaded
+        fg 3unlist make-color
+        TTF_RenderUNICODE_Blended
         [ >r x get y get r> draw-surface ] keep
         SDL_FreeSurface
     ] ifte ;