Fix host system compilation warnings

borodust · Oct 3, 2018 · abf9307 · abf9307
1 parent 895740a
commit abf9307
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 22 deletions.
diff --git a/graphics/system.lisp b/graphics/system.lisp
@@ -20,19 +20,23 @@
     (setf resource-executor (acquire-executor :single-threaded-p t :exclusive-p t))))
 
 
-(defmethod discard-system :before ((this graphics-system))
+(defmethod disabling-flow ((this graphics-system))
   (with-slots (resource-executor) this
-    (when (alivep resource-executor)
-      (mt:wait-with-latch (latch)
-        (execute resource-executor
-                 (lambda ()
-                   (unwind-protect
-                        (progn
-                          (release-rendering-context)
-                          (log:debug "Shared context released"))
-                     (mt:open-latch latch)))
-                 :priority :highest :important-p t)))
-    (release-executor resource-executor)))
+    (>>
+     (%> ()
+       (if (alivep resource-executor)
+           (execute resource-executor
+                    (lambda ()
+                      (unwind-protect
+                           (progn
+                             (release-rendering-context)
+                             (log:debug "Shared context released"))
+                        (continue-flow)))
+                    :priority :highest :important-p t)
+           (continue-flow)))
+     (instantly ()
+       (release-executor resource-executor))
+     (call-next-method))))
 
 
 (defmacro for-graphics ((&optional arg) &body body)
@@ -49,12 +53,14 @@
   (with-slots (resource-executor) this
     (ge.ng:>>
      (call-next-method)
-     (for-host ()
+     (%> ()
        (execute resource-executor
                 (lambda ()
                   (bind-rendering-context :main nil)
-                  (log:debug "Shared context bound"))
-                :priority :highest :important-p t)
+                  (log:debug "Shared context bound")
+                  (continue-flow))
+                :priority :highest :important-p t))
+     (for-host ()
        (framebuffer-size))
      (ge.ng:-> this (viewport)
        (declare (type vec2 viewport))

diff --git a/host/hotkey.lisp b/host/hotkey.lisp
@@ -1,4 +1,4 @@
-(cl:in-package :bodge-host)
+(cl:in-package :cl-bodge.host)
 
 
 (defenum hotkey-state
@@ -7,8 +7,8 @@
 
 
 (defclass hotkey-listener ()
-  ((hotkey-table :initform (make-guarded-reference (make-hash-table :test #'equal)))
-   (current-bag :initform (make-guarded-reference nil))))
+  ((hotkey-table :initform (mt:make-guarded-reference (make-hash-table :test #'equal)))
+   (current-bag :initform (mt:make-guarded-reference nil))))
 
 
 (defun %ensure-correct-hotkey (key-bag)
@@ -21,20 +21,20 @@
 
 (defun register-keyboard-hotkey (hotkey-listener key-bag action)
   (with-slots (hotkey-table) hotkey-listener
-    (with-guarded-reference (hotkey-table)
+    (mt:with-guarded-reference (hotkey-table)
       (setf (gethash (%ensure-correct-hotkey key-bag) hotkey-table) action))))
 
 
 (defun %get-hotkey-action (listener key-bag)
   (with-slots (hotkey-table) listener
-    (with-guarded-reference (hotkey-table)
+    (mt:with-guarded-reference (hotkey-table)
       (gethash key-bag hotkey-table))))
 
 
 (defun hotkey-update-key-state (hotkey-listener key state)
   (with-slots (hotkey-table current-bag) hotkey-listener
     (unless (eq state :repeating)
-      (with-guarded-reference (current-bag)
+      (mt:with-guarded-reference (current-bag)
         (when-let ((prev-hotkey-action (%get-hotkey-action hotkey-listener
                                                            current-bag)))
           (funcall prev-hotkey-action :released))

diff --git a/host/system.lisp b/host/system.lisp
@@ -79,7 +79,7 @@
                  :opengl-version (property '(:host :opengl-version) '(3 3))
                  :resizable (property '(:host :viewport-resizable) nil)
                  :decorated (property '(:host :viewport-decorated) t)
-                 :transparent (property '(:host :viewport-transparent) t)))
+                 :transparent (property '(:host :viewport-transparent) nil)))
 
 
 (defmethod enabling-flow ((this host-system))