/*  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
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

:- module(draw_attribute, []).
:- use_module(library(pce)).
:- require([ between/3
           , chain_list/2
           , default/3
           , forall/2
           , get_config/2
           , get_object/4
           , listen/3
           , member/2
           , send_list/3
           , set_config/2
           , unlisten/1
           ]).

:- pce_autoload(font_item, library(pce_font_item)).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This module defines a  separate frame that allows the  user to set the
values of attributes (pen, font, etc.) of  shapes in the drawing.  The
frame contains a single dialog window, which contains dialog_items for
each of the (graphical shape) attributes that can be edited.

Regardless of the shape(s) for  which we  are editing attributes,  all
dialog items are  always  displayed.  Items that represent  attributes
not present in the  shapes edited are  greyed out to indicate such  to
the user.  As the contents  of the window  changes  each time the user
changes the selection, non-used items are not removed from the dialog.
This would change too much  to the dialog,  transforming the interface
into a ``video clip''.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- pce_begin_class(draw_attribute_editor, frame).

variable(editor,        object,         get,
         "Editor I'm attached too").
variable(client,        chain*,         get,
         "Objects I'm editing the attributes for").
variable(blocked,       int := 0,       get,
         "Blocked count to avoid quadratic behaviour").

%       attributes(?Label, ?Selector)
%
%       Label is the label of the menu is the dialog.  Selector is the
%       name of the method to be activated to change the value.   Used
%       both ways around and only local to  this file, Prolog is a far
%       easier way to store this  table.  The  alternative would be to
%       create  a  sheet and  attach  it to the   class.   This  needs
%       extensions to the preprocessor.

attribute(pen,          pen).
attribute(dash,         texture).
attribute(arrow_1,      first_arrow).
attribute(arrow_2,      second_arrow).
%attribute(arrows,      arrows).
attribute(fill,         fill_pattern).
attribute(colour,       colour).
attribute(font,         font).
attribute(transparent,  transparent).
attribute(radius,       radius).
attribute(x,            x).
attribute(y,            y).
attribute(w,            width).
attribute(h,            height).
attribute(closed,       closed).
attribute(interpolation,interpolation).
attribute(shadow,       shadow).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the attribute  window.  Like  the drawing-tool as a whole,  the
window is a subclass of the PCE class `frame' for simple communication
with its various parts.  Note the use of default/3.

`Frame <->done_message' is activated when the   frame is deleted on user
request using the normal mechanism provided by the window system.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

initialise(A, Draw:object, Label:[name]) :->
    default(Label, 'Attributes', Lbl),
    send(A, send_super, initialise, Lbl),
    send(A, done_message, message(A, quit)),
    send(A, append, new(dialog)),
    send(A, slot, editor, Draw),
    send(A, fill_dialog),
    listen(A,
           set_config(draw_config:resources/_, _),
           send(A, config_changed)).


config_changed(A) :->
    get(A, member, dialog, D),
    send(D, clear),
    send(D, fill_dialog),
    send(D, layout),
    send(D, fit),
    (   get(A, client, Client), Client \== @nil
    ->  send(A, client, Client)
    ;   true
    ).


open(A, Pos:[point]) :->
    "Open at position from config database"::
    (   Pos == @default,
        get(A, editor, Draw), Draw \== @nil,
        get_config(draw_config:history/geometry/attributes, Diff)
    ->  get(Draw?area, position, Pos1),
        send(Pos1, plus, Diff)
    ;   Pos1 = Pos
    ),
    send(A, send_super, open, Pos1, normalise := @on).


unlink(A) :->
    "Save position in config database"::
    (   get(A, editor, Draw), Draw \== @nil,
        get(Draw?area, position, PDraw),
        get(A?area, position, PA),
        get_object(PA, difference, PDraw, Diff),
        set_config(draw_config:history/geometry/attributes, Diff)
    ->  true
    ;   true
    ),
    unlisten(A),
    send(A, send_super, unlink).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Fill the dialog with the various menus.  We defined some generic Prolog
predicates to create the various menu's.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

fill_dialog(A) :->
    get(A, member, dialog, D),
    get(A, editor, Canvas),
    get(Canvas, frame, Draw),

    make_line_menu(Pen,     pen,     [0,1,2,3,4,5]),
    make_line_menu(Texture, texture, [none, dotted, dashed, dashdot]),
    make_arrow_menu(Arrows1, Draw, first_arrow),
    make_arrow_menu(Arrows2, Draw, second_arrow),
    make_fill_pattern_menu(Draw, FillPattern),
    make_colour_menu(Draw, Colour),
    make_font_menu(Font),
    make_transparent_menu(Transparent),
    make_coordinate_menu(X, x),
    make_coordinate_menu(Y, y),
    make_coordinate_menu(W, width),
    make_coordinate_menu(H, height),
    make_radius_menu(Radius),
    make_closed_menu(Closed),
    make_shadow_menu(Shadow),
    make_interpolation_menu(Interpolation),

    send_list([Interpolation, Shadow], alignment, right),
    send_list([Y, W, H], alignment, left),

    send_list(D, append, [Pen, Texture]),
    send(D, append, Arrows1),
    (   get(Arrows1, width, WArrows1),
        WArrows1 > 200
    ->  send(D, append, Arrows2)
    ;   send(Arrows2, alignment, left),
        send(D, append, Arrows2, right)
    ),
    send_list(D, append, [FillPattern, Colour, Radius]),
    send(D, append, Shadow, right),
    send(D, append, Closed),
    send(D, append, Interpolation, right),
    send(D, append, Font),
    send(Transparent, alignment, left),
    send(D, append, Transparent, right),
    send(D, append, X),
    send(D, append, Y, right),
    send(D, append, W, right),
    send(D, append, H, right),

    send(D, append, button(quit, message(A, quit))).


                /********************************
                *             MENU'S            *
                ********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
To create the menu's, we defined a predicate  make_proto_menu/4.  Each
menu_item has as value the attribute value and as  label an image with
the prototype with the corresponding value  set.  Using this approach,
the user can easily  see what a specific   attribute means.  When  the
user selects a menu-item, the menu will send the value itself.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

make_line_menu(Menu, Attribute, Values) :-
    new(Proto, line(2, 8, 28, 8)),
    make_proto_menu(Menu, Proto, Attribute, Values),
    send(Proto, done).


make_arrow_menu(Menu, _Draw, Attribute) :-
    get_config(draw_config:resources/arrows, ArrowsChain),
    chain_list(ArrowsChain, Arrows),
    make_line_menu(Menu, Attribute, [@nil|Arrows]),
    send(Menu, attribute, equal_predicates,
         chain(equal_arrows, close_arrows)).

equal_arrows(X, X) :- !.
equal_arrows(A1, A2) :-
    send(A1, instance_of, arrow),
    send(A2, instance_of, arrow),
    equal_attributes([ class_name,
                       length, wing,
                       pen, texture, style,
                       fill_pattern, colour
                     ],
                     A1, A2).

close_arrows(X, X) :- !.
close_arrows(A1, A2) :-
    send(A1, instance_of, arrow),
    send(A2, instance_of, arrow),
    equal_attributes([ class_name,
                       pen, texture, style,
                       fill_pattern, colour
                     ],
                     A1, A2).

equal_attributes([], _, _).
equal_attributes([A|T], O1, O2) :-
    (   send(O1, has_get_method, A)
    ->  get(O1, A, V1),
        get(O2, A, V2),
        catch(send(V1, equal, V2), _, fail)
    ;   true
    ),
    equal_attributes(T, O1, O2).

make_fill_pattern_menu(_Draw, Menu) :-
    get_config(draw_config:resources/fill_palette, PatternsChain),
    chain_list(PatternsChain, Patterns0),
    realise_patterns(Patterns0, Patterns),
    new(Proto, box(30, 16)),
    make_proto_menu(Menu, Proto, fill_pattern, Patterns),
    send(Proto, done).

realise_patterns([], []).
realise_patterns([Image|T0], [Image|T]) :-
    object(Image),
    send(Image, instance_of, image),
    !,
    realise_patterns(T0, T).
realise_patterns([Name|T0], [Image|T]) :-
    pce_catch_error(_Error, new(Image, image(Name))),
    !,
    realise_patterns(T0, T).
realise_patterns([_|T0], T) :-
    realise_patterns(T0, T).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The colour menu.  When the display  is not a colour  display, the only
possible colours of an object are @default (implying the colour of the
device),  `white' and `black'.   On colour displays  we will show some
more  possibilities.  For  a somewhat  larger  set of choices, a cycle
menu may be more appropriate.

\index{colour}
Currently  the only  way  to  find   out  whether you are   using    a
black-and-white or colour display is `@display  <-depth'.  This is the
number of bits the screen uses to represent a single pixel.

Note   that  the colour  palette   is  constructed  from   a  box with
@black_image    fill pattern.   The problem  here     is  the name  of
@black_image.  It does  not represent  the  colour black, but only  an
image with all pixels set to 1.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

colour_display :-
    \+ get(@display, depth, 1).

colour(_Draw, Colour) :-
    colour_display,
    !,
    get_config(draw_config:resources/colour_palette, ColoursChain),
    chain_list(ColoursChain, Colours),
    member(ColourName, Colours),
    get(@pce, convert, ColourName, colour, Colour).
colour(_, colour(white)).
colour(_, colour(black)).

make_colour_menu(Draw, Menu) :-
    new(Proto, box(30, 16)),
    send(Proto, fill_pattern, @black_image),
    findall(Colour, colour(Draw, Colour), Colours),
    make_proto_menu(Menu, Proto, colour, [@default|Colours]),
    send(Proto, done).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The menu below is for the `transparent'  attribute of text.   When @on
(default), only the pixels of  the font are affected.   Otherwise, the
bounding box of the text will be  cleared first.  Non-transparent text
is often used to mark lines or display on top of filled areas.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

make_transparent_menu(Menu) :-
    new(Proto, figure),
    send(Proto, display, new(B, box(30,16))),
    send(B, fill_pattern, @grey50_image),
    send(Proto, display, new(T, text('T', left,
                                      font(screen, roman, 10)))),
    send(T, center, B?center),
    send(Proto, send_method, send_method(transparent, vector(bool),
                                         message(T, transparent, @arg1))),
    make_proto_menu(Menu, Proto, transparent, [@on, @off]),
    get(Menu, reference, Ref),
    get(Ref, copy, CRef),
    send(Menu, show_label, @off),
    send(Menu, reference, CRef),
    send(Proto, done).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create  a menu for  some prototype attribute.   Each menu_item   has a
`menu_item <->value'  equal   to  the corresponding  element    of the
`Values'  chain.  Each  label  is a image   with an  outline-box  and
`Proto' with the appropriate attribute setting drawn into it.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- pce_global(@menu_proto_box, new(box(30,16))).

make_proto_menu(Menu, Proto, Attribute, Values) :-
    new(Menu, draw_proto_menu(Attribute)),
    (   Attribute == colour
    ->  Kind = pixmap
    ;   Kind = bitmap
    ),
    (   member(Value, Values),
            send(Proto, Attribute, Value),
            new(I, image(@nil, 30, 16, Kind)),
            send(I, draw_in, @menu_proto_box),
            send(I, draw_in, Proto),
            send(Menu, append, menu_item(Value, @default, I)),
            fail
    ;   true
    ),
    length(Values, N),
    Cols is (N+9) // 10,
    send(Menu, columns, Cols).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The coordibate menu is a rather trivial  text_item.  Note the setting of
the field-width and `dialog_item ->alignment:  left'.  The latter places
the items just right to one  another   instead  of vertically aligned in
columns.

NOTE:   We should make a subclass to allow for entering integers only.
        To do this properly, we should know about each keystroke in
        the menu rather than only the return.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

make_coordinate_menu(Menu, Selector) :-
    attribute(Label, Selector),
    coordinate_range(Selector, Low, High),
    new(Menu, int_item(Label, 0,
                       message(@receiver?frame, client_attribute,
                               Selector, @arg1), Low, High)),
    send(Menu, length, 5).

coordinate_range(x,      -9999, 9999).
coordinate_range(y,      -9999, 9999).
coordinate_range(width,  -9999, 9999).
coordinate_range(height, -9999, 9999).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The radius of a box is  the radius of  the circle sections (arcs) used
for rounding  the corners.  As the  user propably   does  not want  to
specify an exact   number of pixels,   a  slider-menu is used.   As  a
disadvantage, the range has to be specified in advance, and 100 is not
the absolute limit.  Note that by setting both the range and the width
to 100, the slider operates 1:1.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

make_radius_menu(Menu) :-
    attribute(Label, radius),
    new(Menu, slider(Label, 0, 100, 0,
                     message(@receiver?frame, client_attribute,
                             radius, @arg1))),
    send(Menu, drag, @on),
    send(Menu, width, 100).


make_shadow_menu(Menu) :-
    attribute(Label, shadow),
    new(Menu, menu(Label, cycle,
                   message(@receiver?frame, client_attribute,
                           shadow, @arg1))),
    forall(between(0, 5, Shadow), send(Menu, append, Shadow)).


make_closed_menu(Menu) :-
    attribute(Label, closed),
    new(Menu, menu(Label, choice,
                   message(@receiver?frame, client_attribute,
                           closed, @arg1))),
    send_list(Menu, append, [@off, @on]).


make_interpolation_menu(Menu) :-
    attribute(Label, interpolation),
    new(Menu, slider(Label, 0, 10, 0,
                     message(@receiver?frame, client_attribute,
                             interpolation, @arg1))),
    send(Menu, width, 100).


                /********************************
                *             FONTS             *
                ********************************/

make_font_menu(M) :-
    new(M, font_item(font, @default,
                     message(@receiver?frame, client_attribute,
                             font, @arg1))).


                /********************************
                *              QUIT             *
                ********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
For a secondary  window like  this  attribute  editor,  it might be  a
useful idea  not to destroy the window  if the user  hits  `quit', but
just to unmap it from the display using `Frame ->show: @off'.  In this
case, it can  be remapped on the  display very  quickly   and when the
window has certain status  information attached to  it,  this  will be
maintained.   For the   case of this editor,  this  only concernes the
coordinates of the window.

To control between  actual  destruction  and   just unmapping it,   an
optional   boolean   argument has been   attached.  This  approach has
several advantages.  If  the caller wants to  descriminate, it can  do
so.  For all cases where the caller does not want  to discriminate, we
have one central place to change the default behaviour.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

quit(A, ShowOff:[bool]) :->
    (   ShowOff == @on
    ->  send(A, show, @off)
    ;   send(A?editor, attribute_editor, @nil),
        send(A, free)
    ).


                /********************************
                *     CLIENT COMMUNICATION      *
                ********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
->fill_items fills and  (de)activates all  dialog items.  The argument
is a chain of shapes (normally the <-selection of the canvas).  If one
of the elements of the selection  has the specified attribute, it will
be activated and the ->selection of the menu will be set accordingly.

If more than one object   in the  selection  has some  attribute,  the
->selection  of the  item  will  be the attribute  value of  the first
object in the chain that is has the attibute.  This is a rather simple
way of handling this case, but what else can we do?
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

fill_items(A, Client:chain) :->
    "Fill the dialog items from chain of shapes"::
    get(A, member, dialog, Dialog),
    (   attribute(Label, Selector),
        get(Dialog, member, Label, Menu),
        (   get(Client, find,
                and(message(@arg1, has_send_method, has_attribute),
                    message(@arg1, has_attribute, Selector)),
                Proto),
            get(Proto, draw_attribute, Selector, Value)
        ->  send(Menu, active, @on),
            set_selection(Menu, Value)
        ;   send(Menu, active, @off)
        ),
        fail
    ;   true
    ).

set_selection(Menu, Value) :-
    send(Menu, instance_of, menu),
    !,
    (   get(Menu, member, Value, Item)
    ->  send(Menu, selection, Item)
    ;   get(Menu, attribute, equal_predicates, PredChain),
        chain_list(PredChain, Preds),
        member(Pred, Preds),
        get(Menu?members, find,
            message(@prolog, Pred, @arg1?value, Value),
            Item)
    ->  send(Menu, selection, Item)
    ;   true
    ).
set_selection(Menu, Value) :-
    send(Menu, selection, Value).


block(A) :->
    "<-blocked++"::
    get(A, blocked, B0),
    B1 is B0 + 1,
    send(A, slot, blocked, B1).

unblock(A) :->
    "<-blocked--"::
    get(A, blocked, B0),
    B1 is B0 - 1,
    send(A, slot, blocked, B1).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set the chain of shapes for which we are editing the attributes.  Note
that if the window is not shown, we won't update the contents.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

client(A, Client:chain*) :->
    "Set the graphical I'm editing"::
    get(A, member, dialog, Dialog),
    (   get(A, blocked, B), B == 0
    ->  (    Client == @nil
        ->   send(Dialog?graphicals, for_some,
                  message(@arg1, active, @off))
        ;    send(A, fill_items, Client)
        )
    ;   true
    ),
    send(A, slot, client, Client).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set the value of an attribute for the clients.  The value is set for
each shape that accepts ->has_attribute.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

client_attribute(A, Selector:name, Val:any) :->
    "Set attribute of client object"::
    (   get(A, client, Chain),
        Chain \== @nil,
        get(Chain, head, Head)
    ->  send(A, block),
        get(Head, window, Window),
        send(Window, open_undo_group),
        send(A?client, for_some,
             if(message(@arg1, has_attribute, Selector),
                message(@arg1, draw_attribute, Selector, Val))),
        send(Window, close_undo_group),
        send(A, unblock)
    ;   true
    ).

:- pce_end_class.

:- pce_begin_class(draw_proto_menu, menu).

initialise(Menu, Attribute:name) :->
    attribute(Label, Attribute),
    send(Menu, send_super, initialise,
         Label, choice,
         message(@receiver?frame, client_attribute, Attribute, @arg1)),
    send(Menu, off_image, @nil),
    send(Menu, border, 2),
    send(Menu, layout, horizontal).

:- pce_end_class.