(* Copyright (C) 1989, 1990 Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: xboxes.i3 *) (* Last modified on Thu Apr 12 00:28:58 1990 by muller *) (* modified on Thu Feb 15 12:32:08 1990 by jerome *) (*==============================================================*) (* The X11 R4 Interface for Modula 3 *) (* *) (* The Athena Widgets Set Example (re)coded in Modula3 *) (*==============================================================*) (* * This an example of how to create nested composite widgets. * * User events are handled through callback routines. * * Application resources are also introduced. * * November 27, 1989 - Chris D. Peterson *) (* * $XConsortium: xboxes.c,v 1.20 89/12/15 19:32:48 kit Exp $ * * Copyright 1989 Massachusetts Institute of Technology * * Permission to use, copy, modify, distribute, and sell this software and its * documentation for any purpose is hereby granted without fee, provided that * the above copyright notice appear in all copies and that both that * copyright notice and this permission notice appear in supporting * documentation, and that the name of M.I.T. not be used in advertising or * publicity pertaining to distribution of the software without specific, * written prior permission. M.I.T. makes no representations about the * suitability of this software for any purpose. It is provided "as is" * without express or implied warranty. * * M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL M.I.T. * BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION * OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) MODULE xboxes EXPORTS Main; FROM M3toC IMPORT TtoS, StoT, ItoP, argc, argv; IMPORT Fmt, Stdio, Wr, Cstdlib, Xrm, Xt, XtN, XtR, Xaw; (* Function Name: Syntax * Description: Prints the calling syntax for this program to stdout. * Arguments: app_con - the application context. * call - the name of the application. * Returns: none - exits tho. *) PROCEDURE Syntax (app_con: Xt.AppContext; call: Xt.String) = BEGIN Xt.DestroyApplicationContext (app_con); Wr.PutText (Stdio.stdout, "Usage: " & StoT (call) & "\n" & " [ -vspace ] [ -hspace ]\n" & " [ -scroll ] [ -noscroll ]\n" & " [ -numboxes ]\n"); Cstdlib.exit (1); END Syntax; (* Function Name: Quit * Description: This function quits the program. * Arguments: w - the widget * call_data - ** UNUSED ** * client_data - ** UNUSED ** * Returns: none *) PROCEDURE Quit (w: Xt.Widget; <*UNUSED*> client_data, call_data: ADDRESS) = BEGIN Xt.DestroyApplicationContext (Xt.WidgetToApplicationContext (w)); Cstdlib.exit (0); END Quit; (* Function Name: MakeBox * Description: Makes a button box containing three labels. * Arguments: parent - parent of the box. * name - name of the boxes first label, and the box. * Returns: none. *) PROCEDURE MakeBox (parent: Xt.Widget; name: Xt.String) = VAR box: Xt.Widget; BEGIN box := Xt.CreateManagedWidget (name, Xaw.boxWidgetClass, parent); EVAL Xt.CreateManagedWidget (name, Xaw.labelWidgetClass, box); FOR i:= 1 TO 3 DO EVAL Xt.CreateManagedWidget (TtoS ("label"), Xaw.labelWidgetClass, box); END; END MakeBox; (* * All application resources must reside in a structure, the structure * contains space where the application resources will be stored. *) TYPE AppResources = RECORD scroll: Xt.Boolean; num_boxes: INTEGER END; (* #define XtOffset(p_type,field) \ ((Cardinal) (((char * ) (&(((p_type)NULL)->field))) - ((char * ) NULL))) *) VAR resources := NEW (Xt.ResourceList); fb_res := NEW (Xt.FallbackResList); options := NEW (Xrm.OptionDescList); app_resources := NEW (UNTRACED REF AppResources); app_con: Xt.AppContext; root, box_parent: Xt.Widget; box, command: Xt.Widget; BEGIN fb_res[0] := TtoS ("*Command.Label: " & "Click the left mouse button here to quit"); fb_res[1] := TtoS ("*Viewport*allowVert: True"); fb_res[2] := TtoS ("*Viewport*allowHoriz: True"); fb_res[3] := NIL; options[0] := Xrm.OptionDescRec{ TtoS ("-hspace"), TtoS ("*Box.hSpace"), Xrm.optionSepArg, NIL}; options[1] := Xrm.OptionDescRec{ TtoS ("-vspace"), TtoS ("*Box.vSpace"), Xrm.optionSepArg, NIL}; options[2] := Xrm.OptionDescRec{ TtoS ("-scroll"), TtoS ("scroll"), Xrm.optionNoArg, TtoS ("True")}; options[3] := Xrm.OptionDescRec{ TtoS ("-noscroll"), TtoS ("scroll"), Xrm.optionNoArg, TtoS ("False")}; options[4] := Xrm.OptionDescRec{ TtoS ("-numboxes"), TtoS ("numBoxes"), Xrm.optionSepArg, NIL}; root := Xt.AppInitialize(app_con, TtoS ("Xboxes"), options, 5, argc, argv, fb_res); IF (argc # 1) THEN Syntax (app_con, argv[0]) END; (* * The resources specification contains: * * The name and class of the resource. * The representation type of the resource. * The location in the structure to keep the value of this resource. * The default value for this resource. * * This information is passed into Xt.GetApplicationResources(). *) resources[0] := Xt.Resource { TtoS ("scroll"), TtoS ("Scroll"), XtR.Boolean, BYTESIZE (Xt.Boolean), 0, XtR.Immediate, ItoP (0)}; resources[1] := Xt.Resource { TtoS ("numBoxes"), TtoS ("NumBoxes"), XtR.Int, BYTESIZE (INTEGER), 4, XtR.Immediate, ItoP (3)}; (* * Actually load the application resources, and store them in the * structure pointed to by &app_resources. *) Xt.GetApplicationResources (root, app_resources, resources, 2); (* * Here we use the app_resources "scroll" to determine whether or not * to insert a viewport widget between the outer Box and the Shell. This * would allow scrolling of the outer Box. *) IF (app_resources^.scroll # 0) THEN box_parent := Xt.CreateManagedWidget (TtoS ("view"), Xaw.viewportWidgetClass, root); ELSE box_parent := root END; box := Xt.CreateManagedWidget (TtoS ("outerbox"), Xaw.boxWidgetClass, box_parent); command := Xt.CreateManagedWidget (TtoS ("command"), Xaw.commandWidgetClass, box); Xt.AddCallback (command, XtN.callback, Quit); (* * Put a bunch of smaller boxes in the outer box. *) FOR i := 1 TO app_resources^.num_boxes DO MakeBox (box, TtoS ("aLongBoxName" & Fmt.Int(i*i*i*i))) END; Xt.RealizeWidget (root); Xt.AppMainLoop (app_con); END xboxes.