! EDWIN 4.3  June 1982

! This main module of EDWIN should be portable to any other machine
! with no source changes, except that on systems such as RSX where
! a small limit on the number of significant characters in external
! linkage, the folowing ECCE command must be applied to it -
!    F/{/ed/}/
! Note this means that any alterations to this module MUST NOT use
! The IMP {} comment convention.

%include "ecsc03.subsyss_iospecs"

%const %integer TRUE = 0,   FALSE = 1

%include "CONFIG"

%include "UTILITY"

%include "CHARSPEC"

! Constants
%const %integer OFF = -1

! control
%own %integer STORING = OFF;! Current stream for storing
%own %integer VIS = 0;      ! Current Char visibility
%const %integer %array RA (0:3) = 0, 5, 3, 6
%own %integer %array ATTRIBUTES (0:15) = 1,0,12,0,0,0,90,5,36,0,0,0,0,0,0,1

! Screen information
%own %integer XO = 0;      ! Origin (bottom left) of device window
%own %integer YO = 0
%own %integer XS = 1023;   ! Size of device window
%own %integer YS = 1023
%own %integer CX = 0;      ! Current virtual position
%own %integer CY = 0
%own %integer XV = 1023;   ! Size of virtual window
%own %integer YV = 1023
%own %integer XL = 0;      ! Origin of virtual window (Left edge)
%own %integer XR = 1023;   ! (Right edge)
%own %integer YB = 0;      ! (Bottom edge)
%own %integer YT = 1023;   ! (Top edge)
%own %integer OWXL=0, OWXR=1023, OWYB=0, OWYT=1023
! Old Window bounds for aspect ratioing retrospectivly.

%routine SWOP (%integer %name A,B)
   %integer C
   C=A;  A=B;  B=C
%end

%external %routine MAP TO DEVICE COORDS (%integer %name X, Y)
   X = MUL DIV (X-XL, XS, XV) + XO
   Y = MUL DIV (Y-YB, YS, YV) + YO
%end

%external %routine MAP TO VIRTUAL COORDS (%integer %name X, Y)
   X = MUL DIV (X-XO, XV, XS) + XL
   Y = MUL DIV (Y-YO, YV, YS) + YB
%end

%routine VECTOR (%integer FX, FY, TX, TY, V)
   ! Draw visible line from virtual coordinates (FX,FY) to (TX,TY).
   ! But if V = 0 just move to (TX,TY).
   %own %integer OTX = 0, OTY = 0

   MAP TO DEVICE COORDS (FX,FY)
   MAP TO DEVICE COORDS (TX,TY)

   %if V#0 %start
       DRIVE DEV (4, FX, FY) %if OTX#FX %or OTY#FY
       DRIVE DEV (5, TX, TY)
   %finish %else DRIVE DEV (4, TX, TY)
   OTX = TX
   OTY = TY
%end

%routine CLIP (%integer TX, TY, V)
   ! Draw a vector (visible if V#0) to virtual position (TX,TY)
   ! but only that part of it (if any) which lies within the virtual window
   %integer F, T, FX, FY
   %constinteger LEFT = 1, RIGHT = 2, ABOVE = 4, BELOW = 8

   %integer %fn CODE (%integer X, Y)
      ! Set one bit for each of the conditions that (X,Y) lies
      ! above, below, to the left, or to the right of window
      %integer C
      C = 0
      C = LEFT %if X<XL
      C = RIGHT %if X>XR
      C = C + ABOVE %if Y>YT
      C = C + BELOW %if Y<YB
      %result = c
   %end

   %return %if VIEWING<0

   FX=CX; FY=CY;          ! Let FROM be current position
   CX=TX; CY=TY;          ! Update current position to TO
   VECTOR (FX,FY,TX,TY,V) %and %return %if CLIPPING<0

   T=CODE (TX,TY)
   VIS = T; ! Remember whether inside window for CHARS
   %cycle
      F = CODE (FX,FY)
      %return %if F&T#0;  ! Both endpoints outside window (same side)
      %if F+T=0 %start;   ! Both endpoints inside window
          VECTOR (FX,FY,TX,TY,V); ! So draw the line and it's over with
          %return
      %finish
      %if F=0 %start;     ! FROM is inside window: swop FROM and TO
          SWOP(F,T); SWOP(FX,TX); SWOP(FY,TY)
      %finish
      ! Now FROM is outside and TO is either inside or outside
      ! So shift FROM along the line FROM/TO until it comes
      ! to lie on the window's edge.
      %if F&LEFT#0 %start
          FY=MUL DIV(TY-FY,XL-FX,TX-FX)+FY; FX=XL
      %finish %else %start
          %if F&RIGHT#0 %start
              FY=MUL DIV(TY-FY,XR-FX,TX-FX)+FY; FX=XR
          %finish %else %start
              %if F&ABOVE#0 %start
                  FX=MUL DIV(TX-FX,YT-FY,TY-FY)+FX; FY=YT
              %finish %else %start 
                  %if F&BELOW#0 %start
                      FX=MUL DIV(TX-FX,YB-FY,TY-FY)+FX; FY=YB
                  %finish
              %finish
          %finish
      %finish
   %repeat
%end

%routine INSERT (%integer A, X, Y); ! Insert instruction into display file
   %integer CODE, OOS

   %return %if STORING < 0
   OOS = OUT STREAM
   SELECT OUTPUT (STORING)
   CODE = A&15
   %if CODE<=5 %and -128<=X<=127 %and -128<=Y<=127 %start
       WRITE (A ! 16, 1)
       WRITE ((X&255)<<8! Y&255, 1)
   %finish  %else %start
       WRITE (A, 1)
       %if CODE = 15 %then WRITE  (X, 1) %else %start
           WRITE (X, 1) %and WRITE (Y, 1) %unless 9<=CODE<=12
       %finish
   %finish
   NEWLINE
   SELECT OUTPUT (OOS)
%end


%routine SET ATTRIBUTE (%integer WHAT,TO)
   ATTRIBUTES(WHAT) = TO
   TO = MUL DIV (TO, XS, XV) %IF WHAT=2; !  Scale char size to dev units.
   DRIVE DEV (7, WHAT, TO) %if VIEWING>=0
%end

%integer %fn CHAR OFFSET (%integer DIR)
   ! Dir is X or Y and the result is the current character offset in dir.
   %const %integer %array RX (0:3) = 1, 0, -1, 0
   %const %integer %array RY (0:3) = 0, 1, 0, -1
   %integer SIZE, ROT

   ROT = (ATTRIBUTES (3)//90)&3
   SIZE = ATTRIBUTES (2)
   %result = SIZE * RX(ROT) %if DIR = 'X'
   %result = SIZE * RY(ROT)
%end

%routine DO ASPECT
   %integer MD,MV,N

   MD = VIEWPORT GRADIENT (YS,XS)
   MV = MUL DIV (5000,IMOD(YT-YB),IMOD(XR-XL))
   %if MD#MV %start
       %if MD>MV %start
           N = (MUL DIV(MD,IMOD(XR-XL),5000)+YB - YT)//2
           YB = YB - N
           YT = YT + N
       %finish %else %start
           N = (MUL DIV(5000,IMOD(YT-YB),MD)+XL - XR)//2
           XL = XL - N
           XR = XR + N
       %finish
   %finish
%end


%constinteger ONE=32;  !  Internal representation of unity

%routine %spec INTERPRET (%integer PC,SIZE,ROT)

%routine MARKER (%integer N)
   %const %integer %array MK(0:10) = '.', 'O', '#', 'A', 'X', '*', '+', '>', '<', 'V', '^'
   %integer scale
   !  This draws a marker at the current position.
   %return %unless 0<=N<=10

   DRIVE DEV (6, MK(N), 0) %and %return %if XLIM(DEVICE)<250;      !  For VDUs.
   SCALE = ONE
   SCALE = ONE * 10 %if XLIM(DEVICE)>4095; !  For calcomps & HP plotters.
   INTERPRET (CHARPDF(2000-N*2), MUL DIV(SCALE, XV, XS), 0)
%end

%routine INTERPRET(%integer PC,SIZE,ORIENT)
   ! PC=0 => PDF read from the input stream, else read from CHAR PDF.
   ! Interpret instructions in display file starting
   ! at (relative) PC until an END instruction is found
   ! For more information on display file layout, see GRAFIX.PDFDOC.
   ! Codes are   0 LINEA   1 MOVEA   2 MARKERA
   !             3 LINER   4 MOVER   5 MARKERR
   !             6 SUBPIC  7 old END 8 WINDOW
   !             9 CHAR   10 ATTRIBUTES   11 END
   %integer WORD, CODE, X, Y, Z, P, LSAVE, CSIZE, ACTIVE, OX, OY
   %switch C (0:15)

   %routine GET (%integer %name N)
      %if PC=0 %then READ(N) %else N=CHARPDF(PC) %and PC=PC+1
   %end

   ACTIVE = FALSE
   %cycle
      GET (WORD)
      CODE=WORD&15
      %if CODE<=5 %start;  !Draw, Move, Marker
          ACTIVE = TRUE
          GET(X)
          %if WORD&16=0 %start; !Long form
              GET(Y)
          %finish%elsestart;           !Short form
              Y=X&255; X=X>>8&255
              X=X!!(\255) %if X&128#0
              Y=Y!!(\255) %if Y&128#0
          %finish
          %if CODE>=3 %start; !Relative
              %if ORIENT&4#0 %start; !Coordinate swop
                  Z=X; X=Y; Y=Z
              %finish
              X=-X %if ORIENT&1#0;   !Y-axis reflection
              Y=-Y %if ORIENT&2#0;   !X-axis reflection
              !Change relative to absolute coords
              X = MUL DIV (X,SIZE,ONE) + CX
              Y = MUL DIV (Y,SIZE,ONE) + CY
              CODE=CODE-3;           !Map to absolute codes
          %finish
    %finish
    ->C(CODE)
C(2):CLIP(X,Y,0);MARKER(WORD>>12&15); %continue ; !Point
C(0):CLIP(X,Y,1); %continue;       !+Draw
C(1):CLIP(X,Y,0); %continue;       !Move
C(6): %signal 14, 5
C(8): ! SET new WINDOW
      GET(XL);  GET(XR);  GET(CODE);  GET (YB);  GET (YT)
      DO ASPECT %if ATTRIBUTES(15)#0
      XV=XR-XL
      YV=YT-YB
      %continue
C(9):%if ATTRIBUTES(4) & 1 = 0  %start
         DRIVE DEV (6, WORD>>4, VIS)
         CX = CX + ATTRIBUTES (2)
     %finish %else %start
         ! Software character if char not PUT.
         P = 2000 - ((WORD>>4 & 255) - 21) << 1
         CSIZE = MULDIV (ATTRIBUTES (2), ONE, 12)
         %continue %if CSIZE < 8; ! Not worth drawing
         %if ATTRIBUTES(1)#0 %start
             LSAVE = ATTRIBUTES(1)
             DRIVE DEV(7,1,0)
         %finish %else LSAVE = -1
         OX = CX;   OY = CY
         INTERPRET(CHARPDF(P),CSIZE,RA((ATTRIBUTES(3)//90)&3))
         CLIP (OX + CHAR OFFSET ('X'), OY + CHAR OFFSET ('Y'), 0)
         DRIVE DEV(7,1,LSAVE) %if LSAVE>=0
     %finish
     ACTIVE = TRUE
     %continue
C(15):
C(10): %if CODE=10 %then CODE=WORD>>4&255 %else GET(CODE)
       SET ATTRIBUTE (WORD>>12&15, CODE)
       %continue
C(11): %return %if ACTIVE=TRUE
  %repeat
C(13): C(14): %signal 14,5
C(7):C(12):
%end



!*******************************************************************
!*                                                                 *
!*               U S E R   R O U T I N E S                         *
!*                                                                 *
!*******************************************************************

%routine %spec WINDOW (%integer A,B,C,D)
%routine %spec VIEW PORT (%integer A,B,C,D)

%external %routine INITIALISE FOR (%integer TYPE)
   DRIVE DEV (0, TYPE, 0); ! Initialise device driver
   VIEW PORT (0, DVX(DEVICE), 0, DVY(DEVICE)) %if 0<=DEVICE<=NUM DEV
   WINDOW (0, 1023, 0, 1023)
%end

%external %routine TERMINATE EDWIN {%alias "ED$TER"}
   DRIVE DEV (1, 0, 0); ! Tell the device driver to Terminate
   INSERT (12, 0, 0); ! Close the PDF if it was in use.
%end

%external %routine LINE ABS (%integer X,Y); !Draw line to absolute pos.
   INSERT(0,X,Y); CLIP(X,Y,1)
%end

%external %routine MOVE ABS (%integer X,Y); !Move to absolute position
   INSERT(1,X,Y); CLIP(X,Y,0)
%end

%external %routine MARKER ABS {%alias "ED$MKA"} (%integer N,X,Y)
   INSERT(N<<12!2,X,Y); CLIP(X,Y,0); MARKER (N)
%end

%external %routine LINE REL (%integer X,Y); !Draw a visible rel vector
   INSERT(3,X,Y); CLIP(X+CX,Y+CY,1)
%end

%external %routine MOVE REL (%integer X,Y); !Draw an invisible rel vector
   INSERT(4,X,Y); CLIP(X+CX,Y+CY,0)
%end

%external %routine MARKER REL {%alias "ED$MKR"} (%integer N,X,Y)
   INSERT(N<<12!5,X,Y); CLIP(X+CX,Y+CY,0); MARKER(N)
%end

%external %routine CHARACTER (%integer CH)
   %const %integer UNIT = 12
   %integer LSAVE, SIZE, OX, OY

   INSERT (CH<<4!9,0,0)

   %return %if VIEWING < 0

   %if ATTRIBUTES(4)&1 = 0 %start
       DRIVE DEV (6,CH,0) %if VIS=0
       CX = CX + ATTRIBUTES (2)
   %finish %else %start
       %return %unless 32<=CH<=127
       SIZE = MUL DIV (ATTRIBUTES(2), ONE, UNIT)
       %return %if SIZE < 8
       %if ATTRIBUTES(1)#0 %start
           LSAVE = ATTRIBUTES(1)
           DRIVE DEV(7,1,0)
       %finish %else LSAVE = -1
       OX = CX;   OY = CY
       INTERPRET(CHARPDF(2000-(CH-21)<<1), SIZE, RA(ATTRIBUTES(3)//90&3))
       CLIP (OX + CHAR OFFSET ('X'), OY + CHAR OFFSET ('Y'), 0)
       DRIVE DEV(7,1,LSAVE) %if LSAVE>=0
   %finish
%end

%external %routine TEXT (%string(255) ST)
   %integer I
   CHARACTER (CHAR NO (ST,I)) %for I = 1,1,LENGTH(ST)
%end

%external %routine NEW FRAME
   DRIVE DEV (3,0,0)
   INSERT (11,0,0)
   CX=0; CY=0
%end

%external %routine UPDATE
   DRIVE DEV (2,0,0); ! Get driver to update the picture.
%end

%external %routine CLIP ON
   CLIPPING = 0
%end

%external %routine CLIP OFF
   CLIPPING = OFF
%end

%external %routine STORE ON {%alias "ED$SON"} (%integer STREAM)
   STORING = STREAM
%end

%external %routine STORE OFF {%alias "ED$SOF"}
   STORING = OFF
%end

%external %routine VIEW ON (%integer STREAM)
   VIEWING = STREAM
%end

%external %routine VIEW OFF
   VIEWING = OFF
%end

%external %routine WINDOW (%integer A,B,C,D)
   XL = A;   OWXL = A;   XR = B;   OWXR = B
   YB = C;   OWYB = C;   YT = D;   OWYT = D
   INSERT(8, A, B);   INSERT(8, C, D)
   DO ASPECT %if ATTRIBUTES(15)#0
   XV = XR-XL;   YV = YT-YB
%end

%external %routine VIEW PORT (%integer A,B,C,D)
   %integer S

   ! We don't allow users to choose silly values as it confuses them!
   %return %if DEVICE<0; ! Anything goes for NULL device
   SWOP (A,B) %if A>B
   SWOP (C,D) %if C>D
   A = 0 %if A<0
   C = 0 %if C<0
   B = XLIM(DEVICE) %if B>XLIM(DEVICE)
   D = YLIM(DEVICE) %if D>YLIM(DEVICE)
   DRIVE DEV (8, A, C); ! Set lower window bounds
   DRIVE DEV (9, B, D); ! Set upper window bounds (If  driver req.)
   XO=A;  XS=B-A;  YO=C;  YS=D-C

   S = STORING
   STORING = OFF
   WINDOW (OWXL, OWXR, OWYB, OWYT)
   STORING = S
%end

%routine STORE ATTRIBUTE (%integer WHAT, IT)
   INSERT ((WHAT<<8 ! IT) <<4 ! 10, 0, 0)
%end

%external %routine SET COLOUR (%integer TO)
   %const %integer THIS = 0, DEF = 1, MAX = 255
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET LINE STYLE (%integer TO)
   %const %integer THIS = 1, DEF = 0, MAX = 4
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET CHAR SIZE {%alias "ED$SCS"} (%integer TO)
   %const %integer THIS = 2
   INSERT (THIS<<12 ! 15, TO, 0)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET CHAR ROT {%alias "ED$SCR"} (%integer TO)
   %const %integer THIS = 3
   ! Force the parameter into the range 0 to 360.
   %if TO < 0 %start
       TO = TO + 360 %until TO >= 0
   %finish %else %if TO>=360 %start
       TO = TO - 360 %until TO < 360
   %finish
   INSERT (THIS<<12+15, TO, 0)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET CHAR QUALITY {%alias "ED$SCQ"} (%integer TO)
   %const %integer THIS = 4, DEF = 0, MAX = 2
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET CHAR FONT {%alias "ED$SCF"} (%integer TO)
   %const %integer THIS = 5, DEF = 0, MAX = 7
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET CHAR SLANT {%alias "ED$SCI"} (%integer TO)
   %const %integer THIS = 6, DEF = 90, MAX = 180
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET INTENSITY (%integer TO)
   %const %integer THIS = 7, DEF = 5, MAX = 7
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine SET SPEED (%integer TO)
   %const %integer THIS = 8, DEF = 36, MAX = 255
   TO = DEF %unless 0<=TO<=MAX
   STORE ATTRIBUTE (THIS, TO)
   %return %if ATTRIBUTES (THIS) = TO
   SET ATTRIBUTE (THIS, TO)
%end

%external %routine ASPECT RATIOING (%integer MODE)
   %const %integer THIS = 15, DEF = 1
   %integer S
   MODE = DEF %unless MODE = 0
   STORE ATTRIBUTE (THIS, MODE)
   SET ATTRIBUTE (THIS, MODE)
   S = STORING
   STORING = OFF
   WINDOW (OWXL, OWXR, OWYB, OWYT)
   STORING = S
%end

%external %routine INQUIRE POSITION {%alias "ED$IP"} (%integer %name X, Y)
   X = CX;  Y = CY
%end

%external %routine INQUIRE WINDOW {%alias "ED$IW"} (%integer %name A, B, C, D)
   A = XL;  B = XR;  C = YB;  D = YT
%end

%external %routine INQUIRE VIEW PORT {%alias "ED$IV"} (%integer %name A, B, C, D)
   A = XO;  B = XS+XO;  C = YO;  D = YS+YO
%end

%external %routine  REVIEW 
   ! This reads a PDF form the current input stream and draws it.
   INTERPRET (0,ONE,0)
%end

%end %of %file