language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/serialmo.mod
IMPLEMENTATION MODULE SerialMouse;
(********************************************************)
(* *)
(* Serial mouse driver *)
(* *)
(* This module provides support for a mouse on *)
(* COM1 or COM2. Note that this is not the *)
(* only mouse driver in PMOS. The PP preprocessor *)
(* chooses which driver to use based on the *)
(* settings in file PP.CFG *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 16 March 1995 *)
(* Status: OK *)
(* *)
(* Note: this file contains preprocessor *)
(* directives; use PP to update it. *)
(* *)
(********************************************************)
FROM Types IMPORT
(* type *) FarBytePointer;
FROM Mouse0 IMPORT
(* type *) Buttons, Events;
FROM LowLevel IMPORT
(* proc *) IANDB, IORB, RSB, LSB, ROLB, OutByte,
MakePointer, FarAddOffset, FarSubtractOffset;
FROM TaskControl IMPORT
(* type *) Lock,
(* proc *) CreateTask, CreateLock, Obtain, Release;
FROM SerialIO IMPORT
(* type *) Parity,
(* proc *) InitSerialChannel, MouseReset, ReadSerial;
FROM TextVideo IMPORT
(* proc *) VideoKind;
(************************************************************************)
(* DUMMY EVENT HANDLER *)
(************************************************************************)
(*<TopSpeed3*)
(*# save, call(c_conv => off, same_ds => off, near_call => off) *)
(*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3)) *)
(*>*)
PROCEDURE DummyEventHandler (A: EventSet; B: ButtonSet; X, Y : CARDINAL);
(* Does nothing - this is here purely because the compiler doesn't *)
(* recognise NULLPROC as being type-compatible with an event *)
(* handler compiled when the call pragma c_conv is set. *)
BEGIN
END DummyEventHandler;
(*<TopSpeed3*) (*# restore *) (*>*)
(************************************************************************)
(* GLOBAL DATA *)
(************************************************************************)
TYPE
MouseType = (NoMouse, MS, Logitech, PC);
CONST
(*<MouseChannel=COM1*) MouseChannel = 1; (*>*)
(*<MouseChannel=COM2 MouseChannel = 2; >*)
(*<MouseKind=Logitech MouseKind = Logitech; >*)
(*<MouseKind=MS MouseKind = MS; >*)
(*<MouseKind=PC MouseKind = PC; >*)
(*<(MouseKind<>Logitech)&(MouseKind<>MS)&(MouseKind<>PC)*)
MouseKind = NoMouse;
(*>*)
TYPE
Parser = PROCEDURE (VAR ButtonSet, VAR SHORTINT, VAR SHORTINT);
SignedByte = RECORD
CASE :BOOLEAN OF
FALSE: b: BYTE;
| TRUE: i: SHORTINT;
END (*CASE*);
END (*RECORD*);
CONST
pageincr = 4096;
rowincr = 160;
VAR
(* Segment of the memory-mapped display, and whether it is monochrome. *)
ScreenSeg: CARDINAL;
BlackAndWhite: BOOLEAN;
(* Flag to indicate that a mouse is present. *)
MousePresent: BOOLEAN;
(* Number of buttons on the mouse. *)
NumberOfButtons: CARDINAL;
(* The procedure to be called to decode the mouse data. We give *)
(* this a value during module initialisation. *)
ParseMouseInput: Parser;
(* A decoding array to help in translating mouse data to button *)
(* values. We set up the values during module initialisation. *)
ButtonMap: ARRAY SHORTCARD[0..7] OF ButtonSet;
(* Flag to say that we expect four bytes (rather than the normal *)
(* three) of mouse data. *)
ExpectingFourBytes: BOOLEAN;
(* The current state of the mouse, updated by the interpreter task. *)
MouseState: RECORD
access: Lock;
ButtonsDown: ButtonSet;
X, Y: CARDINAL;
END (*RECORD*);
(* The rectangle defining the boundaries of mouse movement. *)
Limits: RECORD
access: Lock;
left, right, top, bottom: CARDINAL;
END (*RECORD*);
(* Mappings for translating button states to events. These *)
(* values are filled in during module initialisation. *)
Map1, Map2: ARRAY Buttons OF Events;
(* The caller-specified event handler. *)
UserHandler: RECORD
access: Lock;
trigger: EventSet;
HandlerProc: EventHandler;
END (*RECORD*);
(* Details about the screen cursor. *)
Cursor: RECORD
access: Lock;
mousepage, row, col: CARDINAL;
ScreenPos: FarBytePointer;
ValueUnder: BYTE;
END (*RECORD*);
(* The screen cursor is visible iff Visibility > 0. *)
Visibility: INTEGER;
(* A tuning parameter which controls the point at which cursor *)
(* movement is sped up. *)
Threshold: INTEGER;
(************************************************************************)
(* MANIPULATING THE MOUSE CURSOR ON THE SCREEN *)
(************************************************************************)
PROCEDURE TurnCursorOff;
(* Turns the screen cursor off, assuming it was on. *)
BEGIN
WITH Cursor DO
Obtain (access);
IF BYTE(ScreenPos^) = ROLB(ValueUnder,4) THEN
ScreenPos^ := ValueUnder;
END (*IF*);
Release (access);
END (*WITH*);
END TurnCursorOff;
(************************************************************************)
PROCEDURE TurnCursorOn;
(* Turns the screen cursor on, assuming it was off. *)
BEGIN
WITH Cursor DO
Obtain (access);
ValueUnder := ScreenPos^;
ScreenPos^ := ROLB(ValueUnder,4);
Release (access);
END (*WITH*);
END TurnCursorOn;
(************************************************************************)
PROCEDURE MoveCursor (r, c: INTEGER);
(* Moves the cursor to screen row r and column c. *)
VAR change: INTEGER;
BEGIN
IF Visibility > 0 THEN TurnCursorOff END(*IF*);
WITH Cursor DO
Obtain (access);
change := rowincr*(r-INTEGER(row)) + 2*(c-INTEGER(col));
IF change >= 0 THEN
ScreenPos := FarAddOffset (ScreenPos, change);
ELSE
ScreenPos := FarSubtractOffset (ScreenPos, -change);
END (*IF*);
row := r; col := c;
Release (access);
END (*WITH*);
IF Visibility > 0 THEN TurnCursorOn END(*IF*);
END MoveCursor;
(************************************************************************)
(* INPUT PARSERS FOR SPECIFIC MOUSE TYPES *)
(************************************************************************)
PROCEDURE GetCode(): BYTE;
(* Reads one byte from the mouse port. *)
VAR value: BYTE;
BEGIN
ReadSerial (MouseChannel, value);
RETURN value;
END GetCode;
(************************************************************************)
PROCEDURE ParseLogitechInput (VAR (*OUT*) buttons: ButtonSet;
VAR (*OUT*) Xmove, Ymove: SHORTINT);
(* Reads a single "unit" of information from the mouse port, and *)
(* translates this into a button state and two motion values. *)
(* For the Logitech mouse I don't know the exact rules, but they *)
(* are roughly as shown in the following code. *)
(* THIS PROCEDURE IS WORKING, BUT IT'S NOT CLEAR WHETHER IT'S DONE. *)
(* I can't work out whether the coding I'm assuming is "true" *)
(* Logitech, or just the MS mode of a Logitech mouse. *)
VAR code: BYTE; v3: SignedByte;
BEGIN
code := GetCode();
(* It's possible that at this stage we have just picked up the *)
(* fourth byte of a four-byte sequence. *)
IF code = BYTE(20H) THEN
WITH MouseState DO
Obtain (access);
buttons := ButtonsDown + ButtonSet{MiddleButton};
Release (access);
END (*WITH*);
ExpectingFourBytes := TRUE;
Xmove := 0; Ymove := 0;
RETURN;
END (*IF*);
(* The first 7-bit number picked up should have its high-order *)
(* bit set, but we have to allow for resynchronisation after an *)
(* error in the input. *)
WHILE ORD(IANDB (code, 040H)) = 0 DO
code := GetCode();
END (*WHILE*);
(* The code just picked up has bit 6 set, and bits 5 and 4 as *)
(* indicators for the left and right buttons. Bits 3-0 are *)
(* the high-order bits of the motion values. *)
buttons := ButtonMap[RSB(IANDB(code,30H),4)];
(* The next two input codes are 6-bit numbers, to which we must *)
(* prepend some of the bits from the first byte. *)
v3.b := IORB(GetCode(), LSB(code,6));
Xmove := v3.i;
v3.b := IORB(GetCode(), LSB(IANDB(code, 0CH),4));
Ymove := v3.i;
(* The fourth byte, if present, is 20H for middle button down, *)
(* and 00 for a middle button release. *)
IF ExpectingFourBytes THEN
IF GetCode() = BYTE(20H) THEN
INCL (buttons, MiddleButton);
ELSE
ExpectingFourBytes := FALSE;
END (*IF*);
END (*IF*);
END ParseLogitechInput;
(************************************************************************)
PROCEDURE ParseMSInput (VAR (*OUT*) buttons: ButtonSet;
VAR (*OUT*) Xmove, Ymove: SHORTINT);
(* Reads a single "unit" of information from the mouse port, and *)
(* translates this into a button state and two motion values. *)
(* For a Microsoft mouse a "unit" is three 7-bit codes, where the *)
(* first code has its high-order bit set. *)
VAR code: BYTE; v3: SignedByte;
BEGIN
(* The first 7-bit number picked up should have its high-order *)
(* bit set, but we have to allow for resynchronisation after an *)
(* error in the input. *)
REPEAT
code := GetCode();
UNTIL ORD(IANDB (code, 040H)) <> 0;
(* The code just picked up has bit 6 set, and bits 5 and 4 as *)
(* indicators for the left and right buttons. (The middle *)
(* button doesn't seem to be detected, so I guess the Microsoft *)
(* encoding doesn't allow for three-button mice.) Bits 3-0 are *)
(* the high-order bits of the motion values. *)
buttons := ButtonMap[RSB(IANDB(code,30H),4)];
(* The next two input codes are 6-bit numbers, to which we must *)
(* prepend some of the bits from the first byte. *)
v3.b := IORB(GetCode(), LSB(code,6));
Xmove := v3.i;
v3.b := IORB(GetCode(), LSB(IANDB(code, 0CH),4));
Ymove := v3.i;
END ParseMSInput;
(************************************************************************)
PROCEDURE ParsePCInput (VAR (*OUT*) buttons: ButtonSet;
VAR (*OUT*) Xmove, Ymove: SHORTINT);
(* Reads a single "unit" of information from the mouse port, and *)
(* translates this into a button state and two motion values. *)
(* For the PC mouse a "unit" is five bytes long, with the first *)
(* byte having the binary form 10000xxx. *)
VAR value: SignedByte;
BEGIN
REPEAT
value.b := GetCode();
UNTIL IANDB (value.b, 0F8H) = BYTE(80H);
buttons := ButtonMap[IANDB(value.b,7)];
value.b := GetCode();
Xmove := value.i;
value.b := GetCode();
Ymove := -value.i;
(* In this version we ignore the last two bytes. (I don't know *)
(* what they indicate.) *)
value.b := GetCode();
value.b := GetCode();
END ParsePCInput;
(************************************************************************)
(* THE INTERPRETER TASK *)
(************************************************************************)
PROCEDURE ButtonEvents (oldbuttons, newbuttons: ButtonSet): EventSet;
(* Calculates the events corresponding to a change in button state *)
(* from "oldbuttons" to "newbuttons". *)
VAR B: Buttons; result: EventSet;
BEGIN
result := EventSet {};
FOR B := LeftButton TO MiddleButton DO
IF B IN newbuttons-oldbuttons THEN
INCL (result, Map1[B]);
ELSIF B IN oldbuttons-newbuttons THEN
INCL (result, Map2[B]);
END (*IF*);
END (*FOR*);
RETURN result;
END ButtonEvents;
(************************************************************************)
PROCEDURE MouseInterpreter;
(* Runs as a separate task, picking up signals from the mouse and *)
(* updating the state appropriately. *)
VAR buttons, oldbuttons: ButtonSet; events, enabled: EventSet;
Xmove, Ymove, temp: INTEGER;
shortXmove, shortYmove: SHORTINT;
oldX, newX, oldY, newY: INTEGER;
Handler: EventHandler;
BEGIN
LOOP
(* Obtain the next mouse input string. *)
ParseMouseInput (buttons, shortXmove, shortYmove);
Xmove := VAL(INTEGER, shortXmove);
Ymove := VAL(INTEGER, shortYmove);
(* It's convenient for the user if we amplify the magnitude *)
(* of fast mouse movements. *)
IF ABS(Xmove) > Threshold THEN
Xmove := 3*Xmove;
END (*IF*);
IF ABS(Ymove) > Threshold THEN
Ymove := 2*Ymove;
END (*IF*);
(* Update the mouse state. *)
WITH MouseState DO
Obtain (access);
oldbuttons := ButtonsDown;
ButtonsDown := buttons;
oldX := X; oldY := Y;
WITH Limits DO
Obtain (access);
temp := oldX + Xmove;
IF temp < VAL(INTEGER,left) THEN newX := left
ELSIF temp > VAL(INTEGER,right) THEN newX := right
ELSE newX := temp
END (*IF*);
temp := oldY + Ymove;
IF temp < VAL(INTEGER,top) THEN newY := top
ELSIF temp > VAL(INTEGER,bottom) THEN newY := bottom
ELSE newY := temp
END (*IF*);
Release (access);
END (*WITH*);
X := newX; Y := newY;
Release (access);
END (*WITH*);
(* Turn the (oldbuttons,buttons) combination into an *)
(* "EventSet" value, and move the physical cursor if *)
(* necessary. *)
events := ButtonEvents (oldbuttons, buttons);
IF (newX DIV 8 <> oldX DIV 8) OR (newY DIV 8 <> oldY DIV 8) THEN
INCL (events, Motion);
MoveCursor (newY DIV 8, newX DIV 8);
END (*IF*);
(* Call the event handler if appropriate. *)
WITH UserHandler DO
Obtain (access);
Handler := HandlerProc;
enabled := trigger;
Release (access);
END (*WITH*);
IF (enabled*events <> EventSet{})
AND (Handler <> DummyEventHandler) THEN
Handler (events, buttons, newX, newY);
END (*IF*);
END (*LOOP*);
END MouseInterpreter;
(************************************************************************)
(* THE EXTERNALLY CALLABLE PROCEDURES *)
(************************************************************************)
PROCEDURE Reset (VAR (*OUT*) MousePresent: BOOLEAN;
VAR (*OUT*) NumberOfButtons: CARDINAL);
(* Initializes mouse, returning MousePresent as FALSE if no mouse *)
(* available and as TRUE if it is, and NumberOfButtons as the *)
(* number of buttons for the mouse if installed. *)
BEGIN
NumberOfButtons := 3;
IF MouseKind = Logitech THEN
InitSerialChannel (MouseChannel, 1200, 7, NoParity, 1);
ELSIF MouseKind = MS THEN
InitSerialChannel (MouseChannel, 1200, 7, Always1, 1);
NumberOfButtons := 2;
(* The following reset operation should have no effect on a *)
(* Microsoft mouse, but should force a Logitech mouse to *)
(* enter Microsoft compatibility mode. *)
(* MouseReset (MouseChannel); *)
(* THIS CODE IS NOT WORKING, IT LOOKS AS IF THE INFORMATION *)
(* I'VE RECEIVED IS WRONG. *)
ELSIF MouseKind = PC THEN
InitSerialChannel (MouseChannel, 1200, 8, NoParity, 1);
END (*IF*);
MousePresent := TRUE;
Visibility := 0;
SetCursorPos (320, 100);
END Reset;
(************************************************************************)
PROCEDURE SetCursorPos (X, Y : CARDINAL);
(* Initialises the mouse position. *)
BEGIN
Obtain (MouseState.access);
MouseState.X := X; MouseState.Y := Y;
Release (MouseState.access);
IF Visibility > 0 THEN TurnCursorOff END(*IF*);
WITH Cursor DO
Obtain (access);
row := Y DIV 8; col := X DIV 8;
ScreenPos := MakePointer (ScreenSeg,
pageincr*mousepage + rowincr*row + 2*col + 1);
Release (access);
END (*WITH*);
IF Visibility > 0 THEN TurnCursorOn END(*IF*);
END SetCursorPos;
(************************************************************************)
PROCEDURE ShowCursor;
(* Makes the mouse cursor visible on the screen. *)
BEGIN
IF Visibility = 0 THEN TurnCursorOn END(*IF*);
INC (Visibility);
END ShowCursor;
(************************************************************************)
PROCEDURE HideCursor;
(* Makes the mouse cursor invisible. *)
BEGIN
DEC (Visibility);
IF Visibility = 0 THEN TurnCursorOff END(*IF*);
END HideCursor;
(************************************************************************)
PROCEDURE SetPage (page: CARDINAL);
(* Sets the hardware screen page where the mouse is visible. *)
VAR change: INTEGER;
BEGIN
IF Visibility > 0 THEN TurnCursorOff END(*IF*);
WITH Cursor DO
Obtain (access);
IF page > mousepage THEN
ScreenPos := FarAddOffset (ScreenPos, pageincr*(page-mousepage));
ELSE
ScreenPos := FarSubtractOffset(ScreenPos,
pageincr*(mousepage-page));
END (*IF*);
mousepage := page;
Release (access);
END (*WITH*);
IF Visibility > 0 THEN TurnCursorOn END(*IF*);
END SetPage;
(************************************************************************)
PROCEDURE SetHorizontalLimits (MinX, MaxX : CARDINAL);
(* Sets the horizontal cursor limits. *)
BEGIN
WITH Limits DO
Obtain (access);
left := MinX; right := MaxX;
Release (access);
END (*WITH*);
END SetHorizontalLimits;
(************************************************************************)
PROCEDURE SetVerticalLimits (MinY, MaxY : CARDINAL);
(* Sets the vertical cursor limits. *)
BEGIN
WITH Limits DO
Obtain (access);
top := MinY; bottom := MaxY;
Release (access);
END (*WITH*);
END SetVerticalLimits;
(************************************************************************)
PROCEDURE GetPosBut (VAR (*OUT*) buttons: ButtonSet;
VAR (*OUT*) Xposition, Yposition: CARDINAL);
(* Returns the current mouse position and the state of the buttons. *)
(* Note: the units here are not the same as for procedure *)
(* GetTextMousePosition. In both this procedure and in the event *)
(* handlers the position is presented in units of 1/8th of a *)
(* character width or height. *)
BEGIN
WITH MouseState DO
Obtain (access);
buttons := ButtonsDown;
Xposition := X; Yposition := Y;
Release (access);
END (*WITH*);
END GetPosBut;
(************************************************************************)
PROCEDURE SetEventHandler (DetectedEvents: EventSet;
Handler: EventHandler);
(* Nominates the procedure to be called whenever an event in the *)
(* set DetectedEvents occurs. *)
BEGIN
WITH UserHandler DO
Obtain (access);
HandlerProc := Handler;
trigger := DetectedEvents;
Release (access);
END (*WITH*);
END SetEventHandler;
(************************************************************************)
(* MODULE INITIALISATION *)
(************************************************************************)
PROCEDURE SetUpMappings;
(* Initializes some of the global variables. *)
BEGIN
IF MouseKind = Logitech THEN
ParseMouseInput := ParseLogitechInput;
Threshold := 20;
ButtonMap[0] := ButtonSet {};
ButtonMap[1] := ButtonSet {RightButton};
ButtonMap[2] := ButtonSet {LeftButton};
ButtonMap[3] := ButtonSet {LeftButton, RightButton};
ELSIF MouseKind = MS THEN
ParseMouseInput := ParseMSInput;
NumberOfButtons := 2;
Threshold := 10;
ButtonMap[0] := ButtonSet {};
ButtonMap[1] := ButtonSet {RightButton};
ButtonMap[2] := ButtonSet {LeftButton};
ButtonMap[3] := ButtonSet {LeftButton, RightButton};
ELSIF MouseKind = PC THEN
ParseMouseInput := ParsePCInput;
Threshold := 2;
ButtonMap[0] := ButtonSet {LeftButton,MiddleButton,RightButton};
ButtonMap[1] := ButtonSet {LeftButton, MiddleButton};
ButtonMap[2] := ButtonSet {LeftButton, RightButton};
ButtonMap[3] := ButtonSet {LeftButton};
ButtonMap[4] := ButtonSet {MiddleButton, RightButton};
ButtonMap[5] := ButtonSet {MiddleButton};
ButtonMap[6] := ButtonSet {RightButton};
ButtonMap[7] := ButtonSet {};
END (*IF*);
Map1[LeftButton] := LeftDown;
Map1[RightButton] := RightDown;
Map1[MiddleButton] := MiddleDown;
Map2[LeftButton] := LeftUp;
Map2[RightButton] := RightUp;
Map2[MiddleButton] := MiddleUp;
END SetUpMappings;
(************************************************************************)
PROCEDURE InitialiseMouseDriver(): BOOLEAN;
(* Does all initialisation needed for this module. We make this a *)
(* procedure rather than an initialisation section because module *)
(* Mouse has to decide which mouse driver to use. The function *)
(* result indicates success; if it is FALSE, none of the following *)
(* procedures will work. Note: this is not an end-user procedure, *)
(* it's intended to be called only by module Mouse. *)
BEGIN
VideoKind (ScreenSeg, BlackAndWhite);
ExpectingFourBytes := FALSE;
WITH Limits DO
CreateLock (access);
left := 0; right := 639;
top := 0; bottom := 199;
END (*WITH*);
WITH MouseState DO
CreateLock (access);
ButtonsDown := ButtonSet{};
X := 320; Y := 100;
END (*WITH*);
Visibility := 0;
WITH Cursor DO
CreateLock (access);
mousepage := 0; row := 12; col := 40;
ScreenPos := MakePointer (ScreenSeg, rowincr*row + 2*col + 1);
ValueUnder := ScreenPos^;
END (*WITH*);
SetUpMappings;
WITH UserHandler DO
CreateLock (access);
HandlerProc := DummyEventHandler;
trigger := EventSet{};
END (*WITH*);
CreateTask (MouseInterpreter, 9, "Mouse Interprete");
RETURN TRUE;
END InitialiseMouseDriver;
(************************************************************************)
END SerialMouse.