1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        jan@swi.psy.uva.nl
5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6    Copyright (c)  1999-2011, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(pce_subframe, []).
36:- use_module(library(pce)).
37:- require([ default/3
38           , send_list/3
39           ]).
40
41/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
42This file defines the XPCE class subframe.  Class subframe is a subclass
43of class window that  manages  a  set   of  sub-windows  and  allows for
44`frames-on-windows'.  The behaviour of class subframe   is  based on the
45TWM window manager.
46
47The normal way to use this class is
48
49        1) Relate a set of windows (using ->above, etc.)
50        2) Create an instance of subframe.
51        3) append one of the windows using ->append
52        4) open the frame using ->open.  The argument is a window
53           on which the frame is to be opened.
54
55See also the predicate test/0 at the end of this file.
56
57Other important public methods are
58
59        ->button                define a title-bar button for this frame
60- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
61
62
63:- pce_autoload(twm_resize_button,      library(twm_resize_button)).
64
65:- pce_begin_class(subframe, window).
66
67variable(left_buttons,  chain,  get, "Buttons to the left").
68variable(right_buttons, chain,  get, "Buttons to the right").
69variable(label_text,    text,   get, "Text for the label").
70variable(members,       chain,  get, "Chain with member windows").
71variable(title_line,    line,   get, "Line below titlebar").
72variable(title_box,     box,    get, "Box in titlebar").
73
74variable(closed,        bool,   get, "Iconic/open representation").
75variable(saved_area,    area,   get, "Area of other representation").
76variable(saved_pen,     int,    get, "Pen value of other representation").
77variable(icon,          bitmap, get, "Bitmap representing the icon").
78variable(icon_label_text,text,  get, "Text for iconic representation").
79
80resource(label_font,    font,   '@helvetica_bold_14').
81resource(pen,           int,    '3').
82resource(cursor,        cursor, 'hand2').
83resource(icon,          bitmap, 'pce.bm').
84
85initialise(F, Label:char_array) :->
86    "Create from Label"::
87    send(F, slot, icon, @default),
88
89    send(F, send_super, initialise),
90
91    get(F, resource_value, label_font, Font),
92    default(Label, '', Lbl),
93    send(F, slot, title_box, new(TB, box)),
94    send(TB, pen, 0),
95    send(TB, fill_pattern, @grey50_image),
96    send(F, slot, title_line, new(TL, line)),
97    send(TL, pen, F?pen),
98    send(TL, points, 0, -F?pen/2, 0, -F?pen/2),
99    send(F, slot, label_text, text(Lbl, left, Font)),
100    send(F, slot, left_buttons, new(chain)),
101    send(F, slot, right_buttons, new(chain)),
102    send(F, slot, members, new(chain)),
103
104    send(F, slot, saved_area, area(20,20,64,64)),
105    send(F, slot, saved_pen, 0),
106    send(F, slot, closed, @off),
107    send(F, slot, icon_label_text, text(Lbl, left, Font)).
108
109
110append(F, W:window) :->
111    "Append a new window"::
112    send(W?tile?root, for_all, message(F?members, add, @arg1)).
113
114
115title_bar_height(F, Margin, Height) :-
116    Margin = 2,
117
118    new(H, number(0)),
119    send(F?left_buttons, for_all, message(H, maximum, @arg1?height)),
120    send(F?right_buttons, for_all, message(H, maximum, @arg1?height)),
121    send(H, maximum, F?label_text?height),
122    send(H, plus, 2*Margin + F?title_line?pen),
123
124    get(H, value, Height).
125
126
127geometry(F, FX:[int], FY:[int], FW:[int], FH:[int]) :->
128    "Update position and layout of the title-bar"::
129    send(F, send_super, geometry, FX, FY, FW, FH),
130
131    (   get(F, closed, @off)
132    ->  title_bar_height(F, Margin, H),
133        send(F, scroll_to, point(0, -H)),
134
135        new(X, number(Margin)),
136        get(H, value, PLH),
137        Y is -PLH + Margin,
138        send(F?left_buttons, for_all,
139             and(message(@arg1, set, X, Y),
140                 message(F, display, @arg1),
141                 message(X, plus, Margin + @arg1?width))),
142        send(F?label_text, set, X, Y),
143        send(F, display, F?label_text),
144        send(X, value, F?width - Margin - 2*F?pen),
145        send(F?right_buttons, for_all,
146             and(message(X, minus, @arg1?width),
147                 message(@arg1, set, X, Y),
148                 message(F, display, @arg1),
149                 message(X, minus, Margin))),
150
151        send(F, display, F?title_line),
152        send(F, display, F?title_box),
153        send(F?title_line, end_x, F?width),
154        send(F?title_box, set,
155             F?label_text?right_side + Margin,
156             -(H - Margin),
157             X - F?label_text?right_side - Margin,
158             H - 2*Margin - F?pen),
159        send(F?tile, set, 0, 0, F?width-2*F?pen, F?height - H - 2*F?pen),
160
161        send(F?members, for_all, message(F, display, @arg1))
162    ;   send(F, scroll_to, point(0, 0)),
163        send(F, display, F?icon),
164        send(F, display, F?icon_label_text),
165        send(F?icon_label_text, center_x, F?icon?center_x),
166        send(F?icon_label_text, y, F?icon?bottom_side)
167    ).
168
169
170request_geometry(F, X:[int], Y:[int], W:[int], H:[int]) :->
171    "Add height for the title-bar"::
172    (   get(F, closed, @off)
173    ->  (   H \== @default
174        ->  title_bar_height(F, _Margin, TH),
175            FH is TH + H
176        ;   FH = H
177        ),
178        FW = W
179    ;   FH = F?icon?height + F?icon_label_text?height + 2 * F?pen,
180        new(FW, number(F?icon?width)),
181        send(FW, maximum, F?icon_label_text?width),
182        send(FW, plus, 2 * F?pen)
183    ),
184    send(F, geometry, X, Y, FW, FH).
185
186
187tile(F, Tile:tile) :<-
188    "Get root-tile of the window tree"::
189    get(F?members?head, tile, SubTile),
190    get(SubTile, root, Tile).
191
192
193fit(F) :->
194    "Fix layout"::
195    get(F, tile, RootTile),
196    send(RootTile, enforce),
197    send(F, set,
198         @default, @default, RootTile?ideal_width, RootTile?ideal_height).
199
200
201open(F, W:device, Pos:[point]) :->
202    "Open the sub-frame on indicated device"::
203    send(F, fit),
204    send(W, display, F, Pos).
205
206
207                 /*******************************
208                 *           BUTTONS            *
209                 *******************************/
210
211button(F, Op:'name|code', Image:[image], Place:[{left,right}]) :->
212    "Attach a button to the titlebar"::
213    default(Image, ?(Op, append, '.bm'), Img),
214
215    new(Image16, image(@nil, 18, 18)),
216    new(Bm, bitmap(Img)),
217    send(Bm, center, point(9,9)),
218    send(Image16, draw_in, Bm),
219    send(Bm, done),
220    send(Image16, draw_in, box(18,18)),
221
222    (   Op == resize
223    ->  new(Button, twm_resize_button(Image16))
224    ;   new(Button, bitmap(Image16)),
225        (   atom(Op)
226        ->  Action = message(F, Op)
227        ;   Action = Op
228        ),
229        send(Button, recogniser, click_gesture(left, '', single, Action))
230    ),
231    (   Place == right
232    ->  send(F?right_buttons, append, Button)
233    ;   send(F?left_buttons, append, Button)
234    ),
235    (   get(F, device, Dev),
236        Dev \== @nil
237    ->  send(F, geometry)           % update
238    ;   true
239    ).
240
241
242                 /*******************************
243                 *           EVENTS             *
244                 *******************************/
245
246:- pce_global(@open_subframe_recogniser,
247              new(handler_group(click_gesture(left, '', single,
248                                              message(@receiver, expose)),
249                                new(move_outline_gesture(left))))).
250:- pce_global(@closed_subframe_recogniser,
251              new(handler_group(click_gesture(left, '', double,
252                                              message(@receiver, closed,
253                                                      @off)),
254                                new(move_outline_gesture(left))))).
255
256
257event(F, Ev:event) :->
258    (   send(F, send_super, event)
259    ->  true
260    ;   (   get(F, closed, @off)
261        ->  send(@open_subframe_recogniser, event, Ev)
262        ;   send(@closed_subframe_recogniser, event, Ev)
263        )
264    ).
265
266                 /*******************************
267                 *     ICONIC REPRESENTATION    *
268                 *******************************/
269
270closed(F, Val:bool) :->
271    "Change closed status"::
272    (   get(F, closed, Val)
273    ->  true
274    ;   new(OtherArea, area),
275        send(OtherArea, copy, F?saved_area),
276        send(F?saved_area, copy, F?area),
277        send(F?graphicals, for_all, message(@arg1, displayed, @off)),
278        send(F, slot, closed, Val),
279        get(F, saved_pen, OtherPen),
280        send(F, slot, saved_pen, F?pen),
281        send(F, pen, OtherPen),
282        send(F, area, OtherArea),
283        send(F, expose)
284    ).
285
286
287iconify(F) :->
288    "->closed: @on (button call-back)"::
289    send(F, closed, @on).
290
291:- pce_end_class.
292
293                 /*******************************
294                 *               TEST           *
295                 *******************************/
296
297test :-
298    send(new(@p, picture('Desktop', size(600, 500))), open),
299
300    new(@p2, picture),
301    send(new(@b, browser), right, @p2),
302    send_list(@b, append, [aap, noot, mies]),
303
304    new(@f, subframe('Hello')),
305    send(@f, button, iconify, 'iconify.bm', left),
306    send(@f, button, destroy, 'delete.bm', left),
307    send(@f, button, resize, 'resize.bm', right),
308
309    send(@f, append, @p2),
310    send(@f, open, @p, point(50,50)),
311
312    send(@p2, display, new(B, bitmap('pce.bm'))),
313    send(B, recogniser, new(move_gesture)),
314
315    new(@f2, subframe('I am small')),
316    send(@f2, append, new(@p3, picture)),
317
318    send(@f2, button, iconify, 'iconify.bm', left),
319    send(@f2, button, destroy, 'delete.bm', left),
320    send(@f2, button, resize, 'resize.bm', right),
321
322    send(@f2, open, @p, point(200, 200)).
323