Fix some UI painting bugs
parent
a2a16c1acb
commit
15df9ddddb
|
@ -13,18 +13,14 @@ C: label ( text -- label )
|
|||
[ set-label-text ] keep
|
||||
dup label-theme ;
|
||||
|
||||
: label-size ( gadget -- dim )
|
||||
M: label pref-dim*
|
||||
dup label-font lookup-font dup font-height >r
|
||||
swap label-text string-width r> 2array ;
|
||||
|
||||
M: label pref-dim* label-size ;
|
||||
|
||||
: draw-label ( label -- )
|
||||
M: label draw-gadget*
|
||||
dup label-color gl-color
|
||||
dup label-font swap label-text
|
||||
origin get draw-string ;
|
||||
|
||||
M: label draw-gadget* draw-label ;
|
||||
|
||||
: <label-control> ( model -- gadget )
|
||||
"" <label> [ set-label-text ] <control> ;
|
||||
|
|
|
@ -3,18 +3,22 @@
|
|||
IN: gadgets-outliner
|
||||
USING: arrays gadgets gadgets-borders gadgets-buttons
|
||||
gadgets-frames gadgets-grids gadgets-labels gadgets-panes
|
||||
gadgets-theme generic io kernel math opengl sequences styles ;
|
||||
gadgets-theme generic io kernel math opengl sequences styles
|
||||
namespaces ;
|
||||
|
||||
! Vertical line.
|
||||
TUPLE: guide color ;
|
||||
|
||||
M: guide draw-interior
|
||||
guide-color gl-color
|
||||
rect-dim dup { 0.5 0 0 } v* swap { 0.5 1 0 } v* gl-line ;
|
||||
rect-dim dup { 0.5 0 0 } v* origin get v+
|
||||
swap { 0.5 1 0 } v* origin get v+ gl-line ;
|
||||
|
||||
: guide-theme ( gadget -- )
|
||||
T{ guide f { 0.5 0.5 0.5 1.0 } } swap set-gadget-interior ;
|
||||
|
||||
: <guide-gadget> ( -- gadget )
|
||||
<gadget>
|
||||
T{ guide f { 0.5 0.5 0.5 1.0 } } over set-gadget-interior ;
|
||||
<gadget> dup guide-theme ;
|
||||
|
||||
! Outliner gadget.
|
||||
TUPLE: outliner quot ;
|
||||
|
|
|
@ -33,7 +33,7 @@ sequences ;
|
|||
: gl-rect ( loc dim -- )
|
||||
#! Draws a two-dimensional box.
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
gl-fill-rect
|
||||
>r { 0.5 0.5 } v+ r> { 0.5 0.5 } v- gl-fill-rect
|
||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode ;
|
||||
|
||||
: (gl-poly) [ [ gl-vertex ] each ] do-state ;
|
||||
|
|
|
@ -38,11 +38,10 @@ DEFER: draw-gadget
|
|||
: (draw-gadget) ( gadget -- )
|
||||
[
|
||||
dup rect-loc translate
|
||||
! dup dup gadget-interior draw-interior
|
||||
dup dup gadget-interior draw-interior
|
||||
dup draw-gadget*
|
||||
dup visible-children [ draw-gadget ] each
|
||||
! dup gadget-boundary draw-boundary
|
||||
drop
|
||||
dup gadget-boundary draw-boundary
|
||||
] with-scope ;
|
||||
|
||||
: change-clip ( gadget -- )
|
||||
|
@ -82,7 +81,8 @@ M: f draw-boundary 2drop ;
|
|||
TUPLE: solid color ;
|
||||
|
||||
! Solid pen
|
||||
: (solid) solid-color gl-color rect-dim >r origin get r> ;
|
||||
: (solid)
|
||||
solid-color gl-color rect-dim >r origin get dup r> v+ ;
|
||||
|
||||
M: solid draw-interior (solid) gl-fill-rect ;
|
||||
|
||||
|
@ -103,8 +103,9 @@ M: gradient draw-interior
|
|||
TUPLE: polygon color points ;
|
||||
|
||||
: draw-polygon ( polygon quot -- )
|
||||
>r dup polygon-color gl-color polygon-points r> each ;
|
||||
inline
|
||||
origin get [
|
||||
>r dup polygon-color gl-color polygon-points r> call
|
||||
] with-translation ; inline
|
||||
|
||||
M: polygon draw-boundary
|
||||
[ gl-poly ] draw-polygon drop ;
|
||||
|
@ -112,12 +113,12 @@ M: polygon draw-boundary
|
|||
M: polygon draw-interior
|
||||
[ gl-fill-poly ] draw-polygon drop ;
|
||||
|
||||
: arrow-up { { { 3 0 } { 6 6 } { 0 6 } } } ;
|
||||
: arrow-right { { { 0 0 } { 6 3 } { 0 6 } } } ;
|
||||
: arrow-down { { { 0 0 } { 6 0 } { 3 6 } } } ;
|
||||
: arrow-left { { { 0 3 } { 6 0 } { 6 6 } } } ;
|
||||
: arrow-up { { 3 0 } { 6 6 } { 0 6 } } ;
|
||||
: arrow-right { { 0 0 } { 6 3 } { 0 6 } } ;
|
||||
: arrow-down { { 0 0 } { 6 0 } { 3 6 } } ;
|
||||
: arrow-left { { 0 3 } { 6 0 } { 6 6 } } ;
|
||||
|
||||
: <polygon-gadget> ( color points -- gadget )
|
||||
dup { 0 0 } [ max-dim vmax ] reduce
|
||||
dup max-dim
|
||||
>r <polygon> <gadget> r> over set-rect-dim
|
||||
[ set-gadget-interior ] keep ;
|
||||
|
|
|
@ -34,8 +34,10 @@ C: shuffle-gadget ( node -- gadget )
|
|||
[ 2array ] 2map ;
|
||||
|
||||
: draw-shuffle ( gadget seq seq -- )
|
||||
origin get [
|
||||
>r >r rect-dim first2 r> r> shuffled-endpoints
|
||||
[ first2 gl-line ] each ;
|
||||
[ first2 gl-line ] each
|
||||
] with-translation ;
|
||||
|
||||
M: shuffle-gadget draw-gadget*
|
||||
{ 0 0 0 1 } gl-color
|
||||
|
|
Loading…
Reference in New Issue