(* Copyright (C) 1989, 1990 Digital Equipment Corporation	*)
(* All rights reserved.						*)
(* See the file COPYRIGHT for a full description.		*)

(* File: xscroll.i3						*)
(* Last modified on Tue Apr 24 17:06:37 1990 by jerome		*)
(*      modified on Thu Apr 12 00:13:15 1990 by muller		*)


(*==============================================================*)
(*	The X11 R4 Interface for Modula 3			*)
(*								*)
(*	The Athena Widgets Set Example (re)coded in Modula3	*)
(*==============================================================*)


(*
 * xscroll
 *
 * This an example of how to use the Scrollbar widget.
 *
 * This example also shows how to set a float resource in an argument list.
 *
 * User events handled through callback routines.
 *
 * November 14, 1989 - Chris D. Peterson 
 *)

(*
 * $XConsortium: xscroll.c,v 1.12 89/12/15 19:37:24 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 xscroll EXPORTS Main;

FROM   M3toC   IMPORT	TtoS, StoT, PtoI, ItoP, RtoP, PtoFS, argc, argv;
FROM   Ctypes  IMPORT   FloatStar;

IMPORT Fmt, Stdio, Wr, Cstdlib, Xrm, Xt, XtN, 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) & " [-horiz]\n");
    Cstdlib.exit (1);
END Syntax;


(*	Function Name: Jumped
 *	Description: This function prints a message to stdout.
 *	Arguments: w - ** UNUSED **
 *                 client_data - ** UNUSED **
 *                 call_data - a pointer to a float containing 
 *                               the location selected.
 *	Returns: none
 *)

PROCEDURE Jumped (<*UNUSED*> w: Xt.Widget; 
                  <*UNUSED*> client_data: ADDRESS;
                  call_data: ADDRESS) =
VAR
    top : FloatStar;
BEGIN
    top := PtoFS (call_data); (* LOOPHOLE Address -> FloatStar *)
    Wr.PutText (Stdio.stdout, "thumbed at " &
                              Fmt.Real (top^ * 100.0) &
                              "% the height of the scrollbar\n")
END Jumped;


(*	Function Name: Scrolled
 *	Description: This function prints a message to stdout.
 *	Arguments: w - ** UNUSED **
 *                 client_data - ** UNUSED **
 *                 call_data - the number of pixels scrolled.
 *	Returns: none
 *)

PROCEDURE Scrolled (<*UNUSED*> w: Xt.Widget; 
                    <*UNUSED*> client_data: ADDRESS;
                    call_data: ADDRESS) =
BEGIN
    Wr.PutText (Stdio.stdout, "scrolled by " & 
                              Fmt.Int (PtoI (call_data)) &
                              " pixels.\n")
END Scrolled;



VAR
    args       := NEW (Xt.ArgList);
    options    := NEW (Xrm.OptionDescList);
    app_con:           Xt.AppContext;
    root:              Xt.Widget;
    scrollbar:         Xt.Widget;


BEGIN

    options[0] := Xrm.OptionDescRec{ TtoS ("-horiz"),
				     TtoS ("*scrollbar.orientation"), 
				     Xrm.optionNoArg,
				     TtoS ("horizontal")};

    root := Xt.AppInitialize (app_con, TtoS ("Xscroll"), options, 1, 
                              argc, argv);

    IF (argc # 1) THEN Syntax (app_con, argv[0]) END;

    (*
     * Setting an argument list.
     *)

    (* Pass a floating point resource value. *)

    args[0] := Xt.Arg {XtN.topOfThumb, RtoP (0.5)};

    (* Pass an integer resource value. *)

    args[1] := Xt.Arg {XtN.length, ItoP(200)};

    scrollbar := Xt.CreateManagedWidget (TtoS ("scrollbar"), 
                                         Xaw.scrollbarWidgetClass, root,
				         args, 2);

    (*
     * Add a callback routine to the Scrollbar widget that will inform
     * us when the scrollbar has jumped, or scrolled.
     *)

    Xt.AddCallback (scrollbar, XtN.jumpProc, Jumped);
    Xt.AddCallback (scrollbar, XtN.scrollProc, Scrolled);

    Xt.RealizeWidget (root);
    Xt.AppMainLoop (app_con);

END xscroll.