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