-- screen rectangle monitor of chipmonk

-- last modified by McCreight, January 10, 1983  12:57 PM
--  to clean up aborts

DIRECTORY
  ProcessDefs,
  InlineDefs,
  multiGraphicsDefs,
  ppdddefs,
  ppddefs,
  ppdefs;

pprect: MONITOR IMPORTS ppdefs, ppddefs, ppdddefs, ProcessDefs EXPORTS ppdefs =
  BEGIN OPEN ProcessDefs, multiGraphicsDefs, InlineDefs, ppdefs, ppddefs, ppdddefs;

  maxCA: CARDINAL = 30;
  ctable: TYPE = RECORD [
    fCnt: CARDINAL, -- number of pending repaint commands
    idx: CARDINAL, --  tail of repaint command queue
    nidx: CARDINAL, --  head of repaint command queue
    a: ARRAY [0..maxCA) OF sCmd,
    abrt: PROC
    ];

  colTab, bwTab: ctable;


  initRects: PUBLIC ENTRY PROC =
    BEGIN
    colTab.fCnt _ bwTab.fCnt _ 0;
    colTab.idx _ bwTab.idx _ 0;
    colTab.abrt _ StopColCleanly;
    bwTab.abrt _ StopBWCleanly;
    END;


  CenterAndScale: PUBLIC ENTRY PROC [center: Point, scale: INTEGER,
    bw, col: BOOLEAN _ FALSE] =
    BEGIN
    scaleArray: ARRAY [1..20] OF RECORD [INTEGER, INTEGER] _ [
      [1,256],[1,128],[1, 64],[1, 32], [1, 16], [1, 8], [1, 4], [1, 2], [1, 1],
      [2,1],[3,1],[4, 1], [6, 1], [8, 1], [12, 1], [16, 1], [24, 1],[32,1],[
      48, 1], [64, 1]];

    IF bw THEN
      BEGIN
      StopBWCleanly[]; -- about to make major changes in global variables
      bwScale _ scale;
      [bwScaleN, bwScaleD] _ scaleArray[scale];
      gridBW _ bwScaleN*lambdaGrid;
      bwxoff _ (300*bwScaleD)/bwScaleN - center.x;
      bwyoff _ ((bwBottom/2)*bwScaleD)/bwScaleN - center.y;
      bwxoff _ bwxoff - (bwxoff MOD lambdaGrid);
      bwyoff _ bwyoff - (bwyoff MOD lambdaGrid);
      bwClipx2 _ (606*bwScaleD)/bwScaleN - bwxoff;
      bwClipy2 _ (bwBottom*bwScaleD)/bwScaleN - bwyoff;
      bwClipx1 _ -bwxoff;
      bwClipy1 _ -bwyoff;
      reDrawRectInternal[r: [0,0,0,0], whenErase: 1, bw: TRUE, col: FALSE, all: TRUE];
      END;
    IF col THEN
      BEGIN
      StopColCleanly[];
      cScale _ scale;
      [cScaleN, cScaleD] _ scaleArray[scale];
      gridCol _ cScaleN*lambdaGrid;
      cxoff _ ((colWidth/2)*cScaleD)/cScaleN - center.x;
      cyoff _ ((colHeight/2)*cScaleD)/cScaleN - center.y;
      cxoff _ cxoff - (cxoff MOD lambdaGrid);
      cyoff _ cyoff - (cyoff MOD lambdaGrid);
      cClipx2 _ (colWidth*cScaleD)/cScaleN - cxoff;
      cClipy2 _ (colHeight*cScaleD)/cScaleN - cyoff;
      cClipx1 _ -cxoff;
      cClipy1 _ -cyoff;
      reDrawRectInternal[r: [0,0,0,0], whenErase: 1, bw: FALSE, col: TRUE, all: TRUE];
      END;
    END;

  reDrawRect: PUBLIC ENTRY PROC [
    r: Rect, whenErase: CARDINAL, bw, col, all: BOOLEAN] =
    {reDrawRectInternal[r, whenErase, bw, col, all]};

  reDrawRectInternal: INTERNAL PROC [
    r: Rect, whenErase: CARDINAL, bw, col, all: BOOLEAN] =
    BEGIN  -- note must be called with x1<=x2, y1<=y2
    cmd: sCmd;
    a, b, c, d: INTEGER;
    bb: BOOLEAN;
    cmd.cmd _ IF all THEN all ELSE rect;
    cmd.p _ NIL;
    cmd.ers _ whenErase # 0;
    IF bw THEN
      BEGIN
      IF all THEN
        BEGIN
        cmd.r.x1 _ bwClipx1;
        cmd.r.x2 _ bwClipx2;
        cmd.r.y1 _ bwClipy1;
        cmd.r.y2 _ bwClipy2;
        a _ b _ 0;
        c _ d _ 1200;
        END
      ELSE
        BEGIN
        [bb, a, b, c, d] _ bwscaleRect[r.x1, r.y1, r.x2, r.y2];
        IF bb THEN
          BEGIN
          cmd.r.x1 _ MAX[bwClipx1, r.x1];
          cmd.r.x2 _ MIN[bwClipx2, r.x2];
          cmd.r.y1 _ MAX[bwClipy1, r.y1];
          cmd.r.y2 _ MIN[bwClipy2, r.y2];
          END
        ELSE bw _ FALSE;
        END;
      END;
    IF bw THEN {insRect[cmd, @bwTab]; BROADCAST bwAvail};
    IF col THEN
      BEGIN
      IF all THEN
        BEGIN
        cmd.r.x1 _ cClipx1;
        cmd.r.x2 _ cClipx2;
        cmd.r.y1 _ cClipy1;
        cmd.r.y2 _ cClipy2;
        a _ b _ 0;
        c _ d _ 1200;
        END
      ELSE
        BEGIN
        [bb, a, b, c, d] _ cscaleRect[r.x1, r.y1, r.x2, r.y2];
        IF bb THEN
          BEGIN
          cmd.r.x1 _ MAX[cClipx1, r.x1];
          cmd.r.x2 _ MIN[cClipx2, r.x2];
          cmd.r.y1 _ MAX[cClipy1, r.y1];
          cmd.r.y2 _ MIN[cClipy2, r.y2];
          END
        ELSE col _ FALSE;
        END;
      END;
    IF col THEN {insRect[cmd, @colTab]; BROADCAST colAvail};
    END;


  drawNewlySel: PUBLIC ENTRY PROC [p: LONG POINTER TO list] =
    BEGIN
    cmd: sCmd;
    cmd.cmd _ sel;
    cmd.p _ p;
    cmd.ers _ TRUE;
    insRect[cmd, @bwTab];
    BROADCAST bwAvail;
    insRect[cmd, @colTab];
    BROADCAST colAvail;
    END;

  insRect: INTERNAL PROC [c: sCmd, t: POINTER TO ctable] =
    BEGIN

    inside: PROC [a, b: Rect] RETURNS [BOOLEAN] =  -- True if a inside b
      {RETURN[NOT (a.x1 < b.x1 OR a.y1 < b.y1 OR a.x2 > b.x2 OR a.y2 > b.y2)]};

    IF t.fCnt >= maxCA OR c.cmd=all THEN
      BEGIN -- replace with single command to repaint everything
      t.abrt[];  --abort the current queue
      t.idx _ t.nidx _ 0;
      t.a[0] _ c;
      t.a[0].cmd _ all;
      t.fCnt _ 1;
      RETURN;
      END;
    IF t.fCnt > 0 AND t.a[t.idx].cmd = all THEN RETURN;
      -- we're going to repaint everything anyway
    IF c.cmd = rect THEN
      BEGIN
      i: CARDINAL _ t.nidx;
      THROUGH [0..t.fCnt) DO
        -- see if our repaint can include or be included in a previous one
        IF t.a[i].cmd = rect THEN
          BEGIN
          IF inside[c.r, t.a[i].r] THEN
            {t.a[i].ers _ t.a[i].ers OR c.ers; RETURN};
          IF inside[t.a[i].r, c.r] THEN
            {t.a[i].ers _ t.a[i].ers OR c.ers; t.a[i].r _ c.r; RETURN};
          END;
        i _ Inc[i];
        ENDLOOP;
      END;

    -- add the new command to the queue
    t.idx _ IF t.fCnt = 0 THEN (t.nidx _ 0) ELSE Inc[t.idx];
    t.a[t.idx] _ c;
    t.fCnt _ t.fCnt + 1;
    END;


  Inc: PROC [i: CARDINAL] RETURNS [CARDINAL] = INLINE
    BEGIN RETURN[IF i >= maxCA - 1 THEN 0 ELSE i + 1]; END;

  colAvail, bwAvail, colPainterAck, bwPainterAck: CONDITION;

  StopColCleanly: INTERNAL PROC [] =
    BEGIN
    abortColor _ TRUE;
    colTab.fCnt _ 0;
    WHILE abortColor DO
      NOTIFY colAvail;
      WAIT colPainterAck;
      ENDLOOP;
    END;

  getColNewRect: PUBLIC ENTRY PROC RETURNS [sCmd] =
    BEGIN
    i: CARDINAL;
    WHILE colTab.fCnt = 0 DO
      WAIT colAvail;
      abortColor _ FALSE;
      NOTIFY colPainterAck;
      ENDLOOP;
    i _ colTab.nidx;
    colTab.nidx _ Inc[i];
    colTab.fCnt _ colTab.fCnt - 1;
    RETURN[colTab.a[i]];
    END;

  StopBWCleanly: INTERNAL PROC [] =
    BEGIN
    abortBW _ TRUE;
    bwTab.fCnt _ 0;
    WHILE abortBW DO
      NOTIFY bwAvail;
      WAIT bwPainterAck;
      ENDLOOP;
    END;

  getBwNewRect: PUBLIC ENTRY PROC RETURNS [sCmd] =
    BEGIN
    i: CARDINAL;
    WHILE bwTab.fCnt = 0 DO
      WAIT bwAvail;
      abortBW _ FALSE;
      NOTIFY bwPainterAck;
      ENDLOOP;
    i _ bwTab.nidx;
    bwTab.nidx _ Inc[i];
    bwTab.fCnt _ bwTab.fCnt - 1;
    RETURN[bwTab.a[i]];
    END;

  InitializeCondition[condition: @colAvail, ticks: MsecToTicks[200]];
  InitializeCondition[condition: @bwAvail, ticks: MsecToTicks[200]];
  InitializeCondition[condition: @colPainterAck, ticks: MsecToTicks[200]];
  InitializeCondition[condition: @bwPainterAck, ticks: MsecToTicks[200]];
  initRects[];

  END.