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