
    <<CDRectsImpl.mesa   (part of ChipNDale)>>
        <<Copyright © 1983, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Created by: Christian Jacobi, June 24, 1983 4:58 pm >>
        <<Last edited by: Christian Jacobi, February 23, 1987 6:59:26 pm PST>>

    DIRECTORY
        CD,
        CDBasicsInline,
        CDIO,
        CDPrivate,
        CDProperties,
        CDRects,
        CDOps,
        LRUCache,
        Rope,
        SafeStorage,
        TokenIO;

    CDRectsImpl: CEDAR MONITOR 
        IMPORTS CD, CDBasicsInline, CDIO, CDOps, CDPrivate, CDProperties, LRUCache, Rope, SafeStorage
        EXPORTS CDRects   
        SHARES CD =
    BEGIN

    dummyRectSpecific: CD.RectSpecific = SafeStorage.GetPermanentZone[].NEW[CD.RectRep _ [filler: NIL]];
    lruQueue: LRUCache.Handle _ LRUCache.Create[255, CDPrivate.Hash, CDPrivate.Equal];
    free: CD.Object _ NIL; --always bare rect

    GiveOb: ENTRY PROC [] RETURNS [ob: CD.Object] = INLINE {
        ob _ free; free _ NIL;
        IF ob=NIL THEN ob _ NEW[CD.ObjectRep_[class: bareRectClass, specific: dummyRectSpecific]];
        };

    CreateRectProc: TYPE = PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object] _ CreateBareRect;

    createRectArray: REF ARRAY CD.Layer OF CreateRectProc = 
        SafeStorage.GetPermanentZone[].NEW[ARRAY CD.Layer OF CreateRectProc]; 
        <<--initialized by default>>

    CreateRect: PUBLIC PROC [size: CD.Position, l: CD.Layer] RETURNS [ob: CD.Object] = {
        IF createRectArray[l]=CreateBareRect THEN {
            <<--don't cache a secod time..>>
            ob _ CreateBareRect[size, l]
            }
        ELSE {
            used: REF; insert: BOOL;
            ob _ createRectArray[l][size, l];
            [insert: insert, used: used] _ LRUCache.Include[lruQueue, ob];
            IF ~insert THEN ob _ NARROW[used]; 
                <<--otherwise do not remember object on free! we don't know its class >>
            };
        ob.immutable _ TRUE;
        };

    HangExtensionsOn: PROC[on: CD.ObjectClass] = {
        IF on.newLayer=NIL THEN on.newLayer _ ChangeLayer
        };

    UseAsCreateRect: PUBLIC PROC [l: CD.Layer, 
        createRect: PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object],
        hangExtensionsOn: CD.ObjectClass
        ] = {
        IF createRect=NIL THEN createRect _ CreateBareRect;
        createRectArray[l] _ createRect;
        IF hangExtensionsOn#NIL THEN HangExtensionsOn[hangExtensionsOn];
        CDProperties.PutLayerProp[onto: l, prop: $CDxRectCreation, val: $CDxUser];
        };

    CreateBareRect: PUBLIC PROC [size: CD.Position, l: CD.Layer] RETURNS [ob: CD.Object] = {
        used: REF; insert: BOOL;
        ob _ GiveOb[];
        ob.bbox _ CDPrivate.MinBBox[size];
        ob.layer _ l;
        [insert: insert, used: used] _ LRUCache.Include[lruQueue, ob];
        IF ~insert THEN {free _ ob; ob _ NARROW[used]};
        }; 

    bareRectClass: PUBLIC CD.ObjectClass;
    oldSaveRectClass: CD.ObjectClass; --for compatibility only

    Init: PROC [] = {
        bareRectClass _ CD.RegisterObjectClass[$Rect, [
            drawMe: DrawMeForRects,
            quickDrawMe: DrawMeForRects,
            internalRead: ReadRect,
            internalWrite: WriteRect,
            newLayer: ChangeLayer,
            describe: Describe,
            wireTyped: TRUE
            ]];
        HangExtensionsOn[bareRectClass];
        oldSaveRectClass _ CD.RegisterObjectClass[$SaveRect, [internalRead: ReadRect]];
        }; 

    Describe: CD.DescribeProc = {
        RETURN [Rope.Concat["rect  ", CDOps.LayerRope[ob.layer]]]
        };

    DrawMeForRects: CD.DrawProc = {
        pr.drawRect[pr, CDBasicsInline.MapRect[ob.bbox, trans], ob.layer] 
        }; 

    ChangeLayer: CD.ChangeLayerProc = {
        newOb: CD.Object _ CreateRect[CD.InterestSize[inst.ob], layer];
        IF newOb#NIL THEN inst.ob _ newOb;
        RETURN [newOb#NIL];
        };

    WriteRect: CD.InternalWriteProc -- PROC [ob: Object] -- = {
        CDIO.WritePos[h, CD.InterestSize[ob]];
        CDIO.WriteLayer[h, ob.layer];
        };

    ReadRect: CD.InternalReadProc --PROC [] RETURNS [Object]-- = {
        sz: CD.Position = CDIO.ReadPos[h];
        l: CD.Layer = CDIO.ReadLayer[h];
        ob: CD.Object = CreateRect[sz, l];
        RETURN [ob]
        };

    Init[];
    END.