    ! 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