! EDWIN driver for the HP 7221 plotter

%external %routine %spec PROMPT (%string (15) S)
%external %routine %spec TTMODE (%integer MODE)
%external %routine %spec TTPUT (%integer CH)
%external %routine %spec FLUSH OUTPUT
%external %integer %fn %spec TTREAD
%external %integer %fn %spec INSTREAM
%external %integer %fn %spec OUT STREAM
%external %integer %spec DEVICE
!%external %long %real %fn %spec SIN (%long %real A)
!%external %long %real %fn %spec COS (%long %real A)
%const %real D TO R = 57.2958; ! Magic number converts degrees to rads.

! Control characters
%const %integer TRUE = 0,   FALSE = 1
%const %integer ETX = 3
%const %integer ESC =27
%const %integer DEL = 127
%const %integer BUFF SIZE = 251

! Screen information
%own %integer CMODE = 0;    ! 0=>display, 1=> Console active
%own %integer MODE = 0;    !0 if alphamode
%own %integer SX = 0;      !Current device position
%own %integer SY = 0
%own %integer XL=0, YB=0; ! Lower window bounds.
%own %integer YT = 14000; ! Upper device window bound.
%own %integer XR = 16000; ! Right hand side of device window
%own %integer VIS = TRUE; ! if CVP inside VW
%own %integer TCS = 120; ! True char size.
%own %byte %integer CCOL = 1;  ! Current colour.
%own %byte %integer PM = FALSE;  ! Pending move.
%own %byte %integer PC = FALSE;  ! Pending colour change.
%own %byte %integer NEWFRAMED = FALSE; ! TRUE => NEW FRAME done
%own %integer INBUFF = 32; ! This is the initialisation code


%routine SBN (%integer N)
   ! This sends a single byte number to the plotter
   N = N+64 %if N&32 = 0
   TTPUT (N)
%end

%routine MBN (%integer N)
   ! A three byte number is sent to the plotter
   %integer NN


   TTPUT (96+N//4096)
   
   NN = (N//64)&63
   NN = NN + 64 %unless NN>31
   TTPUT (NN)

   NN = N&63
   NN = NN + 64 %unless NN>31
   TTPUT (NN)
%end

%routine MBP (%integer X, Y)
   ! Multiple byte pair of numbers (5 bytes)
   %integer N


   TTPUT (96+X//1024)
   
   N = (X//16)&63
   N = N + 64 %unless N>31
   TTPUT (N)

   N = (X&15)*4 + (Y//4096)
   N = N + 64 %unless N>31
   TTPUT (N)
   
   N = (Y//64)&63
   N = N + 64 %unless N>31
   TTPUT (N)

   N = Y&63
   N = N + 64 %unless N>31
   TTPUT (N)
%end

%routine MBA (%integer A)
   ! Gives a multi byte angle
   MBN (INT(2\15*(A/180)))
%end

%routine HP INSTRUCTION (%integer WHICH)
   TTPUT (ESC);   TTPUT ('.');   TTPUT (WHICH)
%end

%routine PON 
   HP INSTRUCTION ('(')
   CMODE=0
%end

%routine %spec RESERVE (%integer N)

%routine POF
   RESERVE (BUFF SIZE); ! force out anything which is present.
   HP INSTRUCTION (')')
   TTPUT (13)
   FLUSH OUTPUT
   CMODE=1
%end

%routine RESERVE (%integer N)
   ! Test to see if N chars. will fit in the buffer
   %integer S
   IN BUFF = IN BUFF + N
   %if IN BUFF>250 %start
       HP INSTRUCTION ('L')
       FLUSH OUTPUT
       S = IN STREAM
       SELECT INPUT (0)
       PROMPT (TO STRING (DEL))
       N = TTREAD %until N > ' '
       N = TTREAD %until N = NL; ! Ignore the response
       SELECT INPUT (S)
       IN BUFF = 0
       PROMPT ("Data: ")
   %finish
%end

%ROUTINE CHECK FOR PENDING COLOURS AND MOVES
   TTPUT ('v') %and SBN(5-CCOL) %if PC=TRUE
   TTPUT ('p') %and MBP (SX-XL, SY-YB) %if PM=TRUE
   PC = FALSE
   PM = FALSE
%end

%routine UPDATE
   %if CMODE=0 %start
       TTPUT (ETX) %if MODE=0
       RESERVE (10)
       PM = TRUE
       CHECK FOR PENDING COLOURS AND MOVES
       TTPUT ('v')
       SBN (5-CCOL)
       POF
   %finish
   MODE = -1
%end

%routine CHECK PLOTTING AND NO TEXT
   PON %if CMODE=1
   TTPUT (ETX) %and MODE=-1 %if MODE=0
%end

%external %routine HP SPEED (%integer VAL)
   %return %if DEVICE#3
   PON %if CMODE=1
   TTPUT (ETX) %if MODE=0
   VAL = 36 %unless 1<=VAL<=36
   TTPUT ('~');   TTPUT ('V')
   SBN (VAL)
%end

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

   %routine NEW FRAME
      %integer IN ST, OUT ST

      CHECK PLOTTING AND NO TEXT
      SX=XR;   SY = YT;   PM = TRUE;! Goto the edge.
      VIS = CCOL;                   ! VIS used to remember current colour.
      PC = TRUE;  CCOL = 5;         ! Drop pen
      UPDATE
      IN ST = INSTREAM
      OUT ST = OUT STREAM
      SELECT OUTPUT (0)
      SELECT INPUT (0)
      PRINT STRING ("Enter new sheet of ")
      %if XR<=20*400 %and 20*400<=YT<=28*400 %then PRINT STRING ("rotated A4") %else %start
          PRINT SYMBOL ('A')
          %if XR<=28*400 %and YT<=20*400 %then PRINT SYMBOL ('4') %else PRINT SYMBOL ('3')
      %finish
      PRINT STRING (" paper, type YES to continue")
      NEWLINE
      Prompt ("Ready?")
      SKIP SYMBOL %while NEXT SYMBOL#'Y' %and NEXT SYMBOL#'y'
      SKIP SYMBOL %until NEXT SYMBOL=NL
      SKIP SYMBOL
      SELECT OUTPUT (OUT ST)
      SELECT INPUT (INST)
      Prompt ("Data:")
      NEW FRAMED = TRUE
      ! Restore default state after newframe.
      CCOL = VIS;   SX = 0;   SY = 0;   VIS = TRUE;   PM = TRUE;   PC = TRUE
   %end

   %routine PUT CHAR
      ! Put out a text character properly.
   
      PON %if CMODE=1
      %if MODE#0 %start
          CHECK FOR PENDING COLOURS AND MOVES
          TTPUT ('~'); TTPUT ('''')
          MODE=0
      %finish
      TTPUT (X)
      SX = SX + TCS
      VIS = FALSE %if SX>XR
   %end

   %routine CHANGE ATTRIBUTE
      %switch SW(0:8)
      %const %integer DASH = 32

      %return %if X>8
      CHECK PLOTTING AND NO TEXT
      MODE = -1
      RESERVE (10)
      -> SW(X)
   
SW(0): Y=1 %unless 0<=Y<=4
       Y = 5 %if Y = 0;   ! As plotter colours are 5 - the edwin colour
       PC = TRUE
       CCOL = Y
       %return

SW(1): TTPUT('~');  TTPUT ('Q')
       %if Y=1 %start
           SBN(DASH + 2); SBN(4); MBN(60)
       %finish
       %if Y=2 %start
           SBN(DASH + 14);  SBN(4);  SBN(DASH + 2); SBN(4); MBN(240)
       %finish
       %if Y=3 %start
           SBN(DASH + 8);  SBN(4);  MBN(120)
       %finish
       %if Y=4 %start
           SBN(DASH + 16);  SBN(4);  MBN(200)
       %finish
       %return

SW(2): TTPUT('~');  TTPUT('%');  TCS=Y*100//98;   MBP(TCS, TCS+TCS)
       ! Note that the 100//98 scales the H/W chars to same scale as S/W ones.
       %return

SW(3): TTPUT ('w');   TTPUT ('w');   MBA (Y);     %return;   ! Char rot

SW(4): %return;   ! Ignore attempts to change quality

SW(5): TTPUT ('~');   TTPUT ('P');   MBP (Y,Y);   %return;   ! Char font

SW(6): TTPUT ('~');   TTPUT ('/');   MBA (Y);     %return;   ! Char slant

SW(7): %return;   ! Ignore any attempts to change intensity.

SW(8): HP SPEED (Y)
   %end

   %return %if DEVICE#3 %or COM>15
   -> SW(COM)

SW(0): ! Initialise
       TTMODE (1)
       PON
       TTPUT ('~');   TTPUT('_');     ! Initilalise
       TTPUT ('~');   TTPUT('W');     ! Set graph limits to full size
       MBP (0,0);     MBP(16000,11400);   TTPUT ('}')
       TTPUT ('~');   TTPUT('S');     ! Set Grid default
       MBP(16000,11400);   TTPUT ('}')
       HP INSTRUCTION ('M');          ! Set output mode
       TTPUT (';');   TTPUT (';');   TTPUT ('1');   TTPUT ('0');   TTPUT (';')
       TTPUT (':')
       X=0; Y=1
       CHANGE ATTRIBUTE; ! Colour to 1
       X=2; Y=120
       CHANGE ATTRIBUTE; ! Char size to small ones
       NEW FRAMED = FALSE
       %return

SW(1): !Terminate
       PON %if CMODE=1
       SX = XR;   SY = YT;   PM=TRUE;   ! Go to edge of paper.
       PC = TRUE;   CCOL = 5;           ! Drop pen.

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

SW(3): ! New frame
       NEW FRAME
       %return

SW(4): ! Move Abs
       NEW FRAME %if NEWFRAMED # TRUE
       CHECK PLOTTING AND NO TEXT
       SX = X;   SY = Y
       VIS = TRUE
       PM = TRUE
       MODE = 1
       %return

SW(5): ! Line Abs
       NEW FRAME %if NEW FRAMED # TRUE
       CHECK PLOTTING AND NO TEXT
       RESERVE (20)
       CHECK FOR PENDING COLOURS AND MOVES
       TTPUT ('q'); MBP(X-XL, Y-YB)
       SX = X;   SY = Y
       VIS = TRUE
       MODE = 1
       %return

SW(6): ! Character
       NEW FRAME %if NEWFRAMED # TRUE
       PUT CHAR %if VIS = TRUE
       %return

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

SW(8): ! Set lower  device window bounds
       XL = X
       YB = Y
       %return

SW(9): ! Set upper device window bounds
       XR = X
       YT = Y
       RESERVE (15)
       PON
       TTPUT ('~');   TTPUT ('W');   MBP (XL, YB);   MBP (XR, YT)
       TTPUT ('~');   TTPUT ('S');   MBP (XR-XL, YT-YB); TTPUT ('}')
       %return

SW(*):
%end

%external %routine HP C ARC (%integer RAD, %integer IA, FA)
   %integer OX, OY
   %return %if DEVICE#3
   RESERVE (20)
   OX = SX;   OY = SY
   P7221 (4, SX + INT (RAD * COS (IA * DtoR)), SY + INT (RAD * SIN (IA * DtoR)))
   CHECK PLOTTING AND NO TEXT
   CHECK FOR PENDING COLOURS AND MOVES
   TTPUT ('t')
   MBN (RAD)
   MBA (IA)
   MBA (FA)
   P7221 (4, OX, OY)
%end

%external %routine HP AC ARC (%integer RAD, %integer IA, FA)
   %integer OX, OY
   %return %if DEVICE#3
   RESERVE (20)
   OX = SX;   OY = SY
   P7221 (4, SX + INT (RAD * COS (IA / DtoR)), SY + INT ( RAD * SIN (IA / DtoR)))
   CHECK PLOTTING AND NO TEXT
   CHECK FOR PENDING COLOURS AND MOVES
   TTPUT ('u')
   MBN (RAD)
   MBA (IA)
   MBA (FA)
   P7221 (4, OX, OY)
%end

%external %routine HP CIRCLE (%integer RAD)
   %integer OX
   %return %if DEVICE#3
   RESERVE (20)
   OX = SX
   P7221 (4, SX+RAD, SY)
   CHECK FOR PENDING COLOURS AND MOVES
   TTPUT ('t')
   MBN (RAD)
   P7221 (4, OX, SY)
%end

%dynamic %routine P CURSOR (%integer %name STATE, X, Y)
   %integer I, S

   %integer %fn GET NUM
      %integer V,I
      V = 0
      I = TTREAD
      %cycle
         V = V*10+(I-'0')
         I = TTREAD
         %exit %unless '0'<=I<='9'
      %repeat
      %result = V
   %end

   PON %if CMODE=1
   TTPUT (ETX) %if MODE=0
   HP INSTRUCTION ('D')
   FLUSH OUTPUT
   S = IN STREAM
   SELECT INPUT (0)
   PROMPT (TO STRING (DEL))
   X = GET NUM
   Y = GET NUM
   I = GET NUM
   STATE = I<<4!GET NUM
   ! State is 'pen tp/down flag'<<4! Ctrrent pen.
   POF
   FLUSH OUTPUT
   PROMPT ("Data: ")
   SELECT INPUT (S)
%end

%end %of %file