Font and texture resource loading
This commit is contained in:
parent
3f0e1985b3
commit
9f1bde8ac6
7 changed files with 256 additions and 16 deletions
|
|
@ -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)))
|
||||
)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue