    ! EDWIN driver for 4010 series Tektronix storage tubes and Tektronix 4662 plotters.
    ! With Frigs for Westward 1015 and 2015

    !############################################################################
    !#                                                                          #
    !#  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 Edwin include Device
    from Edwin include Icodes
    from Imp include Lognames

    ! Control characters
    const integer NUL = 0
    const integer DC1 = 17;              ! Invokes cursor on 4002.
    const integer SUB = 26;              ! Invokes cursor on later models.
    const integer ESCAPE = 27
    const integer GRAPHMODE = 29
    const integer ALPHAMODE = 31
    const integer ERASE SCREEN = 12
    const integer PLOTTER = 'A'
    const integer BLOCK SIZE = 255
    const integer BYPASS = NL

    ! Device
    own integer TYPE = 4012
    own integer INVOKE CURSOR

    ! Screen information
    own integer AMODE = 0        { Advanced mode for 4014
    own integer MODE = 0         { 0 if alphamode
    own integer SX = 0, SY = 0   { Current device position
    own integer XL = 0           { Left hand side of device window
    own integer XR = 1023        { Right hand side of device window
    own integer YB = 0           { Bottom side of device window
    own integer YT = 1023        { top side of device window
    own integer VIS = 0          { 0 if CVP inside VW
    own integer TCS = 13         { char size.
    own byte COLOUR = 1          { To optimise pen change requests }
    own integer CHARS SENT = 0, CHECK SUM = 0      { For the plotter }
    own integer NUMBER OF PAD CHARS = 960          { For after newframe }

    routine ADD WITH NO CS (integer I)
       string (7) ST
       ST = ITOS (I, 0)
       TTPUT (CHARNO (ST, I)) for I = 1, 1, LENGTH(ST)
    end

    routine TO PLOT WITH NO CS (integer I)
       TTPUT (ESCAPE);   TTPUT (PLOTTER);   TTPUT (I)
    end

    routine PON
       TO PLOT WITH NO CS ('E')
    !   TO PLOT WITH NO CS ('(')
    end

    routine POFF
    !   TO PLOT WITH NO CS (')')
    !   ADD WITH NO CS (CHECK SUM)
    !   TTPUT (NL)
       TO PLOT WITH NO CS ('F');   TTPUT (NL)
       FLUSH OUTPUT
       ! Ignore the response
    !   CHARS SENT = TTREAD %until CHARS SENT # BYPASS
    !   CHARS SENT = TTREAD %until CHARS SENT = BYPASS
       CHECK SUM = 0
       CHARS SENT = 0
    end

    routine PUT (integer S)
       TTPUT (S)
       if TYPE=4662 start
           CHARS SENT = CHARS SENT + 1
           CHECK SUM = CHECK SUM + S
           CHECK SUM = CHECK SUM - 4095 if CHECK SUM > 4095
           if CHARS SENT > BLOCK SIZE - 5 start
               POFF;   PON
           finish
       finish
    end

    routine ADD (integer I)
       string (7) ST
       ST = ITOS (I,0)
       PUT (CHARNO(ST, I)) for I = 1, 1, LENGTH(ST)
    end

    routine PAD (integer SYM, NO)
       integer I
       PUT (SYM) for I = 1,1,NO
    end

    routine SET ALPHA MODE
       PAD (NUL, 4)
       PUT (ALPHAMODE)
       MODE = 0
    end

    routine ESC PLUS (integer CH)
       PUT (ESCAPE);   PUT (CH)
    end

    routine TO PLOT (integer CH)
       ESC PLUS (PLOTTER)
       PUT (CH)
    end

    routine UPDATE
       SET ALPHA MODE
       TTPUT (25) if TCS=24 and TYPE=4002
       FLUSH OUTPUT
    end

    external routine T4000 alias "EDWIN___T" (integer COM, X, Y)
       own integer WX, WY
       string (63) TYPE ST
       switch SW(0:MAX COM)

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

       routine WAIT (string (255) message)
          POFF
          OPER MESSAGE (MESSAGE)
          ! Ignore the response
    !      S = TTREAD %until S # BYPASS
    !      S = TTREAD %until S = BYPASS
          PON
       end

       routine PUT CHAR
          ! Put out a text character properly.
          UPDATE if MODE#0
          PUT (X)
          PUT (NUL)
          SX = SX + TCS
          VIS = 1 if SX>XR
       end

       routine GOTO(integer X,Y);   !Code up coordinates and send to TTY
          constinteger HI=32,LY=96,LX=64,ENH=7
          if amode#0 start
            ttput (((y>>7)&31)!hi)        {HIY}
            ttput (((y&3)<<2)!(x&3)!118)  {XLOY..extra byte for increased accuracy}
            ttput (((y>>2)&31)!ly)        {LOY}
            ttput (((x>>7)&31)!hi)        {HIX}
            ttput (((x>>2)&31)!lx)        {LOX}
          finish else start
            ttput (y>>5&31!hi); ttput (y&31!ly)
            ttput (x>>5&31!hi); ttput (x&31!lx)
          finish
       end

       routine CHANGE ATTRIBUTE
          switch SW(0:ATT MAXIMUM)
          SET ALPHA MODE if TYPE=4662 and MODE#0
          return unless 0<=X<=ATT MAXIMUM
          -> SW(X)

    SW(att colour):
           return if COLOUR = Y
           WAIT ("Change to pen number ".itos(Y,0)." and press CALL") if TYPE=4662
           return

    SW(att Line style):
           Y = 0 unless 0<=Y<=4
           if TYPE=1015 or TYPE=2015 or TYPE=4014 start
               ESC PLUS (Y+96)
           finish
           return

    SW(att Char size):
           TCS = 13
           if TYPE = 2015 or TYPE = 4014 start
               if Y <  8 then ESC PLUS (';') and TCS=7 else start
                   if Y < 10 then ESC PLUS(':') and TCS=9 else start
                       if Y < 13 then ESC PLUS ('9') and TCS=13 c
                                   else ESC PLUS ('8') and TCS=14
                   finish
               finish
           finish else if TYPE = 4002 start
               if Y>23 then TCS=24 else TCS=12
               MODE = 1; ! To ensure we set this
           finish else if TYPE = 4662 start
               TO PLOT ('I');   ADD (Y);   PUT (',');   ADD (Y*2)
           finish
           return

    SW(att Char rot):
           if TYPE=4662 start
               TO PLOT ('J');   ADD (Y)
           finish
           return

    SW(att Char font):
           if TYPE=4226 and 0<=Y<=6 start
               TO PLOT ('T');   ADD (Y+'0')
           finish
           return

    SW(*): ! All other attributes ignored
       end

       -> SW(COM)

    SW(0): ! Initialise
           TYPE = X
           TYPE ST = ITOS (TYPE, 0)
           if TYPE = 1015 or TYPE = 2015 start
               DEV DATA_NAME = "a Westward ".TYPEST
           else
               DEV DATA_NAME = "a Tektronix ".TYPEST
           finish
           DEV DATA_DVX = 1023
           DEV DATA_DVY = 767
           DEV DATA_MVX = 1023
           DEV DATA_MVY = 767
           TYPEST = "EDWIN_".TYPEST
           if TRANSLATE(TYPEST)#TYPEST start
               SET DEVICE (TYPEST)
           finish
           TYPE ST = "EDWIN_".ItoS(Type,0)."_DELAY"
           if TRANSLATE(TYPEST)#TYPEST start
              begin
                 on 3,4,9 start
                    Oper Message ("Invalid setting for EDWIN_".ItoS(Type,0)."_DELAY")
                    signal 14, 1
                 finish
                 Number of Pad Chars = S to I (Type St)
              end
           finish
           TTMODE (1)
           if TYPE=4002 then INVOKE CURSOR=DC1 else INVOKE CURSOR=SUB
           if TYPE=4662 start
               POFF { Incase the last program failed ? }
               TO PLOT WITH NO CS ('N')    { Reset }
               TO PLOT WITH NO CS ('H');   ADD WITH NO CS (BLOCK SIZE)
               TO PLOT WITH NO CS ('U');   TTPUT (BYPASS)
               PON
    !           AMODE = 1 { Use full resolution }
           finish
           ESC PLUS ('1') if TYPE = 1015 or TYPE = 2015
           return

    SW(1): ! Terminate
           if TYPE=4662 start
               POFF
           else
               SET ALPHA MODE
               TTPUT (13);   TTPUT (10)
               ESC PLUS (';') if TYPE=4014
               TTPUT (24); ! Resets ADM terminals
               ESC PLUS ('2') if TYPE = 1015 or TYPE = 2015
           finish
           FLUSH OUTPUT
           TTMODE (0)
           AMODE = 0  { Incase we come back }
           return

    SW(2): ! Update
           UPDATE
           return

    SW(3): ! New frame
           if TYPE=4662 start
               WAIT ("Enter a new sheet of paper and press CALL")
           finish else start
               ESC PLUS (ERASE SCREEN)
               PAD (NUL, Number of Pad Chars)
           finish
           SX = 0;   SY = 0;   MODE = 0
           return

    SW(4): ! Move Abs
           PUT (GRAPH MODE)
           MODE = 1

    SW(5): ! Line Abs
           if MODE=0 start
               PUT (GRAPH MODE)
               GOTO (SX, SY)
           finish
           GOTO (X, Y)
           SX = X;   SY = Y;   MODE = 1;   VIS = 0
           return

    SW(6): ! Character
           PUT CHAR if VIS=0
           return

    SW(7): ! Attribute  Change
           CHANGE ATTRIBUTE
           return

    SW(8): ! Lower window bounds
           XL = X;   YB = Y
           return

    SW(9): ! Upper window bounds
           XR = X;   YT = Y
           AMODE = 1 if TYPE=4014 and (X>1023 or Y>1023)
           return

    SW(10): ! ??
            return

    SW(11): ! Was overwrite mode
            return

    SW(12): ! Lower box bounds
            WX = X;   WY = Y
            return

    SW(13): ! Upper box bounds
            swap (wx, x) if wx > x
            swap (wy, y) if wy > y
            return if WX > XR or X < XL or WY > YT or Y < YB
            WX = XL if WX < XL
            WY = YB if WY < YB
            X = XR if X > XR
            Y = YT if Y > YT
            ! Box now clipped into the screen.
            T4000 (4, Wx, Wy)
            T4000 (5, Wx, y)
            T4000 (5, x,y)
            T4000 (5, x, Wy)
            T4000 (5, Wx, wy)
            return

    SW(*):
    end

    external routine T REQ alias "EDWIN___T_REQ" (integer name CH, X, Y)
       signal 14, 8 if TYPE = 4662 or TYPE = 4006
       SET ALPHA MODE
       TEK INPUT (CH, X, Y, INVOKE CURSOR)
    end

    end of file