forked from malcolmstill/ulubis
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathvirtual-desktop-mode.lisp
168 lines (147 loc) · 5.76 KB
/
virtual-desktop-mode.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
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(in-package :ulubis)
(defparameter *ortho* (m4:identity))
#|
Our virtual desktop mode. The virtual desktop mode will control
a number of views (defined by the user). This control includes
keybindings for switching between the views and the rendering of
views.
Initially we'll have two key combinations for moving left or right
to the prev / next virtual desktop. The key combinations will
activate a slide animation to smoothly transition between the
views.
When the slide-animation is in effect (when it is non null) we'll
render either all the views or only those visible for the transition.
When the slide-animation is not in effect (when it is null) we'll
only render the visible view.
|#
(defmode virtual-desktop-mode ()
((clear-color :accessor clear-color
:initarg :clear-color
:initform (list 0.3 0.3 0.3 0.0))
(projection :accessor projection
:initarg :projection
:initform (m4:identity))
(old-surface :accessor old-surface
:initarg :old-surface
:initform nil)
(new-surface :accessor new-surface
:initarg :new-surface
:initform nil)
(slide-animation :accessor slide-animation
:initarg :slide-animation
:initform nil)
(focus-follows-mouse :accessor focus-follows-mouse
:initarg :focus-follows-mouse
:initform nil)))
(defmethod init-mode ((mode virtual-desktop-mode))
(setf *ortho* (ortho 0 (screen-width *compositor*) (screen-height *compositor*) 0 1 -1))
(cepl:map-g #'mapping-pipeline nil)
(setf (render-needed *compositor*) t))
(defkeybinding (:pressed "q" Ctrl Shift) () (virtual-desktop-mode)
(uiop:quit))
(defkeybinding (:pressed "s" Ctrl Shift) () (virtual-desktop-mode)
(screenshot))
#|
Here we set up a keybinding fro swicthing between views (virtual desktops).
Our mode knows the view that it is on. It finds all views on the compositor
and the position of its view. It therefore knows which view to set as the
current-view.
However, we have to define this in the mode. If we have a bunch of different
modes across our views, we need to implement this logic on each mode. This
seems silly.
We should have a mode stack that sits above the views that defines this behaviour
and that would allow for animations of these modes. E.g. a pan from one view to
the next.
|#
(defkeybinding (:pressed "Right" Gui) (mode)
(virtual-desktop-mode)
(unless (slide-animation mode)
(with-slots ((screen view)) mode
(let* ((views (surfaces screen))
(current-view (active-surface screen))
(count (length views))
(pos (position current-view views)))
(when (not (= pos (- count 1)))
(make-slide-animation mode screen current-view (nth (+ pos 1) views) 1))))
(setf (render-needed *compositor*) t)))
(defkeybinding (:pressed "Left" Gui) (mode)
(virtual-desktop-mode)
(unless (slide-animation mode)
(with-slots ((screen view)) mode
(let* ((views (surfaces screen))
(current-view (active-surface screen))
(pos (position current-view views)))
(when (not (= pos 0))
(make-slide-animation mode screen current-view (nth (- pos 1) views) -1))))
(setf (render-needed *compositor*) t)))
(defun make-slide-animation (mode screen old-surface new-surface mult)
(setf (x new-surface) (* mult (screen-width *compositor*)))
(setf (slide-animation mode)
(parallel-animation (lambda ()
(setf (active-surface screen) new-surface)
(setf (x new-surface) 0)
(setf (slide-animation mode) nil)
(setf (old-surface mode) nil)
(setf (new-surface mode) nil))
(animation :duration 315
:target new-surface
:property 'x
:to 0
:easing-fn 'easing:in-out-exp)
(animation :duration 315
:target old-surface
:property 'x
:to (* -1 mult (screen-width *compositor*))
:easing-fn 'easing:in-out-exp)))
(setf (old-surface mode) old-surface)
(setf (new-surface mode) new-surface)
(start-animation (slide-animation mode)))
(cepl:defun-g vd-vert ((vert cepl:g-pt)
&uniform
(origin :mat4)
(origin-inverse :mat4)
(surface-scale :mat4)
(surface-translate :mat4))
(values (* *ortho*
surface-translate
origin-inverse
surface-scale
origin
(rtg-math:v! (cepl:pos vert) 1))
(:smooth (cepl:tex vert))))
(cepl:defpipeline-g vd-pipeline ()
(vd-vert cepl:g-pt)
(default-rgb-frag :vec2))
(defmethod render ((surface view) &optional desktop-fbo)
(with-rect (vertex-stream (screen-width *compositor*) (screen-height *compositor*))
(let ((texture (texture-of surface)))
(map-g-default/fbo desktop-fbo #'vd-pipeline vertex-stream
:origin (m4:translation (rtg-math:v! (- (/ (screen-width *compositor*) 2))
(- (/ (screen-height *compositor*) 2))
0))
:origin-inverse (m4:translation (rtg-math:v! (/ (screen-width *compositor*) 2)
(/ (screen-height *compositor*) 2)
0))
:surface-scale (m4:scale (rtg-math:v! (scale-x surface)
(* -1.0 (scale-y surface))
1.0))
:surface-translate (m4:translation (rtg-math:v! (x surface)
(y surface)
0.0))
:texture texture
:alpha 1.0))))
(defmethod render ((mode virtual-desktop-mode) &optional desktop-fbo)
(apply #'gl:clear-color (clear-color mode))
(when desktop-fbo
(cepl:clear desktop-fbo))
(if (not (slide-animation mode))
;; static view of single virtual desktop
(cepl:with-blending (blending-parameters mode)
(let ((view (active-surface (view mode))))
(setf (x view) 0)
(render view desktop-fbo)))
;; If we are transitioning draw the two virtual desktops involved
(mapcar (lambda (virtual-destkop)
(cepl:with-blending (blending-parameters mode)
(render virtual-destkop desktop-fbo)))
(list (old-surface mode) (new-surface mode)))))