[add] text and font classes; [modify] get-asset to pass more args

1 files changed, 81 insertions, 4 deletions

diff --git a/wheelwork.lisp b/wheelwork.lisp
index bf02302..c03a444 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -611,16 +611,93 @@ class should be a subclass of ASSET.  Additional clases can be added
 to the application's ASSET-CLASSIFIERS association list."
   (second (assoc (pathname-type asset-id) (asset-classifiers app) :test #'string-equal)))
 
-(defun get-asset (asset-id &optional (app *application*))
+(defun get-asset (asset-id &key (app *application*) asset-args)
   "ASSET-ID is a pathname namestring relative to the application's
 ASSET-ROOT. GET-ASSET retrieves an already-available asset from the
 application's ASSETS table, or, if not available, loads the asset from
-disk."
+disk.
+
+ASSET-ARGS is a plist to pass to make-instance for the given resource.
+"
   (or (gethash asset-id (application-assets app))
       (setf (gethash asset-id (application-assets app))
             (ensure-loaded
-             (make-instance (asset-class-for asset-id)
-                            :path (uiop:merge-pathnames* asset-id (asset-root app)))))))
+             (apply 'make-instance
+                    (asset-class-for asset-id)
+                    :path (uiop:merge-pathnames* asset-id (asset-root app))
+                    asset-args)))))
+
+(define-symbol-macro +standard-font-chars+
+  " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz01234567890\".,!?-'"  )
+
+(defclass/std font (asset)
+  ((characters :i :std +standard-font-chars+)
+   (oversample :i :doc "ovesampling factor to pass to cl-fond:make-font")
+   (object :with :r :doc "The font as returned from cl-fond:make-font")))
+
+(defmethod ensure-loaded ((font font))
+  (with-slots (path characters oversample object) font
+    (setf object (cl-fond:make-font path characters :oversample oversample))))
+
+
+(defclass/std text (unit interactive)
+  ((font :with :ri :std (error "A font is required") :type font)
+   (content :with :ri :std "")
+   (color :with :ri :std #(1.0 1.0 1.0 1.0))
+   (vao elem-count :r)
+   (shader :with :static :r)))
+
+(defmethod initialize-instance :after ((text text) &key)
+  (with-slots (content font vao elem-count shader) text
+    (unless shader
+      (setf shader
+            (create-shader
+             '(:vertex
+               ((vert :vec2) (col :vec2))
+               ((transform :mat4))
+               ((values
+                 (* transform (vari:vec4 vert 0.0 1.0))
+                 col)))
+             '(:fragment
+               ((tc :vec2))
+               ((tex :sampler-2d)
+                (color :vec4))
+               ((* color (aref (vari:texture tex tc) 0)))))))
+    (multiple-value-bind (vao% count%) (cl-fond:compute-text (font-object font) content)
+      (setf vao vao%
+            elem-count count%))))
+
+(defmethod cleanup ((text text))
+  (with-slots (vao shader) text
+    (gl:delete-vertex-arrays (list vao))
+    (when shader
+      (gl:delete-program shader))
+    (setf vao nil
+          shader nil)))
+
+(defmethod render ((text text))
+  (with-slots (shader font vao elem-count color) text
+    (gl:use-program shader)
+    (gl:active-texture 0)
+    (gl:bind-texture :texture-2d (cl-fond:texture (font-object font)))
+    (gl:program-uniform-matrix-4fv
+     shader
+     (gl:get-uniform-location shader "TRANSFORM")
+     (projected-matrix text))
+    (gl:program-uniformi
+     shader
+     (gl:get-uniform-location shader "TEX")
+     0)
+    (gl:program-uniformfv
+     shader
+     (gl:get-uniform-location shader "COLOR")
+     color)
+    (gl:bind-vertex-array vao)
+    (%gl:draw-elements :triangles elem-count :unsigned-int 0)
+    (gl:bind-vertex-array 0)))
+
+
+
 
 (defmacro defhandler (name handler)
   "Defines a handler - binds (FDEFINITION NAME) to HANDLER, which