! Geometric Utilities for EDWIN, capitalising on device specific features.
!
!%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:consts.inc"
!%include "edwin_dir:specs.inc"
!%include "edwin_dir:shapes.inc"
!%include "edwin.dd"
!%external %routine %spec CHARLES MAP %alias "EDWIN___C_MAP" (%integer A, R, B, G)
!%external %routine %spec WC2014  MAP %alias "EDWIN___W_MAP" (%integer A, R, B, G)
!%external %routine %spec SIGMA   MAP %alias "EDWIN___S_MAP" (%integer A, R, B, G)
!%external %routine %spec X5A     MAP %alias "EDWIN___X_MAP" (%integer A, R, B, G)
!%external %integer %spec CLIPPING    %alias "EDWIN___CLIPPING"
!%external %integer %spec STORING     %alias "EDWIN___STORING"

%const %integer MAX POINT = 360
!%const %integer TRUE = 0,   FALSE = 1

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

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

   DEVICE = DEVICE DATA_DEV NO
   GET ATTRIBUTE (ATT SHADE MODE, SHADE MODE)
   %if SHADE MODE = OUTLINE %or (DEVICE#CHARLES %and DEVICE#APMLevel1 %c
         %and DEVICE#WESTWARD %and DEVICE#SIGMA %and DEVICE#Gigi %c
         %and device#APMlevel2 %and DEVICE#BBC Micro %and DEVICE#X5A) %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, DEVICE, SHADE MODE
   %record (POINTFM) FIRST PT
   %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
   DEVICE = DEVICE DATA_DEV NO
   GET ATTRIBUTE (ATT SHADE MODE, SHADE MODE)
   %if STORING>=0 %start; ! Optimise the adding of the points to the PDF
       STAGE = OUT 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 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) %if SHADE MODE # OUTLINE
%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
   %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 CHORD STEP, CHORD STEP)
   %if DEVICE=HP Plotter %or DEVICE=BBC Micro %or DEVICE=APM Level 1 %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

   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

%external %routine SET COLOUR MAP %alias "EDWIN_SET_COLOUR_MAP" (%integer ADR, RED, BLUE, GREEN)
!   %integer DEVICE
!   DEVICE = DEVICE DATA_DEV NO
!   %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=X5A %start
!       X5A MAP (ADR, RED, BLUE, GREEN)
!   %finish
%end

%end %of %file
