Minimize OpenGL state changes
parent
f9a076a270
commit
a2a16c1acb
|
@ -160,17 +160,13 @@ C: font ( handle -- font )
|
|||
over glyph-size pick glyph-texture-size <sprite>
|
||||
[ bitmap>texture ] keep [ init-sprite ] keep ;
|
||||
|
||||
: char-sprite ( open-font char sprites -- sprite )
|
||||
#! Get a cached display list of a FreeType-rendered
|
||||
#! glyph.
|
||||
[ dupd <char-sprite> ] cache-nth nip ;
|
||||
: draw-char ( open-font char sprites -- )
|
||||
[ dupd <char-sprite> ] cache-nth nip
|
||||
sprite-dlist glCallList ;
|
||||
|
||||
: (draw-string) ( open-font sprites string -- )
|
||||
: (draw-string) ( open-font sprites string loc -- )
|
||||
GL_TEXTURE_2D [
|
||||
GL_MODELVIEW [
|
||||
[
|
||||
>r 2dup r> swap char-sprite
|
||||
sprite-dlist glCallList
|
||||
] each 2drop
|
||||
] do-matrix
|
||||
[
|
||||
[ >r 2dup r> swap draw-char ] each 2drop
|
||||
] with-translation
|
||||
] do-enabled ;
|
||||
|
|
|
@ -22,10 +22,10 @@ SYMBOL: grid-dim
|
|||
|
||||
M: grid-lines draw-boundary
|
||||
#! Clean this up later.
|
||||
GL_MODELVIEW [
|
||||
origin get [
|
||||
grid-lines-color gl-color [
|
||||
grid get rect-dim half-gap v- grid-dim set
|
||||
{ 0 1 } draw-grid-lines
|
||||
{ 1 0 } draw-grid-lines
|
||||
] with-grid
|
||||
] do-matrix ;
|
||||
] with-translation ;
|
||||
|
|
|
@ -21,7 +21,8 @@ M: label pref-dim* label-size ;
|
|||
|
||||
: draw-label ( label -- )
|
||||
dup label-color gl-color
|
||||
dup label-font swap label-text draw-string ;
|
||||
dup label-font swap label-text
|
||||
origin get draw-string ;
|
||||
|
||||
M: label draw-gadget* draw-label ;
|
||||
|
||||
|
|
|
@ -31,9 +31,7 @@ M: list model-changed
|
|||
|
||||
M: list draw-gadget*
|
||||
dup list-color gl-color
|
||||
selected-rect [
|
||||
rect-bounds swap [ gl-fill-rect ] with-translation
|
||||
] when* ;
|
||||
selected-rect [ rect-bounds gl-fill-rect ] when* ;
|
||||
|
||||
M: list focusable-child* drop t ;
|
||||
|
||||
|
|
|
@ -21,33 +21,19 @@ sequences ;
|
|||
swap [ glMatrixMode glPushMatrix call ] keep
|
||||
glMatrixMode glPopMatrix ; inline
|
||||
|
||||
: top-left drop 0 0 glTexCoord2i 0.0 0.0 glVertex2d ; inline
|
||||
|
||||
: top-right 1 0 glTexCoord2i first 0.0 glVertex2d ; inline
|
||||
|
||||
: bottom-left 0 1 glTexCoord2i second 0.0 swap glVertex2d ; inline
|
||||
|
||||
: gl-vertex first2 glVertex2i ; inline
|
||||
|
||||
: bottom-right 1 1 glTexCoord2i gl-vertex ; inline
|
||||
|
||||
: four-sides ( dim -- )
|
||||
dup top-left dup top-right dup bottom-right bottom-left ;
|
||||
|
||||
: gl-line ( a b -- )
|
||||
GL_LINES [ gl-vertex gl-vertex ] do-state ;
|
||||
|
||||
: gl-fill-rect ( dim -- )
|
||||
: gl-fill-rect ( loc dim -- )
|
||||
#! Draws a two-dimensional box.
|
||||
GL_QUADS [ four-sides ] do-state ;
|
||||
[ first2 ] 2apply glRectd ;
|
||||
|
||||
: gl-rect ( dim -- )
|
||||
: gl-rect ( loc dim -- )
|
||||
#! Draws a two-dimensional box.
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
GL_MODELVIEW [
|
||||
0.5 0.5 0.0 glTranslated { 1 1 } v-
|
||||
GL_QUADS [ dup four-sides top-left ] do-state
|
||||
] do-matrix
|
||||
gl-fill-rect
|
||||
GL_FRONT_AND_BACK GL_FILL glPolygonMode ;
|
||||
|
||||
: (gl-poly) [ [ gl-vertex ] each ] do-state ;
|
||||
|
@ -120,11 +106,22 @@ C: sprite ( loc dim dim2 -- sprite )
|
|||
|
||||
: gl-translate ( point -- ) first2 0.0 glTranslated ;
|
||||
|
||||
: top-left drop 0 0 glTexCoord2i 0.0 0.0 glVertex2d ; inline
|
||||
|
||||
: top-right 1 0 glTexCoord2i first 0.0 glVertex2d ; inline
|
||||
|
||||
: bottom-left 0 1 glTexCoord2i second 0.0 swap glVertex2d ; inline
|
||||
|
||||
: bottom-right 1 1 glTexCoord2i gl-vertex ; inline
|
||||
|
||||
: four-sides ( dim -- )
|
||||
dup top-left dup top-right dup bottom-right bottom-left ;
|
||||
|
||||
: draw-sprite ( sprite -- )
|
||||
dup sprite-loc gl-translate
|
||||
GL_TEXTURE_2D over sprite-texture glBindTexture
|
||||
init-texture
|
||||
dup sprite-dim2 gl-fill-rect
|
||||
GL_QUADS [ dup sprite-dim2 four-sides ] do-state
|
||||
dup sprite-dim { 1 0 } v*
|
||||
swap sprite-loc v- gl-translate
|
||||
GL_TEXTURE_2D 0 glBindTexture ;
|
||||
|
@ -143,3 +140,6 @@ C: sprite ( loc dim dim2 -- sprite )
|
|||
sprite-texture <uint> 1 swap glDeleteTextures ;
|
||||
|
||||
: free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ;
|
||||
|
||||
: with-translation ( loc quot -- )
|
||||
GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline
|
||||
|
|
|
@ -35,18 +35,15 @@ GENERIC: draw-boundary ( gadget boundary -- )
|
|||
|
||||
DEFER: draw-gadget
|
||||
|
||||
: with-translation ( loc quot -- )
|
||||
over translate over gl-translate
|
||||
swap slip
|
||||
vneg dup translate gl-translate ; inline
|
||||
|
||||
: (draw-gadget) ( gadget -- )
|
||||
dup rect-loc [
|
||||
dup dup gadget-interior draw-interior
|
||||
[
|
||||
dup rect-loc translate
|
||||
! dup dup gadget-interior draw-interior
|
||||
dup draw-gadget*
|
||||
dup visible-children [ draw-gadget ] each
|
||||
dup gadget-boundary draw-boundary
|
||||
] with-translation ;
|
||||
! dup gadget-boundary draw-boundary
|
||||
drop
|
||||
] with-scope ;
|
||||
|
||||
: change-clip ( gadget -- )
|
||||
>absolute clip [ rect-intersect ] change ;
|
||||
|
@ -85,24 +82,29 @@ M: f draw-boundary 2drop ;
|
|||
TUPLE: solid color ;
|
||||
|
||||
! Solid pen
|
||||
M: solid draw-interior
|
||||
solid-color gl-color rect-dim gl-fill-rect ;
|
||||
: (solid) solid-color gl-color rect-dim >r origin get r> ;
|
||||
|
||||
M: solid draw-boundary
|
||||
solid-color gl-color rect-dim gl-rect ;
|
||||
M: solid draw-interior (solid) gl-fill-rect ;
|
||||
|
||||
M: solid draw-boundary (solid) gl-rect ;
|
||||
|
||||
! Gradient pen
|
||||
TUPLE: gradient colors ;
|
||||
|
||||
M: gradient draw-interior
|
||||
over gadget-orientation swap gradient-colors rot rect-dim
|
||||
gl-gradient ;
|
||||
origin get [
|
||||
over gadget-orientation
|
||||
swap gradient-colors
|
||||
rot rect-dim
|
||||
gl-gradient
|
||||
] with-translation ;
|
||||
|
||||
! Polygon pen
|
||||
TUPLE: polygon color points ;
|
||||
|
||||
: draw-polygon ( polygon quot -- )
|
||||
>r dup polygon-color gl-color polygon-points r> each ; inline
|
||||
>r dup polygon-color gl-color polygon-points r> each ;
|
||||
inline
|
||||
|
||||
M: polygon draw-boundary
|
||||
[ gl-poly ] draw-polygon drop ;
|
||||
|
|
|
@ -128,15 +128,19 @@ M: loc-monitor model-changed
|
|||
editor get editor-focused? [
|
||||
editor get
|
||||
dup editor-caret-color gl-color
|
||||
dup caret-loc swap caret-dim over v+ gl-line
|
||||
dup caret-loc origin get v+
|
||||
swap caret-dim over v+ gl-line
|
||||
] when ;
|
||||
|
||||
: line-translation ( n -- loc )
|
||||
editor get line-height * 0.0 swap 2array ;
|
||||
|
||||
: translate-lines ( n -- )
|
||||
editor get line-height * 0.0 swap 0.0 glTranslated ;
|
||||
line-translation gl-translate ;
|
||||
|
||||
: draw-line ( editor str -- )
|
||||
over editor-color gl-color
|
||||
>r editor-font r> draw-string ;
|
||||
>r dup editor-color gl-color editor-font r>
|
||||
{ 0 0 } draw-string ;
|
||||
|
||||
: first-visible-line ( editor -- n )
|
||||
clip get rect-loc second origin get second -
|
||||
|
@ -161,12 +165,15 @@ M: loc-monitor model-changed
|
|||
\ last-visible-line get
|
||||
rot control-value <slice> ;
|
||||
|
||||
: with-editor-translation ( n quot -- )
|
||||
>r line-translation origin get v+ r> with-translation ;
|
||||
inline
|
||||
|
||||
: draw-lines ( -- )
|
||||
GL_MODELVIEW [
|
||||
\ first-visible-line get translate-lines
|
||||
\ first-visible-line get [
|
||||
editor get dup visible-lines
|
||||
[ draw-line 1 translate-lines ] each-with
|
||||
] do-matrix ;
|
||||
] with-editor-translation ;
|
||||
|
||||
: selection-start/end ( editor -- start end )
|
||||
dup editor-mark* swap editor-caret*
|
||||
|
@ -183,16 +190,14 @@ M: loc-monitor model-changed
|
|||
(draw-selection) ;
|
||||
|
||||
: draw-selection ( -- )
|
||||
GL_MODELVIEW [
|
||||
editor get
|
||||
dup editor-selection-color gl-color
|
||||
selection-start/end
|
||||
over first translate-lines
|
||||
editor get editor-selection-color gl-color
|
||||
editor get selection-start/end
|
||||
over first [
|
||||
2dup [
|
||||
>r 2dup r> draw-selected-line
|
||||
1 translate-lines
|
||||
] each-line 2drop
|
||||
] do-matrix ;
|
||||
] with-editor-translation ;
|
||||
|
||||
M: editor draw-gadget*
|
||||
[ draw-selection draw-lines draw-caret ] with-editor ;
|
||||
|
|
|
@ -64,8 +64,8 @@ M: world model-changed
|
|||
: font-sprites ( font world -- pair )
|
||||
world-fonts [ lookup-font V{ } clone 2array ] cache ;
|
||||
|
||||
: draw-string ( font string -- )
|
||||
>r world get font-sprites first2 r> (draw-string) ;
|
||||
: draw-string ( font string loc -- )
|
||||
>r >r world get font-sprites first2 r> r> (draw-string) ;
|
||||
|
||||
M: world gadget-title world-gadget gadget-title ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue