diff options
| -rw-r--r-- | examples/03-font-render.lisp | 83 | ||||
| -rw-r--r-- | examples/Ticketing.ttf | bin | 0 -> 116772 bytes | |||
| -rw-r--r-- | wheelwork.lisp | 85 |
3 files changed, 112 insertions, 56 deletions
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 Binary files differnew file mode 100644 index 0000000..93cf864 --- /dev/null +++ b/examples/Ticketing.ttf 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 |