OpenGL and FreeType documentation

TODO.txt

@@ -2,10 +2,9 @@
 
 - callback scheduling issue
 - error popup obscures input area
-- browser: tile titles should respond to right-clicks and/or have a
-  menu popup button
 - ui docs
-- calling 'see' with an unknown method should be an error
+- calling 'see' with an nonexistent method should be an error
+- grid-lines are rendered incorrectly
 
 + 0.88:
 
@@ -13,6 +12,7 @@
 - growable data heap
 - variable width word wrap
 - graphical crossref tool
+- inspector where slot values can be changed
 - compiled call traces:
   - should be independent of whenever the runtime was built with
     -fomit-frame-pointer or not

core/handbook/streams.facts

@@ -47,8 +47,10 @@ $terpri
 { $subsection stream-copy } ;
 
 ARTICLE: "stdio" "The default stream"
-"Various words take an implicit stream parameter from the " { $link stdio } " variable to reduce stack shuffling. Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user."
+"Various words take an implicit stream parameter from a variable to reduce stack shuffling."
-{ $link close }
+{ $subsection stdio }
+"Unless rebound in a child namespace, this variable will be set to a console stream for interacting with the user."
+{ $subsection close }
 { $subsection read1 }
 { $subsection read }
 { $subsection readln }

core/ui/freetype/freetype-gl.factor

@@ -5,8 +5,6 @@ libc math namespaces opengl prettyprint
 sequences styles ;
 IN: freetype
 
-! Memory management: freetype is allocated and freed by
-! with-freetype.
 SYMBOL: freetype
 SYMBOL: open-fonts
 
@@ -20,9 +18,6 @@ SYMBOL: open-fonts
         H{ } clone open-fonts set
     ] bind ;
 
-! A font object from FreeType.
-! the handle is an FT_Face.
-! sprites is a vector.
 TUPLE: font ascent descent height handle widths ;
 
 M: font equal? eq? ;
@@ -62,8 +57,6 @@ M: font equal? eq? ;
     "/fonts/" swap ".ttf" 3append resource-path ;
 
 : open-face ( font style -- face )
-    #! Open a TrueType font with the given logical name and
-    #! style.
     ttf-name ttf-path >r freetype get r>
     0 f <void*> [ FT_New_Face freetype-error ] keep *void* ;
 
@@ -91,14 +84,12 @@ C: font ( handle -- font )
     [ set-font-handle ] keep dup init-font
     V{ } clone over set-font-widths ;
 
-: open-font ( fontspec -- font )
+: (open-font) ( font -- open-font )
-    #! Open a font and set the point size of the font.
     first3 >r open-face dup 0 r> 6 shift
     dpi dpi FT_Set_Char_Size freetype-error <font> ;
 
-: lookup-font ( fontspec -- font )
+: open-font ( font -- open-font )
-    #! Cache open fonts.
+    open-fonts get [ (open-font) ] cache ;
-    open-fonts get [ open-font ] cache ;
 
 : load-glyph ( font char -- glyph )
     >r font-handle dup r> 0 FT_Load_Char
@@ -114,7 +105,6 @@ C: font ( handle -- font )
     swap glyph-height ft-ceil 2array ;
 
 : 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 ;
 
@@ -140,8 +130,6 @@ C: font ( handle -- font )
     [ 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).
     tuck sprite-size2 * 2 * [
         alien-address [ copy-bitmap ] keep <alien> gray-texture
     ] with-malloc ;
@@ -155,8 +143,6 @@ C: font ( handle -- font )
     swap glyph-bitmap-rows next-power-of-2 2array ;
 
 : <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 ;

core/ui/gadgets/labels.factor

@@ -24,7 +24,7 @@ C: label ( string -- label )
     dup label-theme ;
 
 M: label pref-dim*
-    dup label-font lookup-font swap label-text text-dim ;
+    dup label-font open-font swap label-text text-dim ;
 
 M: label draw-gadget*
     dup label-color gl-color

core/ui/opengl/gl.factor

@@ -1325,5 +1325,3 @@ FUNCTION: void glCopyTexSubImage3D ( GLenum target, GLint level,
 : GL_TEXTURE_COMPARE_MODE           HEX: 884C ; inline
 : GL_TEXTURE_COMPARE_FUNC           HEX: 884D ; inline
 : GL_COMPARE_R_TO_TEXTURE           HEX: 884E ; inline
-
-

core/ui/opengl/glu.factor

@@ -257,4 +257,3 @@ FUNCTION: void gluTessProperty ( GLUtesselator* tess, GLenum which, GLdouble dat
 FUNCTION: void gluTessVertex ( GLUtesselator* tess, GLdouble* location, GLvoid* data ) ;
 FUNCTION: GLint gluUnProject ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble* model, GLdouble* proj, GLint* view, GLdouble* objX, GLdouble* objY, GLdouble* objZ ) ;
 FUNCTION: GLint gluUnProject4 ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, GLdouble* model, GLdouble* proj, GLint* view, GLdouble nearVal, GLdouble farVal, GLdouble* objX, GLdouble* objY, GLdouble* objZ, GLdouble* objW ) ;
-

core/ui/opengl/load.factor

@@ -2,5 +2,6 @@ PROVIDE: core/ui/opengl
 { +files+ {
     "gl.factor"
     "glu.factor"
-    "opengl-utils.factor"
+    "utilities.factor"
+    "utilities.facts"
 } } ;

core/ui/opengl/utilities.factor

@@ -4,7 +4,7 @@ IN: opengl
 USING: alien errors io kernel math namespaces opengl
 sequences ;
 
-: gl-color ( colorspec -- ) first4 glColor4d ; inline
+: gl-color ( color -- ) first4 glColor4d ; inline
 
 : gl-error ( -- )
     glGetError dup zero? [
@@ -21,17 +21,15 @@ sequences ;
     swap [ glMatrixMode glPushMatrix call ] keep
     glMatrixMode glPopMatrix ; inline
 
-: gl-vertex first2 glVertex2d ; inline
+: gl-vertex ( point -- ) first2 glVertex2d ; inline
 
 : gl-line ( a b -- )
     GL_LINES [ gl-vertex gl-vertex ] do-state ;
 
 : gl-fill-rect ( loc dim -- )
-    #! Draws a two-dimensional box.
     [ first2 ] 2apply glRectd ;
 
 : gl-rect ( loc dim -- )
-    #! Draws a two-dimensional box.
     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 ;
@@ -39,18 +37,15 @@ sequences ;
 : (gl-poly) [ [ gl-vertex ] each ] do-state ;
 
 : gl-fill-poly ( points -- )
-    #! Draw a filled polygon.
     dup length 2 > GL_POLYGON GL_LINES ? (gl-poly) ;
 
 : gl-poly ( points -- )
-    #! Draw a polygon.
     GL_LINE_LOOP (gl-poly) ;
 
 : prepare-gradient ( direction dim -- v1 v2 )
     tuck v* [ v- ] keep ;
 
 : gl-gradient ( direction colors dim -- )
-    #! Draws a quad strip.
     GL_QUAD_STRIP [
         swap >r prepare-gradient r>
         [ length dup 1- v/n ] keep [
@@ -60,13 +55,11 @@ sequences ;
     ] do-state ;
 
 : gen-texture ( -- id )
-    #! Generate texture ID.
     1 0 <uint> [ glGenTextures ] keep *uint ;
 
 : save-attribs ( bits quot -- )
     swap glPushAttrib call glPopAttrib ; inline
 
-! A sprite is a texture and a display list.
 TUPLE: sprite dlist texture loc dim dim2 ;
 
 C: sprite ( loc dim dim2 -- sprite )
@@ -78,9 +71,7 @@ C: sprite ( loc dim dim2 -- sprite )
 
 : sprite-width sprite-dim first ;
 
-: gray-texture ( sprite buffer -- id )
+: gray-texture ( sprite pixmap -- 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
@@ -90,12 +81,9 @@ C: sprite ( loc dim dim2 -- sprite )
         ] save-attribs
     ] keep ;
 
-: gen-dlist ( -- id )
+: gen-dlist ( -- id ) 1 glGenLists ;
-    #! Generate display list ID.
-    1 glGenLists ;
 
 : make-dlist ( type quot -- id )
-    #! Make a display list.
     gen-dlist [ rot glNewList call glEndList ] keep ; inline
 
 : init-texture ( -- )

core/ui/opengl/utilities.facts

@@ -0,0 +1,96 @@
+IN: opengl
+USING: help io kernel math ;
+
+HELP: gl-color
+{ $values { "color" "a color specifier" } }
+{ $description "Wrapper for " { $link glColor4d } " taking a color specifier." } ;
+
+HELP: gl-error
+{ $description "If the most recent OpenGL call resulted in an error, print the error to the " { $link stdio } " stream." } ;
+
+HELP: do-state
+{ $values { "what" integer } { "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." } ;
+
+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-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." } ;
+
+HELP: gl-fill-rect
+{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
+{ $description "Draws a filled rectangle with top-left corner " { $snippet "loc" } " and dimensions " { $snippet "dim" } "." } ;
+
+HELP: gl-rect
+{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
+{ $description "Draws the outline of a rectangle with top-left corner " { $snippet "loc" } " and dimensions " { $snippet "dim" } "." } ;
+
+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" "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } } { "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 wit ha 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." } ;
+
+HELP: save-attribs
+{ $values { "what" integer } { "quot" quotation } }
+{ $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ;
+
+HELP: sprite
+{ $class-description "A sprite is an OpenGL texture together with a display list which renders a textured quad. Sprites are used to draw text in the UI. Sprites have the following slots:"
+    { $list
+        { { $link sprite-dlist } " - an OpenGL display list ID" }
+        { { $link sprite-texture } " - an OpenGL texture ID" }
+        { { $link sprite-loc } " - top-left corner of the sprite" }
+        { { $link sprite-dim } " - dimensions of the sprite" }
+        { { $link sprite-dim2 } " - dimensions of the sprite, rounded up to the nearest powers of two" }
+    }
+} ;
+
+HELP: gray-texture
+{ $values { "sprite" sprite } { "pixmap" "an alien or byte array" } { "id" "an OpenGL texture ID" } }
+{ $description "Creates a new OpenGL texture from a 1 byte per pixel image whose dimensions are equal to " { $link sprite-dim2 } "." } ;
+
+HELP: gen-dlist
+{ $values { "id" integer } }
+{ $description "Wrapper for " { $link glGenLists } " to handle the common case of generating a single display list ID." } ;
+
+HELP: make-dlist
+{ $values { "type" "one of " { $link GL_COMPILE } " or " { $link GL_COMPILE_AND_EXECUTE } } { "quot" quotation } }
+{ $description "Compiles the results of calling the quotation into a new OpenGL display list." } ;
+
+HELP: gl-translate
+{ $values { "loc" "a pair of integers" } }
+{ $description "Wrapper for " { $link glTranslated } " taking a point object." } ;
+
+HELP: free-sprites
+{ $values { "sprites" "a sequence of " { $link sprite } " instances" } }
+{ $description "Deallocates native resources associated toa  sequence of sprites." } ;
+
+HELP: with-translation
+{ $values { "loc" "a pair of integers" } { "quot" quotation } }
+{ $description "Calls the quotation with a translation by " { $snippet "loc" } " pixels applied to the current " { $link GL_MODELVIEW } " matrix, restoring the matrix when the quotation is done." } ;

core/ui/text.factor

@@ -22,7 +22,7 @@ kernel math models namespaces opengl sequences strings ;
     [ text-width ] 2keep text-height 2array ;
 
 : font-sprites ( open-font world -- pair )
-    world-fonts [ lookup-font V{ } clone 2array ] cache ;
+    world-fonts [ open-font V{ } clone 2array ] cache ;
 
 : draw-string ( font string loc -- )
     >r >r world get font-sprites first2 r> r> (draw-string) ;

core/ui/text.facts

@@ -1,5 +1,60 @@
 IN: gadgets
-USING: help freetype strings ;
+USING: help freetype strings kernel styles alien opengl ;
+
+HELP: freetype
+{ $var-description "Global variable. Holds a native handle used by the FreeType library." }
+{ $see-also with-freetype } ;
+
+HELP: open-fonts
+{ $var-description "Global variable. Hashtable mapping font descriptors to " { $link font } " instances." }
+{ $see-also open-font } ;
+
+HELP: init-freetype
+{ $description "Initializes the FreeType library." }
+{ $notes "Do not call this word if you are using the UI." } ;
+
+HELP: font
+{ $class-description "A font which has been loaded by FreeType. Font instances have the following slots:"
+    { $list
+        { { $link font-ascent } ", " { $link font-descent } ", " { $link font-height } " - metrics." }
+        { { $link font-handle } " - alien pointer to an " { $snippet "FT_Face" } "." }
+        { { $link font-widths } " - sequence of character widths. Use " { $link char-width } " and " { $link string-width } " to compute string widths instead of reading this sequence directly." }
+    }
+}
+{ $see-also open-font char-width string-width text-dim draw-string draw-text } ;
+
+HELP: close-freetype
+{ $description "Closes the FreeType library." }
+{ $notes "Do not call this word if you are using the UI." } ;
+
+HELP: with-freetype
+{ $values { "quot" quotation } }
+{ $description "Sets up and tears down FreeType before and after calling the quotation. This word is re-entrant, so the quotation itself can call " { $link with-freetype } "." }
+{ $notes "Do not call this word if you are using the UI." } ;
+
+HELP: open-face
+{ $values { "font" string } { "style" "one of " { $link plain } ", " { $link bold } ", " { $link italic } " or " { $link bold-italic } } { "face" "alien pointer to an " { $snippet "FT_Face" } } }
+{ $description "Loads a TrueType font with the requested logical font name and style." }
+{ $notes "This is a low-level word. Call " { $link open-font } " instead." } ;
+
+HELP: open-font
+{ $values { "font" "a font specifier" } { "open-font" font } }
+{ $description "Loads a TrueType font if it has not already been loaded, otherwise outputs the existing " { $link font } " instance." }
+{ $errors "Throws an error if the font does not exist." } ;
+
+HELP: render-glyph
+{ $values  { "font" font } { "char" "a non-negative integer" } { "bitmap" alien } }
+{ $description "Renders a character and outputs a pointer to the bitmap." } ;
+
+HELP: <char-sprite>
+{ $values { "font" font } { "char" "a non-negative integer" } { "sprite" sprite } }
+{ $description "Renders a character to an OpenGL texture and records a display list which draws a quad with this texture. This word allocates native resources which must be freed by " { $link free-sprites } "." } ;
+
+HELP: (draw-string)
+{ $values { "open-font" font } { "sprites" "a vector of " { $link sprite } " instances" } { "string" string } { "loc" "a pair of integers" } }
+{ $description "Draws a line of text." }
+{ $notes "This is a low-level word, UI code should use " { $link draw-string } " or " { $link draw-text } " instead." }
+{ $side-effects "sprites" } ;
 
 HELP: string-width
 { $values { "open-font" "an instance of " { $link font } } { "string" string } { "w" "a positive integer" } }
@@ -13,10 +68,10 @@ HELP: text-dim
 
 HELP: draw-string
 { $values { "font" "a font specifier" } { "string" string } { "loc" "a pair of integers" } }
-{ $description "Draws a string. This word can only be called from a " { $link draw-gadget* } ", " { $link draw-interior } " or " { $link draw-boundary } " method." }
+{ $description "Draws a line of text." }
 { $see-also open-font draw-text } ;
 
 HELP: draw-text
 { $values { "font" "a font specifier" } { "text" "a string or an array of strings" } { "loc" "a pair of integers" } }
-{ $description "Draws a piece of text, which is either a single-line string or an array of lines. This word can only be called from a " { $link draw-gadget* } ", " { $link draw-interior } " or " { $link draw-boundary } " method." }
+{ $description "Draws text. Text is either a single-line string or an array of lines." }
 { $see-also open-font draw-text } ;

core/ui/text/editor.factor

@@ -63,7 +63,7 @@ M: editor model-changed
 
 : editor-line ( n editor -- str ) control-value nth ;
 
-: editor-font* ( editor -- font ) editor-font lookup-font ;
+: editor-font* ( editor -- font ) editor-font open-font ;
 
 : line-height ( editor -- n )
     editor-font* font-height ;