/*  $Id: subframe.pl,v 1.3 2002/02/01 15:04:54 jan Exp $

    Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        jan@swi.psy.uva.nl
    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    Copyright (C): 1985-2002, University of Amsterdam

    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

    As a special exception, if you link this library with other files,
    compiled with a Free Software compiler, to produce an executable, this
    library does not by itself cause the resulting executable to be covered
    by the GNU General Public License. This exception does not however
    invalidate any other reasons why the executable file might be covered by
    the GNU General Public License.
*/

:- module(pce_subframe, []).
:- use_module(library(pce)).
:- require([ default/3
	   , send_list/3
	   ]).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This file defines the XPCE class subframe.  Class subframe is a subclass
of class window that  manages  a  set   of  sub-windows  and  allows for
`frames-on-windows'.  The behaviour of class subframe   is  based on the
TWM window manager.

The normal way to use this class is

	1) Relate a set of windows (using ->above, etc.)
	2) Create an instance of subframe.
	3) append one of the windows using ->append
	4) open the frame using ->open.  The argument is a window
	   on which the frame is to be opened.

See also the predicate test/0 at the end of this file.

Other important public methods are

	->button		define a title-bar button for this frame
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */


:- pce_autoload(twm_resize_button,	library(twm_resize_button)).

:- pce_begin_class(subframe, window).

variable(left_buttons,	chain,	get, "Buttons to the left").
variable(right_buttons, chain,  get, "Buttons to the right").
variable(label_text,	text,	get, "Text for the label").
variable(members,	chain,  get, "Chain with member windows").
variable(title_line,	line,	get, "Line below titlebar").
variable(title_box,	box,	get, "Box in titlebar").

variable(closed,	bool,	get, "Iconic/open representation").
variable(saved_area,	area,	get, "Area of other representation").
variable(saved_pen,	int,	get, "Pen value of other representation").
variable(icon,		bitmap,	get, "Bitmap representing the icon").
variable(icon_label_text,text,  get, "Text for iconic representation").

resource(label_font,	font,	'@helvetica_bold_14').
resource(pen,		int,	'3').
resource(cursor,	cursor, 'hand2').
resource(icon,		bitmap, 'pce.bm').

initialise(F, Label:char_array) :->
	"Create from Label"::
	send(F, slot, icon, @default),

	send(F, send_super, initialise),

	get(F, resource_value, label_font, Font),
	default(Label, '', Lbl),
	send(F, slot, title_box, new(TB, box)),
	send(TB, pen, 0),
	send(TB, fill_pattern, @grey50_image),
	send(F, slot, title_line, new(TL, line)),
	send(TL, pen, F?pen),
	send(TL, points, 0, -F?pen/2, 0, -F?pen/2),
	send(F, slot, label_text, text(Lbl, left, Font)),
	send(F, slot, left_buttons, new(chain)),
	send(F, slot, right_buttons, new(chain)),
	send(F, slot, members, new(chain)),

	send(F, slot, saved_area, area(20,20,64,64)),
	send(F, slot, saved_pen, 0),
	send(F, slot, closed, @off),
	send(F, slot, icon_label_text, text(Lbl, left, Font)).


append(F, W:window) :->
	"Append a new window"::
	send(W?tile?root, for_all, message(F?members, add, @arg1)).


title_bar_height(F, Margin, Height) :-
	Margin = 2,
	
	new(H, number(0)),
	send(F?left_buttons, for_all, message(H, maximum, @arg1?height)),
	send(F?right_buttons, for_all, message(H, maximum, @arg1?height)),
	send(H, maximum, F?label_text?height),
	send(H, plus, 2*Margin + F?title_line?pen),

	get(H, value, Height).


geometry(F, FX:[int], FY:[int], FW:[int], FH:[int]) :->
	"Update position and layout of the title-bar"::
	send(F, send_super, geometry, FX, FY, FW, FH),
	
	(   get(F, closed, @off)
	->  title_bar_height(F, Margin, H),
	    send(F, scroll_to, point(0, -H)),
	    
	    new(X, number(Margin)),
	    get(H, value, PLH),
	    Y is -PLH + Margin,
	    send(F?left_buttons, for_all,
		 and(message(@arg1, set, X, Y),
		     message(F, display, @arg1),
		     message(X, plus, Margin + @arg1?width))),
	    send(F?label_text, set, X, Y),
	    send(F, display, F?label_text),
	    send(X, value, F?width - Margin - 2*F?pen),
	    send(F?right_buttons, for_all,
		 and(message(X, minus, @arg1?width),
		     message(@arg1, set, X, Y),
		     message(F, display, @arg1),
		     message(X, minus, Margin))),
	    
	    send(F, display, F?title_line),
	    send(F, display, F?title_box),
	    send(F?title_line, end_x, F?width),
	    send(F?title_box, set,
		 F?label_text?right_side + Margin,
		 -(H - Margin),
		 X - F?label_text?right_side - Margin,
		 H - 2*Margin - F?pen),
	    send(F?tile, set, 0, 0, F?width-2*F?pen, F?height - H - 2*F?pen),

	    send(F?members, for_all, message(F, display, @arg1))
	;   send(F, scroll_to, point(0, 0)),
	    send(F, display, F?icon),
	    send(F, display, F?icon_label_text),
	    send(F?icon_label_text, center_x, F?icon?center_x),
	    send(F?icon_label_text, y, F?icon?bottom_side)
	).


request_geometry(F, X:[int], Y:[int], W:[int], H:[int]) :->
	"Add height for the title-bar"::
	(   get(F, closed, @off)
	->  (	H \== @default
	    ->	title_bar_height(F, _Margin, TH),
	        FH is TH + H
	    ;	FH = H
	    ),
	    FW = W
	;   FH = F?icon?height + F?icon_label_text?height + 2 * F?pen,
	    new(FW, number(F?icon?width)),
	    send(FW, maximum, F?icon_label_text?width),
	    send(FW, plus, 2 * F?pen)
	),
	send(F, geometry, X, Y, FW, FH).


tile(F, Tile:tile) :<-
	"Get root-tile of the window tree"::
	get(F?members?head, tile, SubTile),
	get(SubTile, root, Tile).


fit(F) :->
	"Fix layout"::
	get(F, tile, RootTile),
	send(RootTile, enforce),
	send(F, set,
	     @default, @default, RootTile?ideal_width, RootTile?ideal_height).


open(F, W:device, Pos:[point]) :->
	"Open the sub-frame on indicated device"::
	send(F, fit),
	send(W, display, F, Pos).


		 /*******************************
		 *	     BUTTONS		*
		 *******************************/

button(F, Op:'name|code', Image:[image], Place:[{left,right}]) :->
	"Attach a button to the titlebar"::
	default(Image, ?(Op, append, '.bm'), Img),

	new(Image16, image(@nil, 18, 18)),
	new(Bm, bitmap(Img)),
	send(Bm, center, point(9,9)),
	send(Image16, draw_in, Bm),
	send(Bm, done),
	send(Image16, draw_in, box(18,18)),

	(   Op == resize
	->  new(Button, twm_resize_button(Image16))
	;   new(Button, bitmap(Image16)),
	    (	atom(Op)
	    ->	Action = message(F, Op)
	    ;	Action = Op
	    ),
	    send(Button, recogniser, click_gesture(left, '', single, Action))
	),
	(   Place == right
	->  send(F?right_buttons, append, Button)
	;   send(F?left_buttons, append, Button)
	),
	(   get(F, device, Dev),
	    Dev \== @nil
	->  send(F, geometry)		% update
	;   true
	).


		 /*******************************
		 *	     EVENTS		*
		 *******************************/

:- pce_global(@open_subframe_recogniser,
	      new(handler_group(click_gesture(left, '', single,
					      message(@receiver, expose)),
				new(move_outline_gesture(left))))).
:- pce_global(@closed_subframe_recogniser,
	      new(handler_group(click_gesture(left, '', double,
					      message(@receiver, closed,
						      @off)),
				new(move_outline_gesture(left))))).


event(F, Ev:event) :->
	(   send(F, send_super, event)
	->  true
	;   (	get(F, closed, @off)
	    ->	send(@open_subframe_recogniser, event, Ev)
	    ;	send(@closed_subframe_recogniser, event, Ev)
	    )
	).

		 /*******************************
		 *     ICONIC REPRESENTATION	*
		 *******************************/

closed(F, Val:bool) :->
	"Change closed status"::
	(   get(F, closed, Val)
	->  true
	;   new(OtherArea, area),
	    send(OtherArea, copy, F?saved_area),
	    send(F?saved_area, copy, F?area),
	    send(F?graphicals, for_all, message(@arg1, displayed, @off)),
	    send(F, slot, closed, Val),
	    get(F, saved_pen, OtherPen),
	    send(F, slot, saved_pen, F?pen),
	    send(F, pen, OtherPen),
	    send(F, area, OtherArea),
	    send(F, expose)
	).


iconify(F) :->
	"->closed: @on (button call-back)"::
	send(F, closed, @on).

:- pce_end_class.

		 /*******************************
		 *               TEST		*
		 *******************************/

test :-
	send(new(@p, picture('Desktop', size(600, 500))), open),

	new(@p2, picture),
	send(new(@b, browser), right, @p2),
	send_list(@b, append, [aap, noot, mies]),

	new(@f, subframe('Hello')),
	send(@f, button, iconify, 'iconify.bm', left),
	send(@f, button, destroy, 'delete.bm', left),
	send(@f, button, resize, 'resize.bm', right),

	send(@f, append, @p2),
	send(@f, open, @p, point(50,50)),
	
	send(@p2, display, new(B, bitmap('pce.bm'))),
	send(B, recogniser, new(move_gesture)),

	new(@f2, subframe('I am small')),
	send(@f2, append, new(@p3, picture)),

	send(@f2, button, iconify, 'iconify.bm', left),
	send(@f2, button, destroy, 'delete.bm', left),
	send(@f2, button, resize, 'resize.bm', right),

	send(@f2, open, @p, point(200, 200)).
