diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor index 9ec69536c9..fb2551f9eb 100644 --- a/library/sdl/sdl-utils.factor +++ b/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 diff --git a/library/test/gadgets/gradients.factor b/library/test/gadgets/gradients.factor new file mode 100644 index 0000000000..32211f9edb --- /dev/null +++ b/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 0 gradient-color ] unit-test + [ [ 0 255 0 ] ] [ { 1 0 0 } red green 1 gradient-color ] unit-test + + [ 0 100 0 [ 255 0 0 ] ] + [ { 0 1 0 } red green { 100 200 0 } 0 (gradient-x) ] unit-test + + [ 0 100 100 [ 255/2 255/2 0 ] ] + [ { 0 1 0 } red green { 100 200 0 } 100 (gradient-x) ] unit-test + + [ 0 0 200 [ 255 0 0 ] ] + [ { 1 0 0 } red green { 100 200 0 } 0 (gradient-y) ] unit-test + + [ 50 0 200 [ 255/2 255/2 0 ] ] + [ { 1 0 0 } red green { 100 200 0 } 50 (gradient-y) ] unit-test +] with-scope diff --git a/library/test/test.factor b/library/test/test.factor index 81a4a9c02b..2a468a3815 100644 --- a/library/test/test.factor +++ b/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 ; diff --git a/library/ui/editors.factor b/library/ui/editors.factor index f4027a4af8..c1c7d4fe93 100644 --- a/library/ui/editors.factor +++ b/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 ; diff --git a/library/ui/labels.factor b/library/ui/labels.factor index fc3657be77..cf68264d51 100644 --- a/library/ui/labels.factor +++ b/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 ; diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 7c14e9e6ce..a95348a9a7 100644 --- a/library/ui/paint.factor +++ b/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 diff --git a/library/ui/shapes.factor b/library/ui/shapes.factor index aaf06f4711..5e70c73167 100644 --- a/library/ui/shapes.factor +++ b/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 ; - -: rect>screen ( shape -- x1 y1 x2 y2 ) - [ shape-x x get + ] keep - [ shape-y y get + ] keep - [ shape-w pick + ] keep - shape-h pick + ; diff --git a/library/ui/text.factor b/library/ui/text.factor index 6a268ba59a..cd1bb75276 100644 --- a/library/ui/text.factor +++ b/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 ;