(defpackage #:ww.examples/3 (:use #:cl) (:export #:start)) (in-package #:ww.examples/3) (defclass font-display (ww::application) ()) (defun random-text-color () (make-array 4 :initial-contents (list (random 1.0) (random 1.0) (random 1.0) 1.0))) (ww::defhandler change-text-color (ww::on-keydown () "Press any key to change the color of the text" (format t "Pressed a key, changing the color~%") (setf (ww::text-color target) (random-text-color)) (with-accessors ((x ww::x) (y ww::y) (w ww::unit-width) (h ww::unit-height)) target (format t "x:~a,y:~a,width:~a,height:~a~%" x y w h)))) (ww::defhandler marquee (ww::on-perframe () (when (< 900 (ww::x target)) (setf (ww::x target) -800)) (incf (ww::x target) 5 ))) (defvar *spin-table* (make-hash-table :synchronized t)) (ww::defhandler spin (ww::on-perframe () (let ((rot (gethash target *spin-table* 0.0))) (if (< rot (* 8 pi)) (setf (gethash target *spin-table*) (+ rot 0.88) (ww::text-color target) (random-text-color) (ww::rotation target) rot) (progn (setf (ww::rotation target) 0.0) (ww::remove-handler target #'spin) (remhash target *spin-table*)))))) (ww::defhandler twirl-on-click (ww::on-mousedown () (ww::add-handler target #'spin))) (defmethod ww::boot ((app font-display)) (let ((hello (make-instance 'ww::text ;:content "Hell! Oh World ..." :content (format nil "Hell!~%Oh World...") :font (ww::get-asset "Ticketing.ttf" :asset-args '(:oversample 2)))) (instructions (make-instance 'ww::text :content "Click to spin. Press any key to change color." :font (ww::get-asset "Ticketing.ttf")))) (ww::scale-by hello 3.0) (setf (ww::x hello) (* 0.5 (- 800 (ww::unit-width hello))) (ww::y hello) (* 0.5 (- 600 (ww::unit-height hello)))) (ww::add-handler hello #'marquee) (ww::add-handler hello #'change-text-color) (ww::add-handler hello #'twirl-on-click) (ww::refocus-on hello) (ww::add-unit app hello) (ww::scale-by instructions 2.0) (setf (ww::x instructions) (* 0.5 (- 800 (ww::unit-width instructions)))) (ww::add-unit app instructions))) (defun start () (ww::start (make-instance 'font-display :fps 60 :refocus-on-mousedown-p nil :width 800 :height 600 :title "Wheelwork Example: Font display" :asset-root (merge-pathnames "examples/" (asdf:system-source-directory :wheelwork)))))