<<>>
    <<FastTRAPDeviceImpl.mesa>>
        <<Copyright Ó 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Bier, November 6, 1991 10:43 am PST>>
        <<Contents:  Routines for creating instances of the FastTRAP trackball and representing the state of such a device.>>
        <<>>
    DIRECTORY
        DeviceClassTypes, DeviceTypes, FastTRAPDevice, Rope;

    FastTRAPDeviceImpl: CEDAR PROGRAM
        IMPORTS
        EXPORTS FastTRAPDevice, DeviceTypes = BEGIN

    Device: TYPE = DeviceTypes.Device;
    DeviceObj: TYPE = DeviceTypes.DeviceObj;
    DeviceClass: PUBLIC TYPE = DeviceClassTypes.DeviceClass;
    DeviceClassObj: PUBLIC TYPE = DeviceClassTypes.DeviceClassObj;
    DeviceState: TYPE = DeviceTypes.DeviceState;
    DeviceStateObj: TYPE = DeviceTypes.DeviceStateObj;
    DeviceStateChange: TYPE = DeviceTypes.DeviceStateChange;
    DeviceStateChangeObj: TYPE = DeviceTypes.DeviceStateChangeObj;
    KeyName: TYPE = FastTRAPDevice.KeyName;
    ROPE: TYPE = Rope.ROPE;

    FastTRAPData: TYPE = REF FastTRAPDataObj;
    FastTRAPDataObj: TYPE = RECORD [
        name: ROPE
        ];

    FastTRAPState: TYPE = REF FastTRAPStateObj;
    FastTRAPStateObj: TYPE = RECORD [
        wheel: INTEGER,
        x, y: INTEGER, -- trackball coordinates
        buttonDown: ARRAY KeyName OF BOOL
        ];

    fastTRAPClass: DeviceClass Ź NEW[DeviceClassObj Ź [$FastTRAP, GetFastTRAPState]];

    <<Class Routines>>
    GetFastTRAPState: DeviceClassTypes.GetDeviceStateProc = {
        <<PROC [device: Device] RETURNS [state: DeviceState];>>
        state Ź AllocateState[device];
        };

    CreateFastTRAP: PUBLIC PROC [name: Rope.ROPE] RETURNS [device: Device] = {
        <<Create a data structure representing a particular physical FastTRAP.  Calls class.create[class].>>
        data: FastTRAPData Ź NEW[FastTRAPDataObj Ź [name: name]];
        device Ź NEW[DeviceObj];
        device.class Ź fastTRAPClass;
        device.data Ź data;
        device.name Ź name;
        };

    AllocateState: PUBLIC PROC [device: Device] RETURNS [deviceState: DeviceState] = {
        <<Allocates storage representing the state of this keyboard when all of its keys are up, the trackball is at 0,0, and the 
        thumbwheel is at 0.  Each DeviceState is immutable, so they may be freely stored in long-term storage.>>
        state: FastTRAPState Ź NEW[FastTRAPStateObj Ź [wheel: 0, x: 0, y: 0, buttonDown: [FALSE, FALSE, FALSE]]];
        deviceState Ź NEW[DeviceStateObj];
        deviceState.class Ź device.class;
        deviceState.state Ź state;
        };
        <<>>
    CopyState: PROC [deviceState: DeviceState] RETURNS [copy: DeviceState] = {
        old: FastTRAPState Ź NARROW[deviceState.state];
        state: FastTRAPState Ź NEW[FastTRAPStateObj Ź [wheel: old.wheel, x: old.x, y: old.y, buttonDown: old.buttonDown]];
        copy Ź NEW[DeviceStateObj];
        copy.class Ź deviceState.class;
        copy.state Ź state;
        };

    <<Representing FastTRAP State Changes>>

    buttonDownChange: ARRAY KeyName OF ARRAY BOOL OF DeviceStateChange;
    trackballChange: ARRAY [-4..4] OF ARRAY [-4..4] OF DeviceStateChange;
    wheelChange: ARRAY [-4..4] OF DeviceStateChange;

    Init: PROC = {
        buttonDownChange[left][FALSE] Ź KeyChangeCreate[left, FALSE];
        buttonDownChange[left][TRUE] Ź KeyChangeCreate[left, TRUE];
        buttonDownChange[middle][FALSE] Ź KeyChangeCreate[middle, FALSE];
        buttonDownChange[middle][TRUE] Ź KeyChangeCreate[middle, TRUE];
        buttonDownChange[right][FALSE] Ź KeyChangeCreate[right, FALSE];
        buttonDownChange[right][TRUE] Ź KeyChangeCreate[right, TRUE];
        FOR i: INT IN [-4..4] DO
            FOR j: INT IN [-4..4] DO
                trackballChange[i][j] Ź TrackballChangeCreate[i, j];
                ENDLOOP;
            wheelChange[i] Ź WheelChangeCreate[i];
            ENDLOOP;
        };

    KeyChange: PUBLIC PROC [key: KeyName, down: BOOL] RETURNS [change: DeviceStateChange] = {
        change Ź buttonDownChange[key][down];
        };

    TrackballChange: PUBLIC PROC [deltaX, deltaY: INTEGER] RETURNS [change: DeviceStateChange] = {
        IF deltaX IN [-4..4] AND deltaY IN [-4..4] THEN change Ź trackballChange[deltaX][deltaY]
        ELSE {
            change Ź TrackballChangeCreate[deltaX, deltaY];
            };
        };

    ThumbwheelChange: PUBLIC PROC [delta: INTEGER] RETURNS [change: DeviceStateChange] = {
        IF delta IN [-4..4] THEN change Ź wheelChange[delta]
        ELSE {
            change Ź WheelChangeCreate[delta];
            };
        };

    KeyChangeCreate: PROC [key: KeyName, down: BOOL] RETURNS [dsChange: DeviceStateChange] ~ {
        change: FastTRAPChange Ź NEW[FastTRAPChangeObj];
        change.type Ź key;
        change.key Ź key;
        change.down Ź down;
        dsChange Ź NEW[DeviceStateChangeObj];
        dsChange.class Ź fastTRAPClass;
        dsChange.change Ź change;
        };

    TrackballChangeCreate: PROC [deltaX, deltaY: INTEGER] RETURNS [dsChange: DeviceStateChange] ~ {
        change: FastTRAPChange Ź NEW[FastTRAPChangeObj];
        change.type Ź trackball;
        change.deltaX Ź deltaX;
        change.deltaY Ź deltaY;
        dsChange Ź NEW[DeviceStateChangeObj];
        dsChange.class Ź fastTRAPClass;
        dsChange.change Ź change;
        };

    WheelChangeCreate: PROC [delta: INTEGER] RETURNS [dsChange: DeviceStateChange] ~ {
        change: FastTRAPChange Ź NEW[FastTRAPChangeObj];
        change.type Ź wheel;
        change.deltaX Ź delta;
        dsChange Ź NEW[DeviceStateChangeObj];
        dsChange.class Ź fastTRAPClass;
        dsChange.change Ź change;
        };

    FastTRAPChange: TYPE = REF FastTRAPChangeObj;
    FastTRAPChangeObj: TYPE = RECORD [
        type: ChangeType,
        key: KeyName Ź left,
        down: BOOL,
        deltaX, deltaY: INTEGER Ź 0
        ];
    ChangeType: TYPE = {key, trackball, wheel};

    StateAfterChange: PUBLIC PROC [deviceState: DeviceState, change: DeviceStateChange] RETURNS [newDeviceState: DeviceState] = {
        ftChange: FastTRAPChange Ź NARROW[change.change];
        SELECT ftChange.type FROM
            key => newDeviceState Ź KeyMotion[deviceState, ftChange.key, ftChange.down];
            trackball => newDeviceState Ź TrackballMotion[deviceState, ftChange.deltaX, ftChange.deltaY];
            wheel => newDeviceState Ź ThumbwheelMotion[deviceState, ftChange.deltaX];
            ENDCASE => ERROR;
        };

    ExpandedChange: TYPE = FastTRAPDevice.ExpandedChange;
    UnpackChange: PUBLIC PROC [change: DeviceStateChange] RETURNS [expanded: ExpandedChange] = {
        ftChange: FastTRAPChange Ź NARROW[change.change];
        SELECT ftChange.type FROM
            key => expanded Ź [key[ftChange.key, ftChange.down]];
            trackball => expanded Ź [trackball[ftChange.deltaX, ftChange.deltaY]];
            wheel => expanded Ź [wheel[ftChange.deltaX]];
            ENDCASE => ERROR;
        };

    <<Changing FastTRAP State>>

    KeyMotion: PUBLIC PROC [deviceState: DeviceState, key: KeyName, down: BOOL] RETURNS [newDeviceState: DeviceState] = {
        newDeviceState Ź CopyState[deviceState];
        NARROW[newDeviceState.state, FastTRAPState].buttonDown[key] Ź down;
        };

    TrackballMotion: PUBLIC PROC [deviceState: DeviceState, deltaX, deltaY: INTEGER] RETURNS [newDeviceState: DeviceState] = {
        newState, oldState: FastTRAPState;
        newDeviceState Ź CopyState[deviceState];
        newState Ź NARROW[newDeviceState.state];
        oldState Ź NARROW[deviceState.state];
        newState.x Ź oldState.x + deltaX;
        newState.y Ź oldState.y + deltaY;
        };

    ThumbwheelMotion: PUBLIC PROC [deviceState: DeviceState, delta: INTEGER] RETURNS [newDeviceState: DeviceState] = {
        newDeviceState Ź CopyState[deviceState];
        NARROW[newDeviceState.state, FastTRAPState].wheel Ź NARROW[deviceState.state, FastTRAPState].wheel + delta;
        };

    <<Inspecting State>>
    <<>>
    IsDown: PUBLIC PROC [deviceState: DeviceState, key: KeyName] RETURNS [BOOL] = {
        state: FastTRAPState Ź NARROW[deviceState.state];
        RETURN[state.buttonDown[key]];
        };
    GetTrackball: PUBLIC PROC [deviceState: DeviceState] RETURNS [x, y: INTEGER] = {
        state: FastTRAPState Ź NARROW[deviceState.state];
        x Ź state.x;
        y Ź state.y;
        };
    GetThumbwheel: PUBLIC PROC [deviceState: DeviceState] RETURNS [wheel: INTEGER] = {
        state: FastTRAPState Ź NARROW[deviceState.state];
        wheel Ź state.wheel;
        };

    Init[];

    END.