packages feed

language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/tests/testmous.mod

MODULE TestMouse;

	(****************************************************************)
	(*								*)
	(*		    Test of the Mouse module			*)
	(*	Demonstrates simple use of the mouse and event handler	*)
	(*								*)
	(*	Author:		P.D. Terry, Rhodes University,		*)
	(*			 Sun  01-10-1993			*)
	(*	Modified by:	Peter Moylan				*)
	(*			(to run with PMOS and TopSpeed v3)	*)
	(*	Last edited:	16 March 1995				*)
	(*	Status:		Working					*)
	(*								*)
	(*	    Two known but minor bugs:				*)
	(*	     1.	(Fixed)						*)
	(*	     2.	Mouse cursor disappears if you leave it sitting	*)
	(*		at a screen location which is being rewritten.	*)
	(*	    Problem #2 is fixed in this program by surrounding	*)
	(*	    every screen write by "HideMouseCursor" and		*)
	(*	    "ShowMouseCursor" operations; but a general		*)
	(*	    solution would probably require modifications to my	*)
	(*	    Windows module, and I'm reluctant to take such a	*)
	(*	    step because in principle module Windows should not	*)
	(*	    need to know anything about mice.			*)
	(*								*)
	(****************************************************************)

FROM Mouse IMPORT
    (* type *)	Buttons, ButtonSet, Events, EventSet,
    (* proc *)	ResetMouse, InstallEventHandler, GetTextMouseStatus,
		HideMouseCursor, ShowMouseCursor;

	(* Note to users of PMOS version 2.0: in version 2.0 module	*)
	(* TaskControl does not support the Lock datatype.  To resolve	*)
	(* this, either upgrade to version 2.1 or replace every Lock	*)
	(* by a Semaphore.						*)

FROM TaskControl IMPORT
    (* type *)	Lock,
    (* proc *)	CreateTask, CreateLock, Obtain, Release;

FROM Semaphores IMPORT
    (* type *)	Semaphore,
    (* proc *)	CreateSemaphore, Wait, Signal;

FROM SoundEffects IMPORT
    (* proc *)	Beep;

FROM Keyboard IMPORT
    (* proc *)	InKey;

FROM Windows IMPORT
    (* type *)	Window, Colour, FrameType, DividerType,
		RowRange, ColumnRange,
    (* proc *)	OpenWindow, CloseWindow, WriteString, WriteLn,
		ChangeScrollingRegion, SetCursor;

FROM NumericIO IMPORT
    (* proc *)	WriteCard, WriteRJCard;

(************************************************************************)

VAR
    (* HaveMouse is TRUE iff a mouse and mouse driver are present.	  *)
    (* NumberOfButtons is the number of mouse buttons known to the driver.*)

    HaveMouse : BOOLEAN;
    NumberOfButtons: CARDINAL;

    (* The following counters count the events picked up by our handler.*)

    EventCount: ARRAY [LeftDown..MiddleUp] OF CARDINAL;

    (* Our record of the current mouse position and button status. *)

    MouseState:	RECORD
		    access: Lock;
		    Xpos: ColumnRange;
		    Ypos: RowRange;
		    LeftPressed, MiddlePressed, RightPressed: BOOLEAN;
		END (*RECORD*);

    (* Semaphore to signal the fact that a mouse event has happened.	*)

    MouseEvent: Semaphore;

(************************************************************************)

PROCEDURE DisplayPosition;

    (* Runs as a separate task. *)

    VAR X, Y: CARDINAL;  Left, Middle, Right: BOOLEAN;
	w1, w2: Window;
	DownUp: ARRAY BOOLEAN OF ARRAY [0..3] OF CHAR;

    BEGIN
	DownUp[FALSE] := "UP  ";
	DownUp[TRUE] := "DOWN";

	(* Create a window to display the mouse position. *)

	OpenWindow (w1,black,green,2,6,60,79,simpleframe,doubledivider);
	WriteString (w1, "  Mouse position");
	ChangeScrollingRegion (w1, 3, 3);
	SetCursor (w1, 3, 7);  WriteString (w1, ",");

	(* Create a window to display the button state. *)

	OpenWindow (w2,black,green,8,14,60,79,simpleframe,doubledivider);
	WriteString (w2, "     Buttons");
	ChangeScrollingRegion (w2, 3, 7);
	WriteString (w2, "Left");  WriteLn (w2);
	WriteString (w2, "Middle");  WriteLn (w2);
	WriteString (w2, "Right");  WriteLn (w2);

	LOOP	(* forever *)
	    ShowMouseCursor;
	    Wait (MouseEvent);

	    (* Pick up the mouse state. *)

	    WITH MouseState DO
		Obtain (access);
		X := Xpos;  Y := Ypos;
		Left := LeftPressed;  Middle := MiddlePressed;
		Right := RightPressed;
		Release (access);
	    END (*WITH*);

	    (* Turn off mouse cursor while writing to the screen. *)

	    HideMouseCursor;

	    (* Display mouse position. *)

	    SetCursor (w1, 3, 3);  WriteRJCard (w1, X, 4);
	    SetCursor (w1, 3, 9);  WriteRJCard (w1, Y, 4);

	    (* Display button status. *)

	    SetCursor (w2, 3, 9);  WriteString (w2, DownUp[Left]);
	    IF NumberOfButtons > 1 THEN
		SetCursor (w2, 5, 9);  WriteString (w2, DownUp[Right]);
	    END (*IF*);
	    IF NumberOfButtons > 2 THEN
		SetCursor (w2, 4, 9);  WriteString (w2, DownUp[Middle]);
	    END (*IF*);
	END (*LOOP*);

    END DisplayPosition;

(************************************************************************)

(*# save, call(c_conv => off, same_ds => off, near_call => off) *)
(*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)

PROCEDURE Handler (A: EventSet;  B: ButtonSet;  X, Y : CARDINAL);

    (*   +++++ Don't attempt any DOS calls inside one of these ++++++	*)
    (* This procedure is called by the mouse driver whenever there is	*)
    (* a mouse event, and that event is in the event set specified at	*)
    (* the time this handler was activated.				*)

    VAR j: Events;

    BEGIN
	FOR j := LeftDown TO MiddleUp DO
	    IF j IN A THEN
		INC (EventCount[j]);
	    END (*IF*);
	END (*FOR*);

	WITH MouseState DO
	    Obtain (access);
	    Xpos := X DIV 8;  Ypos := Y DIV 8;
	    LeftPressed := LeftButton IN B;
	    MiddlePressed := MiddleButton IN B;
	    RightPressed := RightButton IN B;
	    Release (access);
	END (*WITH*);
	Signal (MouseEvent);

    END Handler;

(*# restore *)

(************************************************************************)

PROCEDURE RunTheTest;

    (* Starts event handler, starts DisplayPosition task, and lets them	*)
    (* run until the user hits a keyboard key.  Before exiting, writes	*)
    (* a summary of the mouse events.					*)

    CONST DetectedEvents = EventSet {LeftDown, LeftUp, MiddleDown, MiddleUp,
						RightDown, RightUp, Motion};

    VAR w: Window;  ch: CHAR;  B: ButtonSet;

    BEGIN
	WITH MouseState DO
	    CreateLock (access);
	    GetTextMouseStatus (B, Xpos, Ypos);
	    LeftPressed := LeftButton IN B;
	    MiddlePressed := MiddleButton IN B;
	    RightPressed := RightButton IN B;
	END (*WITH*);
	Signal (MouseEvent);
	HideMouseCursor;
	OpenWindow (w, blue, cyan, 2, 14, 0, 55, simpleframe, nodivider);
	WriteString(w, 'Mouse detected with ');
	WriteCard(w, NumberOfButtons); WriteString(w, ' buttons.');
	WriteLn (w);
	WriteString(w, 'Move mouse, press buttons, hit any key to finish.');
	WriteLn (w);
	ShowMouseCursor;

	InstallEventHandler (DetectedEvents, Handler);

	CreateTask (DisplayPosition, 4, "Position dis");

	(* From now on, all the work is done by Handler and the task	*)
	(* called Handler.  We stop when the user hits the keyboard.	*)

	ch := InKey();

	(* Write a summary to the screen. *)

	HideMouseCursor;
	WriteLn(w);
	WriteCard(w, EventCount[LeftDown]);
	WriteString(w, ' left presses, ');
	WriteCard (w, EventCount[LeftUp]);
	WriteString(w, ' left releases');
	WriteLn (w);
	WriteCard (w, EventCount[MiddleDown]);
	WriteString (w, ' middle presses, ');
	WriteCard (w, EventCount[MiddleUp]);
	WriteString (w, ' middle releases');
	WriteLn (w);
	WriteCard (w, EventCount[RightDown]);
	WriteString (w, ' right presses, ');
	WriteCard (w, EventCount[RightUp]);
	WriteString (w, ' right releases.');
	WriteLn (w);
	WriteLn (w);  WriteString (w, 'Hit any key to finish.');
	ShowMouseCursor;
	ch := InKey();
	CloseWindow (w);

    END RunTheTest;

(************************************************************************)
(*				MAIN PROGRAM				*)
(************************************************************************)

VAR j: Events;

BEGIN
    FOR j := LeftDown TO MiddleUp DO
	EventCount[j] := 0;
    END (*FOR*);

    CreateSemaphore (MouseEvent, 0);
    ResetMouse (HaveMouse, NumberOfButtons);

    IF HaveMouse THEN
	ShowMouseCursor;  RunTheTest;
    ELSE
	Beep;  Beep;  Beep;
    END (*IF*);

END TestMouse.