! EDWIN driver for HP2648A Raster-scan terminal.

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

! Control characters
const integer BEL = 7
const integer cr = 13
const integer DC1 = 17
const integer esc = 27
const integer sp = ' '

! Screen information
own integer SEQ = 0;       ! Escape-sequence type
own integer SUBSEQ = 0;    ! Escape-subsequence
own integer pend = 0;      ! Pending char in sequence
own integer alpha = 0;     ! Graphics text is on if # 0
own integer SX = 0;        !Current device position
own integer SY = 0
own integer XL = 0
own integer XR = 719;     !Right hand side of device window
own integer YB = 0
own integer YT = 300
own integer alpha disp = 1;   ! = 0 if alpha is off

routine put ( integer i )
   ttput(pend) if pend # 0
   pend = i
end

routine put coord ( integer x )
   ! Codes up binary absolute coordinate
   integer hi
   hi = x >> 5
   put( sp + hi&2_11111 )
   put( sp + x &2_11111 )
end

routine goto ( integer x, y )
   put coord(x)
   put coord(y)
end

routine leave
   return if seq = 0
   seq = 0
   pend = 'z' if pend = 0
   put('z') unless 'a' <= pend <= 'z'
   pend = pend + 'A' - 'a'
end

routine star ( integer sub )
   return if seq = '*' and subseq = sub
   leave
   put(esc) ; put('*') ; put(sub) ; put(0) ; !no pending
   put('i') if sub = 'p';  !plotting absolute
   seq = '*' ; subseq = sub
end

routine aoff
   return if alpha disp = 0
   star('d') ; put('f')
   alpha disp = 0
end

routine aon
   return unless alpha disp = 0
   star('d') ; put('e')
   alpha disp = 1
end

routine chars on
   return if alpha # 0
   star('d') ; put('s')
   alpha = 1
end

routine chars off
   return if alpha = 0
   star('d') ; put('t')
   alpha = 0
end

routine update
   chars off
   aon
   leave
   put(0)           ; !clear off pend
   flush output
end

external routine HP2648 alias "EDWIN___R" (integer COM, X, Y)
   own integer WX, WY
   switch SW(0:MAX COM)

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

   routine PUT CHAR
      chars on ; leave
      put (x)
   end
   
   routine CHANGE ATTRIBUTE (integer WHICH, TO)
      own byte array mapline(0:4) = '1','7','4','6','5'
      integer i
      switch AS(0:ATT MAXIMUM)
      -> AS(WHICH)
   
AS(att line style):
      star('m')
      to = 0 unless 0<=to<=4
      put(mapline(to)) ; put('b')
      return

AS(att char size):
      i = (to+3)//7
      i = 1 if i < 1
      i = 8 if i > 8
      star('m') ; put(i+'0') ; put('m')
      return
   
AS(att char font):
      star ('m')
      if to=0 then put ('o') else put ('p')
      return

AS(att colour mode):
      star ('m');   put ('0'+to);   put ('a')
      return

AS(*): ! Ignore all other attributes
   end

   -> SW(COM)

SW(0): ! Initialise
      dev data_name = "an HP 2648 Terminal"
      dev data_dvx = 719
      dev data_dvy = 359
      dev data_Mvx = 719
      dev data_Mvy = 359
      star('m') ; put('r') ; !set defaults
      aoff
      return

SW(1): !Terminate
      update
      return

SW(2): ! Update
       update
       return

SW(3): ! New frame
      aoff
      star('d') ; put('a')
      return

SW(4): ! Move Abs
      aoff
      star('p')
      put('a') ; goto (x,y)
      sx=x;  sy=y
      return

SW(5): ! Line Abs
      aoff
      star('p')
      if alpha # 0 start;   !must move first
         put('a')
         goto (sx,sy)
      finish
      goto (x,y)
      sx=x; sy=y
      return

SW(6): ! Character
       aoff
       put char
       return

SW(7): ! Attribute  Change
       change attribute (x, Y)
       return

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

SW(9): ! Upper window bounds
       XR = X;   YT = Y
       return

SW(10): ! ??
        return

SW(11): ! Was overwrite mode
        Y = X
        X = Att Colour mode
        -> SW (7)

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.
        HP2648 (4, Wx, Wy)
        HP2648 (5, Wx, y)
        HP2648 (5, x,y)
        HP2648 (5, x, Wy)
        HP2648 (5, Wx, wy)
        return

SW(*):
end

external routine R REQ alias "EDWIN___R_REQ" (integer name CH, X, Y)
   integer sym

   integer function num
      integer res
      res = 0
      sym = ttget until '0' <= sym <= '9'
      while '0' <= sym <= '9' cycle
         res = res*10+sym-'0'
         sym = ttget
      repeat
      result = res
   end

   leave ; put(bel)
   star('s') ; put('4') ; put('^') ; put(dc1) ; put(0)
   flush output ; seq = 0
   x = num ; y = num ; ch = num
   sym = ttget while sym >= ' '
   put(cr)
end

end of file