-- Copyright (C) 1983, 1984  by Xerox Corporation. All rights reserved. 
-- DisplayImplG.mesa - last edited by 
--  Poskanzer	29-Sep-83 13:05:18 
--  Rick 	28-Oct-83 15:32:22
--  Daniels 	 7-Jun-84 14:58:39

DIRECTORY
  BitBlt USING [BITBLT, BitBltFlags, GrayParm],
  Display USING [Brick, fiftyPercent],
  DisplayFormat USING [CircleType],
  DisplayInternal USING [],
  DisplayOps USING [AbsPlace, FillList, FillObject, Intersect],
  Inline USING [DIVMOD],
  SpecialDisplay USING [defaultContext, LineStyle, Special],
  Window USING [BoxHandle, Place],
  WindowOps USING [
    AbsoluteBoxHandle, bbPtr, Bounds, GetContext, lock, Object,
    RecList, ScreenBox, SpecialTimesWpl];

DisplayImplG: MONITOR LOCKS WindowOps.lock
  IMPORTS BitBlt, DisplayOps, Inline, SpecialDisplay, WindowOps
  EXPORTS DisplayOps, 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;

  -- filled circles

  LineBlt: PROCEDURE [
    aLeft, aRight, aY: INTEGER, gray: Display.Brick, flags: BitBlt.BitBltFlags,
    window: Handle, r: WindowOps.RecList,
    context: SpecialDisplay.Special ← SpecialDisplay.defaultContext] =
    BEGIN
    left: INTEGER = MAX[r.box.left, aLeft];
    top: INTEGER = MAX[r.box.top, aY];
    right: INTEGER = MIN[r.box.right, aRight + 1];
    bottom: INTEGER = MIN[r.box.bottom, aY + 1];
    width: INTEGER = right - left;
    height: INTEGER = bottom - top;
    ctx: SpecialDisplay.Special = WindowOps.GetContext[r, context];
    offset, bit, yOffset: INTEGER;
    IF width <= 0 OR height <= 0 THEN RETURN;
    yOffset ← (top - window.place.y) MOD gray.LENGTH;
    [quotient: offset, remainder: bit] ← Inline.DIVMOD[left, 16];
    WindowOps.bbPtr↑ ← [
      dst: [
      word: ctx.bmAddress + WindowOps.SpecialTimesWpl[top, ctx] + offset,
      bit: bit],
      src: [word: gray.BASE + yOffset, bit: (left - window.place.x) MOD 16],
      srcDesc: [
      gray[
      BitBlt.GrayParm[
      yOffset: yOffset, widthMinusOne: 0, heightMinusOne: gray.LENGTH - 1]]],
      dstBpl: ctx.bpl, width: width, height: height, flags: flags];
    BitBlt.BITBLT[WindowOps.bbPtr];
    END;

  SpecialFilledCircle: PUBLIC ENTRY PROC [
    window: Handle, place: Window.Place, radius: INTEGER, gray: Display.Brick,
    flags: BitBlt.BitBltFlags, circleType: DisplayFormat.CircleType,
    bounds: Window.BoxHandle,
    context: Special ← SpecialDisplay.defaultContext] = {
    ENABLE UNWIND => NULL;
    firstRec: WindowOps.RecList = DisplayOps.FillList[window, FALSE];
    IF gray = Display.fiftyPercent THEN gray ← DESCRIPTOR[fifty];
    SpFilledCircleInternal[
      firstRec, window, place, radius, gray, flags, circleType, bounds,
      context]};

  fifty: ARRAY [0..2) OF CARDINAL ← [125252B, 52525B];

  SpFilledCircleInternal: INTERNAL PROC [
    firstRec: WindowOps.RecList, window: Handle, place: Window.Place,
    radius: INTEGER, gray: Display.Brick, flags: BitBlt.BitBltFlags,
    circleType: DisplayFormat.CircleType, bounds: Window.BoxHandle,
    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 xes are maintained to determine xys in
    -- all eight octants.  Scanlines start top, middle, middle, bottom. xes
    -- start left, middle, middle, right.  All end on the 45s.
    absBounds: WindowOps.ScreenBox =
      IF bounds = NIL THEN WindowOps.Bounds[window]
      ELSE WindowOps.AbsoluteBoxHandle[window, bounds];
    abs: Window.Place = DisplayOps.AbsPlace[window, place];
    newError: INTEGER;
    twoRadius: INTEGER ← 2*radius;
    FOR r: WindowOps.RecList ← firstRec, r.link UNTIL r = NIL DO
      IF DisplayOps.Intersect[r, absBounds] THEN {
        ctx: Special = WindowOps.GetContext[r, context];
        minY: INTEGER = r.box.top;
        maxY: INTEGER = r.box.bottom - 1;
        minX: INTEGER = r.box.left;
        maxX: INTEGER = r.box.right - 1;
        error: INTEGER ← (radius - 1)/2;
        twoxma: INTEGER ← 1;
        twoymb: INTEGER ← 2*radius - 1;
        y1: INTEGER ← abs.y - radius;
        y2, y3: INTEGER ← abs.y;
        y4: INTEGER ← abs.y + radius;
        x1: INTEGER ← abs.x - radius;
        x2, x3: INTEGER ← abs.x;
        x4: INTEGER ← abs.x + radius;
        UNTIL x3 > x4 DO
          IF y1 IN [minY..maxY] THEN
            LineBlt[
              MAX[x2, minX], MIN[x3, maxX], y1, gray, flags, window, r,
              context];
          IF y2 IN [minY..maxY] THEN
            LineBlt[
              MAX[x1, minX], MIN[x4, maxX], y2, gray, flags, window, r,
              context];
          IF y3 IN [minY..maxY] THEN
            LineBlt[
              MAX[x1, minX], MIN[x4, maxX], y3, gray, flags, window, r,
              context];
          IF y4 IN [minY..maxY] THEN
            LineBlt[
              MAX[x2, minX], MIN[x3, maxX], y4, gray, flags, window, r,
              context];
          x2 ← x2 - 1;
          x3 ← x3 + 1;
          y2 ← y2 - 1;
          y3 ← y3 + 1;
          error ← error + twoxma;
          IF ABS[newError ← error - twoymb] < ABS[error] THEN {
            error ← newError;
            x1 ← x1 + 1;
            x4 ← x4 - 1;
            y1 ← y1 + 1;
            y4 ← y4 - 1;
            twoymb ← twoymb - 2};
          twoxma ← twoxma + 2;
          ENDLOOP};
      ENDLOOP};

  END.