<<>>
    <<ViewersWorldImpl.mesa>>
        <<Copyright Ó 1988, 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Bier, August 13, 1990 4:18 pm PDT>>
        <<Christian Jacobi, July 1, 1992 12:08 pm PDT>>
        <<Kenneth A. Pier, April 19, 1991 3:50 pm PDT>>
        <<Willie-s, October 29, 1991 5:12 pm PST>>
        <<Michael Plass, March 15, 1992 4:39 pm PST>>
        <<>>
        <<A big switch which allows separate implementation of viewer worlds.>>
        <<Last tweaked by Mike Spreitzer March 26, 1992 4:15 pm PST>>
        <<>>
    DIRECTORY
        Atom, Buttons, CedarProcess, Imager, ImagerBackdoor, InputFocus, KeyMappingTypes, MessageWindow, Rope, TIPPrivate, UserInput, 
        UserInputOps, ViewerOps, ViewerPrivate, ViewerScreenTypes, ViewersWorld, ViewersWorldClasses, ViewersWorldInitializations, 
        ViewersWorldInstance, ViewersWorldRefType, ViewersWorldTypes;

    ViewersWorldImpl: CEDAR MONITOR
        IMPORTS Atom, CedarProcess, Imager, ImagerBackdoor, MessageWindow, TIPPrivate, UserInputOps, ViewerOps, ViewerPrivate
        EXPORTS ViewersWorld, ViewersWorldClasses, ViewersWorldInitializations, ViewersWorldInstance, ViewersWorldRefType
     = BEGIN

        Focus: TYPE = InputFocus.Focus;
        FocusRec: TYPE = InputFocus.FocusRec;
        Ref: TYPE = ViewersWorld.Ref;
        ViewersWorldObj: PUBLIC TYPE = ViewersWorldTypes.ViewersWorldObj;
        ViewersWorldClass: TYPE = ViewersWorldClasses.ViewersWorldClass;

        outOfColormapEntries: PUBLIC ERROR = CODE;

        setWorldNotifiers: LIST OF ViewersWorldInstance.SetNotifyProc Ź NIL;

        theVWorld: ViewersWorld.Ref Ź DummyViewersWorld[]; 


    DummyViewersWorld: PROC RETURNS [ViewersWorld.Ref] = {
        w: ViewersWorld.Ref Ź CreateViewersWorld[class: DummyViewersWorldClass[]];
        RETURN [w]
        };

    dummySetCursorPatternProc: ViewersWorldClasses.SetCursorPatternProc ~ {};
    dummyGetCursorPatternProc: ViewersWorldClasses.GetCursorPatternProc ~ {
        RETURN [deltaX: 0, deltaY: 0, cursorPattern: ALL[0], patternName: $Unnamed]
        };
    dummySetBigCursorPatternProc: ViewersWorldClasses.SetBigCursorPatternProc ~ {};
    dummyGetBigCursorPatternProc: ViewersWorldClasses.GetBigCursorPatternProc ~ {ERROR};
    dummyIsBigCursorPatternProc: ViewersWorldClasses.IsBigCursorPatternProc ~ {RETURN [FALSE]};
    dummyBigCursorsSupportedProc: ViewersWorldClasses.BigCursorsSupportedProc ~ {RETURN[FALSE]};
    dummySetCursorColorProc: ViewersWorldClasses.SetCursorColorProc ~ {};
    dummyGetCursorColorProc: ViewersWorldClasses.GetCursorColorProc ~ {RETURN [Imager.black]};
    dummySetMousePositionProc: ViewersWorldClasses.SetMousePositionProc ~ {};
    dummyGetMousePositionProc: ViewersWorldClasses.GetMousePositionProc ~ {
        RETURN [x: 0, y: 0, display: NIL]
        };
    dummySetCutBufferProc: ViewersWorldClasses.SetCutBufferProc ~ {};
    dummyGetCutBufferProc: ViewersWorldClasses.GetCutBufferProc ~ {RETURN[NIL]};
    dummyBlinkProc: ViewersWorldClasses.BlinkProc ~ {};
    dummyGetDeviceSizeProc: ViewersWorldClasses.GetDeviceSizeProc ~ {RETURN[1024, 808]};
    dummyContextCreatorProc: ViewerScreenTypes.ContextCreatorProc ~ {
        RETURN [ImagerBackdoor.BitmapContext[ImagerBackdoor.NewBitmap[1,1]]]
        };
    dummyAllocateColorMapIndexProc: ViewersWorldClasses.AllocateColorMapIndexProc ~ {RETURN[0]};
    dummyFreeColorMapIndexProc: ViewersWorldClasses.FreeColorMapIndexProc ~ {};
    dummySetColorMapEntryProc: ViewersWorldClasses.SetColorMapEntryProc ~ {};
    dummyGetColorMapEntryProc: ViewersWorldClasses.GetColorMapEntryProc ~ {RETURN[0,0,0]};

    DummyViewersWorldClass: PROC RETURNS [ViewersWorldClass] = {
        c: ViewersWorldClass Ź NEW[ViewersWorldClasses.ViewersWorldClassObj Ź [
            setCursorPattern: dummySetCursorPatternProc,
            getCursorPattern: dummyGetCursorPatternProc,
            setBigCursorPattern: dummySetBigCursorPatternProc,
            getBigCursorPattern: dummyGetBigCursorPatternProc,
            isBigCursorPattern: dummyIsBigCursorPatternProc,
            bigCursorsSupported: dummyBigCursorsSupportedProc,
            setCursorColor: dummySetCursorColorProc,
            getCursorColor: dummyGetCursorColorProc,
            setMousePosition: dummySetMousePositionProc,
            getMousePosition: dummyGetMousePositionProc,
            setCutBuffer: dummySetCutBufferProc,
            getCutBuffer: dummyGetCutBufferProc,
            blink: dummyBlinkProc,
            getDeviceSize: dummyGetDeviceSizeProc,
            creator: dummyContextCreatorProc,
            allocateColorMapIndex: dummyAllocateColorMapIndexProc,
            freeColorMapIndex: dummyFreeColorMapIndexProc,
            setColorMapEntry: dummySetColorMapEntryProc,
            getColorMapEntry: dummyGetColorMapEntryProc
            ]];
        RETURN [c]
        };

    SetWorld: PROC [viewersWorld: ViewersWorld.Ref] = {
        IF viewersWorld = NIL THEN viewersWorld Ź DummyViewersWorld[];
        theVWorld Ź viewersWorld;
        ViewerPrivate.SetBWScreenSize[viewersWorld.width, viewersWorld.height];
        FOR l: LIST OF ViewersWorldInstance.SetNotifyProc Ź setWorldNotifiers, l.rest WHILE l#NIL DO
            l.first[viewersWorld];
            ENDLOOP
        };

    GetWorld: PUBLIC PROC [] RETURNS [viewersWorld: ViewersWorld.Ref] = {
        viewersWorld Ź theVWorld;
        };

    CallWhenSet: PUBLIC ENTRY PROC[ proc: ViewersWorldInstance.SetNotifyProc ] = {
        IF proc#NIL THEN setWorldNotifiers Ź CONS[proc, setWorldNotifiers]; 
        };

    CreateViewersWorld: PUBLIC PROC [class: ViewersWorldClass, mapping: KeyMappingTypes.Mapping Ź NIL, screenServerData: REF Ź NIL] 
    RETURNS [viewersWorld: Ref] = {
        handle: UserInput.Handle;
        viewersWorld Ź NEW[ViewersWorldObj];
        viewersWorld.mapping Ź mapping;
        viewersWorld.class Ź class;
        viewersWorld.screenServerData Ź screenServerData;
        viewersWorld.currentFocus Ź NEW[FocusRec];
        viewersWorld.focusTIP Ź TIPPrivate.CreateTIPClient[buttons: ViewerPrivate.MasterButtonProc, notify: ViewerPrivate.MasterNotifyProc, 
        clientData: viewersWorld, name: "ViewersWorld"];
        handle Ź TIPPrivate.GetInputHandle[viewersWorld.focusTIP];
        IF viewersWorld.mapping#NIL THEN UserInputOps.SetMapping[handle, viewersWorld.mapping];
        };
    <<>>
    <<Connecting with Viewers>>
    <<>>
    StartInstallation: PUBLIC PROC [viewersWorld: Ref] = {
        SetWorld[viewersWorld];
        ViewerPrivate.ProcessEndOpsRegistry[];
        SetUpOutput[viewersWorld, viewersWorld.class.creator];
        EnableInput[viewersWorld];
        ViewerPrivate.GreyScreen[main, 0, 0, 9999, 9999];
        MessageWindow.CreateMessageWindow[];
        RETURN};

    FinishInstallation: PUBLIC PROC [viewersWorld: Ref] = {
        };

    <<Setting up Input>>
    <<>>
    GetInputHandle: PUBLIC PROC [viewersWorld: Ref] RETURNS [handle: UserInput.Handle] = {
        IF viewersWorld.focusTIP # NIL THEN {
            handle Ź TIPPrivate.GetInputHandle[viewersWorld.focusTIP];
            };
        };

    EnableInput: PROC [viewersWorld: Ref] = {
        <<Allows viewers to begin taking actions off its input queue and processing them.>>
        inner: PROC = {
            TIPPrivate.DiscardTypeAhead[viewersWorld.focusTIP];
            TIPPrivate.StartTIPClient[viewersWorld.focusTIP];
            };
        CedarProcess.DoWithPriority[LOOPHOLE[ViewerPrivate.VMgrPriority], inner];
        viewersWorld.inputEnabled Ź TRUE;
        };

    RestartInput: PUBLIC PROC [viewersWorld: Ref] = {
        <<The process that takes actions from the input queue as died.  Create a new one.>>
        handle: UserInput.Handle;
        TIPPrivate.DestroyClient[viewersWorld.focusTIP]; -- destroy old notifier
        viewersWorld.focusTIP Ź TIPPrivate.CreateTIPClient[name: "ViewersWorldRestart", buttons: ViewerPrivate.MasterButtonProc, notify: 
        ViewerPrivate.MasterNotifyProc, clientData: viewersWorld];
        handle Ź TIPPrivate.GetInputHandle[viewersWorld.focusTIP];
        IF viewersWorld.mapping#NIL THEN UserInputOps.SetMapping[handle, viewersWorld.mapping];
        EnableInput[viewersWorld];
        };

    <<Setting up Output>>

    SetUpOutput: PROC [viewersWorld: Ref, creator: ViewerPrivate.ContextCreatorProc] = {
        [] Ź ViewerPrivate.SetCreator[creator]; -- allocates a pool of contexts
        viewersWorld.outputEnabled Ź TRUE;
        };


    SetMousePosition: PUBLIC PROC [viewersWorld: Ref, x, y: INTEGER, display: REF Ź NIL, device: REF Ź NIL] = {
        viewersWorld.class.setMousePosition[viewersWorld.screenServerData, x, y, display, device];
        };

    GetMousePosition: PUBLIC PROC [viewersWorld: Ref, device: REF Ź NIL] RETURNS [x, y: INTEGER, display: REF Ź NIL] = {
        RETURN viewersWorld.class.getMousePosition[viewersWorld.screenServerData, device];
        };
        <<>>
    BlinkViewersWorld: PUBLIC PROC [viewersWorld: Ref, display: REF Ź NIL, frequency: CARDINAL Ź 750, duration: CARDINAL Ź 500] = {
        viewersWorld.class.blink[viewersWorld.screenServerData, display, frequency, duration];
        };
    <<>>
    SetSize: PUBLIC PROC [viewersWorld: Ref, width: NAT, height: NAT, display: REF Ź NIL] = {
        viewersWorld.width Ź width;
        viewersWorld.height Ź height;
        IF viewersWorld=theVWorld THEN {
            ViewerPrivate.SetBWScreenSize[width, height];
            IF viewersWorld.outputEnabled THEN {
                [] Ź ViewerPrivate.SetCreator[viewersWorld.class.creator]; -- update the cache of contexts
                ViewerOps.PaintEverything[];
                };
            };
        RETURN};

    GetSize: PUBLIC PROC [viewersWorld: Ref, display: REF Ź NIL] RETURNS [width, height: NAT] = {
        width Ź viewersWorld.width;
        height Ź viewersWorld.height;
        };
    <<>>
    GetDeviceSize: PUBLIC PROC [viewersWorld: Ref, display: REF Ź NIL] RETURNS [w, h: NAT] = {
        [w, h] Ź viewersWorld.class.getDeviceSize[viewersWorld.screenServerData, display];
        };

    SetCutBuffer: PUBLIC PROC [viewersWorld: Ref, buffer: ATOM, data: Rope.ROPE] = {
        IF viewersWorld=NIL THEN viewersWorld Ź GetWorld[];
        viewersWorld.class.setCutBuffer[viewersWorld.screenServerData, buffer, data];
        };

    GetCutBuffer: PUBLIC PROC [viewersWorld: Ref, buffer: ATOM] RETURNS [data: Rope.ROPE] = {
        IF viewersWorld=NIL THEN viewersWorld Ź GetWorld[];
        data Ź viewersWorld.class.getCutBuffer[viewersWorld.screenServerData, buffer];
        };

    AllocateColorMapIndex: PUBLIC PROC [viewersWorld: Ref, display: REF Ź NIL, revokeIndex: RevokeColorMapIndexProc, clientData: REF Ź 
    NIL] RETURNS [index: CARDINAL] = {
        index Ź viewersWorld.class.allocateColorMapIndex[viewersWorld.screenServerData, display, revokeIndex, clientData];
        };
    <<>>
    RevokeColorMapIndexProc: TYPE = ViewersWorld.RevokeColorMapIndexProc;
    FreeColorMapIndex: PUBLIC PROC [viewersWorld: Ref, index: CARDINAL, display: REF Ź NIL] = {
        viewersWorld.class.freeColorMapIndex[viewersWorld.screenServerData, index, display];
        };
        <<>>
    SetColorMapEntry: PUBLIC PROC [viewersWorld: Ref, index: CARDINAL, display: REF Ź NIL, red, green, blue: INTEGER] = {
        <<red, green, blue should be between 0 and 255.   They should not be gamma-corrected.>>
        viewersWorld.class.setColorMapEntry[viewersWorld.screenServerData, index, display, red, green, blue];
        };

    GetColorMapEntry: PUBLIC PROC [viewersWorld: Ref, index: CARDINAL, display: REF Ź NIL] RETURNS [red, green, blue: INTEGER] = {
        <<red, green, blue should be between 0 and 255.   They should not be gamma-corrected.>>
        [red, green, blue] Ź viewersWorld.class.getColorMapEntry[viewersWorld.screenServerData, index, display];
        };
    <<>>
    GetWorldProp: PUBLIC PROC [viewersWorld: Ref, prop: REF] RETURNS [val: REF] = {
        RETURN [Atom.GetPropFromList[viewersWorld.properties, prop]]
        };

    PutWorldProp: PUBLIC ENTRY PROC [viewersWorld: Ref, prop: REF, val: REF] = {
        IF viewersWorld#NIL THEN viewersWorld.properties Ź Atom.PutPropOnList[viewersWorld.properties, prop, val]
        };

    RemWorldProp: PUBLIC ENTRY PROC [viewersWorld: Ref, prop: REF] = {
        IF viewersWorld#NIL THEN viewersWorld.properties Ź Atom.RemPropFromList[viewersWorld.properties, prop]
        };

    GetClassProp: PUBLIC PROC [class: ViewersWorldClass, prop: REF] RETURNS [val: REF] = {
        RETURN [Atom.GetPropFromList[class.properties, prop]]
        };

    PutClassProp: PUBLIC ENTRY PROC [class: ViewersWorldClass, prop: REF, val: REF] = {
        IF class#NIL THEN class.properties Ź Atom.PutPropOnList[class.properties, prop, val]
        };

    RemClassProp: PUBLIC ENTRY PROC [class: ViewersWorldClass, prop: REF] = {
        IF class#NIL THEN class.properties Ź Atom.RemPropFromList[class.properties, prop]
        };

    Atom.PutProp[$Viewers, $Viewers, $Viewers]; --hack which allows to detect viewer less worlds
    END.