-- Copyright (C) 1983, 1984  by Xerox Corporation. All rights reserved. 
-- DisplayImplD.mesa - last edited by 
-- Rick	        12-Nov-83 14:51:57  
-- Bruce	24-Feb-83 16:08:25  
-- Daniels	 7-Jun-84 14:56:02  

DIRECTORY
  BitBlt USING [BitBltFlags],
  DisplayFormat USING [CircleType],
  Display USING [paintGrayFlags],
  DisplayOps USING [
    AbsPlace, Color, HasUnder, LogError, FillList, FillObject, Intersect, Shade],
  DisplayInternal USING [],
  SpecialDisplay USING [DashCnt, defaultContext, LineStyle, solid, Special],
  Window USING [BoxHandle, Place],
  WindowOps USING [
    AbsoluteBoxHandle, bitmapAddress, Bounds, DisplayList, GetContext,
    lock, Object, RecList, ScanLine, ScreenBox, SpecialTimesWpl];

DisplayImplD: MONITOR LOCKS WindowOps.lock
  IMPORTS DisplayOps, SpecialDisplay, WindowOps
  EXPORTS DisplayInternal, SpecialDisplay, Window =
  BEGIN

  -- exported types
  Handle: TYPE = LONG POINTER TO Object;
  Object: PUBLIC TYPE = WindowOps.Object;

  FillHandle: TYPE = LONG POINTER TO FillObject;
  FillObject: PUBLIC TYPE = DisplayOps.FillObject;

  -- copied types because John doesn't like them
  LineStyle: TYPE = SpecialDisplay.LineStyle;
  Special: TYPE = SpecialDisplay.Special;

  -- circles

  Circle: PUBLIC ENTRY PROC [
    window: Handle, place: Window.Place, radius: INTEGER,
    circleType: DisplayFormat.CircleType, bounds: Window.BoxHandle ¬ NIL] = {
    -- This routine observes that:
    -- radius IN [0..8000]
    -- place.x, place.y IN [-8000.. 8000]
    -- Also the circle bouding box intersects each reclist and before any integer
    -- math is done, the circle is in each reclist. Four scanlines and four
    -- bitIndexes are maintained to determine xys in all eight octants.  Scanlines
    -- start top, middle, middle, bottom.  BitIndexes start left, middle, middle,
    -- right.  All end on the 45s.
    ENABLE UNWIND => NULL;
    absBounds: WindowOps.ScreenBox =
      IF bounds = NIL THEN WindowOps.Bounds[window]
      ELSE WindowOps.AbsoluteBoxHandle[window, bounds];
    startTwoxma: INTEGER ¬ 1;
    startTwoymb: INTEGER ¬ 2*radius - 1;
    abs: Window.Place = DisplayOps.AbsPlace[window, place];
    IF ~window.inTree THEN RETURN;
    FOR r: WindowOps.RecList ¬ WindowOps.DisplayList[window], r.link 
      UNTIL r = NIL DO
      IF DisplayOps.Intersect[r, absBounds] THEN {
        IF abs.x - radius < r.box.left OR  --  clipped?
          abs.x + radius > r.box.right OR abs.y + radius > r.box.bottom OR
          abs.y - radius < r.box.top OR DisplayOps.HasUnder[r] THEN {
          [] ¬ SpCircleInternal[
            r, FALSE, window, place, radius, circleType, bounds,
            SpecialDisplay.solid, Display.paintGrayFlags];
          RETURN};
        {		-- not clipped, so these values can't be negative
	wpl: CARDINAL = SpecialDisplay.defaultContext.wpl;
        bitAddress1: WindowOps.ScanLine ¬
          WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[abs.y - radius];
        bitAddress2: WindowOps.ScanLine ¬
          WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[abs.y];
        bitAddress3: WindowOps.ScanLine ¬ bitAddress2;
        bitAddress4: WindowOps.ScanLine ¬
          WindowOps.bitmapAddress + WindowOps.SpecialTimesWpl[abs.y + radius];
        bitIndex1: INTEGER ¬ abs.x - radius;
        bitIndex2, bitIndex3: INTEGER ¬ abs.x;
        bitIndex4: INTEGER ¬ abs.x + radius;
        newError: INTEGER;
        twoxma: INTEGER ¬ startTwoxma;
        twoymb: INTEGER ¬ startTwoymb;
        error: INTEGER ¬ (radius - 1)/2;
        IF circleType[0] THEN {
	    bitIndex1 ¬ bitIndex1 + 1; bitIndex2 ¬ bitIndex2 + 1};
	  IF circleType[1] THEN {
	    bitIndex1 ¬ bitIndex1 - 1; bitIndex2 ¬ bitIndex2 - 1};
	  IF circleType[2] THEN {
	    bitIndex3 ¬ bitIndex3 - 1; bitIndex4 ¬ bitIndex4 - 1};
	  IF circleType[3] THEN {
	    bitIndex3 ¬ bitIndex3 + 1; bitIndex4 ¬ bitIndex4 + 1};
	  IF circleType[4] THEN {
	    bitAddress1 ¬ bitAddress1 + wpl;
	    bitAddress2 ¬ bitAddress2 + wpl};
	  IF circleType[5] THEN {
	    bitAddress1 ¬ bitAddress1 - wpl;
	    bitAddress2 ¬ bitAddress2 - wpl};
	  IF circleType[6] THEN {
	    bitAddress3 ¬ bitAddress3 - wpl; 
	    bitAddress4 ¬ bitAddress4 - wpl};
	  IF circleType[7] THEN {
	    bitAddress3 ¬ bitAddress3 + wpl;
	    bitAddress4 ¬ bitAddress4 + wpl};
        -- Provided this loop quits when it's supposed to, less thanradius/2times,
        -- twoxma IN [0..radius]
        -- twoymb IN [0..2*radius]
        -- error starts at [0..radius/2],  and stays IN [-twoymb..twoymb] 
        -- as twoymb goes to zero.
        UNTIL bitIndex3 > bitIndex4 DO
          bitAddress1[bitIndex2] ¬ TRUE;  -- set a bit
          bitAddress1[bitIndex3] ¬ TRUE;
          bitAddress2[bitIndex1] ¬ TRUE;
          bitAddress2[bitIndex4] ¬ TRUE;
          bitAddress3[bitIndex1] ¬ TRUE;
          bitAddress3[bitIndex4] ¬ TRUE;
          bitAddress4[bitIndex2] ¬ TRUE;
          bitAddress4[bitIndex3] ¬ TRUE;
          bitIndex2 ¬ bitIndex2 - 1;
          bitIndex3 ¬ bitIndex3 + 1;
          bitAddress2 ¬ bitAddress2 - wpl;
          bitAddress3 ¬ bitAddress3 + wpl;
          error ¬ error + twoxma;
          IF ABS[newError ¬ error - twoymb] < ABS[error] THEN {
            error ¬ newError;
            bitIndex1 ¬ bitIndex1 + 1;
            bitIndex4 ¬ bitIndex4 - 1;
            bitAddress1 ¬ bitAddress1 + wpl;
            bitAddress4 ¬ bitAddress4 - wpl;
            twoymb ¬ twoymb - 2};
          twoxma ¬ twoxma + 2;
          ENDLOOP}};
      ENDLOOP};

  SpecialCircle: PUBLIC ENTRY PROC [
    window: Handle, place: Window.Place, radius: INTEGER,
    circleType: DisplayFormat.CircleType, bounds: Window.BoxHandle,
    dashes: SpecialDisplay.LineStyle, flags: BitBlt.BitBltFlags,
    context: Special ¬ SpecialDisplay.defaultContext] = {
    ENABLE UNWIND => NULL;
    filled: BOOLEAN = context.alloc # NIL;
    firstRec: WindowOps.RecList = DisplayOps.FillList[window, filled];
    SpCircleInternal[
      firstRec, filled, window, place, radius, circleType, bounds, dashes, flags,
      context]};

  SpCircleInternal: INTERNAL PROC [
    firstRec: WindowOps.RecList, filled: BOOLEAN, window: Handle,
    place: Window.Place, radius: INTEGER, circleType: DisplayFormat.CircleType,
    bounds: Window.BoxHandle, dashes: SpecialDisplay.LineStyle,
    flags: BitBlt.BitBltFlags, context: Special ¬ SpecialDisplay.defaultContext]={
    -- This routine observes that:
    -- radius IN [0..8000]
    -- place.x, place.y IN [-8000.. 8000]
    -- Also the circle bouding box intersects Display.clip.box.
    -- Display.clip.box.left, right IN [0.. 1000]
    -- Display.clip.box.top, bottom IN [0..800]
    -- Four scanlines and four bitIndexes are maintained to determine xys in
    -- all eight octants.  Scanlines start top, middle, middle, bottom. BitIndexes
    -- start left, middle, middle, right.  All end on the 45s.
    L: PROCEDURE [l: LONG POINTER] RETURNS [LONG ORDERED POINTER] = INLINE {
      RETURN[LOOPHOLE[l]]};
    absBounds: WindowOps.ScreenBox =
      IF bounds = NIL THEN WindowOps.Bounds[window]
      ELSE WindowOps.AbsoluteBoxHandle[window, bounds];
    abs: Window.Place = DisplayOps.AbsPlace[window, place];
    newError: INTEGER;
    bitIndex2, bitIndex3: INTEGER ¬ abs.x;
    dashCnt, dashSum: CARDINAL;
    widths: ARRAY [0..SpecialDisplay.DashCnt) OF CARDINAL;
    inc1, inc2, inc3, inc4, inc5, inc6: CARDINAL;
    paint: DisplayOps.Color = DisplayOps.Shade[flags];
    fillLength: INTEGER;
    fillcnt1,fillcnt2,fillFudge1,fillFudge2,fillFudge3,fillFudge4,index: INTEGER;
    fill: FillHandle;
    inLeft, outLeft, inRight, outRight, inTop, outTop, inBottom, 
      outBottom: BOOLEAN ¬ FALSE;
    FOR i: CARDINAL IN [0..SpecialDisplay.DashCnt) DO
      widths[i] ¬ dashes.widths[i]; ENDLOOP;
    inc1 ¬ 0;
    inc2 ¬ widths[0]*10;
    inc3 ¬ inc2 + widths[1]*10;
    inc4 ¬ inc3 + widths[2]*10;
    inc5 ¬ inc4 + widths[3]*10;
    inc6 ¬ inc5 + widths[4]*10;
    FOR r: WindowOps.RecList ¬ firstRec, r.link UNTIL r = NIL DO
      IF DisplayOps.Intersect[r, absBounds] THEN {
        int: WindowOps.ScreenBox = [
	  left: MAX[r.box.left, absBounds.left],
	  right: MIN[r.box.right, absBounds.right],
	  top: MAX[r.box.top, absBounds.top],
	  bottom: MIN[r.box.bottom, absBounds.bottom]];
	ctx: Special = WindowOps.GetContext[r, context];
        minBitAddress: LONG ORDERED POINTER = LOOPHOLE[ 
	  ctx.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[int.top], ctx]];
        maxBitAddress: LONG ORDERED POINTER = LOOPHOLE[
	  ctx.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[int.bottom - 1],ctx]];
        minBitIndex: INTEGER ¬ MAX[0, int.left];
        maxBitIndex: INTEGER ¬ int.right - 1;
	IF int.top = int.bottom THEN LOOP;
	IF filled THEN {
	  minBitIndex ¬ MAX[0, minBitIndex];
	  maxBitIndex ¬ absBounds.right;
          fillcnt1 ¬ fillcnt2 ¬ 0;
          fillFudge1 ¬ abs.y - int.top - radius; -- bA1 in fill place
	  fillFudge2 ¬ fillFudge3 ¬ abs.y - int.top; -- bA2, bA3 in fill place
	  fillFudge4 ¬ abs.y - int.top + radius; -- bA4 in fill place
	  fillLength ¬ int.bottom - int.top;
	  fill ¬ ctx.alloc[window, int.top, fillLength];
	  fill.xs[0] ¬ minBitIndex};
        FOR i: CARDINAL IN [0..dashes.thickness) DO  -- for thicking
          error: INTEGER ¬ (radius - 1)/2;
          twoxma: INTEGER ¬ 1;
          twoymb: INTEGER ¬ 2*radius - 1;
          bitAddress1: WindowOps.ScanLine ¬
            LOOPHOLE[ctx.bmAddress + WindowOps.SpecialTimesWpl[
                       INTEGER[abs.y - radius + i], ctx]];
          bitAddress2: WindowOps.ScanLine ¬ LOOPHOLE[
	    ctx.bmAddress + WindowOps.SpecialTimesWpl[INTEGER[abs.y], ctx]];
          bitAddress3: WindowOps.ScanLine ¬ bitAddress2;
          bitAddress4: WindowOps.ScanLine ¬
            LOOPHOLE[ctx.bmAddress + WindowOps.SpecialTimesWpl[
                       INTEGER[abs.y + radius - i], ctx]];
          bitIndex1: INTEGER ¬ abs.x - radius + i;
          bitIndex4: INTEGER ¬ abs.x + radius - i;
          bitIndex2 ¬ bitIndex3 ¬ abs.x;
	  IF circleType[0] THEN {
	    bitIndex1 ¬ bitIndex1 + 1; bitIndex2 ¬ bitIndex2 + 1};
	  IF circleType[1] THEN {
	    bitIndex1 ¬ bitIndex1 - 1; bitIndex2 ¬ bitIndex2 - 1};
	  IF circleType[2] THEN {
	    bitIndex3 ¬ bitIndex3 - 1; bitIndex4 ¬ bitIndex4 - 1};
	  IF circleType[3] THEN {
	    bitIndex3 ¬ bitIndex3 + 1; bitIndex4 ¬ bitIndex4 + 1};
	  IF circleType[4] THEN {
	    bitAddress1 ¬ bitAddress1 + ctx.wpl;
	    bitAddress2 ¬ bitAddress2 + ctx.wpl;
	    fillFudge1 ¬ fillFudge1 + 1;
	    fillFudge2 ¬ fillFudge2 + 1};
	  IF circleType[5] THEN {
	    bitAddress1 ¬ bitAddress1 - ctx.wpl;
	    bitAddress2 ¬ bitAddress2 - ctx.wpl;
	    fillFudge1 ¬ fillFudge1 - 1;
	    fillFudge2 ¬ fillFudge2 - 1};
	  IF circleType[6] THEN {
	    bitAddress3 ¬ bitAddress3 - ctx.wpl; 
	    bitAddress4 ¬ bitAddress4 - ctx.wpl;
	    fillFudge3 ¬ fillFudge3 - 1;
	    fillFudge4 ¬ fillFudge4 - 1};
	  IF circleType[7] THEN {
	    bitAddress3 ¬ bitAddress3 + ctx.wpl;
	    bitAddress4 ¬ bitAddress4 + ctx.wpl;
	    fillFudge3 ¬ fillFudge3 + 1;
	    fillFudge4 ¬ fillFudge4 + 1};
          dashSum ¬ inc6 + widths[5]*10;
          dashCnt ¬ inc2/2;
          UNTIL bitIndex3 > bitIndex4 DO
            IF dashCnt IN [inc1..inc2) OR dashCnt IN [inc3..inc4)  -- dashes
              OR dashCnt IN [inc5..inc6) THEN {
              inL1: BOOLEAN = L[bitAddress1] IN [minBitAddress..maxBitAddress];
              inL2: BOOLEAN = L[bitAddress2] IN [minBitAddress..maxBitAddress];
              inL3: BOOLEAN = L[bitAddress3] IN [minBitAddress..maxBitAddress];
              inL4: BOOLEAN = L[bitAddress4] IN [minBitAddress..maxBitAddress];
              inC1: BOOLEAN = bitIndex1 IN [minBitIndex..maxBitIndex];
              inC2: BOOLEAN = bitIndex2 IN [minBitIndex..maxBitIndex];
              inC3: BOOLEAN = bitIndex3 IN [minBitIndex..maxBitIndex];
              inC4: BOOLEAN = bitIndex4 IN [minBitIndex..maxBitIndex];
              IF inL1 AND inC2 THEN -- sector 8
	        IF filled THEN {
	          index ¬ fillcnt2 + fillFudge1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex2}
                ELSE bitAddress1[bitIndex2] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress1[bitIndex2]);
              IF inL1 AND inC3 THEN -- sector 1
	        IF filled THEN {
		  index ¬ fillcnt2 + fillFudge1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex3}
                ELSE bitAddress1[bitIndex3] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress1[bitIndex3]);
              IF inL2 AND inC1 THEN -- sector 7
	        IF filled THEN {
		  index ¬ fillFudge2 - fillcnt1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex1}
                ELSE bitAddress2[bitIndex1] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress2[bitIndex1]);
              IF inL2 AND inC4 THEN -- sector 2
	        IF filled THEN {
		  index ¬ fillFudge2 - fillcnt1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex4}
                ELSE bitAddress2[bitIndex4] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress2[bitIndex4]);
              IF inL3 AND inC1 THEN  -- sector 6
	        IF filled THEN {
		  index ¬ fillFudge3 + fillcnt1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex1}
                ELSE bitAddress3[bitIndex1] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress3[bitIndex1]);
              IF inL3 AND inC4 THEN -- secter 3
	        IF filled THEN {
		  index ¬ fillFudge3 + fillcnt1;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
	          fill.xs[index] ¬ bitIndex4}
                ELSE bitAddress3[bitIndex4] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress3[bitIndex4]);
              IF inL4 AND inC2 THEN -- secter 5
	        IF filled THEN {
		  index ¬ fillFudge4 - fillcnt2;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex2}
                ELSE bitAddress4[bitIndex2] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress4[bitIndex2]);
              IF inL4 AND inC3 THEN -- sector 4
	        IF filled THEN {
		  index ¬ fillFudge4 - fillcnt2;
		  IF index ~IN [0..fillLength) THEN DisplayOps.LogError[];
		  fill.xs[index] ¬ bitIndex3}
                ELSE bitAddress4[bitIndex3] ¬
                  (SELECT paint FROM white => FALSE, black => TRUE,
                    ENDCASE => ~bitAddress4[bitIndex3])};
	    IF filled THEN  fillcnt1 ¬ fillcnt1 + 1;
            bitIndex2 ¬ bitIndex2 - 1;
            bitIndex3 ¬ bitIndex3 + 1;
            bitAddress2 ¬ bitAddress2 - ctx.wpl;
            bitAddress3 ¬ bitAddress3 + ctx.wpl;
            error ¬ error + twoxma;
            dashCnt ¬ (dashCnt + 10) MOD dashSum;
            IF ABS[newError ¬ error - twoymb] < ABS[error] THEN {
              IF filled THEN fillcnt2 ¬ fillcnt2 + 1;
              error ¬ newError;
              bitIndex1 ¬ bitIndex1 + 1;
              bitIndex4 ¬ bitIndex4 - 1;
              bitAddress1 ¬ bitAddress1 + ctx.wpl;
              bitAddress4 ¬ bitAddress4 - ctx.wpl;
              twoymb ¬ twoymb - 2;
              dashCnt ¬ (dashCnt + 4) MOD dashSum};
            twoxma ¬ twoxma + 2;
            ENDLOOP;
          ENDLOOP};
      ENDLOOP};

  END.