(* Copyright (C) 1989, 1990 Digital Equipment Corporation *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* File: xwidgets.i3 *) (* Last modified on Tue Apr 24 18:18:27 1990 by jerome *) (* modified on Thu Apr 12 01:26:39 1990 by muller *) (*==============================================================*) (* The X11 R4 Interface for Modula 3 *) (* *) (* The Athena Widgets Set Example (re)coded in Modula3 *) (*==============================================================*) (* * This example uses all the Athena widgets, and demonstrates timeouts. * * November 30, 1989 - Chris D. Peterson *) (* * $XConsortium: xwidgets.c,v 1.27 89/12/15 19:33:19 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. *) UNSAFE MODULE xwidgets EXPORTS Main; FROM M3toC IMPORT TtoS, StoT, PtoI, PtoDS, PtoFS, ItoP, UtoP, argc, argv; IMPORT Fmt, Stdio, Text, Wr, Ctypes, Cstdlib, X, Xrm, Xt, XtN, Xaw; VAR fallbacklist := NEW (Xt.FallbackResList); args := NEW (Xt.ArgList); app_con: Xt.AppContext; root: Xt.Widget; outer: Xt.Widget; dialog: Xt.Widget; box: Xt.Widget; quit: Xt.Widget; chart: Xt.Widget; list: Xt.Widget; viewport: Xt.Widget; count := 0; (* Function Name: CreateFormWithButtons * Description: Creates a form widget that contains: * a label, command, toggle, and menu button. * Arguments: parent - the parent of the form widget. * Returns: none. *) PROCEDURE CreateFormWithButtons (parent: Xt.Widget) = VAR form, label, button, menu: Xt.Widget; BEGIN form := Xt.CreateManagedWidget (TtoS ("form"), Xaw.formWidgetClass, parent); label := Xt.CreateManagedWidget (TtoS ("formLabel"), Xaw.labelWidgetClass, form); args[0] := Xt.Arg {XtN.fromHoriz, label}; button := Xt.CreateManagedWidget (TtoS ("command"), Xaw.commandWidgetClass, form, args, 1); Xt.AddCallback (button, XtN.callback, Count, label); args[0] := Xt.Arg {XtN.fromHoriz, button}; button := Xt.CreateManagedWidget (TtoS ("toggle"), Xaw.toggleWidgetClass, form, args, 1); Xt.AddCallback (button, XtN.callback, Count, label); args[0] := Xt.Arg {XtN.fromHoriz, button}; button := Xt.CreateManagedWidget (TtoS ("menuButton"), Xaw.menuButtonWidgetClass, form, args, 1); menu := Xt.CreatePopupShell (TtoS ("menu"), Xaw.simpleMenuWidgetClass, button); FOR i:= 0 TO 5 DO EVAL Xt.CreateManagedWidget (TtoS ("menuEntry" & Fmt.Int (i)), Xaw.smeBSBObjectClass, menu); IF (i = 2) THEN EVAL Xt.CreateManagedWidget (TtoS ("menuButton"), Xaw.smeLineObjectClass, menu) END; END; END CreateFormWithButtons; (* Function Name: CreateBox * Description: Creates a box with a label and a scrollbar in it. * Arguments: parent - the parent of the box. * Returns: none. *) PROCEDURE CreateBox (parent: Xt.Widget) = VAR box, scrollbar, label: Xt.Widget; BEGIN box := Xt.CreateManagedWidget (NIL, Xaw.boxWidgetClass, parent); scrollbar := Xt.CreateManagedWidget (TtoS ("scrollbar"), Xaw.scrollbarWidgetClass, box); label := Xt.CreateManagedWidget (TtoS ("scroll_label"), Xaw.labelWidgetClass, box); Xt.AddCallback (scrollbar, XtN.jumpProc, Thumbed, label); Xt.AddCallback (scrollbar, XtN.scrollProc, Scrolled, label); END CreateBox; (* 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"); Cstdlib.exit (1); END Syntax; (* Function Name: TimeSinceTouched * Description: This function returns the number of 10s of seconds since * the user caused an event in this application. * Arguments: widget - the strip chart widget. * closure - unused. * value_ptr - a pointer to the value to return. * Returns: none *) VAR old_value: Ctypes.Double := 0.0D0; old_stamp: X.Time := 1; PROCEDURE TimeSinceTouched (widget: Xt.Widget; <*UNUSED*> closure: ADDRESS; value_ptr: ADDRESS) = VAR new_stamp: X.Time; update: INTEGER; BEGIN new_stamp := Xt.LastTimestampProcessed (Xt.Display (widget)); IF (old_stamp # new_stamp) THEN old_stamp := new_stamp; old_value := 0.0D0 ELSE args[0] := Xt.Arg {XtN.update, ADR (update)}; Xt.GetValues (widget, args, 1); old_value := old_value + (LONGFLOAT (update) / 10.0D0) END; PtoDS (value_ptr) ^ := old_value; END TimeSinceTouched; (* Function Name: Quit * Description: Destroys all widgets, and returns. * Arguments: widget - the widget that called this callback. * closure, calldata - unused. * Returns: none * * NOTE: The shell widget has a destroy callback that sets a five second * timer, and at the end of that time the program exits. *) PROCEDURE Quit (<*UNUSED*> w: Xt.Widget; client_data: ADDRESS; <*UNUSED*> call_data: ADDRESS) = BEGIN Wr.PutText (Stdio.stdout, "Command callback.\n"); Xt.DestroyWidget (client_data); END Quit; (* Function Name: Count * Description: This callback routin will increment that counter * and display the number as the label of the widget passed * in the closure. * Arguments: widget - unused * client_data - a pointer to the label widge to display the * string in. * call_data - unused * Returns: none *) PROCEDURE Count (<*UNUSED*> w: Xt.Widget; client_data: ADDRESS; <*UNUSED*> call_data: ADDRESS) = BEGIN INC (count); args[0] := Xt.Arg {XtN.label, TtoS (" " & Fmt.Int (count) & " ")}; Xt.SetValues (client_data, args, 1) END Count; (* Function Name: Okay * Description: Adds an entry to the List widget passed as clientData. * The name of this entry is the value of the dialog widget. * Arguments: widget - the button that called this callback. * client_data - the list widget to add the entry to. * call_data - unused * Returns: none. * * NOTE: It is assumed that the button is a child of the dialog. *) PROCEDURE Okay (w: Xt.Widget; client_data: ADDRESS; <*UNUSED*> call_data: ADDRESS) = VAR list_widget: Xt.Widget; num_items:= 0; allocated_items:= 0; list:= NEW (Xt.StringList); BEGIN list_widget := client_data; (* ?!?!?!? IF (num_items = allocated_items) THEN allocated_items := allocaed_items + 10; list := (String * ) XtRealloc(list, sizeof(String) * allocated_items); } ?!?!?!? *) (* * The value returned by XawDialogGetValueString() does not remain good * forever so we must store is somewhere. This creates a memory leak * since I don't remember these values, and free them later. I know about * it, but it doesn't seem worth fixing in this example. *) INC (num_items); (* ?!?!?!? list[num_items] := Xt.NewString (Xaw.DialogGetValueString (Xt.Parent (widget))); Xaw.ListChange (list_widget, list, num_items, 0, 1); ?!?!?!? *) END Okay; (* Function Name: Scrolled. * Description: Prints the location of the pointer into the label * widget provided. * Arguments: widget - unused. * label_ptr - a pointer to the label widget. * value_ptr - the amount the bar has been scrolled. * Returns: none *) PROCEDURE Scrolled (<*UNUSED*> w: Xt.Widget; label_ptr: ADDRESS; value_ptr: ADDRESS) = VAR message: Text.T; BEGIN message := "scrolled by " & Fmt.Int (PtoI (value_ptr)) & " pixels.\n"; Wr.PutText (Stdio.stdout, message); args[0] := Xt.Arg {XtN.label,TtoS (message)}; Xt.SetValues (label_ptr, args, 1); END Scrolled; (* Function Name: Thumbed. * Description: Prints the location of the thumb as a percentage of the * height of the scrollbar into the label widget provided. * Arguments: widget - unused. * label_ptr - a pointer to the label widget. * top_ptr - a pointer to a float containing the location of * of the scrollbar's thumb. * Returns: *) PROCEDURE Thumbed (<*UNUSED*> w: Xt.Widget; label_ptr: ADDRESS; top_ptr: ADDRESS) = VAR top : Ctypes.FloatStar; message: Text.T; BEGIN top := PtoFS (top_ptr); message := "thumbed to " & Fmt.Real (top^ * 100.0) & "% "; args[0] := Xt.Arg {XtN.label,TtoS (message)}; Xt.SetValues (label_ptr, args, 1); END Thumbed; (* Function Name: Finish * Description: This is a timeout function that will exit the program. * Arguments: client_data, id - unused. * Returns: exits. *) PROCEDURE Finish (<*UNUSED*> client_data: ADDRESS; <*UNUSED*> id: Xt.IntervalIdStar) = BEGIN (* * I should really destroy the app_context here, but I am lazy, and * getting the app_context a pain. *) Wr.PutText (Stdio.stdout, "Bye!\n"); Cstdlib.exit (0); END Finish; (* Function Name: Destroyed * Description: This is a Destroy callback that when called sets a * timeout function that will exit the program in 5 seconds. * Arguments: w - the widget that was just destroyed. * client_data, call_data - unused. * Returns: none. *) PROCEDURE Destroyed (w: Xt.Widget; <*UNUSED*> client_data: ADDRESS; <*UNUSED*> call_data: ADDRESS) = BEGIN Wr.PutText (Stdio.stdout, "Everything now destroyed; " & "setting 5 second timer.\n"); EVAL Xt.AppAddTimeOut (Xt.WidgetToApplicationContext (w), 5000, Finish, NIL); END Destroyed; VAR fallbacktext := ARRAY OF TEXT { "*input: True", "*Paned.width: 350", "*label.label: At least one of each Athena Widget.", "*Dialog.label: I am a Dialog widget.", "*Dialog.value: Enter new value here.", "*Dialog*command*label: ok", "*Dialog*resizable: True", "*Viewport*allowVert: True", "*Form*formLabel.label: 0", "*Form*resizable: True", "*StripChart*update: 1", "*StripChart*jumpScroll: 1", "*Box*allowResize: True", "*scrollbar*orientation: horizontal", "*scrollbar*length: 100", "*text*height: 75", "*text*string: Look ma,\\na Modula-3 text widget!", "*text*editType: edit", "*text*scrollVertical: whenNeeded", "*text*scrollHorizonal: whenNeeded", "*textFile*type: file", "*textFile*string: /etc/motd", "*textFile*scrollVertical: whenNeeded", "*textFile*scrollHorizonal: whenNeeded", "*textFile*height: 75"}; BEGIN FOR i := 0 TO LAST (fallbacktext) DO fallbacklist[i] := TtoS (fallbacktext[i]) END; fallbacklist[LAST (fallbacktext)+1] := NIL; root := Xt.AppInitialize (app_con, TtoS ("Xwidgets"), NIL, 0, argc, argv, fallbacklist); IF (argc # 1) THEN Syntax (app_con, argv[0]) END; Xt.AddCallback (root, XtN.destroyCallback, Destroyed); outer := Xt.CreateManagedWidget (TtoS ("paned"), Xaw.panedWidgetClass, root); quit := Xt.CreateManagedWidget (TtoS ("quit"), Xaw.commandWidgetClass, outer); Xt.AddCallback (quit, XtN.callback, Quit, root); EVAL Xt.CreateManagedWidget (TtoS ("label"), Xaw.labelWidgetClass, outer); dialog := Xt.CreateManagedWidget (TtoS ("dialog"), Xaw.dialogWidgetClass, outer); viewport := Xt.CreateManagedWidget (TtoS ("viewport"), Xaw.viewportWidgetClass, outer); list := Xt.CreateManagedWidget (TtoS ("list"), Xaw.listWidgetClass, viewport); Xaw.DialogAddButton (dialog, TtoS ("command"), Okay, list); CreateFormWithButtons (outer); box := Xt.CreateManagedWidget (TtoS ("box"), Xaw.boxWidgetClass, outer); EVAL Xt.CreateManagedWidget (NIL, Xaw.clockWidgetClass, box); EVAL Xt.CreateManagedWidget (NIL, Xaw.logoWidgetClass, box); chart := Xt.CreateManagedWidget (TtoS ("stripChart"), Xaw. stripChartWidgetClass, outer); Xt.AddCallback (chart, XtN.getValue, TimeSinceTouched); EVAL Xt.CreateManagedWidget (TtoS ("text"), Xaw.asciiTextWidgetClass, outer); CreateBox (outer); EVAL Xt.CreateManagedWidget (TtoS ("textFile"), Xaw.asciiTextWidgetClass, outer); Xt.RealizeWidget (root); Xt.AppMainLoop (app_con) END xwidgets.