! EDWIN driver for HP2648A Raster-scan terminal.

%external %routine %spec TTMODE (%integer I)
%external %routine %spec TTPUT (%integer CH)
%external %routine %spec FLUSH OUTPUT
%external %integer %fn %spec TTGET
%external %integer %spec DEVICE

! 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 XR = 719;   !Right hand side of device window
%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

%dynamic %routine HP2648A (%integer COM, X, Y)
   %switch SW(0:15)

   %routine PUT CHAR
      chars on ; leave
      put (x)
   %end
   
   %routine CHANGE ATTRIBUTE
      %own %byte %array mapline(0:4) = '1','7','4','6','5'
      %integer i
      %switch SW(0:15)
      -> SW(X)
   
SW(1):   ! Line type change
         star('m')
         put(mapline(y)) ; put('b')
         %return

SW(2):   ! Set char size.
         i = (y+3)//7
         i = 1 %if i < 1
         i = 8 %if i > 8
         star('m') ; put(i+'0') ; put('m')
         %return
   
SW(5):   ! Set character font
         star ('m')
         %if y=0 %then put ('o') %else put ('p')
         %return

SW(*):   ! Ignore the rest
   %end

   
   %return %if DEVICE#11
   COM = COM & 15
   -> SW(COM)

SW(0): ! Initialise
      ttmode (1)
      star('m') ; put('r') ; !set defaults
      aoff
      x = 2 ; y = 12
      change attribute
      %return

SW(1): !Terminate
      update
      ttmode (0)
      %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
       %return

SW(8): ! Ignore lower window bounds settings
       %return

SW(9): ! Upper window bounds
       xr=x
       %return

SW(11): ! Set painting mode
        star ('m');   put ('0'+X);   put ('a')
        %return

SW(*):
%end

%dynamic %routine HCURSOR (%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