forked from Shirakumo/trial
-
Notifications
You must be signed in to change notification settings - Fork 0
/
fullscreenable.lisp
45 lines (38 loc) · 1.59 KB
/
fullscreenable.lisp
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
#|
This file is a part of trial
(c) 2016 Shirakumo http://tymoon.eu ([email protected])
Author: Nicolas Hafner <[email protected]>
|#
(in-package #:org.shirakumo.fraf.trial)
(defclass fullscreenable (display)
((original-mode :initform NIL :accessor original-mode)
(resolution :accessor resolution)
(fullscreen :accessor fullscreen))
(:default-initargs
:resolution (list 800 600)
:fullscreen NIL))
(defmethod initialize-instance :after ((fullscreenable fullscreenable) &key resolution fullscreen)
(setf (original-mode fullscreenable) (cl-monitors:mode
(dolist (monitor (cl-monitors:detect))
(when (cl-monitors:primary-p monitor)
(return monitor)))))
(setf (resolution fullscreenable) resolution)
(setf (fullscreen fullscreenable) fullscreen))
(defmethod finalize :after ((fullscreenable fullscreenable))
(setf (resolution fullscreenable) NIL))
(defmethod (setf resolution) :before (resolution (fullscreenable fullscreenable))
(etypecase resolution
(null
(cl-monitors:make-current (original-mode fullscreenable)))
(list
(resize (context fullscreenable)
(first resolution)
(second resolution)))
(cl-monitors:mode
(resize (context fullscreenable)
(cl-monitors:width resolution)
(cl-monitors:height resolution))
(cl-monitors:make-current resolution))))
(defmethod (setf fullscreen) :before (fullscreen (fullscreenable fullscreenable))
(show (context fullscreenable) :fullscreen fullscreen))
(cl-monitors:init)