From f0c61b9499d750847300d7b88fbd99fd577cad85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 11 Nov 2008 00:28:37 -0600 Subject: [PATCH] Rewrite OpenGL rendering code - Don't use glPolygonMode to draw outline rectangles - Use vertex arrays instead of glBegin/glVertex/glEnd - Remove dead code from opengl vocabulary - draw-interior and draw-boundary are now called with origin get [ ... ] with-translation --- basis/opengl/opengl-docs.factor | 33 ---- basis/opengl/opengl.factor | 146 ++++++++---------- basis/ui/gadgets/buttons/buttons.factor | 97 ++++++++---- basis/ui/gadgets/editors/editors.factor | 6 +- basis/ui/gadgets/grid-lines/grid-lines.factor | 17 +- basis/ui/gadgets/labelled/labelled.factor | 4 +- basis/ui/gadgets/labels/labels.factor | 2 +- basis/ui/gadgets/lists/lists.factor | 8 +- basis/ui/gadgets/panes/panes.factor | 8 +- basis/ui/gadgets/theme/theme.factor | 30 ++-- basis/ui/gadgets/worlds/worlds.factor | 4 +- basis/ui/render/render.factor | 122 ++++++++++----- 12 files changed, 256 insertions(+), 221 deletions(-) diff --git a/basis/opengl/opengl-docs.factor b/basis/opengl/opengl-docs.factor index 87981789a7..6752c5126c 100644 --- a/basis/opengl/opengl-docs.factor +++ b/basis/opengl/opengl-docs.factor @@ -9,14 +9,6 @@ HELP: gl-color HELP: gl-error { $description "If the most recent OpenGL call resulted in an error, print the error to " { $link output-stream } "." } ; -HELP: do-state - { - $values - { "mode" { "One of the " { $link "opengl-geometric-primitives" } } } - { "quot" quotation } - } -{ $description "Wraps a quotation in " { $link glBegin } "/" { $link glEnd } " calls." } ; - HELP: do-enabled { $values { "what" integer } { "quot" quotation } } { $description "Wraps a quotation in " { $link glEnable } "/" { $link glDisable } " calls." } ; @@ -25,10 +17,6 @@ HELP: do-matrix { $values { "mode" { $link GL_MODELVIEW } " or " { $link GL_PROJECTION } } { "quot" quotation } } { $description "Saves and restores the matrix specified by " { $snippet "mode" } " before and after calling the quotation." } ; -HELP: gl-vertex -{ $values { "point" "a pair of integers" } } -{ $description "Wrapper for " { $link glVertex2d } " taking a point object." } ; - HELP: gl-line { $values { "a" "a pair of integers" } { "b" "a pair of integers" } } { $description "Draws a line between two points." } ; @@ -41,22 +29,6 @@ HELP: gl-rect { $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } } { $description "Draws the outline of a rectangle with top-left corner " { $snippet "loc" } " and bottom-right corner " { $snippet "ext" } "." } ; -HELP: rect-vertices -{ $values { "lower-left" "A pair of numbers indicating the lower-left coordinates of the rectangle." } { "upper-right" "The upper-right coordinates of the rectangle." } } -{ $description "Emits" { $link glVertex2d } " calls outlining the axis-aligned rectangle from " { $snippet "lower-left" } " to " { $snippet "upper-right" } " on the z=0 plane in counterclockwise order." } ; - -HELP: gl-fill-poly -{ $values { "points" "a sequence of pairs of integers" } } -{ $description "Draws a filled polygon." } ; - -HELP: gl-poly -{ $values { "points" "a sequence of pairs of integers" } } -{ $description "Draws the outline of a polygon." } ; - -HELP: gl-gradient -{ $values { "direction" "an orientation specifier" } { "colors" "a sequence of color specifiers" } { "dim" "a pair of integers" } } -{ $description "Draws a rectangle with top-left corner " { $snippet "{ 0 0 }" } " and dimensions " { $snippet "dim" } ", filled with a smoothly shaded transition between the colors in " { $snippet "colors" } "." } ; - HELP: gen-texture { $values { "id" integer } } { $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ; @@ -131,12 +103,10 @@ $nl { $subsection "opengl-low-level" } "Wrappers:" { $subsection gl-color } -{ $subsection gl-vertex } { $subsection gl-translate } { $subsection gen-texture } { $subsection bind-texture-unit } "Combinators:" -{ $subsection do-state } { $subsection do-enabled } { $subsection do-attribs } { $subsection do-matrix } @@ -146,9 +116,6 @@ $nl { $subsection gl-line } { $subsection gl-fill-rect } { $subsection gl-rect } -{ $subsection gl-fill-poly } -{ $subsection gl-poly } -{ $subsection gl-gradient } ; ABOUT: "gl-utilities" diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 5d9baf644d..7cf141ca6a 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -2,44 +2,31 @@ ! Portions copyright (C) 2007 Eduardo Cavazos. ! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. - USING: alien alien.c-types continuations kernel libc math macros - namespaces math.vectors math.constants math.functions - math.parser opengl.gl opengl.glu combinators arrays sequences - splitting words byte-arrays assocs colors accessors ; - +namespaces math.vectors math.constants math.functions +math.parser opengl.gl opengl.glu combinators arrays sequences +splitting words byte-arrays assocs colors accessors +generalizations locals memoize ; IN: opengl -: coordinates ( point1 point2 -- x1 y2 x2 y2 ) - [ first2 ] bi@ ; - -: fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) - [ first2 [ >fixnum ] bi@ ] bi@ ; - : color>raw ( object -- r g b a ) - >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; + >rgba { [ red>> ] [ green>> ] [ blue>> ] [ alpha>> ] } cleave ; inline : gl-color ( color -- ) color>raw glColor4d ; inline -: gl-clear-color ( color -- ) - color>raw glClearColor ; +: gl-clear-color ( color -- ) color>raw glClearColor ; : gl-clear ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ; -: set-color ( object -- ) color>raw glColor4d ; -: set-clear-color ( object -- ) color>raw glClearColor ; - : gl-error ( -- ) glGetError dup zero? [ "GL error: " over gluErrorString append throw ] unless drop ; -: do-state ( mode quot -- ) - swap glBegin call glEnd ; inline - : do-enabled ( what quot -- ) over glEnable dip glDisable ; inline + : do-enabled-client-state ( what quot -- ) over glEnableClientState dip glDisableClientState ; inline @@ -48,6 +35,7 @@ IN: opengl : (all-enabled) ( seq quot -- ) over [ glEnable ] each dip [ glDisable ] each ; inline + : (all-enabled-client-state) ( seq quot -- ) [ dup [ glEnableClientState ] each ] dip dip @@ -55,6 +43,7 @@ IN: opengl MACRO: all-enabled ( seq quot -- ) >r words>values r> [ (all-enabled) ] 2curry ; + MACRO: all-enabled-client-state ( seq quot -- ) >r words>values r> [ (all-enabled-client-state) ] 2curry ; @@ -62,37 +51,46 @@ MACRO: all-enabled-client-state ( seq quot -- ) swap [ glMatrixMode glPushMatrix call ] keep glMatrixMode glPopMatrix ; inline -: gl-vertex ( point -- ) - dup length { - { 2 [ first2 glVertex2d ] } - { 3 [ first3 glVertex3d ] } - { 4 [ first4 glVertex4d ] } - } case ; - -: gl-normal ( normal -- ) first3 glNormal3d ; - : gl-material ( face pname params -- ) >c-float-array glMaterialfv ; +: gl-vertex-pointer ( seq -- ) + [ 2 GL_FLOAT 0 ] dip glVertexPointer ; inline + +: gl-color-pointer ( seq -- ) + [ 4 GL_FLOAT 0 ] dip glColorPointer ; inline + +: gl-texture-coord-pointer ( seq -- ) + [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline + +: line-vertices ( a b -- ) + append >c-float-array gl-vertex-pointer ; + : gl-line ( a b -- ) - GL_LINES [ gl-vertex gl-vertex ] do-state ; + line-vertices GL_LINES 0 2 glDrawArrays ; -: gl-fill-rect ( loc ext -- ) - coordinates glRectd ; +: (rectangle-vertices) ( dim -- vertices ) + { + [ drop 0 0 ] + [ first 0 ] + [ first2 ] + [ second 0 swap ] + } cleave 8 narray >c-float-array ; -: gl-rect ( loc ext -- ) - GL_FRONT_AND_BACK GL_LINE glPolygonMode - >r { 0.5 0.5 } v+ r> { 0.5 0.5 } v- gl-fill-rect - GL_FRONT_AND_BACK GL_FILL glPolygonMode ; +: rectangle-vertices ( dim -- ) + (rectangle-vertices) gl-vertex-pointer ; -: (gl-poly) ( points state -- ) - [ [ gl-vertex ] each ] do-state ; +: (gl-rect) ( -- ) + GL_LINE_LOOP 0 4 glDrawArrays ; -: gl-fill-poly ( points -- ) - dup length 2 > GL_POLYGON GL_LINES ? (gl-poly) ; +: gl-rect ( dim -- ) + rectangle-vertices (gl-rect) ; -: gl-poly ( points -- ) - GL_LINE_LOOP (gl-poly) ; +: (gl-fill-rect) ( -- ) + GL_QUADS 0 4 glDrawArrays ; + +: gl-fill-rect ( dim -- ) + rectangle-vertices (gl-fill-rect) ; : circle-steps ( steps -- angles ) dup length v/n 2 pi * v*n ; @@ -109,35 +107,24 @@ MACRO: all-enabled-client-state ( seq quot -- ) : circle-points ( loc dim steps -- points ) circle-steps unit-circle adjust-points scale-points ; -: gl-circle ( loc dim steps -- ) - circle-points gl-poly ; - -: gl-fill-circle ( loc dim steps -- ) - circle-points gl-fill-poly ; - -: prepare-gradient ( direction dim -- v1 v2 ) - tuck v* [ v- ] keep ; - -: gl-gradient ( direction colors dim -- ) - GL_QUAD_STRIP [ - swap >r prepare-gradient r> - [ length dup 1- v/n ] keep [ - >r >r 2dup r> r> set-color v*n - dup gl-vertex v+ gl-vertex - ] 2each 2drop - ] do-state ; +: circle-vertices ( loc dim steps -- vertices ) + circle-points concat >c-float-array ; : (gen-gl-object) ( quot -- id ) >r 1 0 r> keep *uint ; inline + : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ; + : gen-gl-buffer ( -- id ) [ glGenBuffers ] (gen-gl-object) ; : (delete-gl-object) ( id quot -- ) >r 1 swap r> call ; inline + : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ; + : delete-gl-buffer ( id -- ) [ glDeleteBuffers ] (delete-gl-object) ; @@ -205,35 +192,21 @@ TUPLE: sprite loc dim dim2 dlist texture ; : gl-translate ( point -- ) first2 0.0 glTranslated ; -c-float-array ; -: 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 - -PRIVATE> - -: four-sides ( dim -- ) - dup top-left dup top-right dup bottom-right bottom-left ; +: rect-texture-coords ( -- ) + (rect-texture-coords) gl-texture-coord-pointer ; : draw-sprite ( sprite -- ) - dup loc>> gl-translate - GL_TEXTURE_2D over texture>> glBindTexture - init-texture - GL_QUADS [ dim2>> four-sides ] do-state - GL_TEXTURE_2D 0 glBindTexture ; - -: rect-vertices ( lower-left upper-right -- ) - GL_QUADS [ - over first2 glVertex2d - dup first pick second glVertex2d - dup first2 glVertex2d - swap first swap second glVertex2d - ] do-state ; + GL_TEXTURE_COORD_ARRAY [ + dup loc>> gl-translate + GL_TEXTURE_2D over texture>> glBindTexture + init-texture rect-texture-coords + dim2>> rectangle-vertices + (gl-fill-rect) + GL_TEXTURE_2D 0 glBindTexture + ] do-enabled-client-state ; : make-sprite-dlist ( sprite -- id ) GL_MODELVIEW [ @@ -256,6 +229,9 @@ PRIVATE> : with-translation ( loc quot -- ) GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline +: fix-coordinates ( point1 point2 -- x1 y2 x2 y2 ) + [ first2 [ >fixnum ] bi@ ] bi@ ; + : gl-set-clip ( loc dim -- ) fix-coordinates glScissor ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 4ad9e14874..9f3e3a8520 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -1,12 +1,11 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel math models namespaces sequences - strings quotations assocs combinators classes colors - classes.tuple opengl math.vectors - ui.commands ui.gadgets ui.gadgets.borders - ui.gadgets.labels ui.gadgets.theme - ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures - ui.render math.geometry.rect ; +strings quotations assocs combinators classes colors +classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets +ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme +ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures +ui.render math.geometry.rect locals alien.c-types ; IN: ui.gadgets.buttons @@ -62,10 +61,10 @@ C: button-paint } cond ; M: button-paint draw-interior - button-paint draw-interior ; + button-paint dup [ draw-interior ] [ 2drop ] if ; M: button-paint draw-boundary - button-paint draw-boundary ; + button-paint dup [ draw-boundary ] [ 2drop ] if ; : align-left ( button -- button ) { 0 1/2 } >>align ; inline @@ -103,17 +102,34 @@ repeat-button H{ #! the mouse is held down. repeat-button new-button bevel-button-theme ; -TUPLE: checkmark-paint color ; +TUPLE: checkmark-paint < caching-pen color last-vertices ; -C: checkmark-paint +: ( color -- paint ) + checkmark-paint new swap >>color ; + +c-float-array ; + +PRIVATE> + +M: checkmark-paint recompute-pen + swap dim>> checkmark-vertices >>last-vertices drop ; M: checkmark-paint draw-interior - color>> set-color - origin get [ - rect-dim - { 0 0 } over gl-line - dup { 0 1 } v* swap { 1 0 } v* gl-line - ] with-translation ; + [ compute-pen ] + [ color>> gl-color ] + [ last-vertices>> gl-vertex-pointer ] tri + GL_LINES 0 4 glDrawArrays ; : checkmark-theme ( gadget -- gadget ) f @@ -148,30 +164,47 @@ TUPLE: checkbox < button ; M: checkbox model-changed swap value>> >>selected? relayout-1 ; -TUPLE: radio-paint color ; +TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ; -C: radio-paint +: ( color -- paint ) radio-paint new swap >>color ; + + + +M: radio-paint recompute-pen + swap dim>> + [ { 4 4 } swap { 8 8 } v- 12 circle-vertices >>interior-vertices ] + [ { 1 1 } swap { 2 2 } v- 12 circle-vertices >>boundary-vertices ] bi + drop ; + +> gl-color ] bi ; + +PRIVATE> M: radio-paint draw-interior - color>> set-color - origin get { 4 4 } v+ swap rect-dim { 8 8 } v- 12 gl-fill-circle ; + [ (radio-paint) ] [ interior-vertices>> gl-vertex-pointer ] bi + GL_POLYGON 0 circle-steps glDrawArrays ; M: radio-paint draw-boundary - color>> set-color - origin get { 1 1 } v+ swap rect-dim { 2 2 } v- 12 gl-circle ; + [ (radio-paint) ] [ boundary-vertices>> gl-vertex-pointer ] bi + GL_LINE_LOOP 0 circle-steps glDrawArrays ; -: radio-knob-theme ( gadget -- gadget ) - f - f - black - black - >>interior - black >>boundary ; +:: radio-knob-theme ( gadget -- gadget ) + [let | radio-paint [ black ] | + gadget + f f radio-paint radio-paint >>interior + radio-paint >>boundary + { 16 16 } >>dim + ] ; : ( -- gadget ) - - radio-knob-theme - { 16 16 } >>dim ; + radio-knob-theme ; TUPLE: radio-control < button value ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index a1026ef35a..4a5545f23c 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -127,7 +127,7 @@ M: editor ungraft* : draw-caret ( -- ) editor get focused?>> [ editor get - dup caret-color>> set-color + dup caret-color>> gl-color dup caret-loc origin get v+ swap caret-dim over v+ [ { 0.5 -0.5 } v+ ] bi@ gl-line @@ -171,7 +171,7 @@ M: editor ungraft* : draw-lines ( -- ) \ first-visible-line get [ - editor get dup color>> set-color + editor get dup color>> gl-color dup visible-lines [ draw-line 1 translate-lines ] with each ] with-editor-translation ; @@ -190,7 +190,7 @@ M: editor ungraft* (draw-selection) ; : draw-selection ( -- ) - editor get selection-color>> set-color + editor get selection-color>> gl-color editor get selection-start/end over first [ 2dup [ diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index f4266adba1..0356e7fd4d 100644 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -23,13 +23,10 @@ SYMBOL: grid-dim ] with each ; M: grid-lines draw-boundary - origin get [ - -0.5 -0.5 0.0 glTranslated - color>> set-color [ - dup grid set - dup rect-dim half-gap v- grid-dim set - compute-grid - { 0 1 } draw-grid-lines - { 1 0 } draw-grid-lines - ] with-scope - ] with-translation ; + color>> gl-color [ + dup grid set + dup rect-dim half-gap v- grid-dim set + compute-grid + { 0 1 } draw-grid-lines + { 1 0 } draw-grid-lines + ] with-scope ; diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor index 37b1d251e8..79a485b711 100644 --- a/basis/ui/gadgets/labelled/labelled.factor +++ b/basis/ui/gadgets/labelled/labelled.factor @@ -30,10 +30,10 @@ M: labelled-gadget focusable-child* content>> ; : title-theme ( gadget -- gadget ) { 1 0 } >>orientation - T{ gradient f { + { T{ rgba f 0.65 0.65 1.0 1.0 } T{ rgba f 0.65 0.45 1.0 1.0 } - } } >>interior ; + } >>interior ; : ( text -- label )