Merge pull request #97 from FolkComputer/arcade/more-fonts

Add the ability to load more fonts!

2 files changed, 40 insertions, 9 deletions

diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index f7b70959..f92afb67 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -112,7 +112,6 @@ On process {
             namespace export *
             namespace ensemble create
         }
-        variable font [font load "PTSans-Regular"]
         variable glyphMsd [Gpu::fn {sampler2D atlas vec4 atlasGlyphBounds vec2 glyphUv} vec4 {
             vec2 atlasUv = mix(atlasGlyphBounds.xw, atlasGlyphBounds.zy, glyphUv);
             return texture(atlas, vec2(atlasUv.x, 1.0-atlasUv.y));
@@ -214,8 +213,26 @@ On process {
             Gpu::draw $circle [list $x $y] $radius $thickness [getColor $color] [ne $filled "false"]
         }
 
-        proc textExtent {text scale} {
-            variable font
+        set ::FontCache [dict create]
+
+        # load all fonts into the fontCache
+        foreach fontPath [list {*}[glob {*}vendor/fonts/*.png]] {
+            set fontName ""
+            regexp {vendor/fonts/(.*).png} $fontPath whole_match fontName
+            if {!($fontName eq "")} {
+                puts "Loaded $fontName into font cache"
+                set fontdata [font load $fontName]
+                dict set ::FontCache $fontName $fontdata
+            }
+        }
+
+        proc textExtent {text scale {font "PTSans-Regular"}} {
+            if {!([dict exists $::FontCache $font])} {
+                throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist"
+                return
+            }
+            set font [dict get $::FontCache $font]
+
             set em [* $scale 25.0]
             set x 0; set y 0
             set width 0
@@ -236,8 +253,14 @@ On process {
             }
             return [list $width [+ $y $em]]
         }
-        proc text {x0 y0 scale text radians} {
-            variable font
+        proc text {x0 y0 scale text radians {font "PTSans-Regular"}} {
+            if {!([dict exists $::FontCache $font])} {
+                throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist"
+                return
+            }
+            set font [dict get $::FontCache $font]
+        
+
             variable glyph
             set fontAtlas [font gpuAtlasImage $font]
             set fontAtlasSize [list [::image width [font atlasImage $font]] \
@@ -336,7 +359,7 @@ On process {
             return vec4(0.0, 0.0, 0.0, 0.0);
         }]
         variable imCache [dict create]
-        variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES 1]
+        variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES [dict size $::FontCache]]
         proc checkImCacheAndCopyIfNeeded {imDrawSet} {
             variable imCache
             variable IMCACHE_MAX_IMAGES
@@ -452,7 +475,10 @@ On process {
 
         set renderTime [baretime {
             Display::start
-            foreach command $displayCommands { {*}$command }
+            foreach command $displayCommands {
+                try { {*}$command } \
+                    on error e { puts stderr $::errorInfo }
+            }
             Display::end
         }]
 
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index ad5e406f..18c6e139 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -4,15 +4,20 @@ When /thing/ has region /region/ {
     # set height [region height $region]
     set radians [region angle $region]
 
-    When the collected matches for [list /someone/ wishes $thing is labelled /text/] are /matches/ {
+    When the collected matches for [list /someone/ wishes $thing is labelled /text/ with font /font/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }
 
         set scale 1
-        Display::text $x $y $scale $text $radians
+        Display::text $x $y $scale $text $radians [dict get $match font]
     }
 }
 
+When /someone/ wishes /thing/ is labelled /text/ {
+  # Set the default font
+  Wish $thing is labelled $text with font "PTSans-Regular"
+}
+
 fn text {coords text angle} {
   Display::text [lindex $coords 0] [lindex $coords 1] 2 $text $angle
 }