Added FreeType example

src/FreeType.cake

@@ -1,18 +1,89 @@
+(c-import
+ ;; Included only for FT_BEGIN_HEADER etc.
+ ;; Normally we are "supposed" to include the headers via the defines, but that would break the build
+ ;; system's ability to find dependent headers to scan.
+ "freetype/config/ftheader.h"
+ "freetype/freetype.h")
+
 (comptime-cond
  ('auto-test
+  (c-import "<stdio.h>")
+
+  (defmacro freetype-check-result-or-return (result symbol while-doing string)
+    (tokenize-push output
+      (unless (= (token-splice result) FT_Err_Ok)
+        (fprintf stderr "error: encountered error %d while %s\n" (token-splice result)
+                 (token-splice while-doing))
+        (return 1)))
+    (return true))
+
   (defun test--freetype (&return int)
-    (return 1))))
+    (var freetype-library FT_Library)
+    (var result int
+      (FT_Init_FreeType (addr freetype-library)))
+    (freetype-check-result-or-return result "initializing FreeType")
+
+    (var typeface FT_Face)
+    (var face-index int 0)
+    (var load-font (* (const char)) "data/Fonts/Ubuntu-R.ttf")
+    (set result (FT_New_Face freetype-library load-font face-index (addr typeface)))
+    (unless (= result FT_Err_Ok)
+      (fprintf stderr "error: encountered error %d while loading font %s\n" result load-font)
+      (return 1))
+
+    (set result (FT_Set_Char_Size
+                 typeface    ;; handle to face object
+                 0       ;; char_width in 1/64th of points
+                 (* 16 64)   ;; char_height in 1/64th of points
+                 300     ;; horizontal device resolution
+                 300))   ;; vertical device resolution
+
+    (freetype-check-result-or-return result "setting character size")
+
+    (var glyph-index-y int (FT_Get_Char_Index typeface 'g'))
+    (unless glyph-index-y
+      (fprintf stderr "error: could not find glyph 'g' in font\n")
+      (return 1))
+
+    (set result (FT_Load_Glyph typeface glyph-index-y FT_LOAD_DEFAULT))
+    (freetype-check-result-or-return result "loading glyph")
+
+    ;; One slot for the whole face
+    (set result (FT_Render_Glyph (path typeface > glyph) FT_RENDER_MODE_NORMAL))
+    (freetype-check-result-or-return result "rendering glyph")
+
+    (var num-rows int (path typeface > glyph > bitmap . rows))
+    (var num-columns int (path typeface > glyph > bitmap . width))
+    (each-in-range num-rows row
+      (each-in-range num-columns column
+        (var current-pixel (* (unsigned char))
+          (addr
+           (at (+ column (* row num-columns))
+               (path typeface > glyph > bitmap . buffer))))
+        (fprintf stderr "%c" (? (> (deref current-pixel) 128) '#' '.')))
+      (fprintf stderr "\n"))
+
+    (FT_Done_Face typeface)
+    (FT_Done_FreeType freetype-library)
+
+    (return 0))))
 
 ;;
 ;; Building
 ;;
 
+(add-dependency-git-submodule
+ clone-freetype
+ "https://gitlab.freedesktop.org/freetype/freetype.git"
+ "Dependencies/FreeType")
+
 (defun-comptime build-freetype (manager (& ModuleManager) module (* Module) &return bool)
   (comptime-cond
    ('Windows
     (comptime-error "Need to add Windows support to FreeType"))
 
    ('Unix
+    ;; TODO: These paths are duplicated elsewhere in this file
     (var freetype-build-dir (* (const char)) "cakelisp_cache/FreeTypeBuildDir")
     (var freetype-install-dir ([] 1024 char) (array 0))
     (SafeSnprintf freetype-install-dir (array-size freetype-install-dir)
@@ -90,7 +161,6 @@
   (return true))
 (add-compile-time-hook-module pre-build build-freetype)
 
-(add-dependency-git-submodule
- clone-freetype
- "https://gitlab.freedesktop.org/freetype/freetype.git"
- "Dependencies/FreeType")
+(export-and-evaluate
+ (add-c-search-directory-module
+  "cakelisp_cache/FreeTypeBuildDir/install/include/freetype2"))