    ! Edwin driver for Tek 41XX and 42XX series terminals.

    !############################################################################
    !#                                                                          #
    !#  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 Ascii, Lognames

    own short Model = 4105  { Options 4105 or all others (driver better) }

    ! Modes, Graph mode determines if text screen visible
    !        Line mode is =3 if polygon expected, <0 if doing a polygon
    own short Graph Mode = False, Line Mode = 0

    ! current graphics colour, current mode, cur style, cur fill
    own integer cur col = 1, omode = 0, cur style = 0, cur fill = -1, real col = 1
    own integer real fill = -1
    own byte array Fill Map (1:16) = 0,4,7,11,8,1,5,14,12,6,10,9,2,3,13,16
    ! current graphics position (may be outside window)
    own integer lastx = 0, lasty = 0
    ! window delimiters
    own integer x min = 0, y min = 0, x max = 4095, y max = 3071
    ! charcter sizes, width in pixels and height in Terminal Space Units
    own integer tcs = 5, tsu = 61
    ! flags if move required before writing text or drawing, text direction
    own integer move pending = FALSE, cur dir = -1 {forces initial setup}

    routine Add (integer a, b)
       TTput (Esc);   TTput (A);   TTput(B)
    end

    ! coords - send <X,Y> coords in correct format
    routine coords(integer x, y)
       const integer TOP5 = 7, INT5 = 2, SR2 = 2
       const integer HIYMARKER = 32, LOYMARKER = 96, EXTRAMARKER = 96
       const integer HIXMARKER = 32, LOXMARKER = 64
       const integer HIMASK = 127 , LOMASK = 3
       integer HIY, LOY, HIX, LOX, extra

       HIY = Y>>TOP5 ; Y = Y & HIMASK ; HIY = HIY ! HIYMARKER
       LOY = Y>>INT5 ; Y = Y & LOMASK ; LOY = LOY ! LOYMARKER
       HIX = X>>TOP5 ; X = X & HIMASK ; HIX = HIX ! HIXMARKER
       LOX = X>>INT5 ; X = X & LOMASK ; LOX = LOX ! LOXMARKER
       extra = EXTRAMARKER ! X ! (Y << SR2)
       TTput(HIY);  TTput(extra);  TTput(LOY);  TTput(HIX);  TTput(LOX)
    end {coords}

    ! drawto - drawto line from current postion to x, y
    routine drawto(integer x, y)
       ! draw
       Add ('L', 'G')
       coords(x,y)
    end {drawto}

    ! domove - move from current position to x, y
    routine domove(integer x, y)
       ! move
       Add ('L', 'F')
       coords(x,y)
       move pending = FALSE
    end

    ! send int - send integer in correct format
    routine send int(integer int)
       const integer HI6 = 10, INT6 = 4, HiMARKER = 64
       const integer LoMARKER = 32, SIGNMARKER = 16
       const integer Hi1MASK = 1023, Hi2MASK = 15

       integer HiI1, HiI2, LoI

       if int >= 0 start
          LoI = LoMARKER ! SIGNMARKER
       else
          LoI = LoMARKER
       finish
       int = -int if int < 0
       HiI1 = int>>HI6 ; int = int & Hi1MASK ; HiI1 = HiI1 ! HiMARKER
       HiI2 = int>>INT6 ; int = int & Hi2MASK ; HiI2 = HiI2 ! HiMARKER
       LoI = int ! LoI

       if HiI1 > HiMARKER then TTput(HiI1)
       if HiI2 > HIMARKER then TTput(HiI2)
       TTput (LoI)
    end {send int}

    !%own %short Segment Open = False, Last Segment = -1
    !
    !%external %routine Open Tek Segment %alias "EDWIN_OPEN_TEK_SEGMENT" (-
    !   %integer Number, Mode)
    !   %own %integer Last Mode = 0
    !   %if Last Segment > 0 %start
    !      Add ('S', 'C')
    !      Add ('R', 'F');   Send int (2)
    !      Add ('S', 'M');   Send int (Last Segment)
    !      %if Last Mode = 0 %start
    !         Send int (1)
    !      %else
    !         Send int (4)
    !      %finish
    !   %finish
    !   Add ('R', 'F');   Send int (0)
    !   Add ('S', 'E');   Send int (Number)
    !   Segment Open = True
    !   Last Segment = Number
    !   Last Mode = Mode
    !%end

    ! set colour map - routine to allow attributes of logical colour
    !        index to be changed.
    routine SET COLOUR MAP(integer index, hue, lightness, saturation)
       if (0 <= index <= 7) and (-32768 <= hue <= 32768) and c
             (0 <= lightness <= 100) and c
             (0 <= saturation <= 100) start

          ! set surface colour map
          Add ('T', 'G')
          ! 1 = surface No. (only one ), 4 = No. of array elements
          TTput('1') ; TTput('4')
          send int(index)
          send int(hue) ; send int(lightness) ; send int(saturation)
       finish
    end {set colour map}

    ! set colours - setup default colour map
    routine set colours
       set colour map(0,0,0,0)         { black }
       set colour map(1,0,100,0)       { white }
       set colour map(2,0,50,100)      { blue }
       set colour map(3,240,50,100)    { green }
       set colour map(4,120,50,100)    { red }
       set colour map(5,300,50,100)    { cyan }
       set colour map(6,180,50,100)    { yellow }
       set colour map(7,0,65,0)        { grey }
    end {set colours}

    external routine T41XX alias "EDWIN___U" (integer com, x, y)

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

       ! used to hold corner of box
       own integer wx, wy, mx, my
       string (63) Type St
       switch sw(0:MAX COM)

       ! put char - write one char to output
       routine put char
          do move(lastx, lasty) if move pending = TRUE
          ! graphic text (1 char)
          Add ('L', 'T');   TTput ('1');   TTPUT (x)
       end {put char}

       ! change attribute - change attribute x to y
       routine change attribute (integer x, y)
          switch sw(0:ATT maximum)

          return unless 0 <= x <= ATT maximum
          -> sw(x)

          sw(att colour):
             if Model = 4105 start
                y = 1 unless 0 <= y <= 7
                real col = y
                cur fill = -y
             else
                y = 1  unless 0 <= y <= 4
                real col = y
                if y>0 start
                   Add ('R', 'A'); send int (y)
                   y = 1
                   cur fill = real fill
                else
                   Add ('R', 'A'); send int (-1)
                   y = 0
                   cur fill = 0
                finish
             finish
             cur col = y
             ! set line index
             Add ('M','L');   send int(y)
             ! select fill pattern
             Add ('M','P');   send int(cur fill)
             ! select text colour
             Add ('M', 'T');  send int(y)
             return

          sw(att line style):
             y = 0 unless 0 <= y <= 7
             return if Cur style = y
             Cur style = y
             ! set line style
             Add ('M','V');   TTput(y+'0')
             return

          sw(att char size):
    !?         tsu = 13*y
    !?         %if 1 <= tsu <= 87 %start
    !?            tsu = 61 ; tcs = 5
    !?         %finish %else %if 88 <= tsu <= 148 %start
    !?            tsu = 122 ; tcs = 10
    !?         %else
    !?            tsu = 183 ; tcs = 15
    !?         %finish
    !?         ! set graphtext size
    !?         Add ('M','C');  TTput ('0');  sendint(tsu);  TTput ('0')
    !?         tsu = (tsu*5)//7 + 10 {convert height to width}
             return

          sw(att char rot): ! char orientation
    !?         %if y = curdir %then %return
    !?         curdir = y
    !?         ! Set Graphtext rotation
    !?         Add ('M','R');   sendint(y);   sendint(0)
             return

          sw(att char quality):
             ! Would be the MQ command on non-4105 displays, but they default
             ! to high quality, so there seems no reason to change it.
             return

          sw(att char slant):
             Add ('M', 'A') and sendint(y) if Model#4105
             return

          sw(att colour mode):
             omode = Y
             return

          sw(att shade mode):
             ! select fill pattern
             if Model = 4105 start
                Add ('M','P') and send int(y+1) if y>1
             else
                y = 1 unless 1<=y<=16
                Cur fill = Fill map (y)
                Cur fill = -cur col if cur fill = 0 or Model = 4105
                Real Fill = cur fill
                Add ('M', 'P');  send int (cur fill)
             finish
             return

          sw(*): ! ignore the rest
       end {change attribute}

       ! new frame - clear graphics screen
       routine new frame
          ! page
          Add ('R', 'A');   send int (-1)
    !      %if Last Segment # -1 %start
    !         Add ('R', 'F'); send int (0)   { Fix up level 0 }
    !         Add ('S', 'K'); send int (-1)  { Delete all segments }
    !         Add ('R', 'F'); send int (2)   { back to normal }
    !         Last Segment = -1
    !      %finish
          TTput (esc);   TTPUT (FF)
          lastx = 0 ; lasty = 0
          Change Attribute (0,real col)
          Add ('M', 'V') and TTPUT (cur style+'0') if cur style # 0
       end {new frame}

       -> sw(com)

    sw(0): ! initialise
           Model = X
           DEV DATA_NAME = "a Tektronix ".ItoS(Model,0)." terminal"
           Dev Data_Type = Model
           DEV DATA_DVX = 4095
           DEV DATA_DVY = 3071
           DEV DATA_MVX = 4095
           DEV DATA_MVY = 3071
           DEV DATA_MAX COLOUR = 7
           DEV DATA_MAX STYLES = 7
    !?       DEV DATA_NUM CHAR SIZES = 255
    !?       %if Model = 4105 %start
    !?           DEV DATA_NUM CHAR ROTS = 4
    !?       %else
    !?           DEV DATA_NUM CHAR SLANTS = 255
    !?           DEV DATA_NUM CHAR ROTS = 255
    !?       %finish
           Type St = "EDWIN_".ItoS (Model,0)
           if TRANSLATE(TYPEST)#TYPEST start
               SET DEVICE (TYPEST)
           finish
           TTMODE (1)
           ! select code tek, reset parameters
           Add ('%', '!');   sendint (0)
           ! Cancel (ie. Reset parameters)
           Add ('K', 'C')
           TTPUT (0) for X=1,1,200
           Flush Output  { To allow KC command to settle down }
           ! Set Flagging mode (to use ^S & ^Q)
           Add ('N', 'F');  sendint(1)
           ! set window
           add ('R','W');   coords(0,0) ; coords(Dev Data_DVX,Dev Data_DVY)
           new frame
           wx = X MIN ; wy = Y MIN
           ! Set dialog area to 30 lines
           add ('L', 'L');   send int (30)
           ! clear dialog area
           add ('L','Z')
           ! set dialog background transparent
           add ('L','I');   send int(1);   send int(0);   send int(0)
           ! set dialog area invisible
           Add ('L', 'V');   send int(0)
           ! set cursor speed
           add ('I','J');   send int(7);   send int(3)
           if Model > 4105 start
              ! Set to have 4 surfaces
              add ('R', 'D'); send int (4)
                              send int (1); send int (1); send int (1); send int (1)
              ! Set colour mode to RGB
              add ('T', 'M'); send int (1); send int (3)
              ! Set surface colour maps
              add ('T', 'G'); send int (1); send int (4); send int (1);
                              send int (100); send int (100); send int (100)
              add ('T', 'G'); send int (2); send int (4); send int (1);
                              send int (0); send int (0); send int (100)
              add ('T', 'G'); send int (3); send int (4); send int (1);
                              send int (0); send int (100); send int (0)
              add ('T', 'G'); send int (4); send int (4); send int (1);
                              send int (100); send int (0); send int (0)
           else
              set colours
           finish
           Graph mode = True
           return

    sw(1): ! terminate
           ! Set dialog area to 24 lines
           add ('L', 'L');   send int (24)
           ! Set dialog area visible
           Add ('L', 'V');   send int (1)
           if Model=4105 start
               ! Cancel (reset)
               add ('K','C')
               Flush Output
               ! The above seems to need to settle down, hence
               TTPUT (0) for x=1,1,200
               Flush Output
               ! code ansi, NB. Must be last command, as stops others working!
               Add ('%','!');   sendint (1)
           else
               ! Reset power-up state
               Add ('K', 'V')
           finish
           Flush Output
           TTmode (0)
           Graph Mode = False
           return

    sw(2): ! update
    !       Add ('S', 'C') %and Segment Open = False %if Segment Open = True
           ! Set dialog area visible
           Add ('L', 'V');   send int (1)
           ! Reset modes
    !       Add ('K', 'C')
    !       FLUSH OUTPUT
    !       ! The above seems to need to settle down, hence
    !       TTPUT (0) %for x=1,1,200
           FLUSH OUTPUT
           Graph mode = False
           return

    sw(3): ! new frame
           new frame
           Flush Output
           ! set dialog area invisible
           Add ('L', 'V');   send int(0)
           Graph mode = True
           return

    sw(4): ! move abs
           if Line Mode = 3 start
               ! The opening point of a polygon
               Add ('L', 'P');   Coords (x, y);   send int (0)
               move pending = False
               Line Mode = -1 { Polygon is now active }
           else
               move pending = True
           finish
           lastx = x ; lasty = y
           return

    sw(5): ! line abs
           if Line mode = 2 { Point mode } start
               Add ('L', 'H');   coords (x, y)   { NB. Assuming default MM state }
           else
               domove(lastx, lasty) if move pending = True
               drawto(x, y)
           finish
           lastx = x ; lasty = y
           return

    sw(6): ! output char
           put char
           return

    sw(7): ! change attribute
           change attribute (x, y)
           return

    sw(8): ! lower window bounds
           if x > 4095 start
              X MIN = 4095
           finish else if x < 0 start
              X MIN = 0
           else
              X MIN = X
           finish
           if y > 3071 start
              Y MIN = 3071
           finish else if y < 0 start
              Y MIN = 0
           else
              Y MIN = y
           finish
           return

    sw(9): ! upper window bounds
           ! make sure any commands with old window done first
           if x > 4095 start
              X MAX = 4095
           finish else if x < 0 start
              X MAX = 0
           else
              X MAX = x
           finish
           if y > 3071 start
              Y MAX = 3071
           finish else if y < 0 start
              Y MAX = 0
           else
              Y MAX = y
           finish
           if Model#4105 start
               ! Set viewport
               add ('R','V');   coords(Xmin, YMin);   coords(Xmax, Ymax)
           finish
           ! set window
           add ('R','W');   coords(Xmin, YMin);   coords(Xmax, Ymax)
           return

    sw(10): ! Mode, ie, points, lines, polygons etc.
            Add ('L', 'E') if Line mode < 0 { ie. in a polygon }
            X = 1 unless 0 <= X <= 3
            Line Mode = X
            return

    sw(11): ! was Overwrite mode
            change attribute (att colour mode, x)
            return

    sw(12): ! lower box bounds
            wx = X;   wy = y
            return

    sw(13): ! upper box bounds & draw box
            SWAP (WX, X) if WX > X
            SWAP (WY, Y) if WY > Y
            return if WX > X MAX or X < X MIN or WY > Y MAX or Y < Y MIN
            WX = X MIN if WX < X MIN
            WY = Y MIN if WY < Y MIN
            X = X MAX if X > X MAX
            Y = Y MAX if Y > Y MAX
            ! Box now clipped into the screen.
            ! begin panel
            add ('L','P');   coords(wx,wy);   send int(0)
            drawto(x,wy) ; drawto(x,y) ; drawto(wx,y)
            ! end panel
            add ('L','E')
            lastx = x ; lasty = y
            return

    sw(*): ! ignore rest
    end {T4105}

    ! T CURSOR - return state & x,y coords of cursor
    external routine T1 CURSOR alias "EDWIN___U_REQ"(integer name state,x,y)
       const integer TO4095 = 2, HI = 5, MASK = 31
       integer t

       ! enable 4010 GIN mode
       TTput(ESC);   TTput(SUB)
       Flush Output
       ! get report
       state = TTREAD
       x = ((TTREAD & MASK)<<HI + (TTREAD & MASK))<<TO4095
       y = ((TTREAD & MASK)<<HI + (TTREAD & MASK))<<TO4095
       t = TTREAD
    end {T1 CURSOR}

    end of file