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) 1985-2002, 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 #include <h/kernel.h>
36 #include <h/graphics.h>
37 #include <h/text.h>
38
39 static status
initialiseDictItem(DictItem di,Any key,CharArray lbl,Any obj,Name style)40 initialiseDictItem(DictItem di, Any key, CharArray lbl, Any obj, Name style)
41 { if ( instanceOfObject(key, ClassCharArray) && !isName(key) )
42 key = toName(key);
43
44 assign(di, key, key);
45 assign(di, label, lbl);
46 assign(di, index, ZERO);
47 assign(di, object, (isDefault(obj) ? NIL : obj));
48 assign(di, dict, NIL);
49 assign(di, style, style);
50
51 succeed;
52 }
53
54
55 static status
unlinkDictItem(DictItem di)56 unlinkDictItem(DictItem di)
57 { if ( notNil(di->dict) )
58 return deleteDict(di->dict, di);
59
60 succeed;
61 }
62
63
64 static DictItem
getConvertDictItem(Class class,Any key)65 getConvertDictItem(Class class, Any key)
66 { answer(newObject(ClassDictItem, key, EAV));
67 }
68
69
70 static status
labelDictItem(DictItem di,CharArray str)71 labelDictItem(DictItem di, CharArray str)
72 { assign(di, label, str);
73
74 if (notNil(di->dict) && notNil(di->dict->browser))
75 send(di->dict->browser, NAME_ChangeItem, di, EAV);
76
77 succeed;
78 }
79
80
81 CharArray
getLabelDictItem(DictItem di)82 getLabelDictItem(DictItem di)
83 { if ( isDefault(di->label) )
84 { if ( instanceOfObject(di->key, ClassCharArray) )
85 answer(di->key);
86 else if ( isInteger(di->key) ) /* not an object! */
87 { string s;
88
89 toString(di->key, &s);
90
91 return (CharArray) StringToString(&s);
92 } else
93 answer(qadGetv(di->key, NAME_printName, 0, NULL));
94 } else
95 answer(di->label);
96 }
97
98
99 static status
keyDictItem(DictItem di,Any key)100 keyDictItem(DictItem di, Any key)
101 { if ( notNil(di->dict) && notNil(di->dict->table) )
102 { deleteHashTable(di->dict->table, di->key);
103 assign(di, key, key);
104 appendHashTable(di->dict->table, di->key, di);
105 } else
106 assign(di, key, key);
107
108 if (notNil(di->dict) && notNil(di->dict->browser) && isDefault(di->label))
109 send(di->dict->browser, NAME_ChangeItem, di, EAV);
110
111 succeed;
112 }
113
114
115 static status
styleDictItem(DictItem di,Name style)116 styleDictItem(DictItem di, Name style)
117 { assign(di, style, style);
118
119 if ( notNil(di->dict) && notNil(di->dict->browser) )
120 send(di->dict->browser, NAME_ChangeItem, di, EAV);
121
122 succeed;
123 }
124
125
126 static status
dictDictItem(DictItem di,Dict d)127 dictDictItem(DictItem di, Dict d)
128 { status rval;
129
130 addCodeReference(di);
131 if ( notNil(di->dict) )
132 deleteDict(di->dict, di);
133 rval = appendDict(d, di);
134 delCodeReference(di);
135
136 return rval;
137 }
138
139
140 static Any
getImageDictItem(DictItem di)141 getImageDictItem(DictItem di)
142 { Dict d;
143 Any browser;
144
145 if ( notNil(d = di->dict) &&
146 notNil(browser = d->browser) )
147 answer(browser);
148
149 fail;
150 }
151
152
153 static Point
getPositionDictItem(DictItem di)154 getPositionDictItem(DictItem di)
155 { ListBrowser lb;
156
157 if ( (lb = getImageDictItem(di)) )
158 { int index = valInt(di->index) * BROWSER_LINE_WIDTH;
159 int x, y, w, h, b;
160
161 if ( get_character_box_textimage(lb->image, index,
162 &x, &y, &w, &h, &b) )
163 { x += valInt(lb->image->area->x);
164 y += valInt(lb->image->area->y);
165
166 answer(answerObject(ClassPoint, toInt(x), toInt(y), EAV));
167 }
168 }
169
170 fail;
171 }
172
173 /********************************
174 * VISUAL *
175 ********************************/
176
177 static Any
getContainedInDictItem(DictItem di)178 getContainedInDictItem(DictItem di)
179 { Dict d;
180
181 if ( notNil(d = di->dict) )
182 answer(di->dict);
183
184 fail;
185 }
186
187 /*******************************
188 * CLASS DECLARATION *
189 *******************************/
190
191 /* Type declaractions */
192
193 static char *T_initialise[] =
194 { "key=any", "label=[char_array]", "object=[any]*", "style=[name]" };
195
196 /* Instance Variables */
197
198 static vardecl var_dictItem[] =
199 { SV(NAME_key, "any", IV_GET|IV_STORE, keyDictItem,
200 NAME_value, "Key used to index from dict"),
201 SV(NAME_label, "[char_array]", IV_NONE|IV_STORE, labelDictItem,
202 NAME_appearance, "Label used to display in browser"),
203 IV(NAME_object, "any", IV_BOTH,
204 NAME_delegate, "Associated data"),
205 SV(NAME_style, "[name]", IV_GET|IV_STORE, styleDictItem,
206 NAME_appearance, "Display style for item"),
207 IV(NAME_index, "int", IV_GET,
208 NAME_order, "Index in dict (0-based)"),
209 SV(NAME_dict, "dict*", IV_GET|IV_STORE, dictDictItem,
210 NAME_organisation, "Dict holding me")
211 };
212
213 /* Send Methods */
214
215 static senddecl send_dictItem[] =
216 { SM(NAME_initialise, 4, T_initialise, initialiseDictItem,
217 DEFAULT, "Create from key, label, object and style"),
218 SM(NAME_unlink, 0, NULL, unlinkDictItem,
219 DEFAULT, "Delete from dict")
220 };
221
222 /* Get Methods */
223
224 static getdecl get_dictItem[] =
225 { GM(NAME_containedIn, 0, "dict", NULL, getContainedInDictItem,
226 DEFAULT, "dict object I'm contained in"),
227 GM(NAME_convert, 1, "dict_item", "any", getConvertDictItem,
228 DEFAULT, "Convert <-key to dict_item"),
229 GM(NAME_label, 0, "char_array", NULL, getLabelDictItem,
230 DEFAULT, "<-label<-print_name or <-key if <-label == @default"),
231 GM(NAME_position, 0, "point", NULL, getPositionDictItem,
232 NAME_area, "Position in coordinate-system of list_browser"),
233 GM(NAME_image, 0, "list_browser", NULL, getImageDictItem,
234 NAME_popup, "<-browser of the <-dict (for popup menu's)")
235 };
236
237 /* Resources */
238
239 #define rc_dictItem NULL
240 /*
241 static classvardecl rc_dictItem[] =
242 {
243 };
244 */
245
246 /* Class Declaration */
247
248 static Name dictItem_termnames[] = { NAME_key, NAME_label, NAME_object };
249
250 ClassDecl(dictItem_decls,
251 var_dictItem, send_dictItem, get_dictItem, rc_dictItem,
252 3, dictItem_termnames,
253 "$Rev$");
254
255 status
makeClassDictItem(Class class)256 makeClassDictItem(Class class)
257 { declareClass(class, &dictItem_decls);
258 delegateClass(class, NAME_object);
259 saveStyleVariableClass(class, NAME_dict, NAME_nil);
260 cloneStyleVariableClass(class, NAME_dict, NAME_nil);
261
262 succeed;
263 }
264
265