! 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