/* 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. */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module defines the mode-selection menu at the left-side of the canvas. It consists of two classes: draw_menu, which is a subclass of picture and which is responsible for communication, load/save, etc. and draw_icon, which defines the combination of a mode, a cursor and a prototype. There are two reasonable primitives for implementing this menu. The first is to use a dialog window and a choice menu, of which the menu_items have image labels. The second is the approach taken in this file, to use a picture with a 1-column format attached to it and images for the options. Which of them is to be preferred is difficult to tell. Both approaches require about the same amount of programming. I've chosen for the latter approach, partly for `historical' reasons and partly to illustrate how non-standard menus can be created using ordinary graphicals. As the user can modify the menu by adding/deleting prototypes and changing prototype attributes, the contents of this menu can be saved to file. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- module(draw_menu, []). :- use_module(library(pce)). :- require([ default/3 , memberchk/2 ]). /******************************** * ICON MENU * ********************************/ :- pce_begin_class(draw_menu, dialog). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Variables to keep track of load/save. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ variable(file, file*, both, "File for storing prototypes"). variable(modified, bool, get, "Menu has been modified"). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The menu of with the modes and prototypes is a dialog window with a displayed menu. This is one of the many possibilities. When updating this documentation, it would have been a more natural choice to use a dialog window with an attached format and buttons using an `image' label for the modes. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initialise(M) :-> send(M, send_super, initialise, 'Icons'), send(M, gap, size(0,0)), send(M, ver_shrink, 100), send(M, ver_stretch, 100), send(M, display, new(P, menu(proto, choice, message(@arg1, activate)))), send(P, layout, vertical), send(P, show_label, @off), send(M, resize_message, message(M, new_size, @arg2)), send(M, modified, @off). new_size(M, Size:size) :-> get(M, member, proto, Menu), get(Size, width, W), Cols is max(1, W // 48), send(Menu, columns, Cols). modified(M, Value:[bool]) :-> default(Value, @on, Val), send(M, slot, modified, Val). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Attach a new prototype. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ proto(M, Proto:proto='graphical|link*', Mode:'mode=name', Cursor:cursor=cursor, Icon:icon=[image], Tag:tag=[name], UserProto:user_proto=[bool]) :-> "Attach a new prototype":: default(UserProto, @off, UProto), get(M, member, proto, Menu), send(Menu, append, new(I, draw_icon(Proto, Mode, Cursor, Icon))), ( Tag \== @default, send(I, has_send_method, help_message) % help message package -> send(I, help_message, tag, Tag) % loaded ; true ), send(I, user_proto, UProto), send(M, adjust), send(M, modified, @on). adjust(M) :-> "Make it wide enough to display all items":: ( get(M, displayed, @on) -> get(M?visible, height, H), get(M, member, proto, Menu), get(Menu?members, size, S), get(Menu, border, B), Rows is max(1, H//(32+2*B)), Cols is (S+Rows-1)//Rows, ( get(Menu, columns, Cols) -> true ; send(Menu, columns, Cols), send(M, ideal_width, Menu?width), send(M?frame, resize) ) ; true ). current(M, Icon:draw_icon) :<- "Find current icon":: get(M, member, proto, Menu), get(Menu, selection, Icon). find_icon(M, Cond:code, Icon:draw_icon) :<- "Find icon from condition":: get(M, member, proto, Menu), get(Menu?members, map, @arg1?value, Icons), get(Icons, find, Cond, Icon). activate_select(M) :-> "Activate icon that does select":: get(M, member, proto, Menu), get(Menu?members, find, @arg1?(mode) == select, Item), send(Item, activate). /******************************* * STYLE * *******************************/ columns(M, Cols:'0..') :-> "Set # columns in menu":: get(M, member, proto, TheMenu), send(TheMenu, columns, Cols). /******************************** * CREATE * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create a prototype from a chain of graphicals (usually the selection; in the future this might also come from a prototype editor). If the chain has one element, no compound is needed. NOTE: Due to the improper functioning of <-clone with regards to connections to the outside world, all connections should be internal to the chain of graphicals. We won't try to program around this problem here, but improve PCE's kloning schema later. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ create_proto(M, Graphicals:chain, How:{as_is,virgin}) :-> "Create a prototype from a chain of graphicals":: get(Graphicals, size, Size), ( Size == 0 -> send(M, report, error, 'No selection') ; Size == 1 -> get(Graphicals, head, Sel1), clone_proto(How, Sel1, Proto), send(Proto, selected, @off) ; new(Proto, draw_compound), get(Graphicals, clone, Members), send(Members, for_all, and(message(Proto, display, @arg1), message(@arg1, selected, @off))), send(Proto, reference, @default), send(Proto, string, '') ), mode_and_cursor_from_proto(How, Proto, Mode, Cursor), send(M, proto, Proto, Mode, Cursor, user_proto := @on). clone_proto(_, Connection, Clone) :- send(Connection, instance_of, connection), !, get(Connection, link, Link), get(Link, clone, Clone), send(Clone, copy, Connection). clone_proto(virgin, Path, Clone) :- send(Path, instance_of, path), get(Path, clone, Clone), send(Clone, clear). clone_proto(_, Graphical, Clone) :- get(Graphical, clone, Clone). mode_and_cursor(text, draw_text, xterm). mode_and_cursor(box, draw_resize, crosshair). mode_and_cursor(ellipse, draw_resize, crosshair). mode_and_cursor(line, draw_line, crosshair). mode_and_cursor(path, draw_path, cross). mode_and_cursor(link, draw_connect, plus). mode_and_cursor_from_proto(as_is, _Proto, draw_proto, dotbox) :- !. mode_and_cursor_from_proto(virgin, Proto, Mode, Cursor) :- mode_and_cursor(Class, Mode, Cursor), send(Proto, instance_of, Class). /******************************** * DELETE * ********************************/ can_delete(M) :-> "Test if current prototype may be deleted":: get(M, current, Icon), send(Icon, can_delete). delete(M, Icon0:[draw_icon]) :-> "Delete current prototype":: ( Icon0 == @default -> get(M, current, Icon), ( send(Icon, can_delete) -> send(M, activate_select) ; send(@display, inform, 'Can''t delete this prototype'), fail ) ; Icon = Icon0 ), send(Icon, free), send(M, modified, @on). clear(M) :-> "Remove all prototypes":: get(M, member, proto, TheMenu), send(TheMenu, clear). /******************************** * SAVE/LOAD * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Saving/loading is very similar to the corresponding code in canvas.pl. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ save_as(M) :-> "Save in user-requested file":: get(@finder, file, @off, '.proto', File), send(M, save, File). save(M, File:[file]) :-> "Save prototypes to named file":: ( File == @default -> get(M, file, SaveFile), SaveFile \== @nil ; send(M, file, File), SaveFile = File ), get(M, proto_sheet, Sheet), send(Sheet, save_in_file, SaveFile), send(M, report, status, 'Prototypes saved in %s', SaveFile?absolute_path), send(M, modified, @off). proto_sheet(M, Sheet:sheet) :<- "Fetch description of user prototypes in a sheet":: new(Sheet, sheet(attribute(pcedraw_prototype_version, 1), attribute(protos, new(Protos, chain)))), get(M, member, proto, Menu), send(Menu?members, for_all, message(M, append_proto_sheet, Protos, @arg1)). append_proto_sheet(_M, Protos:chain, Icon:draw_icon) :-> "Append a single proto to Protos":: ( get(Icon, user_proto, @on) -> get(Icon, mode_cursor, CursorName), get(Icon, mode, Mode), get(Icon, slot, proto, Proto), % also @nil ! send(Protos, append, sheet(attribute(cursor, CursorName), attribute(mode, Mode), attribute(proto, Proto))) ; true ). proto_sheet(M, Sheet:sheet, Clear:[bool]) :-> "Load prototype definitions from sheet":: get(M, member, proto, Menu), ( Clear == @on -> send(Menu, clear), send(M?frame, fill_menu) ; true ), get(Sheet, protos, Chain), send(Chain, for_all, message(M, proto, @arg1?proto, @arg1?mode, @arg1?cursor, user_proto := @on)). load_from(M) :-> "Load from user-requested file":: get(@finder, file, @on, '.proto', File), send(M, load, File). load(M, File:[file]) :-> "Load prototypes from named file":: ( File == @default -> get(M, file, LoadFile), LoadFile \== @nil ; send(M, file, File), LoadFile = File ), get(LoadFile, object, ProtoSheet), ( send(ProtoSheet, instance_of, sheet), get(ProtoSheet, pcedraw_prototype_version, 1) -> send(M, proto_sheet, ProtoSheet, @on), send(M, activate_select), send(M, adjust), send(M, modified, @off) ; send(M, report, error, 'File contains old or no PceDraw prototypes') ). :- pce_end_class. /******************************** * ICONS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - We have chosen to specialise class `bitmap' to represent the icon. Each icon represents a prototype, a mode and a cursor that is used by the canvas to indicate the mode. The visual representation of an icon is an outline that indicates the mode and a small version of the prototype to indicate what is drawn. There are two reasonable choices for this job. One is to use a subclass of device and display the outline and a resized clone of the prototype. The other is to use class bitmap and draw a clone of the prototype in it. It is difficult to say which of the two is better. I finally decided that just a bitmap is cheaper to save (considering the fact that the device case holds a bitmap of the same size too). Another criterium is how difficult it is to change an argument of the prototype. For a device this is slightly simpler as we just pass the message to change the argument to the prototype and the clone of the prototype displayed in the icon. Using a bitmap, we have to recompute the contents of the bitmap. This however is not very hard. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(draw_icon, menu_item). variable(proto, 'graphical|link*', none, "Prototype represented"). variable(mode, name, both, "Mode initiated by the icon"). variable(mode_cursor, name, both, "Associated cursor-name"). variable(user_proto, bool := @off, both, "Prototype was created by the user"). item_size(48,32). initialise(I, Proto:'graphical|link*', Mode:name, Cursor:cursor, Image:[image]) :-> "Create an icon for a specific mode":: send(I, send_super, initialise, @nil), send(I, slot, value, I), % hack, needs to be fixed! send(I, mode, Mode), send(I, proto, Proto, Image), send(I, slot, mode_cursor, Cursor?name). proto(I, Proto:'graphical|link') :<- get(I, slot, proto, Proto), Proto \== @nil. can_delete(I) :-> "Can I delete this icon?":: get(I, user_proto, @on). /******************************** * PROTOTYPES * ********************************/ proto(I, Proto:'graphical|link*', Image:[image]) :-> "Set the prototype":: send(I, slot, proto, Proto), ( Image == @default -> send(I, paint_proto) ; send(I, label, Image) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create the image of the icon. First, we will paint the outline, indicating the mode. Next, we make a copy of the prototype (because we have to modify it and we should not change the original prototype), modify the text to `T' and the size to fit in the icon. Finally, we draw the prototype in the icon and send `Object ->done' to the clone to inform PCE we have done with it. The general case uses an intermediate device to ensure that if the prototype creates additional graphicals, these are displayed correctly. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ paint_proto(MI) :-> "Paint a small version of the prototype":: get(MI, slot, proto, Proto), item_size(IW, IH), send(MI, label, new(I, image(@nil, IW, IH))), send(MI, paint_outline), ( Proto == @nil -> true ; send(Proto, instance_of, link) -> new(Dev, device), % links (connection) send(Dev, display, new(B1, box(0,0)), point(11, 10)), send(Dev, display, new(B2, box(0,0)), point(27, 20)), send(B1, handle, handle(0, 0, Proto?from)), send(B2, handle, handle(0, 0, Proto?to)), ( get(Proto, attribute, draw_connection_class, Class) -> true ; Class = draw_connection ), Term =.. [Class, B1, B2, Proto], new(Connection, Term), ( send(Connection, has_send_method, menu_text) -> send(Connection, menu_text) ; true ), send(I, draw_in, Dev), send(Dev, destroy) ; send(Proto, instance_of, path), % Path case send(Proto?points, empty) -> get(Proto, clone, Clone), send(Clone, clear), send(Clone, append, point(10,10)), send(Clone, append, point(20,7)), send(Clone, append, point(30,15)), send(Clone, append, point(15,21)), send(I, draw_in, Clone) ; send(Proto, instance_of, bezier_curve) % Bezier curves -> get(Proto, clone, Clone), send(Clone, start, point(5,23)), send(Clone, end, point(35,23)), send(Clone, control1, point(15,0)), send(Clone, control2, point(48,0)), send(I, draw_in, Clone) ; new(D, device), % general case get(Proto, clone, Clone), ( send(Clone, has_send_method, menu_text) -> send(Clone, menu_text) ; true ), ( get(MI, mode, draw_proto) -> get(Clone, size, size(PW, PH)), ( (PW/30) > (PH/20) -> DW = 30, DH is integer(30 * PH/PW) ; DH = 20, DW is integer(20 * PW/PH) ) ; DW = 30, DH = 14 ), send(Clone, size, size(DW, DH)), send(D, display, Clone), send(D, center, point(22, 14)), send(I, draw_in, D) ), send(MI, label, I). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Paint the outline in the bitmap. For each of the outlines, there is a bitmap file named `Mode.bm' in PCE's bitmap search-path. We copy this image in the bitmap. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ paint_outline(MI) :-> "Paint the mode indicating bitmap":: get(MI, label, I), get(MI, mode, Mode), outline_image(Mode, ImageFile), send(I, copy, image(resource(ImageFile))). outline_image(select, 'select.bm'). outline_image(draw_text, 'draw_text.bm'). outline_image(draw_resize, 'draw_resize.bm'). outline_image(draw_line, 'draw_line.bm'). outline_image(draw_bezier, 'draw_line.bm'). outline_image(draw_path, 'draw_path.bm'). outline_image(draw_connect, 'draw_connect.bm'). outline_image(draw_cconnect, 'draw_cconnect.bm'). outline_image(draw_proto, 'draw_proto.bm'). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Hook to find the resource. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ resource(Name, image, image(Name)) :- outline_image(_, Name). /******************************** * ATTRIBUTES * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - These two methods from the interface to the attribute editor. See also the files `attribute.pl' and `shape.pl'. Note that prototypes do not have a position and therefore the `x' and `y' should not be regarded arguments. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ has_attribute(I, Att:name) :-> "Test if prototype has named attribute":: \+ memberchk(Att, [x, y]), send(I?proto, has_attribute, Att). draw_attribute(I, Att:name, Val:any) :-> "Set attribute of prototype":: send(I?proto, draw_attribute, Att, Val), send(I, repaint_proto), send(I?window, modified, @on). /******************************** * ACTIVATION * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Activate an icon. First it sets `Graphical ->inverted' to @on for only this icon in the menu. Note the use of `Device ->for_all' and `if'. This is the most efficient way to reach our goals, both in terms of the amount of code we have to write as in terms of performance. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ activate(I) :-> "Select the icon; set mode and proto":: get(I, menu, Menu), send(Menu, selection, I), send(Menu?frame, mode, I?mode, I?mode_cursor), ( get(I, proto, Proto) -> send(Menu?frame, proto, Proto) ; send(Menu?frame, proto, @nil) ). :- pce_end_class.