! 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)
          finishelsestart;             !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