    ! Geometric Utilities for EDWIN, capitalising on device specific features.

    !############################################################################
    !#                                                                          #
    !#  This is a module from the EDWIN Graphics Package, which was developed   #
    !#  in the Department of Computer Science, at Edinburgh University, from    #
    !#  1978 to the present day, release 5 of EDWIN in October 1984.            #
    !#                                                                          #
    !#  The principal author of the EDWIN Graphics Package was J Gordon Hughes, #
    !#  while working for the Edinburgh University Computer Sceince Department. #
    !#  Parts of EDWIN have been produced by many different people, too many    #
    !#  too mention, working for different departments of Edinburgh and Leeds   #
    !#  Universities.                                                           #
    !#                                                                          #
    !#  This module is regarded as being in the public domain, and the authors  #
    !#  and accept no responsibility regarding the uses to which the software   #
    !#  will be put.                                                            #
    !#                                                                          #
    !############################################################################

    record format POINTFM (integer X, Y)
    record format LINEFM (long real A, B, C)

    ! IMP Maths routines
    from Imp include maths

    ! Routines from EDWIN
    from Edwin include consts
    from Edwin include specs
    from Edwin include shapes
    from Edwin include iprocs
    from Edwin include icodes

    const integer MAX POINT = 360

    external routine RECTANGLE alias "EDWIN_RECTANGLE" (integer XL, YL, XU, YU)
       ! This draws a rectangle.
       integer SHADE MODE

       PDF INSERT (13, XL, YL);   PDF INSERT (13, XU, YU)

       GET ATTRIBUTE (ATT SHADE MODE, SHADE MODE)
       if SHADE MODE = OUTLINE start
           CLIP (XL, YL, 0)
           CLIP (XU, YL, 1);   CLIP (XU, YU, 1)
           CLIP (XL, YU, 1);   CLIP (XL, YL, 1)
       else
           MAP TO DEVICE COORDS (XL, YL)
           DRIVE DEVICE (12, XL, YL)
           MAP TO DEVICE COORDS (XU, YU)
           DRIVE DEVICE (13, XU, YU)
       finish
    end

    ! This is a routine for drawing clipped polygons, using the Sutherland-
    ! Hodgman algorithm, CACM Vol 17, Page 32, Jan 74.

    external routine POLYGON alias "EDWIN_POLYGON" (integer NUM E, record (POINTFM) array name AP)
       const integer LAST = 3
       integer PTR, ANY OUT, STAGE, XL, XR, YB, YT, SHADE MODE, L, W
       record (POINTFM) FIRST PT, C, D
       record (POINTFM) array F, S (0:3)
       byte integer array FIRST OF, OUT (0:3)

       routine GET RID OF (record (POINTFM) name P)
          if ANY OUT=FALSE start
              DRIVE DEVICE (10, 3, 0) if SHADE MODE#OUTLINE
              CLIP (P_X, P_Y, 0)
              FIRST PT = P
              ANY OUT = TRUE
          finish
          CLIP (P_X, P_Y, 1)
       end

       routine spec DEAL WITH POINT (record (POINTFM) name P)

       routine OUTPUT (record (POINTFM) name P)
          OUT (STAGE) = TRUE
          GET RID OF (P) and return if STAGE = LAST
          STAGE = STAGE + 1
          DEAL WITH POINT (P)
          STAGE = STAGE - 1
       end

       integer fn INTERSECT (record (POINTFM) name S,P)
          ! Note if point is on the line it is assumed to intersect it.
          switch SW(0:3)
          -> SW(STAGE)

       SW(0): ! XL
              result = TRUE if S_X<=XL<P_X or P_X<=XL<S_X
              result = FALSE

       SW(2): ! XR
              result = TRUE if S_X<=XR<P_X or P_X<=XR<S_X
              result = FALSE
       SW(1): ! YB
              result = TRUE if S_Y<=YB<P_Y or P_Y<=YB<S_Y
              result = FALSE

       SW(3): ! YT
              result = TRUE if S_Y<=YT<P_Y or P_Y<=YT<S_Y
              result = FALSE
       end

       integer fn visible (record (POINTFM) name S)
          switch SW(0:3)
          -> SW(STAGE)

       SW(0): result = TRUE if S_X>=XL
              result = FALSE

       SW(2): result = TRUE if S_X<=XR
              result = FALSE

       SW(1): result = TRUE if S_Y>=YB
              result = FALSE

       SW(3): result = TRUE if S_Y<=YT
              result = FALSE
       end

       routine compute intersect (record (POINTFM) name I, P, S)
          ! Computes intersect I from points P and S.
          switch SW(0:3)
          -> SW(STAGE)

       SW(0): I_X = XL
              I_Y = MUL DIV (P_Y-S_Y, XL-S_X, P_X-S_X) + S_Y
              return

       SW(2): I_X = XR
              I_Y = MUL DIV (P_Y-S_Y, XR-S_X, P_X-S_X) + S_Y
              return

       SW(1): I_X = MUL DIV (P_X-S_X, YB-S_Y, P_Y-S_Y) + S_X
              I_Y = YB
              return

       SW(3): I_X = MUL DIV (P_X-S_X, YT-S_Y, P_Y-S_Y) + S_X
              I_Y = YT
       end

       routine DEAL WITH INTERSECT (record (POINTFM) name P)
           record (POINTFM) I

           if FIRST OF (STAGE)=TRUE start
               COMPUTE INTERSECT (I, P, S(STAGE)) and OUTPUT (I) if INTERSECT (P, S(STAGE)) = TRUE
           else
               F(STAGE) = P
               FIRST OF (STAGE) = TRUE
           finish
       end

       routine DEAL WITH POINT (record (POINTFM) name P)
           DEAL WITH INTERSECT (P)
           S(STAGE) = P
           OUTPUT (P) if VISIBLE (P) = TRUE
       end

       ANY OUT = FALSE
       GET ATTRIBUTE (ATT SHADE MODE, SHADE MODE)
       NUM E = NUM E - 1 if AP(NUM E)_X=AP(1)_X and AP(NUM E)_Y=AP(1)_Y
       if NUM E = 4 start
           ! It is 4 sided, but is it worth making it an orthogonal box?
           if AP(1)_X = AP(2)_X and AP(2)_Y = AP(3)_Y and -
               AP(3)_X = AP(4)_X and AP(4)_Y = AP(1)_Y start
               L = |AP(2)_X - AP(3)_X|
               W = |AP(1)_Y - AP(2)_Y|
               if REM(L,2)=0 and REM(W,2)=0 start { No rounding would arise }
                   if AP(2)_X > AP(3)_X then C_X = AP(3)_X else C_X = AP(2)_X
                   C_X = C_X + L//2
                   if AP(2)_Y > AP(1)_Y then C_Y = AP(1)_Y else C_Y = AP(2)_Y
                   C_Y = C_Y + W//2
                   -> Do As Polygon if L=0 or W=0 { Co-incident points }
                   Rectangle (AP(1)_x, AP(1)_y, AP(3)_x, AP(3)_y)
                   return
               finish
           else if AP(1)_Y = AP(2)_Y and AP(2)_X = AP(3)_X and -
                     AP(3)_Y = AP(4)_Y and AP(4)_X = AP(1)_X
               L = |AP(1)_X - AP(2)_X|
               W = |AP(2)_Y - AP(3)_Y|
               if REM(L,2)=0 and REM(W,2)=0 start { No rounding would arise }
                   if AP(2)_X > AP(1)_X then C_X = AP(1)_X else C_X = AP(2)_X
                   C_X = C_X + L//2
                   if AP(2)_Y > AP(3)_Y then C_Y = AP(3)_Y else C_Y = AP(2)_Y
                   C_Y = C_Y + W//2
                   -> Do As Polygon if L=0 or W=0 { Co-incident points }
                   Rectangle (AP(1)_x, AP(1)_y, AP(3)_x, AP(3)_y)
                   return
               finish
           finish
       finish
       Do as Polygon:
       if STORING>=0 start;   ! Optimise the adding of the points to the PDF
           STAGE = OUTPUT STREAM
           SELECT OUTPUT (STORING)
           WRITE (6, 1);   WRITE (NUME, 1)
           for PTR = 1, 1, NUME cycle
              WRITE (AP(PTR)_X, 1)
              WRITE (AP(PTR)_Y, 1)
              NEWLINE if PTR&7=0
           repeat
           NEWLINE
           SELECT OUTPUT (STAGE)
       finish
       if Shade Mode = Outline start
           CLIP (AP(1)_X, AP(1)_Y, 0)
           for PTR = 1, 1, NUME cycle
              CLIP (AP(PTR)_X, AP(PTR)_Y, 1)
           repeat
           CLIP (AP(1)_X, AP(1)_Y, 1)
       else
           if CLIPPING>=0 start;   ! Only clip if the user asks to
               INQUIRE WINDOW (XL,XR,YB,YT)
               STAGE = 0
               FIRST OF (PTR) = FALSE and OUT(PTR) = FALSE for PTR=0,1,3
               DEAL WITH POINT (AP(PTR)) for PTR = 1,1,NUM E
               for STAGE = 0,1,3 cycle
                   DEAL WITH INTERSECT (F(STAGE)) if OUT(STAGE) = TRUE
               repeat
               return unless ANYOUT=TRUE
           else
               GET RID OF (AP(PTR)) for PTR = 1,1,NUM E
           finish
           GET RID OF (FIRST PT); ! To close the polygon.
           DRIVE DEVICE (10, 1, 0)
       finish
    end

    external routine CIRCLE alias "EDWIN_CIRCLE" (integer RAD)
       ! RAD is the radius.
       ! The circle is INSIDE the polygon.
       ! The circle drawing routine is based on an original one by JRCC.

       const real D TO R = 57.2958;   ! Magic number converts degrees to rads.
       integer I, X, Y, W, XL, XR, YB, YT, PX, PY, DEVICE, CHORD STEP, STORE
       integer SHADE MODE
       long real RA, RR, CONT
       record (POINTFM) array PTS (1:361)

       PDF INSERT (14, RAD, 0)

       if CLIPPING>=0 start
           INQUIRE POSITION (PX, PY)
           INQUIRE WINDOW (XL, XR, YB, YT)
           return unless XL-RAD <= PX <= XR+RAD and YB-RAD <= PY <= YT+RAD
       finish

       DEVICE = DEVICE DATA_DEV NO
       GET ATTRIBUTE (ATT SHADE MODE, SHADE MODE)
       if DEVICE=HP Plotter or DEVICE=X5A or DEVICE=Versatec or c
           DEVICE=Postscript {%or DEVICE=??? %or DEVICE=???} start
           I = 0;   Y = 0
           MAP TO DEVICE COORDS (I, Y)
           MAP TO DEVICE COORDS (RAD, Y)
           DRIVE DEVICE (14, |I-RAD|, 0)      { Hardware circle }
           return
       finish

       GET ATTRIBUTE (ATT CHORD STEP, CHORD STEP)
       STORE = STORING;   STORING = -1
       INQUIRE POSITION (PX, PY)
       RR = RAD * (2 - Cos(CHORD STEP/2/DtoR))
       PTS(1)_X = PX + INT(RR)
       PTS(1)_Y = PY
       CONT = CHORD STEP
       I = 2
       cycle
          RA =  CONT / DtoR
          PTS(I)_X = PX + INT(RR * COS(RA))
          PTS(I)_Y = PY + INT(RR * SIN(RA))
          CONT = CONT + CHORD STEP
          exit if CONT>360
          I = I + 1
       repeat
       POLYGON (I, PTS)
       MOVE ABS (PX, PY)
       STORING = STORE
    end

    ! Utilties to draw ARCs and SECTORs

    routine FIND POINTS (integer RAD, CX, CY, SA, FA, integer name PTR,
                          record (POINTFM) array name AP)
       integer A, STEP

       GET ATTRIBUTE (ATT CHORD STEP, STEP)
       A = SA
       cycle
          AP(PTR)_X = int(Rad * Cos(A/DtoR)) + CX
          AP(PTR)_Y = int(Rad * Sin(A/DtoR)) + CY
          exit if A = FA
          PTR = PTR + 1
          if SA < FA start
              A = A + STEP
              A = FA if A > FA
          else
              A = A - STEP
              A = FA if A < FA
          finish
       repeat
    end

    external routine ARC alias "EDWIN_ARC" (integer OX, OY, RAD, START ANG, END ANG)
       record (POINTFM) array P (1:361)
       integer PTR, I
       PTR = 1
       FIND POINTS (RAD, OX, OY, START ANG, END ANG, PTR, P)
       MOVE ABS (P(1)_X, P(1)_Y)
       LINE ABS (P(I)_X, P(I)_Y) for I=2,1,PTR
    end

    external routine SECTOR alias "EDWIN_SECTOR" (integer OX, OY, RAD, START ANG, END ANG)
       record (POINTFM) array P (1:363)
       integer PTR
       P(1)_X = OX;   P(1)_Y = OY
       PTR = 2
       FIND POINTS (RAD, OX, OY, START ANG, END ANG, PTR, P)
       PTR = PTR + 1
       P (PTR)_X = OX;  P(PTR)_Y = OY
       POLYGON (PTR, P)
    end

    end of file