/[defwm]/Define-Window-Manager/src/borders.lisp
ViewVC logotype

Contents of /Define-Window-Manager/src/borders.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (vendor branch)
Thu Feb 26 19:29:52 2004 UTC (10 years, 1 month ago) by rjain
Branch: MAIN, rjain
CVS Tags: start, HEAD
Changes since 1.1: +0 -0 lines
Initial import
1 rjain 1.1 (in-package :define-window-manager)
2    
3     (defclass window-border (mute-repainting-mixin sheet-parent-mixin sheet-multiple-child-mixin mirrored-sheet-mixin sheet-translation-mixin layout-protocol-mixin basic-sheet)
4     ((north-west-pane)
5     (north-pane)
6     (north-east-pane)
7     (west-pane)
8     (managed-window :initarg :managed-window)
9     (east-pane)
10     (south-west-pane)
11     (south-pane)
12     (south-east-pane)
13     (north-space)
14     (south-space)
15     (east-space)
16     (west-space)))
17    
18     (defmethod compose-space ((border window-border) &key width height)
19     (declare (ignore width height))
20     (with-slots (north-space south-space west-space east-space
21     north-west-pane north-pane north-east-pane
22     west-pane managed-window east-pane
23     south-west-pane south-pane south-east-pane) border
24     (let ((nw (compose-space north-west-pane))
25     (n (compose-space north-pane))
26     (ne (compose-space north-east-pane))
27     (w (compose-space west-pane))
28     (e (compose-space east-pane))
29     (sw (compose-space south-west-pane))
30     (s (compose-space south-pane))
31     (se (compose-space south-east-pane)))
32     (setf north-space (max (space-requirement-min-height nw)
33     (space-requirement-min-height n)
34     (space-requirement-min-height ne))
35     south-space (max (space-requirement-min-height sw)
36     (space-requirement-min-height s)
37     (space-requirement-min-height se))
38     west-space (max (space-requirement-min-width nw)
39     (space-requirement-min-width w)
40     (space-requirement-min-width sw))
41     east-space (max (space-requirement-min-width ne)
42     (space-requirement-min-width e)
43     (space-requirement-min-width se)))
44     (let ((border-width (+ west-space east-space))
45     (border-height (+ north-space south-space)))
46     (space-requirement+* (compose-space managed-window)
47     :width border-width
48     :min-width border-width
49     :max-width border-width
50     :height border-height
51     :min-height border-height
52     :max-height border-height)))))
53    
54     (defmethod allocate-space ((border window-border) width height)
55     (with-slots (north-space south-space west-space east-space
56     north-west-pane north-pane north-east-pane
57     west-pane managed-window east-pane
58     south-west-pane south-pane south-east-pane) border
59     (let ((inside-top north-space)
60     (inside-left west-space)
61     (inside-width (- width west-space east-space))
62     (inside-height (- height north-space south-space))
63     (inside-bottom (- width east-space))
64     (inside-right (- height south-space)))
65     (layout-child north-west-pane :left :top 0 0 west-space north-space )
66     (layout-child north-pane :center :top inside-left 0 inside-width north-space )
67     (layout-child north-east-pane :right :top inside-right 0 east-space north-space )
68     (layout-child west-pane :left :center 0 inside-top west-space inside-height)
69     (layout-child managed-window :center :center inside-left inside-top inside-width inside-height)
70     (layout-child east-pane :right :center inside-right inside-top east-space inside-height)
71     (layout-child south-west-pane :left :bottom 0 inside-bottom west-space south-space )
72     (layout-child south-pane :center :bottom inside-left inside-bottom inside-width south-space )
73     (layout-child south-east-pane :right :bottom inside-right inside-bottom east-space south-space ))))
74    

  ViewVC Help
Powered by ViewVC 1.1.5