The ModulaTor logo 7KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication

The ModulaTor
Erlangen's First Independent Modula-2 Journal! Nr. 4/Dec-1990 
_____________________________________________________________

XWindows and UIL Programming Using Modula-2 

Two Examples show how to use DEC's XWindows interface and it's Toolkit on a 
VAXstation under VMS 

by A. Schuhmacher,  Isotopenforschung Dr. Sauerwein GmbH, Bergische Str. 16, W - 5657 Haan/Rheinland 1, F.R.G.

4th extended edition, 04-Jun-1993: includes Oberon-2 version of the icosahedron drawing program; revised 
by Petra Fabian, ModulaWare GmbH. 

This article lists two functional identical Modula-2 programs. To keep the XWindows and 
UIL (user interface language) examples simple, they only create a single window on the 
VAXstation entitled "Demo" with an "EXIT" field that can be activated by clicking a mouse 
button. Picture 1 shows a hardcopy of the screen layout after invoking one of the 
programs. 

(here should the picture showing a window and a box with the word EXIT be inserted) 

Picture 1: The initial screen layout generated by the Modula-2 example programs 

The example modules are called WindowDemo_Xdo and WindowDemo_Uil. Both import 
DECW$XLIBDEF, which is the definition module that defines the XWindows interface. 
Module WindowDemo_Uil also imports DECW$DWTDEF, which establishes the 
interface to DEC's XWindows toolkit. The two interface modules are so-called Modula-2 
foreign definition modules and are part of ModulaWare's MVR distribution kit. These and 
other interface modules, namely decw$dwtentry, decw$dwtmsg, decw$dwtstruct, 
decw$dwtwidgetdef, decw$dwtwidgetstruct, and decw$xlibmsg were created by Modula- 
Ware to provide the Modula-2 programmer access to DEC's XWindows workstation 
software. The names of Modula-2's XWindows and DECWindows objects like constants, 
data types, procedures and module structure are equivalent to the corresponding VAX- 
station's Pascal modules. 

The Modula-2 programs can be compiled with ModulaWare's VAX/VMS Modula-2 
Compiler MVR V2.x and linked to the shareable image SYS$SHARE:DECW$DWTLIB- 
SHR using the VMS linker. The so-called UIL program in file WindowDemo_Uil.Uil is 
compiled using the VMS-workstation's command $ UIL WindowDemo_Uil.Uil, which 
generates a user interface description file with the extension UID. For space reasons, a 
description of the XWindows, UIL-routines and UIL language elements used in the 
examples was omitted. Readers interested in understanding the examples should 
consult the VAX/VMS workstation's documentation (DRM-, convenience-, intrinsic-, and 
window-routines). The purpose here is to show two solutions that emerge by different 
design goals. 

The difference between the two WindowDemo Modula-2 programs is, that in the _Xdo 
module all window actions are programmed explicitely on the lowest level, whereas the 
_Uil module only establishes a link to a separate program written in UIL. To write an UIL 
program has several advantages over explicitly programming all window actions into an 
application program. First UIL is higher level than XWindows and hence shorter, more 
readable, more reliable and easier to modify. Last but not least UIL is programming 
language independent and also independent from the application program itself. 

Modification of the UIL part of an application program is done by simply editing and 
compiling the UIL source file and running the application program, i.e. no re-compiling 
and no re-linking is required. This is accomplished by a dynamic link between application 
and UID. Disadvantages of the resource consuming UIL may be performance problems 
in connecting, reading and interpreting the UID file at run-time and the introduction of yet 
another programming language. 

In our example, the application is the _Uil module. It only consists of a frame-work, which 
refers to the UID file through the string uid_file. The string is a file name, which is first 
trimmed via STR$TRIM to the variable filedesc. filedesc is then used as input parameter 
in the DWT$OPEN_HIERARCHY call, which establishes a link between the Modula-2 
application programm and the UID file at run-time. The so-called call-back procedures 
create_proc and exit_proc are also connected to UIL at run-time via array variable proc 
by a call to dwt$register_drm_names. 

WindowDemo_Xdo.MOD

__________________________________________________________________________________________________ 

MODULE WindowDemo_Xdo;
FROM SYSTEM IMPORT ADR, ADDRESS, NOP, WORD, SHORTWORD, BYTE;
FROM FileSystem IMPORT Done, Open, Close, Reset, Eof, File, ReadRecord;
FROM Storage IMPORT ALLOCATE;
FROM InOut IMPORT WriteString, WriteLn;
FROM StringHandlingProcedures IMPORT STR$TRIM;
FROM DECW$XLIBDEF IMPORT (* Constantes *) x$c_input_output, x$c_button_press,
    x$c_expose, x$c_z_pixmap, x$c_button2, x$c_button1, x$c_button3,
    x$m_cw_event_mask, x$m_cw_back_pixel, x$m_button_press, x$m_exposure, x$m_gc_foreground, x$m_gc_background,
  (* Types *) x$visual, x$gc_values, x$image, x$set_win_attributes, x$color,
  (* Procedures *) x$open_display, x$close_display, x$create_window,
    x$destroy_window, x$map_window, x$unmap_window, x$default_screen_of_display,
    x$default_gc_of_screen, x$default_depth_of_screen, x$default_visual_of_screen,
    x$default_colormap_of_screen, x$alloc_named_color, x$width_of_screen,
    x$height_of_screen, x$display_name, x$white_pixel_of_screen,
    x$black_pixel_of_screen, x$store_name, x$load_font, x$set_font, x$create_gc, x$clear_window, 
    x$draw_image_string, x$event,x$next_event,x$put_image, x$create_pixmap, x$create_image,
    x$set_icon_name, x$default_screen, x$set_foreground, x$expose_event, x$root_window_of_screen; 

CONST error = 'DISPLAY NOT OPEND!'; icon_name = 'IFS'; window_name = 'DEMO'; label_name = 'EXIT'; red = 'RED';
  font_name = '-ADOBE-NEW CENTURY SCHOOLBOOK-MEDIUM-R-NORMAL--*-140-*-*-p-*';
  window_1x = 0; window_1y = 0; window_1w = 300; window_1h = 150; border_width1= 0;
  window_2x = 100; window_2y = 50; window_2w = 100; window_2h = 50; border_width2= 4;

PROCEDURE Error; BEGIN WriteString (error); WriteLn; END Error; 

VAR window_1, screen, status, attributes_mask, window_2, gc, font, dpy, i: CARDINAL; 
  visual : x$visual;
  xswda : x$set_win_attributes;
  event : x$event;
  xgcvl : x$gc_values;
  eventerr : BOOLEAN; depth, colormap : CARDINAL; width, height : INTEGER;
  str_size : SHORTWORD; colorname : ARRAY [0..2] OF CHAR;
  screen_color, screen_out : x$color;
BEGIN (* Initialize display id and screen id *)
  dpy  := x$open_display (NOP); IF (dpy = 0) THEN Error; END;
  screen := x$default_screen_of_display (dpy);
  depth := (x$default_depth_of_screen (screen));
  x$default_visual_of_screen (screen, visual);
  attributes_mask := x$m_cw_back_pixel+x$m_cw_event_mask;
  xswda.x$l_swda_event_mask := x$m_button_press+x$m_exposure;
  xswda.x$l_swda_background_pixel := x$white_pixel_of_screen (screen);
  (*Create the window_1 window*)
  window_1 := x$create_window (dpy, x$root_window_of_screen (screen), window_1x, window_1y, 
    window_1w, window_1h, border_width1, depth, x$c_input_output, visual, attributes_mask, xswda);
  (*Define Background Color for window_2*)
  colormap := x$default_colormap_of_screen (screen); colorname := red;
  status := x$alloc_named_color (dpy, colormap, colorname, screen_color, screen_out); 
  IF status#0 THEN
    xgcvl.x$l_gcvl_background := screen_color.x$l_colr_pixel;
    xswda.x$l_swda_background_pixel := screen_color.x$l_colr_pixel;
  ELSE
    xgcvl.x$l_gcvl_background := x$white_pixel_of_screen (screen);
    xswda.x$l_swda_background_pixel := x$white_pixel_of_screen (screen);
  END; 
  (*Create the window_2 window*)
  window_2 := x$create_window (dpy, window_1, window_2x, window_2y, window_2w, window_2h, 
    border_width2, depth, x$c_input_output, visual, attributes_mask, xswda);
  (* Create graphics context *)
  gc := x$create_gc (dpy, window_2, x$m_gc_foreground+x$m_gc_background, xgcvl);
  (* Load the font for text writing *)
  font := x$load_font (dpy, font_name);
  x$set_font (dpy, gc, font);
  x$store_name (dpy, window_1, window_name);
  x$set_icon_name (dpy, window_1, icon_name);
  (* Map the windows *)
  x$map_window (dpy, window_1);
  x$map_window (dpy, window_2);
  (* Handle Events *) eventerr := FALSE;
  REPEAT
    x$next_event (dpy, event); x$draw_image_string (dpy, window_2, gc, 30, 30, label_name);
    IF (event.evnt_type = x$c_button_press) AND (event.evnt_expose.x$l_exev_window= window_2) THEN 
      eventerr := TRUE;
      x$unmap_window (dpy, window_1);
      x$unmap_window (dpy, window_2);
      x$close_display (dpy); 
    END;
  UNTIL eventerr;
END WindowDemo_Xdo.

WindowDemo_Uil.MOD

__________________________________________________________________________________________________ 

MODULE WindowDemo_Uil;
FROM SYSTEM IMPORT NOP, BYTE, WORD, SHORTWORD, ADDRESS, ADR, CAST;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM VMS IMPORT SYS$EXIT;
FROM SSDefinitions IMPORT SS$_NORMAL;
FROM StringHandlingProcedures IMPORT STR$TRIM;
FROM DECW$XLIBDEF IMPORT (*constants*) x$m_button_press, 
  (*procedures*) x$set_foreground, x$default_gc_of_screen, x$draw_line, x$get_pixel, x$query_pointer; 
FROM DECW$DWTDEF IMPORT (*intrinsic-routines*) xt$set_values, xt$main_loop,
    xt$manage_child, xt$realize_widget, xt$add_event_handler, xt$initialize, xt$unmanage_child, 
  (*constants*) DWT$C_NICON_NAME, DWT$C_NALLOW_SHELL_RESIZE, 
  (*types*) dwt$widget, dwt$arg, dwt$drm_count, dwt$cardinal, dwt$drmreg_arg,
    dwt$drm_type, dwt$callback, dwt$translations, dwt$action_list, dwt$any_cb_st, dwt$event_mask, dwt$opaque, 
  (*VMS-only-routines*) dwt$vms_set_arg, dwt$vms_set_desc_arg, 
  (*UIL-routines*) DWT$INITIALIZE_DRM, DWT$OPEN_HIERARCHY, DWT$FETCH_WIDGET,
    dwt$register_drm_names, dwt$drm_hierarchy, dwt$get_window, dwt$get_display, dwt$get_screen;

CONST k_main_window=1; k_exit=2; max_widget = 2; uid_file = "windowdemo_uil.uid"; 
  title_name = "Demo"; icon_name = "DEMO";
  proc1_name = "create_proc"; proc2_name = "exit_proc"; proc_max = 2;
TYPE char_type = ARRAY [0..20] OF CHAR;
  strdesctype= RECORD len, class: SHORTWORD; str: POINTER TO ARRAY[0..79] OF CHAR END;

PROCEDURE CreateProc (VAR widget: dwt$widget;VAR tag: INTEGER; VAR callback_data: dwt$any_cb_st);
BEGIN widget_array[tag] := widget; 
END CreateProc;

PROCEDURE ExitProc (VAR widget: dwt$widget;VAR tag: INTEGER; VAR callback_data: dwt$any_cb_st);
VAR status, i: INTEGER;
BEGIN
  FOR i := 1 TO max_widget DO
    xt$unmanage_child (widget_array[i]);
  END;
  status := SYS$EXIT (CAST(WORD, SS$_NORMAL));
END ExitProc;

VAR hierarchy_id_return : dwt$drm_hierarchy; arglist : ARRAY [0..0] OF dwt$arg; status, argc : dwt$cardinal; 
  proc : ARRAY [1..proc_max] OF dwt$drmreg_arg; proc_string : ARRAY [1..proc_max] OF char_type;
  class : dwt$drm_type; toplevel : dwt$widget; other : BOOLEAN; filedesc : ARRAY[0..1] OF POINTER TO strdesctype;
  regnum : dwt$drm_count; num_files : SHORTWORD; widget_array : ARRAY[1..max_widget] OF dwt$widget;

BEGIN DWT$INITIALIZE_DRM; argc := 0; toplevel := xt$initialize (title_name, 'topclass', NOP, 0, argc, NOP);
  dwt$vms_set_desc_arg ('TRUE', arglist, 0, DWT$C_NALLOW_SHELL_RESIZE); xt$set_values (toplevel, arglist, 1);
  dwt$vms_set_desc_arg (icon_name, arglist, 0, DWT$C_NICON_NAME); xt$set_values (toplevel, arglist, 1);
  NEW (filedesc[0]); NEW (filedesc[0]^.str); filedesc[0]^.class := CAST(SHORTWORD, 0); filedesc[1] := NIL;
  status := STR$TRIM (filedesc[0]^.str^, uid_file, filedesc[0]^.len);
  num_files := CAST(SHORTWORD, 1); status := DWT$OPEN_HIERARCHY (num_files, filedesc, NOP, hierarchy_id_return);
  DISPOSE (filedesc[0]^.str); DISPOSE (filedesc[0]);
  proc_string[1] := proc1_name; proc[1].dwt$a_drmr_name := ADR (proc_string[1]);
  proc[1].dwt$l_drmr_value := CAST(ADDRESS, CreateProc);
  proc_string[2] := proc2_name; proc[2].dwt$a_drmr_name := ADR (proc_string[2]);
  proc[2].dwt$l_drmr_value := CAST(ADDRESS, ExitProc);
  regnum := CAST(SHORTWORD, proc_max); status := dwt$register_drm_names (proc, regnum);
  status := DWT$FETCH_WIDGET (hierarchy_id_return, 'MAIN_WINDOW', toplevel, widget_array[k_main_window], class);
  xt$manage_child (widget_array[k_main_window]); xt$realize_widget (toplevel); xt$main_loop ();
END WindowDemo_Uil.

WindoDemo_Uil.UIL

__________________________________________________________________________________________________ 

module windowdemo_uil
    version = 'v1.0'
    names = case_sensitive
procedure
    exit_proc (integer);
    create_proc (integer);
value
    DWT$C_FALSE: false;
    DWT$C_TRUE : true;
    k_exit_label_text : compound_string("EXIT");
    k_toplevel : 0;
    k_main_window : 1;
    k_exit : 2;
    redb : color('red',background);
    whiteb : color('white',background);
    k_button_font : font('-ADOBE-NEW CENTURY SCHOOLBOOK-MEDIUM-R-NORMAL--*-140-*-*-p-*');
! Main Window
object
    MAIN_WINDOW: dialog_box{
        arguments {
            x = 0;
            y = 0;
            width = 300;
            height= 150;
            border_width=0;
            background_color=whiteb;
        };
        controls {
            push_button exit_button;
        };
        callbacks {
            create = procedure create_proc(k_main_window);
        };
    };
! Secondary Window
object 
     exit_button: push_button {
          arguments {
            x = 50;
            y = 25;
            width = 100;
            height = 50;
            label_label=k_exit_label_text;
            border_width = 4;
            background_color = redb;
            font_argument = k_button_font;
            shadow = DWT$C_FALSE;
          };
          callbacks { 
            activate = procedure exit_proc(k_exit);
            create = procedure create_proc(k_exit);
          };  
     };
end module;

__________________________________________________________________________________________________ 

To have a direct comparison between XWindows programming in DEC VAX-Pascal and 
ModulaWare's Modula-2, the famous DECWindows-demo program ICOPAS.PAS written 
in Pascal was rewritten in Modula-2. The source code has been modified to take 
advantage of Modula-2's extended features (i.e. local modules for intialisation and array 
and record constructors in statement part) and uses the ISO Modula-2 Standard library 
module SysClock. The source formatting layout is intentionally dense to save space. 

ICOMOD[_v4].MOD

__________________________________________________________________________________________________ 

MODULE ICOMOD;
(*Description: Display a wire-frame rotating icosahedron, with hidden lines removed
  Arguments: -
  Description: bounce a bounding box inside the window
  XWindows Programming Example: Modula-2 version derived from the Pascal version of the Ico demo
  by common effort of A. Schuhmacher, Elmar Baumgart, Guenter Dotzel,
  ModulaWare GmbH, Wilhelmstr. 17A, D-8520 Erlangen/F.R.G., 24-Nov-1991

  Source file [m2lib]icomod_v4.mod
  To compile use MVR V4 ( $modr/iso=2 icomod_v4.mod )
  To link use ( $link icomod_v4,sys$input/opt 
                sys$share:decw$xlibshr/share )
*)        
FROM DECW$XLIBMSG IMPORT
  X$_CANTOPEN;
FROM DECW$XLIBDEF IMPORT
  x$visual, x$set_win_attributes, x$event, x$gc_values, x$point,
  x$segment, x$clear_area, x$draw_segments, x$sync, x$open_display, x$default_screen,
  x$white_pixel, x$black_pixel, x$display_width, x$display_height, x$m_cw_event_mask,
  x$m_cw_back_pixel, x$m_cw_border_pixel, x$default_visual, x$create_window,
  x$default_root_window, x$default_depth, x$c_input_output, x$change_property,
  x$c_prop_mode_replace, x$map_window, x$create_gc, x$set_foreground,
  x$set_background, x$pending, x$next_event, X$C_XA_STRING, X$C_XA_WM_NAME;
FROM SysClock IMPORT GetClock, DateTime;
FROM ConditionHandlingProcedures IMPORT LIB$STOP;
FROM SYSTEM IMPORT BYTE,NOP,CAST,SHORTWORD;
IMPORT LongMath, ConditionHandlingProcedures, DECW$XLIBMSG, DECW$XLIBDEF;

TYPE UNSIGNED = CARDINAL; DOUBLE = LONGREAL; WORD = SHORTWORD;

CONST Zero = 0.0; One = 1.0; Two = 2.0;

PROCEDURE zero(VAR a: ARRAY OF BYTE);
VAR i: INTEGER;
BEGIN FOR i:= 0 TO HIGH(a) DO a[i]:= CAST(BYTE, 0); END;
END zero;

CONST NV = 12;(* number of vertices *) NF = 20;(* number of faces *) 
  iconame_length_max = 100;

TYPE Point3D = RECORD x,y,z:  DOUBLE; END;
  Coord3D = (x, y, z);
  twelve_points = ARRAY[0..NV-1] OF Point3D;
  sixty_integers= ARRAY[0..59] OF INTEGER;
  Transform3D = ARRAY[0..3],[0..3] OF DOUBLE;
  P3Darray = ARRAY BOOLEAN OF twelve_points;
  string = ARRAY [0..iconame_length_max] OF CHAR;

VAR (* variables needed by xlib *)
  dpy: UNSIGNED;    (* the display variable *)
  vis: x$visual;    (* the default visual *)
  fg: UNSIGNED;     (* the foreground color *)
  bg: UNSIGNED;     (* the background color *)
  win: UNSIGNED;    (* our window id *)
  winX:INTEGER;     (* x coordinate of window origin *)
  winY: INTEGER;    (* y coordinate of window origin *)
  winW: INTEGER;    (* window width *)
  winH: INTEGER;    (* window height *)
  xswa: x$set_win_attributes; (* window attributes *)
  gc: UNSIGNED;     (* our gc id *)
  xev: x$event;     (* our event structure *)
  xgcv: x$gc_values;(* our gc structure *)
  mask: UNSIGNED;   (* a mask for window attributes *)
  iconame: string;
  (* variables needed for calculations *)
  seed: INTEGER;  (* used to initialize the random # gen *)
  icoX, icoY, icoW, icoH, icoDeltaX, icoDeltaY: INTEGER;
  new1, new2: INTEGER; prevX, prevY: INTEGER; buffer: BOOLEAN; xform: Transform3D; wo2, ho2: DOUBLE;
  (* icosahedron vertices *)
  f : sixty_integers; xv : P3Darray; drawn : ARRAY[0..NV-1],[0..NV-1] OF BOOLEAN;

  PROCEDURE Random (VAR i:INTEGER):REAL;
  BEGIN
    i:=69069*CAST(CARDINAL,i) + 1;
    IF i<0 THEN RETURN 
      (FLOAT(ABS(i))+2147483648.)/4294967296.;
    ELSE RETURN
      FLOAT(i)/4294967296.;
    END;
  END Random;

MODULE drawIcoInit;
  IMPORT wo2, ho2, Two, icoW, icoH, zero, xform,xv,f,buffer, Point3D, 
    twelve_points, sixty_integers, Transform3D, Coord3D, DOUBLE, One;
  FROM LongMath IMPORT sin,cos;

  PROCEDURE FormatRotateMat(axis : Coord3D; angle: DOUBLE; VAR m: Transform3D);
  (* Description: Format a matrix that will perform a rotation transformation
     about the specified axis.  The rotation angle is measured
     counterclockwise about the specified axis when looking
     at the origin from the positive axis.
    Input: axis (x, y, z) about which to perform rotation
     angle (in radians) of rotation
    Output: m formatted rotation matrix
  *)
  VAR s,c:DOUBLE;

    PROCEDURE IdentMat(VAR m:Transform3D);
    (* Description: Format a 4x4 identity matrix.
      Output: m formatted identity matrix
    *)
    VAR i:INTEGER;
    BEGIN
      zero(m);
      FOR i := 0 TO 3 DO m[i,i] := One;
      END;
    END IdentMat;
  BEGIN (*FormatRotateMat*)
    IdentMat(m); s := sin(angle); c := cos(angle);
    CASE axis OF 
      x: m[1,1] := c; m[2,2] := c; m[1,2] := s; m[2,1] := -s;
    | y: m[0,0] := c; m[2,2] := c; m[2,0] := s; m[0,2] := -s;
    | z: m[0,0] := c; m[1,1] := c; m[0,1] := s; m[1,0] := -s;
    END
  END FormatRotateMat;

  PROCEDURE ConcatMat(VAR l, r, m : Transform3D);
  (* Description: Concatenate two 4-by-4 transformation matrices.
    Input: l multiplicand (left operand) r multiplier (right operand)
    Output: m result matrix
  *)
  VAR i,j:INTEGER;
  BEGIN
    FOR i := 0 TO 3 DO
      FOR j := 0 TO 3 DO
        m[i][j] := l[i][0] * r[0][j] + l[i][1] * r[1][j] + l[i][2] * r[2][j] + l[i][3] * r[3][j];
      END;
    END;
  END ConcatMat;
VAR r1,r2:  Transform3D;
BEGIN
  f:= sixty_integers{
    0,  2,  1,    0,  3,  2,    0,  4,  3,    0,  5,  4,    0,  1,  5,
    1,  6, 10,    1,  2,  6,    2,  7,  6,    2,  3,  7,    3,  8,  7,
    3,  4,  8,    4,  9,  8,    4,  5,  9,    5, 10,  9,    5,  1, 10,
   10,  6, 11,    6,  7, 11,    7,  8, 11,    8,  9, 11,    9, 10, 11};
  (* Set up points, transforms, etc.:  *)
  FormatRotateMat(x, (5.0 * 3.1416 / 180.0), r1); 
  FormatRotateMat(y, (5.0 * 3.1416 / 180.0), r2);
  ConcatMat(r1, r2, xform);
  xv[FALSE]:= twelve_points{(* set all of xv[0,i] to v[i] *)
    Point3D{ 0.00000000E0,  0.00000000E0, -0.95105650E0},
    Point3D{ 0.00000000E0,  0.85065080E0, -0.42532537E0},
    Point3D{ 0.80901698E0,  0.26286556E0, -0.42532537E0},
    Point3D{ 0.50000000E0, -0.68819095E0, -0.42532537E0},
    Point3D{-0.50000000E0, -0.68819095E0, -0.42532537E0},
    Point3D{-0.80901698E0,  0.26286556E0, -0.42532537E0},
    Point3D{ 0.50000000E0,  0.68819095E0,  0.42532537E0},
    Point3D{ 0.80901698E0, -0.26286556E0,  0.42532537E0},
    Point3D{ 0.00000000E0, -0.85065080E0,  0.42532537E0},
    Point3D{-0.80901698E0, -0.26286556E0,  0.42532537E0},
    Point3D{-0.50000000E0,  0.68819095E0,  0.42532537E0},
    Point3D{ 0.00000000E0,  0.00000000E0,  0.95105650E0} };
  buffer := FALSE;
  (* Get the initial position, size, and speed of the bounding-box: *)
  icoW := 150; icoH := 150; wo2 := LFLOAT(icoW) / Two; ho2 := LFLOAT(icoH) / Two;
END drawIcoInit;

  PROCEDURE drawIco(win,gc :UNSIGNED; icoX, icoY, icoW, icoH, prevX, prevY : INTEGER);
  (* Description: Undraw previous icosahedron (by erasing its bounding box).
     Rotate and draw the new icosahedron.
    Input: win window on which to draw
     gc X11 graphics context to be used for drawing
     icoX, icoY  position of upper left of bounding-box
     icoW, icoH  size of bounding-box
     prevX, prevYposition of previous bounding-box
  *)
  VAR 
    p0,p1,p2,i,iv2,ixv,ifa,ie:  INTEGER;
    v2: ARRAY[0..NV-1] OF x$point;
    edges:  ARRAY[0..29] OF x$segment;

    PROCEDURE PartialNonHomTransform(n:INTEGER; m:Transform3D;outa:BOOLEAN; 
      VAR t: P3Darray);
    (* Description: Perform a partial transform on non-homogeneous points.
       Given an array of non-homogeneous (3-coordinate) input points,
       this routine multiplies them by the 3-by-3 upper left submatrix
       of a standard 4-by-4 transform matrix.  The resulting non-homogeneous
       points are returned.
      Input: n   number of points to transform 
       m 4-by-4 transform matrix
       outa index into the tarray for output
       t[ina] array of non-homogeneous input points
      Output: t[outa]array of transformed non-homogeneous output points
    *)
    VAR i: INTEGER; ina: BOOLEAN;
    BEGIN
      ina:= NOT outa;
      FOR i:=0 TO n DO
        t[outa][i] := Point3D{ 
          t[ina][i].x * m[0][0] + t[ina][i].y * m[1][0] + t[ina][i].z * m[2][0],
          t[ina][i].x * m[0][1] + t[ina][i].y * m[1][1] + t[ina][i].z * m[2][1],
          t[ina][i].x * m[0][2] + t[ina][i].y * m[1][2] + t[ina][i].z * m[2][2]};
      END
    END PartialNonHomTransform;
  BEGIN (*drawIco*)
    buffer:= NOT buffer;(* Switch double-buffer and rotate vertices *)
    PartialNonHomTransform(NV-1, xform, buffer, xv);
    ixv:=0; iv2:=0;(* Convert 3D coordinates to 2D window coordinates: *)
    FOR i := NV-1 TO 0 BY -1 DO
      v2[iv2] := x$point{
        CAST(WORD, TRUNC(((xv[buffer][ixv].x + One) * wo2) + LFLOAT(icoX))),
        CAST(WORD, TRUNC(((xv[buffer][ixv].y + One) * ho2) + LFLOAT(icoY)))};
      INC(ixv); INC(iv2);
    END;
    ixv := 0; iv2 := 0; ifa := 0; ie := 0;(* Accumulate edges to be drawn, eliminating duplicates for speed *)
    zero(drawn);(* reinitialize the drawn array *)
    FOR i := 1 TO NF DO
      p0 := f[ifa]; p1 := f[ifa + 1]; p2 := f[ifa + 2]; INC(ifa, 3);
      (* If facet faces away from viewer, don't consider it: *)
      IF xv[buffer][p0].z + xv[buffer][p1].z + xv[buffer][p2].z >= Zero THEN
        IF NOT drawn[p0][p1] THEN
          drawn[p0][p1] := TRUE; drawn[p1][p0] := TRUE;
          edges[ie] := x$segment{v2[p0].x$w_gpnt_x, v2[p0].x$w_gpnt_y, v2[p1].x$w_gpnt_x, v2[p1].x$w_gpnt_y};
          INC(ie);
        END;
        IF NOT drawn[p1][p2] THEN
          drawn[p1][p2] := TRUE; drawn[p2][p1] := TRUE;
          edges[ie] := x$segment{v2[p1].x$w_gpnt_x, v2[p1].x$w_gpnt_y, v2[p2].x$w_gpnt_x, v2[p2].x$w_gpnt_y};
          INC(ie);
        END;
        IF NOT drawn[p2][p0] THEN
          drawn[p2][p0] := TRUE; drawn[p0][p2] := TRUE;
          edges[ie] := x$segment{v2[p2].x$w_gpnt_x, v2[p2].x$w_gpnt_y, v2[p0].x$w_gpnt_x, v2[p0].x$w_gpnt_y};
          INC(ie);
        END;
      END;
    END;  (*FOR*)
    (* Erase previous, draw current icosahedrons; sync for smoothness. *)
    x$clear_area(dpy, win, prevX, prevY, icoW + 1, icoH + 1, 0);
    x$draw_segments(dpy, win, gc, edges, ie);
    x$sync(dpy, 0);
  END drawIco;
VAR status: UNSIGNED; time: DateTime;
BEGIN (*Main-Body*)
  zero(xgcv); mask:= 0; (* a mask for window attributes *)
  iconame:= 'IcoMod is the Modula-2 Version of Ico'; zero(drawn);
  (* Establish a network connection from the client to the server by "opening"
    the display. On VMS systems, the logical name "display" will be
    translated to identify the display. This definition can be accomplished 
    with a DCL command like:
      $ define display foobar::0
    where "foobar" is the DECnet node name of server workstation.
    If an error occurs on the Open, then print a message and exit the program.  
  *)
  dpy := x$open_display(NOP); IF dpy = 0 THEN LIB$STOP(X$_CANTOPEN); END;
  (* get the forground and background pixel colors for display *)
  fg := x$white_pixel(dpy, x$default_screen(dpy)); bg := x$black_pixel(dpy, x$default_screen(dpy));
  winW := 600; winH := 600;(* Set up window parameters, create and map window if necessary: *)
  winX := (x$display_width(dpy, x$default_screen(dpy)) - CAST(UNSIGNED, winW)) / 2;
  winY := (x$display_height(dpy,x$default_screen(dpy)) - CAST(UNSIGNED, winH)) / 2;
  (* set up the window attributes.  We want to set the event mask, the background pixel and the foreground pixel *)
  xswa.x$l_swda_event_mask := 0; xswa.x$l_swda_background_pixel := bg; xswa.x$l_swda_border_pixel := fg;
  (* set up the mask to the correct bits set to one for the attributes that we want to change *)
  mask := x$m_cw_event_mask+ x$m_cw_back_pixel; mask := mask + x$m_cw_border_pixel;
  status:=x$default_visual(dpy,x$default_screen(dpy),vis);(* use the default visual as a parameter to create window *)
  (* create a window whose parent is the root window.  Use 
    the default depth and visual.  This routine 
    returns the window id in the variable win
  *)
  win := x$create_window(dpy, x$default_root_window(dpy), winX, winY, winW, winH, 0, 
  x$default_depth(dpy,x$default_screen(dpy)), 
  x$c_input_output, vis, mask, xswa); 
  (* windows are not visible until they are maped.  map this window *)
  x$change_property(dpy, win, X$C_XA_WM_NAME , X$C_XA_STRING, 8,
    x$c_prop_mode_replace, iconame, LENGTH(iconame));
  x$map_window(dpy, win);
  gc := x$create_gc(dpy, win, 0, xgcv);(* Set up a graphics context *)
  x$set_foreground(dpy, gc, fg);(* set the foreground and background pixel in the new gc *)
  x$set_background(dpy, gc, bg);
  (* Initialize the random number generator seed *)
  GetClock(time); seed:=(time.minute*60+time.second)*100+time.fractions;
  (* initialize icox and ixoy to be a random starting place.  The
    number needs to be between the left and right at top and
    bottom of the window.Get the random number and zero out the high bits.
    This leaves a number between 0 and 255 
  *)
  new1 := INT(Random(seed)*256.); new2 := INT(Random(seed)*256.);
  (* calculate initial position by using the random number and
    keeping the value in between icoW and winW.  We multiply
    by a number between 0 and 255, and then divide by 256
    to keep the value of icox in the correct range
  *)
  icoX := ((winW  - icoW) * new1) / 256; icoY := ((winH  - icoH) * new2) / 256;
  icoDeltaX := 13; icoDeltaY := 9;(* move it by this much each time *)
  LOOP(* Bounce the box in the window: *)
    (* make sure there are no pending events. If there are, get them but don't do anything *)
    IF x$pending(dpy) <> 0 THEN x$next_event(dpy, xev); END;
    prevX := icoX; prevY := icoY;
    INC(icoX, icoDeltaX);
    IF (icoX < 0) OR (icoX + icoW > winW) THEN
      DEC(icoX, icoDeltaX * 2); icoDeltaX := -icoDeltaX;
    END;
    INC(icoY, icoDeltaY);
    IF (icoY < 0) OR (icoY + icoH > winH) THEN
      DEC(icoY, icoDeltaY * 2); icoDeltaY := - icoDeltaY;
    END;
    drawIco(win, gc, icoX, icoY, icoW, icoH, prevX, prevY);
  END ;
END ICOMOD.

__________________________________________________________________________________________________ 

Editors note: All sources of the above example programs were submitted to ModulaWare 
in Sep.-1990 (updated to ISO Modula-2 in May-1993) and are now part of ModulaWare's 
Modula-2 compiler distribution kit MVR. 

The above Modula-2 version of ICOMOD_v4.MOD was again rewritten in Oberon-2 by 
Petra Fabian using ModulaWare's VAX/VMS Oberon-2 compiler H2O V1.28 in 
Jun-1993.  

oli:ICOMOD.MOD

__________________________________________________________________________________________________ 

MODULE ICOMOD;
(*Description: Display a wire-frame rotating icosahedron, with hidden lines removed
  Arguments: -
  Description: bounce a bounding box inside the window
  XWindows Programming Example: Modula-2 version derived from the Pascal version of the Ico 
demo
  by common effort of A. Schuhmacher, Elmar Baumgart, Guenter Dotzel,
  ModulaWare GmbH, Wilhelmstr. 17A, D-8520 Erlangen/F.R.G., 24-Nov-1991

  Transpiled manually to Oberon-2 by Petra Fabian, ModulaWare GmbH,
  03-Jun-1993, from source file [m2lib]icomod_v4.mod

  source file: oli:icomod.mod

  To link use ( $ link icomod,sys$input/opt 
                   sys$share:decw$xlibshr/share )
*)        
IMPORT Y:= DECW$XLIBMSG, X:= DECW$XLIBDEF, SysClock, L := LIB$, SYSTEM,
 LM := LongMath, R:=Random, M2_Arithmetic, CTR;

TYPE CARDINAL = CTR.CARDINAL; 
 SHORTWORD = SYSTEM.SHORTWORD;
 UNSIGNED = CARDINAL; DOUBLE = LONGREAL; WORD = SHORTWORD;
 BYTE = SYSTEM.BYTE;
 ENUM = INTEGER;

CONST Zero = 0.0; One = 1.0; Two = 2.0; NOP = NIL;

CONST NV = 12;(* number of vertices *) NF = 20;(* number of faces *) 
  iconame_length_max = 100; x = 0; y = 1; z = 2;

TYPE Point3D = RECORD x,y,z:  DOUBLE; END;
  (* Coord3D = (x, y, z); *)
  Coord3D = ENUM;
  twelve_points = ARRAY NV OF Point3D;
  sixty_integers= ARRAY 60 OF INTEGER;
  Transform3D = ARRAY 4 OF ARRAY 4 OF DOUBLE;
  P3Darray = ARRAY 2 OF twelve_points;
  string = ARRAY iconame_length_max+1 OF CHAR;

VAR (* variables needed by xlib *)
  dpy: UNSIGNED;    (* the display variable *)
  vis: X.x$visual;    (* the default visual *)
  fg: UNSIGNED;     (* the foreground color *)
  bg: UNSIGNED;     (* the background color *)
  win: UNSIGNED;    (* our window id *)
  winX:INTEGER;     (* x coordinate of window origin *)
  winY: INTEGER;    (* y coordinate of window origin *)
  winW: INTEGER;    (* window width *)
  winH: INTEGER;    (* window height *)
  xswa: X.x$set_win_attributes; (* window attributes *)
  gc: UNSIGNED;     (* our gc id *)
  xev: X.x$event_0;     (* our event structure *)
  xgcv: X.x$gc_values;(* our gc structure *)
  mask: UNSIGNED;   (* a mask for window attributes *)
  iconame: string;
  (* variables needed for calculations *)
  seed: INTEGER;  (* used to initialize the random # gen *)
  icoX, icoY, icoW, icoH, icoDeltaX, icoDeltaY: INTEGER;
  new1, new2: INTEGER; prevX, prevY: INTEGER; buffer: BOOLEAN; 
  xform: Transform3D; wo2, ho2: DOUBLE;
  (* icosahedron vertices *)
  f : sixty_integers; xv : P3Darray; 
  drawn : ARRAY NV OF ARRAY NV OF BOOLEAN;
  r1,r2:  Transform3D;
  i : INTEGER;
  findex : INTEGER;
  status: UNSIGNED; time: SysClock.DateTime;

  PROCEDURE Index(a: BOOLEAN): INTEGER;
  BEGIN
    IF a THEN RETURN 1 ELSE RETURN 0 END;
  END Index;

  (* init procedures *)

  PROCEDURE cPoint3D(VAR x: Point3D; a,b,c : DOUBLE);
  BEGIN
    x.x := a; x.y := b; x.z := c;
  END cPoint3D;

  PROCEDURE finit(a,b,c: INTEGER);
  BEGIN
    f[findex] := a; INC(findex);
    f[findex] := b; INC(findex);
    f[findex] := c; INC(findex);
  END finit;  

  PROCEDURE zero(VAR a: ARRAY OF BYTE);
  VAR i: INTEGER;
  BEGIN FOR i:= 0 TO LEN(a)-1 DO a[i]:= SYSTEM.CAST(BYTE, 0); END;
  END zero;

  PROCEDURE FormatRotateMat(axis : Coord3D; angle: DOUBLE; VAR m: Transform3D);
  (* Description: Format a matrix that will perform a rotation transformation
     about the specified axis.  The rotation angle is measured
     counterclockwise about the specified axis when looking
     at the origin from the positive axis.
    Input: axis (x, y, z) about which to perform rotation
     angle (in radians) of rotation
    Output: m formatted rotation matrix
  *)
  VAR s,c:DOUBLE;

    PROCEDURE IdentMat(VAR m:Transform3D);
    (* Description: Format a 4x4 identity matrix.
      Output: m formatted identity matrix
    *)
    VAR i:INTEGER;
    BEGIN
      zero(m);
      FOR i := 0 TO 3 DO m[i,i] := One;
      END;
    END IdentMat;
  BEGIN (*FormatRotateMat*)
    IdentMat(m); s := LM.sin(angle); c := LM.cos(angle);
    CASE axis OF 
    | x: m[1,1] := c; m[2,2] := c; m[1,2] := s; m[2,1] := -s;
    | y: m[0,0] := c; m[2,2] := c; m[2,0] := s; m[0,2] := -s;
    | z: m[0,0] := c; m[1,1] := c; m[0,1] := s; m[1,0] := -s;
    END
  END FormatRotateMat;

  PROCEDURE ConcatMat(VAR l, r, m : Transform3D);
  (* Description: Concatenate two 4-by-4 transformation matrices.
    Input: l multiplicand (left operand) r multiplier (right operand)
    Output: m result matrix
  *)
  VAR i,j:INTEGER;
  BEGIN
    FOR i := 0 TO 3 DO
      FOR j := 0 TO 3 DO
        m[i][j] := l[i][0] * r[0][j] + l[i][1] * r[1][j] 
        + l[i][2] * r[2][j] + l[i][3] * r[3][j];
      END;
    END;
  END ConcatMat;

  PROCEDURE drawIco(win,gc :UNSIGNED; 
    icoX, icoY, icoW, icoH, prevX, prevY : INTEGER);
  (* Description: Undraw previous icosahedron 
     (by erasing its bounding box).
     Rotate and draw the new icosahedron.
     Input: win window on which to draw
     gc X11 graphics context to be used for drawing
     icoX, icoY  position of upper left of bounding-box
     icoW, icoH  size of bounding-box
     prevX, prevYposition of previous bounding-box
  *)
  VAR 
    p0,p1,p2,i,iv2,ixv,ifa,ie,a:  INTEGER;
    v2: ARRAY NV OF X.x$point;
    edges:  ARRAY 30 OF X.x$segment;

    PROCEDURE PartialNonHomTransform(n:INTEGER; m:Transform3D;
      outa:BOOLEAN; VAR t: P3Darray);
    (* Description: Perform a partial transform on non-homogeneous points.
       Given an array of non-homogeneous (3-coordinate) input points,
       this routine multiplies them by the 3-by-3 upper left submatrix
       of a standard 4-by-4 transform matrix.  The resulting non-homogeneous
       points are returned.
      Input: n   number of points to transform 
       m 4-by-4 transform matrix
       outa index into the tarray for output
       t[ina] array of non-homogeneous input points
      Output: t[outa]array of transformed non-homogeneous output points
    *)
    VAR i: INTEGER; ina: BOOLEAN;
        a, b: INTEGER;
    BEGIN
      ina:= ~ outa;
      a := Index(ina);
      b := Index(outa);
      FOR i:=0 TO n DO
        t[b][i].x :=  t[a][i].x * m[0][0] + t[a][i].y * m[1][0] + 
          t[a][i].z * m[2][0];
        t[b][i].y :=  t[a][i].x * m[0][1] + t[a][i].y * m[1][1] + 
          t[a][i].z * m[2][1];
        t[b][i].z :=  t[a][i].x * m[0][2] + t[a][i].y * m[1][2] + 
          t[a][i].z * m[2][2];
      END;
    END PartialNonHomTransform;

  BEGIN (*drawIco*)
    buffer:= ~ buffer;(* Switch double-buffer and rotate vertices *)
    PartialNonHomTransform(NV-1, xform, buffer, xv);
    ixv:=0; iv2:=0;(* Convert 3D coordinates to 2D window coordinates: *)
    a := Index(buffer);
    FOR i := NV-1 TO 0 BY -1 DO
      v2[iv2].x$w_gpnt_x := SYSTEM.CAST(WORD, 
        M2_Arithmetic.MINT(((xv[a][ixv].x + One) * wo2) + icoX));
      v2[iv2].x$w_gpnt_y :=  SYSTEM.CAST(WORD, 
        M2_Arithmetic.MINT(((xv[a][ixv].y + One) * ho2) + icoY));
      INC(ixv); INC(iv2);
    END;
    ixv := 0; iv2 := 0; ifa := 0; ie := 0;
    (* Accumulate edges to be drawn, eliminating duplicates for speed *)
    zero(drawn);(* reinitialize the drawn array *)
    FOR i := 1 TO NF DO
      p0 := f[ifa]; p1 := f[ifa + 1]; p2 := f[ifa + 2]; INC(ifa, 3);
      (* If facet faces away from viewer, don't consider it: *)
      IF xv[a][p0].z + xv[a][p1].z + xv[a][p2].z >= Zero THEN
        IF ~ drawn[p0][p1] THEN
          drawn[p0][p1] := TRUE; drawn[p1][p0] := TRUE;
          edges[ie].x$w_gseg_x1 := v2[p0].x$w_gpnt_x;
          edges[ie].x$w_gseg_y1 := v2[p0].x$w_gpnt_y;
          edges[ie].x$w_gseg_x2 := v2[p1].x$w_gpnt_x;
          edges[ie].x$w_gseg_y2 := v2[p1].x$w_gpnt_y;  
          INC(ie);
        END;
        IF ~ drawn[p1][p2] THEN
          drawn[p1][p2] := TRUE; drawn[p2][p1] := TRUE;
          edges[ie].x$w_gseg_x1 := v2[p1].x$w_gpnt_x; 
          edges[ie].x$w_gseg_y1 := v2[p1].x$w_gpnt_y; 
          edges[ie].x$w_gseg_x2 := v2[p2].x$w_gpnt_x;
          edges[ie].x$w_gseg_y2 := v2[p2].x$w_gpnt_y;
          INC(ie);
        END;
        IF ~ drawn[p2][p0] THEN
          drawn[p2][p0] := TRUE; drawn[p0][p2] := TRUE;
          edges[ie].x$w_gseg_x1 := v2[p2].x$w_gpnt_x;
          edges[ie].x$w_gseg_y1 := v2[p2].x$w_gpnt_y;
          edges[ie].x$w_gseg_x2 := v2[p0].x$w_gpnt_x; 
          edges[ie].x$w_gseg_y2 := v2[p0].x$w_gpnt_y; 
          INC(ie);
        END;
      END;
    END;  (*FOR*)
    (* Erase previous, draw current icosahedrons; sync for smoothness. *)
    X.x$clear_area(dpy, win, prevX, prevY, icoW + 1, icoH + 1, 0);
    X.x$draw_segments(dpy, win, gc, edges, ie);
    X.x$sync(dpy, 0); 
  END drawIco;

BEGIN (*Main-Body*)
  buffer := FALSE; findex := 0; finit (0,  2,  1); finit (0,  3,  2);
  finit (0,  4,  3); finit (0,  5,  4); finit (0,  1,  5); finit (1,  6, 10);
  finit (1,  2,  6); finit (2,  7,  6); finit (2,  3,  7); finit (3,  8,  7);
  finit (3,  4,  8); finit (4,  9,  8); finit (4,  5,  9); finit (5, 10,  9);
  finit (5,  1, 10); finit (10,  6, 11); finit (6,  7, 11);
  finit (7,  8, 11); finit (8,  9, 11); finit (9, 10, 11);
  (* Set up points, transforms, etc.:  *)
  FormatRotateMat(x, (5.0 * 3.1416 / 180.0), r1); 
  FormatRotateMat(y, (5.0 * 3.1416 / 180.0), r2);
  ConcatMat(r1, r2, xform);
  cPoint3D(xv[0][0], 0.00000000E0,  0.00000000E0, -0.95105650E0);
  cPoint3D(xv[0][1], 0.00000000E0,  0.85065080E0, -0.42532537E0);
  cPoint3D(xv[0][2], 0.80901698E0,  0.26286556E0, -0.42532537E0);
  cPoint3D(xv[0][3], 0.50000000E0, -0.68819095E0, -0.42532537E0);
  cPoint3D(xv[0][4],-0.50000000E0, -0.68819095E0, -0.42532537E0);
  cPoint3D(xv[0][5],-0.80901698E0,  0.26286556E0, -0.42532537E0);
  cPoint3D(xv[0][6], 0.50000000E0,  0.68819095E0,  0.42532537E0);
  cPoint3D(xv[0][7], 0.80901698E0, -0.26286556E0,  0.42532537E0);
  cPoint3D(xv[0][8], 0.00000000E0, -0.85065080E0,  0.42532537E0);
  cPoint3D(xv[0][9],-0.80901698E0, -0.26286556E0,  0.42532537E0);
  cPoint3D(xv[0][10],-0.50000000E0,  0.68819095E0,  0.42532537E0);
  cPoint3D(xv[0][11], 0.00000000E0,  0.00000000E0,  0.95105650E0);
  (* Get the initial position, size, and speed of the bounding-box: *)
  icoW := 150; icoH := 150; wo2 := icoW / Two; 
  ho2 := icoH / Two;

  zero(xgcv); mask:= 0; (* a mask for window attributes *)
  iconame:= 'IcoMod is the Oberon-2 Version of Ico'; zero(drawn);
  (* Establish a network connection from the client to the server by "opening"
    the display. On VMS systems, the logical name "display" will be
    translated to identify the display. This definition can be accomplished 
    with a DCL command like:
      $ define display foobar::0
    where "foobar" is the DECnet node name of server workstation.
    If an error occurs on the Open, then print a message and exit the program.  
  *)
  (* dpy := X.x$open_display(NOP); *)
  dpy := X.x$open_display(''); 
  IF dpy = 0 THEN L.LIB$STOP(Y.X$_CANTOPEN); END; 
  (* get the forground and background pixel colors for display *)
  fg := X.x$white_pixel(dpy, X.x$default_screen(dpy)); 
  bg := X.x$black_pixel(dpy, X.x$default_screen(dpy)); 
  winW := 600; winH := 600;
  (* Set up window parameters, create and map window if necessary: *)
  winX := (X.x$display_width(dpy, X.x$default_screen(dpy)) - winW) DIV 2;
  winY := (X.x$display_height(dpy,X.x$default_screen(dpy)) - winH) DIV 2; 
  (* set up the window attributes.  
     We want to set the event mask, 
     the background pixel and the foreground pixel *)
  xswa.x$l_swda_event_mask := 0; 
  xswa.x$l_swda_background_pixel := bg; 
  xswa.x$l_swda_border_pixel := fg;
  (* set up the mask to the correct bits set to one for the 
     attributes that we want to change *)
  mask := X.x$m_cw_event_mask+ X.x$m_cw_back_pixel; 
  mask := mask + X.x$m_cw_border_pixel;
  status:=X.x$default_visual(dpy,X.x$default_screen(dpy),vis); 
  (* use the default visual as a parameter to create window *)
  (* create a window whose parent is the root window.  Use 
    the default depth and visual.  This routine 
    returns the window id in the variable win
  *)
  win := X.x$create_window(dpy, X.x$default_root_window(dpy), 
    winX, winY, winW, winH, 0, X.x$default_depth(dpy,X.x$default_screen(dpy)), 
    X.x$c_input_output, vis, mask, xswa); 
  (* windows are not visible until they are maped.  map this window *)
  X.x$change_property(dpy, win, X.X$C_XA_WM_NAME , X.X$C_XA_STRING, 8,
    X.x$c_prop_mode_replace, iconame, SYSTEM.LENGTH(iconame));
  X.x$map_window(dpy, win);
  gc := X.x$create_gc(dpy, win, 0, xgcv);(* Set up a graphics context *)
  X.x$set_foreground(dpy, gc, fg);(* set the foreground and background 
  pixel in the new gc *)
  X.x$set_background(dpy, gc, bg);
  (* Initialize the random number generator seed *) 
  SysClock.GetClock(time); 
  seed:=(time.minute*60+time.second)*100+time.fractions;
  (* initialize icox and ixoy to be a random starting place.  The
    number needs to be between the left and right at top and
    bottom of the window.Get the random number and zero out the high bits.
    This leaves a number between 0 and 255 
  *)
  new1 := ENTIER(R.Random(seed,seed)*256.);             
  new2 := ENTIER(R.Random(seed,seed)*256.);
  (* calculate initial position by using the random number and
    keeping the value in between icoW and winW.  We multiply
    by a number between 0 and 255, and then divide by 256
    to keep the value of icox in the correct range
  *)
  icoX := ((winW  - icoW) * new1) DIV 256; 
  icoY := ((winH  - icoH) * new2) DIV 256;
  icoDeltaX := 13; icoDeltaY := 9;(* move it by this much each time *)
  LOOP(* Bounce the box in the window: *)
    (* make sure there are no pending events. 
     If there are, get them but don't do anything *)
    IF X.x$pending(dpy) # 0 THEN X.x$next_event(dpy, xev); END; 
    prevX := icoX; prevY := icoY;
    INC(icoX, icoDeltaX);
    IF (icoX < 0) OR (icoX + icoW > winW) THEN
      DEC(icoX, icoDeltaX * 2); icoDeltaX := -icoDeltaX;
    END;
    INC(icoY, icoDeltaY);
    IF (icoY < 0) OR (icoY + icoH > winH) THEN
      DEC(icoY, icoDeltaY * 2); icoDeltaY := - icoDeltaY;
    END;
    drawIco(win, gc, icoX, icoY, icoW, icoH, prevX, prevY);
  END ;
END ICOMOD.

__________________________________________________________________________________________________ 

MODULE Random; 
  TYPE INTEGER*=LONGINT;
  
  PROCEDURE Random*(VAR i,j:INTEGER):REAL;
  BEGIN
    i:=69069*i + 1;
    IF i<0 THEN RETURN (ABS(i)+2147483648.)/4294967296.;
    ELSE RETURN i/4294967296.;
    END;
  END Random;

END Random.

__________________________________________________________________________________________________ 

MODULE M2_Arithmetic;

IMPORT CTR;

TYPE INTEGER*=CTR.INTEGER;
  CARDINAL*=CTR.CARDINAL;

PROCEDURE MINT*(r:  LONGREAL): INTEGER;
END MINT;

PROCEDURE MTRUNC*(r:  LONGREAL): CARDINAL;
END MTRUNC;

PROCEDURE MMOD*(a,b: INTEGER): INTEGER;
END MMOD;

END M2_Arithmetic.

__________________________________________________________________________________________________ 

DEFINITION MODULE M2_Arithmetic;

PROCEDURE MINT(r:  LONGREAL): INTEGER;

PROCEDURE MTRUNC(r:  LONGREAL): CARDINAL;

PROCEDURE MMOD(a,b: INTEGER): INTEGER;

END M2_Arithmetic.

__________________________________________________________________________________________________ 

IMPLEMENTATION MODULE M2_Arithmetic;

PROCEDURE MINT(r:  LONGREAL): INTEGER;
BEGIN
  RETURN INT(r);
END MINT;

PROCEDURE MTRUNC(r:  LONGREAL): CARDINAL;
BEGIN
  RETURN TRUNC(r);
END MTRUNC;

PROCEDURE MMOD(a,b: INTEGER): INTEGER;
BEGIN
  RETURN a MOD b;
END MMOD;

END M2_Arithmetic.

__________________________________________________________________________________________________ 

\250 DEC, DECWindows, VAX, VMS are registered trademarks of Digital Equipment Corporation. \252 MVR is a 
trademark of ModulaWare.

IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication: The Editor of The ModulaTor is Guenter Dotzel; he can be reached by tel/fax: [removed due to abuse] or by mailto:[email deleted due to spam]
  ModulaWare home page   The ModulaTor download    [Any browser]

Webdesign by www.otolo.com/webworx, 14-Jul-1998