    ! EDWIN 5.2  Sept 1985

    !############################################################################
    !#                                                                          #
    !#  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.                                                            #
    !#                                                                          #
    !############################################################################

    from Imp include Connect
    from Imp include Lognames
    from Imp include Maths
    from Edwin include consts
    from Edwin include icodes
    from Edwin include specs
    external integer fn spec MULDIV alias "EDWIN___MUL_DIV" (integer A, B, C)

    from Edwin include charspec

    ! Global Data for the EDWIN library -

    external record (DEVICE DATA FM) DEV DATA alias "EDWIN___DEVICE_DATA" = 0

    external record (DEVICE DATA FM) map D DATA alias "EDWIN_DEVICE_DATA"
       result == record(addr(DEV DATA))
    end

    external integer VIEWING alias "EDWIN___VIEWING" = 0
    external integer STORING alias "EDWIN___STORING" = -1
    external integer CLIPPING alias "EDWIN___CLIPPING" = 0
    ! These three variables are set up by the device drivers for Draft (curse)
    external integer Font Width alias "CharX"
    external integer Font Height alias "CharY"
    external integer Font Descender alias "OffY"

    !%include "EDCONFIG"

    ! control
    const integer Max Int = 16_7FFFFFF { NB: 4 bits saved for multiplications }
    own integer VIS = 0;        ! Current Char visibility
    own integer DEVICE CHAR SIZE = 12
    own integer array ATTRIBUTES (0:15) = -1 (*)
    const integer array DEF ATTRIBUTES (0:15) = { Colour       }  1,
                                                   { Line Style   }  0,
                                                   { Char size    } 12,
                                                   { Char rot     }  0,
                                                   { Char quality }  0,
                                                   { Char font    }  0,
                                                   { Char slant   }  0,
                                                   { Maker size   }  7,
                                                   { Speed (max)  }  0,
                                                   { Colour mode  }  0,
                                                   { Shade mode   }  0,
                                                   { Chord step   } 15,
                                                   { Char Mirror  }  0,
                                                   { Att 13       }  0,
                                                   { Att 14       }  0,
                                                   { Aspect ratio }  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  alias "EDWIN_MAP_TO_DCS" (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 alias "EDWIN_MAP_TO_VCS" (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 DEVICE (Dev move, FX, FY) if OTX#FX or OTY#FY
           DRIVE DEVICE (Dev Line, TX, TY)
       else
           DRIVE DEVICE (Dev Move, TX, TY)
       finish
       OTX = TX
       OTY = TY
    end

    external routine CLIP alias "EDWIN___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

       FX=CX; FY=CY;          ! Let FROM be current position
       CX=TX; CY=TY;          ! Update current position to TO
       return if VIEWING<0
       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
          else
              if F&RIGHT#0 start
                  FY=MUL DIV(TY-FY,XR-FX,TX-FX)+FY; FX=XR
              else
                  if F&ABOVE#0 start
                      FX=MUL DIV(TX-FX,YT-FY,TY-FY)+FX; FY=YT
                  else
                      if F&BELOW#0 start
                          FX=MUL DIV(TX-FX,YB-FY,TY-FY)+FX; FY=YB
                      finish
                  finish
              finish
          finish
       repeat
    end

    external routine PDF INSERT alias "EDWIN___PDF_INSERT" (integer A, X, Y)
       ! Insert instruction into display file
       switch IS (0:15)
       integer OOS

       return if STORING < 0
       OOS = OUTPUT STREAM
       SELECT OUTPUT (STORING)
       Write (A, 1)
       -> IS (A&15)
    IS(0): IS(1): IS(2): IS(3): IS(4): IS(5):       { Two Values to be output
    IS(6): IS(7): IS(8): IS(13):
           WRITE (X, 1);   WRITE (Y, 1)
           -> Done
    IS(14): IS(15):                                 { Output X value
           WRITE (X, 1)
    Done:
    IS(9): IS(10): IS(11): IS(12):                  { No other values
       NEWLINE
       SELECT OUTPUT (OOS)
    end

    external routine SET ATTRIBUTE alias "EDWIN___SET_ATTRIBUTE" (integer WHAT, TO)
       return if ATTRIBUTES(WHAT) = TO
       ATTRIBUTES(WHAT) = TO
       if WHAT=Att Char Size start
          DEVICE CHAR SIZE = MUL DIV (TO, XS, XV)
          TO = DEVICE CHAR SIZE
       finish
       DRIVE DEVICE (Dev Attribute, WHAT, TO)
    end

    external routine GET ATTRIBUTE alias "EDWIN___GET_ATTRIBUTE" (integer CODE, integer name VAL)
       VAL = ATTRIBUTES (CODE)
    end

    routine CHAR OFFSET (integer name XO, YO)
       ! Update XO and YO with the relative movements caused by the character
       long real R
       integer SIZE, ROT

       ROT = ATTRIBUTES (Att Char Rot)
       SIZE = ATTRIBUTES (Att Char size)
       SIZE = -SIZE if Attributes (Att Char Mirror) & Mirror in Y Axis # 0
       if Rot = 0 start
           XO = SIZE
           YO = 0
       else
           R = Rot/DtoR
           XO = round (size * Cos(r))
           YO = round (size * Sin(r))
       finish
    end

    routine DO ASPECT
       integer MD, MV, N, ARF

       ARF = DEV DATA_ARF
       ARF = 100 if ARF = 0
       MD = round ((Float(100000)*Float(YS)) / (Float(ARF)*Float(XS)))
       MV = MUL DIV (1000, |YT-YB|, |XR-XL|)
       if MD#MV start
           if MD>MV start
               N = (MUL DIV(MD,|XR-XL|,1000)+YB - YT)//2
               YB = YB - N
               YT = YT + N
           else
               N = (MUL DIV(1000,|YT-YB|,MD)+XL - XR)//2
               XL = XL - N
               XR = XR + N
           finish
       finish
    end

    own integer MARKER SCALE = 1
    const integer Anti Rounding = 1000

    external routine SET MARKER SIZE alias "EDWIN_SET_MARK_SIZE" (integer S)
       S = 1 unless 0 < S < 256
       PDF INSERT ((Att Marker Size << 8 ! S) << 4 ! PDF Attribute, 0, 0)
       MARKER SCALE = S
    end

    routine spec INTERPRET (integer PC, SIZE, Rot, Mirror)

    external routine MARKER alias "EDWIN___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 DEVICE (Dev Char, MK(N), 0) and return if DEV DATA_Dev no = VT100
       if Dev Data_Units per cm > 0 start
          SCALE = Trunc(Marker Scale * Anti Rounding * -
                       (DEV DATA_X Units per cm/40 + 0.5))
       else
          SCALE = Marker Scale * Anti Rounding
       finish
       INTERPRET (CHARPDF(2000-N*2), MUL DIV(SCALE, XV, XS), 0, 0)
    end

    routine INTERPRET (integer PC, SIZE, Rot, Mirror)
       ! Interpret instructions in display file starting
       ! at (relative) PC until an END instruction is found
       ! Codes are   0 LINEA   1 MOVEA   2 MARKERA
       !             3 LINER   4 MOVER   5 MARKERR
       !             6 SUBPIC  7 END     8 WINDOW
       !             9 CHAR   10 ATTRIBUTES   11 END
       integer WORD, CODE, X, Y, Z, P, SSAVE, LSAVE, CSIZE, ACTIVE, OX, OY
       long real SinR, CosR
       switch C (0:15)

       ACTIVE = FALSE
       if Rot # 0 start
          Sin R = Sin (Rot/DtoR)
          Cos R = Cos (Rot/DtoR)
       finish
       cycle
          WORD = CHARPDF(PC);   PC=PC+1
          CODE=WORD&15
          if CODE<=5 start;    !Draw, Move, Marker
              ACTIVE = TRUE
              X = CHARPDF (PC);   PC = PC + 1
              if WORD&16=0 start;   !Long form
                  Y = CHARPDF (PC);   PC = PC + 1
              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
                  !Change the scale
                  X = X*SIZE
                  Y = Y*SIZE
                  X = -X if Mirror & Mirror in Y Axis # 0
                  Y = -Y if Mirror & Mirror in X Axis # 0
                  if Rot # 0 start
                     Z = Round (X*CosR - Y*SinR)
                     Y = Round (X*SinR + Y*CosR)
                     X = Z
                  finish
                  X = Round(X/Anti Rounding) + CX
                  Y = Round(Y/Anti Rounding) + CY
                  CODE=CODE-3;           !Map to absolute codes
              finish
        finish
        ->C(CODE)
    C(0):    CLIP (X, Y, 1);   continue           { Line }
    C(1):    CLIP (X, Y, 0);   continue           { Move }
    C(2):    CLIP (X, Y, 0);   MARKER(WORD>>12&15)
      repeat
    C(*): signal 14, 5
    C(12):
    end

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

    external routine TERMINATE EDWIN alias "EDWIN_TERM"
       PDF INSERT   (PDF Terminate, 0, 0)
       DRIVE DEVICE (Dev Terminate, 0, 0)
       DEV DATA_DEV NO = -1
    end

    external routine LINE ABS alias "EDWIN_LINE_ABS" (integer X, Y)
       PDF INSERT (PDF Line Abs, X, Y)
       CLIP (X, Y, 1)
    end

    external routine MOVE ABS alias "EDWIN_MOVE_ABS" (integer X, Y)
       PDF INSERT (PDF Move Abs, X, Y)
       CLIP (X, Y, 0)
    end

    external routine MARKER ABS alias "EDWIN_MARK_ABS" (integer N, X, Y)
       PDF INSERT (N<<12!PDF Mark Abs, X, Y)
       CLIP (X, Y, 0)
       MARKER (N)
    end

    external routine LINE REL alias "EDWIN_LINE_REL" (integer DX, DY)
       PDF INSERT (PDF Line Rel, DX, DY)
       CLIP (DX+CX, DY+CY, 1)
    end

    external routine MOVE REL alias "EDWIN_MOVE_REL" (integer DX, DY)
       PDF INSERT (PDF Move Rel, DX, DY)
       CLIP (DX+CX, DY+CY, 0)
    end

    external routine MARKER REL alias "EDWIN_MARK_REL" (integer N, DX, DY)
       PDF INSERT (N<<12!PDF Mark Rel, DX, DY)
       CLIP (DX+CX, DY+CY, 0)
       MARKER (N)
    end

    external routine CHARACTER alias "EDWIN_CHAR" (integer SYM)
       const integer UNIT = 12
       integer FSAVE, SSAVE, LSAVE, SIZE, OX, OY, NX, NY
       long real R Size

       on 14 start
           signal 14, event_sub if event_sub # 14
           ATTRIBUTES (Att Char Quality) = 1 { software chars }
           -> resume
       finish

       PDF INSERT (SYM<<4!PDF character, 0, 0)

    Resume: { After a hardware character error }
       if ATTRIBUTES(Att Char Quality) = 0 start
           CHAR OFFSET (NX, NY)
           CX = CX + NX
           CY = CY + NY
           DRIVE DEVICE (Dev Char, SYM, 0) if VIS=0
       else
           if ATTRIBUTES(Att Line Style)#0 start
               LSAVE = ATTRIBUTES(Att Line Style)
               DRIVE DEVICE(Dev Attribute, Att Line Style, 0)
           finish else LSAVE = -1
           if ATTRIBUTES(Att Shade Mode)#0 start
               FSAVE = ATTRIBUTES(Att Shade Mode)
               DRIVE DEVICE(Dev Attribute, Att Shade Mode, 0)
           finish else FSAVE = -1
           if ATTRIBUTES(Att Char Font)=0 start;   ! Normal EDWIN ones
               RSize = Float(Attributes(Att Char Size))*Float(Anti Rounding)/12
               if R Size > Max Int start
                  Size = Max Int
               else
                  Size = Round (R Size)
               finish
               if SIZE > 0 and 32<=SYM<=127 start
                   OX = CX;   OY = CY
                   if Device Char Size > 2 start
                      INTERPRET (CHARPDF(2000-(SYM-21)<<1), Size,
                             Attributes(Att Char Rot), Attributes(Att Char Mirror))
                   finish
                   CHAR OFFSET (NX, NY)
                   CLIP (OX + NX, OY + NY, 0)
               finish
           else;  ! GIMMS characters
               SSAVE = STORING;   STORING = -1
               DRAW CHAR (SYM, Attributes(Att Char Font), Attributes(Att Char Size),
                          Attributes(Att Char Rot), Attributes(Att Char Mirror))
               STORING = SSAVE
           finish
           DRIVE DEVICE (Dev Attribute, Att Line Style, LSAVE) if LSAVE>=0
           DRIVE DEVICE (Dev Attribute, Att Shade Mode, FSAVE) if FSAVE>=0
       finish
    end

    external routine NEW FRAME alias "EDWIN_NEW_FRAME"
       PDF INSERT   (PDF Newframe, 0, 0)
       DRIVE DEVICE (Dev Newframe, 0, 0)
       CX = 0
       CY = 0
    end

    external routine UPDATE alias "EDWIN_UPDATE"
       DRIVE DEVICE (Dev update, 0, 0)
    end

    external routine CLIP ON alias "EDWIN_CLIP_ON"
       CLIPPING = 0
    end

    external routine CLIP OFF alias "EDWIN_CLIP_OFF"
       CLIPPING = DISABLED
    end

    external routine STORE ON alias "EDWIN_STORE_ON" (integer STREAM)
       STORING = STREAM
    end

    external routine STORE OFF alias "EDWIN_STORE_OFF"
       STORING = DISABLED
    end

    external routine VIEW ON alias "EDWIN_VIEW_ON" (integer STREAM)
       VIEWING = STREAM
    end

    external routine VIEW OFF alias "EDWIN_VIEW_OFF"
       VIEWING = DISABLED
    end

    external routine WINDOW alias "EDWIN_WINDOW" (integer A, B, C, D)
       signal 14, 12 if A>=B or C>=D
       XL = A;   OWXL = A;   XR = B;   OWXR = B
       YB = C;   OWYB = C;   YT = D;   OWYT = D
       PDF INSERT(PDF Window, A, B);   PDF INSERT(PDF Window, C, D)
       DO ASPECT if ATTRIBUTES(15)#0
       XV = XR-XL;   YV = YT-YB
       VIS = 0
       A = ATTRIBUTES(Att Char Size)
       return if A <= 0 { No size set up yet, Window having been called from Init }
       ATTRIBUTES (Att Char Size) = 0
       SET ATTRIBUTE (Att Char Size, A) { Fix device character size for new window }
    end

    external routine VIEWPORT alias "EDWIN_VIEWPORT" (integer XL, XR, YB, YT)
       integer S

       return if DEV DATA_DEV NO<=0

       ! Check that the bounds are valid, trying to make a sensible size if req.
       XL = 0 if XL<0
       YB = 0 if YB<0
       XR = DEV DATA_MVX if XR>DEV DATA_MVX
       YT = DEV DATA_MVY if YT>DEV DATA_MVY
       signal 14, 13 if XL>=XR or YB>=YT

       DRIVE DEVICE (Dev low wb,  XL, YB)  { Set lower viewport bounds
       DRIVE DEVICE (Dev high wb, XR, YT)  { Set upper viewport bounds
       XO=XL;  XS=XR-XL;  YO=YB;  YS=YT-YB

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

    external routine ASPECT RATIOING alias "EDWIN_ASPECT_RATIO" (integer MODE)
       const integer THIS = 15
       integer S
       MODE = 1 unless MODE = 0
       PDF INSERT ((THIS<<8 ! MODE) <<4 ! PDF Attribute, 0, 0)
       ATTRIBUTES (THIS) = MODE
       S = STORING
       STORING = DISABLED
       WINDOW (OWXL, OWXR, OWYB, OWYT)
       STORING = S
    end

    external routine INITIALISE FOR alias "EDWIN_INIT" (integer DEVICE TYPE)
       integer I
       DRIVE DEVICE (Dev initialise, DEVICE TYPE, 0)
       VIEW PORT (0, DEV DATA_DVX, 0, DEV DATA_DVY) if DEV DATA_DVX#0
       WINDOW (0, 1023, 0, 1023)
       ATTRIBUTES (I) = -1 for I = 0, 1, ATT MAXIMUM
       SET ATTRIBUTE (I, DEF ATTRIBUTES(I)) for I = 0, 1, ATT MAXIMUM
    end

    external routine INQUIRE POSITION alias "EDWIN_INQ_POSITION" (integer name X, Y)
       X = CX;   Y = CY
    end

    external routine INQUIRE WINDOW alias "EDWIN_INQ_WINDOW" (integer name A, B, C, D)
       A = XL;   B = XR;   C = YB;   D = YT
    end

    external routine INQUIRE VIEWPORT alias "EDWIN_INQ_VIEWPORT" (integer name A, B, C, D)
       A = XO;   B = XS+XO;   C = YO;   D = YS+YO
    end

    external routine REQUEST INPUT alias "EDWIN_REQUEST" (integer name STATE, X, Y)
       REQUEST DEVICE (STATE, X, Y)
       MAP TO VIRTUAL COORDS (X, Y)
    end

    external routine SAMPLE INPUT alias "EDWIN_SAMPLE" (integer name STATE, X, Y)
       SAMPLE DEVICE (STATE, X, Y)
       MAP TO VIRTUAL COORDS (X, Y)
    end

    external routine AREA INPUT alias "EDWIN_AREA" (integer name XL, YB, XR, YT)
       AREA DEVICE (XL, YB, XR, YT)
       MAP TO VIRTUAL COORDS (XL, YB)
       MAP TO VIRTUAL COORDS (XR, YT)
    end

    end of file { Unless you want it all together }

    include "EDATTRIB"
    include "EDTEXT"
    include "EDUTILS"
    include "EDERRORS"
    record format POINT FM (integer X, Y)
    include "EDWIN:SHAPES.INC"
    include "EDSHAPES"
    include "EDREVIEW"
    include "EDCIFSUP"
    include "EDDEFDEV"

    end of file