Slither/window.lisp at main · Fuglesteg/Slither · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
(defpackage #:slither/window
  (:use #:cl
        #:slither/core
        #:slither/utils)
  (:local-nicknames (:glfw :org.shirakumo.fraf.glfw))
  (:export #:frame
           #:*window-width*
           #:*window-height*
           #:fps
           #:with-event-loop
           #:with-window
           #:aspect-ratio))

(in-package #:slither/window)

(defclass game-window (glfw:window) ()
  (:default-initargs
   :width 250 :height 250
   :title "Slither"))

(defvar *window-height* 1920)
(defvar *window-width* 1080)

(defun aspect-ratio ()
  (/ *window-width* *window-height*))

(defmethod glfw:window-resized ((window game-window) width height)
  (setf *window-width* width
        *window-height* height)
  (gl:viewport 0 0 width height))

(defvar *last-frame-time* 0)
(defvar *current-time* 0)

(defun calculate-dt ()
  (calculate-delta-time (coerce (glfw:time) 'single-float)))

#+micros
(defun read-repl ()
  (continuable
    (let ((connection (or micros/swank-api:*emacs-connection*
                          (micros::default-connection))))
      (when connection
        (micros::handle-requests connection t)))))

(defvar *window* nil)

(defun fps ()
  (unless (= (delta-time) 0)
    (/ 1 (delta-time))))

(defun open-window (&rest initargs)
  (glfw:init)
  (unless *window*
    (let ((window (apply #'make-instance 'game-window initargs)))
      (destructuring-bind (width height) (glfw:framebuffer-size window)
        (setf *window* window
              *window-width* width
              *window-height* height)))))

(defun close-window ()
  (glfw:destroy *window*)
  (setf *window* nil)
  (glfw:shutdown))

(defmacro with-window (initargs &body body)
  `(progn
     (apply #'open-window ,initargs)
     (unwind-protect
          (progn ,@body)
       (close-window))))

(defmacro with-event-loop (&body body)
  `(loop until (glfw:should-close-p *window*)
         do (progn
              #+micros (read-repl)
              (calculate-dt)
              (glfw:poll-events)
              (continuable
                ,@body)
              (glfw:swap-buffers *window*))))