Move resource methods into resource system

audio/buffer.lisp

@@ -44,7 +44,7 @@
 
 (defun make-audio-buffer (resource)
   (make-instance 'audio-buffer
-                 :channel-format (audio-channel-format-of resource)
-                 :sample-depth (audio-sample-depth-of resource)
-                 :sampling-rate (audio-sampling-rate-of resource)
-                 :pcm-data (pcm-audio-data-of resource)))
+                 :channel-format (ge.rsc:audio-channel-format resource)
+                 :sample-depth (ge.rsc:audio-sample-depth resource)
+                 :sampling-rate (ge.rsc:audio-sampling-rate resource)
+                 :pcm-data (simple-array-of (ge.rsc:audio->foreign-array resource))))

canvas/canvas.lisp

@@ -3,15 +3,28 @@
 
 (declaim (special *canvas*))
 
+
 (defclass canvas (disposable)
-  ((handle :initarg :handle :reader %handle-of)))
+  ((handle :initarg :handle :reader %handle-of)
+   (image-cache :initform (make-hash-table :test #'eq))))
 
 
-(define-destructor canvas (handle)
+(define-destructor canvas (handle image-cache)
   (run (for-graphics ()
+         (flet ((%destroy-image (image value)
+                  (declare (ignore value))
+                  (when (remhash image image-cache)
+                    (bodge-canvas:destroy-image handle image))))
+           (maphash #'%destroy-image image-cache))
          (bodge-canvas:destroy-canvas handle))))
 
 
+(define-system-function make-canvas graphics-system
+    (canvas-class width height &key (pixel-ratio 1.0) (antialiased t))
+  (make-instance canvas-class
+                 :handle (bodge-canvas:make-canvas width height :pixel-ratio pixel-ratio
+                                                                :antialiased antialiased)))
+
 (defun render-canvas (canvas renderer)
   (let ((*canvas* canvas))
     (bodge-canvas:with-preserved-state (:blend-enabled t
@@ -35,11 +48,20 @@
              (render-canvas ,this #'%render)))))))
 
 
-(define-system-function make-canvas graphics-system
-    (canvas-class width height &key (pixel-ratio 1.0) (antialiased t))
-  (make-instance canvas-class
-                 :handle (bodge-canvas:make-canvas width height :pixel-ratio pixel-ratio
-                                                                :antialiased antialiased)))
+(defun make-canvas-image (canvas image)
+  (with-slots (image-cache) canvas
+    (let ((image (bodge-canvas:make-rgba-image (%handle-of canvas)
+                                               (simple-array-of (ge.rsc:image->foreign-array image))
+                                               (ge.rsc:image-width image)
+                                               (ge.rsc:image-height image))))
+      (setf (gethash image image-cache) image))))
+
+
+(defun destroy-canvas-image (canvas image)
+  (with-slots (image-cache) canvas
+    (when (remhash image image-cache)
+      (run (for-graphics ()
+             (bodge-canvas:destroy-image (%handle-of canvas) image))))))
 
 
 (defun canvas-width (&optional (canvas *canvas*))
@@ -73,3 +95,11 @@
 
 (defun update-canvas-pixel-ratio (canvas pixel-ratio)
   (bodge-canvas:update-canvas-pixel-ratio (%handle-of canvas) pixel-ratio))
+
+
+(define-system-function make-image-paint graphics-system (canvas image)
+  (let* ((image (make-canvas-image canvas image))
+         (paint (bodge-canvas:make-image-paint image)))
+    (flet ((%destroy-image ()
+             (destroy-canvas-image canvas image)))
+      (trivial-garbage:finalize paint #'%destroy-image))))

canvas/packages.lisp

@@ -1,5 +1,5 @@
 (bodge-util:define-package :cl-bodge.canvas
-    (:nicknames :ge.vg)
+  (:nicknames :ge.vg)
   (:use :cl :cl-bodge.engine :bodge-util :cl-bodge.graphics)
   (:reexport-from :bodge-canvas
                   #:with-retained-canvas
@@ -36,6 +36,9 @@
                   #:scale-canvas
                   #:reset-canvas-transform
 
+                  #:image-paint-width
+                  #:image-paint-height
+
                   #:draw-text
                   #:make-font
                   #:make-default-font
@@ -52,6 +55,9 @@
            #:update-canvas-size
            #:update-canvas-pixel-ratio
 
+           #:make-image-paint
+
+           #:register-font-face
            #:canvas-font-metrics
            #:canvas-text-bounds
            #:canvas-text-advance))

cl-bodge.asd

@@ -11,9 +11,6 @@
   :pathname "engine/"
   :serial t
   :components ((:file "packages")
-               (:module resources
-                :components ((:file "audio")
-                             (:file "graphics")))
                (:module events
                 :components ((:file "event")
                              (:file "emitter")
@@ -115,7 +112,8 @@
   :mailto "dev@borodust.org"
   :license "MIT"
   :depends-on (cl-bodge/engine bodge-utilities cl-bodge/graphics
-                               bodge-canvas cl-bodge/resources)
+                               bodge-canvas cl-bodge/resources
+                               trivial-garbage)
   :pathname "canvas/"
   :serial t
   :components ((:file "packages")
@@ -144,6 +142,7 @@
   :mailto "dev@borodust.org"
   :license "MIT"
   :depends-on (cl-bodge/engine bodge-utilities cl-bodge/host log4cl
+                               cl-bodge/resources
                                openal-blob bodge-openal)
   :pathname "audio/"
   :serial t

engine/packages.lisp

@@ -1,24 +1,3 @@
-(bodge-util:define-package :cl-bodge.engine.resources
-  (:nicknames :ge.ng.rsc)
-  (:use :cl :bodge-util)
-  (:export pixel-format
-           pixel-format-p
-
-           pixel-format-of
-           foreign-array-of
-           width-of
-           height-of
-
-           pcm-data
-           sample-depth
-           channel-format
-
-           pcm-audio-data-of
-           audio-channel-format-of
-           audio-sample-depth-of
-           audio-sampling-rate-of))
-
-
 (bodge-util:define-package :cl-bodge.events
   (:nicknames :ge.eve)
   (:use :cl :bodge-util :bodge-concurrency :cl-flow :bodge-memory)
@@ -48,8 +27,7 @@
   (:use-reexport
    :bodge-concurrency
    :bodge-memory
-   :bodge-math
-   :cl-bodge.engine.resources)
+   :bodge-math)
   (:reexport-from :flow
                   #:->
                   #:>>

resources/audio.lisp

@@ -1,26 +1,50 @@
 (cl:in-package :cl-bodge.resources)
 
 
+(deftype pcm-data ()
+  '(or (simple-array (unsigned-byte 8) (*))
+    (simple-array (signed-byte 16) (*))
+    (simple-array (signed-byte 32) (*))
+    (simple-array single-float (*))
+    (simple-array double-float (*))))
+
+
+(deftype sample-depth ()
+  '(member 8 16))
+
+
+(defenum channel-format
+  :mono :stereo)
+
+
+(defgeneric audio->foreign-array (resource))
+(defgeneric audio-channel-format (resource))
+(defgeneric audio-sample-depth (resource))
+(defgeneric audio-sampling-rate (resource))
+
+
 (defclass audio ()
   ((channel-format :initarg :channel-format :initform nil
-                   :type channel-format :reader audio-channel-format-of)
+                   :type channel-format :reader audio-channel-format)
    (sample-depth :initarg :sample-depth :initform nil
-                 :type sample-depth :reader audio-sample-depth-of)
+                 :type sample-depth :reader audio-sample-depth)
    (sampling-rate :initarg :sampling-rate :initform nil
-                  :type positive-integer :reader audio-sampling-rate-of)))
+                  :type positive-integer :reader audio-sampling-rate)))
 
 
 (defclass pcm-16-audio (audio) ()
   (:default-initargs :sample-depth 16))
 
 
 (defclass cached-pcm-16-audio (pcm-16-audio)
-  ((samples :initarg :samples :reader pcm-audio-data-of)))
+  ((samples :initarg :samples :reader audio->foreign-array)))
 
 
 (defun make-cached-pcm-16-audio (file)
   (make-instance 'cached-pcm-16-audio
-                 :samples (sndfile:read-short-samples-into-array file)
+                 :samples (let ((samples (sndfile:read-short-samples-into-array file)))
+                            (make-foreign-array (length samples) :element-type '(signed-byte 16)
+                                                                 :initial-contents samples))
                  :sampling-rate (sndfile:sound-sample-rate file)
                  :channel-format (ecase (sndfile:sound-channels file)
                                    (1 :mono)
@@ -45,12 +69,12 @@
 
 
 (defmethod encode-resource ((this audio-resource-handler) (audio cached-pcm-16-audio) stream)
-  (sndfile:write-short-samples-into-stream stream (pcm-audio-data-of audio)
-                                                 :format :flac
-                                                 :channels (ecase (audio-channel-format-of audio)
-                                                             (:mono 1)
-                                                             (:stereo 2))
-                                                 :sample-rate (audio-sampling-rate-of audio)))
+  (sndfile:write-short-samples-into-stream stream (simple-array-of (audio->foreign-array audio))
+                                           :format :flac
+                                           :channels (ecase (audio-channel-format audio)
+                                                       (:mono 1)
+                                                       (:stereo 2))
+                                           :sample-rate (audio-sampling-rate audio)))
 
 
 (defmethod make-resource-handler ((type (eql :audio)) &key)

resources/image.lisp

@@ -1,20 +1,33 @@
 (cl:in-package :cl-bodge.resources)
 
+;;;
+;;;
+;;;
+(defenum pixel-format
+  :grey :rgb :rgba)
+
+;;;
+;;;
+;;;
+(defgeneric image-pixel-format (image))
+(defgeneric image-width (image))
+(defgeneric image-height (image))
+(defgeneric image->foreign-array (image))
+
 
 (defclass image ()
-  ((width :initarg :width :reader width-of)
-   (height :initarg :height :reader height-of)
-   (format :initarg :pixel-format :reader pixel-format-of)
-   (data :initarg :data :reader data-of)))
+  ((width :initarg :width :reader image-width)
+   (height :initarg :height :reader image-height)
+   (format :initarg :pixel-format :reader image-pixel-format)
+   (data :initarg :data :reader image->foreign-array)))
 
 
 (defun prepare-png-data (width height pixel-format data)
   (loop with channels = (ecase pixel-format
                           (:grey 1)
                           (:rgb 3)
                           (:rgba 4))
-        with result = (make-foreign-array (* width height channels)
-                                          :element-type '(unsigned-byte 8))
+        with result = (make-foreign-array (* width height channels) :element-type '(unsigned-byte 8))
         with array = (simple-array-of result)
         for i from 0 below height
         do (loop for j from 0 below width
@@ -28,9 +41,9 @@
 
 
 (defun unwind-png-data (image data)
-  (let ((width (width-of image))
-        (height (height-of image))
-        (array (simple-array-of (data-of image))))
+  (let ((width (image-width image))
+        (height (image-height image))
+        (array (simple-array-of (image->foreign-array image))))
     (loop with channels = (ecase (pixel-format-of image)
                             (:grey 1)
                             (:rgb 3)
@@ -85,10 +98,6 @@
     (read-image-from-stream stream :jpeg)))
 
 
-(defmethod foreign-array-of ((this image))
-  (data-of this))
-
-
 ;;;
 ;;; Image resource
 ;;;

resources/packages.lisp

@@ -29,9 +29,19 @@
 
            ;; audio
            load-ogg-vorbis-audio
+           audio-channel-format
+           audio-sample-depth
+           audio-sampling-rate
+           audio->foreign-array
 
            ;; images
            load-png-image
+           image-width
+           image-height
+           pixel-format
+           pixel-format-p
+           image-pixel-format
+           image->foreign-array
 
            ;; chunked
            write-chunk