! EDWIN driver for 4000 series Tektronix storage tubes.

%external %routine %spec PROMPT (%string (63) STR)
%external %routine %spec TTMODE (%integer PARM)
%external %routine %spec TTPUT (%integer CH)
%external %routine %spec FLUSH OUTPUT
%external %integer %fn %spec IN STREAM
%external %integer %spec DEVICE

! Control characters
%const %integer DC1 = 17;            ! Invokes cursor on 4002.
%const %integer SUB = 26;            ! Invokes cursor on later models.
%const %integer ESCAPE = 27
%const %integer GRAPHMODE = 29
%const %integer ALPHAMODE = 31
%const %integer ERASE SCREEN = 12
%const %integer NUL = 0
%const %integer DEL = 127

! Device
%own %integer TYPE = 4012
%own %integer INVOKE CURSOR

! Screen information
%own %integer AMODE = 0;    ! Advanced mode for 4014
%own %integer MODE = 0;    !0 if alphamode
%own %integer SX = 0;      !Current device position
%own %integer SY = 0
%own %integer XR = 1023;   !Right hand side of device window
%own %integer VIS = 0;     !0 if CVP inside VW
%own %byte %integer TCS = 13; ! True char size.

%routine PAD (%integer SYM,NO)
   %integer I
   TTPUT (SYM) %for I = 1,1,NO
%end

%routine UPDATE
   PAD (NUL,4)
   TTPUT (ALPHA MODE)
   TTPUT (25) %if TCS=24; ! Sets big chars on 4002
   FLUSH OUTPUT
   MODE=0
%end

%external %routine T4000 (%integer COM, X, Y)
   %switch SW(0:15)

   %routine PUT CHAR
      ! Put out a text character properly.
      UPDATE %if MODE#0
      TTPUT (X)
      TTPUT (0)
      SX=SX+TCS
      VIS = 1 %if SX>XR
   %end
   
   %routine GOTO(%integer X,Y); !Code up coordinates and send to TTY
      %constinteger HI=32,LY=96,LX=64,ENH=7
      TTPUT (Y>>5&31!HI); TTPUT (Y&31!LY)
      TTPUT ((ENH<<4)!(Y>>10&3)!(X>>10&3)) %if AMODE#0
      TTPUT (X>>5&31!HI); TTPUT (X&31!LX)
   %end
   
   %routine CHANGE ATTRIBUTE
      %switch SW(0:15)
      -> SW(X)
   
SW(0):    %return

SW(1):    %if TYPE =4014 %start
              TTPUT(ESCAPE)
              TTPUT(Y+96)
          %finish
          %return

SW(2):    TCS = 13
          %if TYPE = 4014 %start
              TTPUT (ESCAPE)
              %if Y <  8 %then TTPUT (';') %and TCS=7 %else %start
                  %if Y < 10 %then TTPUT(':') %and TCS=9 %else %start
                      %if Y < 13 %then TTPUT ('9') %and TCS=13 %c
                                  %else TTPUT ('8') %and TCS=14
                  %finish
              %finish
          %finish
   
          %if TYPE = 4002 %start
              %if Y>23 %then TCS=24 %else TCS=12
              MODE = 1; ! To ensure we set this
          %finish
   
          %return
   
SW(3):SW(4):
SW(5):SW(6): %return; ! Ignore changes orient, Quality, fount or intensity.

SW(7): SW(8): SW(9): SW(10): SW(11): SW(12): SW(13): SW(14): SW(15):
   %end

   
   %return %if DEVICE#0 %and DEVICE#1
   COM = COM & 15
   %return %if COM > 9
   -> SW(COM)

SW(0): ! Initialise
       TTMODE (1)
       TYPE = X
       %if TYPE=4002 %then INVOKE CURSOR=DC1 %else INVOKE CURSOR=SUB
       X=1; Y=0
       CHANGE ATTRIBUTE
       X=2; Y=12
       CHANGE ATTRIBUTE
       %return

SW(1): !Terminate
        PAD (NUL,4)
        TTPUT (ALPHA MODE)
        TTPUT (13)
        TTPUT (10)
        TTPUT (ESCAPE) %and TTPUT (';') %if TYPE=4014
        TTPUT (24); ! Resets ADM terminals
        FLUSH OUTPUT
        TTMODE (0)
        %return

SW(2): ! Update
       UPDATE
       NEWLINE %if COM=1
       %return

SW(3): ! New frame
       TTPUT (ESCAPE)
       TTPUT (ERASE SCREEN)
       PAD (DEL,960)
       SX=0; SY=0; MODE=0
       %return

SW(4): ! Move Abs
       TTPUT (GRAPH MODE) 
       GOTO (X,Y)
       SX=X;  SY=Y
       MODE = 1; VIS=0
       %return

SW(5): ! Line Abs
       %if MODE=0 %start
           TTPUT (GRAPH MODE)
           GOTO (SX,SY)
       %finish
       GOTO (X,Y)
       MODE = 1
       SX=X; SY=Y
       VIS=0
       %return

SW(6): ! Character
       PUT CHAR %if VIS=0
       %return

SW(7): ! Attribute  Change
       CHANGE ATTRIBUTE
       %return

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

SW(9): ! Upper window bounds
       XR=X
       AMODE = 1 %if TYPE=4014 %and (X>1023 %or Y>1023)

%end

%external %routine TCURSOR (%integer %name CH, X, Y)
   %integer A,B,C,D,E,IS

   ! This method of getting the cursor leaves the prompt unchanged.
   PAD (NUL,4);   TTPUT (ALPHA MODE); FLUSH OUTPUT
   IS = IN STREAM
   SELECT INPUT (0)
   PROMPT (TO STRING (ESCAPE).TO STRING (INVOKE CURSOR))
   READ SYMBOL (CH) %until CH>31; ! The Key
   READ SYMBOL (A);  READ SYMBOL (B);  READ SYMBOL (C);  READ SYMBOL (D);  ! Coords.
   READ SYMBOL (E) %until E<' '
   X = (A&31)<<5!B&31
   Y = (C&31)<<5!D&31
   SELECT INPUT (IS)
   MODE = 0
%end

%end %of %file