.;
.; UPS.CMD
.;
.; This is a procedure to mail a bunch of files.
.;
	.SETS S$PROC <FILSPC>

.; Required ICP initialization:

	.ENABLE SUBSTITUTION
	.DISABLE DISPLAY
	.DISABLE DETACH
	.ENABLE CONTROL-Z
	.ENABLE ESCAPE-SEQUENCE
	.ENABLE OVERFLOW

.; Required TT: driver initialization (must come after the
.;		.ENABLE ESCAPE-SEQUENCE):

	.SETN TIWID <TICWID>
	.SETS MCR ""
	.IF <CLI> <> "MCR"	.SETS MCR "MCR "
	.ENABLE QUIET
	'MCR'SET /FORMFEED=TI:
	'MCR'SET /LOWER=TI:
	'MCR'SET /ESCSEQ=TI:
	'MCR'SET /BUF=TI:132.
	.DISABLE QUIET

.; Useful symbol definitions:

	.; The following are suitable for ASCII terminals:

	.SETN NJUNK 7			! Define BELL to be a
	.SETS BELL "'NJUNK%V'"		!    <Bell> character.
	.SETN NJUNK 12			! Define LF to be a
	.SETS LF "'NJUNK%V'"		!    <Linefeed> char.
	.SETN NJUNK 14			! Define FF to be a
	.SETS FF "'NJUNK%V'"		!    <Formfeed> char.
	.SETN NJUNK 16			! Define SO to be a
	.SETS SO "'NJUNK%V'"		!    <Shift Out> char.
	.SETN NJUNK 17			! Define SI to be a
	.SETS SI "'NJUNK%V'"		!    <Shift In> char.
	.SETN NJUNK 33			! Define ESCAPE to be
	.SETS ESCAPE "'NJUNK%V'"	!    an <ESC> character
	.SETN NJUNK 217			! Define SS3 to be an
	.SETS SS3 "'NJUNK%V'"		!    <SS3> (="<ESC>O")
	.SETN NJUNK 233			! Define CSI to be a
	.SETS CSI "'NJUNK%V'"		!    <CSI> (="<ESC>[")
	.SETS BLANKS "                                        "
	.SETS BLANKS BLANKS+BLANKS+BLANKS

	.; The following are suitable for ANSI terminals:

	.SETS HOME ESCAPE+"[H"		! HOME homes cursor
	.SETS CLEAR ESCAPE+"[J"		! CLEAR clears screen
	.SETS CLRLIN ESCAPE+"[K"	! Clear line.
	.SETS BOLD ESCAPE+"[1m"		! Bold video.
	.SETS REV ESCAPE+"[7m"		! Reverse video
	.SETS NML ESCAPE+"[m"		! Normal screen attrib.
	.SETS BOTTOM ESCAPE+"[24;1H"

	.; The following initializes a DEC VT100 or VT200
	.; series terminal by homing and clearing the screen,
	.; loading the normal ASCII character set into G0 and
	.; the graphics character set into G1, and selecting G0.

	.SETS INIT HOME+CLEAR+ESCAPE+"(B"+ESCAPE+")0"+SI+NML

	.SETS S$PCHR "5555568800224444"

	.; Define parameters used in processing the arrow keys:
	.; These are defined by:
	.;	.SETS ARROWx "axis,fac,sign,limit,test"
	.;   where:
	.;	x	= last character of escape sequence;
	.;	axis	= name of symbol to update;
	.;	fac	= factor to apply if PF1 in effect;
	.;	sign	= direction of travel along axis;
	.;	limit	= limiting value on the axis;
	.;	test	= type of test to make against limit.

	.SETS ARROWA "N$FLD,8,-,0.,<"		! <CSI>A = Up arrow.
	.SETS ARROWB "N$FLD,8,+,N$FMAX,>"	! <CSI>B = Down arrow.
	.SETS ARROWC "N$CVAL,10,+,N$CMAX,>"	! <CSI>C = Right arrow.
	.SETS ARROWD "N$CVAL,10,-,N$CMIN,<"	! <CSI>D = Left arrow.
	.SETS ARROW5 "N$SCR,8,-,0.,<"		! Fake for "Prev Screen"
	.SETS ARROW6 "N$SCR,8,+,N$SMAX,>"	! Fake for "Next Screen"

	.GOTO ENTRY			! Skip subroutines.


.; And, some useful subroutines:

	.;
	.;	.GOSUB ASKE size;line;column
	.;
	.; Positions the cursor at the given line and column,
	.; and issues a .ASKS. On return,
	.;	TEXT contains the text part of the answer;
	.;	ESCSEQ contains the escape sequence;
	.;	<STRLEN> contains the location of the escape
	.;	    character.
	.;
.ASKE:
	.PARSE COMMAN ";" FLDSIZ COMMAN
	.PARSE COMMAN "\" COMMAN FLDTXT
	.GOSUB POSITN 'COMMAN%C'
	.TEST FLDTXT
	.SETS FLDTMP FLDTXT+BLANKS[<STRLEN>+1:'FLDSIZ'.]
	.SETS ESCSEQ ""
	.INC N$FLD
	.ASKS [::FLDTXT] TEXT 'COMMAN''REV''FLDTMP''COMMAN'
	.SETS S$ERR ""
	.SETS S$GOTO "DISPAT"
	.IFT <EOF>	.RETURN
	.TEST TEXT ESCAPE
	.IF <STRLEN> = 0	.TEST TEXT CSI
	.IF <STRLEN> = 0	.TEST TEXT SS3
	.IF <STRLEN> <> 0	.SETS ESCSEQ TEXT[<STRLEN>:*]
	.IF <STRLEN> <> 0	.SETS TEXT TEXT[1:<STRLEN>-1]
	.IF TEXT = ""	.SETS TEXT FLDTXT
	.TEST TEXT
	.SETS FLDTMP TEXT+BLANKS[<STRLEN>+1:'FLDSIZ'.]
	;'COMMAN''REV''FLDTMP''BOTTOM''NML''CLRLIN''HOME'
	.RETURN

	.;
	.;	.GOSUB POSITN line;column
	.;
	.; returns the escape sequence in COMMAN.
	.;
	.; The following is suitable for an ANSI terminal.
	.;
.POSITN:
	.SETS COMMAN ESCAPE+"["+"'COMMAN%C'"+"H"
	.RETURN

	.;
	.;	.GOSUB PLOTF size;line;column\text
	.;
	.; Plots the text in a reverse field at the given location.
	.;
.PLOTF:
	.PARSE COMMAN ";" FLDSIZ COMMAN
	.PARSE COMMAN "\" COMMAN FLDTXT
	.GOSUB POSITN 'COMMAN%C'
	.TEST FLDTXT
	.SETS FLDTMP FLDTXT+BLANKS[<STRLEN>+1:'FLDSIZ'.]
	;'COMMAN''REV''FLDTMP'
	.RETURN


.ENTRY:	.;
	.SETT L$Y
	.SETF L$N
	.SETT L$T
	.SETF L$F
	.SETF L$0
	.SETT L$1
	.SETS S$T "Y"
	.SETS S$F "N"
	.SETN N$T 1.
	.SETN N$F 0.
	.SETN N$Y 1.
	.SETN N$N 0.
	.SETF GOLD
	.SETS S$GCTL "FLD"

	.SETN N$SCR 0.			! Initialy in screen 0 (= main)
	.SETN N$SMAX 0.			! Have a total of 1 screen.
	.SETN N$FLD 0.			! Initially on field 0 of that screen.
	.SETN N$FMX0 16.		! Screen 0 has 17 fields.
	.SETN N$FMAX N$FMX'N$SCR%D'	! Set max flds for current screen.
	.SETN N$CVAL 0.			! Coded value of current field.
	.SETN N$CMIN 0.			! Min. coded value.
	.SETN N$CMAX 0.			! Max. coded value.

	.SETS S$ADRS ""			! Default address field.
	.SETS S$SUBJ ""			! Default subject.
	.SETS S$FL00 ""			! Default first file.
	.SETS S$FL01 ""			! Default second file.
	.SETS S$FL02 ""			! Default third file.
	.SETS S$FL03 ""			! Default fourth file.
	.SETS S$FL04 ""			! Default fifth file.
	.SETS S$FL05 ""			! Default sixth file.
	.SETS S$FL06 ""			! Default seventh file.
	.SETS S$FL07 ""			! Default eighth file.
	.SETS S$FL08 ""			! Default nineth file.
	.SETS S$FL09 ""			! Default tenth file.
	.SETS S$FL10 ""			! Default eleventh file.
	.SETS S$FL11 ""			! Default twelfth file.
	.SETS S$FL12 ""			! Default thirteenth file.
	.SETS S$FL13 ""			! Default fourteenth file.
	.SETS S$FL14 ""			! Default fifteenth file.

	.SETS S$ERR ""
	.SETS ESCSEQ ""
	.SETS TEXT P1
.PAINT:
	.GOTO PAINT'N$SCR%D'

.PAINT0:;'INIT'
	.TEST S$PROC
	.SETN N$COL 40.-(<STRLEN>/2)
	.SETS S$JUNK BLANKS[1:N$COL]+S$PROC
;'HOME''CLEAR''S$JUNK'
;                              File Mailing Utility
;                    Use: ^Z to exit, <PF4> or <DO> to execute
;
;     To: 'REV''S$ADRS%L40''NML'
;Subject: 'REV''S$SUBJ%L40''NML'
;
;  Files: 'REV''S$FL00%L40''NML'
;         'REV''S$FL01%L40''NML'
;         'REV''S$FL02%L40''NML'
;         'REV''S$FL03%L40''NML'
;         'REV''S$FL04%L40''NML'
;         'REV''S$FL05%L40''NML'
;         'REV''S$FL06%L40''NML'
;         'REV''S$FL07%L40''NML'
;         'REV''S$FL08%L40''NML'
;         'REV''S$FL09%L40''NML'
;         'REV''S$FL10%L40''NML'
;         'REV''S$FL11%L40''NML'
;         'REV''S$FL12%L40''NML'
;         'REV''S$FL13%L40''NML'
;         'REV''S$FL14%L40''NML'
;'BOTTOM''CLRLIN''BOLD''S$ERR''NML''HOME'

	.GOTO DISPAT

.DISPAT:
	.SETN N$OFLD N$FLD
	.SETS S$OGCT S$GCTL
	.SETS S$GCTL "FLD"
	.GOTO 'S$OGCT''N$SCR%DR1Z''N$FLD%DR2Z'

.FLD000:
	.GOSUB ASKE 40;5;10\'S$ADRS'
	.IFT <EOF>	.GOTO EXIT
	.DISABLE LOWERCASE
	.SETS S$ADRS TEXT
	.ENABLE LOWERCASE
	.GOTO ESCPSI

.FLD001:
	.GOSUB ASKE 40;6;10\'S$SUBJ'
	.IFT <EOF>	.GOTO EXIT
	.SETS S$SUBJ TEXT
	.GOTO ESCPSI

.FLD002:
.FLD003:
.FLD004:
.FLD005:
.FLD006:
.FLD007:
.FLD008:
.FLD009:
.FLD010:
.FLD011:
.FLD012:
.FLD013:
.FLD014:
.FLD015:
.FLD016:
	.SETN N$ROW N$FLD+6.
	.SETN N$FILE N$FLD-2.
	.SETS S$FILE S$FL'N$FILE%DR2Z'
	.GOSUB ASKE 40;'N$ROW%D';10\'S$FILE'
	.IFT <EOF>	.GOTO EXIT
	.DISABLE LOWERCASE
	.SETS TEXT "'TEXT%C'"
	.ENABLE LOWERCASE
	.IF TEXT = ""	.GOTO ESCPSI
	.SETS S$ERR "Error - File 'TEXT' not found."
	.TESTFILE 'TEXT'
	.IF <FILERR> <> 1	.GOTO INPERR
	.SETS S$FL'N$FILE%DR2Z' <FILSPC>
	.GOSUB PLOTF 40;'N$ROW%D';10\'<FILSPC>'
	.SETS S$ERR ""
	.GOTO ESCPSI


.INPERR:;'BOTTOM''CLRLIN''BOLD''S$ERR''NML''HOME'
.LGCERR:.SETN N$FLD N$OFLD
	.GOTO 'S$GOTO'


.; Initialize the escape sequence parser:

.ESCPSI:
	.SETS ESCTYP "INI"	! Set parser "state".
	.SETN ESCAMX 0.		! Set number of arguments.
	.SETN ESCA0 0.		! Clear the first argument.

.; Main parser loop:

	.; Strip off the next character (if any), convert it to 
	.; a number, and do a "computed" GO TO based on current 
	.; parser state and character code:

.ESCPSR:
	.IF ESCSEQ = ""	.GOTO 'S$GOTO'	! If done, get more.
	.SETS CHAR ESCSEQ[1:1]		! Get first character,
	.SETS ESCSEQ ESCSEQ[2:*]	!  remove from buffer.
	.SETN CVALUE 'CHAR%V'		! Get its value.
	.ONERR ESCPSE			! Trap unexpected chars.
	.GOTO 'ESCTYP''CVALUE'		! Handle this character.

.ESCPSE:.SETN N$FLD N$OFLD
	.SETF GOLD
	.GOTO 'S$GOTO'

	.; First character = <ESC>; set state:

.INI33:	.SETS ESCTYP "ESC"		! Go to escape "state".
	.GOTO ESCPSR			! Get next character.

	.; First character is <SS3>, or

.INI217:.;

	.; First was <ESC> and second is "O"; set state:

.ESC117:.SETS ESCTYP "SS3"		! Go to SS3 "state".
	.GOTO ESCPSR			! Get next character.

	.; Got <CSI>nnn~ = one of the "F" keys. Dispatch appropriately.

.CSI176:.GOTO FKY'ESCA0%D'

	.; Got <SS3>P = PF1 - use it as shift key:

.SS3120:.SETN N$FLD N$OFLD
	.SETT GOLD			! Set shift flag.
	.GOTO ESCPSI			! Get next escape seq.

.FKY28:	.; Got LK201 "Help" key.

	.; Got <SS3>Q = PF2 - use it as help key:
	.; (not implimented).
.; .SS3121:.SETS S$GOTO "PAINT"
	.SETN N$FLD N$OFLD
	.SETN N$OFLD 2.
	.IF N$SCR = 2.	.SETN N$OFLD 0.
	.SETN N$SCR N$OFLD
	.SETN N$OFLD 0.
	.SETN N$FLD 0.
	.SETN N$FMAX N$FMX'N$SCR'
	.SETF GOLD
	.GOTO ESCPSI			! Get next escape seq.

	.; Got <SS3>R = PF3 - use it as refresh screen key.

.SS3122:.SETS S$GOTO "PAINT"
	.SETN N$FLD N$OFLD
	.GOTO REFRSH
	.IFT GOLD	.GOTO REFRSH
	.SETN N$OFLD 1.
	.IF N$SCR = 1.	.SETN N$OFLD 0.
	.SETN N$SCR N$OFLD
	.SETN N$OFLD 0.
	.SETN N$FLD 0.
	.SETN N$FMAX N$FMX'N$SCR'
.REFRSH:.SETF GOLD
	.GOTO ESCPSI			! Get next escape seq.

.FKY29:	.; Got LK201 "Do" key.

	.SETF GOLD			! Turn off "gold".

	.; Got <SS3>S = PF4 - use it as send key.

.SS3123:.SETN N$FLD N$OFLD
	.SETS S$GOTO "DOIT"
	.GOTO ESCPSI			! Get next escape seq.

	.; First character is <CSI>, or

.INI233:.;

	.; First was <ESC> and second is "["; set state:

.ESC133:.SETS ESCTYP "CSI"		! Go to CSI "state".
	.GOTO ESCPSR			! Get next character.

	.; In a <CSI> sequence, and have a decimal digit:

.CSI60:	.;
.CSI61:	.;
.CSI62:	.;
.CSI63:	.;
.CSI64:	.;
.CSI65:	.;
.CSI66:	.;
.CSI67:	.;
.CSI70:	.;
.CSI71:	.;
	.;				! Accumulate parameter.
	.SETN ESCA'ESCAMX' ESCA'ESCAMX'*10.+CVALUE-60
	.GOTO ESCPSR			! Get next character.

	.; In a <CSI> sequence, and got a ";"; End of parameter:

.CSI73:	.SETN ESCAMX ESCAMX+1.		! Have another param.
	.SETN ESCA'ESCAMX' 0.		! Initialize it.
	.GOTO ESCPSR			! Get next character.

.FKY5:	.; LK201 "Prev. Screen" key.
.FKY6:	.; LK201 "Next Screen" key.

	.SETS CHAR "'ESCA0%D'"		! Fake "<CSI>n"
	.SETN ESCA0 1.			! Force argument to 1.
	.SETS S$GOTO "PAINT"		! We will need to repaint.
	.SETN N$FLD 0.			! Force to field 0.
	.GOTO ARROW			! Process like arrow.

	.; An arrow key generates these escape sequences:

.CSI103:.;	<CSI>C = Right arrow;
.CSI104:.;	<CSI>D = Left arrow.
	.SETS S$GCTL "COD"
.CSI101:.;	<CSI>A = Up arrow;
.CSI102:.;	<CSI>B = Down arrow;
.ARROW:.;
	.SETN N$FLD N$OFLD
	.PARSE ARROW'CHAR' "," AXIS FAC SIGN LIMIT TEST
	.IF ESCA0 = 0	.SETN ESCA0 1.	! Force param.
	.IFT GOLD .SETN ESCA0 ESCA0*'FAC'.	! Apply PF1.
	.SETN 'AXIS' 'AXIS''SIGN'ESCA0	! Set new loc.
	.IF 'AXIS' 'TEST' 'LIMIT'	.SETN 'AXIS' 'LIMIT'
	.SETF GOLD			! Clear shift key.
	.GOTO ESCPSR			! Get next character.

.DOIT:	;'INIT'
	.ENABLE QUIET
	'MCR'SET /BUF=TI:'TIWID%D'.
	.DISABLE QUIET
	.ENABLE DISPLAY

	.TESTDEVICE SY:
	.PARSE <EXSTRI> "," S$ODEF S$JUNK
	.IF <DIRECT> <> "[]"	.SETS S$ODEF S$ODEF+<DIRECT>
	'MCR'SET /DEF=SYS$LOGIN

	.SETS S$OUIC <UIC>
	'MCR'SET /UIC='<LOGUIC>'

	.OPEN UPS.TMP
	.DATA SET TE HCPY
	.DATA SET QUIET
	.DATA D WH
	.SETN N$FILE 0.
.DOITL:
	.SETS S$FILE S$FL'N$FILE%DR2Z'
	.SETS S$FILE "'S$FILE%C'"
	.IF S$FILE <> ""	.DATA I;
	.IF S$FILE <> ""	.DATA I;========================================================================
	.IF S$FILE <> ""	.DATA I;
	.IF S$FILE <> ""	.DATA I; 'S$FILE'
	.IF S$FILE <> ""	.DATA I;
	.IF S$FILE <> ""	.DATA INCLUDE 'S$FILE'
	.INC N$FILE
	.IF N$FILE < 15.	.GOTO DOITL
	.DATA EXIT
	.CLOSE
	'MCR'EDT UPS.TMP,UPS.TMP
	.OPEN UPS.BAT
	.DATA $ JOB/TIME=60
	.DATA $ DCL SET /MCR=TI:
	.DATA $ SEND/NOFILE UPS.TMP
	.DATA 'S$ADRS'
	.DATA 
	.DATA 'S$SUBJ'
	.DATA Y
	.DATA $ PIP UPS.TMP;*/DE
	.DATA $ EOJ
	.CLOSE
	'MCR'SUB /NOPRIN=UPS.BAT/DE
	'MCR'SET /DEF='S$ODEF'
	'MCR'SET /UIC='S$OUIC'
	.EXIT