[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Nov 7 14:18:47 1997 
Subject:Converting Openlook to Motif 
From:Robin Popplestone 
Volume-ID:971107.01 

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' =>