More OpenGL rendering tweaks

basis/opengl/opengl.factor

@@ -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 -- )
+: fill-rect-vertices ( dim -- )
-    (rectangle-vertices) gl-vertex-pointer ;
+    (fill-rect-vertices) gl-vertex-pointer ;
-
-: (gl-rect) ( -- )
-    GL_LINE_LOOP 0 4 glDrawArrays ;
-
-: gl-rect ( dim -- )
-    rectangle-vertices (gl-rect) ;
 
 : (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 ;

basis/ui/freetype/freetype.factor

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

basis/ui/gadgets/buttons/buttons.factor

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

basis/ui/gadgets/editors/editors.factor

@@ -127,10 +127,12 @@ M: editor ungraft*
 : draw-caret ( -- )
     editor get focused?>> [
         editor get
-        dup caret-color>> gl-color
+        [ caret-color>> gl-color ]
+        [
             dup caret-loc origin get v+
             swap caret-dim over v+
-        [ { 0.5 -0.5 } v+ ] bi@ gl-line
+            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
+    over -
-    0.0 swap editor get line-height glRectd ;
+    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) ;
 

basis/ui/gadgets/worlds/worlds.factor

@@ -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
+    ] if ;
-    ] USE: tools.time benchmark global [ "timings" get-global push ] bind ;
 
 world H{
     { T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }