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

%record %format POINTFM (%integer X, Y)
%record %format LINEF (%long %real A, B, C)
%const %integer TRUE = 0,   FALSE = 1
%const %integer CHARLES = 2, HPPLOT=3, Fred=5, BIGHP=12, NEWHP=13, Perq=18
%const %integer WESTWARD=15, SIGMA=16
%const %integer MAX POINT = 100
%own %byte NUM C POINTS = 24
%own %byte CIRCLE MODE = FALSE
%const %integer ON = 1, OFF = 0
%own %byte SHADING = ON

! Routines from EDWIN
%include "edwin:specs.inc"
%external %integer %spec DEVICE
%external %integer %spec CLIPPING
%external %integer %fn %spec MUL DIV (%integer A, B, C)
!%external %routine %spec CHARLES MAP %alias "ED__CHAS_MAP"   (%integer ADR, RED, BLUE, GREEN)
!%external %routine %spec WC2014  MAP %alias "ED__WC2014_MAP" (%integer ADR, RED, BLUE, GREEN)
!%external %routine %spec SIGMA   MAP %alias "ED__SIGMA_MAP"  (%integer ADR, RED, BLUE, GREEN)
!%external %routine %spec DIANA   MAP %alias "ED__DIANA_MAP"  (%integer ADR, RED, BLUE, GREEN)

! IMP Maths routines for VAX and MOUSES
%include "inc:maths.imp"

%external %routine SET SHADE MODE %alias "ED_SHADE_MODE" (%integer ON or OFF)
   SHADING = ON or OFF & 1
%end

%external %routine SET CHORD STEP %alias "ED_SET_CHORD_STEP" (%integer I)
   %if 1<=I<=90 %start
       NUM C POINTS = 360//I
   %finish
%end

%external %routine SET ARC POINTS %alias "ED_ARC_POINTS" (%integer I)
   NUM C POINTS = 8
   NUM C POINTS = I %if I > 8
   NUM C POINTS = MAX POINT-1 %if NUM C POINTS >= MAX POINT
   CIRCLE MODE = TRUE
%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 "ED_POLYGON" (%integer NUM E,
     %record (POINTFM) %array %name AP (1:*))
   %const %integer LAST = 3
   %integer PTR, ANY OUT, STAGE, XL, XR, YB, YT
   %record (POINTFM) FIRST PT
   %record (POINTFM) %array F, S (0:3)
   %byte %integer %array FIRST OF, OUT (0:3)
   %record (POINTFM) %array FF (1:256)

   %routine GET RID OF (%record (POINTFM) %name P)
      %if ANY OUT=FALSE %start
          DRIVE DEV (10, 3, 0) %if SHADING=ON
          MOVE ABS (P_X, P_Y)
          FIRST PT = P
          ANY OUT = TRUE
      %finish
      LINE ABS (P_X, P_Y)
   %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
       %finish %else %start
           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

   %if NUM E = 0 %start
       %return { Wasn't worth comming here }
   %finish %else %if NUM E = 1 %start
       MARKER ABS (0, AP(1)_X, AP(1)_Y)
   %finish %else %if NUM E = 2 %start
       MOVE ABS (AP(1)_X, AP(1)_Y)
       LINE ABS (AP(2)_X, AP(2)_Y)
   %else
       NUME = NUME - 1 %if AP(1)_X = AP(NUME)_X %and AP(1)_Y = AP(NUME)_Y
       INQUIRE WINDOW (XL, XR, YB, YT)
       %if DEVICE=FRED %and NUME <= 255 %and shading=on %start
           ANY OUT = TRUE
           %for STAGE = 1, 1, NUME %cycle
             ANY OUT = FALSE %unless XL <= AP(STAGE)_X %and XR >= AP(STAGE)_X %c
                             %and    YB <= AP(STAGE)_Y %and YT >= AP(STAGE)_Y
           %repeat
           %if ANY OUT = TRUE %start
               ! All the shape is in the window.
               %for STAGE = 1, 1, NUME %cycle
                    FF (STAGE) = AP (STAGE)
                    MAP TO DEVICE COORDS (FF(STAGE)_X, FF(STAGE)_Y)
               %repeat
               DRIVE DEV (15, NUME, ADDR(FF(1)))
               %return
           %finish
       %finish
       ANY OUT = FALSE
       %if CLIPPING>=0 %start; ! Only clip if the user asks to
           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
       %finish %else %start
           GET RID OF (AP(PTR)) %for PTR = 1, 1, NUM E
       %finish
       GET RID OF (FIRST PT); ! To close the polygon.
       DRIVE DEV (10, 1, 0)
   %finish
%end

%external %routine CIRCLE %alias "ED_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
   %long %real RV, R, ITA, CONT
   %record (POINTFM) %array PTS (1:NUM C POINTS + 1)

   %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

   %if DEVICE=HPPLOT %or DEVICE=BIGHP %or DEVICE=NEWHP %c
                     %or (DEVICE=Fred %and SHADING=ON) %start
       I = 0;   Y = 0
       MAP TO DEVICE COORDS (I, Y)
       MAP TO DEVICE COORDS (RAD, Y)
       DRIVE DEV (14, |I-RAD|, 0)      { Hardware circle }
       %return
   %finish

   ITA = 360/NUM C POINTS
   R = RAD*(2-COS(ITA/2/DtoR))
   INQUIRE POSITION (PX, PY)
   PTS(1)_X = PX + INT(R)
   PTS(1)_Y = PY
   CONT = ITA
   I = 2
   %cycle
      RV=CONT/DtoR
      PTS(I)_X = PX + INT(R*COS(RV))
      PTS(I)_Y = PY + INT(R*SIN(RV))
      CONT = CONT + ITA
      %exit %if CONT>360
      I = I + 1
   %repeat
   POLYGON (I, PTS)
   MOVE ABS (PX, PY)
%end

%external %routine RECTANGLE %alias "ED_RECTANGLE" (%integer XL, YL, XU, YU)
   ! This draws a rectangle.

   %if SHADING=OFF %or (DEVICE#CHARLES %and DEVICE#Fred %and DEVICE#WESTWARD %c
                   %and DEVICE#SIGMA %and DEVICE#Perq) %start
       MOVE ABS (XL, YL)
       LINE ABS (XU, YL);   LINE ABS (XU, YU);   LINE ABS (XL, YU);   LINE ABS (XL, YL)
   %finish %else %start
       MAP TO DEVICE COORDS (XL, YL)
       DRIVE DEV (12, XL, YL)
       MAP TO DEVICE COORDS (XU, YU)
       DRIVE DEV (13, XU, YU)
   %finish
%end

%external %routine BOX %alias "ED_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)
   %finish %else %start
       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 "ED_WIRE" (%integer W, N,
     %record (POINTFM) %array %name P (1:1000))
   ! 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 (LINEF) LNEW, LLAST, LBEGIN, LEND, MLLAST, MLNEW, LBEGINP, LENDP

   %routine BREAK UP WIRE (%integer W, N,
        %record (POINTFM) %array %name P (1:1000))
      ! 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(X)
           D_Y = INT(Y)
           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 (LINEF) %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 (LINEF) %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 (LINEF) %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(LINEF) %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 (LINEF) %name LINE, NLINE, %record (POINTFM) P)
      ! Forms the perpendicular of LINE, passing through point P.

      %record (LINEF) 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

   %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 CIRCLE MODE=TRUE

   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)
   PERP THROUGH (LEND, LENDP, P(N))
   INFLATE (LENDP, LENDP, HWIDTH)

   ! 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

%external %routine SET COLOUR MAP %alias "ED_SET_COLOUR_MAP" (%integer ADR, RED, BLUE, GREEN)
!   %if DEVICE=CHARLES %start
!       CHARLES MAP (ADR, RED, BLUE, GREEN)
!   %finish %else %if DEVICE=SIGMA %start
!       SIGMA MAP (ADR, RED, BLUE, GREEN)
!   %finish %else %if DEVICE=WESTWARD %start
!       WC2014 MAP (ADR, RED, BLUE, GREEN)
!   %finish %else %if DEVICE=Fred %start
!       DIANA MAP (ADR, RED, BLUE, GREEN)
!   %finish
%end

! Utilties to draw ARCs and SECTORs

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

   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 "ED_ARC" (%integer OX, OY, RAD, START ANG, END ANG)
   %record (POINTFM) %array P (1:361)
   %integer PTR, I
   PTR = 1
   FIND POINTS (RAD, 360//NUM C POINTS, 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 "ED_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, 360//NUM C POINTS, 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
