fix various UI bugs; use opengl-style colors

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4ed6b520867a757749d95b21ee81e78bba78c932..54086d68305ff94e8a988264e24ac8f64342bd05 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,7 +1,5 @@
 0.79:\r
 \r
-- sig11 on first startup\r
-- fix initial font metrics being incorrect\r
 - swap @{ and { syntax\r
 - get stuff in examples dir running in the ui\r
 - [ ... is annoying\r

diff --git a/contrib/httpd/html.factor b/contrib/httpd/html.factor
index 60faee99729f11ed7eb4d70f4dfd8a83987bdd8d..03ae5848fb3d4f029763b373d7cc58bada4cdd89 100644 (file)
--- a/contrib/httpd/html.factor
+++ b/contrib/httpd/html.factor
@@ -20,7 +20,7 @@ presentation sequences strings styles words ;
     ] "" make ;
 
 : hex-color, ( triplet -- )
-    [ >hex 2 CHAR: 0 pad-left % ] each ;
+    [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] each ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 58ef4394c3157ab03f481fd939c916c186cf4cff..2e0700aa79ff657b25c253d4b00bf3fb7d849190 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -17,6 +17,15 @@ sequences strings vectors words ;
 
 IN: sequences
 
+: first2 ( { x y } -- x y )
+    1 swap bounds-check nip first2-unsafe ; inline
+
+: first3 ( { x y z } -- x y z )
+    2 swap bounds-check nip first3-unsafe ; inline
+
+: first4 ( { x y z w } -- x y z w )
+    3 swap bounds-check nip first4-unsafe ; inline
+
 M: object like drop ;
 
 M: object empty? ( seq -- ? ) length 0 = ;

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index 9a20e3ecaa6a7cec8efbd3aea4cf2ae49758d652..1075340e7d1e380935e2de176e44a926d493146f 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -40,12 +40,6 @@ GENERIC: resize ( n seq -- seq )
 : ?push ( elt seq/f -- seq )
     [ 1 <vector> ] unless* [ push ] keep ;
 
-: first2 ( { x y } -- x y )
-    dup first swap second ; inline
-
-: first3 ( { x y z } -- x y z )
-    dup first over second rot third ; inline
-
 : bounds-check? ( n seq -- ? )
     over 0 >= [ length < ] [ 2drop f ] if ;
 
@@ -73,3 +67,7 @@ M: object set-nth-unsafe set-nth ;
 M: integer length ;
 M: integer nth drop ;
 M: integer nth-unsafe drop ;
+
+: first2-unsafe [ 0 swap nth-unsafe ] keep 1 swap nth-unsafe ; inline
+: first3-unsafe [ first2-unsafe ] keep 2 swap nth-unsafe ; inline
+: first4-unsafe [ first3-unsafe ] keep 3 swap nth-unsafe ; inline

diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor
index 75b2970d5d906ab1ed18663ab93b69cf9428ff15..47b70a50c761cc6dcd761a45aa67bd0cee25e94f 100644 (file)
--- a/library/freetype/freetype-gl.factor
+++ b/library/freetype/freetype-gl.factor
@@ -186,8 +186,9 @@ C: font ( handle -- font )
     0 -rot [ char-width + ] each-with ;
 
 : draw-string ( open-font string -- )
-    GL_MODELVIEW [
-        GL_TEXTURE_BIT [
-            [ char-sprite sprite-dlist glCallList ] each-with
-        ] save-attribs
-    ] do-matrix ;
+    GL_TEXTURE_2D glEnable
+    0 -rot [
+        char-sprite [ sprite-width + ] keep
+        sprite-dlist glCallList
+    ] each-with neg 0 0 glTranslatef
+    GL_TEXTURE_2D glDisable ;

diff --git a/library/help/tutorial.factor b/library/help/tutorial.factor
index 1ab8b6aeb74717fad10fe1e530f1380334656377..e20edc7abf1a74a33b529978c5a5d01255cb08f8 100644 (file)
--- a/library/help/tutorial.factor
+++ b/library/help/tutorial.factor
@@ -13,7 +13,7 @@ namespaces sdl sequences strings styles ;
 \r
 : <underline> ( -- gadget )\r
     <gadget>\r
-    << gradient f @{ @{ 64 64 64 }@ @{ 255 255 255 }@ }@ >>\r
+    << gradient f @{ @{ 0.25 0.25 0.25 1.0 }@ @{ 1.0 1.0 1.0 1.0 }@ }@ >>\r
     over set-gadget-interior\r
     @{ 0 10 0 }@ over set-gadget-dim\r
     @{ 1 0 0 }@ over set-gadget-orientation ;\r
@@ -28,13 +28,13 @@ M: string tutorial-line
     }@ cond ;\r
 \r
 : example-theme\r
-    << solid f @{ 204 204 255 }@ >> swap set-gadget-interior ;\r
+    << solid f @{ 0.8 0.8 1.0 1.0 }@ >> swap set-gadget-interior ;\r
 \r
 M: general-list tutorial-line\r
     car <input-button> dup example-theme ;\r
 \r
 : page-theme\r
-    << gradient f @{ @{ 204 204 255 }@ @{ 255 204 255 }@ }@ >>\r
+    << gradient f @{ @{ 0.8 0.8 1.0 1.0 }@ @{ 1.0 0.8 1.0 1.0 }@ }@ >>\r
     swap set-gadget-interior ;\r
 \r
 : <page> ( list -- gadget )\r

diff --git a/library/opengl/opengl-utils.factor b/library/opengl/opengl-utils.factor
index 3a51d06c4846494acfd8a5b92cd368c5a0a173d3..0bb3278e6687fc66a8ae74ec340b0a3ad772eee3 100644 (file)
--- a/library/opengl/opengl-utils.factor
+++ b/library/opengl/opengl-utils.factor
@@ -3,9 +3,11 @@
 IN: opengl
 USING: alien errors kernel math namespaces opengl sdl sequences ;
 
+: gl-color ( { r g b a } -- ) first4 glColor4d ; inline
+
 : init-gl ( -- )
     0.0 0.0 0.0 0.0 glClearColor 
-    1.0 0.0 0.0 glColor3d
+    @{ 1.0 0.0 0.0 0.0 }@ gl-color
     GL_COLOR_BUFFER_BIT glClear
     GL_PROJECTION glMatrixMode
     glLoadIdentity
@@ -14,10 +16,10 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
     0 0 width get height get glViewport
     0 width get height get 0 gluOrtho2D
     GL_SMOOTH glShadeModel
-    GL_TEXTURE_2D glEnable
     GL_BLEND glEnable
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
-    GL_SCISSOR_TEST glEnable ;
+    GL_SCISSOR_TEST glEnable
+    GL_MODELVIEW glMatrixMode ;
 
 : gl-flags
     SDL_OPENGL
@@ -31,7 +33,7 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
     init-surface ;
 
 : with-gl-screen ( quot -- )
-    >r 0 gl-flags r> with-screen ;
+    >r 0 gl-flags r> with-screen ; inline
 
 : gl-error ( -- )
     glGetError dup 0 = [ drop ] [ gluErrorString throw ] if ;
@@ -47,19 +49,15 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
 : do-matrix ( mode quot -- )
     swap glMatrixMode glPushMatrix call glPopMatrix ; inline
 
-: gl-color ( { r g b } -- )
-    dup first 255 /f over second 255 /f rot third 255 /f
-    glColor3d ;
-
-: gl-vertex first3 glVertex3d ;
+: gl-vertex first3 glVertex3d ; inline
 
-: top-left drop 0 0 glTexCoord2d @{ 0 0 0 }@ gl-vertex ;
+: top-left drop 0 0 glTexCoord2d @{ 0 0 0 }@ gl-vertex ; inline
 
-: top-right 1 0 glTexCoord2d @{ 1 0 0 }@ v* gl-vertex ;
+: top-right 1 0 glTexCoord2d @{ 1 0 0 }@ v* gl-vertex ; inline
 
-: bottom-left 0 1 glTexCoord2d @{ 0 1 0 }@ v* gl-vertex ;
+: bottom-left 0 1 glTexCoord2d @{ 0 1 0 }@ v* gl-vertex ; inline
 
-: bottom-right 1 1 glTexCoord2d gl-vertex ;
+: bottom-right 1 1 glTexCoord2d gl-vertex ; inline
 
 : four-sides ( dim -- )
     dup top-left dup top-right dup bottom-right bottom-left ;
@@ -151,16 +149,17 @@ C: sprite ( loc dim dim2 -- )
     GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf
     GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf ;
 
+: gl-translate ( { x y z } -- ) first3 glTranslatef ;
+
 : make-sprite-dlist ( sprite -- id )
     GL_MODELVIEW [
         GL_COMPILE [
-            GL_MODELVIEW [
-                dup sprite-loc first3 glTranslatef
-                GL_TEXTURE_2D over sprite-texture glBindTexture
-                init-texture
-                dup sprite-dim2 gl-fill-rect
-            ] do-matrix
-            sprite-width 0 0 glTranslatef
+            dup sprite-loc gl-translate
+            GL_TEXTURE_2D over sprite-texture glBindTexture
+            init-texture
+            dup sprite-dim2 gl-fill-rect
+            dup sprite-dim @{ 1 0 0 }@ v*
+            swap sprite-loc v- gl-translate
         ] make-dlist
     ] do-matrix ;
 

diff --git a/library/styles.factor b/library/styles.factor
index 0651c75b6e3bd7ecf8674c697e970f38353780bc..7d4b5a0f3a99a66f5a574fee93d2cd275063de5e 100644 (file)
--- a/library/styles.factor
+++ b/library/styles.factor
@@ -2,15 +2,15 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: styles
 
-! Colors are RGB triples.
-: black      @{ 0   0   0   }@ ;
-: dark-gray  @{ 64  64  64  }@ ;
-: gray       @{ 128 128 128 }@ ;
-: light-gray @{ 192 192 192 }@ ;
-: white      @{ 255 255 255 }@ ;
-: red        @{ 255 0   0   }@ ;
-: green      @{ 0   255 0   }@ ;
-: blue       @{ 0   0   255 }@ ;
+! Colors are RGBA quadruples
+: black      @{ 0.0 0.0 0.0 1.0 }@ ;
+: dark-gray  @{ 0.25 0.25 0.25 1.0 }@ ;
+: gray       @{ 0.5 0.5 0.5 1.0 }@ ;
+: light-gray @{ 0.75 0.75 0.75 1.0 }@ ;
+: white      @{ 1.0 1.0 1.0 1.0 }@ ;
+: red        @{ 1.0 0.0 0.0 1.0 }@ ;
+: green      @{ 0.0 1.0 0.0 1.0 }@ ;
+: blue       @{ 0.0 0.0 1.0 1.0 }@ ;
 
 SYMBOL: foreground ! Used for text and outline shapes.
 SYMBOL: background ! Used for filled shapes.

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 4c5ac6e3d4a6c7648f5d38cdaad2785dd07a1426..44452751eda57a15669337c9bd0df7b4193f5772 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -20,26 +20,22 @@ SYMBOL: clip
 DEFER: draw-gadget
 
 : (draw-gadget) ( gadget -- )
-    dup dup gadget-interior draw-interior
-    dup dup gadget-boundary draw-boundary
-    draw-gadget* ;
+    dup rect-loc translate [
+        gl-translate
+        dup dup gadget-interior draw-interior
+        dup dup gadget-boundary draw-boundary
+        draw-gadget*
+    ] keep vneg gl-translate ;
 
 : do-clip ( gadget -- )
     >absolute clip [ rect-intersect dup ] change
     dup rect-loc swap rect-dim gl-set-clip ;
 
-: with-translation ( gadget quot -- | quot: gadget -- )
-    #! Note: origin variable is still changed after quot returns
-    GL_MODELVIEW [
-        >r dup rect-loc translate first3 glTranslated
-        r> call
-    ] do-matrix ; inline
-
 : draw-gadget ( gadget -- )
     clip get over inside? [
         [
             dup do-clip
-            dup [ (draw-gadget) ] with-translation
+            dup (draw-gadget)
             dup visible-children [ draw-gadget ] each
         ] with-scope
     ] when drop ;

diff --git a/library/ui/theme.factor b/library/ui/theme.factor
index a51cb1decad047ad158701e3d571d8091f9c56f8..d2718fa70d7982fca5d9cdf2dd2708f370c2839e 100644 (file)
--- a/library/ui/theme.factor
+++ b/library/ui/theme.factor
@@ -10,9 +10,9 @@ DEFER: set-label-font
 IN: gadgets-theme
 USING: arrays gadgets kernel sequences styles ;
 
-: solid-black << solid f @{ 0 0 0 }@ >> ;
+: solid-black << solid f @{ 0.0 0.0 0.0 1.0 }@ >> ;
 
-: solid-white << solid f @{ 255 255 255 }@ >> ;
+: solid-white << solid f @{ 1.0 1.0 1.0 1.0 }@ >> ;
 
 : solid-interior solid-white swap set-gadget-interior ;
 
@@ -20,30 +20,30 @@ USING: arrays gadgets kernel sequences styles ;
 
 : plain-gradient
     << gradient f @{
-        @{ 240 240 240 }@
-        @{ 212 212 212 }@
-        @{ 212 212 212 }@
-        @{ 160 160 160 }@
+        @{ 0.94 0.94 0.94 1.0 }@
+        @{ 0.83 0.83 0.83 1.0 }@
+        @{ 0.83 0.83 0.83 1.0 }@
+        @{ 0.62 0.62 0.62 1.0 }@
     }@ >> ;
 
 : rollover-gradient
     << gradient f @{
-        @{ 255 255 255 }@
-        @{ 232 232 232 }@
-        @{ 232 232 232 }@
-        @{ 192 192 192 }@
+        @{ 1.0 1.0 1.0 1.0 }@
+        @{ 0.9 0.9 0.9 1.0 }@
+        @{ 0.9 0.9 0.9 1.0 }@
+        @{ 0.75 0.75 0.75 1.0 }@
     }@ >> ;
 
 : pressed-gradient
     << gradient f @{
-        @{ 192 192 192 }@
-        @{ 232 232 232 }@
-        @{ 232 232 232 }@
-        @{ 255 255 255 }@
+        @{ 0.75 0.75 0.75 1.0 }@
+        @{ 0.9 0.9 0.9 1.0 }@
+        @{ 0.9 0.9 0.9 1.0 }@
+        @{ 1.0 1.0 1.0 1.0 }@
     }@ >> ;
 
 : faint-boundary
-    << solid f @{ 160 160 160 }@ >> swap set-gadget-boundary ;
+    << solid f @{ 0.62 0.62 0.62 1.0 }@ >> swap set-gadget-boundary ;
 
 : bevel-button-theme ( gadget -- )
     plain-gradient rollover-gradient pressed-gradient
@@ -55,33 +55,32 @@ USING: arrays gadgets kernel sequences styles ;
 
 : roll-button-theme ( button -- )
     f solid-black solid-black <button-paint> over set-gadget-boundary
-    f f << solid f @{ 236 230 232 }@ >> <button-paint> swap set-gadget-interior ;
+    f f << solid f @{ 0.92 0.9 0.9 1.0 }@ >> <button-paint> swap set-gadget-interior ;
 
 : caret-theme ( caret -- )
-    << solid f @{ 255 0 0 }@ >> swap set-gadget-interior ;
+    << solid f @{ 1.0 0.0 0.0 1.0 }@ >> swap set-gadget-interior ;
 
 : elevator-theme ( elevator -- )
     << gradient f @{
-        @{ 96 96 96 }@
-        @{ 112 112 112 }@
-        @{ 128 128 128 }@
+        @{ 0.37 0.37 0.37 1.0 }@
+        @{ 0.43 0.43 0.43 1.0 }@
+        @{ 0.5 0.5 0.5 1.0 }@
     }@ >> swap set-gadget-interior ;
 
 : reverse-video-theme ( gadget -- )
     solid-black swap set-gadget-interior ;
 
 : display-title-theme
-    << solid f @{ 216 232 255 }@ >> swap set-gadget-interior ;
+    << solid f @{ 0.84 0.9 1.0 1.0 }@ >> swap set-gadget-interior ;
 
 : menu-theme ( menu -- )
     dup solid-boundary
-    << gradient f @{ @{ 216 216 216 }@ @{ 255 255 255 }@ }@ >>
-    swap set-gadget-interior ;
+    << solid f @{ 0.9 0.9 0.9 0.9 }@ >> swap set-gadget-interior ;
 
 : label-theme ( label -- )
-    @{ 0 0 0 }@ over set-label-color
+    @{ 0.0 0.0 0.0 1.0 }@ over set-label-color
     @{ "Monospaced" plain 12 }@ swap set-label-font ;
 
 : editor-theme ( editor -- )
-    @{ 0 0 0 }@ over set-label-color
+    @{ 0.0 0.0 0.0 1.0 }@ over set-label-color
     @{ "Monospaced" bold 12 }@ swap set-label-font ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 0ec7a64fb738de77b44b54ddf1414085cc84f4df..9dea09dcd99df35f3498b64a061d58ef07d3241d 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -17,16 +17,13 @@ global [ first-time on ] bind
             world get solid-interior
             @{ 800 600 0 }@ world get set-gadget-dim
             <hand> hand set
-            listener-application
             first-time off
         ] when
     ] bind ;
 
 : check-running
-    world get [
-        world-running?
-        [ "The UI is already running" throw ] when
-    ] when* ;
+    world get world-running?
+    [ "The UI is already running" throw ] when ;
 
 IN: shells
 
@@ -35,5 +32,6 @@ IN: shells
     #! dimensions.
     [
         init-world check-running
-        world get rect-dim first2 0 gl-flags [ run-world ] with-screen
+        world get rect-dim first2
+        [ listener-application run-world ] with-gl-screen
     ] with-freetype ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index ed161a9c42acaa5411f1843ae2a537afecd59fee..76bc38d7260bc8912c31b43c6f5ce2034e4d3bb1 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -99,7 +99,7 @@ M: motion-event handle-event ( event -- )
 
 : world-step ( -- )
     world get world-invalid >r layout-world r>
-    [ update-hand draw-world ] when ;
+    [ update-hand USE: test [ draw-world ] time ] when ;
 
 : next-event ( -- event ? ) <event> dup SDL_PollEvent ;