C SUBROUTINE TTYINI
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERCIALLY.
C
C Modifications Record:
C =====================
C	Oct-90 Chris Doran, Sira
C	Complete rewrite to use SMG routines
C
	SUBROUTINE TTYINI
C PERFORM INITS ON UNIT 5. NORMALLY EITHER DO NOTHING OR
C REPLACE WITH SOMETHING THAT WORKS FOR YOUR SYSTEM. TYPICAL
C ACTIONS:
C  SET THE TERMINAL NOT TO WRAP AROUND
C  ATTACH TERMINAL SO TYPE-AHEAD WORKS
C  SET UP TERMINAL TO MUNGE AROUND THE ESCAPE SEQUENCES TO ALLOW
C  SPECIAL FUNCTION AND/OR ARROW KEYS TO WORK.
C VMS VERSION ... HIGHLY SYSTEM DEPENDENT...
	INCLUDE '($DSCDEF)'
	INCLUDE '($SMGDEF)'
	INCLUDE '($TTDEF)'
 	PARAMETER SM = 16, DECKPAM = 0, DECKPNM = 0
	INTEGER*4 DESBLK(5)
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	DATA RENDIT/0/
	DATA DESBLK(3)/1/
C  Definitions of arrow keys and others mapping to 1-character commands
	PARAMETER NARROW=7
	INTEGER*4 KARROW(NARROW)
     1	/SMG$K_TRM_UP,SMG$K_TRM_DOWN,SMG$K_TRM_LEFT,SMG$K_TRM_RIGHT,
     2	SMG$K_TRM_CTRLW,SMG$K_TRM_CTRLZ,SMG$K_TRM_F10/
	CHARACTER*1 CARROW(NARROW)/'1','2','3','4','V','X','X'/
C  Keypad definitions
	CHARACTER*11 AKCMD/'@DK:AK?.CMD'/
	CHARACTER*12 AKACMD/'@DK:AK?A.CMD'/
	CHARACTER*30 KEYNAM
	PARAMETER NKEYPD=14
	INTEGER*4 KKEYPD(NKEYPD)
     1	/SMG$K_TRM_KP0,SMG$K_TRM_KP1,SMG$K_TRM_KP2,SMG$K_TRM_KP3,
     2  SMG$K_TRM_KP4,SMG$K_TRM_KP5,SMG$K_TRM_KP6,SMG$K_TRM_KP7,
     3  SMG$K_TRM_KP8,SMG$K_TRM_KP9,SMG$K_TRM_COMMA,SMG$K_TRM_MINUS,
     4	SMG$K_TRM_PERIOD,SMG$K_TRM_ENTER/
	CHARACTER*1 CKEYPD(NKEYPD)
     1	/'E','F','G','H','I','J','K','L','M','N','A','B','C','D'/
	EXTERNAL TTYRES
C Main SMG startup is done by UVT100, which MUST be called first.
	CALL SMG$CREATE_KEY_TABLE(KEYTBL)
	CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_PF1,KEYNAM)
	CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,SMG$M_KEY_NOECHO,,'GOLD')
	CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_PF2,KEYNAM)
	CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'/H')
	CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'/H9')
	DO I=1,NARROW
	  CALL SMG$KEYCODE_TO_NAME(KARROW(I),KEYNAM)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  	SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,
     2		'/'//CARROW(I))
	ENDDO
	DO I=1,NKEYPD
	  CALL SMG$KEYCODE_TO_NAME(KKEYPD(I),KEYNAM)
	  AKCMD(7:7) = CKEYPD(I)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,AKCMD)
	  IF (KKEYPD(I).NE.SMG$K_TRM_PERIOD) THEN
	    AKACMD(7:7) = CKEYPD(I)
	    CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	    SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,AKACMD)
	  ELSE
C	    Gold . just terminates GOLD state -- no command file required
	    CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	    SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO)
	  ENDIF
	ENDDO
	CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_PF3,KEYNAM)
	IF (TTYPE.EQ.TT$_VT52) THEN
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYS.CMD')
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYSA.CMD')
C  .NOT. VT52 is assumed to be an LK201 keyboard, but it doesn't matter
C  if it's just a VT100.
	ELSE
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYR.CMD')
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYRA.CMD')
	  CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_PF4,KEYNAM)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYS.CMD')
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYSA.CMD')
	  CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_HELP,KEYNAM)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'/H')
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,'GOLD',
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'/H9')
C  LK201 'DO' = GOLD PF4 = recalculate
	  CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_DO,KEYNAM)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:KYSA.CMD')
C  LK201 'FIND' = KP5
	  CALL SMG$KEYCODE_TO_NAME(SMG$K_TRM_FIND,KEYNAM)
	  CALL SMG$ADD_KEY_DEF(KEYTBL,KEYNAM,,
     1	  SMG$M_KEY_TERMINATE.OR.SMG$M_KEY_NOECHO,'@DK:AKJ.CMD')
	ENDIF
C Set application mode keypad
	CALL UVT100(SM,DECKPAM)
C Queue a keypad change back on exit
	DESBLK(2)=%LOC(TTYRES)
	DESBLK(4)=%LOC(STAT)
	CALL SYS$DCLEXH(DESBLK)
	RETURN
	END
C
C INTEGER*4 FUNCTION READL(LUN,LINE,LTH)
C Read in a line on LUN LUN. If LUN = 1 or 5, and FOOBAR = 0, use SMG to fetch
C it from the screen (SYS$COMMAND); otherwise, read from a file, which could
C be SYS$INPUT.
C Returns: -2 on error, -1 on EOF, >=0 = no of chars read on success
	INTEGER*4 FUNCTION LREAD(LUN,LINE,LTH)
	LOGICAL*1 LINE(1)
	INCLUDE '($DSCDEF)'
	INCLUDE '($TRMDEF)'
	INTEGER*2 NCHARS,SMG$_EOF
	EXTERNAL SMG$_EOF
	RECORD /DSCDEF1/LINDES,PRDES
	LOGICAL*1 PROMPT(132)
	INTEGER*4 SMG$READ_STRING,FOOBAR
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /FOOBAR/FOOBAR
	IF (FOOBAR.EQ.0 .AND. (LUN.EQ.5 .OR. LUN.EQ.1)) THEN
	  LINDES.DSC$W_MAXSTRLEN=LTH
	  LINDES.DSC$B_DTYPE=DSC$K_DTYPE_T
	  LINDES.DSC$B_CLASS=DSC$K_CLASS_S
	  LINDES.DSC$A_POINTER=%LOC(LINE)
	  PRDES.DSC$A_POINTER=%LOC(PROMPT)
	  CALL GETPR(PRDES)
	  I=SMG$READ_STRING(KEYBD,LINDES,PRDES,LTH,
     1		TRM$M_TM_TRMNOECHO,,,NCHARS,,DISPLY,RENDIT)
	  IF (I.EQ.%LOC(SMG$_EOF)) GOTO 998
	  IF (.NOT.I) GOTO 999
	ELSE
	  READ(LUN,1000,ERR=999,END=998)NCHARS,(LINE(I),I=1,LTH)
 1000	  FORMAT(Q,<LTH>A1)
	ENDIF
	LREAD=NCHARS
	RETURN
 999	LREAD=-2
	RETURN
 998	LREAD=-1
	RETURN
	END
C
C SUBROUTINE GETTTL(LINE)
C Read in a terminal line on VAX.
C Keypad keys must be interpreted (this saves Analy!ticalc having to decode
C escape sequences).
C Returns: -2 on error, -1 on EOF, >=0 = no of chars read on success
	SUBROUTINE GETTTL(LINE)
	LOGICAL*1 LINE(132)
	INCLUDE '($DSCDEF)'
	INCLUDE '($SMGDEF)'
	RECORD /DSCDEF1/LINDES,PRDES
	LOGICAL*1 PROMPT(132)
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	LINDES.DSC$W_MAXSTRLEN=132
	LINDES.DSC$B_DTYPE=DSC$K_DTYPE_T
	LINDES.DSC$B_CLASS=DSC$K_CLASS_S
	LINDES.DSC$A_POINTER=%LOC(LINE)
	PRDES.DSC$A_POINTER=%LOC(PROMPT)
	CALL GETPR(PRDES)
	CALL SMG$READ_COMPOSED_LINE(KEYBD,KEYTBL,LINDES,PRDES,,
     1		DISPLY,SMG$M_FUNC_KEYS.OR.SMG$M_NORECALL)
	RETURN
	END
C
C SUBROUTINE GETPR(PRDES)
C Get the "prompt" string for LREAD or GETTTL -- Fetch all up to the current
C position on the current line. This prevents things line ctrl/R from deleting
C text to the left of the cursor. Unfortunately, rendition and line-drawing
C characters get lost.
	SUBROUTINE GETPR(PRDES)
	INCLUDE '($DSCDEF)'
	INCLUDE '($SMGDEF)'
	RECORD /DSCDEF1/PRDES
	INTEGER*4 SMG$CURSOR_COLUMN
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	PRDES.DSC$B_DTYPE=DSC$K_DTYPE_T
	PRDES.DSC$B_CLASS=DSC$K_CLASS_S
	PRDES.DSC$W_MAXSTRLEN=SMG$CURSOR_COLUMN(DISPLY)-1
	IF (PRDES.DSC$W_MAXSTRLEN.NE.0) THEN
	  CALL SMG$SET_CURSOR_ABS(DISPLY,,1)
	  CALL SMG$READ_FROM_DISPLAY(DISPLY,PRDES)
	ENDIF
	RETURN
	END
C
C INTEGER*4 FUNCTION LWRITE(LUN,LINE,LTH)
C Write characters on LUN LUN. If LUN = 1 or 6, use SMG to write it at the
C current screen position, as set by UVT100(CUP), in rendition set by
C UVT100(SGR).
C If the line contains escape, csi, ctrl/O, or ctrl/N (as in lines from command
C files or keypad diagrams, write with escape sequence parsing enabled.
C If not, leave it disabled, otherwise renditions don't work.
C If LUN is neither 1 nor 6, assume it's a file.
C Returns: -1 on error, +1 on success
	INTEGER*4 FUNCTION LWRITE(LUN,LINE,LTH)
	LOGICAL*1 LINE(1)
	INCLUDE '($DSCDEF)'
	INTEGER*4 SMG$PUT_CHARS,SMG$PUT_WITH_SCROLL,
     1		STR$FIND_FIRST_IN_SET
	INTEGER*4 ESCSEQ
	RECORD /DSCDEF1/LINDES
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	IF (LTH.EQ.0) RETURN
	IF (LUN.EQ.6 .OR. LUN.EQ.1) THEN
	  LINDES.DSC$W_MAXSTRLEN=LTH
	  LINDES.DSC$B_DTYPE=DSC$K_DTYPE_T
	  LINDES.DSC$B_CLASS=DSC$K_CLASS_S
	  LINDES.DSC$A_POINTER=%LOC(LINE)
	  ESCSEQ = STR$FIND_FIRST_IN_SET(LINDES,
     1		CHAR(27)//CHAR(155)//CHAR(14)//CHAR(15))
	  IF (ESCSEQ.NE.0) CALL SMG$ALLOW_ESCAPE(DISPLY,1)
	  LWRITE = SMG$PUT_CHARS(DISPLY,LINDES,,,,RENDIT)
	  IF (ESCSEQ.NE.0) CALL SMG$ALLOW_ESCAPE(DISPLY,0)
	  IF (.NOT.LWRITE) GOTO 999
	ELSE
	  WRITE(LUN,1000,ERR=999)(LINE(I),I=1,LTH)
 1000	  FORMAT('+',<LTH>A1,$)
	ENDIF
	LWRITE=1
	RETURN
 999	LWRITE=-1
	RETURN
	END
C
C INTEGER*4 FUNCTION LCRLF(LUN)
C Advance to the start of the next line. If LUN = 1 or 6, use SMG to write to
C at the screen, if LUN is neither 1 nor 6, write to a file.
C Screen output is far more complicated than you'd think, because we have to
C defeat SMG's cunning ruse to let you use the bottom line of the screen by
C not scrolling until you write something. The snag is that that write must
C be done by SMG$PUT_LINE, not by SMG$PUT_CHARS, but we want to build up
C lines with SMG$PUT_CHARS and scroll up when you start the next line. It is an
C undocumented restriction (DEC tell me) that you can't do it that way!
C Returns: -1 on error, +1 on success
	INTEGER*4 FUNCTION LCRLF(LUN)
	INTEGER*4 ROW,SMG$CURSOR_ROW,SMG$SET_CURSOR_ABS
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	IF (LUN.EQ.6 .OR. LUN.EQ.1) THEN
	  ROW = SMG$CURSOR_ROW(DISPLY)
	  IF (ROW.EQ.24) THEN
	    CALL SMG$SCROLL_DISPLAY_AREA(DISPLY)
	  ELSE
	    ROW=ROW+1
	  ENDIF
	  IF (.NOT.SMG$SET_CURSOR_ABS(DISPLY,ROW,1)) GOTO 999	    
	ELSE
	  WRITE(LUN,1001,ERR=999)
 1001	  FORMAT(' ')
	ENDIF
	LCRLF=1
	RETURN
 999	LCRLF=-1
	RETURN
	END
C
C
C TTYRES is called on exit to put the terminal back the way we found it
C -- especially numeric keypad
	SUBROUTINE TTYRES(COND)
	INTEGER*4 COND
	PARAMETER RM = 17, DECKPAM = 0, DECKPNM = 0
	INTEGER*4 PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	COMMON /SMG/PASTE,DISPLY,KEYBD,KEYTBL,RENDIT,TTYPE,DEVDP2
	CALL SMG$CANCEL_INPUT(KEYBD)
	CALL UVT100(RM,DECKPNM)
	RETURN
	END
