-
-
Notifications
You must be signed in to change notification settings - Fork 12
/
fixed.lisp
65 lines (56 loc) · 2.41 KB
/
fixed.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
#|
This file is a part of Alloy
(c) 2019 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(in-package #:org.shirakumo.alloy)
(defclass fixed-layout (layout vector-container)
())
(defmethod (setf bounds) ((bounds extent) (layout fixed-layout)))
(defmethod notice-bounds ((element layout-element) (layout fixed-layout))
;; Calculate max bound
(cond ((= 1 (element-count layout))
(setf (slot-value layout 'bounds) (bounds element)))
(T
(destructure-extent (:x lx :y ly :w lw :h lh :to-px T) (bounds layout)
(destructure-extent (:x ex :y ey :w ew :h eh :to-px T) (bounds element)
(let ((l (min lx ex))
(b (min ly ey))
(r (max (+ lx lw) (+ ex ew)))
(u (max (+ ly lh) (+ ey eh))))
(setf (slot-value layout 'bounds)
(print (px-extent l b (- r l) (- u b))))))))))
(defmethod suggest-bounds (extent (layout fixed-layout))
extent)
(defmethod enter ((element layout-element) (layout fixed-layout) &key x y w h)
(call-next-method)
(let ((e (bounds element)))
(with-unit-parent layout
(setf (bounds element)
(px-extent (or x (extent-x e))
(or y (extent-y e))
(or w (extent-w e))
(or h (extent-h e)))))
element))
(defmethod leave :after ((element layout-element) (layout fixed-layout))
(when (= 0 (element-count layout))
(setf (slot-value layout 'bounds) (px-extent))))
(defmethod update ((element layout-element) (layout fixed-layout) &key x y w h)
(call-next-method)
(let ((e (bounds element)))
(with-unit-parent layout
(setf (bounds element)
(px-extent (or x (extent-x e))
(or y (extent-y e))
(or w (extent-w e))
(or h (extent-h e)))))
element))
(defmethod ensure-visible :before ((element layout-element) (layout fixed-layout))
;; Find parent
(loop until (or (eq layout (layout-parent element))
(eq element (layout-parent element)))
do (setf element (layout-parent element)))
(when (eq layout (layout-parent element))
;; Shuffle to ensure element is last, and thus drawn on top.
(rotatef (aref (elements layout) (1- (length (elements layout))))
(aref (elements layout) (position element (elements layout))))))