Fix some UI painting bugs

slava 2006-10-12 22:09:30 +00:00
parent a2a16c1acb
commit 15df9ddddb
5 changed files with 27 additions and 24 deletions

View File

@ -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> ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -34,8 +34,10 @@ C: shuffle-gadget ( node -- gadget )
[ 2array ] 2map ;
: draw-shuffle ( gadget seq seq -- )
>r >r rect-dim first2 r> r> shuffled-endpoints
[ first2 gl-line ] each ;
origin get [
>r >r rect-dim first2 r> r> shuffled-endpoints
[ first2 gl-line ] each
] with-translation ;
M: shuffle-gadget draw-gadget*
{ 0 0 0 1 } gl-color