-- 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.