1 /* xsiviewwin - XLISP interface to IVIEW dynamic graphics package. */
2 /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */
3 /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */
4 /* You may give out copies of this software; for conditions see the */
5 /* file COPYING included with this distribution. */
10 #define IVIEW_WINDOW_TITLE "Graph Window"
12 #define IVIEW_WINDOW_LEFT 10
13 #define IVIEW_WINDOW_TOP 20
14 #define IVIEW_WINDOW_WIDTH 250
15 #define IVIEW_WINDOW_HEIGHT 250
18 #define IVIEW_WINDOW_LEFT 0
19 #define IVIEW_WINDOW_TOP 0
20 #define IVIEW_WINDOW_WIDTH 250
21 #define IVIEW_WINDOW_HEIGHT 250
22 #define IVIEW_WINDOW_LEFT 50
24 #define IVIEW_WINDOW_LEFT 50
26 #define IVIEW_WINDOW_TOP 0
28 #define IVIEW_WINDOW_TOP 50
30 #define IVIEW_WINDOW_WIDTH 400
31 #define IVIEW_WINDOW_HEIGHT 400
33 #endif /* MACINTOSH */
35 /* external variables */
37 extern LVAL sk_allocate
, sk_dispose
, sk_resize
, sk_redraw
, sk_do_idle
,
38 sk_do_click
, sk_do_motion
, sk_do_key
, sk_install
, sk_remove
, s_title
,
39 s_go_away
, s_menu
, s_hardware_address
, s_black_on_white
, s_has_h_scroll
,
40 s_has_v_scroll
, s_internals
, sk_show
, sk_show_window
;
41 extern LVAL s_in_callback
;
43 /**************************************************************************/
45 /** Window Creation Functions **/
47 /**************************************************************************/
49 /* :ISNEW message for IVIEW-WINDOW-CLASS */
50 LVAL
iview_window_isnew(V
)
52 LVAL object
= xlgaobject();
53 int show
= xsboolkey(sk_show
, TRUE
);
56 initialize_graph_window(object
);
57 if (show
) send_message(object
, sk_allocate
);
61 /* :ALLOCATE message for IVIEW-WINDOW-CLASS */
62 LVAL
iview_window_allocate(V
)
67 object
= xlgaobject();
69 w
= IViewWindowNew(object
, TRUE
);
70 /* use StShowWindow to show (map) window but NOT send :resize or :redraw */
71 if (xsboolkey(sk_show
, TRUE
)) StShowWindow(w
);
76 VOID StGWGetAllocInfo
P7C(LVAL
, object
, char **, title
,
77 int *, left
, int *, top
, int *, width
, int *, height
, int *, goAway
)
81 if (slot_value(object
, s_hardware_address
) != NIL
)
82 send_message(object
, sk_dispose
);
84 window_title
= slot_value(object
, s_title
);
85 if (!stringp(window_title
)) {
86 window_title
= cvstring(IVIEW_WINDOW_TITLE
);
87 set_slot_value(object
, s_title
, window_title
);
89 *title
= (char *) getstring(window_title
);
91 *left
= IVIEW_WINDOW_LEFT
;
92 *top
= IVIEW_WINDOW_TOP
;
93 *width
= IVIEW_WINDOW_WIDTH
;
94 *height
= IVIEW_WINDOW_HEIGHT
;
95 get_window_bounds(object
, left
, top
, width
, height
);
97 *goAway
= slot_value(object
, s_go_away
) != NIL
;
100 VOID StGWObDoClobber
P1C(LVAL
, object
)
102 standard_hardware_clobber(object
);
105 VOID StGWObResize
P1C(LVAL
, object
)
107 send_callback_message(object
, sk_resize
);
110 VOID StGWObRedraw
P1C(LVAL
, object
)
112 send_callback_message(object
, sk_redraw
);
116 /* idle action. incall is used to detect longjmp's on errors and to */
117 /* turn off idle calling if the call is generating an error. */
118 VOID StGWObDoIdle
P1C(LVAL
, object
)
120 static int incall
= FALSE
;
123 StGWSetIdleOn(StGWObWinInfo(object
), FALSE
);
129 send_callback_message(object
, sk_do_idle
);
134 VOID StGWObDoMouse
P5C(LVAL
, object
, int, x
, int, y
, MouseEventType
, type
, MouseClickModifier
, mods
)
136 LVAL Lx
, Ly
, argv
[6], olddenv
;
143 argv
[2] = Lx
= cvfixnum((FIXTYPE
) x
);
144 argv
[3] = Ly
= cvfixnum((FIXTYPE
) y
);
147 xldbind(s_in_callback
, s_true
);
148 if (type
== MouseClick
) {
149 extend
= ((int) mods
) % 2;
150 option
= ((int) mods
) / 2;
151 argv
[1] = sk_do_click
;
152 argv
[4] = (extend
) ? s_true
: NIL
;
153 argv
[5] = (option
) ? s_true
: NIL
;
154 xscallsubrvec(xmsend
, 6, argv
);
157 argv
[1] = sk_do_motion
;
158 xscallsubrvec(xmsend
, 4, argv
);
164 VOID StGWObDoKey
P4C(LVAL
, object
, int, key
, int, shift
, int, opt
)
166 LVAL argv
[5], ch
, olddenv
;
169 xldbind(s_in_callback
, s_true
);
175 argv
[3] = shift
? s_true
: NIL
;
176 argv
[4] = opt
? s_true
: NIL
;
177 xscallsubrvec(xmsend
, 5, argv
);
182 StGWWinInfo
*StGWObWinInfo
P1C(LVAL
, object
)
184 LVAL internals
= slot_value(object
, s_internals
);
186 if (! consp(internals
) || ! adatap(car(internals
))
187 || getadaddr(car(internals
)) == NULL
)
188 xlfail("bad internal data");
189 return((StGWWinInfo
*) getadaddr(car(internals
)));
192 VOID initialize_graph_window
P1C(LVAL
, object
)
194 LVAL internals
, value
;
195 int v
, width
, height
, size
;
197 ColorCode bc
,dc
; /* added JKL */
199 internals
= newadata(StGWWinInfoSize(), 1, FALSE
);
200 set_slot_value(object
, s_internals
, consa(internals
));
201 StGWInitWinInfo(object
);
203 gwinfo
= StGWObWinInfo(object
);
204 if (gwinfo
== NULL
) return;
206 StGWSetObject(gwinfo
, object
);
208 if (slot_value(object
, s_black_on_white
) == NIL
) {
209 bc
= StGWBackColor(gwinfo
); /* this seems better for color */
210 dc
= StGWDrawColor(gwinfo
); /* machines - 0 and 1 are not */
211 StGWSetDrawColor(gwinfo
, bc
); /* the default draw and back */
212 StGWSetBackColor(gwinfo
, dc
); /* colors on the Amiga JKL */
215 StGetScreenSize(&width
, &height
);
216 size
= (width
> height
) ? width
: height
;
217 if ((value
= slot_value(object
, s_has_h_scroll
)) != NIL
) {
218 v
= (fixp(value
)) ? getfixnum(value
) : size
;
219 StGWSetHasHscroll(gwinfo
, TRUE
, v
);
221 if ((value
= slot_value(object
, s_has_v_scroll
)) != NIL
) {
222 v
= (fixp(value
)) ? getfixnum(value
) : size
;
223 StGWSetHasVscroll(gwinfo
, TRUE
, v
);
227 LVAL
xsiview_window_update(V
)
233 object
= xlgaobject();
234 resized
= (xlgetarg() != NIL
);
237 graph_update_action(StGWObWinInfo(object
), resized
);
238 #endif /* MACINTOSH */
242 LVAL
xsiview_window_activate(V
)
248 object
= xlgaobject();
249 active
= (xlgetarg() != NIL
);
252 graph_activate_action(StGWObWinInfo(object
), active
);
253 menu
= slot_value(object
, s_menu
);
255 if (active
) send_message(menu
, sk_install
);
256 else send_message(menu
, sk_remove
);
258 #endif /* MACINTOSH */
262 /**************************************************************************/
264 /** Idle Installation Functions **/
266 /**************************************************************************/
268 LVAL
iview_window_idle_on(V
)
271 int on
= 0, set
= FALSE
;
273 gwinfo
= StGWObWinInfo(xlgaobject());
274 if (gwinfo
== NULL
) return(NIL
);
278 on
= (xlgetarg() != NIL
) ? TRUE
: FALSE
;
282 if (set
) StGWSetIdleOn(gwinfo
, on
);
283 return((StGWIdleOn(gwinfo
)) ? s_true
: NIL
);
286 /**************************************************************************/
288 /** Menu Installation and Access Functions **/
290 /**************************************************************************/
292 LVAL
iview_window_menu(V
)
294 LVAL object
, menu
= NULL
;
297 object
= xlgaobject();
305 if (menu_p(menu
)) set_slot_value(object
, s_menu
, menu
);
306 else if (menu
== NIL
) set_slot_value(object
, s_menu
, NIL
);
307 else xlerror("not a menu", menu
);
310 return(slot_value(object
, s_menu
));