[ 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> ;
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 ;
: (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 -- )
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 ;
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 ;
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 ;
[ 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