]> gitweb.factorcode.org Git - factor.git/commitdiff
more UI paint cleanups, gradient paint added
authorSlava Pestov <slava@factorcode.org>
Sun, 17 Jul 2005 07:47:14 +0000 (07:47 +0000)
committerSlava Pestov <slava@factorcode.org>
Sun, 17 Jul 2005 07:47:14 +0000 (07:47 +0000)
library/sdl/sdl-utils.factor
library/test/gadgets/gradients.factor [new file with mode: 0644]
library/test/test.factor
library/ui/editors.factor
library/ui/labels.factor
library/ui/paint.factor
library/ui/shapes.factor
library/ui/text.factor

index 9ec69536c9c15e0d66caa10f7669143b83206f76..fb2551f9eb202403a8cff631ada4dc20dae7e133 100644 (file)
@@ -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
diff --git a/library/test/gadgets/gradients.factor b/library/test/gadgets/gradients.factor
new file mode 100644 (file)
index 0000000..32211f9
--- /dev/null
@@ -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
index 81a4a9c02b2d28496fb4094199afaef46fe67f51..2a468a38154bebaba8921769f58e59859ef44b9c 100644 (file)
@@ -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 ;
 
index f4027a4af8374ba67161810e331b67e3706053b6..c1c7d4fe935c049a953acaf261ee795301aa05a3 100644 (file)
@@ -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 ;
index fc3657be775806858018071b655a486ea0f6a714..cf68264d51808b739e57ca264af7eebf1112f680 100644 (file)
@@ -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 ;
index 7c14e9e6cea6c1f234c20339ba0b54c62c0a9843..a95348a9a7c3baa3bf5c4189daa083869a10cad4 100644 (file)
@@ -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
index aaf06f4711e1fd23a7a02d2cf728ea13c0f17fab..5e70c73167a5c7185e05ac9dc6c390ae2b496c02 100644 (file)
@@ -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 + ;
index 6a268ba59a12dafe179294cae0ed435eb6a26e85..cd1bb75276e7c20973b571a926e28534ad8a12d5 100644 (file)
@@ -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 ;