More OpenGL rendering tweaks

db4
Slava Pestov 2008-11-11 02:31:56 -06:00
parent f0c61b9499
commit d579628d61
5 changed files with 40 additions and 26 deletions
basis

View File

@ -69,7 +69,24 @@ MACRO: all-enabled-client-state ( seq quot -- )
: gl-line ( a b -- )
line-vertices GL_LINES 0 2 glDrawArrays ;
: (rectangle-vertices) ( dim -- vertices )
: (rect-vertices) ( dim -- vertices )
{
[ drop 0 1 ]
[ first 1- 1 ]
[ [ first 1- ] [ second ] bi ]
[ second 0 swap ]
} cleave 8 narray >c-float-array ;
: rect-vertices ( dim -- )
(rect-vertices) gl-vertex-pointer ;
: (gl-rect) ( -- )
GL_LINE_LOOP 0 4 glDrawArrays ;
: gl-rect ( dim -- )
rect-vertices (gl-rect) ;
: (fill-rect-vertices) ( dim -- vertices )
{
[ drop 0 0 ]
[ first 0 ]
@ -77,20 +94,14 @@ MACRO: all-enabled-client-state ( seq quot -- )
[ second 0 swap ]
} cleave 8 narray >c-float-array ;
: rectangle-vertices ( dim -- )
(rectangle-vertices) gl-vertex-pointer ;
: (gl-rect) ( -- )
GL_LINE_LOOP 0 4 glDrawArrays ;
: gl-rect ( dim -- )
rectangle-vertices (gl-rect) ;
: fill-rect-vertices ( dim -- )
(fill-rect-vertices) gl-vertex-pointer ;
: (gl-fill-rect) ( -- )
GL_QUADS 0 4 glDrawArrays ;
: gl-fill-rect ( dim -- )
rectangle-vertices (gl-fill-rect) ;
fill-rect-vertices (gl-fill-rect) ;
: circle-steps ( steps -- angles )
dup length v/n 2 pi * v*n ;
@ -203,7 +214,7 @@ MEMO: (rect-texture-coords) ( -- seq )
dup loc>> gl-translate
GL_TEXTURE_2D over texture>> glBindTexture
init-texture rect-texture-coords
dim2>> rectangle-vertices
dim2>> fill-rect-vertices
(gl-fill-rect)
GL_TEXTURE_2D 0 glBindTexture
] do-enabled-client-state ;

View File

@ -196,6 +196,7 @@ M: freetype-renderer string-height ( open-font string -- h )
:: (draw-string) ( open-font sprites string loc -- )
GL_TEXTURE_2D [
loc [
-0.5 0.5 0.0 glTranslated
string open-font string char-widths scan-sums [
[ open-font sprites ] 2dip draw-char
] 2each

View File

@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ;
: checkmark-points ( dim -- points )
{
[ { 0 0 } v* ]
[ { 1 1 } v* ]
[ { 0 0 } v* { 0 1 } v+ ]
[ { 1 1 } v* { 0 1 } v+ ]
[ { 0 1 } v* ]
[ { 1 0 } v* ]
} cleave 4array ;
@ -170,14 +170,14 @@ TUPLE: radio-paint < caching-pen color interior-vertices boundary-vertices ;
<PRIVATE
: circle-steps 12 ;
: circle-steps 8 ;
PRIVATE>
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
[ { 4 4 } swap { 9 9 } v- circle-steps circle-vertices >>interior-vertices ]
[ { 1 1 } swap { 3 3 } v- circle-steps circle-vertices >>boundary-vertices ] bi
drop ;
<PRIVATE

View File

@ -127,10 +127,12 @@ M: editor ungraft*
: draw-caret ( -- )
editor get focused?>> [
editor get
dup caret-color>> gl-color
dup caret-loc origin get v+
swap caret-dim over v+
[ { 0.5 -0.5 } v+ ] bi@ gl-line
[ caret-color>> gl-color ]
[
dup caret-loc origin get v+
swap caret-dim over v+
gl-line
] bi
] when ;
: line-translation ( n -- loc )
@ -180,12 +182,14 @@ M: editor ungraft*
dup editor-mark* swap editor-caret* sort-pair ;
: (draw-selection) ( x1 x2 -- )
2dup = [ 2 + ] when
0.0 swap editor get line-height glRectd ;
over -
dup 0 = [ 2 + ] when
[ 0.0 2array ] [ editor get line-height 2array ] bi*
swap [ gl-fill-rect ] with-translation ;
: draw-selected-line ( start end n -- )
[ start/end-on-line ] keep tuck
>r >r editor get offset>x r> r>
[ editor get offset>x ] 2dip
editor get offset>x
(draw-selection) ;

View File

@ -83,7 +83,6 @@ SYMBOL: ui-error-hook
[ rethrow ] ui-error-hook set-global
: draw-world ( world -- )
[
dup draw-world? [
dup world [
[
@ -95,8 +94,7 @@ SYMBOL: ui-error-hook
] with-variable
] [
drop
] if USE: prettyprint
] USE: tools.time benchmark global [ "timings" get-global push ] bind ;
] if ;
world H{
{ T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }