code.delx.au - gnu-emacs/blob - test/etags/erl-src/gs_dialog.erl

   1 -module(gs_dialog). % behaviour
   2 -define(VERSION, '2001.1101').
   3 -vsn(?VERSION).
   4 -author('cpressey@catseye.mb.ca').
   5 -copyright('Copyright (c)2001 Cat`s Eye Technologies. All rights reserved.').
   6
   7 %%% Redistribution and use in source and binary forms, with or without
   8 %%% modification, are permitted provided that the following conditions
   9 %%% are met:
  10 %%%
  11 %%%   Redistributions of source code must retain the above copyright
  12 %%%   notice, this list of conditions and the following disclaimer.
  13 %%%
  14 %%%   Redistributions in binary form must reproduce the above copyright
  15 %%%   notice, this list of conditions and the following disclaimer in
  16 %%%   the documentation and/or other materials provided with the
  17 %%%   distribution.
  18 %%%
  19 %%%   Neither the name of Cat's Eye Technologies nor the names of its
  20 %%%   contributors may be used to endorse or promote products derived
  21 %%%   from this software without specific prior written permission.
  22 %%%
  23 %%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  24 %%% CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  25 %%% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  26 %%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27 %%% DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
  28 %%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
  29 %%% OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  30 %%% PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
  31 %%% OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  32 %%% ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
  33 %%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  34 %%% OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  35 %%% POSSIBILITY OF SUCH DAMAGE.
  36
  37 -export([behaviour_info/1,
  38          show/4,
  39          test/0]).
  40
  41 %%% BEGIN gs_dialog.erl %%%
  42
  43 %%% This module specifies a common behaviour for "modal" dialog boxes
  44 %%% using GS.
  45
  46 %%--------------------------------------------------------------------
  47 %% behaviour_info(callbacks) -> ListOfFunctionArityTuples
  48 %% Used by R8 to check the implementation modules for consistency
  49 %% with the behaviour specification, what callbacks this module needs.
  50
  51 behaviour_info(callbacks) ->
  52   [
  53
  54     %%----------------------------------------------------------------
  55     %% Module:buttons() -> ListOfAtoms
  56     %% Should return the labels used on the main (non-extra) buttons
  57     %% of the dialog box.
  58     %% e.g. ['OK', 'Cancel'].
  59
  60     {buttons, 0},
  61
  62     %%----------------------------------------------------------------
  63     %% Module:icon() -> FileNameString | {Text, FgColour, BgColour}
  64     %% Should return the the icon displayed in the dialog box.
  65     %% This should either be the fully qualified filename of a 32x32 GIF
  66     %% file (e.g. in the application's priv dir,) or a 3-tuple
  67     %% describing a simple "circle" icon to be rendered by GS itself.
  68     %% The latter option was added because some versions of Erlang for
  69     %% Windows use a Tk emulation package which is not always on the
  70     %% ball when it comes to correct image transparency and colour.
  71     %% e.g. filename:join(code:priv_dir(?MODULE), "notify.gif")
  72
  73     {icon, 0},
  74
  75     %%----------------------------------------------------------------
  76     %% Module:controls(Parent, ArgList) -> {GSControl | nil, NewArgList}
  77     %% Used by the implementation to provide extra controls in the dialog
  78     %% box, if any.  If not, nil should be returned instead of the control.
  79     %% If many controls are added, it is recommended they are placed in a
  80     %% frame, with the frame returned as the control.
  81     %% The control need not have positioning information, as it will be
  82     %% assigned a pack_xy option when it is placed into the Parent frame.
  83     %% The list of arguments may be modified by this callback.
  84     %% e.g. {nil, Args}
  85
  86     {controls, 2},
  87
  88     %%----------------------------------------------------------------
  89     %% Module:on_key(ExtraControl, KeyAtom, ArgList) ->
  90     %%   {button, ButtonNameAtom} | nil
  91     %% Called when a key is pressed in the dialog box.  The return value
  92     %% specified whether it is linked to pressing a button, or whether it
  93     %% it is ignored and passed on to a further handler (if any.)
  94
  95     {on_key, 3},
  96
  97     %%----------------------------------------------------------------
  98     %% Module:on_button(ExtraControl, ButtonNameAtom, ArgList) -> Result
  99     %% Called when one of the main (non-extra) buttons are pressed in
 100     %% the dialog box.  Since this closes the dialog box, the implementation
 101     %% module is expected to provide a final result term with this function.
 102
 103     {on_button, 3},
 104
 105     %%----------------------------------------------------------------
 106     %% Module:on_event(ExtraControl, Event, ArgList) -> Result
 107     %% Allows the implementation module to handle other GS events,
 108     %% e.g. those generated by the extra controls specified.
 109
 110     {on_event, 3}
 111   ].
 112
 113 %%% Public Interface
 114
 115 %%--------------------------------------------------------------------
 116 %% show(ModuleNameAtom, TitleString, MessageString, ArgList) -> Result
 117 %% Display a generic modal dialog box, customized by the
 118 %% callback functions in Module.  This should be called by
 119 %% the 'show' function in the Module in question.
 120 %% The argument list is passed back to the callback functions in the
 121 %% module, for retaining information pertinent to the callback module;
 122 %% the behaviour itself does not inspect or care about this list.
 123
 124 show(Module, Title, Message, Args) ->
 125   Screen = gs:start(),
 126   Buttons = Module:buttons(),
 127   NumButtons = length(Buttons),
 128   application:load(?MODULE),
 129   {ok, Font} = application:get_env(?MODULE, font),
 130   {ok, {ScreenWidth, ScreenHeight}} =
 131     application:get_env(?MODULE, screen_size),
 132   {ok, {DialogWidth, DialogHeight}} =
 133     application:get_env(?MODULE, dialog_size),
 134   Window = gs:create(window, Screen,
 135     [{width, DialogWidth}, {height, DialogHeight},
 136      {x, (ScreenWidth - DialogWidth) div 2},
 137      {y, (ScreenHeight - DialogHeight) div 2},
 138      {title, Title},
 139      {configure, true}, {keypress, true}]),
 140   Frame = gs:create(frame, Window,
 141     [{bw, 0},
 142      {packer_x, lists:duplicate(NumButtons, {stretch, 1})},
 143      {packer_y, [{stretch, 1},{stretch, 2},{stretch, 1}]}]),
 144   case Module:icon() of
 145     nil ->
 146       Label = gs:create(label, Frame,
 147         [{label, {text, Message}}, {font, Font}, {justify, center},
 148          {pack_xy, {{1, NumButtons}, 1}}]);
 149     {Text, Fg, Bg} ->
 150       InnerFrame = gs:create(frame, Frame,
 151         [{pack_xy, {{1, NumButtons}, 1}}, {bw, 0},
 152          {packer_x, [{stretch, 1}, {fixed, 32}, {stretch, 8}]},
 153          {packer_y, [{stretch, 1}, {fixed, 32}, {stretch, 1}]}]),
 154       IconCanvas = gs:create(canvas, InnerFrame,
 155         [{pack_xy, {2, 2}}]),
 156       IconCircle = gs:create(oval, IconCanvas,
 157         [{coords, [{0, 0}, {31, 31}]}, {fg, black}, {fill, Bg}]),
 158       IconFont = {screen, bold, 24},
 159       {ITW,ITH} = gs:read(IconCanvas, {font_wh, {IconFont, Text}}),
 160       ITX = 16 - ITW div 2,
 161       ITY = 16 - ITH div 2,
 162       IconText = gs:create(text, IconCanvas,
 163         [{coords, [{ITX, ITY}]}, {fg, Fg}, {text, Text}, {font, IconFont}]),
 164       Label = gs:create(label, InnerFrame,
 165         [{label, {text, Message}}, {font, Font}, {justify, center},
 166          {pack_xy, {3, {1,3}}}]);
 167     FileName when list(FileName) ->
 168       InnerFrame = gs:create(frame, Frame,
 169         [{pack_xy, {{1, NumButtons}, 1}}, {bw, 0},
 170          {packer_x, [{stretch, 1}, {fixed, 32}, {stretch, 8}]},
 171          {packer_y, [{stretch, 1}, {fixed, 32}, {stretch, 1}]}]),
 172       IconCanvas = gs:create(canvas, InnerFrame,
 173         [{pack_xy, {2, 2}}]),
 174       Icon = gs:create(image, IconCanvas, [{coords, [{0, 0}]},
 175                                            {load_gif, FileName}]),
 176       Label = gs:create(label, InnerFrame,
 177         [{label, {text, Message}}, {font, Font}, {justify, center},
 178          {pack_xy, {3, {1,3}}}])
 179   end,
 180   {Extra, NewArgs} = Module:controls(Frame, Args),
 181   case Extra of
 182     nil -> gs:config(Frame, {packer_y, [{stretch, 2},{fixed, 0},{stretch, 1}]});
 183     _   -> gs:config(Extra, {pack_xy, {{1, NumButtons}, 2}})
 184   end,
 185   lists:foldl(fun(X, A) ->
 186        I = gs:create(frame, Frame, [{packer_x, [{stretch, 1}, {fixed, 80}, {stretch, 1}]},
 187                                     {packer_y, [{stretch, 1}, {fixed, 24}, {stretch, 1}]},
 188                                     {pack_xy, {A, 3}}]),
 189        gs:create(button, I, [{label, {text, atom_to_list(X)}}, {font, Font},
 190                              {data, {button, X}},
 191                              {pack_xy, {2, 2}}]),
 192        A + 1
 193        end, 1, Buttons),
 194   gs:config(Frame, [{width, DialogWidth}, {height, DialogHeight}]),
 195   {MessageWidth, MessageHeight} = gs:read(Frame, {font_wh, {Font, Message}}),
 196   case MessageWidth of
 197     N1 when N1 > trunc(DialogWidth * 0.8) ->
 198         NewDialogWidth = trunc(MessageWidth * 1.2),
 199         gs:config(Window,
 200           [{width, NewDialogWidth},
 201            {x, (ScreenWidth - NewDialogWidth) div 2}]);
 202     _ -> ok
 203   end,
 204   case MessageHeight of
 205     N2 when N2 > trunc(DialogHeight * 0.666) ->
 206         NewDialogHeight = trunc(MessageHeight * 1.666),
 207         gs:config(Window,
 208           [{height, NewDialogHeight},
 209            {y, (ScreenHeight - NewDialogHeight) div 2}]);
 210     _ -> ok
 211   end,
 212   gs:config(Window, {map, true}),
 213   dialog_loop(Module, Window, Frame, Extra, NewArgs).
 214
 215 %%--------------------------------------------------------------------
 216 %% dialog_loop(Module, Window, Frame, Extra, Args) -> Result
 217 %% Called by show/4, handles generic events in a dialog box.
 218
 219 dialog_loop(Module, Window, Frame, Extra, Args) ->
 220   receive
 221     {gs, Window, destroy, Data, EventArgs} ->
 222        Module:on_button(Extra, 'Cancel', Args);
 223     {gs, Window, configure, Data, [W,H | Rest]} ->
 224        gs:config(Frame, [{width, W}, {height, H}]),
 225        dialog_loop(Module, Window, Frame, Extra, Args);
 226     {gs, Window, keypress, Data, [KeyCode | Rest]} ->
 227        case Module:on_key(Extra, KeyCode, Args) of
 228          {button, ButtonType} ->
 229            Return = Module:on_button(Extra, ButtonType, Args),
 230            gs:destroy(Window),
 231            Return;
 232          _ -> dialog_loop(Module, Window, Frame, Extra, Args)
 233        end;
 234     {gs, Button, click, {button, ButtonType}, EventArgs} ->
 235        Return = Module:on_button(Extra, ButtonType, Args),
 236        gs:destroy(Window),
 237        Return;
 238     Other -> % io:fwrite("~w~n", [Other]),
 239       case Module:on_event(Extra, Other, Args) of
 240          {button, ButtonType} ->
 241            Return = Module:on_button(Extra, ButtonType, Args),
 242            gs:destroy(Window),
 243            Return;
 244          _ -> dialog_loop(Module, Window, Frame, Extra, Args)
 245       end
 246   end.
 247
 248 %%--------------------------------------------------------------------
 249 %% test() -> ResultTuple.
 250 %% Tests some of the common dialog boxes implemented with this behaviour.
 251
 252 test() ->
 253   A = gs_dialog_notify:show("Notification", "This is a notification dialog."),
 254   B = gs_dialog_confirm:show("Confirmation",
 255       "Are you sure you want to\ntake some sort of drastic action?"),
 256   C = gs_dialog_question:show("Question", "Save your barcodes first?"),
 257   D = gs_dialog_entry:show("Text Entry",
 258       "Enter the address of this order:", "555 Twenty-third St."),
 259   E = gs_dialog_list:show("Select One", "Select a game to play.",
 260       ["Chess", "Checkers", "Othello", "Go", "Backgammon", "Kali", "Sink"]),
 261   F = gs_dialog_color:show("Choose Colour", "Pick your favourite colour.",
 262       {255, 0, 128}),
 263   G = gs_dialog_notify:show("Lengthy Notification",
 264       "This is an extremely long message with no line breaks.  "
 265       "The dialog box should expand to display the entire message."),
 266   H = gs_dialog_notify:show("Lengthy Notification",
 267       "This is an extremely\nlong message with\nmany lines.\n\n"
 268       "The dialog box\nshould\nexpand\nto\ndisplay\nthe\nentire\nmessage."),
 269   {A,B,C,D,E,F,G,H}.
 270
 271 %%% END of gs_dialog.erl %%%