    ! The EDWIN BOX and WIRE routines for CIF drawing

    !############################################################################
    !#                                                                          #
    !#  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
    include "imp_include:maths.inc"

    ! Routines from EDWIN
    include "edwin_dir:specs.inc"
    include "edwin_dir:shapes.inc"

    const integer True = 1, False = 0
    own integer WIRE MODE = EXTENDED ENDS

    external routine SET WIRE MODE alias "EDWIN_SET_WIRE_MODE" (integer MODE)
       if FLAT ENDS <= MODE <= ROUND ENDS start
           WIRE MODE = MODE
       else
           WIRE MODE = EXTENDED ENDS
       finish
    end

    external routine BOX alias "EDWIN_BOX" (integer L, W, record (POINTFM) name C, D)
       ! This routines draws a box of length L, width W at centre C with direction D.

       integer I
       record (POINTFM) PL, PU
       record (POINTFM) array PTS (1:4)
       long real THETA, LC, WC, LS, WS

       if D_X=0 or D_Y=0 start
           if D_Y#0 start
               I = L;   L = W;   W = I
           finish
           RECTANGLE (C_X - L//2, C_Y - W//2, C_X + L//2, C_Y + W//2)
       else
           THETA = ARCTAN (D_X, D_Y)
           LC = L * COS (THETA)
           WC = W * COS (THETA)
           LS = L * SIN (THETA)
           WS = W * SIN (THETA)
           PTS(1)_X = C_X - int((LC + WS)/2)
           PTS(1)_Y = C_Y + int((WC - LS)/2)
           PTS(2)_X = C_X + int((LC - WS)/2)
           PTS(2)_Y = C_Y + int((WC + LS)/2)
           PTS(3)_X = C_X + int((LC + WS)/2)
           PTS(3)_Y = C_Y - int((WC - LS)/2)
           PTS(4)_X = C_X - int((LC - WS)/2)
           PTS(4)_Y = C_Y - int((WC + LS)/2)
           POLYGON (4, PTS)
       finish
    end

    external routine WIRE alias "EDWIN_WIRE" (integer W, N, record (POINTFM) array name P)
       ! This routine converts a wire to a POLYGON.
       ! wire width is given by W, and the wire has N points specifying it,
       ! whose coordinates are given in P.
       ! Algorithm is based on the SIMULA one in CIF20P.

       integer I, NUM IN, NUM OUT
       long real HWIDTH
       record (POINTFM) array IN (1:N)
       record (POINTFM) array OUT (1:2*N+2)
       record (LINEFM) LNEW, LLAST, LBEGIN, LEND, MLLAST, MLNEW, LBEGINP, LENDP

       routine BREAK UP WIRE (integer W, N, record (POINTFM) array name P)
          ! Break up the wire into some boxes, with circles over the points.
          record (POINTFM) P1, P2, D, C
          integer I, L
          long real X, Y

          routine SWAP (record (POINTFM) name A, B)
              record (POINTFM) C
              C = A;   A = B;   B = C;
          end

          for I=1,1,N-1 cycle
               P1 = P(I)
               P2 = P(I+1)
               ! Orthogonal boxes?
               if P1_X = P2_X start
                   SWAP (P1, P2) if P1_Y > P2_Y
                   RECTANGLE (P1_X-W//2, P1_Y, P1_X + W//2, P2_Y)
                   continue
               finish
               if P1_Y = P2_Y start
                   SWAP (P1, P2) if P1_X > P2_X
                   RECTANGLE (P1_X, P1_Y-W//2, P2_X, P1_Y+W//2)
                   continue
               finish
               ! Arbitary Box
               X = P2_X - P1_X
               Y = P2_Y - P1_Y
               L = INT ( SQRT ( X*X + Y*Y))
               C_X = P1_X + INT(X/2)
               C_Y = P1_Y + INT(Y/2)
               D_X = INT(Y)
               D_Y = - INT(X)
               BOX (W, L, C, D)
          repeat
          MOVE ABS (P(I)_X, P(I)_Y) and CIRCLE (W//2) for I=N, -1, 1
       end

       integer fn EQ (long real A, B)
          result = TRUE if A - 0.05 < B < A + 0.05
          result = FALSE
       end

       routine NORMALISE (record (LINEFM) name LINE)
          ! This normalises the line equation on the creation of a new line.

          long real D

          D = SQRT (LINE_A¬2 + LINE_B¬2)
          return if EQ(D,0)=TRUE

          LINE_A = LINE_A/D
          LINE_B = LINE_B/D
          LINE_C = LINE_C/D
       end

       routine MAKE LINE (record (POINTFM) name P1, P2, record (LINEFM) name LINE)
          ! given the points P1 & P2 compute the line equation in a b c  form.

          LINE_A = P2_Y - P1_Y
          LINE_B = - ( P2_X - P1_X)
          LINE_C = - LINE_A*P1_X - LINE_B*P1_Y
          if EQ(LINE_A,0)=TRUE and EQ(LINE_B,0)=TRUE and EQ(LINE_C,0)=TRUE start
              LINE_B = -1
              LINE_C = P1_Y
          finish
          NORMALISE (LINE)
       end

       routine INFLATE (record (LINEFM) name LINE, NLINE, long real W)
          ! Inflate LINE by width W

          NLINE = LINE
          NLINE_C = NLINE_C + W
          NORMALISE (NLINE)
       end

       integer fn INTERSECT (record(LINEFM) name L1, L2, record (POINTFM) name P)
          ! TRUE if lines intersect, and P gets the intersection point.
          ! otherwise FALSE.

          long real D
          long real TX, TY

          D = L1_A*L2_B - L2_A*L1_B
          result = FALSE if EQ(D,0)=TRUE

          TX = (L1_B*L2_C - L2_B*L1_C)/D
          TY = (L2_A*L1_C - L1_A*L2_C)/D
          P_X = int(TX)
          P_Y = int(TY)
          result = TRUE
       end

       routine PERP THROUGH (record (LINEFM) name LINE, NLINE, record (POINTFM) P)
          ! Forms the perpendicular of LINE, passing through point P.

          record (LINEFM) TLINE

          TLINE = LINE
          TLINE_A = LINE_B
          TLINE_B = - LINE_A
          TLINE_C = -TLINE_A*P_X - TLINE_B*P_Y
          NORMALISE (TLINE)
          NLINE = TLINE
       end

       return if N = 0
       if W=0 start;   ! This is a POLY-LINE
           MOVE ABS (P(1)_X, P(1)_Y)
           LINE ABS (P(I)_X, P(I)_Y) for I = 2, 1, N
           return
       finish
       MOVE ABS (P(1)_X, P(1)_Y) and CIRCLE (W//2) and return if N = 1
       BREAK UP WIRE (W, N, P) and return if WIRE MODE = ROUND ENDS

       HWIDTH = W/2
       NUM IN = 2
       NUM OUT = 2
       MAKE LINE (P(1), P(2), LBEGIN)
       LNEW = LBEGIN

       for I=2,1,N-1 cycle
            LLAST = LNEW
            MAKE LINE (P(I), P(I+1), LNEW)

            INFLATE (LLAST, MLLAST, H WIDTH)
            INFLATE (LNEW, MLNEW, HWIDTH)
            NUM OUT = NUM OUT + 1 if INTERSECT (MLLAST, MLNEW, OUT(NUM OUT)) = TRUE

            INFLATE (LLAST, MLLAST, - HWIDTH)
            INFLATE (LNEW, MLNEW, - HWIDTH)
            NUM IN = NUM IN + 1 if INTERSECT (MLLAST, MLNEW, IN(NUM IN)) = TRUE
       repeat
       LEND = LNEW

       PERP THROUGH (LBEGIN, LBEGINP, P(1))
       INFLATE (LBEGINP, LBEGINP, - HWIDTH) if WIRE MODE # FLAT ENDS
       PERP THROUGH (LEND, LENDP, P(N))
       INFLATE (LENDP, LENDP, HWIDTH) if WIRE MODE # FLAT ENDS

       ! Compute end intersections.
       INFLATE (LBEGIN, MLNEW, HWIDTH)
       signal 14,7 unless INTERSECT (LBEGIN P, MLNEW, OUT (1)) = TRUE
       INFLATE (LBEGIN, MLNEW, - HWIDTH)
       signal 14,7 unless INTERSECT (LBEGIN P, MLNEW, IN (1)) = TRUE
       INFLATE (LEND, MLNEW, HWIDTH)
       signal 14,7 unless INTERSECT (LEND P, MLNEW, OUT (NUM OUT)) = TRUE
       INFLATE (LEND, MLNEW, - HWIDTH)
       signal 14,7 unless INTERSECT (LEND P, MLNEW, IN (NUM IN)) = TRUE

       ! make a set of ordered points from IN & OUT lists.
       N = NUM OUT
       N = N + 1 and OUT(N) = IN(I) for I=NUM IN, -1, 1
       POLYGON (N, OUT)
    end

    end of file