From bb1baae5c6c9ba1f1bba26696920e272df6bee85 Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Mon, 27 Jun 2022 09:56:09 -0500
Subject: [add] text and font classes; [modify] get-asset to pass more args
---
examples/03-font-render.lisp | 83 ++++++++++++++++--------------------------
examples/Ticketing.ttf | Bin 0 -> 116772 bytes
wheelwork.lisp | 85 +++++++++++++++++++++++++++++++++++++++++--
3 files changed, 112 insertions(+), 56 deletions(-)
create mode 100644 examples/Ticketing.ttf
diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp
index f26f0d0..6e1637a 100644
--- a/examples/03-font-render.lisp
+++ b/examples/03-font-render.lisp
@@ -1,58 +1,37 @@
-(defun make-shader ()
- (wheelwork::create-shader
- '(:vertex
- ((vert :vec2) (col :vec2))
- ()
- ((values
- (vari:vec4
- (* 0.008 vert) 0.0 1.0)
- col)))
- '(:fragment
- ((tc :vec2))
- ((tex :sampler-2d))
- ((* (vari:vec4 1.0 1.0 1.0 1.0) (aref (vari:texture tex tc) 0))))))
+(defpackage #:ww.example/3
+ (:use :cl))
+
+(in-package #:ww.example/3)
+
+
+(defclass font-display (ww::application) ())
+
+(defmethod ww::boot ((app font-display))
+ (let ((hello
+ (make-instance
+ 'ww::text
+ :content "Hell! Oh World..."
+ :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2)))))
+
+ (setf (ww::unit-width hello)
+ (* 5 (ww::unit-width hello))
+
+ (ww::unit-height hello)
+ (* 5 (ww::unit-height hello))
+
+ (ww::unit-x hello) 100
+
+ (ww::unit-y hello) 100)
+
+ (ww::add-unit app hello)))
+
(defun start ()
- (sdl2:with-init (:everything)
- (sdl2:gl-set-attr :context-major-version 3)
- (sdl2:gl-set-attr :context-minor-version 3)
- (sdl2:gl-set-attr :context-profile-mask
- sdl2-ffi:+sdl-gl-context-profile-core+)
- (sdl2:gl-set-attr :doublebuffer 1)
- (sdl2:with-window (window
- :flags '(:shown :opengl)
- :title "Font Example")
- (sdl2:with-gl-context (ctx window)
- (sdl2:gl-make-current window ctx)
- (gl:viewport 0 0 800 800)
- (gl:enable :depth-test)
- (let* ((font
- (cl-fond:make-font
- #P"~/projects/INACTIVE/wwb-haxe/Assets/Ticketing.ttf"
- "ABCDEFGHJIJKLMNOPQRSTUVWXYZabcdefhgjijklmnopqrstuvwxyz0123456789 ,.!?:;-+/\\"))
- (shader
- (make-shader)))
- (gl:program-uniformi shader (gl:get-uniform-location shader "TEX") 0)
- (multiple-value-bind (vao elems) (cl-fond:compute-text font "Hey Man")
- (print (list :vao vao :elems elems))
- (sdl2:with-event-loop (:method :poll)
- (:idle ()
- (gl:clear-color 0.0 0.0 0.0 1.0)
- (gl:clear :depth-buffer-bit :color-buffer-bit)
- (gl:use-program shader)
- (gl:active-texture 0)
- (gl:bind-texture :texture-2d (cl-fond:texture font))
- (gl:bind-vertex-array vao)
- (%gl:draw-elements :triangles
- elems
- :unsigned-int 0)
- (gl:bind-vertex-array 0)
- (sdl2:gl-swap-window window)
- (setf got-here t))
- (:quit ()
- (gl:delete-vertex-arrays (list vao))
- t))))))))
+ (ww::start (make-instance 'font-display
+ :title "Wheelwork Example: Font display"
+ :asset-root "~/projects/wheelwork/examples/")))
+
diff --git a/examples/Ticketing.ttf b/examples/Ticketing.ttf
new file mode 100644
index 0000000..93cf864
Binary files /dev/null and b/examples/Ticketing.ttf differ
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
--
cgit v1.2.3