Font and texture resource loading

engine/core.scm

@@ -429,11 +429,55 @@
 	(end-mode-3d)))
     (hash-table-set! render-queues queue-name '())))
 
+;; Resource queue
+(export resource-load-queue resource-unload-queue)
+(define resource-load-queue '())
+(define resource-unload-queue '())
+
+(export make-resource resource? resource-type resource-contents resource-initialized? resource-initializer resource-finalizer set-resource-contents! set-resource-initialized!)
+(define-record-type <resource>
+  (int:make-resource type struct initialized? initializer finalizer)
+  resource?
+  (type resource-type)
+  (struct resource-contents set-resource-contents!)
+  (initialized? resource-initialized? set-resource-initialized!)
+  (initializer resource-initializer)
+  (finalizer resource-finalizer))
+
+(define (add-resource res)
+  (assert (resource? res))
+  (set! resource-load-queue (cons res resource-load-queue)))
+
+(define (make-resource type struct initialized? initializer finalizer)
+  (assert (member type '(font texture)))
+  (assert (boolean? initialized?))
+  (assert (procedure? initializer))
+  (assert (procedure? finalizer))
+  (let ((r (int:make-resource type struct initialized? initializer finalizer)))
+    (add-resource r)
+    r))
+
+(define (load-queued-resources)
+  (for-each
+   (lambda (res)
+     ((resource-initializer res) res)
+     (set! resource-unload-queue (cons res resource-unload-queue)))
+   resource-load-queue)
+  (set! resource-load-queue '()))
+
+(define (unload-queued-resources)
+  (for-each
+   (lambda (res)
+     ((resource-finalizer res) res))
+   resource-unload-queue)
+  (set! resource-unload-queue '()))
+
 ;; Frame generation and game loop
 (export resolve-queues next-frame *clear-color* perform-render)
 
 ;; Resolve the entity and system queues. This is exported which allows breaking iteration
 (define (resolve-queues)
+  (load-queued-resources)
   (resolve-entity-queue)
   (resolve-system-queue))
 
@@ -483,5 +527,6 @@
     (process)
     (unless (close-predicate)
       (loop)))
+  (unload-queued-resources)
   (close-window))
 )

engine/drawing.scm

@@ -3,6 +3,7 @@
 	(chicken base)
 	(chicken module)
 	raylib
+	(imugi core)
 	(imugi guards)
 	(imugi math)
 	(srfi 4)
@@ -237,7 +238,7 @@
 
 ;; Drawing functions
 ;; Helper wrappers for raylib functions
-(export draw-circle-2d draw-rectangle-2d draw-text-2d)
+(export draw-circle-2d draw-rectangle-2d draw-text-2d draw-texture-2d draw-font-text-2d)
 (define (draw-circle-2d pos-vec radius color filled)
   (assert (vec2? pos-vec))
   (assert (number? radius))
@@ -282,4 +283,32 @@
 	     (number->integer (v-y pos-vec))
 	     size
 	     (use-color tint)))
+
+(define (draw-font-text-2d pos-vec text size tint font)
+  (assert (vec2? pos-vec))
+  (assert (string? text))
+  (assert (resource? font))
+  (assert (eqv? 'font (resource-type font)))
+  (assert ((conjoin integer? positive?) size))
+  (assert (color? tint))
+  (when (resource-initialized? font)
+    (draw-text-ex
+     (resource-contents font)
+     text
+     (make-vec2 (number->integer (v-x pos-vec))
+		(number->integer (v-y pos-vec)))
+     size
+     1
+     (use-color tint))))
+
+(define (draw-texture-2d pos-vec texture color)
+  (assert (vec2? pos-vec))
+  (assert (resource? texture))
+  (assert (eqv? 'texture (resource-type texture)))
+  (assert (color? color))
+  (when (resource-initialized? texture)
+    (draw-texture (resource-contents texture)
+		  (number->integer (v-x pos-vec))
+		  (number->integer (v-y pos-vec))
+		  (use-color color))))
 )

engine/resource.scm

@@ -1,25 +1,48 @@
 (module (engine resource) ()
 (import scheme
 	(chicken base)
+	(chicken module)
 	(chicken gc)
 	raylib
-	(srfi 99))
+	(srfi 69)
+	(engine core))
 
-(define-record-type <resource>
-  (int:make-resource type struct)
-  resource?
-  (type int:resource-type)
-  (struct int:resource-contents))
+(export font)
+(define fonts (make-hash-table))
 
-(define (resource-finalizer type)
-  (case type
-    ((font) unload-font)
-    (else identity)))
+(define (font filename)
+  (assert (string? filename))
+  (if (hash-table-exists? fonts filename)
+      (hash-table-ref fonts filename)
+      (let ((f (make-resource 'font '()
+			      #f
+			      (lambda (res)
+				(set-resource-contents! res (load-font filename))
+				(set-resource-initialized! res #t))
+			      (lambda (res)
+				(hash-table-delete! fonts filename)
+				(unload-font (resource-contents res))
+				(set-resource-initialized! res #f)))))
+	(hash-table-set! fonts filename f)
+	f)))
 
-(define (make-resource type struct)
-  (assert (member type '(texture font)))
-  (assert (record? struct))
-  (let ((r (int:make-resource type struct)))
-    (set-finalizer! r (lambda (x) ((resource-finalizer type) x)))))
+(export texture)
+(define textures (make-hash-table))
 
+(define (texture filename)
+  (assert (string? filename))
+  (if (hash-table-exists? textures filename)
+      (hash-table-ref textures filename)
+      (let ((t (make-resource 'texture '()
+			      #f
+			      (lambda (res)
+				(set-resource-contents! res (load-texture filename))
+				(set-resource-initialized! res #t))
+			      (lambda (res)
+				(hash-table-delete! textures filename)
+				;; TODO: uncomment this when possible
+				;; (unload-texture (resource-contents res)) ; at time of writing, this is not yet in the raylib egg
+				(set-resource-initialized! res #f)))))
+	(hash-table-set! textures filename t)
+	t)))
 )