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
+	(engine core)
 	(engine guards)
 	(engine 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

@@ -0,0 +1,48 @@
+(module (engine resource) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	(chicken gc)
+	raylib
+	(srfi 69)
+	(engine core))
+
+(export font)
+(define fonts (make-hash-table))
+
+(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)))
+
+(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)))
+)

samples/resources/OFL.txt

@@ -0,0 +1,93 @@
+Copyright (c) 2010, Kimberly Geswein (kimberlygeswein.com)
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+https://openfontlicense.org
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

samples/textures.scm

@@ -0,0 +1,50 @@
+(module (textures) ()
+(import scheme
+	raylib
+	(chicken base)
+	(engine core)
+	(engine resource)
+	(engine scene)
+	(engine math)
+	(engine drawing))
+
+(define draw-smiley
+  (make-system
+   'draw-smiley
+   0
+   'global
+   '()
+   (lambda ()
+     (push-render-object 'screen
+			 0
+			 (lambda ()
+			   (draw-texture-2d
+			    (vec 0 0)
+			    (texture "../samples/resources/smiley.png")
+			    (make-color 1 1 1 1)))))))
+
+(define draw-smiley-text
+  (make-system
+   'draw-text
+   0
+   'global
+   '()
+   (lambda ()
+     (push-render-object 'screen
+			 1
+			 (lambda ()
+			   (draw-font-text-2d
+			    (vec 100 500)
+			    "Hello there..."
+			    64
+			    (make-color 0 0 0 1)
+			    (font "../samples/resources/NothingYouCouldDo.ttf")))))))
+
+(define (demo)
+  (scene
+   draw-smiley
+   draw-smiley-text))
+
+((demo))
+(create-window)
+)