Here is my basic X-stuff. I don't make any big claims for't.
;;; setup_x.p R.J.Popplestone - September 91
;;; This is a somewhat interim version of the X-windows interface for
;;; the COINS 530 course based upon the Sethi book.
uses XpwGraphic;
uses lexical_args;
compile_mode:pop11 +defpdr +varsch +constr;
max(popmemlim, 6000000) -> popmemlim; ;;; give us some space.
;;;lib check_string; ;;; Force loading because LISP V14.01 redefines.
;;; NO! redefine
cancel check_string;
define check_string(obj) with_props false;
lvars obj;
unless isstring(obj) then
mishap(obj,1,'STRING NEEDED');
endunless
enddefine;
uses popxlib; ;;; Set up lib lists etc. for access to Xpop libraries
uses xt_widget; ;;; Widget creation, management, mapping etc
uses xt_callback; ;;; Set up call-back to POP from xlib C-functions
uses xt_event; ;;; Event handling, see ref xt_event
;;; sysxsetup(); ;;; See help sysxsetup
;;; Now we create some widget-sets
{% ;;; seems to be a system bug that dumps stuff on the stack
vars
XpwGraphic = XptWidgetSet("Poplog")("GraphicWidget"),
XpwComposite = XptWidgetSet("Poplog")("CompositeWidget"),
ApplicationShell = XptWidgetSet("Toolkit")("ApplicationShellWidget"),
was_event,
W_default,
;
%} -> ;
uses XptNewWindow; ;;; Simple interface to make and destroy windows
uses XtN; ;;; A Macro for hashed table of fixed address nt strings
uses fast_XptValue; ;;; Access and update widget resources by name
vars procedure(
use_font,
dx_font = newanyproperty([],32,1,20,syshash,nonop =,"perm",undef,false), ;;; Temporary.
dy_font = newanyproperty([],32,1,20,syshash,nonop =,"perm",undef,false), ;;; Temporary.
asc_font = newanyproperty([],32,1,20,syshash,nonop =,"perm",10,false), ;;; Temporary.
EH_pointer, ;;; User to define this.
EH_W_key, ;;; User to define this.
pr_mon_event = pr,
set_event_handlers,
XEH_button, ;;;
XEH_key,
);
;;;vars shell = XtAppCreateShell('xpw\(0)', 'Xpw\(0)',
;;; ApplicationShell,
;;; XptDefaultDisplay,
;;; XptArgList([]) );
vars mon_x_event = 0,
style_invert = GXinvert,
style_set = GXset,
style_clear = GXclear,
;
;;; A function to create a widget W.
define mk_W(string,xsize,ysize,xloc,yloc) -> W;
lvars string, xsize, ysize, xloc, yloc, W;
lconstant arg_vector = initv(4); ;;; re-usable vector for XptNewWindow
lconstant XpwGraphic = XptWidgetSet("Poplog")("GraphicWidget");
unless string then vednullstring -> string
endunless;
check_string(string);
fi_check(xsize,0,false) ->;
fi_check(ysize,0,false) ->;
fi_check(xloc,false,false) ->;
fi_check(yloc,false,false) ->;
XptNewWindow(
string,
fill(xsize, ysize, xloc, yloc, arg_vector),
[],
XpwGraphic) ->W;
set_event_handlers(W);
W -> W_default; ;;; Used by font-query stuff.
enddefine;
define kill_W(W);
XtDestroyWidget(W);
enddefine;
define x_W(W);
lvars W;
XptValue(W, XtN x, TYPESPEC(:XptShort))
enddefine;
define updaterof x_W(W);
lvars W;
-> XptValue(W, XtN x,TYPESPEC(:XptShort))
enddefine;
define y_W(W);
lvars W;
XptValue(W, XtN y, TYPESPEC(:XptShort))
enddefine;
define updaterof y_W(W);
lvars W;
-> XptValue(W, XtN y,TYPESPEC(:XptShort))
enddefine;
define dx_W(W);
lvars W;
XptValue(W, XtN width, TYPESPEC(:XptShort))
enddefine;
define updaterof dx_W(W);
lvars W;
-> XptValue(W, XtN width,TYPESPEC(:XptShort))
enddefine;
define dy_W(W);
lvars W;
XptValue(W, XtN height,TYPESPEC(:XptShort))
enddefine;
define updaterof dy_W(W);
lvars W;
-> XptValue(W, XtN height,TYPESPEC(:XptShort))
enddefine;
;;; Draw a line on widget W.
define draw_line(x1,y1,x2,y2, S,W);
lvars x1,y1,x2,y2,S,W;
if S then S
else GXclear
endif;
->fast_XptValue(W, XtN function); ;;; Set style
XpwDrawLine(W,intof(x1),intof(y1),intof(x2),intof(y2));
enddefine;
/* example.
draw_line(10,10,100,100,false,W);
XpwDrawArc(WIDGET, X, Y, WIDTH, HEIGHT, [procedure]
S_ANGLE, I_ANGLE)
Calls the XpwMDrawArc method for WIDGET.
Draws an arc on a circle or ellipse bounded by the rectangle
whose top left corner is (X, Y), with given WIDTH and HEIGHT.
The arc is defined by the start angle, S_ANGLE, (relative to the
centre) and the amount the angle is to be increased, I_ANGLE,
where S_ANGLE and I_ANGLE are measured from the three O'clock
position, in 64ths of a degree, counterclockwise (negative
angles are measured clockwise). Increments greater than 360
degrees are truncated to 360 degrees. See "man XDrawArc" for
further details, including measurements of angles in ellipses.
*/
define draw_arc(x,y,dx,dy,a_1,a_2,style,W);
XpwDrawArc(W,x,y,dx,dy,a_1,a_2)
enddefine;
;;; This is defined in terms of XpwDrawline to improve efficiency.
define draw_box(x,y,dx,dy,S,W);
intof(x)->x; intof(y)->y; intof(dx)->dx; intof(dy)->dy;
lvars
x1 = x + dx,
y1 = y + dy,
;
/*
;;; BH removed this section on 8aug96. The removal doesn't seem to be causing
;;; problems.
if S then S
else GXclear
endif;
->fast_XptValue(W, XtN function); ;;; Set style
*/
S -> fast_XptValue(W, XtN function);
XpwDrawLine(W, x, y, x1, y);
XpwDrawLine(W, x1, y, x1, y1);
XpwDrawLine(W, x1, y1, x, y1);
XpwDrawLine(W, x, y1, x, y);
enddefine;
define draw_text(x,y,Msg,F,W);
XpwSetFont(W,F)->;
intof(x)->x; intof(y)->y;
lvars a = XpwFontAscent(W);
if isstring(Msg) then
XpwDrawImageString(W,x,1+y+a,Msg);
else 1 + y + a -> y;
lvars string, Obj,
L = datalist(Msg),
dy = XpwFontHeight(W);
for Obj in L do
if isstring(Obj) then Obj else Obj><'' endif -> string;
XpwDrawImageString(W,x,y,string);
y + dy -> y;
endfor;
endif;
enddefine;
/*
draw_text(0,0,'0123456789',XtN times_bold14,W);
draw_text(100,100,'hello',false,W);
draw_text(100,100,'hello',XtN times_bold14,W);
draw_text(100,100,'hello',XtN 5*8,W);
draw_text(100,120,'hello',XtN times_roman14,W);
draw_text(100,140,'hello',XtN times_roman8,W);
draw_text(100,120,'hello',XtN times_roman24,W);
vars str = consstring(for i from 128 to 255 do i endfor, 127);
draw_text(00,10,str, '8x16kana',W);
draw_text(00,10,'hello\^@is\tthe\^m\n',XtN times_roman14,W);
XptValue(W, XtN font) =>
*/
;;; Draw the string at point (x,y) in window W using the font.
define clear_graphic(W); ;;; clears the whole window.
XpwClearWindow(W);
enddefine;
/*
clear_graphic(W)
*/
;;; ??? are the max functions needed in X-windows?
;;; This procedure inverts the foreground and background colours in the
;;; rectangle in window W with top left corner (x0,y0) and dimesensions dx,dy
/*
Access or update line drawing function of the current window. The
integer can be one of the draw functions listed in HELP * XpwGraphic.
The following draw functions are provided:
GXclear GXand GXandReverse
GXcopy (default) GXandInverted GXnoop
GXxor GXor GXnor
GXequiv GXinvert GXorReverse
GXcopyInverted GXorInverted GXnand
GXset
*/
define invert_rect(x0 y0 dx dy,W);
lvars x y x1 y1 x0,y0,dx,dy,W;
if dx==0 then 1 -> dx
endif;
GXinvert -> fast_XptValue(W, XtN function); ;;; Set inversion.
XpwFillRectangle(W,max(0,x0), ;;; ??? do we need the max in this case???
max(0,y0),
dx,
dy);
enddefine;
/*
GXcopy -> fast_XptValue(W,XtN function);
invert_rect(10,10,20,30,W);
*/
;;; Clear the area of the widget W with top-left corner at (x,y), width dx
;;; and height dy.
define clear_area(x,y,dx,dy,W);
lvars x,y,dx,dy,W;
GXclear -> fast_XptValue(W, XtN function); ;;; Set to clear
XpwFillRectangle(W,intof(x),intof(y),intof(dx),intof(dy));
enddefine;
define use_colour(colour,W);
XpwSetColor(W,colour);
enddefine;
/*
W =>
draw_line(0,0,100,100,W,false);
clear_area(50,50,10, 20,W)
set_background(XtN red,W);
use_colour(XtN maroon, W)=>
use_colour('#00008fff0000\^@',W) =>
use_colour(XtN black, W)=>
*/
;;; ts_fonts.p Copyright R.J.Popplestone dec89
/*This contains the font-handling capabilities for lib typeset.
Any code specific to a particular windowing system should be put here
Atributes of a font
*/
vars
S_bf_14 ;;; The bold font
S_bf_18
S_rm_8 ;;; The subscript and superscript font.
S_rm_14
F
;
/* Unix utilities to find fonts:
xfontsel - chooses a font
xlsfonts - lists the fonts
times_bold10
times_bold12
times_bold14
times_bold18
times_bold24
times_bold8
times_bolditalic10
times_bolditalic12
times_bolditalic14
times_bolditalic18
times_bolditalic24
times_bolditalic8
times_italic10
times_italic12
times_italic14
times_italic18
times_italic24
times_italic8
times_roman10
times_roman12
times_roman14
times_roman18
times_roman24
times_roman8
*/
/*
XpwMSetFont [XpwMethod]
#include <X11/Xpw/XpwCore.h>
XpwCallMethod(widget, XpwMSetFont, fontname);
Widget widget;
String fontname;
See REF *XpwCore/XpwSetFont for a description of this method and
the Pop-11 convenience procedure that is used to call this
method.
XpwSetFont
*/
define dx_text(str,F);
datalength(str)*dx_font(F);
enddefine;
define dy_text(str,F);
dy_font(F);
enddefine;
define asc_text(str,F);
asc_font(F);
enddefine;
define use_font(F,W);
lvars F,W,r;
if W then
XpwSetFont(W,F) -> r;
elseif F = 'ascii' then ;;; do nothing
endif;
enddefine;
/*
You need to use the function
"XLoadQueryFont(Display *display, String fontname)"
XFontStruct *font;
Display *display;
char fontname[128];
int font_width, font_height;
font = XLoadQueryFont(display, fontname);
font_height = font->max_bounds.ascent + font->max_bounds.descent;
font_width = font->max_bounds.rbearing - font->max_bounds.lbearing;
XFontStruct is defined in /usr/inlcude/X11/Xlib.h as:
typedef struct {
XExtData *ext_data; /* hook for extension to hang data */
Font fid; /* Font id for this font */
unsigned direction; /* hint about direction the font is painted */
unsigned min_char_or_byte2;/* first character */
unsigned max_char_or_byte2;/* last character */
unsigned min_byte1; /* first row that exists */
unsigned max_byte1; /* last row that exists */
Bool all_chars_exist;/* flag if all characters have non-zero size*/
unsigned default_char; /* char to print for undefined character */
int n_properties; /* how many properties there are */
XFontProp *properties; /* pointer to array of additional properties*/
XCharStruct min_bounds; /* minimum bounds over all existing char*/
XCharStruct max_bounds; /* maximum bounds over all existing char*/
XCharStruct *per_char; /* first_char to last_char information */
int ascent; /* log. extent above baseline for spacing */
int descent; /* log. descent below baseline for spacing */
} XFontStruct;
XpwSetFont(W,F) =>
** <false>
*/
/*
See ref XpwGraphic and ref XpwPixmap and Xt intrinsics manual for X11R4.
XpwGraphic Resources
--------------------
========================================================================
Name Class Type Access
========================================================================
XtNusePrivateGC XtCBoolean Boolean SGI
XtNmyGC XtCGC Pointer G
XtNswitchCmaps XtCBoolean Boolean SGI
XtNmouseX XtCMouseLocation Int SG
XtNmouseY XtCMouseLocation Int SG
XtNbuttonEvent XtCCallback XtCallbackList GI
XtNkeyboardEvent XtCCallback XtCallbackList GI
XtNmouseEvent XtCCallback XtCallbackList GI
XtNmotionEvent XtCCallback XtCallbackList GI
XrNresizeEvent XtCCallback XtCallbackList GI
The Access Column is interpreted as follows:
S Value can be set by XtSetValues
G Value can be read by XtGetValues
I Value can be set at initialization
* Value set in other ways
XtN is a macro which reads the next word and returns a null-terminated
string.
XtN buttonEvent [resource]
XtN keyboardEvent [resource]
XtN mouseEvent [resource]
XtN motionEvent [resource]
XtN resizeEvent [resource]
CALLBACKLIST, default value: empty (NULL)
The XtN *Event resources are Callback Lists that are activated
when certain categories of events have occured within an Xpw
widget. They should not be updated using XtSetValues. Users can
add procedures to one of these callback list using
XtAddCallback, specifying which event they are interested in
trapping. For example:
XtAddCallback(widget, XtN motionEvent, foo, false)
For more information on writing event handlers using these
callbacks, see the sections on Actions and Translations below.
Notice that the resources XtN mouseX, XtN mouseY, XtN modifiers and
possibly XtN key are set before a client is notified of an event
so that clients can read these resources in order to determine
what action to take for the event.
The following resources are retrieved from the argument list or the
resource database when XpwComposite widgets are created.
========================================================================
Name Class Type Access
========================================================================
XtNancestorSensitive XtCSensitive Boolean G*
XtNbackground XtCBackground Pixel SGI
XtNbackgroundPixmap XtCPixmap Pixmap SGI
XtNborderColor XtCBorderColor Pixel SGI
XtNborderPixmap XtCPixmap Pixmap SGI
XtNborderWidth XtCBorderWidth short SGI
XtNdepth XtCdepth short SGI
XtNdestroyCallback XtCCallback XtCallbackList SI
XtNheight XtCHeight short SGI
XtNmappedWhenManaged XtCMappedWhenManaged Boolean SGI
XtNsensitive XtCSensitive Boolean GI*
XtNtranslations XtCTranslations XtTranslations GI
XtNwidth XtCWidth short SGI
XtNx XtCPosition short SGI
XtNxpwCallback XtCCallback XtCallbackList SI
XtNy XtCPosition short SGI
The following notes describe new resources or properties of resources
for XpwComposite widgets.
XtNxpwCallback [resource]
This callback list is used notify clients of configure events.
Actions and Translations
------------------------
XpwComposite has one action, "notify-configure-event". This action
simply calls the xpwCallback to notify clients of configure events. The
translations for XpwComposite are:
<Configure>: notify-configure-event()
*/
vars procedure(
icon_label = newassoc([]), ;;; This is a dummy definition ???
ShortFileName_W = newassoc([]), ;;; and so is this ???
label_W = newassoc([]), ;;; and so is this???
expose_W = erase, ;;; and so is this???
);
define xt_graphic_width(W);
XptValue(W, XtN width, "short");
enddefine;
/*
xt_graphic_width(W) =>
*/
define xt_graphic_height(W);
XptValue(W, XtN height, "short");
enddefine;
;;; Work out the location of the window W.
define loc_W(W);
{% XptValue(W, XtN x, "short"), XptValue(W,XtN y, "short") %}
enddefine;
procedure(P,W);
lvars P,W, x = P(1), y = P(2);
x -> XptValue(W, XtN x, "short");
y -> XptValue(W, XtN y, "short");
endprocedure -> updater(loc_W);
/*
mk_W('Demonstration',600,400,200,30) -> W;
loc_W(W) =>
{0 0}
{0 100} -> loc_W(W);
loc_W(W) =>
{0 0}
set_event_handlers(W1);
*/
define set_event_handlers(W);
XtAddCallback(W, XtN buttonEvent, XEH_button, false);
XtAddCallback(W, XtN keyboardEvent, XEH_key, false);
;;; XtAddCallback(W, XtN destroyCallback, XEH_quit,false);
;;; XtAddCallback(W, XtN resizeEvent, XEH_resized,false);
;;; XtAddCallback(W, XtN quitEvent, XEH_resized,false);
enddefine;
define XEH_button(W, client_data, call_data);
lvars button = exacc ^int call_data,
x_mouse = XptValue(W, XtN mouseX),
y_mouse = XptValue(W, XtN mouseY),
modifier = XptValue(W, XtN modifiers),
L,
;
if mon_x_event&&1=1 then
x_mouse.pr; sp(2); y_mouse.pr;
sp(2); modifier.pr; nl(1);
endif;
[%
EH_pointer(x_mouse,y_mouse,modifier,W)
%] -> L;
if L.null.not then
pr('\n non-empty stack on pointer ev ');
pr(L);
endif;
enddefine;
;;; Handle the X-event associated with a key-depression.
define XEH_key(W, client_data, call_data);
lvars c = exacc ^int call_data,
modifiers = XptValue(W, XtN modifiers),
k = XptValue(W, XtN key),
;
if mon_x_event&&32=32 then
pr(c); sp(2); pr(modifiers); sp(2); pr(k); nl(1);
pr(W);
endif;
if c<0 then return
elseif c<256 then
if modifiers&&4=4 then ;;; Control character
c&&31
else c
endif
elseif c = 65293 then ;;; Return
13
elseif c=65307 then ;;; Escape key
27
elseif c=65535 then ;;; Delete key
127
else return
endif -> c;
if mon_x_event&&32=32 then
npr(c);
endif;
lvars L = [%EH_W_key(c,W) %];
unless L then mishap('EH_key returned result');
endunless;
true -> was_event;
enddefine;
define XEH_resized(W,client_data, call_data);
if mon_x_event then
pr_mon_event('XEH_resized(');
endif;
enddefine;
/*
;;; vars W = mk_W('Demo',650,400,500,30); ;;; Make a general purpose widget.
use_font('times_roman14',W);
*/
define wait_for_event();
until was_event do
enduntil;
false -> was_event;
enddefine;
vars setup_x = true;
'setup_x loaded' =>
|