Minimize OpenGL state changes

slava 2006-10-11 20:39:53 +00:00
parent f9a076a270
commit a2a16c1acb
8 changed files with 69 additions and 67 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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