2009-01-21 20:34:42 -05:00
|
|
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-02-12 04:58:42 -05:00
|
|
|
USING: math.rectangles math.vectors namespaces kernel accessors
|
2009-04-11 16:17:08 -04:00
|
|
|
assocs combinators sequences opengl opengl.gl colors
|
2009-09-24 17:08:58 -04:00
|
|
|
colors.constants ui.backend ui.gadgets ui.pens ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: ui.render
|
|
|
|
|
|
|
|
SYMBOL: clip
|
|
|
|
|
|
|
|
SYMBOL: viewport-translation
|
|
|
|
|
|
|
|
: flip-rect ( rect -- loc dim )
|
|
|
|
rect-bounds [
|
2008-11-28 01:02:02 -05:00
|
|
|
[ { 1 -1 } v* ] dip { 0 -1 } v* v+
|
2007-09-20 18:09:08 -04:00
|
|
|
viewport-translation get v+
|
|
|
|
] keep ;
|
|
|
|
|
|
|
|
: do-clip ( -- ) clip get flip-rect gl-set-clip ;
|
|
|
|
|
2009-01-27 00:11:45 -05:00
|
|
|
: init-clip ( clip-rect -- )
|
|
|
|
[
|
|
|
|
dim>>
|
|
|
|
[ { 0 1 } v* viewport-translation set ]
|
|
|
|
[ [ { 0 0 } ] dip gl-viewport ]
|
2009-04-11 16:17:08 -04:00
|
|
|
[ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
|
2009-01-27 00:11:45 -05:00
|
|
|
]
|
|
|
|
[ clip set ] bi
|
2007-09-20 18:09:08 -04:00
|
|
|
do-clip ;
|
|
|
|
|
2009-01-27 00:11:45 -05:00
|
|
|
: init-gl ( clip-rect -- )
|
2007-09-20 18:09:08 -04:00
|
|
|
GL_SMOOTH glShadeModel
|
2009-01-27 00:11:45 -05:00
|
|
|
GL_SCISSOR_TEST glEnable
|
2007-09-20 18:09:08 -04:00
|
|
|
GL_BLEND glEnable
|
|
|
|
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
|
2008-11-11 01:28:37 -05:00
|
|
|
GL_VERTEX_ARRAY glEnableClientState
|
2007-09-20 18:09:08 -04:00
|
|
|
init-matrices
|
2009-09-24 14:05:27 -04:00
|
|
|
init-clip ;
|
|
|
|
|
|
|
|
: clear-gl ( transparent? -- )
|
|
|
|
[
|
2009-09-24 17:08:58 -04:00
|
|
|
system-background-color
|
|
|
|
[ red>> ] [ green>> ] [ blue>> ] tri 0.0
|
|
|
|
glClearColor
|
2009-09-24 14:05:27 -04:00
|
|
|
GL_COLOR_BUFFER_BIT glClear
|
|
|
|
] [
|
|
|
|
! white gl-clear is broken w.r.t window resizing
|
|
|
|
! Linux/PPC Radeon 9200
|
|
|
|
COLOR: white gl-color
|
|
|
|
{ 0 0 } clip get dim>> gl-fill-rect
|
|
|
|
] if ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
GENERIC: draw-gadget* ( gadget -- )
|
|
|
|
|
|
|
|
M: gadget draw-gadget* drop ;
|
|
|
|
|
|
|
|
SYMBOL: origin
|
|
|
|
|
|
|
|
{ 0 0 } origin set-global
|
|
|
|
|
|
|
|
: visible-children ( gadget -- seq )
|
2009-02-10 19:47:34 -05:00
|
|
|
[ clip get origin get vneg offset-rect ] dip children-on ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-02-01 21:31:42 -05:00
|
|
|
: translate ( rect/point -- ) loc>> origin [ v+ ] change ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-02-14 22:53:39 -05:00
|
|
|
GENERIC: draw-children ( gadget -- )
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2009-04-02 10:09:09 -04:00
|
|
|
! For gadget selection
|
|
|
|
SYMBOL: selected-gadgets
|
|
|
|
|
|
|
|
SYMBOL: selection-background
|
|
|
|
|
|
|
|
GENERIC: selected-children ( gadget -- assoc/f selection-background )
|
|
|
|
|
|
|
|
M: gadget selected-children drop f f ;
|
|
|
|
|
|
|
|
! For text rendering
|
|
|
|
SYMBOL: background
|
|
|
|
|
|
|
|
SYMBOL: foreground
|
|
|
|
|
|
|
|
GENERIC: gadget-background ( gadget -- color )
|
|
|
|
|
|
|
|
M: gadget gadget-background dup interior>> pen-background ;
|
|
|
|
|
|
|
|
GENERIC: gadget-foreground ( gadget -- color )
|
|
|
|
|
|
|
|
M: gadget gadget-foreground dup interior>> pen-foreground ;
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
: draw-selection-background ( gadget -- )
|
|
|
|
selection-background get background set
|
|
|
|
selection-background get gl-color
|
|
|
|
[ { 0 0 } ] dip dim>> gl-fill-rect ;
|
|
|
|
|
|
|
|
: draw-standard-background ( object -- )
|
|
|
|
dup interior>> dup [ draw-interior ] [ 2drop ] if ;
|
|
|
|
|
|
|
|
: draw-background ( gadget -- )
|
|
|
|
origin get [
|
|
|
|
[
|
|
|
|
dup selected-gadgets get key?
|
|
|
|
[ draw-selection-background ]
|
|
|
|
[ draw-standard-background ] if
|
|
|
|
] [ draw-gadget* ] bi
|
|
|
|
] with-translation ;
|
|
|
|
|
|
|
|
: draw-border ( object -- )
|
|
|
|
dup boundary>> dup [
|
|
|
|
origin get [ draw-boundary ] with-translation
|
|
|
|
] [ 2drop ] if ;
|
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: (draw-gadget) ( gadget -- )
|
2009-02-10 19:47:34 -05:00
|
|
|
dup loc>> origin get v+ origin [
|
2009-04-02 10:09:09 -04:00
|
|
|
[ draw-background ] [ draw-children ] [ draw-border ] tri
|
2009-02-10 19:47:34 -05:00
|
|
|
] with-variable ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: >absolute ( rect -- rect )
|
|
|
|
origin get offset-rect ;
|
|
|
|
|
|
|
|
: change-clip ( gadget -- )
|
|
|
|
>absolute clip [ rect-intersect ] change ;
|
|
|
|
|
|
|
|
: with-clipping ( gadget quot -- )
|
2008-11-28 01:02:02 -05:00
|
|
|
clip get [ over change-clip do-clip call ] dip clip set do-clip ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: draw-gadget ( gadget -- )
|
|
|
|
{
|
2008-08-29 19:44:19 -04:00
|
|
|
{ [ dup visible?>> not ] [ drop ] }
|
|
|
|
{ [ dup clipped?>> not ] [ (draw-gadget) ] }
|
2008-04-11 13:54:33 -04:00
|
|
|
[ [ (draw-gadget) ] with-clipping ]
|
2009-02-14 20:50:22 -05:00
|
|
|
} cond ;
|
|
|
|
|
2009-02-14 22:53:39 -05:00
|
|
|
M: gadget draw-children
|
2009-04-02 10:09:09 -04:00
|
|
|
dup children>> [
|
|
|
|
{
|
|
|
|
[ visible-children ]
|
|
|
|
[ selected-children ]
|
|
|
|
[ gadget-background ]
|
|
|
|
[ gadget-foreground ]
|
|
|
|
} cleave [
|
|
|
|
|
|
|
|
{
|
|
|
|
[ [ selected-gadgets set ] when* ]
|
|
|
|
[ [ selection-background set ] when* ]
|
|
|
|
[ [ background set ] when* ]
|
|
|
|
[ [ foreground set ] when* ]
|
|
|
|
} spread
|
|
|
|
[ draw-gadget ] each
|
|
|
|
] with-scope
|
|
|
|
] [ drop ] if ;
|
2009-02-14 22:53:39 -05:00
|
|
|
|
2009-02-14 20:50:22 -05:00
|
|
|
CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 }
|
|
|
|
|
2009-03-14 00:49:16 -04:00
|
|
|
CONSTANT: panel-background-color
|
|
|
|
T{ rgba f
|
|
|
|
0.7843137254901961
|
|
|
|
0.7686274509803922
|
|
|
|
0.7176470588235294
|
|
|
|
1.0
|
|
|
|
}
|
|
|
|
|
2009-02-24 02:21:10 -05:00
|
|
|
CONSTANT: focus-border-color COLOR: dark-gray
|