diff --git a/examples/hookup.lisp b/examples/hookup.lisp new file mode 100644 index 0000000..2077c52 --- /dev/null +++ b/examples/hookup.lisp @@ -0,0 +1,140 @@ +(defpackage #:org.shirakumo.alloy.examples.hookup + (:use #:cl) + (:local-nicknames + (#:glfw #:org.shirakumo.fraf.glfw) + (#:alloy #:org.shirakumo.alloy) + (#:animation #:org.shirakumo.alloy.animation) + (#:opengl #:org.shirakumo.alloy.renderers.opengl) + (#:simple #:org.shirakumo.alloy.renderers.simple) + (#:presentations #:org.shirakumo.alloy.renderers.simple.presentations)) + (:export + #:launch)) + +(in-package #:org.shirakumo.alloy.examples.hookup) + +(defclass renderer (org.shirakumo.alloy.renderers.opengl.msdf:renderer + org.shirakumo.alloy.renderers.opengl.png:renderer + presentations:default-look-and-feel) + ()) + +(defmethod alloy:allocate ((renderer renderer))) + +(defclass ui (alloy:fixed-scaling-ui) + ((alloy:target-resolution :initform (alloy:px-size 1280 720)) + (alloy:scales :initform '((3840 T 2.0) + (2800 T 1.5) + (1920 T 1.25) + (1280 T 1.0) + (1000 T 0.8) + (T T 0.5))))) + +;; STUB +(defmethod (setf alloy:cursor) (cursor (ui ui))) + +(defclass window (glfw:window renderer) + ((ui :initform (make-instance 'ui) :accessor ui) + (cursor-location :initform (alloy:px-point 0 0) :accessor cursor-location))) + +(defmethod initialize-instance :after ((window window) &key) + (alloy:allocate window) + ;; Setup initial GL state + (gl:clear-color 0 0 0 0) + (gl:enable :blend :depth-test :depth-clamp :stencil-test) + (gl:clear-stencil #x00) + (gl:stencil-func :always 1 #xFF) + (gl:stencil-mask #xFF) + (gl:clear-depth 0.0) + (gl:depth-func :gequal) + (gl:depth-mask T) + (gl:blend-func :src-alpha :one-minus-src-alpha) + ;; Construct our test layout + (let ((layout (make-instance 'alloy:grid-layout :col-sizes '(100 T) :row-sizes '(30) :layout-parent (alloy:layout-tree (ui window)))) + (focus (make-instance 'alloy:focus-list :focus-parent (alloy:focus-tree (ui window))))) + (alloy:enter "Hello" layout) + (let ((button (alloy:represent "Test" 'alloy:button :layout-parent layout :focus-parent focus))) + (alloy:on alloy:activate (button) + (print :HELLO))))) + +;; Hook up events +(defmethod glfw:window-resized ((window window) w h) + (alloy:suggest-size (alloy:px-size w h) (ui window)) + (let ((target (simple:transform-matrix window))) + (setf (aref target 0) (/ 2f0 (max 1f0 w))) + (setf (aref target 1) 0f0) + (setf (aref target 2) -1f0) + + (setf (aref target 3) 0f0) + (setf (aref target 4) (/ 2f0 (max 1f0 h))) + (setf (aref target 5) -1f0) + + (setf (aref target 6) 0f0) + (setf (aref target 7) 0f0) + (setf (aref target 8) 0.0001f0) + (setf (simple:identity-matrix window) (copy-seq target)))) + +(defmethod glfw:mouse-moved ((window window) x y) + (let ((location (alloy:px-point x (- (second (glfw:size window)) y)))) + (alloy:handle (make-instance 'alloy:pointer-move + :old-location (cursor-location window) + :location location) + (ui window)) + (setf (cursor-location window) location))) + +(defmethod glfw:mouse-button-changed ((window window) button action mods) + (case action + (:press + (alloy:handle (make-instance 'alloy:pointer-down + :location (cursor-location window) + :kind button) + (ui window))) + (:release + (alloy:handle (make-instance 'alloy:pointer-up + :location (cursor-location window) + :kind button) + (ui window))))) + +(defmethod glfw:key-changed ((window window) key code action mods) + (case action + (:press + (alloy:handle (make-instance 'alloy:key-down :code code :key key :modifiers mods) + (ui window))) + (:repeat + (alloy:handle (make-instance 'alloy:key-down :code code :key key :modifiers mods :repeat-p T) + (ui window))) + (:release + (alloy:handle (make-instance 'alloy:key-up :code code :key key :modifiers mods) + (ui window))))) + +(defmethod glfw:mouse-scrolled ((window window) x y) + (alloy:handle (make-instance 'alloy:scroll + :dy y + :dx x + :location (cursor-location window)) + (ui window))) + +(defmethod glfw:char-entered ((window window) char) + (alloy:handle (make-instance 'alloy:text-event :text (string (code-char char))) + (ui window))) + +(defun launch () + (glfw:init) + (let ((window (make-instance 'window :opengl-profile :opengl-core-profile + :context-version-major 3 + :context-version-minor 3)) + (last-time (glfw:timestamp)) + (resolution (/ 1.0d0 (glfw:timestamp-resolution)))) + (declare (type (unsigned-byte 64) last-time)) + ;; Loop + (unwind-protect + (loop until (glfw:should-close-p window) + do (glfw:poll-events) + (let* ((new-time (glfw:timestamp)) + (dt (* (- new-time last-time) resolution))) + (declare (type (unsigned-byte 64) new-time)) + (animation:update (ui window) (float dt 0f0)) + (setf last-time new-time)) + ;; Render UI + (gl:viewport 0 0 (glfw:width window) (glfw:height window)) + (alloy:render window (ui window)) + (glfw:swap-buffers window)) + (glfw:shutdown))))