From 49ac2ad797e63957f0058ef4ad6e15dda482175d Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Tue, 21 Jun 2022 08:12:30 -0500 Subject: [add] start function and event loop --- wheelwork.lisp | 137 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 137 insertions(+) (limited to 'wheelwork.lisp') diff --git a/wheelwork.lisp b/wheelwork.lisp index e7c3546..23b328a 100644 --- a/wheelwork.lisp +++ b/wheelwork.lisp @@ -1,3 +1,140 @@ ;;;; wheelwork.lisp (in-package #:wheelwork) + +(defvar *application* nil + "current application") + +(defclass/std application () + ((title :with :std "Wheelwork App") + (asset-root :ri :std #P"./" :doc "Directory under which assets are stored.") + (asset-classifiers + :std '(("png" texture)) + :doc "ALIST of (EXT CLASS). EXT is a string, file estension. CLASS is a symbol, class name.") + (assets :with :a :std (make-hash-table :test 'equal) + :doc "maps asset names to asset instances.") + (scale :with :a :std 1.0) + (width height :with :std 800) + (projection :with :a :doc "The projection matrix for the scene. Orthographic by default.") + (window :with :a) + (display-root :doc "A list of objects to display, the root of a tree") + (refocus-on-mousedown-p :std t) + (focus last-motion-target :with :a) + (frame-wait :std (/ 1000 30) :doc "Frames Per Second" :a))) + +(defun can-set-projection-p (app) + (and (slot-boundp app 'width) + (slot-boundp app 'height) + (slot-boundp app 'scale))) + +(defun set-projection (app) + (when (can-set-projection-p app)q + (with-slots (projection scale width height) app + ;; set projection matrix + (setf projection (mat:mortho 0.0 (/ width scale) 0 (/ height scale) -1.0 1.0))))) + +(defmethod initialize-instance :after ((app application) &key) + (set-projection app)) + +(defmethod (setf closer-mop:slot-value-using-class) :after + (new-value class (app application) slot) + (when (member (closer-mop:slot-definition-name slot) + '(scale width height)) + (set-projection app))) + + +(defgeneric boot (app) + (:documentation "Specialized for each subclass of + APPLICATION. Responsble for setting the app up once the system + resoruces are avaialble.") + (:method ((app application)) nil)) + +(defgeneric cleanup (thing) + (:documentation "Clean up applications, textures, and so on.") + (:method ((any t)) nil)) + +(defun start (app &key (x :centered) (y :centered)) + (sdl2:with-init (:everything) + (sdl2:with-window (window + :flags '(:shown :opengl) + :title (application-title app) + :w (application-width app) + :h (application-height app) + :x x :y y) + (setf (application-window app) window) + (sdl2:with-gl-context (ctx window) + (sdl2:gl-make-current window ctx) + (gl:viewport 0 0 (application-width app) (application-height app)) + (let ((*application* app)) + (boot app) + (eventloop app) + (cleanup app)))))) + +(defun eventloop (app) + (sdl2:with-event-loop (:method :poll) + (:quit () t))) + + + +;; (defun get-focus (&optional (app *application*)) +;; (or (application-focus app) +;; (display-root app))) + +;; (defun get-projection (&optional (app *application*)) +;; (application-projection app)) + +;; (defun application-width (&optional (app *application*)) +;; (multiple-value-bind (w h) (sdl2:get-window-size (application-window app)) +;; (declare (ignore h)) +;; w)) + +;; (defun application-height (&optional (app *application*)) +;; (multiple-value-bind (w h) (sdl2:get-window-size (application-window app)) +;; (declare (ignore w)) +;; h)) + +;; (defun asset-class-for (asset-id &optional (app *application*)) +;; "Given an asset-id (see GET-ASSET), retrieve the symbol name of a +;; the class that will be used to instantiate the asset object. That +;; 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*)) +;; "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." +;; (or (gethash asset-id (application-assets app)) +;; (setf (gethash asset-id (application-assets app)) +;; (initialize +;; (make-instance (asset-class-for asset-id) +;; :path (uiop:merge-pathnames* asset-id (asset-root app))))))) + +;; (defclass/std event-handler () +;; ((event-type handler-function :ri))) + +;; (defclass/std listener () +;; ((keydown keyup mousedown mouseup mousemove mousewheel focus blur perframe +;; :r :with :type event-handler) +;; (keydown-table +;; keyup-table +;; mousedown-table +;; mouseup-table +;; mousemove-table +;; mousewheel-table +;; focus-table +;; blur-table +;; perframe-table +;; :static +;; :std (make-hash-table) +;; :doc "Keyed by DISPLAY-UNIT instance, holds an EVENT-HANDLER if handler is defined for unit.")) +;; (:documentation "Event handlers per object. The static hash tables +;; are keyed by UNIT and hold Event-Handler instances.")) + +;; (defclass/std display-unit () +;; ((x y width height rotation :a :with :std 0.0 :type float :doc "Geometric properties") +;; (cached-model cached-real-model container listener :a :doc "Internal use.") +;; (focusablep :doc "T indicates it cannot be made the object of focus.") +;; (opacity :std 1.0 :doc "0.0 indicates it will not be rendred."))) + -- cgit v1.2.3