FreeType debugging

diff --git a/library/alien/malloc.factor b/library/alien/malloc.factor
index b4223fdafc5a8b5857512229b7e8695530699877..cfa1503b79b4244fe5985aa78e2034548b503222 100644 (file)
--- a/library/alien/malloc.factor
+++ b/library/alien/malloc.factor
@@ -5,6 +5,7 @@ USING: alien errors kernel ;
 
 LIBRARY: libc
 FUNCTION: ulong malloc ( ulong size ) ;
+FUNCTION: ulong calloc ( ulong count, ulong size ) ;
 FUNCTION: void free ( ulong ptr ) ;
 FUNCTION: ulong realloc ( ulong ptr, ulong size ) ;
 FUNCTION: void memcpy ( ulong dst, ulong src, ulong size ) ;

diff --git a/library/freetype/freetype-gl.factor b/library/freetype/freetype-gl.factor
index 97d879957cd196d5041ec4d6dee8db09d58b7e49..632ac909ec198ee90cb7a9a179363144bfec24ed 100644 (file)
--- a/library/freetype/freetype-gl.factor
+++ b/library/freetype/freetype-gl.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-USING: #<unknown> alien arrays errors hashtables io kernel
+USING: alien arrays errors hashtables io kernel
 kernel-internals lists math namespaces opengl prettyprint
 sequences styles ;
 IN: freetype
@@ -19,14 +19,11 @@ SYMBOL: open-fonts
         {{ }} clone open-fonts set
     ] bind ;
 
-! A sprite are a texture and display list.
-TUPLE: sprite dlist texture ;
-
 : free-dlists ( seq -- )
-    "Freeing display lists: " print . ;
+    drop ;
 
 : free-textures ( seq -- )
-    "Freeing textures: " print . ;
+    drop ;
 
 : free-sprites ( glyphs -- )
     dup [ sprite-dlist ] map free-dlists
@@ -35,11 +32,19 @@ TUPLE: sprite dlist texture ;
 ! A font object from FreeType.
 ! the handle is an FT_Face.
 ! sprites is a vector.
-TUPLE: font height handle sprites metrics ;
+TUPLE: font ascent descent height handle sprites ;
 
-: close-font ( font -- )
+: flush-font ( font -- )
+    #! Only do this after re-creating a GL context!
     dup font-sprites [ ] subset free-sprites
-    font-handle FT_Done_Face ;
+    { } clone swap set-font-sprites ;
+
+: close-font ( font -- )
+    dup flush-font font-handle FT_Done_Face ;
+
+: flush-fonts ( -- )
+    #! Only do this after re-creating a GL context!
+    open-fonts get hash-values [ flush-font ] each ;
 
 : close-freetype ( -- )
     global [
@@ -76,23 +81,25 @@ TUPLE: font height handle sprites metrics ;
     ttf-name ttf-path >r freetype get r>
     0 f <void*> [ FT_New_Face freetype-error ] keep *void* ;
 
-: dpi 100 ;
+: dpi 72 ;
 
 : fix>float 64 /f ;
 
 : font-units>pixels ( n font -- n )
     face-size face-size-y-scale FT_MulFix fix>float ;
 
-: init-font-height ( font -- )
-    dup font-handle
-    dup face-y-max over face-y-min - swap font-units>pixels 
-    swap set-font-height ;
+: init-ascent ( font face -- )
+    dup face-y-max swap font-units>pixels swap set-font-ascent ;
+
+: init-descent ( font face -- )
+    dup face-y-min swap font-units>pixels swap set-font-descent ;
+
+: init-font ( font -- )
+    dup font-handle 2dup init-ascent dupd init-descent
+    dup font-ascent over font-descent - swap set-font-height ;
 
 C: font ( handle -- font )
-    { } clone over set-font-sprites
-    { } clone over set-font-metrics
-    [ set-font-handle ] keep
-    dup init-font-height ;
+    [ set-font-handle ] keep dup flush-font dup init-font ;
 
 : open-font ( { font style ptsize } -- font )
     #! Open a font and set the point size of the font.
@@ -103,60 +110,81 @@ C: font ( handle -- font )
     #! Cache open fonts.
     3array open-fonts get [ open-font ] cache ;
 
-: load-glyph ( face char -- glyph )
-    dupd 0 FT_Load_Char freetype-error face-glyph ;
+: load-glyph ( font char -- glyph )
+    >r font-handle r> dupd 0 FT_Load_Char
+    freetype-error face-glyph ;
 
-: (char-size) ( font char -- dim )
-    >r font-handle r> load-glyph
-    dup glyph-width fix>float
+: glyph-size ( glyph -- dim )
+    dup glyph-advance-x fix>float
     swap glyph-height fix>float 0 3array ;
 
-: char-size ( open-font char -- w h )
-    over font-metrics [ dupd (char-size) ] cache-nth nip first2 ;
-
-: string-size ( font string -- w h )
-    0 pick font-height
-    2swap [ char-size >r rot + swap r> max ] each-with ;
-
-: render-glyph ( face char -- bitmap )
+: render-glyph ( font char -- bitmap )
     #! Render a character and return a pointer to the bitmap.
     load-glyph dup
     FT_RENDER_MODE_NORMAL FT_Render_Glyph freetype-error ;
 
 : with-locked-block ( size quot -- | quot: address -- )
-    swap malloc [ swap call ] keep free ; inline
+    swap 1 calloc [ swap call ] keep free ; inline
+
+: b/b>w 8 shift bitor ;
+
+: copy-pixel ( bit tex -- bit tex )
+    f pick alien-unsigned-1 255 b/b>w
+    f pick set-alien-unsigned-2
+    >r 1+ r> 2 + ;
 
-: (copy-bitmap) ( bitmap-chase texture-chase width width-pow2 )
-    >r 3dup swapd memcpy tuck >r >r + r> r> r> tuck >r >r + r> r> ;
+: (copy-row) ( bit tex bitend texend -- bitend texend )
+    >r pick over >= [
+        r> 2swap 2drop
+    ] [
+        >r copy-pixel r> r> (copy-row)
+    ] if ;
 
-: copy-bitmap ( glyph texture width-pow2 -- )
-    pick glyph-bitmap-rows >r >r over glyph-bitmap-pitch >r >r
-    glyph-bitmap-buffer alien-address r> r> r> r>
-    [ (copy-bitmap) ] times 2drop 2drop ;
+: copy-row ( bit tex width width2 -- bitend texend width width2 )
+    [ pick + >r pick + r> (copy-row) ] 2keep ;
 
-: bitmap>texture ( width height glyph -- id )
+: copy-bitmap ( glyph texture -- )
+    over glyph-bitmap-rows >r
+    over glyph-bitmap-width dup next-power-of-2 2 *
+    >r >r >r glyph-bitmap-buffer alien-address r> r> r> r> 
+    [ copy-row ] times 2drop 2drop ;
+
+: bitmap>texture ( glyph sprite -- id )
     #! Given a glyph bitmap, copy it to a texture with the given
     #! width/height (which must be powers of two).
-    3drop
-    32 32 * 4 * [
-        <alien> 32 32 * 4 * [
-            128 pick rot set-alien-signed-1
-        ] each 32 32 rot gray-texture
+    tuck sprite-size2 * 2 * [
+        [ copy-bitmap ] keep <alien> gray-texture
     ] with-locked-block ;
 
-: char-texture-size ( bitmap -- width height )
-    dup glyph-bitmap-width swap glyph-bitmap-rows
-    [ next-power-of-2 ] 2apply ;
+: glyph-texture-loc ( glyph font -- loc )
+    font-ascent swap glyph-hori-bearing-y fix>float -
+    0 swap 0 3array ;
 
-: <char-sprite> ( face char -- sprite )
-    render-glyph [ char-texture-size 2dup ] keep
-    bitmap>texture [ texture>dlist ] keep <sprite> ;
+: glyph-texture-size ( glyph -- dim )
+    dup glyph-bitmap-width next-power-of-2
+    swap glyph-bitmap-rows next-power-of-2 0 3array ;
 
-: char-sprite ( open-font char -- sprite )
-    over font-sprites
-    [ >r dup font-handle r> <char-sprite> ] cache-nth nip ;
+: <char-sprite> ( font char -- sprite )
+    #! Create a new display list of a rendered glyph. This
+    #! allocates external resources. See free-sprites.
+    over >r render-glyph dup r> glyph-texture-loc
+    over glyph-size pick glyph-texture-size <sprite>
+    [ bitmap>texture ] keep [ init-sprite ] keep ;
 
-: draw-string ( font string -- )
-    GL_TEXTURE_BIT [
-        [ char-sprite sprite-dlist glCallList ] each-with
-    ] save-attribs ;
+: char-sprite ( open-font char -- sprite )
+    #! Get a cached display list of a FreeType-rendered
+    #! glyph.
+    over font-sprites [ dupd <char-sprite> ] cache-nth nip ;
+
+: char-width ( open-font char -- w )
+    char-sprite sprite-width ;
+
+: string-width ( open-font string -- w )
+    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 ;

diff --git a/library/math/integer.factor b/library/math/integer.factor
index bbfd2647cc218006d1bd9ad21d2de0639bdc732c..9bc6255bad19d924e260f49f468d8d58b84c7ab1 100644 (file)
--- a/library/math/integer.factor
+++ b/library/math/integer.factor
@@ -31,10 +31,14 @@ UNION: integer fixnum bignum ;
     foldable
 
 : (next-power-of-2) ( i n -- n )
-    2dup >= [ drop ] [ >r 1 shift r> (next-power-of-2) ] if ;
+    2dup >= [
+        drop
+    ] [
+        >r 1 shift 1 max r> (next-power-of-2)
+    ] if ;
 
 : next-power-of-2 ( n -- n )
-    2 swap (next-power-of-2) ;
+    0 swap (next-power-of-2) ;
 
 IN: math-internals
 

diff --git a/library/math/ratio.factor b/library/math/ratio.factor
index b45cb72128595b0acae80c73e4c147735d776859..31a0be28b2d463d009cc7c2e823ccc7c6736ff7d 100644 (file)
--- a/library/math/ratio.factor
+++ b/library/math/ratio.factor
@@ -35,6 +35,8 @@ M: ratio - ( x y -- x-y ) 2dup scale - -rot ratio+d / ;
 M: ratio * ( x y -- x*y ) 2>fraction * >r * r> / ;
 M: ratio / scale / ;
 M: ratio /i scale /i ;
+M: ratio /mod 2dup >r >r /i dup r> * r> swap - ;
+M: ratio mod /mod nip ;
 M: ratio /f scale /f ;
 
 M: ratio truncate >fraction /i ;

diff --git a/library/opengl/opengl-utils.factor b/library/opengl/opengl-utils.factor
index da725b0cac9308f4acb73139667d68a751f1eb0f..04476efbef77e419de3c5dc5382fbe6b90147f25 100644 (file)
--- a/library/opengl/opengl-utils.factor
+++ b/library/opengl/opengl-utils.factor
@@ -14,10 +14,16 @@ 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_TEXTURE_2D glEnable
+    GL_BLEND glEnable
+    GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
+    GL_SCISSOR_TEST glEnable ;
 
 : gl-flags
-    SDL_OPENGL SDL_RESIZABLE bitor SDL_HWSURFACE bitor SDL_DOUBLEBUF bitor ;
+    SDL_OPENGL
+    SDL_RESIZABLE bitor
+    SDL_HWSURFACE bitor
+    SDL_DOUBLEBUF bitor ;
 
 : gl-resize ( event -- )
     #! Acts on an SDL resize event.
@@ -44,13 +50,13 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
 
 : gl-vertex first3 glVertex3d ;
 
-: top-left drop @{ 0 0 0 }@ gl-vertex ;
+: top-left drop 0 0 glTexCoord2d @{ 0 0 0 }@ gl-vertex ;
 
-: top-right @{ 1 0 0 }@ v* gl-vertex ;
+: top-right 1 0 glTexCoord2d @{ 1 0 0 }@ v* gl-vertex ;
 
-: bottom-left @{ 0 1 0 }@ v* gl-vertex ;
+: bottom-left 0 1 glTexCoord2d @{ 0 1 0 }@ v* gl-vertex ;
 
-: bottom-right gl-vertex ;
+: bottom-right 1 1 glTexCoord2d gl-vertex ;
 
 : four-sides ( dim -- )
     dup top-left dup top-right dup bottom-right bottom-left ;
@@ -58,19 +64,17 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
 : gl-line ( from to { r g b } -- )
     gl-color [ gl-vertex ] 2apply ;
 
-: (gl-rect) swap gl-color [ four-sides ] do-state ;
-
-: gl-fill-rect ( dim { r g b } -- )
+: gl-fill-rect ( dim -- )
     #! Draws a two-dimensional box.
-    GL_QUADS (gl-rect) ;
+    GL_QUADS [ four-sides ] do-state ;
 
-: gl-rect ( dim { r g b } -- )
+: gl-rect ( dim -- )
     #! Draws a two-dimensional box.
-    GL_LINE_LOOP (gl-rect) ;
+    GL_LINE_LOOP [ four-sides ] do-state ;
 
-: (gl-poly) swap gl-color [ [ gl-vertex ] each ] do-state ;
+: (gl-poly) [ [ gl-vertex ] each ] do-state ;
 
-: gl-fill-poly ( points { r g b } -- )
+: gl-fill-poly ( points -- )
     #! Draw a filled polygon.
     GL_POLYGON (gl-poly) ;
 
@@ -82,7 +86,9 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
     swap glMatrixMode glPushMatrix call glPopMatrix ; inline
 
 : gl-set-clip ( loc dim -- )
-    [ first2 ] 2apply glScissor ;
+    dup first2 >r >r
+    over second swap second + height get swap - >r
+    first r> r> r> glScissor ;
 
 : prepare-gradient ( direction dim -- v1 v2 )
     tuck v* [ v- ] keep ;
@@ -104,17 +110,26 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
 : save-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
 
-: gray-texture ( width height buffer -- id )
+! A sprite is a texture and a display list.
+TUPLE: sprite dlist texture loc dim dim2 ;
+
+C: sprite ( loc dim dim2 -- )
+    [ set-sprite-dim2 ] keep
+    [ set-sprite-dim ] keep
+    [ set-sprite-loc ] keep ;
+
+: sprite-size2 sprite-dim2 first2 ;
+
+: sprite-width sprite-dim first ;
+
+: gray-texture ( sprite buffer -- id )
     #! Given a buffer holding a width x height (powers of two)
     #! grayscale texture, bind it and return the ID.
     gen-texture [
         GL_TEXTURE_BIT [
             GL_TEXTURE_2D swap glBindTexture
-            GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
-            GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
-            GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf
-            GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf
-            >r >r >r GL_TEXTURE_2D 0 GL_RGBA r> r> 0 GL_RGBA
+            >r >r GL_TEXTURE_2D 0 GL_RGBA r>
+            sprite-size2 0 GL_LUMINANCE_ALPHA
             GL_UNSIGNED_BYTE r> glTexImage2D
         ] save-attribs
     ] keep ;
@@ -127,19 +142,25 @@ USING: alien errors kernel math namespaces opengl sdl sequences ;
     #! Make a display list.
     gen-dlist [ rot glNewList call glEndList ] keep ; inline
 
-: texture>dlist ( width height id -- id )
-    #! Given a texture width/height and ID, make a display list
-    #! for draws a quad with this texture.
+: init-texture ( -- )
+    GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR glTexParameteri
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameterf
+    GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameterf ;
+
+: make-sprite-dlist ( sprite -- id )
     GL_MODELVIEW [
         GL_COMPILE [
-            1 1 1 glColor3f
-            GL_TEXTURE_2D swap glBindTexture
-            GL_QUADS [
-                0 0 glTexCoord2d 0 0 glVertex2i
-                0 1 glTexCoord2d 0 over glVertex2i
-                1 1 glTexCoord2d 2dup glVertex2i
-                1 0 glTexCoord2d over 0 glVertex2i
-            ] do-state
-            drop 0 0 glTranslatef
+            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
         ] make-dlist
     ] do-matrix ;
+
+: init-sprite ( texture sprite -- )
+    [ set-sprite-texture ] keep
+    [ make-sprite-dlist ] keep set-sprite-dlist ;

diff --git a/library/sdl/load.factor b/library/sdl/load.factor
index 3b129582a8091191d097480be7d664c9594004b5..2353c048ffb72ca225ce950b0449a9e60c02f07f 100644 (file)
--- a/library/sdl/load.factor
+++ b/library/sdl/load.factor
@@ -10,7 +10,6 @@ USING: alien io kernel parser sequences ;
     "/library/sdl/sdl.factor"
     "/library/sdl/sdl-video.factor"
     "/library/sdl/sdl-event.factor"
-    "/library/sdl/sdl-gfx.factor"
     "/library/sdl/sdl-keysym.factor"
     "/library/sdl/sdl-keyboard.factor"
     "/library/sdl/sdl-utils.factor"

diff --git a/library/sdl/sdl-gfx.factor b/library/sdl/sdl-gfx.factor
deleted file mode 100644 (file)
index 6318679..0000000
--- a/library/sdl/sdl-gfx.factor
+++ /dev/null
@@ -1,108 +0,0 @@
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: sdl USING: alien ;
-
-: pixelColor ( surface x y color -- )
-    "void" "sdl-gfx" "pixelColor"
-    [ "surface*" "short" "short" "uint" ]
-    alien-invoke ;
-
-: hlineColor ( surface x1 x2 y color -- )
-    "void" "sdl-gfx" "hlineColor"
-    [ "surface*" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: vlineColor ( surface x y1 y2 color -- )
-    "void" "sdl-gfx" "vlineColor"
-    [ "surface*" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: rectangleColor ( surface x1 y1 x2 y2 color -- )
-    "void" "sdl-gfx" "rectangleColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: boxColor ( surface x1 y1 x2 y2 color -- )
-    "void" "sdl-gfx" "boxColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: lineColor ( surface x1 y1 x2 y2 color -- )
-    "void" "sdl-gfx" "lineColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: aalineColor ( surface x1 y1 x2 y2 color -- )
-    "void" "sdl-gfx" "aalineColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: circleColor ( surface x y r color -- )
-    "void" "sdl-gfx" "circleColor"
-    [ "surface*" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: aacircleColor ( surface x y r color -- )
-    "void" "sdl-gfx" "aacircleColor"
-    [ "surface*" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: filledCircleColor ( surface x y r color -- )
-    "void" "sdl-gfx" "filledCircleColor"
-    [ "surface*" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: ellipseColor ( surface x y rx ry color -- )
-    "void" "sdl-gfx" "ellipseColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: aaellipseColor ( surface x y rx ry color -- )
-    "void" "sdl-gfx" "aaellipseColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: filledEllipseColor ( surface x y rx ry color -- )
-    "void" "sdl-gfx" "filledEllipseColor"
-    [ "surface*" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: trigonColor ( surface x1 y1 x2 y2 x3 y3 color -- )
-    "void" "sdl-gfx" "trigonColor"
-    [ "surface*" "short" "short" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: aatrigonColor ( surface x1 y1 x2 y2 x3 y3 color -- )
-    "void" "sdl-gfx" "aatrigonColor"
-    [ "surface*" "short" "short" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: filledTrigonColor ( surface x1 y1 x2 y2 x3 y3 color -- )
-    "void" "sdl-gfx" "filledTrigonColor"
-    [ "surface*" "short" "short" "short" "short" "short" "short" "uint" ]
-    alien-invoke ;
-
-: polygonColor ( surface vx vy n color -- )
-    "void" "sdl-gfx" "polygonColor"
-    [ "surface*" "short*" "short*" "int" "int" ]
-    alien-invoke ;
-
-: aapolygonColor ( surface vx vy n color -- )
-    "void" "sdl-gfx" "aapolygonColor"
-    [ "surface*" "short*" "short*" "int" "int" ]
-    alien-invoke ;
-
-: filledPolygonColor ( surface vx vy n color -- )
-    "void" "sdl-gfx" "filledPolygonColor"
-    [ "surface*" "short*" "short*" "int" "int" ]
-    alien-invoke ;
-
-: characterColor ( surface x y c color -- )
-    "void" "sdl-gfx" "characterColor"
-    [ "surface*" "short" "short" "char" "uint" ]
-    alien-invoke ;
-
-: stringColor ( surface x y str color -- )
-    "void" "sdl-gfx" "stringColor"
-    [ "surface*" "short" "short" "char*" "uint" ]
-    alien-invoke ;

diff --git a/library/sdl/sdl-utils.factor b/library/sdl/sdl-utils.factor
index a580a9a569b7077d1e16204a04ae396bdebb48b2..807c576f2ca2642b4a1455bd7e47401944bb80f1 100644 (file)
--- a/library/sdl/sdl-utils.factor
+++ b/library/sdl/sdl-utils.factor
@@ -30,28 +30,6 @@ SYMBOL: bpp
     [ [ >r init-sdl r> call ] [ SDL_Quit ] cleanup ] with-scope ;
     inline
 
-: rgb ( [ r g b ] -- n )
-    first3
-    255
-    swap >fixnum 8 shift bitor
-    swap >fixnum 16 shift bitor
-    swap >fixnum 24 shift bitor ;
-
-: make-rect ( x y w h -- rect )
-    <sdl-rect>
-    [ set-sdl-rect-h ] keep
-    [ set-sdl-rect-w ] keep
-    [ set-sdl-rect-y ] keep
-    [ set-sdl-rect-x ] keep ;
-
-: with-pixels ( quot -- )
-    width get [
-        height get [
-            [ rot dup slip swap surface get swap ] 2keep
-            [ rot pixelColor ] 2keep
-        ] repeat
-    ] repeat drop ; inline
-
 : must-lock-surface? ( -- ? )
     #! This is a macro in SDL_video.h.
     surface get dup surface-offset 0 = [

diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor
index 9897b8d7fe39fa3a254ceb9b339263c88756a240..8ab0b4cfff20706254c48a6cf329268754e38ef1 100644 (file)
--- a/library/test/math/integer.factor
+++ b/library/test/math/integer.factor
@@ -85,7 +85,8 @@ unit-test
 [ 0 ] [ -7/8 ceiling ] unit-test
 [ -1 ] [ -3/2 ceiling ] unit-test
 
-[ 2 ] [ 1 next-power-of-2 ] unit-test
+[ 0 ] [ 0 next-power-of-2 ] unit-test
+[ 1 ] [ 1 next-power-of-2 ] unit-test
 [ 2 ] [ 2 next-power-of-2 ] unit-test
 [ 4 ] [ 3 next-power-of-2 ] unit-test
 [ 16 ] [ 13 next-power-of-2 ] unit-test

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index b79fa251337479a6be1ac7ef126235e0010cdfae..10eedcafcbeca879da9cfde2ba64d6de0730ed78 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -54,7 +54,7 @@ TUPLE: editor line caret ;
 
 : run-char-widths ( font str -- wlist )
     #! List of x co-ordinates of each character.
-    >array [ char-size drop ] map-with
+    >array [ char-width ] map-with
     dup 0 [ + ] accumulate swap 2 v/n v+ ;
 
 : x>offset ( x font str -- offset )
@@ -122,7 +122,7 @@ C: editor ( text -- )
     dup editor-actions ;
 
 : offset>x ( gadget offset str -- x )
-    head-slice >r gadget-font r> string-size drop ;
+    head-slice >r gadget-font r> string-width ;
 
 : caret-loc ( editor -- x y )
     dup editor-line [ caret-pos line-text get ] bind offset>x

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 29afab0351fb4166722dbc7605c54178005a5eee..695291a6701b92f0c5dd5e5f9e86ebc327bbb523 100644 (file)
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-labels
 USING: arrays freetype gadgets gadgets-layouts generic
-hashtables io kernel math namespaces sequences styles ;
+hashtables io kernel math namespaces opengl sequences styles ;
 
 ! A label gadget draws a string.
 TUPLE: label text ;
@@ -15,13 +15,14 @@ C: label ( text -- label )
     [ 2dup [ set-label-text ] keep relayout ] unless 2drop ;
 
 : label-size ( gadget text -- dim )
-    dup gadget-font swap label-text string-size 0 3array ;
+    dup gadget-font dup font-height >r
+    swap label-text string-width r> 0 3array ;
 
 M: label pref-dim ( label -- dim )
     label-size ;
 
 : draw-label ( label -- )
-    dup gadget-font swap label-text draw-string ;
+    dup fg gl-color dup gadget-font swap label-text draw-string ;
 
 M: label draw-gadget* ( label -- )
     dup delegate draw-gadget* draw-label ;

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index cadf49546a5c88d43a72b4d785775dc598ce97ea..5fb21c19b9feb02b7c2e2dd724634d6d0825ff5e 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -81,10 +81,10 @@ TUPLE: solid ;
 
 ! Solid pen
 M: solid draw-interior
-    drop dup rect-dim swap bg gl-fill-rect ;
+    drop dup bg gl-color rect-dim gl-fill-rect ;
 
 M: solid draw-boundary
-    drop dup rect-dim @{ 1 1 0 }@ v- swap fg gl-rect ;
+    drop dup fg gl-color rect-dim @{ 1 1 0 }@ v- gl-rect ;
 
 ! Rollover only
 TUPLE: rollover-only ;
@@ -115,10 +115,10 @@ M: gadget draw-gadget* ( gadget -- )
 TUPLE: polygon points ;
 
 M: polygon draw-boundary ( gadget polygon -- )
-    polygon-points swap fg gl-poly ;
+    swap fg gl-color polygon-points gl-poly ;
 
 M: polygon draw-interior ( gadget polygon -- )
-    polygon-points swap bg gl-fill-poly ;
+    swap bg gl-color polygon-points gl-fill-poly ;
 
 : arrow-up    @{ @{ 3 0 0 }@ @{ 6 6 0 }@ @{ 0 6 0 }@ }@ ;
 : arrow-right @{ @{ 0 0 0 }@ @{ 6 3 0 }@ @{ 0 6 0 }@ }@ ;

diff --git a/library/ui/world.factor b/library/ui/world.factor
index b2a86bc91333a623f9020ba92c9017676ff00b05..ff46b5564a7acef32c952069fc54da3fad397099 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien arrays errors gadgets-layouts generic io kernel
-lists math memory namespaces opengl prettyprint sdl
+USING: alien arrays errors freetype gadgets-layouts generic io
+kernel lists math memory namespaces opengl prettyprint sdl
 sequences sequences strings styles threads ;
 
 ! The world gadget is the top level gadget that all (visible)
@@ -118,5 +118,6 @@ M: quit-event handle-event ( event -- )
     drop stop-world ;
 
 M: resize-event handle-event ( event -- )
+    flush-fonts
     gl-resize
     width get height get 0 3array world get set-gadget-dim ;