Trailing-Edge
-
PDP-10 Archives
-
decuslib20-08
-
decus/20-0178/vdt.mac
There is 1 other file named vdt.mac in the archive. Click here to see a list.
;Edit number 51 by SST.D-BIGELOW on 29-Mar-84
; Add new command ^VA, to even all of a double spaced input file.
;
;Edit number 50 by SST.D-BIGELOW on 28-Mar-84
; Fix problem with page mark display routine. Make the SPCON and SPCOFF
; routines pay attention to the order in which they are called.
;
;Edit number 47 by SST.D-BIGELOW on 28-Mar-84
; Add a /VT102 switch, which is required for special insert and delete
; code for VT100 terminals.
;
;Edit number 46 by SST.D-BIGELOW on 27-Feb-84
; Correct bug in ^DB routine introduced for ANSI terminals.
;
;Edit number 45 by SST.D-BIGELOW on 22-Feb-84
; Make ^^ in function string yield an up-arrow in command.
;
;Edit number 44 by SST.D-BIGELOW on 22-Feb-84
; Make first page 4 lines longer when autopaginating. Make up for the
; lack of a header on the first page.
;
;Edit number 43 by SST.D-BIGELOW on 9-Feb-84
; Correct bugs when inserting or deleting too many lines or characters
; is attempted. Work manually if more than 23 lines or 78 characters.
;
;<SST.P-GALVIN>VDT.MAC.13, 29-Jan-84 20:12:49, Edit by SST.P-GALVIN
; 42 Implement /Search mode. If set, we call PATMAT instead of displaying
; the first screen, and don't display the full screen until ^L is typed
; or a routine which calls .FFD is executed. All commands are usable
; after the first search. Areas effected: GETTXT, PATMAT, and TYPLIN
;
;<SST.P-GALVIN>VDT.MAC.14, 11-Jan-84 18:29:03, Edit by SST.P-GALVIN
; 41 Implement VT100 insertion and deletion of lines (let the terminal
; do the work.
;
;<SST.P-GALVIN>VDT.MAC.3, 11-Jan-84 12:00:35, Edit by SST.P-GALVIN
; 40 Take advantage of the alternate keypad mode on VT100s to allow
; more function keys.
;
;<SST.D-BIGELOW>VDT.MAC.2, 21-Dec-83 16:31:22, Edit by SST.D-BIGELOW
; 37 Control-K;H modifications: make <CR> cancel the old header, but any
; number of blanks followed by <CR> set to paging style two with no
; left margin header.
;
;<SST.D-BIGELOW>VDT.MAC.2, 5-Dec-83 10:33:42, Edit by SST.D-BIGELOW
; 36 Make the header input routine more defensive. Handle a header that
; doesn't end with a null by looking for control characters as we read,
; and ending as soon as we find one.
;
;<SST.D-BIGELOW>VDT.MAC.5, 31-Oct-83 17:43:35, Edit by SST.D-BIGELOW
; 35 Fix problem where double-spaced downward scrolling broke when the
; cursor was on the last line of the screen.
;
;<SST.D-BIGELOW>VDT.MAC.4, 31-Oct-83 16:30:09, Edit by SST.D-BIGELOW
; 34 Correct problem with scrolling upwards in double spaced mode. Scroll
; value was being overwritten by two.
;
;<SST.D-BIGELOW>VDT.MAC.3, 10-Oct-83 12:29:18, Edit by SST.D-BIGELOW
; 33 Change VT100 (ansi) terminal upward scrolling routine to take account
; of status of double flag.
;
;<SST.D-BIGELOW>VDT.MAC.40, 28-Sep-83 13:37:47, Edit by SST.D-BIGELOW
; 32 Allow a carriage return input to the get header routine to clear out
; a page header and restore -n- style.
;
;<SST.D-BIGELOW>VDT.MAC.33, 27-Sep-83 10:53:43, Edit by SST.D-BIGELOW
; 31 Correct problem with autopagination double-counting the first line of
; a new page, causing the last lines of a file to disappear.
;
;<SST.D-BIGELOW>VDT.MAC.8, 15-Sep-83 15:19:26, Edit by SST.D-BIGELOW
; 30 Rewrite the justify routine to handle any combinations of margins and
; spacing conditions.
;
;<SST.P-GALVIN>VDT.MAC.6, 17-Aug-83 12:59:42, Edit by SST.P-GALVIN
; 27 Make ^KP toggle pagination; Make ^KB Set a page break after inserting
; a new line; Make ^KD Set double spacing and get rid of ^KT; Make
; routines more reluctant to call setpag: .Hom, Posit, BakTab, TraTab,
; Patmat, Search, Getlin, .Tab, .FFD, Insert, Deleol
;
;<SST.D-BIGELOW>VDT.MAC.11, 11-Aug-83 17:02:17, Edit by SST.D-BIGELOW
; 25 Completely rewrite fill and empty to handle new style of pagination,
; remove AJ support, and increase speed and efficiency.
;
;<SST.D-BIGELOW>VDT.MAC.2, 30-Jun-83 11:43:25, Edit by SST.D-BIGELOW
; 24 Correct FILL and EMPTY routines to work properly with new techniques
; of terminating file with delete.
;
;<SST.P-GALVIN>VDT.MAC.28, 21-Jun-83 13:52:56, Edit by SST.D-BIGELOW
; 23 Fix longstanding bug in the JOIN routine: if you attempt to do a
; join when the cursor is past the margin, routine returns without
; popping the stack first.
;
;<SST.P-GALVIN>VDT.MAC.27, 20-Jun-83 17:18:31, Edit by SST.P-GALVIN
; 22 Attempted the impossible: Floating (wordstar-like) pagination on
; a mainframe computer.
;
;<SST.P-GALVIN>VDT.MAC.3, 16-Jun-83 13:36:32, Edit by SST.P-GALVIN
; 21 Made ^KA (adjust margin) only change the left margin if
; we're in program mode.
;
;<SST.P-GALVIN>VDT.MAC.2, 18-Mar-83 15:16:11, Edit by SST.P-GALVIN
; 20 Started implementing a new algorithm for single and double spacing.
; This one depends on the mode selected by ^KT, and flag DOUBLE is set
; if we are double-spacing.
;
;<SST.D-GALVIN>VDT.MAC.2, 7-Mar-83 15:12:13, Edit by SST.D-GALVIN
; 17 Patch the FILL routine to eliminate hanging if no modified
; SIN% JSYS is being used.
;
;<SST.P-GALVIN>VDT.MAC.3, 1-Mar-83 11:08:51, Edit by SST.P-GALVIN
; 16 Add an error message if control-c trap enabling fails (for
; the MIT exec and Batch).
;
;<SST.D-BIGELOW>VDT.MAC.2, 17-Feb-83 14:14:34, Edit by SST.D-BIGELOW
; 15 Add the ^KA command to adjust the margins via the shrink amount.
; This allows toggling of note style margins in and out.
;
;<SST.P-GALVIN>VDT.MAC.38, 29-Jan-83 16:06:37, Edit by SST.P-GALVIN
; 14 Change the ^PP and ^PN commands so that the cursor remains on the
; same screen line as it was before the command was issued. This
; does not effect these commmands when they are preceeded by a
; numeric arguement.
;
;<SST.P-GALVIN>VDT.MAC.35, 28-Jan-83 17:48:34, Edit by SST.P-GALVIN
; 13 Implemented reverse search and replacment. Repeat search and replace
; also knows how to behave, and so goes in the proper direction.
;
;<SST.D-BIGELOW>VDT.MAC.2, 31-Dec-82 08:17:48, Edit by SST.D-BIGELOW
; 12 Add processing for a new wpsim switch /NUMBER:n which allows starting
; page numbering at any desired place.
;
;<SST.P-GALVIN>VDT.MAC.2, 9-Dec-82 16:38:21, Edit by SST.P-GALVIN
; 11 Create a section of the UNFILL routine which checks the
; CTRLCV word to see whether it should convert
; "$"'s to "<esc>"'s and "^"'s to control's.
;
;<SST.P-GALVIN>VDT.MAC.2, 1-Dec-82 16:08:07, Edit by SST.P-GALVIN
; 10 Change empty algorithm to avoid problems with filtab switch being
; set. Add new switch F.TABC.
;
;<SST.P-GALVIN>VDT.MAC.5, 22-Nov-82 13:37:04, Edit by SST.P-GALVIN
; 7 Implement a new command "^KZ", which toggles "zero output", i.e.
; output to nowhere, on and off. The startup value is on.
;
;<SST.D-BIGELOW>VDT.MAC.2, 18-Oct-82 11:08:37, Edit by SST.D-BIGELOW
; 6 Change the insert mode so that it only inserts lines when it has
; reached new territory -- allow editing within inserts.
;
;<SST.SYSDOC>VDT.MAC.3, 15-Oct-82 11:22:53, Edit by SST.D-BIGELOW
; 5 Modify the help file to reflect the changed commands.
;
;<SST.D-BIGELOW>VDT.MAC.13, 14-Oct-82 14:43:46, Edit by SST.D-BIGELOW
; 4 Turn off /MODEL2 if not a Viewpoint. Remove ^S/^Q from list of
; commands, use ^KW for ^S and new search command for ^Q. Changed
; format of search failure messages.
;
;<SST.D-BIGELOW>VDT.MAC.2, 7-Oct-82 09:08:09, Edit by SST.D-BIGELOW
; 3 Fix problem where double spacing fails when reading in a single
; spaced input file.
;
;<SST.D-BIGELOW>VDT.MAC.6, 28-Sep-82 16:59:22, Edit by SST.D-BIGELOW
; 2 Correct problem reading in doubled files without the correct
; number of trailing blank lines -- add erjmp after sin.
;
;<SST.D-BIGELOW>VDT.MAC.3, 28-Sep-82 15:19:23, Edit by SST.D-BIGELOW
; 1 Start VDT edit history -- WPSIM now loads an external version
; number which includes VDT edit in the edit number.
;
;<SST.D-BIGELOW>VDT.MAC.2, 28-Sep-82 14:55:55, Edit by SST.D-BIGELOW
; Fix a nasty bug that blows up programs when you are converting
; output and a ~ line ends the file.
;
;<SST.D-BIGELOW>VDT.MAC.2, 27-Sep-82 15:26:44, Edit by SST.D-BIGELOW
; Correct problem in repeat search routine -- cursor left in wrong
; place if search fails before N runs out.
;
;<SST.D-BIGELOW>VDT.MAC.4, 22-Sep-82 18:32:27, Edit by SST.D-BIGELOW
; Correct more problems with replacement routine, and make the ^KN
; routine clear the screen before refreshing.
;
;<SST.D-BIGELOW>VDT.MAC.2, 8-Sep-82 16:40:26, Edit by SST.D-BIGELOW
; Add ^PT routine to make the current line scroll to the top of the
; screen.
;
;<SST.D-BIGELOW>VDT.MAC.2, 8-Sep-82 14:23:57, Edit by SST.D-BIGELOW
; Make change in insert file routine to prevent error in gtjfn from
; leaving reverse video on.
;
;<SST.D-BIGELOW>VDT.MAC.2, 7-Sep-82 10:44:28, Edit by SST.D-BIGELOW
; Make a change in the output ciphering routine so that the last line of
; text would get properly ciphered.
;
;<SST.D-BIGELOW>VDT.MAC.2, 3-Sep-82 12:42:59, Edit by SST.D-BIGELOW
; Add ^KV command to help message. Subtracted a line from the numeric
; repeat count explanation to make room for it.
;
;<SST.D-BIGELOW>VDT.MAC.2, 1-Sep-82 13:24:04, Edit by SST.D-BIGELOW
; Make the EMPTY routine smarter about counting -- it was converting
; (hghlin-1) lines of text.
;
;<SST.D-BIGELOW>VDT.MAC.10, 31-Aug-82 20:10:15, Edit by SST.D-BIGELOW
; Correct input file reading section -- don't use typerr for errors.
; Instead use type with rfpos% to see where we are.
;
;<SST.D-BIGELOW>VDT.MAC.7, 31-Aug-82 12:35:51, Edit by SST.D-BIGELOW
; Now implement upward scrolling, using the same logic as the downward
; scrolling feature. Amount to scroll is variable.
;
;<SST.D-BIGELOW>VDT.MAC.3, 30-Aug-82 17:10:29, Edit by SST.D-BIGELOW
; Implement downward scrolling on the VT100 terminals, by use of the
; reverse index command.
;
;<SST.SYSDOC>VDT.MAC.4, 30-Aug-82 14:59:29, Edit by SST.D-BIGELOW
; Add commands to save and restore the cursor attributes when using
; special effects on a VT100 terminal.
;
;<SST.D-BIGELOW>VDT.MAC.3, 26-Aug-82 14:49:44, Edit by SST.D-BIGELOW
; Make correction to $>R routine to prevent TOPLIN from ever becoming
; negative.
;
;<SST.D-BIGELOW>VDT.MAC.3, 20-Aug-82 17:06:30, Edit by SST.D-BIGELOW
; Make POSELN routine position to end of line even if past the end.
; If blank line, just return.
;
;<SST.D-BIGELOW>VDT.MAC.2, 20-Aug-82 13:04:48, Edit by SST.D-BIGELOW
; Make the empty routine eliminate trailing spaces as well as trailing
; tabs.
;
;<SST.P-GALVIN>VDT.MAC.3, 20-Aug-82 11:37:27, Edit by SST.P-GALVIN
; Allow interractive function redefinition (up to 70 characters in
; a function).
;
;<SST.P-GALVIN>VDT.MAC.16, 15-Aug-82 16:01:46, Edit by SST.P-GALVIN
; Implement the $>R (return) command. Return the cursor to the
; location of the $< command. This command enables you to leave
; an ancor in the file, and return to it at anytime (up till the
; next $< command is executed.
;
;<SST.P-GALVIN>VDT.MAC.9, 15-Aug-82 14:06:30, Edit by SST.P-GALVIN
; Implemented the ^KN command: Kill the current buffer and input
; a new file for editing.
;
;<SST.P-GALVIN>VDT.MAC.43, 13-Aug-82 14:22:24, Edit by SST.D-BIGELOW
; Finish implementation of replacement for long strings.
;
;<SST.P-GALVIN>VDT.MAC.33, 13-Aug-82 10:10:38, Edit by SST.D-BIGELOW
; Rewrite LINLEN routine and modify replacement algorithms.
;
;<SST.P-GALVIN>VDT.MAC.31, 13-Aug-82 08:22:22, Edit by SST.D-BIGELOW
; Modify algorithm for inserting spaces. Terminate with error message
; if we try to insert too many spaces.
;
;<SST.P-GALVIN>VDT.MAC.29, 12-Aug-82 18:51:43, Edit by SST.P-GALVIN
; Make the REPLACE command work with replacement strings longer
; than the search string. It still won't work if the old line
; would be longer than 80 characters with the replacement
;
;<SST.D-BIGELOW>VDT.MAC.5, 10-Aug-82 09:43:51, Edit by SST.D-BIGELOW
; Change "undefined terminal type" message so that it doesn't undefine
; the terminal before exiting. Make repeat counts work for arrow keys
; on DEC terminals.
;
;<SST.D-BIGELOW>VDT.MAC.2, 9-Aug-82 10:31:57, Edit by SST.D-BIGELOW
; Implement tabifying on output if requested by filtab switch. Convert
; multiple spaces to tabs.
;
;<SST.D-BIGELOW>VDT.MAC.3, 6-Aug-82 14:15:27, Edit by SST.D-BIGELOW
; Change save buffer parameters -- counts were wrong and buffers were
; overflowing. Allow 144 lines, 3100 words, 17500 characters. (Octal)
;
;<SST.D-BIGELOW>VDT.MAC.2, 6-Aug-82 11:59:01, Edit by SST.D-BIGELOW
; Add new method of displaying proper screen after a continued ctrl-C.
; Force a ^L into input buffer after continuing. Also remove some error
; messages from expert mode typout, and fix a bug in movpar processing.
;
;<SST.P-GALVIN>VDT.MAC.16, 1-Aug-82 12:50:45, Edit by SST.B-RAMSEY
; Fix the maximum line checking code in FILL so that input is terminated
; at Maxlin rather than at Maxlin-1 lines.
;
;<SST.P-GALVIN>VDT.MAC.2, 31-Jul-82 15:19:45, Edit by SST.P-GALVIN
; Implement a faster form of File <--> Buffer I/O.
; This one depends on the modified SIN% JSYS.
;
;<SST.P-GALVIN>VDT.MAC.7, 29-Jul-82 10:41:43, Edit by SST.P-GALVIN
; Implement the VT52 (GIGI) terminal type.
;
;<SST.D-BIGELOW>VDT.MAC.2, 20-Jul-82 15:39:36, Edit by SST.D-BIGELOW
; Adjust the maximum line checking routines to be at the character input
; routine rather than just after a down command.
;
;<SST.B-RAMSEY>VDT.MAC.3, 20-Jul-82 10:42:44, Edit by SST.B-RAMSEY
; Define as Internal MATCH and MAKTAB so that the pattern-matching
; routines may be called from external programs.
;
;<SST.VIDEO>VDT.MAC.2, 19-Jul-82 15:37:39, Edit by SST.D-BIGELOW
; Beginning of edit history. Add intercept to pick up failure
; of STI% jsys before the input buffer fills up.
;
Subttl Table of contents for VDT
; -- Section -- -- Page --
;
; 1. Edit history.................................................. 1
; 2. Table of contents............................................. 2
; 3. Title page.................................................... 3
; 4. Program flag definitions...................................... 4
; 5. Terminal definitions.......................................... 6
; 6. Control character dispatch table.............................. 8
; 7. Interrupt system tables....................................... 9
; 8. Control character output control.............................. 10
; 9. INITRM - Set special terminal/job status...................... 11
; 10. RESTRM - Restore original TTY status.......................... 13
; 11. GETTXT - Routine to return text buffer........................ 14
; 12. Pagination routines........................................... 22
; 13. Control character processing.................................. 24
; 14. Special functions
; 14.1 Pagination and tab stop manipulation................. 34
; 14.2 New file............................................. 43
; 14.3 Deletes.............................................. 44
; 14.4 Tabbing.............................................. 52
; 14.5 Inserts.............................................. 53
; 14.6 Search routines...................................... 60
; 14.7 Pattern matching searches............................ 61
; 14.8 String replacement................................... 63
; 14.9 Positioning.......................................... 67
; 15. Text movement routines
; 15.1 GETLIN............................................... 73
; 15.2 RETLIN............................................... 74
; 15.3 MOVPAR............................................... 76
; 16. Justification routines........................................ 80
; 17. Pagination routines
; 17.1 Routines to help auto-pagination..................... 88
; 18. Show status command........................................... 90
; 19. Toggle zero output command.................................... 93
; 20. Special function control commands............................. 94
; 21. Pattern matcher routines
; 21.1 Maktab............................................... 97
; 21.2 Getpat............................................... 98
; 21.3 Match................................................ 100
; 22. Terminal control routines..................................... 102
; 23. NXTWRD - Find the next word in the file....................... 103
; 24. Adjustment routines
; 24.1 FILL................................................. 105
; 24.2 EMPTY................................................ 112
; 25. General subroutines........................................... 118
; 26. Number input routines......................................... 126
;
; (End of table of contents)
Title VDT - Video Display Terminal Simulator
Subttl Title page
Search MACSYM,MONSYM,SYMBOL
.Directive FLBLST
Sall
;Version information -- used in loading WPSIM
VEDIT==51 ; Edit number
VDTEDT==:VEDIT ; Copy into an external
;Internal routines
INTERN GETTXT,FILL,EMPTY,INITRM,RESTRM,UNFILL,MAKTAB,MATCH
;External storage
EXTERN LINE,COL,BUF,MAXLIN,TOPLIN,HGHLIN,MAXCOL,BACKUP,SCHAR,SPARE
EXTERN INDENT,TJFN,LENGTH,WIDTH,MINCOL,TIW,CCOC,TABS,INTBLK,SAVEP
EXTERN PAGSIZ,SAVBUF,SAVNUM,LETHED,FLINK,PAT,CHRNUM,CHRCNT
EXTERN NUMSCH,PAGNUM,PGHEAD,REPSTR,REPLEN,LSTSPC
EXTERN HYPHEN,INTACS,INTSTK,EXPERT,XPNCOL,FUNCT,VALUE,PROG,CIPHER
EXTERN MOD2,FILTAB,FSTLIN,INPLIN,OUTLIN,SCRVAL,CTRLCV,STRPAG,SHRINK
EXTERN AUTOPG,HARDPG,CURRPG,BFRCNT,CHRPTR,JBUF,SFIRST,VT102
;Description:
;
; VDT was written in August of 1981 by Douglas Bigelow at the
; Wesleyan Computing Center. VDT is a general purpose subroutine
; designed for use as a word processor simulator.
;
Subttl Program flag definitions
;Define special SIN% jsys flag if it isn't in MONSYM
Ifndef SI%TCC,<SI%TCC==676767,,123765>
;Define time to wait for an error message to be seen
HLDTIM==^D1500 ; 1.5 seconds
;Define a special error typing macro
DEFINE TYPERR(STR),<
JRST [HRROI A,[ASCIZ \STR\]
JRST ERMSA]>
;Now define the flag accumulator bits
BITPOS==0
; **note: terminal flags must be in lh only
SWITCH F.BHOM ; Terminal home is at bottom of screen
SWITCH F.NWRP ; Terminal doesn't wrap left or up
SWITCH F.ANSI ; Terminal follows ansi standard
SWITCH F.CXBY ; Cursor is x before y
SWITCH F.NFFD ; Terminal has no form feed
SWITCH F.SPEF ; Terminal has special video effects
SWITCH F.VT52 ; Terminal is a VT52
SWITCH F.V102 ; VT102 Terminal type
; **end of terminal flags
;More switches
SWITCH F.TFAR ; Too far down - (too many lines)
SWITCH F.FINI ; Finished
SWITCH F.FMOV ; Forced move command in progress
SWITCH F.FFCV ; Form feed conversion in progress
SWITCH F.INDT ; Indent after refreshing
SWITCH F.EMES ; Error message on screen
SWITCH F.DSCR ; Downward scrolling move done
SWITCH F.RPSH ; Repeating previous search
SWITCH F.INSM ; Insert mode in effect
SWITCH F.PMRK ; Page mark
SWITCH F.NSIN ; New sin% jsys available
SWITCH F.REPL ; Replacement string active
SWITCH F.DGET ; Delete on get command
SWITCH F.COPY ; Copy text
SWITCH F.MOVE ; Move text
SWITCH F.DELE ; Delete text
SWITCH F.NEGR ; Negative retlin in effect
SWITCH F.NBAK ; No backup on retlin
SWITCH F.ZOUT ; Outputting to null:
SWITCH F.TABC ; Tab conversion in progress
SWITCH F.UPAR ; Up-arrow seen in control conversion mode
SWITCH F.NOPG ; No change of the pagination mark is possible
SWITCH F.IEOF ; Input end of file seen
SWITCH F.DBSP ; Double spacing toggle for justification
SWITCH F.DBIN ; Input text is double spaced
SWITCH F.NELN ; Non-empty line found in justif routine
SWITCH F.SPON ; Special effects on
;Now some spare storage used for auto-indent processing
CRLFS: BYTE(7) 15,12,0,0,0
SPACES: asciz . .
Subttl Terminal definitions
;Here we define the commands for all the terminals that we know about.
DEFINE CL(X),<"X"-100>
ALT==33 ; Define an escape
NUL==0 ; And a null
SP==40 ; And a space
DEFINE TRMLST,<
TRM (Viewpoint,4,<F.BHOM+F.SPEF>,<ALT,"Y",SP,SP>,<ALT,"K">,<ALT,"k">,<ALT,"Y">)
TRM (Datamedia,7,<F.NWRP+F.CXBY>,<CL(Y)>,<CL(])>,<CL(K)>,<CL(^)>)
TRM (VT100,20,<F.SPEF+F.ANSI+F.NFFD>,<ALT,"[","H">,<ALT,"[","K">,<ALT,"[","J">,<ALT,"[">)
TRM (VT52,17,<F.NFFD+F.VT52>,<ALT,"H">,<ALT,"K">,<ALT,"J">,<ALT,"Y">)
>
;Now define the embedded SEQ macro. It takes one argument
;made up of a sequence of characters. A word is generated in the
;form addr,,n where -n is the number of characters, and addr is
;the address of the string of characters. Eight bit characters are generated.
DEFINE SEQ(CHARS),<
CNT==0 ; Start count at zero
IRP <CHARS>,<CNT==CNT+1> ; Loop over chars counting them
IFE CNT,< ; If no characters
EXP 0 ; Then produce just a zero word
>
IFN CNT,< ; If any characters
XWD [ ; Start literal
WORD==0 ; Initialize word to zero
.SHFT==^D28 ; Initialize shift value
IRP <CHARS>,< ; Loop over all chars again
WORD==WORD+<<CHARS>_.SHFT> ; Add new char into word
.SHFT==.SHFT-8 ; Lessen shift by a char
IFL .SHFT,< ; If the word is full
EXP WORD ; Dump completed word of chars
WORD==0 ; Reset the word
.SHFT==^D28 ; And the shift value
>
> ; End of loop over chars
IFN <.SHFT-^D29>,< ; See if any partial word left
EXP WORD ; If so, dump it too
>
],-CNT ; End literal and store count
> ; End of ifn cnt conditional
>
;Now define the tables that hold the terminal sequences
DEFINE TRM(T.NAM,T.TYP,T.FLG,T.HOM,T.CEOL,T.CEOS,T.ADR),<
EXP T.FLG+T.TYP>
TRMTAB: TRMLST ; Generate the terminal list
0 ; End of list
;Now the home sequence table
DEFINE TRM(T.NAM,T.TYP,T.FLG,T.HOM,T.CEOL,T.CEOS,T.ADR),<
SEQ <T.HOM>>
HOMTAB: TRMLST ; Generate the home list
0 ; End of list
;Now the clear to end of line sequence table
DEFINE TRM(T.NAM,T.TYP,T.FLG,T.HOM,T.CEOL,T.CEOS,T.ADR),<
SEQ <T.CEOL>>
CELTAB: TRMLST ; Generate the ceol list
Z
;The clear to end of screen sequence table
DEFINE TRM(T.NAM,T.TYP,T.FLG,T.HOM,T.CEOL,T.CEOS,T.ADR),<
SEQ <T.CEOS>>
CESTAB: TRMLST ; Generate the ceos list
Z
;The absolute addressing sequence table
DEFINE TRM(T.NAM,T.TYP,T.FLG,T.HOM,T.CEOL,T.CEOS,T.ADR),<
SEQ <T.ADR>>
ADRTAB: TRMLST ; Generate the addressing list
Z
Subttl Control character dispatch table
;Any control character which may have a meaning to any of the supported
;terminals has a dispatch address where the character is handled. A
;cursor key is indicated by the sign bit being set, in which case the left
;half word also contains the terminal type for which the cursor key is
;appropriate. The dispatch table processing routine has the responsibility
;of resolving inter-terminal conflicts.
ALL==400000 ; All terminals
ADDS==400004 ; Viewpoints
DATA==400007 ; Datamedias
VT52==400017 ;GIGI and VT52
CCTAB: EXP R ; No meaning
XWD ADDS,.HOM ; ^a - home on adds terminals
EXP .FUN ; ^b - special functions
EXP CTLC ; ^c - abort
EXP DELETE ; ^d - delete functions
EXP EXIT ; ^e - exit
XWD ADDS,.RIG ; ^f - right on adds terminals
EXP GETLIN ; ^g - get text
XWD ALL,.LEF ; ^h - left on all terminals
EXP .TAB ; ^i - tab on all terminals
XWD ALL,.DWN ; ^j - down on all terminals
EXP .SPEC ; ^k - special functions
EXP .FFD ; ^l - clear on all terminals
EXP .CR ; ^m - carriage return on all terminals
EXP INSERT ; ^n - insert functions
EXP RETLIN ; ^o - retrieve "gotten" text
EXP POSIT ; ^p - position functions
EXP R ; ^Q - unused
EXP BAKTAB ; ^r - reverse tab
EXP R ; ^S - unused
EXP TRATAB ; ^t - transparent tab
XWD ADDS,.LEF ; ^u - left on adds terminals
EXP EVEN ; ^v - justify paragraph
EXP PATMAT ; ^w - string search
EXP SEARCH ; ^x - repeat search
XWD DATA,.HOM ; ^y - home on a datamedia
XWD ADDS,.UP ; ^z - up on an adds terminal
EXP .ESC ; Esc - special handling
XWD DATA,.RIG ; ^\ - right on a datamedia
EXP DELEOL ; ^] - delete to end of line
EXP R ; ^^
XWD DATA,.UP ; ^_ - up on a datamedia
Subttl Interrupt system tables
;Level table
LEVTAB: EXP INTBLK
EXP INTBLK+1
EXP INTBLK+2
;Channel table
CHNTAB: 1,,CONC ; Channel zero, control-c
BLOCK ^D35 ; No others at present
;Here to process a control-C. Ask the user if they really want to
;abort what they're doing.
CONC: DMOVEM F,INTACS ; Save f and a
MOVE A,[2,,INTACS+2] ; Load a blt pointer
BLT A,INTACS+17 ; Store the acs
MOVE P,[IOWD 50,INTSTK] ; Get a stack pointer
CALL CONFRM ; Confirm the control-c
JRST CONC.A ; Not really wanted
CALL CLRSCN ; Clear the screen
CALL RESTRM ; Restore normal mode
TYPE <% Aborting -- type CONTINUE to resume, or REENTER to save your file>
PUSH P,.JBREN## ; Save current reenter address
MOVEI A,CONC.B ; Get reenter address
MOVEM A,.JBREN## ; Save it
HALTF% ; Quit
;If we're continued..
CALL INITRM ; Restore terminal
CALL CLRSCN ; Clear screen
;; CALL .FFD ; Refresh it
MOVEI A,.PRIIN ; Input
MOVEI B,14 ; Form feed
STI% ; Force a refresh
;Here if we never messed up the screen
CONC.A: POP P,.JBREN## ; Restore old reenter address
MOVE P,[INTACS,,0] ; Get blt pointer
BLT P,P ; Restore all acs
DEBRK% ; And dismiss the interrupt
;Here for a reenter
CONC.B: POP P,.JBREN## ; Get old reenter address
MOVE P,SAVEP ; Get old stack pointer
RETSKP ; Return to output mode
Subttl Control character output control
;Define the control characters that should be literally translated.
;Everything else doesn't echo, which prevents the terminal being affected
;by special effects that the program doesn't know about.
DEFINE CCENB(X),<
CCP1=0
CCP2=0
IRPC X,<
.T="X"-100
.T=.T*2
IFL <.T-^D35>,<CCP1=CCP1+400000000000_-.T>
IFG <.T-^D35>,<CCP2=CCP2+400000000000_-<.T-^D36>>
>
>
DEFINE CCLFT(X),<
IRP X,<
.T=X*2
IFL <.T-^D35>,<CCP1=CCP1+400000000000_-.T>
IFG <.T-^D35>,<CCP2=CCP2+400000000000_-<.T-^D36>>
>
>
;Now define the "action" characters
CCENB (AFHJLMUYZ) ; The control characters
CCLFT (<33,34,35,37>) ; And left-overs (non alphabetic)
Subttl INITRM - Set special terminal/job status
;The terminal has to be carefully set up to run - exactly the correct
;control characters must echo in literal mode, and all others must not
;echo. The length and width must be zero. The terminal interrupt word
;must be cleared. Page mode must be disabled. And all standard parameters
;must be stored and restored at end of program.
INITRM: MOVEI A,.CTTRM ; Controlling terminal
GTTYP% ; Get our type
SETZ P2, ; This will be the terminal pointer
INI.A: SKIPN A,TRMTAB(P2) ; Get a terminal type
NOERR (<? Your defined terminal type is not supported>,EXIT)
CAIE B,(A) ; Do we match right half?
AOJA P2,INI.A ; No, try again
HLLZ F,A ; Get the flags
HRRZS A ; Isolate terminal type
CAIE A,ADDS-ALL ; Is it a viewpoint?
SETZM MOD2 ; No, so model2 switch is worthless
MOVX A,GJ%SHT ; Short form
HRROI B,ASC<TTY:> ; Tty device
GTJFN% ; Get a jfn on it
SSTERR (<Can't get tty jfn>,EXIT)
MOVX B,FLD(10,OF%BSZ)!OF%WR ; Write 8-bit bytes
OPENF% ; Open the channel
SSTERR (<Can't open a channel to the tty>,EXIT)
MOVEM A,TJFN ; Save the jfn
MOVEI A,.FHJOB ; This job
RTIW% ; Get current interrupt word
MOVEM B,TIW ; Save it
MOVX B,1B3 ; ^c only
STIW% ; Set interrupt word
ERJMP [TYPE <%Warning: Control-C's are not being trapped>
JRST .+1] ; Type error and continue
MOVEI A,.CTTRM ; Terminal
RFCOC% ; Get current ccoc settings
DMOVEM B,CCOC ; Save them
MOVX B,CCP1 ; Control character output word one
MOVX C,CCP2 ; And two
SKPON F.ANSI!F.VT52 ; Does this terminal need escape?
TRZ C,600000 ; No, so turn off escape
SFCOC% ; Set it
MOVEI B,.MORLW ; Line width
MTOPR% ; Get current value
MOVEM C,WIDTH ; And store
MOVEI B,.MORLL ; Screen length
MTOPR%
MOVEM C,LENGTH ; Store current value
MOVEI B,.MOSLW ; Set width function
SETZ C, ; To zero
MTOPR%
MOVEI B,.MOSLL ; Set length
MTOPR% ; Also to zero
SKPON F.ANSI ; Are we ansi?
JRST INI.B ; No, skip the next code
MOVE A,TJFN ; Set alternate keypad mode
MOVEI B,ALT ; By sending an <esc>= to the tty
BOUT% ; Send an escape
MOVEI B,"=" ; And an equal
BOUT% ; Write it
SKIPE VT102 ; Are we in VT102 mode?
FLGON F.V102 ; Yes, set the flag
;Set up interrupts to intercept a ^C
INI.B: MOVEI A,.FHSLF ; Our fork
MOVE B,[LEVTAB,,CHNTAB] ; Tables
SIR% ; Initialize
MOVX B,1B0 ; Channel zero
AIC% ; Activate it
EIR% ; Enable system
MOVE A,[3,,0] ; ^c to channel zero
ATI% ; Activate terminal interrupt
ERJMP .+1 ; Ignore the error this time
RET ; Done
Subttl RESTRM - Restore original TTY status
RESTRM: SKPON F.ANSI ; Are we an ansi terminal?
JRST RES.A ; No, skip the next code
MOVE A,TJFN ; Reset the keypad mode by sending
MOVEI B,ALT ; An <esc>
BOUT%
MOVEI B,">" ; And a ">"
BOUT%
RES.A: MOVE A,TJFN ; Get the terminal JFN
CLOSF% ; Close the terminal
JFCL ; Ignore errors
MOVEI A,.FHJOB ; Our job
MOVE B,TIW ; Get old interrupt word
STIW% ; And set it
ERJMP .+1 ; Ignore errors
MOVEI A,.CTTRM ; This terminal
DMOVE B,CCOC ; Get original ccoc settings
SFCOC% ; Set them
MOVEI B,.MOSLW ; Set width
MOVE C,WIDTH ; To old value
MTOPR%
MOVEI B,.MOSLL ; Set length
MOVE C,LENGTH ; To old value
MTOPR%
SETZ B, ; Current line position
SFPOS% ; Now zero
MOVE A,TJFN ; Terminal jfn
CLOSF% ; Closed
JFCL ; Ignore errors
;Disable the interrupt system
MOVEI A,.FHSLF ; Our fork
DIR% ; Disable interrupts
SETZ B, ; No channels
AIC% ; Now active
MOVEI A,3 ; Terminal code 3 (^c)
DTI% ; Deactivate terminal interrupt
ERJMP .+1 ; Ignoring errors
RET ; Done
Subttl GETTXT - Routine to return text buffer
;GETTXT assumes that what shows on the screen is reflected by the buffer
;contents, and that the cursor is where LINE and COL say it is. Location
;MAXLIN contains the legal line limit for the input text. TOPLIN contains
;the current line that's at the top of the screen. Note that the line
;position to be used in cursor positioning, if such becomes necessary, is
;LINE modulo 24. Location BUF contains the address of the destination buffer.
;The input is terminated on two successive escapes. The failure return is
;taken if LINE exceeds MAXLIN. HGHLIN contains the number of the highest
;line seen.
GETTXT: TRVAR <SLINE,SCOL,<CCSTRG,2>,IMFLG,BEGBUF,DIRECT,SHRVAL,DOUBLE,JCNT>
SETZM DOUBLE ; Single spacing by default
SETZM DIRECT ; Searching forward by default
SKIPE PROG ; Programming mode?
SETZM AUTOPG ; Yes, NO autopagination
SETZM SHRVAL ; Clear shrink value
MOVE T1,[POINT 7,BUF] ; Point to the buffer
MOVEM T1,BEGBUF ; And save the pointer
SETOM SLINE ; Clear it
SETOM SCOL ; Clear it
MOVEM P,SAVEP ; Save the stack pointer
SETZM TOPLIN ; Top line counter
MOVEI A,.CTTRM ; Terminal
RFCOC% ; Get current ccoc settings
DMOVEM B,CCSTRG ; Save them
;Initialize the screen
FLGON F.INDT ; Indent after refresh
CALL CLRSCN ; Clear the screen
; SKIPE SFIRST ; Are we in search-first mode?
; CALL PATMAT ; Yes, do a search first
SKIPN SFIRST ; Search-first mode?
CALL .FFD ; And initialize it
CALL SETPTR ; Set up the pointer
SKPON F.NSIN ; Do we have a new SIN% JSYS?
CALL CHKSIN ; Not yet...make sure we don't
;This is the main character input loop
GET.A: MOVE A,HGHLIN ; Get highest current line
CAMLE A,MAXLIN ; Too high?
RET ; Yes
SKPON F.NSIN ; New SIN% jsys available?
JRST GET.A2 ; Nope, do it the old way
;Attempt to read in a string of characters at once, for efficiency. We
; only do this if there are more than 2 characters left on the line to read,
; and only read to the first control character. SIN% must be modified for
; this function to work.
MOVE C,MAXCOL ; Get column
SUB C,COL ; Get characters left on line
CAIG C,6 ; Line too short?
JRST GET.A2 ; Yes, don't bother
SUBI C,4 ; Don't go into check area
MOVX D,SI%TCC ; Special JSYS flag
BPM B,SPARE ; Point to a buffer
MOVEI A,.PRIIN ; Principle input device
MOVE T1,C ; Copy character count
SIN% ; Read in the text
SUBI T1,1(C) ; Get chars read minus one
BPM B,SPARE ; Reset byte pointer
JUMPLE T1,GET.A1 ; Only one char read, handle specially
ADDM T1,COL ; Bump the column count
MOVNS T1 ; Negate t1
ADDM T1,CHRCNT ; And bump character count
ILDB A,B ; Get a byte
IDPB A,P1 ; Deposit it
AOJL T1,.-2 ; And loop until done
;Here for the last character on the line - might be control, handle differently
GET.A1: ILDB A,B ; Get the character
JRST GET.A3 ; Analyze it
;Here for regular character input, a byte at a time
GET.A2: SOS CHRCNT ; Count down another character read
PBIN% ; Get a character
;We can get here from escape handling routine, if we were forced to
; read in a pre-mature character.
GET.A3: SETZM VALUE ; No numeric value assumed
CAIN A,177 ; Is it a rubout?
JRST GET.C ; Yes, handle it specially
CAIGE A,SP ; Is it a control character?
JRST GET.B ; Yes, handle it
IDPB A,P1 ; Store the character
CALL .RIG ; Move cursor right
JUMPE T1,BREAK ; Look for line overflow
CAMLE T1,MAXCOL ; Too far over?
JRST BREAK ; Yes, correct the line
CAMLE T1,MINCOL ; In the red zone?
JRST CHECK ; Yes, look for a breaker
JRST GET.A ; Next char
;Handle control characters here. Return from GETTXT when we get the non-skip
;return from CCTAB, which indicates end of input found.
GET.B: SKIPL A,CCTAB(A) ; Get the dispatch code
JRST GET.B1 ; Not a cursor char
LDB T1,[POINT 9,A,17] ; Isolate type code
JUMPE T1,GET.B1 ; All terminals if zero
HRRZ T2,TRMTAB(P2) ; Get type of this terminal
CAMN T1,T2 ; Same type?
JRST GET.B1 ; Yes, execute the command
JRST GET.A ; No, discard the command
;Here if the control character is legitimate
GET.B1: FLGOFF F.NOPG ; Assume page mark will go away
CALL (A) ; Control character dispatch address
CALL SETPTR ; Set new pointer position
SKPON F.NOPG ; If screen ok, dont do paging
CALL SETPAG ; Display any page breaks on screen
SKPON F.FINI ; Finished?
JRST GET.A ; No, get next character
CALL CLRSCN ; Clear the screen
RETSKP ; And return
;Handle a rubout here. This gets treated as an actual delete, not as a
;backspace. It removes the character pointed to and shifts the line.
GET.C: CALL DELCHR ; Delete a character
CALL SETPTR ; Set the pointer up
JRST GET.A ; Loop for more
; BREAK and CHECK - Routines to handle line breaking neatly
;Check -- if the character we just looked at was a space, break the line.
CHECK: JUMPE A,CHE.A ; Neo-space?
CAIE A,SP ; Or space?
JRST GET.A ; No, return
CHE.A: FLGON F.FMOV ; Forced move
CALL .DWN ; Down a line
CALL DOIND ; Do indentation
JRST GET.A ; And continue
;Break - reverse and break the line at the first space we find. Go back only
;BACKUP characters before giving up, though. The double sequence at BRE.A
;probably looks odd, but reflect on the operation of the ADJBP instruction.
BREAK: JUMPE A,CHE.A ; Check for neo-space
CAIN A,SP ; Last one a space?
JRST CHE.A ; Yes, let check handle it
MOVE T2,BACKUP ; Get maximum backup
MOVE T3,P1 ; Get copy of pointer
;Loop here going backwards through the line
BRE.A: SETO T1, ; Set to minus one
ADJBP T1,T3 ; Back up the pointer
SOJ T2, ; Count back
LDB T3,T1 ; Get a byte
JUMPE T3,BRE.C ; Check for neo-space
CAIN T3,SP ; Space?
JRST BRE.C ; Yes, handle it
JUMPL T2,BRE.E ; Check for exceeding backup value
SETO T3, ; Now do same for other ac
ADJBP T3,T1 ; Make copy and back it up one
SOJ T2, ; Count back
LDB T1,T3 ; Get the character
JUMPE T1,BRE.B ; Check for neo-space
CAIN T1,SP ; Space?
JRST BRE.B ; Yes
JUMPGE T2,BRE.A ; Loop if we haven't gone too far
JRST BRE.E ; We have, break where we are
;We have a breaking spot. Pick up the characters we passed over and
;re-deposit them at the beginning of the next line.
BRE.B: MOVE T1,T3 ; Get pointer in right ac
BRE.C: SUB T2,BACKUP ; Get negative count of characters
PUSH P,T2 ; Save it
ADDB T2,COL ; Column where zeroing starts
JUMPG T2,BRE.C1 ; Skip if normal count
ADDI T2,^D80 ; We wrapped, back up to last line
MOVEM T2,COL ; Store it
SOS LINE ; Back up
BRE.C1: PUSH P,T1 ; Save the pointer
CALL CLREOL ; Blank out rest of line
FLGON F.FMOV ; Forced move
CALL .DWN ; Get to next line
CALL DOIND ; Do indentation
POP P,T1 ; Restore pointer
POP P,T2 ; Restore counter
MOVEI T3,SP ; Load a space
;Transfer from old line to new
BRE.D: ILDB A,T1 ; Get a character
DPB T3,T1 ; Overwrite it with a blank
IDPB A,P1 ; Deposit it
AOS COL ; Count it
SKIPN A ; Is it a null?
MOVEI A,SP ; Yes, that's a space
PBOUT% ; And type it
AOJL T2,BRE.D ; Loop as far as necessary
JRST GET.A ; Done
;No breaking point is convenient, so break the line just where we are
BRE.E: MOVNI T1,2 ; Load a minus two
SKIPE HYPHEN ; Want a hyphen?
MOVNI T1,1 ; Nope
ADDM T1,COL ; Adjust the column
ADJBP T1,P1 ; Copy the byte pointer
PUSH P,T1 ; Save it
HRROI A,[ASCIZ .- .] ; Two backspaces, etc
SKIPE HYPHEN ; Do we want the hyphen?
HRROI A,[ASCIZ . .] ; No, just break
PSOUT% ; Repair the line
FLGON F.FMOV ; Forced move in progress
CALL .DWN ; Down a line
CALL DOIND ; Indent it
POP P,T1 ; Restore old pointer
SKIPE HYPHEN ; Are we hyphenating?
JRST BRE.E1 ; Nope, skip this
ILDB A,T1 ; Get a byte
MOVEI B,"-" ; Get a hyphen
DPB B,T1 ; To replace it with
IDPB A,P1 ; Move the char
PBOUT% ; Type the char
BRE.E1: ILDB A,T1 ; Get the next char
MOVEI B,SP ; Load a space
DPB B,T1 ; Overwrite the character
PBOUT% ; Type that one too
IDPB A,P1 ; Transfer complete
CALL SETLC ; Set line and column
JRST GET.A ; Done
;Special routine to position the text byte pointer according to the current
;line and column.
SETPTR: STKVAR <<SAVT12,2>> ; Temp storage
DMOVEM T1,SAVT12
MOVE P1,LINE ; Get line number
IMULI P1,20 ; Get word address for line beginning
MOVE T1,COL ; Get column
IDIVI T1,5 ; Get word within line block
ADD P1,T1 ; Add to address
ADD P1,BUF ; Add in buffer address
HLL P1,PTRTAB(T2) ; Make proper byte pointer
DMOVE T1,SAVT12 ; Restore acs
RET ; Done
;Routine to position the line and column counters according to the current
;status of the byte pointer.
SETLC: HLLZ T1,P1 ; Get byte pointer part
HRRZ T2,P1 ; And address part
SUB T2,BUF ; Remove offset
IDIVI T2,20 ; Get line
MOVEM T2,LINE ; Store it
IMULI T3,5 ; Get start of column block
HRLZI T2,-6 ; Counter for aobjn loop
CAME T1,PTRTAB(T2) ; Check entries
AOBJN T2,.-1 ; Loop through table
ADDI T3,(T2) ; Add proper offset
MOVEM T3,COL ; And store the column
CAIGE T3,^D80 ; Too high?
RET ; No
SETZM COL ; Yes, we're on the next line
AOS LINE ; So say so
RET ; Done
;Byte pointer table
PTRTAB: 440700,,0 ; Point 7,0
350700,,0 ; Point 7,0,6
260700,,0 ; Point 7,0,13
170700,,0 ; Point 7,0,20
100700,,0 ; Point 7,0,27
010700,,0 ; Point 7,0,35
Subttl Pagination routines
SETPAG: SKIPN AUTOPG ; Autopagination on?
RET ; No, don't bother
CALL CLRPG ; Clear any current marks
SETO T1, ; Here we store loc of last page mark
SKIPE HARDPG ; Any hard page marks yet?
CALL FNDPAG ; Yes, find the nearest previous one
JUMPGE T1,SETP.A ; Non-neg means value set
MOVN T1,LETHED ; Otherwise use letterhead as count
ADDI T1,4 ; Add in count of header
; Here we loop, adding the page size to the value in t1 (last mark) until
; we are >= the current top-of-screen line value.
SETP.A: ADD T1,PAGSIZ ; Add the pagesize
CAMGE T1,TOPLIN ; Are we greater than top-of-screen?
JRST SETP.A ; No, keep incrementing
SUB T1,TOPLIN ; Find the difference
CAIL T1,^D23 ; Is it less than 24?
RET ; No, so no page break on screen
MOVE T2,T1 ; Store the marker value
SKIPN HARDPG ; Any hard pages?
JRST SETP.B ; No, so don't bother checking
SKIPE B,T1 ; Copy it
IMULI B,20 ; If non-zero, multiply by 20
ADD B,BUF ; Add buffer offset
CALL FNDP.A ; Look for page break on screen
JUMPGE T1,R ; Return if one found
SETP.B: MOVEM T2,CURRPG ; Save current page marker
; Here we know there is a page break on the screen. Put it where it belongs:
SETMRK: PUSH P,LINE ; Save the current line
PUSH P,COL ; Save the column
MOVEI A,^D79 ; The 79th col
MOVEM A,COL ; Set it
ADD T2,TOPLIN ; Find our loc on the screen
MOVEM T2,LINE ; Set the line
CALL FNDP.B ; See if there's a hard mark on screen
JUMPLE T1,SETM.B ; If none, skip the next test
MOVE B,LINE ; Recall the current line
SUB B,TOPLIN ; Find it on the screen
CAML B,T1 ; Is hard mark before soft one?
JRST SETM.A ; Yes, don't write it then
SETM.B: CALL SPCON ; Start the special effects
CALL CURSOF ; Cursor off if possible
CALL CURPOS ; Position the cursor
MOVEI A,"P" ; Page marker
PBOUT% ; Type it
SETM.A: POP P,COL ; Reset the column
POP P,LINE ; Reset the line
CALL CURPOS ; Put the cursor back
CALL SPCOFF ; Stop writing special characters
CALL CURSON ; Restore cursor if off
RET ; And return
; Here is the routine which erases the current page-mark from the screen:
CLRPG: SKIPGE CURRPG ; Is there a current mark?
RET ; No, just return
PUSH P,LINE
PUSH P,COL ; Save the current line and col
MOVE A,CURRPG ; Recall where the mark is
ADD A,TOPLIN ; Find the real line number
MOVEM A,LINE ; Make it the line
MOVEI A,^D79 ; 79
MOVEM A,COL ; Make it the current col
CALL CURSOF ; Turn off cursor, if possible
CALL CURPOS ; Move the cursor there
MOVEI A," " ; Get a space
PBOUT% ; Type it
POP P,COL ; Restore the column
POP P,LINE ; And the line
CALL CURPOS ; Reset the cursor
CALL CURSON ; Restore cursor if off
SETOM CURRPG ; Clear the current page word
RET ; And return
; Here is the FNDPAG routine. We search backward from the current line
; until we find a "~" as the first character of a line:
FNDPAG: MOVE B,TOPLIN ; Recall the current line
IMULI B,20 ; Make it a word counter
ADD B,BUF ; Find it in the buffer
MOVE T1,TOPLIN ; Where to start
; Now loop, looking for a "~" as the first character of a line
FNDP.A: LDB A,[POINT 7,@B,6] ; Get the first character of the line
CAIN A,"~" ; Is it a squiggle?
RET ; Return with the counter
SUBI B,20 ; Move to the previous line
SOJGE T1,FNDP.A ; Loop for all lines
RET ; And return
; Here to find if a hard page break is somewhere on the screen:
FNDP.B: MOVE B,TOPLIN ; Recall the top of screen
ADDI B,^D23 ; Find the current bottom line
IMULI B,20 ; Make it a word
ADD B,BUF ; Find it in the buffer
MOVEI T1,^D23 ; We'll check up to 23 lines back
JRST FNDP.A ; And look for the break
Subttl Control character processing
;.HOM - Home the cursor. On an ADDS we go to the bottom left corner of
;the screen, but on any other terminal it's top left.
.HOM: SETZM COL ; Column zero
MOVE T1,TOPLIN ; Get top line
MOVEM T1,LINE ; Make it current line
SKPOFF F.BHOM ; On a bottom homing terminal?
CALL HOMEUP ; An adds - really home it
FLGOFF F.NOPG ; Don't change the page mark
RET ; Return
;.LEF - Left cursor. This behaves differently on different terminals.
.LEF: SKIPN T1,VALUE ; Repeat count?
JRST .+3 ; No, regular
MOVNS T1 ; Make count negative
JRST POSM.C ; And dispatch
FLGON F.NOPG ; So far, screen is ok
SOSL T1,COL ; Reduce column
RET ; Done - that was easy!
FLGOFF F.NOPG ; But now screen might be bad
SKPON F.NWRP!F.ANSI ; Non-wrapping terminal?
JRST LEF.A ; Nope
SETZM COL ; Yes, can't back past left edge
RET ; Done
LEF.A: MOVEI T1,^D79 ; Last column on previous line
MOVEM T1,COL ; Store it
CALL .UP ; Up one line
RET ; Done
;.CR - Carriage return. Handled same on all terminals
.CR: PBIN% ; Get the line feed
FLGOFF F.DSCR ; No downward scrolling in effect
SETZM COL ; Now at column zero
CALL .DWN ; Go down a line
TXZN F,F.DSCR ; Did .dwn set scrolling flag?
SKIPLE INDENT ; Any indention?
JRST DOIND ; Do the indentation
RET ; Done
;.UP - Go up a line, watching for wraparound.
.UP: SKIPN T1,VALUE ; Repeat count?
JRST .+3 ; No, regular
MOVNS T1 ; Make count negative
JRST POSM.L ; And go do it
SOS T1,LINE ; Back up a line
SKIPE DOUBLE ; Double spacing?
SOS T1,LINE ; Yes, two lines
FLGON F.NOPG ; We left the page mark alone
CAML T1,TOPLIN ; Backed up too far?
JRST [SKIPE DOUBLE ; Double spacing?
JRST CURPOS ; Yes, manual spacing
RET] ; No, just return
FLGOFF F.NOPG ; Might have changed the screen
JUMPG T1,UP.B ; Hidden data, back up
SETZM TOPLIN ; Set first line as top
SETZM LINE
CALL CURPOS ; Re-position cursor
RET ; Done
;Here if we want to wrap backwards with more text available.
UP.B: MOVE T1,TOPLIN ; Get present top
SUB T1,SCRVAL ; Amount to scroll by
SKIPGE T1 ; Don't go negative
SETZ T1,
CAMLE T1,LINE ; See if we're not back far enough
MOVE T1,LINE ; We weren't, fix it
MOVEM T1,TOPLIN ; Reset the top border
CALL CLRSCN ; Clear screen
CALL .FFD ; Refresh the screen
RET ; And return
;Cursor right
.RIG: SKIPE T1,VALUE ; Repeat count?
JRST POSM.C ; Yes, handle that
AOS T1,COL ; Bump the column
FLGON F.NOPG ; Chance the screen is ok
CAIGE T1,^D80 ; Wraparound?
RET ; No
FLGOFF F.NOPG ; Screen might be fudged, mark it
SKPON F.ANSI!F.VT52 ; Ansi or vt52 mode?
JRST RIG.A ; Nope, regular
SOS T1,COL ; Yes, no wrapping available
RET ; Done
;On a regular wrapping terminal
RIG.A: SETZM COL ; Now on column zero
CALL .DWN ; Cursor down one line
SETZ T1, ; Return column
RET ; Done
;.TAB - These are tricky to handle. The Viewpoints don't have hardware
;tabs, so for consistency on all terminals we set tabs to no echo mode and
;simulate them by spaces.
.TAB: MOVEI A,SP ; Get a space
TAB.A: IDPB A,P1 ; Deposit at least one
PBOUT% ; And type it too
AOS T1,COL ; Bump the column
CAIL T1,^D80 ; Too far?
JRST TAB.B ; Yes, new line
ADJBP T1,[POINT 1,TABS] ; Get pointer to proper area
ILDB T2,T1 ; Get the bit
JUMPE T2,TAB.A ; Not set, keep going
RET ; Done
;Here when we've tabbed too far and reached next line
TAB.B: SETZM COL ; Yes, we're at left edge now
CALL .DWN ; And down one line
FLGOFF F.NOPG ; We could have blown floating mark
RET ; Done
;Special routines to set and remove tab stops
.REMTB: TDZA T1,T1 ; Clear t1
.SETTB: MOVEI T1,1 ; Set t1
SKIPN T2,COL ; Get column
RET ; Don't mess with first tab
ADJBP T2,[POINT 1,TABS] ; Get byte pointer
IDPB T1,T2 ; Set or clear a tab
RET ; Return
;.FFD - Form feed handling. The screen is now clear, so we should
;refresh it.
.FFD: SETZM SFIRST ; Clear search mode
SKPOFF F.NFFD ; No form feed?
CALL CLRSCN ; Supply a clear screen
SETZM CURRPG ; No page mark any more
.FFD.B: MOVE T1,TOPLIN ; Get top of screen
MOVEI T2,^D24 ; Amount to print
;Alternate entry from routines that don't want to start outputting at the top.
FFD.A: PUSH P,BUF ; Save some parameters
PUSH P,HGHLIN
IMULI T1,20 ; Make into word offset
ADDM T1,BUF ; Add to buf
SOJ T2, ; Back up by one line
MOVEM T2,HGHLIN ; Store for empty routine
MOVEI A,SPARE ; Spare data buffer
CALL EMPTY ; Translate the buffer
SETZ T2, ; Wipe out the last crlf
IDPB T2,T1 ; With a null
POP P,HGHLIN
POP P,BUF
HRROI A,SPARE ; Get the buffer
PSOUT% ; And type it
TXZN F,F.INDT ; Should we indent?
JRST CURPOS ; No, just return
SKIPE COL ; Are we at left edge?
JRST CURPOS ; No, so stay where we are
MOVE T1,INDENT ; Get indent
MOVEM T1,COL ; And set it
JRST CURPOS ; Position and return
;CTLC - Control C handling. Here we just abort the program. If we're
;continued, we jump to .FFD to restore the screen to a known state.
CTLC: CALL CLRSCN ; Clear the screen
CALL RESTRM ; Restore normal terminal mode
TYPE <% Aborting, type CONTINUE to recover>
HALTF% ; Die
CALL INITRM ; Back to special mode
CALL CLRSCN ; Clear the screen
CALL .FFD ; Reset the contents
JRST GET.A ; And get next input
;Exit - leave the program
EXIT: FLGON F.FINI ; Done
RET ; Return
;.DWN - Go down one line. This gets a bit tricky, since the screen
;might scroll and we have to be aware of where the top line really is.
.DWN: SKIPE T1,VALUE ; Repeat count?
JRST POSM.L ; Yes, do it
SKIPN DOUBLE ; Double spacing?
IFSKP. ; Yes, add another line
MOVEI A,12 ; Line feed
PBOUT% ; Type it
AOS A,LINE ; Add another line
SUB A,TOPLIN ; Find out what line we're on
CAIL A,^D24 ; Double scroll case?
AOS TOPLIN ; Yes, account for it
ENDIF.
AOS A,LINE ; Down a line
SUB A,TOPLIN ; How far down are we?
FLGON F.NOPG ; We didn't move the window (yet)
CAIGE A,^D24 ; Did we scroll?
JRST DWN.A ; No, return after zeroing flags
FLGOFF F.NOPG ; We moved it now
MOVE A,LINE ; Get line again
CAMLE A,HGHLIN ; Is there more text below?
JRST DWN.B ; No
MOVEI A,.PRIOU ; Output
HRROI B,[BYTE (7) 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12]
MOVN C,SCRVAL ; Number of lines down to go
SKPON F.FMOV ; Forced move?
AOJ C, ; No, so go one less
SKIPE C ; Any more to go?
SOUT% ; Yes
MOVE T2,SCRVAL ; Get lines to refresh
ADDM T2,TOPLIN ; Reflect new top line
PUSH P,COL ; Save column
SETZM COL ; Clear it
CALL CURPOS ; Position
POP P,COL ; Restore column
MOVE T1,LINE ; Get line to start
CALL FFD.A ; Do a partial refresh
FLGON F.DSCR ; Downward scrolling in effect
;Make sure that the flag F.FMOV is zeroed no matter how we leave this
;routine, or else it can hang around to bother us later.
DWN.A: FLGOFF F.FMOV ; Clear the flag
MOVE A,LINE ; Get line back again
CAMLE A,HGHLIN ; Did we set a new max?
MOVEM A,HGHLIN ; Yes, set it
JRST DWN.C ; * check for insert mode
RET ; Done
;Check for a forced MOVE command - such as for a tab overflow.
DWN.B: AOS TOPLIN ; Reflect new top line
MOVEM A,HGHLIN ; Set new maximum line seen
TXZN F,F.FMOV ; Forced move?
RET ; No
MOVEI A,12 ; Get a lf
PBOUT% ; And go down a line
; RET ; Done
;* Check for insert mode
DWN.C: SKPON F.INSM ; Insert mode?
RET ; No, done
MOVE A,IMFLG ; Get current line
CAML A,LINE ; Are we within old limit?
RET ; Yes, so we're done
CALL INSLIN ; No, so add new line
AOS IMFLG ; Bump the new line flag
RET ; Done
;.ESC - Escape handling. Some special functions require an escape before
;the real command. Otherwise escapes get ignored unless we're on an ANSI
;mode terminal. ANSI terminals use escape sequences for cursor movement.
;** Update: escapes now mean beginning of number.
.ESC: CALL GETNIN ; Get a number, w/o terminator
SKIPN VALUE ; Don't erase an existing value
MOVEM T1,VALUE ; Save it
MOVE A,T2 ; Copy terminating byte
JUMPE T1,ESC.0 ; Jump if no number
CAIL A,SP ; A control char?
JRST ESC.0 ; No
SKIPLE T1,CCTAB(A) ; Get the dispatch address
PBOUT% ; Must be echoed before dispatch
JRST (T1) ; Cursor, go to it
;Here if not a numeric command
ESC.0: CAIN A,"<" ; Open bracket?
JRST ESC.D ; Yes
CAIN A,">" ; Close bracket?
JRST MOVPAR ; Yes, copy and delete text
CAIN A,"O" ; A special function code?
JRST ESC.C ; Yes, handle specially
CAIE A,.CHDEL ; Don't echo a rubout
PBOUT% ; Type the terminating byte
SKPOFF F.VT52 ; Terminal a vt52?
JRST ESC.1 ; Yes, skip the next tests
SKPON F.ANSI ; Altmodes part of cursor movement?
JRST GET.A3 ; No, analyze current character
CAIE A,"[" ; A bracket?
RET ; Nope, illegal
PBIN% ; Get the next
ESC.1: CAIN A,"A" ; Code a = up
JRST ESC.E ; Do it
CAIN A,"B" ; Code b = down
JRST ESC.A ; Handle it specially
CAIN A,"C" ; Code c = right
JRST .RIG ; Do it
CAIN A,"D" ; Code d = left
JRST .LEF ; Do it
RET ; Ignore anything else
;We handle the down command specially because it doesn't scroll. Thus
;it must be different from the line feed, which does.
ESC.A: MOVE T1,LINE ; Bump the line count
SUB T1,TOPLIN ; Get distance from top
MOVEI A,12 ; Load up a line feed
CAIL T1,^D23 ; Tried to go off the screen?
PBOUT% ; Force a cursor movement
JRST .DWN ; And go to down routine
;Check for bumping the highest line
ESC.B: MOVE T1,LINE ; Get current line
CAMLE T1,HGHLIN ; Set new high water mark?
MOVEM T1,HGHLIN ; Yes, say so
RET ; Done
; Find out the sequence and handle the function code:
ESC.C: SKPON F.ANSI ; An ansi terminal?
RET ; No, ignore the sequence
MOVEI A,"A" ; A dummy code to follow the escape
PBOUT% ; Write it to the terminal to get
; Rid of the hanging <esc>
CALL ICHAR1 ; Get the next character, no raise
CAIE A,"S" ; Is it the home sequence? (pf4)
JRST ESC.C1 ; Nope, find the function
FLGON F.NOPG ; Left the screen alone
SETZM COL ; Column zero
MOVE T1,TOPLIN ; Get top line
MOVEM T1,LINE ; Make it current line
CALL HOMEUP ; And home the cursor
RET ; Done
ESC.C1: MOVEI T1,ESCMAX ; Get the conversion table size
ESC.C2: HRRZ T2,ESCTAB(T1) ; Get a function code
CAME A,T2 ; Match?
IFSKP. ; Yes...
HLRZ A,ESCTAB(T1) ; Get the corresponding function code
MOVEI T1,FUNMAX ; Get the length of the other table
JRST FUN.A ; And let the funct handler do the work
ENDIF. ; ...yes
SOJG T1,ESC.C2 ; No, look at the next entry
TYPERR <? Illegal function code specified>
RET ; Return to caller
ESCTAB: Z
XWD "1","P" ; Pf1
XWD "2","Q" ; Pf2
XWD "3","R" ; Pf3
XWD "!","w" ; 7
XWD """","x" ; 8
XWD "#","y" ; 9
XWD "A","m" ; -
XWD "B","t" ; 4
XWD "C","u" ; 5
XWD "D","v" ; 6
XWD "E","l" ; ,
XWD "F","q" ; 1
XWD "G","r" ; 2
XWD "H","s" ; 3
XWD "I","p" ; 0
XWD "J","n" ; .
XWD "U","M" ; Enter
ESCMAX==.-ESCTAB-1 ; Length of the table
;Mark a beginning position for the move command
ESC.D: MOVE T1,LINE ; Get line
MOVEM T1,SLINE ; Store it
MOVE T1,COL ; Get col
MOVEM T1,SCOL ; That too
RET ; Done
;Move the cursor up. If we're at the top, then scroll the screen downwards
; and insert (scrval) lines.
ESC.E: STKVAR <SCRTMP> ; Temporary variable
MOVE A,LINE ; Get current line
CAME A,TOPLIN ; Are we at the top?
JRST .UP ; No, regular up
MOVE B,SCRVAL ; Get current setting
SUB A,B ; Too far?
JUMPGE A,SCRL.A ; No
ADD B,A ; Correct the change
SETZ A, ; Cursor is homed
JUMPLE B,R ; We're already at the top
SCRL.A: MOVEM A,LINE ; Set line
MOVEM A,TOPLIN ; And topline
MOVEM B,SCRTMP ; Save amount to scroll
SETOM CURRPG ; Say the old page marks are gone
MOVE A,TJFN ; Get terminal jfn
MOVE C,[SEQ<ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",ALT,"M",>]
HLRZ B,C ; Copy string address
HRLI B,441000 ; Make 8-bit pointer
MOVN C,SCRTMP ; Get line count
ASH C,1 ; Multiply by two
SOUT% ; Type the string
MOVEI A,15 ; Get a cr
PBOUT% ; And home the line
MOVE T1,LINE ; Get top line
MOVE T2,SCRTMP ; Get line count
CALL FFD.A ; Refresh that many lines
MOVE A,LINE ; Get current line
ADD A,SCRTMP ; Add offset
SOJ A, ; Subtract for cursor movement
SKIPE DOUBLE ; Double spacing set?
SOJ A, ; Yes, one more line
CAMGE A,TOPLIN ; Too far?
MOVE A,TOPLIN ; Yes, correct it
MOVEM A,LINE ; Restore new value for line
JRST CURPOS ; And return
Subttl Special functions -- Pagination and tab stop manipulation
;These are a class of functions that deserve control characters but
;don't have them. The ^K is followed by a letter code that specifies
;the action.
.SPEC: CALL ICHAR ; Get a character
CAIN A,"J" ; Join?
JRST JOIN ; Yes
CAIN A,"C" ; Center?
JRST CENTER ; Yes
CAIN A,"F" ; Flush right?
JRST FLUSHR ; Yes
CAIN A,"S" ; Set tabs?
JRST .SETTB ; Yes
CAIN A,"R" ; Remove tabs?
JRST .REMTB ; Yes
CAIN A,"B" ; Permanent page break?
JRST PERMBK ; Yes
CAIN A,"N" ; New file?
JRST NEWFIL ; Yes
CAIN A,"D" ; Togging double/single mode
JRST DOUB ; Yes, toggle the mode
CAIN A,"U" ; Unpaginate?
JRST UNPAG ; Yes
CAIN A,"I" ; Setting the indentation?
JRST SETIND ; Yes
CAIN A,"M" ; Setting maximum right margin?
JRST SETMAX ; Yes
CAIN A,"H" ; Heading set up?
JRST SETHED ; Yes
CAIN A,"?" ; Help command?
JRST HLPMES ; Yes
CAIN A,"L" ; List the functions?
JRST LSTFUN ; Yes
CAIN A,"V" ; Set scroll value?
JRST SETSCR ; Yes
CAIN A,"W" ; What command
JRST SHOW ; Show the status
CAIN A,"*" ; Search mode?
SETOM SFIRST ; Yes, set the mode word
CAIN A,"A" ; Adjust margins?
JRST SHRMAR ; Yes
; CAIN A,"Z" ; Toggle zero output?
; JRST ZOUT ; Yes
CAIE A,"P" ; Toggle pagination?
RET ; No, none of the above, ignore it
SETO A, ; Set A to be true
SKIPE AUTOPG ; Are we paginating?
SETZ A, ; We weren't, but we are now
MOVEM A,AUTOPG ; Save the toggled flag
RET ; None of the above
;Setind - reset the current line indentation
SETIND: MOVE A,COL ; Get current column
MOVEM A,INDENT ; Set as the new indent
RET ; Done
;Setmax - reset the current maximum margin
SETMAX: MOVE A,COL ; Get current column
CAIGE A,14 ; Make sure it's not too small
RET ; Too small
CAIL A,^D80 ; Or too big
RET ; It was
MOVEM A,MAXCOL ; Save it
SUBI A,4 ; Now set mincol
MOVEM A,MINCOL
CAMLE A,BACKUP ; Larger than backup?
MOVEM A,BACKUP ; Yes, can't be allowed
RET ; And return
;Centering formfeed - center the current line on the page and refresh
CNTFFD: SKIPE T1,VALUE ; Get repeat count
JRST POSM.C ; It exists, char command
SKPON F.NFFD ; If nffd terminal, ffd comes later
CALL CLRSCN ; Supply a clear screen
MOVE T1,LINE ; Get line
SUBI T1,^D12 ; Get half a screen back
SKIPGE T1 ; But don't go negative
SETZ T1,
MOVEM T1,TOPLIN ; New top of screen
CALL .FFD ; Do a form feed
RET ; And return
;Setscr -- set new scrolling parameter
SETSCR: SKIPG A,VALUE ; Check the requested value
TYPERR <? Value must be between 1 and 24>
CAILE A,^D24 ; Too large?
TYPERR <? Value must be between 1 and 24>
MOVEM A,SCRVAL ; Store it
RET ; And return
;Centering subroutine - Center the text on the current line
CENTER: MOVE T1,MAXCOL ; Get right margin
SKIPG T3,COL ; Get column
RET ; Must be past zero
SUB T1,T3 ; Get remaining space
JUMPLE T1,R ; Must be some
LSH T1,-1 ; Cut in half
HRROI A,SPARE ; Point to spare buffer
HRROI B,SPACES ; Source of spaces
MOVNI C,^D79 ; Number to copy
SOUT% ; Copy them
SETZM COL ; Start at left margin
CALL SETPTR ; Set up p1
MOVE A,T1 ; Get columns we're moving
ADJBP A,[POINT 7,SPARE] ; Adjust the pointer
MOVE B,P1 ; Source
MOVN C,T3 ; Move (col) places
SOUT%
CALL CLREOL ; Clear the line
MOVE A,P1 ; Beginning of line
HRROI B,SPARE ; Source
MOVNI C,^D79 ; Number to move
SOUT% ; Copy the line, shifted
MOVE A,P1 ; Where to start
CALL TYPLIN ; Type it out
MOVE T1,INDENT ; Indent position
MOVEM T1,COL ; Set column
FLGON F.FMOV ; Forced move in progress
CALL .DWN ; Down to next line
CALL CURPOS ; Position cursor
RET ; Done
;Flush right subroutine - make current text flush right
FLUSHR: MOVE T1,MAXCOL ; Get right margin
SKIPG T3,COL ; Get column
RET ; Must be past zero
SUB T1,T3 ; Get remaining space
JUMPLE T1,R ; Must be some
HRROI A,SPARE ; Point to spare buffer
HRROI B,SPACES ; Source of spaces
MOVNI C,^D79 ; Number to copy
SOUT% ; Copy them
SETZM COL ; Start at left margin
CALL SETPTR ; Set up p1
MOVE A,T1 ; Get columns we're moving
ADJBP A,[POINT 7,SPARE] ; Adjust the pointer
MOVE B,P1 ; Source
MOVN C,T3 ; Move (col) places
SOUT%
CALL CLREOL ; Clear the line
MOVE A,P1 ; Beginning of line
HRROI B,SPARE ; Source
MOVNI C,^D79 ; Number to move
SOUT% ; Copy the line, shifted
MOVE A,P1 ; Where to start
CALL TYPLIN ; Type it out
MOVE T1,INDENT ; Indent position
MOVEM T1,COL ; Set column
FLGON F.FMOV ; Forced move in progress
CALL .DWN ; Down to next line
CALL CURPOS ; Position cursor
RET ; Done
;Join subroutine -- Join next line to current line
JOIN: MOVE T1,MAXCOL ; Get maximum column
SUB T1,COL ; Find spaces left
JUMPLE T1,R ; Return if no space left
PUSH P,P1 ; Preserve pointer
MOVE T2,P1 ; Get pointer
AOS LINE ; Go to next line
SETZM COL ; Beginning of it
CALL SETPTR ; Set a new pointer
MOVE T3,MAXCOL ; Get max columns
JOI.A: ILDB A,P1 ; Get a byte
CAIE A,SP ; Discard spaces
CAIN A,NUL ; And nulls
SOJG T3,JOI.A ; Keep looking for a valid character
JUMPE A,JOI.C ; None on line if zero
CAMLE T1,T3 ; Check two counters
MOVE T1,T3 ; Use only lesser of two
CAIA ; Skip next ildb
JOI.B: ILDB A,P1 ; Get a char
IDPB A,T2 ; Deposit it
SOJG T1,JOI.B ; Repeat until done
JOI.C: POP P,P1 ; Restore old pointer
CALL SETLC ; And restore old line and col
CALL CLL.A ; Clear to end of line
MOVE A,P1 ; Copy the pointer
CALL TYPLIN ; Type this line over
AOS LINE ; Get to next line
CALL DELLN1 ; And delete it
CALL DISPLA ; Display new remainder of screen
RET ; And return
;SHRMAR routine -- shrink and expand margins
SHRMAR: MOVE A,SHRVAL ;GET TOGGLE
MOVE B,SHRINK ;GET SHRINK VALUE
SKIPE A ;SHRINK FLAG SET?
MOVNS B ;YES, NEGATE VALUE
ADD B,INDENT ;ADD TO CURRENT INDENT
SKIPGE B ;TOO SMALL?
SETZ B, ;YES
CAILE B,^D78 ;TOO LARGE?
MOVEI B,^D78 ;YES
MOVEM B,INDENT ;STORE NEW INDENT
;Now adjust the maximum
SKIPE PROG ;PROGRAMMING?
JRST SHRM.A ;YES, DON'T CHANGE RIGHT MARGIN
MOVN B,SHRINK ;GET SHRINK VALUE
SKIPE A ;FLAG SET?
MOVNS B ;NEGATE IT
ADD B,MAXCOL ;ADD TO CURRENT MAXIMUM
SKIPGE B ;TOO SMALL?
SETZ B, ;YES
CAILE B,^D78 ;TOO LARGE?
MOVEI B,^D78 ;YES
MOVEM B,MAXCOL ;STORE NEW MAXCOL
;Now change the flag
SHRM.A: XORI A,1 ;SET OR CLEAR
MOVEM A,SHRVAL ;STORE IT
RET ;AND RETURN
;HLPMES routine - display the help message
;Type out the help text, clear screen when a space is typed.
HLPMES: CALL CLRSCN ; Clear the screen
HRROI A,HLP..1 ; Get message
PSOUT% ; Type it
CALL ICHAR ; Get a continuation character
CAIN A,SP ; Is it a space?
JRST HLPTWO ; Yes, next page
CALL CLRSCN ; Clear screen again
JRST .FFD ; And refresh
;The help message
HLP..1: ASCIZ \ +--------------------------( Command summary )--------------------------+
| |
| ^P Position to: ^D Delete: |
| C Centering refresh. C Character. (Same as RUBOUT) |
| B Beginning of file. W Word. |
| E End of file. L Line. |
| L start of current Line. R Remainder of line. |
| A Append to current line. E + ^G -- to End of file. |
| N Next page (screen). F + ^G -- entire File. |
| P Previous page (screen). |
| W beginning of next Word. ^N iNsert: |
| R Reverse word tab. (NIY) C Character. |
| L Line. |
| ^T Transparent tab. S Split line at cursor. |
| ^R Reverse transparent tab. I continuous Insert mode. |
! F Function definition |
| ^W Search for/replace a string. |
| ^X Repeat last search/replace. ^E Exit from program. |
| ^L Refresh the screen. |
| ^V eVen text: |
| P in Paragraph. (** Type space for more help, |
| F in File. or <CR> to return to text **) |
| |
+----------------------------( Page one )-------------------------------+\
;Page two of the help file
;Type out the help text, clear screen when a space is typed.
HLPTWO: CALL CLRSCN ; Clear the screen
HRROI A,HLP..2 ; Get message
PSOUT% ; Type it
CALL ICHAR ; Get a continuation character
CAIN A,SP ; Is it a space?
JRST HLPMES ; Yes, previous page
CALL CLRSCN ; Clear screen again
JRST .FFD ; And refresh
;The second page of the help file
HLP..2: ASCIZ \ +--------------------------( Command summary )--------------------------+
| |
| ^K Miscellaneous commands: ^K More miscellaneous: |
| ? Type the help message. W What are tab/margin settings. |
| V set Value for scrolling. S Set a tab stop. |
| B insert a hard page Break N input a New file. |
| R Remove a tab stop. |
| ^G Get line(s) into text buffer: C Center text. |
| M Move the lines (delete). F set text to Flush right. |
| C Copy the lines (keep). I set new /INDENT value. |
| M set new /MAXIMUM value |
| $< Set beginning of text string. P toggle Pagination on and off |
| $> Set end of text string: D toggle Double spacing |
| M: move, C: copy, D: delete. U Remove hard page breaks |
| R: return L List user defined functions |
| H set up page Header. |
| ^O Retrieve text in text buffer. J Join two lines together. |
| |
! General note on numbers: any command may be preceeded by <escape> |
| number -- this specifies a repeat count for the function. Cursor |
| keys may also be used with a repeat count for fast movement. |
| |
| (** Type space for previous page, or <CR> to return to text **) |
+----------------------------( Page two )-------------------------------+\
;LSTFUN routine - list the user-defined functions
LSTFUN: CALL CLRSCN ; Clear the screen
SETZ T1, ; Set up a counter
MOVEI D,FUNCT ; Point to the function list
TYPE < User Defined Functions
> ; Type a header
LSTLOP: AOS T1 ; Increment the counter
ADDI D,30 ; Increment our function word count
SKIPN (D) ; Is there a function defined?
JRST LSTL.A ; No, don't type anything
TYPNCR <F> ; Type an F
CAIL T1,7 ; Is the function 1-6?
IFSKP. ; Yes, just type the number
NUMOUT T1,12 ; Type the number of the function
ELSE. ; If not, type a letter
MOVE A,T1 ; Get the number
ADDI A,72 ; Make it the corresponding letter
PBOUT% ; Type the byte
ENDIF. ; End of typing a letter
TYPNCR < [> ; Nice formating
HRRO A,D ; Point to the function in question
PSOUT% ; Write the function to the screen
TYPE <]> ; And type a CRLF
LSTL.A: CAIGE T1,FUNMAX ; Out of functions?
JRST LSTLOP ; No, keep going
TYPNCR <
(Type any character to continue)>
CALL ICHAR ; Yes, wait for a char to be input
CALL CLRSCN ; Clear the screen
JRST .FFD ; And then refresh the screen
Subttl Special functions -- New file
;This routine clears the main buffer and inputs a new file, preserving
; the previous files switches. The routine is, unfortunately, WPSIM
; dependant. The new JFN is stored in external location IJFN.
NEWFIL: CALL DELFIL ; Delete the file after confirmation
SKIPLE HGHLIN ; Anything in the buffer?
RET ; Yes, not confirmed
CALL WRKSPC ; Get workspace set up
CALL SPCON ; On with the lights
MOVEI A,.CTTRM ; This terminal
SETZ B, ; Zero the line and col
SFPOS% ; Set the position
TYPNCR <File: > ; Prompt
MOVX A,GJ%SHT+GJ%OLD+GJ%FNS+GJ%CFM ; Old file
MOVE B,[.PRIIN,,.PRIOU] ; Get info from terminal
GTJFN% ; Get a jfn
ERJMP NEWF.1 ; Can't
HRRZM A,IJFN## ; Save the jfn
MOVX B,FLD(7,OF%BSZ)!OF%RD ; Read access
OPENF% ; Open it
ERJMP NEWF.2 ; Can't
MOVE A,IJFN## ; Jfn in a
CALL FILL ; Get the file into the buffer
ERJMP NEWF.3 ; Can't
NEWF.A: CALL SPCOFF ; Off with the lights
SETZM LINE ; Position to top of file
SETZM COL
SETZM TOPLIN ; Top of screen
CALL CLRSCN ; Clear the screen
CALL .FFD ; And display the screen
RET ; And we're done
; Here to toggle between single and double space mode:
DOUB: SETCMM DOUBLE ; Toggle double spacing
RET ; And return
;Error returns
NEWF.1: HRROI T1,ASC<? Unable to find file>
SKIPA ; Next
NEWF.2: HRROI T1,ASC<? Unable to open file>
SKIPA ; Next
NEWF.3: HRROI T1,ASC<? Unable to read file>
MOVEI A,.CTTRM ; This terminal
RFPOS% ; Get position
HRRZS B ; Isolate column
JUMPLE B,NEWF.4 ; At the beginning
TYPE ; At end of line -- type a cr
NEWF.4: MOVE A,T1 ; Get string pointer
PSOUT% ; Type it
MOVEI A,HLDTIM ; Sleep time
DISMS% ; Wait that long
JRST NEWF.A ; And finish up
Subttl Special functions -- Deletes
;Analyze the character following to determine whether to delete a word, line
;or to EOL or EOS.
DELETE: CALL ICHAR ; Get a character
CAIN A,"C" ; Character?
JRST DELCHR ; Yes
CAIN A,"W" ; Word?
JRST DELWRD ; Yes
CAIN A,"L" ; Line?
JRST DELLIN ; Yes
CAIN A,"R" ; Rest of line?
JRST DELEOL ; Yes
CAIN A,"E" ; To end of text?
JRST DELEOS ; Yes
CAIN A,"F" ; Delete whole file?
JRST DELFIL ; Yes
CAIN A,"B" ; Delete to beginning?
JRST DELBEG ; Yes
RET ; None of the above
;Routine to delete one character
DELCHR: SKIPLE T1,VALUE ; Repeat value?
JRST DELMCH ; Yes, do several
MOVE A,P1 ; Get pointer
MOVE C,COL ; Where are we?
SUBI C,^D79 ; Get characters left on line
;Loop looking at rest of characters on line
DELC.A: ILDB T1,A ; Get a character
JUMPE T1,DELC.B ; Null is a space
CAIE T1,SP ; Space
JRST DELC.C ; Not a space
;Look for a line of all spaces remaining
DELC.B: AOJL C,DELC.A ; Spaces only, keep going
SOSGE COL ; End of line, back up
JRST [AOS COL ; Too far, correct and return
RET]
CALL SETPTR ; Set pointer correctly
IDPB T1,P1 ; Deposit a space
MOVEI A,10 ; Get a backspace
PBOUT% ; Type it
CALL CLL.A ; Clear to eol
RET ; Done
;Routine to delete to beginning of file
DELBEG: MOVE T1,COL ; Get column
MOVE T2,INDENT ; Get indent
SUB T1,T2 ; Get difference
JUMPL T1,R ; Don't do it if beyond indent
MOVEM T2,COL ; Set new column
CALL SETPTR ; Set the pointer
JRST DELMCH ; And remove the space
;This line gets a regular deletion of a character at the cursor
DELC.C: SKPON F.V102 ; Are we a VT102 terminal?
CALL CLL.A ; No, clear to end of line
MOVE A,P1 ; Destination
MOVEI B,1 ; Source is destination+1
ADJBP B,P1 ; So get it
MOVE C,COL ; Get column
SUBI C,^D79 ; Get minus columns left
SKIPE C ; Don't let it be zero
SOUT% ; Move in
SKPOFF F.V102 ; Are we VT102?
JRST DELC.D ; Yes, delete a char and return
MOVEI D,SP ; No, get a space
IDPB D,A ; And tack it on
MOVE A,P1 ; Get pointer
CALL TYPLIN ; Type the line
CALL CURPOS ; Get cursor back
RET ; Done
;Here to delete characters on a VT102 terminal:
DELC.D: SKIPN T1,VALUE ; Do we have a count?
MOVEI T1,1 ; No, make it a 1
DELC.E: MOVE A,TJFN ; The jfn of the terminal
MOVEI B,ALT ; An escape
BOUT% ; Write it
MOVEI B,"[" ; A bracket
BOUT% ; Write it
MOVE B,T1 ; Get the repeat count
CAILE B,^D80 ; Too many?
MOVEI B,^D80 ; Yes, reduce to a reasonable number
HRRZI C,12 ; Decimal, no column count
NOUT% ; Write the number
DBLERR (Nout Failed,CONT)
MOVE A,TJFN ; To the terminal again
MOVEI B,"P" ; A p to terminate
BOUT% ; Write it
RET ; And return to caller
;Here to delete many characters
DELMCH: MOVE T3,T1 ; Copy number
ADD T1,COL ; Get column that would put us at
CAIG T1,^D79 ; Too far?
JRST DELM.A ; Nope
SUBI T1,^D79 ; Get distance over
SUB T3,T1 ; Modify value
SKIPG T3 ; Still legal?
TYPERR <? Can't delete that many characters on this line>
DELM.A: PUSH P,T3 ; Save the number
CALL SHIFT ; Shift line by (t3) chars
POP P,T1 ; Restore count
SKPOFF F.V102 ; Are we a VT102 terminal?
JRST DELC.E ; Yes, go delete (t1) characters
CALL CLREOL ; Clear line
MOVE A,P1 ; Copy pointer
CALL TYPLIN ; Type rest of line
CALL CURPOS ; Position
RET ; And return
;Delete line routines - remove the line at the cursor
DELLIN: SKIPLE T4,VALUE ; Repeat count?
IFSKP. ; No, do one line
MOVEI T4,1 ; Load one
SKIPE DOUBLE ; Double spacing?
LSH T4,1 ; Yes, double to two lines
ENDIF.
DELN.A: PUSH P,T4 ; Save the delete count
CALL DELLN1 ; Delete 1 line
SOJG T4,.-1 ; Repeat as far as necessary
POP P,T4 ; Retreive the line count
CAIG T4,^D23 ; Too many lines?
SKPON F.V102 ; Or a VT102 terminal?
JRST DISPLA ; Either one...display and ret
; Here if we have a VT102 terminal...do a fancy line delete and redisplay
MOVE A,TJFN ; Get the tty jfn
MOVEI B,ALT ; An esc
BOUT% ; Send it
MOVEI B,"["
BOUT% ; Send a bracket
MOVE A,TJFN ; Point at the destination
MOVE B,T4 ; Get the number to output
CAILE B,^D24 ; Too many?
MOVEI B,^D24 ; Yes, reduce to a reasonable number
HRRZI C,12 ; A base 10 number
NOUT% ; Translate it into ascii
DBLERR (Nout failed,CONT)
MOVE A,TJFN ; Recall the terminal jfn
MOVEI B,"M" ; Delete line code
BOUT% ; Send it
PUSH P,LINE ; Save the current line number
MOVE T3,TOPLIN ; Get the top of screen
ADDI T3,^D24 ; Find the bottom line
SUB T3,T4 ; Find t4 lines form the bottom
CAML T3,LINE ; Further along in file?
MOVEM T3,LINE ; Pretend this is the current line
CALL DISPLA ; Redisplay here
POP P,LINE ; Recall the current line
CALL CURPOS ; Position the cursor
RET ; And return
;This is the routine to delete one line without updating the display
DELLN1: MOVE A,LINE ; Get line
IMULI A,20 ; Get word starting line
ADD A,BUF ; Point to text
HRLS A ; Put in left half
ADD A,[20,,0] ; Make "from" higher than "to"
SOS B,HGHLIN ; Lower highest line
CAMGE B,LINE ; Must not delete too far
AOS HGHLIN ; So if we did, bump hghlin back up
IMULI B,20 ; Point to new highest line
ADD B,BUF ; Inside buffer
BLT A,17(B) ; Shift everything
MOVE A,SPACES ; Get some spaces
MOVEM A,20(B) ; Store in last line
HRLI A,20(B) ; Set up new blt pointer
HRRI A,21(B)
BLT A,37(B) ; Clear new highest line
RET ; And return
;DELEOL - delete to end of line routine.
DELEOL: CALL TXTEOL ; Remove text to end of line
CALL CLREOL ; Clear on screen
RET ; Done
;DELEOS - Delete from cursor to end of text
DELEOS: CALL CONFRM ; Make sure that's what's wanted
RET ; It wasn't
CALL TXTEOL ; Remove text trailing this line
MOVE T1,LINE ; Get current line
MOVE T2,HGHLIN ; Get highest line
CAML T1,T2 ; Are we at the top?
JRST CLREOS ; Yes, nothing more to remove
MOVEM T1,HGHLIN ; New highest line
AOJ T1, ; Start at next
IMULI T1,20 ; Convert to word value
ADD T1,BUF ; Make into address
HRLS T1 ; Get into left half
SUB T1,[1,,0] ; Point back into cleared area
IMULI T2,20 ; Convert high line to word address
ADD T2,BUF ; Make it an address
BLT T1,17(T2) ; Propogate the spaces
CALL CLREOS ; Clear to end of screen
RET ; And return
;TXTEOL - Remove the text on the current line trailing the cursor.
TXTEOL: MOVE A,P1 ; Get pointer
HRROI B,SPACES ; Space source
MOVNI C,^D79 ; Get line length
ADD C,COL ; Left after cursor
SKIPE C ; Don't let it be zero
SOUT% ; Clear with spaces
MOVEI B,SP ; Get a space
IDPB B,A ; And wipe out that trailing null
RET ; Done
;Delete a word. Erases the word either at or following the cursor,
;plus the trailing spaces.
DELWRD: CALL NXTWRD ; Get coordinates of next word
JRST DLW.A ; No word following
MOVEM T1,COL ; Where it starts
CALL SETPTR ; Set the pointer to it
CALL SHIFT ; Shift the line over by (t3)
CALL CLREOL ; Clear to end of line
MOVE A,P1 ; Get pointer
CALL TYPLIN ; Type the line
CALL CURPOS ; Get cursor back
RET ; Done
;Here to back up a character and try again
DLW.A: SOSGE COL ;TRY BACKING UP
JRST [SETZM COL ;CAN'T, WE'RE AT BEGINNING
JRST CURPOS] ;FIX UP CURSOR
CALL SETPTR ;SET UP THE POINTER
JRST DELWRD ;TRY AGAIN
;Shift subroutine -- shift the line over (T3) places to the left, filling
;in trailing blanks on the right.
SHIFT: MOVE A,P1 ; Destination
MOVE B,T3 ; Number of spaces to delete
ADJBP B,P1 ; Now points to source
MOVE C,COL ; Get column
ADD C,T3 ; Add field width
SUBI C,^D80 ; Get minus columns left
SKIPE C ; Don't let it be zero
SOUT% ; Move in
MOVEI D,SP ; Get a space
IDPB D,A ; And tack it on
SOJG T3,.-1 ; Loop for number of deleted spaces
RET ; Done
;Function F - delete whole file
DELFIL: CALL CONFRM ; Confirm the request
RET ; Not really meant
CALL CLRSCN ; Clear the screen
SETZM TOPLIN ; Start at line zero
SETZM LINE ; We're at home position
MOVE T1,INDENT ; Get indention
MOVEM T1,COL ; Set it
CALL CURPOS ; Position there
MOVE T1,SPACES ; Get some spaces
MOVEM T1,@BUF ; Clear first word
MOVE T3,HGHLIN ; Get highest line seen
IMULI T3,20 ; Get number of words
ADDI T3,17 ; Add another line's worth
ADD T3,BUF ; Add in address of buffer
HRL T2,BUF ; Get buffer start
HRR T2,BUF ; In both halves
AOJ T2, ; Bump right hand side
BLT T2,(T3) ; Clear whole storage block
SETZM HGHLIN ; Highest line we've seen
RET ; Done
Subttl Special functions -- Tabbing
;Transparent tabs - non destructive as they move.
TRATAB: FLGOFF F.NOPG ; Doesn't need resetting of page mark
AOS T1,COL ; Bump the column
CAIL T1,^D80 ; Too far?
JRST TRA.A ; Yes, down a line
ADJBP T1,[POINT 1,TABS] ; Get pointer to proper area
ILDB T2,T1 ; Get the bit
JUMPE T2,TRATAB ; Not set, keep going
JRST TRA.B ; Done, position and return
;Here we adjust for a new line
TRA.A: SETZM COL ; Zero the column
FLGON F.FMOV ; Forced move in progress
CALL .DWN ; Down a line
;Now get the cursor where we want it
TRA.B: CALL CURPOS ; Position it
RET ; And return
;Backtabs - non-destructive tabs backwards to previous tab stop.
BAKTAB: SOS T1,COL ; Backup the cursor
FLGOFF F.NOPG ; Doesn't need resetting of page mark
JUMPL T1,BAK.A ; Too far?
ADJBP T1,[POINT 1,TABS] ; Get pointer to proper bit
ILDB T2,T1 ; Get it
JUMPE T2,BAKTAB ; No set, keep going
JRST BAK.B ; Found one
;Here when we've backed up a line
BAK.A: MOVEI T1,^D79 ; Last column
MOVEM T1,COL ; Set it
CALL .UP ; Tell program we went up a line
JRST BAKTAB ; Keep trying on this new line
;Now get the cursor where we want it
BAK.B: CALL CURPOS ; Position it
RET ; And return
Subttl Special functions -- Inserts
;Insert either a line or an unknown number of characters. If the latter,
;we break the current line and put the remainder on the next line.
;Or, insert a function definition into the function block.
INSERT: CALL ICHAR ; Get the specifier
CAIN A,"L" ; Line?
JRST INSLIN ; Yes
CAIN A,"C" ; Char?
JRST INSCHR ; Yes
CAIN A,"S" ; Split?
JRST INSPLT ; Yes
CAIN A,"I" ; * insert mode to stick?
JRST INSMOD ; * yes
CAIN A,"F" ; Function definition?
JRST INSFUN ; Yes
RET ; No good
;Here to insert a whole line
INSLIN: SKIPLE T2,VALUE ; Repeat count?
IFSKP. ; No, do one line
MOVEI T2,1 ; Load one
SKIPE DOUBLE ; Double spacing?
LSH T2,1 ; Yes, double to two lines
ENDIF.
MOVE T1,LINE ; Insert the line here
CALL ILINE ; Insert line(s)
SKPON F.V102 ; A VT102 terminal?
JRST DISPLA ; No, now display
; Here for VT102 terminals. Do a fancy insert.
PUSH P,LINE ; Save the current line
MOVEM T1,LINE ; Set the new line for insert
CALL CURPOS ; Move the cursor there
MOVE A,TJFN ; Get the tty jfn
MOVEI B,ALT ; An esc
BOUT% ; Send it
MOVEI B,"["
BOUT% ; Send a bracket
MOVE A,TJFN ; Point at the destination
MOVE B,T2 ; Get the number to output
CAILE B,^D24 ; Too many?
MOVEI B,^D24 ; Yes, reduce to a reasonable number
HRRZI C,12 ; A base 10 number
NOUT% ; Translate it into ascii
DBLERR (Nout failed,CONT)
MOVE A,TJFN ; Recall the terminal jfn
MOVEI B,"L" ; Insert line code
BOUT% ; Send it
POP P,LINE ; Restore the old line loc
CALL CURPOS ; Position the cursor
RET ; And return
;Here to toggle insert mode
INSMOD: TXCE F,F.INSM ; * on or off?
JRST INM.A ; Off
CALL LINACT ; Active line?
IFSKP. ; Yes, do the following
CALL INLN1 ; Insert 1 line
CALL INS.B ; And do a split
ENDIF. ; Done
MOVE A,LINE ; Save current line
MOVEM A,IMFLG ; For later use
RET ; Done
;Here when we're turning insert mode off - justify the code now
INM.A: PUSH P,LINE ; Save current line
JRST EVE.A ; And even current paragraph
; Subroutine to insert one or more lines into the workspace.
; Call with T1 containing line number in front of which new lines are to
; be inserted. T2 contains the number of lines to insert. The inserted
; lines will be zeroed before returning.
; Entry point if double spacing is to be considered a factor:
ILINED: SKIPE DOUBLE ; Double spacing?
LSH T2,1 ; Yes, double the # of lines
; Entry point for straight single spacing insertion:
ILINE: DMOVE B,T1 ; Copy the args
SOS B ; Adjust the location argument
MOVE A,HGHLIN ; Top line of file
SUB A,B ; Get number of lines to insert
IMUL A,[-20] ; Make a neg number of words
MOVE B,HGHLIN ; Get highest line
LSH B,4 ; Multiply by 20 to get words
ADD B,BUF ; Add buffer address
ADDI B,17 ; Last word of the line
IMULI C,20 ; Number of words to insert
ADD C,B ; New destination
EXTEND A,[XBLT] ; Do a backwards blt
ADDM T2,HGHLIN ; Set the new highest line
;Now clear the area vacated
DMOVE A,T1 ; Copy values again
LSH A,4 ; Word number of starting area
ADD A,BUF ; Address
SETZM (A) ; Clear first word
HRLS A ; Put into left half
AOJ A, ; Bump right half
LSH B,4 ; Number of words to clear
ADDI B,(A) ; Add location to start at
BLT A,-2(B) ; And move words until we get there
RET ; Done
; Here to insert a line, ignoring the single/double spacing status:
INLN1: PUSH P,T2 ; Save the current t2
PUSH P,T1 ; Save t1 too
MOVE T1,LINE ; Insert the line where we are
AOS T1 ; But after the current line
MOVEI T2,1 ; Insert 1 line
CALL ILINE ; Go do it
POP P,T1 ; Retore t1
POP P,T2 ; And t2
RET ; And return
;Insert a line after the current line, or 2 if double spacing:
INLN2: PUSH P,T2 ; Save the current t2
PUSH P,T1 ; Save t1 too
MOVE T1,LINE ; Insert the line where we are
AOS T1 ; But after the current line
MOVEI T2,1 ; Insert 1 line
CALL ILINED ; Go do it
POP P,T1 ; Retore t1
POP P,T2 ; And t2
RET ; And return
;Here to insert a partial line
INSPLT: CALL INLN1 ; Insert a line
INS.B: CALL SPLIT ; Split this line
SKIPE DOUBLE ; Double spacing?
CALL INLN1 ; Yes, insert one line
PUSH P,COL ; Save proper column
SETZM COL ; Reset it
CALL DISPLA ; Display the screen changes
POP P,COL ; Restore proper column
JRST CURPOS ; And get there
;Split subroutine. Split the current line at the cursor, but don't update.
SPLIT: SKIPN PROG ; Programming?
CALL NXTWRD ; Find beginning of word
JRST SPL.A ; Split the line here
MOVEM T1,COL ; Use that column to start
CALL SETPTR ; And reset the pointer
SPL.A: PUSH P,P1 ; Save current pointer
AOS LINE ; Bump the line
PUSH P,COL ; Save column
SETZM COL ; Zero the column
CALL SETPTR ; Reset the pointer
MOVE A,INDENT ; Get indent
POP P,B ; Restore column
CAMLE A,B ; Beyond current column?
SETZ A, ; No, so start on the margin
ADJBP A,P1 ; Point to proper place on this line
MOVE P1,(P) ; Get proper value of p1 back
CALL SETLC ; Reset old line and column
MOVE B,P1 ; Get source
MOVNI C,^D79 ; Find out how many..
ADD C,COL ; ..characters to send
SKIPGE C ; Check for no transfer
SOUT% ; Send them
ILDB T2,B ; Get one more byte
IDPB T2,A ; And insert it
MOVE A,P1 ; Get pointer
HRROI B,SPACES ; What to write
MOVNI C,^D79 ; Number of spaces
ADD C,COL ; Left after text
SKIPGE C ; Don't transfer if nothing to do
SOUT% ; Fill in all but last
POP P,P1 ; Restore old pointer
RET ; Done
;Here to insert characters. Put in a blank and shift the rest of the
;line to the right. Characters shifted out of last position are lost.
INSCHR: SKIPG T1,VALUE ; Multiple?
MOVEI T1,1 ; No, only one
MOVE T3,P1 ; Store pointer
CALL MAKSPC ; Make some space
TYPERR <? Inserted spaces would cross right margin -- command ignored>
CALL CLREOL ; Clear to end of line
MOVE A,T3 ; Retrieve old pointer
CALL TYPLIN ; Type rest of line
CALL CURPOS ; Position cursor
RET ; And return
;Makespace routine -- insert several characters
MAKSPC: MOVE A,T1 ; Copy number
ADD A,COL ; Add to current column
SUB A,MAXCOL ; Check against right edge
SKIPLE A ; Past it?
RET ; Yes, give error return
MOVE C,COL ; Get column
SUBI C,^D79 ; Get remainder of line
HRROI A,SPARE ; Point to spare buffer
MOVE B,P1 ; Get text pointer
SKIPGE C ; Only if characters to transfer
SOUT% ; Transfer the data
MOVE A,T1 ; Get space count
MOVEI T4,SP ; Get a space
IDPB T4,P1 ; Store it where we are
SOJG A,.-1 ; Loop for all spaces
MOVE A,P1 ; Where to put the remainder
MOVE B,[POINT 7,SPARE] ; Source
MOVE C,COL ; Get column
SUB C,MAXCOL ; Remainder of line
ADDI C,1(T1) ; Minus number of spaces
SKIPGE C ; Check for no transfer
SOUT%
JUMPG C,.+3 ; Maybe we shouldn't type anything
ILDB T4,B ; Last one
IDPB T4,A ; Overwrites the null
RETSKP ; Done
;Here we allow the user to assign a function to a function key.
INSFUN: CALL WRKSPC ; Get some workspace
CALL SPCON ; Special effects
HRROI A,ASC<Function name: > ; Prompt
CALL GETSTU ; Get a string
MOVE B,[POINT 7,SPARE] ; Point to it
ILDB A,B ; Get the name
ILDB C,B ; Get the next byte
JUMPN C,INSF.B ; If not a null, error
SUBI A,60 ; Make it useable
JUMPLE A,INSF.B ; Zero or less...illegal
CAIG A,6 ; Was it a proper number?
JRST INSF.A ; Yes
CAIG A,20 ; Improper number?
JRST INSF.B ; Yes
CAILE A,32 ; Too big a letter?
JRST INSF.B ; Yes
SUBI A,12 ; Good letter, make it a number >11
;Here for a proper function name
INSF.A: IMULI A,30 ; Find the index into function storage
MOVEM A,T4 ; And save it
CALL WRKSPC ; Beginining of work space
HRROI A,ASC<Function: > ; Prompt
CALL GETSTR ; Get the string
MOVE A,[POINT 7,SPARE] ; Point to the string
MOVE B,[POINT 7,0] ; Destination
HRRI B,FUNCT(T4)
ILDB C,A ; Get a byte
IDPB C,B ; No, write it out
JUMPE C,.+2 ; Zero? done.
JRST .-3 ; Loop
;Here when done
CALL SPCOFF ; Of with the lights
CALL CLRWRK ; Clear the workspace
RET ; And we're done
;Here for an illegal function name
INSF.B: TYPNCR <% Illegal function name>
MOVEI A,HLDTIM ; Waiting time
DISMS% ; Sleep long enough to see it
CALL SPCOFF ; Effects off
CALL CLRWRK ; Clear the workspace
RET ; Error and return
Subttl Special functions -- Search routines
;This routine searches for the last string found by a ^W search, or for
;an "@" if this is the first search.
SEARCH: FLGOFF F.NOPG ; Doesn't need resetting of page mark
FLGON F.RPSH ; Say we're repeating previous search
SKPOFF F.REPL ; Replacement?
JRST REPLA ; Yes, do that
SKIPE CHRNUM ; Any characters?
JRST PMATCH ; Yes, repeat last search
MOVEI A,"@" ; Get a char
MOVEM A,PAT+1 ; Store it
MOVEI T3,1 ; One character
MOVEM T3,CHRNUM ; Store it
CALL MAKTAB ; Make the table
JRST PMATCH ; And match it
Subttl Special functions -- Pattern matching searches
;This routine uses the Knuth-Morris-Pratt algorithm.
PATMAT: FLGOFF F.NOPG ; Doesn't need resetting of page mark
MOVE A,VALUE ; Recall the repeat value
MOVEM A,DIRECT ; Save it as the direction were heading
MOVE T1,[PAT,,PAT+1] ; Get a blt pointer
FLGOFF F.REPL!F.RPSH ; Not a replacement, not repeating
SETZM PAT ; Clear a word
BLT T1,FLINK+120 ; Clear to end
CALL GETPAT ; Get the pattern
CALL MAKTAB ; Make the pattern matcher
SKPOFF F.REPL ; Replacement?
JRST REPLA ; Yes, proceed
;Alternate entry point from SEARCH
PMATCH: CALL MATCH ; Find a match
IFNSK. ; Not found
SKIPE VALUE ; Are we repeating?
JRST PATM.Z ; Yes, so reset cursor
JRST PATM.C ; No, so cursor hasn't moved
ENDIF.
SOSLE VALUE ; Count down number of searches
JRST PMATCH ; More to do
PATM.Z: MOVE T1,LINE ; Get current line
SUB T1,TOPLIN ; Get top of screen
SKIPL DIRECT ; Were we searching backward?
IFSKP. ; Yes...
SKIPL T1 ; Are we still on the screen?
JRST PATM.A ; No, so dont refresh
ELSE. ; No...
CAIGE T1,^D24 ; Are we off the screen?
JRST PATM.A ; No, so just repair last lines
ENDIF. ; End of conditional
CALL SPCOFF ; Turn off special effects
MOVE T1,LINE ; Get current line
SUBI T1,^D12 ; Split a screen
SKIPGE T1 ; Are we still in the file?
SETZ T1, ; No, set the top of screen
MOVEM T1,TOPLIN ; Store new screen top
CALL CLRSCN ; Clear
SKIPN SFIRST ; Just starting?
CALLRET .FFD ; No, refresh screen and return
CALLRET TYPLN1 ; Yes, just type the line and return
;Here when we're still on the current screen. Just repair last lines, which
;were used to hold the pattern we matched.
PATM.A: SKPON F.RPSH ; Repeating previous search?
JRST PATM.B ; No, jump ahead
SKIPN SFIRST ; Searching at first?
JRST CURPOS ; No, so nothing to repair
CALLRET TYPLN1 ; Yes, type the line and ret
PATM.B: CALL SPCOFF ; Turn off special effects
CALL CLRWRK ; Clear the work space
SKIPN SFIRST ; Searching at first?
RET ; No, just return
CALLRET TYPLN1 ; Yes, type the line and ret
;Here if we didn't find a string
PATM.C: SKIPN EXPERT ; Are we expert?
JRST PTM.C1 ; No, type message
SKIPE SFIRST ; Searching at first?
CALLRET TYPLN1 ; Yes, type the line and return
SKPOFF F.RPSH ; Repeat search?
RET ; Yes, so no workspace to clear
JRST PATM.B ; No, so must clear workspace
PTM.C1: CALL WRKSPC ; Clear a message area
CALL SPCON ; On with the effects
TYPNCR <% Search string was not found>
MOVEI A,HLDTIM ; Time to wait
DISMS% ; Sleep
JRST PATM.B ; And quit
Subttl Special functions -- String replacement
;This function implements search and replace
REPLA: STKVAR <TXTMOV> ; Get a temp variable
CALL MATCH ; Match up the string
JRST PATM.C ; Can't
MOVN T3,REPLEN ; Get length of replacement
ADD T3,CHRNUM ; Add length of search string
MOVEM T3,TXTMOV ; Save the size difference
JUMPL T3,REPL.B ; Too long
SKIPE T3 ; Any left over?
CALL SHIFT ; Yes, remove excess characters
SKIPG B,REPLEN ; Get length
JRST RPL.Z1 ; Nothing to replace
BPM T1,REPSTR ; Point to replacement string
ILDB T2,T1 ; Get a byte
IDPB T2,P1 ; Put it into the buffer
SOJG B,.-2 ; Until done
;Now fix up the screen display
RPL.Z1: MOVE T1,LINE ; Get current line
SUB T1,TOPLIN ; Subtract screen top
SKIPL DIRECT ; Were we searching backward?
IFSKP. ; Yes...
SKIPL T1 ; Are we still on the screen?
JRST REPL.A ; No
ELSE. ; No...
CAIGE T1,^D24 ; Are we off the screen?
JRST REPL.A ; No
ENDIF. ; End of conditional
MOVE T1,LINE ; Get line
SUBI T1,^D12 ; Put it into the center
SKIPGE T1 ; Are we still in the file?
SETZ T1, ; No, set the top of screen
MOVEM T1,TOPLIN ; Set new top of screen
CALL CLRSCN ; Clear
SKIPN SFIRST ; Don't update if just starting
CALLRET .FFD ; No starting, redisplay and return
CALLRET TYPLN1 ; Just display current line and ret
;Here to fix up part of the screen
REPL.A: SKPOFF F.RPSH ; Repeating?
JRST REP.A1 ; Yes, don't clear work space
CALL CLRWRK ; Clear work space
MOVE T1,LINE ; Get line number
SUB T1,TOPLIN ; Find offset into screen
SKIPE SFIRST ; Searching at first?
CALLRET TYPLN1 ; Yes, type the line and ret
CAIL T1,^D22 ; Was affected area just fixed?
JRST CURPOS ; Yes, position and return
REP.A1: CALL SETPTR ; Set the pointer
CALL CURPOS ; Position cursor
SKIPN TXTMOV ; Do we have to replace the remainder?
JRST REP.A2 ; No, just the exact text
CALL CLREOL ; Clear rest of line
MOVE A,P1 ; Get pointer
CALL TYPLIN ; Re-type the line
CALL CURPOS ; Position cursor
RET ; And return
; Here if the replacement string is longer that the search string
REPL.B: CALL LINLEN ; How many chars are on this line?
MOVN T1,TXTMOV ; Get the overrun length
ADD T4,T1 ; Get destination column
CAML T4,MAXCOL ; Would the line be too long?
JRST RPL.B1 ; Yes, check it out
MOVE D,P1 ; Save pointer
CALL MAKSPC ; Insert (T1) spaces
TYPERR <? New replacement line is too long>
BPM T1,REPSTR ; Point to the replacement string
MOVE T2,REPLEN ; Get the length of the string
MOVEM D,P1 ; Restore pointer
RPL.B2: ILDB A,T1 ; Get a byte
IDPB A,P1 ; And put it in the buffer
SOJG T2,RPL.B2 ; And loop through all characters
JRST RPL.Z1 ; Finish the replacement
;Here if the replacement string is too long
RPL.B1: SKIPE PROG ; Program mode?
JRST RPL.B3 ; Yes, error
PUSH P,LINE ; Save current line
CALL SETPTR ; Make sure pointer is set
MOVE T3,CHRNUM ; Get length
CALL SHIFT ; Delete that amount
CALL LINACT ; Active line following?
IFSKP. ; Yes
CALL INLN2 ; Insert a following line
MOVE A,P1 ; Copy pointer
ILDB A,A ; Get following char
CAIE A,SP ; Space?
SKIPN A ; Or null?
IFNSK.
CALL SPLIT ; Split line at following word
ELSE.
CALL SPL.A ; Otherwise split in place
ENDIF.
ENDIF.
CALL LINAC2 ; Line active before cursor?
IFSKP. ; Yes
CALL INLN2 ; Insert another
AOS LINE ; Bump line
ENDIF.
MOVE T1,INDENT ; Get indent
MOVEM T1,COL ; Set column
CALL SETPTR ; Set the pointer
MOVE A,P1 ; Point to destination
BPM B,REPSTR ; Point to the string
MOVN C,REPLEN ; It's this long
MOVE T1,MAXCOL ; Get maximum column
SUB T1,INDENT ; Find available length
CAMLE C,T1 ; String short enough?
MOVE C,T1 ; No, reset it
SOUT% ; Move it
MOVE T1,(P) ; Retrieve old value of line
MOVEM T1,LINE ; And set it
CALL SETPTR
JRST EVE.A ; Finally, justify the paragraph
; Note line stays pushed!
;Here if the replacement is too long and we're in program mode
RPL.B3: CALL CLRWRK ; Workspace again
CALL SPCON ; Turn on special effects
TYPNCR <% Replacement string is too long to fit>
CALL SPCOFF ; Turn off effects
SETZM REPLEN ; End of replacement string
MOVEI A,HLDTIM ; Time to wait
DISMS% ; Sleep
CALL CLRWRK ; Clear the work space
RET ; And return
;Here to just retype the changed part of the line
REP.A2: HRROI A,REPSTR ; Get the string
PSOUT% ; Type it
CALL CURPOS ; Position
RET ; And return
Subttl Special functions -- Positioning
;These routines handle moving the cursor to special parts of the file.
POSIT: CALL ICHAR ; Get a char
FLGOFF F.NOPG ; None of these effect the page mark
CAIN A,"L" ; Beginning of line?
JRST POSBOL ; Yes
CAIN A,"A" ; Append to line?
JRST POSELN ; Yes
CAIN A,"B" ; Beginning?
JRST POSBEG ; Yes
CAIN A,"E" ; End?
JRST POSEND ; Yes
CAIN A,"P" ; Last page?
JRST POSPRV ; Yes
CAIN A,"N" ; Next page?
JRST POSNXT ; Yes
CAIN A,"W" ; To next word?
JRST POSWRD ; Yes
CAIN A,"C" ; Centering formfeed?
JRST CNTFFD ; Yes
CAIN A,"T" ; Position to top?
JRST POSTOP ; Yes
RET ; None of the above
;Move cursor to beginning of file
POSBEG: SETZM LINE ; Line zero
SETZM COL
SKIPN TOPLIN ; Already there?
JRST POSCUR ; Yes, just position cursor
SETZM TOPLIN ; No, reset
JRST POSCOM ; Clear and re-display
;Move cursor to end of file
POSEND: SETZM COL ; Column zero
MOVE T1,HGHLIN ; Get highest line
MOVEM T1,LINE ; Our new position
SUB T1,TOPLIN ; Find out where we are
CAIGE T1,^D24 ; On screen?
JRST POSCUR ; Yes, just position the cursor
MOVE T1,LINE ; Get position
SUBI T1,^D12 ; Put us in middle of screen
MOVEM T1,TOPLIN ; New top
JRST POSCOM ; Finish up
;In-line cursor movement routines -- move to beginning and end of line
;Move cursor to beginning of line
POSBOL: SKIPE T1,VALUE ; Any repeat count?
JRST POSM.L ; Yes, multiple line positioning
SETZM COL ; Zero the column
SKIPE T1,INDENT ; Unless there's an indent
MOVEM T1,COL ; In which case set it
JRST CURPOS ; Set cursor and return
;Move cursor to end of line
POSELN: CALL SETPTR ; Set pointer to current cursor posit
CALL NXTWRD ; Get next word
CAIA ; None, skip
JRST POSE.B ; Found one, continue
SETZM COL ; Start at beginning now
CALL SETPTR ; Set the pointer
CALL NXTWRD ; Anything there?
JRST CURPOS ; No, position and return
POSE.A: CALL SETPTR ; Set up the pointer
CALL NXTWRD ; Get next word in line
JRST POSE.C ; No more on line
POSE.B: MOVEM T1,COL ; Set position of current word
ADDM T2,COL ; Now position to next word
AOS COL ; Bump to get past the word
JRST POSE.A ; And try again
POSE.C: SOS COL ; Back up one character
JRST CURPOS ; And reset
;Move cursor to the beginning of the next word on the line.
POSWRD: CALL NXTWRD ; Get next word coordinates
JRST POSW.B ; None, go to next line
CAMLE T1,COL ; Have we advanced?
JRST POSW.A ; Yes, set the new column
ADD T3,T1 ; No, so get to next word
CAIL T3,^D79 ; Too far?
JRST [ADD T1,T2 ; Yes, don't advance all the way
JRST POSW.A] ; And jump to eol
MOVEM T3,COL ; Set new column
CALL SETPTR ; Set the pointer
CALL NXTWRD ; Get next word
JRST POSW.B ; None there
;Here to move to the next word
POSW.A: MOVEM T1,COL ; Set new column
CALL CURPOS ; Position
RET ; And return
;Here to move to the next line
POSW.B: FLGON F.FMOV ; Set forced move flag
CALL .DWN ; Go down one line
CALL DOIND ; Indent properly
RET ; And return
;Move cursor a varying number of pages or lines
;Characters
POSM.C: ADD T1,COL ; Get new column
IDIVI T1,^D80 ; Find number of lines
ADD T1,LINE ; Find new line number
MOVEM T2,COL ; Set new column
SKIPL T2 ; Is it non-negative?
JRST POSM.Y ; Yes, join main stream
ADDI T2,^D80 ; Correct the offset
MOVEM T2,COL ; Set new column
SOJA T1,POSM.Y ; And lower the line by one
;Pages
POSM.P: IMULI T1,^D22 ; Then adjust number of lines
MOVE T2,TOPLIN ; Get top line
TRNA ; Skip
;Lines
POSM.L: MOVE T2,LINE ; Get current line
ADD T1,T2 ; Adjust current line
;All of the above
POSM.Y: CAMLE T1,HGHLIN ; Too high?
MOVEM T1,HGHLIN ; Yes, adjust
SKIPGE T1 ; Too low?
SETZ T1, ; Yes, adjust
MOVEM T1,LINE ; Store the line value
CAML T1,TOPLIN ; Below old top line?
JRST PML.A ; Nope
MOVEM T1,TOPLIN ; Set new top line
CALL CLRSCN ; Clear the screen
JRST .FFD ; And refresh
;Here if we're past old top line
PML.A: MOVE T2,TOPLIN ; Get top of screen
ADDI T2,^D23 ; Find maximum location
CAMG T1,T2 ; On the screen?
JRST CURPOS ; Yes, just position cursor
MOVEM T1,TOPLIN ; Set new screen top
CALL CLRSCN ; Clear the screen
JRST .FFD ; And refresh
;Move cursor to previous page
POSPRV: SKIPN T1,VALUE ; Numeric count?
JRST .+3 ; No
MOVNS T1 ; Negate the argument
JRST POSM.P ; Yes, move pages
SETZM COL ; Get to column zero
SKIPN T1,TOPLIN ; At beginning?
JRST PPRV.A ; Yes, no refresh
SUBI T1,^D22 ; Back up a screen
SKIPGE T1 ; Unless gone too far
SETZ T1, ; Yes, set to zero
MOVEM T1,TOPLIN ; Reset top line
MOVE T1,LINE ; Recall the line
SUBI T1,^D22 ; Up 22 lines
SKIPGE T1 ; Still positive?
SETZ T1, ; No, make us zero
MOVEM T1,LINE ; Save new location
JRST POSCOM ; Finish up
;Here if we merely need to move the current line without refreshing screen
PPRV.A: SKIPN T1,LINE ; Get line
RET ; Already homed - no changes
SETZM LINE ; Get to line zero
JRST POSCUR ; Position cursor and return
;Move cursor to next page
POSNXT: SKIPE T1,VALUE ; Repeat count?
JRST POSM.P ; Yes, move several pages
SETZM COL ; Column zero
MOVE T1,TOPLIN ; Get top of screen
ADDI T1,^D22 ; Scroll it
CAML T1,HGHLIN ; Compare to end of text
JRST PNXT.A ; Too far
MOVEM T1,TOPLIN ; Store new top line
MOVE T1,LINE ; Recall the current line
ADDI T1,^D22 ; Move to next page
MOVEM T1,LINE ; And remember it
JRST POSCOM ; Finish up
;Here if our destination is on the screen. Just get the cursor to end of text.
PNXT.A: MOVE T1,HGHLIN ; Get highest line
MOVEM T1,LINE ; Store it
JRST POSCUR ; And position to there
;POSCOM routine - completion routine for all positioning. Refresh the screen
;and display new text.
POSCOM: CALL CLRSCN ; Clear the screen
FLGON F.INDT ; Indent after refresh
JRST .FFD ; Display
;POSCUR routine - cursor is moving to a position on the screen, so no
;refresh is necessary. Just position the cursor after indenting.
POSCUR: SKIPE T1,INDENT ; Any indent?
MOVEM T1,COL ; Yes
JRST CURPOS ; Position and return
;POSTOP routine -- position the current line at the top of the screen
POSTOP: MOVE T1,LINE ; Get line
SUB T1,TOPLIN ; Are we already there?
JUMPLE T1,R ; Yes, nothing to do
PUSH P,COL ; And col
PUSH P,LINE ; Save current line
SETZM COL ; Zero the column
MOVEI A,^D23 ; Last line
ADD A,TOPLIN ; Of screen
MOVEM A,LINE ; Store it
CALL CURPOS ; Position there
MOVEI A,.PRIOU ; Output to tty
HRROI B,[BYTE (7) 12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12]
MOVN C,T1 ; Number of lines
SOUT% ; Go down
MOVE T2,(P) ; Get current line setting
EXCH T2,TOPLIN ; Set it and grab toplin
ADDI T2,^D24 ; Add a screen
EXCH T1,T2 ; T1 gets line, t2 gets count
MOVEM T1,LINE ; Save new (temp) line
CALL CURPOS ; Position to new location
CALL FFD.A ; Refresh screen (partially)
POP P,LINE ; And line
POP P,COL ; Restore column
JRST CURPOS ; And return to old place
Subttl Text movement routines -- GETLIN
;Getlin accepts a parameter that indicates the number of lines to save. The
;saved text is inserted in a buffer and deleted from the screen and text.
GETLIN: SKIPG VALUE ; Saved number?
JRST GETL.A ; No
CALL ICHAR ; Get following character
MOVE T2,A ; Copy it
MOVE A,VALUE ; Get count
JRST GETL.B ; Continue on
;Read in the argument after the ^G command
GETL.A: CALL GETNUM ; Get a number
CAIA ; Skip
JRST GETL.D ; Number returned, done
MOVE T2,A ; Copy the terminating character
MOVEI A,1 ; Assume one by default
;Check out the number returned
GETL.B: CAILE A,^D100 ; Too many lines?
TYPERR <? ^G argument must be between 1 and 100 inclusive>
CAIN T2,"C" ; Copy?
JRST GETL.D ; Yes
CAIN T2,"M" ; Move?
JRST GETL.C ; Yes
TYPERR <? ^G. termination code must be C or M>
GETL.C: FLGON F.DGET ; Delete after copy
GETL.D: MOVEM A,SAVNUM ; Save the number
MOVE T1,LINE ; Get current line
IMULI T1,20 ; Get words
ADD T1,BUF ; Make an address
HRLS T1 ; Put in left hand side
HRRI T1,SAVBUF ; Destination
IMULI A,20 ; Words to be saved
BLT T1,SAVBUF-1(A) ; Transfer correct number
CLRSKS F.DGET ; Are we deleting?
RET ; No, just a copy
MOVE T4,SAVNUM ; Yes, get number
CALL DELLN1 ; Delete one line
SOJG T4,.-1 ; Repeat for all lines
CALL DISPLA ; Display changes
RET ; And return
Subttl Text movement routines -- RETLIN
;Retlin inserts the saved text into the buffer at the appropriate position.
RETLIN: SKIPN SAVNUM ; Get number of saved lines
RET ; None saved
FLGOFF F.NEGR ; Clear negative retlin flag
SKIPL SAVNUM ; Is it negative?
IFSKP. ; Do the following if so
FLGON F.NEGR ; Set the flag
FLGOFF F.NBAK ; Assume backup is ok
CALL LINAC2 ; Active line before cursor?
IFSKP. ; Yes, do the following
CALL LINACT ; Check if active line past col
IFSKP. ; An active line,
CALL INLN2 ; Insert a line after this one
CALL SPLIT ; And split the current line
ENDIF.
AOS LINE ; Bump current line
ELSE.
FLGON F.NBAK ; Flag no backup after insertion
ENDIF.
ENDIF.
MOVM T2,SAVNUM ; Get number of lines to insert
MOVE T1,LINE ; And where to do it
CALL ILINE ; Do the insert
;Here when the correct white space is there to overwrite.
RTL.B: MOVE T1,LINE ; Get current line
IMULI T1,20 ; Words
ADD T1,BUF ; Make an address
HRLI T1,SAVBUF ; Point to save buffer
MOVEI T2,20 ; Words per line
IMUL T2,SAVNUM ; Times number of lines
SKPOFF F.NEGR ; Negative?
MOVNS T2 ; Yes, negate answer
ADDI T2,-1(T1) ; Make an address offset
BLT T1,(T2) ; Transfer it
SETZM COL ; Start at column zero
SKPON F.NEGR ; Negative retlin flag?
JRST RTL.C ; No, just display
MOVE T1,LINE ; Get LINE value
SKPOFF F.NBAK ; No backup flag?
IFSKP.
SOSGE T1,LINE ; Back up the line value
SETZB T1,LINE ; Unless it went to -1
ENDIF.
CAMGE T1,TOPLIN ; Backed up too far?
JRST [MOVEM T1,TOPLIN ; Yes, correct it
FLGON F.EMES ; Must correct the whole screen
JRST .+1] ; Proceed
PUSH P,LINE ; Save the line
JRST EVE.A ; And justify
;Here for normal move
RTL.C: FLGON F.INDT ; Indent after refresh
CALL DISPLA ; Display the screen changes
RET ; And return
Subttl Text movement routines -- MOVPAR
;This routine will move a block of text bounded by special markers, not
; necessarily on line boundries.
MOVPAR: FLGOFF F.COPY!F.MOVE!F.DELE ; Clear flags
CALL ICHAR ; What follows?
CAIN A,"C" ; Copy?
FLGON F.COPY ; Yes
CAIN A,"M" ; Move?
FLGON F.MOVE ; Yes
CAIN A,"D" ; Delete?
FLGON F.DELE ; Yes
CAIN A,"R" ; Return to first mark?
JRST MVP.E ; Yes, go to a special routine
SKPON F.COPY!F.MOVE!F.DELE ; Any set?
TYPERR <? Block move termination code must be M, C or D>
;Check for double spacing and prohibit if set
SKIPE DOUBLE ; Double spacing?
TYPERR <? Function not yet implemented for double spacing mode>
;Here to move the text
MVP.A: STKVAR <ELINE,ECOL> ; Current cursor position
MOVE T1,COL ; Get column
MOVEM T1,ECOL ; Save it
MOVE T1,LINE ; Store current line
MOVEM T1,ELINE ; Store it
IMULI T1,^D80 ; Multiply by chars per line
ADD T1,ECOL ; Add column
HRRZ T2,SLINE ; Starting line
IMULI T2,^D80 ; Get character position
ADD T2,SCOL ; Add starting column
SUB T1,T2 ; Get number of chars
AOJ T1, ; Bump by one to correct the count
SKIPLE T1 ; Check it
CAILE T1,17500 ; Check for too large
TYPERR <? Illegal text boundry conditions>
SKPON F.COPY ; Copying?
JRST MVP.B ; No
MOVE T2,SLINE ; Get line
MOVEM T2,LINE ; Store it
MOVE T2,SCOL ; And column
MOVEM T2,COL ; Set that too
CALL SETPTR ; Set pointer to it
HRROI A,SPACES ; Initialize to spaces
BPM B,SAVBUF ; Point to output buffer
SETZ C, ; Until a null
SIN% ; Make it neat
MOVEI T2,^D80 ; Characters on a line
SUB T2,COL ; Chars to transfer
SUB T1,T2 ; Correct the count
MOVE B,INDENT ; Get indent
CAMLE B,COL ; Beyond current column?
SETZ B, ; No, so start on the margin
ADJBP B,[POINT 7,SAVBUF] ; Adjust pointer accordingly
MOVE A,P1 ; Point to text
MOVN C,T2 ; Get count
SKIPE C ; Don't transfer nothing
SIN% ; Transfer the characters
BPM B,SAVBUF+20 ; Point to beginning of second line
MOVN C,T1 ; Get remaining characters
SKIPE C ; Check count
SIN% ; Transfer complete string
HRROI A,SPACES ; Spaces again
SETZ C, ; Until a null
SIN% ; Make it neat
MOVE T2,ELINE ; Ending line
SUB T2,SLINE ; Starting line
AOJ T2, ; Bump it
MOVNM T2,SAVNUM ; Save (-) as lines in buffer
MOVE A,ELINE ; Get the line
MOVEM A,LINE ; Restore it
MOVE A,ECOL ; Get the column
MOVEM A,COL ; And restore it
SETOM SLINE ; Clear settings
SETOM SCOL
RET ; Return
;Here for a move or a delete
MVP.B: CALL LINAC2 ; Line empty before cursor?
IFSKP. ; No
CALL LINACT ; Line empty after cursor?
IFSKP. ; No
CALL INLN2 ; Insert a new line
CALL SPLIT ; And split the current one
ENDIF.
ELSE.
SOS ELINE ; Back up the last line copied
ENDIF.
MOVE T2,SLINE ; Get starting line
MOVEM T2,LINE ; Store it
MOVE T2,SCOL ; And starting column
MOVEM T2,COL ; Store it
CALL SETPTR ; Set the pointer
FLGOFF F.NBAK ; Assume backup
CALL LINAC2 ; Line empty before cursor?
IFSKP. ; No
AOS SLINE ; So start at line+1
CALL LINACT ; Line empty after cursor?
IFSKP. ; No
CALL INLN2 ; Insert a new line
CALL SPLIT ; And split the current one
AOS ELINE ; Bump the end count
ENDIF.
ELSE.
FLGON F.NBAK ; No backing up for justification
ENDIF.
MOVE T4,ELINE ; Get ending line
SUB T4,SLINE ; Get difference
JUMPL T4,MVP.D ; None to move
MOVE T2,SLINE ; Get starting line
MOVEM T2,LINE ; Set it
SKPON F.MOVE ; Are we moving?
JRST MVP.C ; No, deleting
;Copy the block of text to the save buffer
IMULI T2,20 ; Multiply by words per line
ADD T2,BUF ; Get starting location
HRLS T2 ; Put into left side
HRRI T2,SAVBUF ; Point to save buffer
MOVEI T3,1(T4) ; Number of lines
MOVNM T3,SAVNUM ; Save number of lines in buffer
IMULI T3,20 ; Get number of words
BLT T2,SAVBUF(T3) ; Copy several lines
;Here to delete the block of text
MVP.C: CALL DELLN1 ; Delete a line
SOJGE T4,.-1 ; Repeat until done
;Here to finish up and justify
MVP.D: SETO T2, ; Flag to indicate no value
EXCH T2,SLINE ; Store it
SKPOFF F.NBAK ; Back up necessary?
IFSKP. ; Yes
SOSGE T2 ; Back up ac t2
SETZ T2, ; Unless we went too far
ENDIF.
MOVEM T2,LINE ; Set new line
SETOM SCOL ; Clear starting column
CAML T2,TOPLIN ; Still on the screen?
IFSKP. ; If not on screen
CALL CLRSCN ; Clear the screen
MOVE A,LINE ; Restore old line value
MOVE T1,A ; Get line position
SUBI T1,^D12 ; Adjust it
SKIPGE T1 ; Too small?
SETZ T1, ; Yes, clear it
MOVEM T1,TOPLIN ; Set new top line
FLGON F.EMES ; Yes, make sure we refresh
ENDIF.
PUSH P,LINE ; Save current value
JRST EVE.A ; Now go justify
;Here for the Return command. Restore the saved position and fix the display
MVP.E: MOVE A,SCOL ; And the column
SKIPGE A ; Valid value?
TYPERR <? No anchor position set to return to>
MOVEM A,COL
MOVE A,SLINE ; Get the line
MOVEM A,LINE
CALL SETPTR ; Point us there
MOVE A,LINE ; Get current line
SUB A,TOPLIN ; Subtract the screen top
JUMPL A,.+3 ; Negative? redo screen
CAIGE A,^D24 ; Off the screen?
JRST CURPOS ; No, position the cursor
MOVE A,LINE ; Get line again
SUBI A,^D12 ; Put it into the center
SKIPGE A ; Is it non-negative?
SETZ A, ; No, make it zero
MOVEM A,TOPLIN ; Set new top of screen
CALL CLRSCN ; And re-display
CALL .FFD
RET
Subttl Justification routines
;Justify the text until we come to a line that is all spaces or we come to
;a line that doesn't change.
EVEN: FLGOFF F.DBIN ; Assume no double input
SKIPG A,VALUE ; Repeat count?
SETO A, ; No, don't count
MOVEM A,JCNT ; Set number of lines
PUSH P,LINE ; Store line
CALL ICHAR ; Get the next char
CAIN A,"P" ; Paragraph?
JRST EVE.A1 ; Yes
CAIN A,"F" ; File?
JRST EVE.B ; Yes
CAIE A,"A" ; All double spaced?
IFSKP. ; Yes
FLGON F.DBIN ; Say double spaced input
JRST EVE.B ; And even whole file
ENDIF.
CAIE A,"D" ; Are we doing double spaced input?
IFSKP. ; Yes
FLGON F.DBIN ; Say so
JRST EVE.A1 ; And go even a paragraph
ENDIF.
POP P,LINE ; Wrong character
RET ; None of the above
;Justify one paragraph -- easy!
EVE.A: SKIPE DOUBLE ; Are we in double input mode?
FLGON F.DBIN ; Yes, so try double output mode too
SETOM JCNT ; Don't count lines
EVE.A1: SETZM COL ; Start at beginning
CALL SETPTR ; Make pointer right
CALL JUSTIF ; Justify one paragraph
JFCL ; We don't care if it's eof
JRST EVE.C ; Done
;Justify the whole file
EVE.B: SETZM COL
CALL SETPTR ; Set the pointer
EVE.B1: CALL JUSTIF ; Justify a paragraph
JRST EVE.C ; Done
MOVE T1,LINE ; Get next line
CAMLE T1,HGHLIN ; Too high?
JRST EVE.C ; Yes
JRST EVE.B ; No, do next paragraph
;Here to display the current buffer with changes.
EVE.C: POP P,LINE ; Restore original line
SETZM COL ; Column zero
CALL SETPTR ; Set the pointer
FLGON F.INDT ; Indent after refresh
TXZE F,F.EMES ; Error message on screen?
JRST .FFD ; Yes, clear whole screen
CALL CLREOS ; Clear to end of screen
MOVE T1,LINE ; Get line
MOVE T2,TOPLIN ; And top line
ADDI T2,^D24 ; Add end of screen
SUB T2,T1 ; True amount to refresh
CALL FFD.A ; Refresh the screen below line
RET ; Done
;Justify subroutine
;This routine justifies the text in the current paragraph. Special variables
;are:
; Fstlin - First line in paragraph
;
JUSTIF: SKIPE PROG ; Programming mode?
RET ; Yes, just return
FLGOFF F.DBSP ; Not on permitted blank
SETZB T4,COL ; Start at beginning of lines
SETZM INPLIN ; Clear input and output counters
SETZM OUTLIN
JUST: CALL SETPTR ; Set the pointer
CALL NXTWRD ; Get first word
JRST [AOS A,LINE ; Bump the line
CAMLE A,HGHLIN ; Compare for max
RET ; End of file
JRST JUST] ; Try again
MOVE A,LINE ; Get current line
MOVEM A,FSTLIN ; Store first active line
MOVE P3,[POINT 7,SPARE] ; Point to buffer
MOVEI B,SP ; Get a space
MOVE C,T1 ; Copy position of first char in word
SOJL C,JUS.B1 ; Pre-decrement count
IDPB B,P3 ; Insert spaces to proper column
AOJA T4,.-2 ; And loop, counting spaces
;Loop here getting one word after another
JUS.B: CALL NXTWRD ; Get a word
JRST ENDLIN ; End of line
JUS.B1: MOVEM T1,COL ; New cursor posit
CALL SETPTR ; Set p1 to it
MOVE A,P3 ; Destination
MOVE B,P1 ; Source
ADD T4,T2 ; Add length of word
CAMLE T4,MAXCOL ; Line now too long?
JRST NEWLIN ; Yes
MOVN C,T2 ; Length of word
SOUT% ; Copy it
MOVEM A,P3 ; Store new pointer
LDB A,P3 ; Get last byte
MOVEI D,SP ; Load a space
CALL CHKTRM ; Check for sentance terminators
JRST JUS.B2 ; None found
IDPB D,P3 ; Found one, extra space needed
AOJ T4,
JUS.B2: IDPB D,P3 ; Load an extra space
AOJ T4, ; Count word terminator
ADDM T3,COL ; Point to next word
CALL SETPTR ; Reflect the change
JRST JUS.B ; And loop
;Endlin routine -- end of input line, so simply go on to the next.
ENDLIN: AOS INPLIN ; Bump input line counter
SKIPGE JCNT ; Skip counting if negative
IFSKP. ; It isn't
SOSG JCNT ; Count down number of lines
JRST ENDPAR ; End of count, finish up
ENDIF.
TXC F,F.DBSP ; Toggle the doubling counter
AOS T1,LINE ; Bump the line
CAMLE T1,HGHLIN ; Too high?
JRST ENDPAR ; Yes
SETZM COL ; Start at beginning
CALL SETPTR ; Set up the pointer
MOVE T1,P1 ; Copy the pointer
ILDB T2,T1 ; Get first char on line
CAIN T2,"~" ; Page marker?
JRST ENDL.A ; Yes, new paragraph
CAIN T2,"." ; Runoff command?
JRST ENDL.A ; Yes
FLGOFF F.NELN ; Empty line
CALL NXTWRD ; Get next word
IFNSK. ; None there
SKPON F.DBIN ; Double spaced input?
JRST ENDL.B ; No, end of paragraph
SKPON F.DBSP ; Double toggle cleared?
JRST ENDL.B ; Yes, end of paragraph
JRST ENDLIN ; No, advance to next line
ENDIF.
FLGON F.NELN ; A non-empty line
CAME T1,INDENT ; Off the margin?
CALL ENDL.C ; Yes, end of normal paragraph
SKPON F.DBIN ; Double input mode?
JRST JUS.B1 ; No, continue with processing
SKPOFF F.DBSP ; Double toggle set?
CALL ENDL.C ; Yes, should not be
JRST JUS.B1 ; Continue on with processing
;ENDL.A - Handle a page marker carefully to avoid justifying it as text
ENDL.A: CALL ENDPAR ; End of paragraph processing
JFCL ; Expect skip return
AOS LINE ; Start with line past page mark
RETSKP ; Return from justif
;ENDL.B - Only dispatch to ENDPAR if the JCNT is negative.
ENDL.B: SKIPGE JCNT ; Negative?
JRST ENDPAR ; Yes, we're not counting lines
JRST ENDLIN ; Yes, we are counting lines
;ENDL.C - Only dispatch to ENDPAR if JCNT negative, otherwise process.
ENDL.C: SKIPL JCNT ; Negative?
RET ; No, proceed
POP P,A ; Yes, pop off return
JRST ENDPAR ; And end the paragraph
;Newlin routine -- end of output line, so regroup
NEWLIN: SUB T4,T2 ; Get original count back
CALL MOVEIT ; Move the current line
MOVE A,OUTLIN ; Number of lines in output buffer
CAIGE A,100 ; Limit of 100
JRST JUS.B1 ; Within the limit
JRST ENDPAR+1 ; Over, stop here
;Endpar - end of input text. We now adjust the space in the
;file by deleting or adding extra lines.
ENDPAR: CALL MOVEIT ; Move current output line
MOVE T2,OUTLIN ; Get output line count
SKIPE DOUBLE ; Doubling?
LSH T2,1 ; Yes, double the count
MOVE T3,T2 ; Copy count
ADD T3,FSTLIN ; Get starting line
MOVEM T3,LINE ; Set it for ^vf command use
SUB T2,INPLIN ; Get change input to output
JUMPE T2,ENDP.B ; Equal, no change
JUMPL T2,ENDP.A ; Lines to delete
MOVE T1,FSTLIN ; Lines to add, get first line
CALL ILINE ; Add (t2) lines at line (t1)
JRST ENDP.B ; And do the transfer
;Here to delete lines
ENDP.A: MOVNS T2 ; Negate to get lines to delete
MOVE T3,T2 ; Copy that number
ADD T3,FSTLIN ; T3 now has source for blt
MOVE T1,FSTLIN ; T1 has destination
IMULI T1,20 ; Word offset
ADD T1,BUF ; Address
IMULI T3,20 ; Same gyrations
ADD T3,BUF
HRL T1,T3 ; Make blt pointer
MOVE T3,HGHLIN ; Get highest point
SUB T3,T2 ; Adjust it
MOVEM T3,HGHLIN ; And reset it
IMULI T3,20 ; Calculate address
ADD T3,BUF
BLT T1,17(T3) ; Transfer the data
MOVE T1,SPACES ; Load some spaces
MOVEM T1,20(T3) ; Deposit them
HRLI T1,20(T3) ; Source
HRRI T1,21(T3) ; Destination
IMULI T2,20 ; Get number of words to blank
ADDI T2,20(T3) ; Last address to blank
BLT T1,(T2) ; Finish up
;Now copy the lines from the output to the main buffer
ENDP.B: MOVEI A,JBUF ; Output address
MOVE B,FSTLIN ; First line of destination
LSH B,4 ; Multiply by 20
ADD B,BUF ; Add in buffer
HRLI A,444400 ; Make 36-bit byte pointers
HRLI B,444400
;Loop transferring a line at a time
ENDP.C: MOVNI C,20 ; Transfer 20 words
SIN% ; From source to dest
SKIPN DOUBLE ; Double spacing?
IFSKP. ; Yes
PUSH P,A ; Save source
BPM36 A,SPACES ; Load up pointer to spaces
MOVNI C,20 ; Number of words
SIN%
POP P,A ; Restore pointer
ENDIF.
SOSLE OUTLIN ; Done right number of lines yet?
JRST ENDP.C ; No, continue
SKPOFF F.DBIN ; Double input?
IFSKP. ; No, do SINGLE -> DOUBLE conversion
SKIPN DOUBLE ; Double spacing?
RETSKP ; No, done
SKPON F.NELN ; Non-empty line following?
CALL DELLN1 ; No, so delete following empty line
ELSE. ; Here, do DOUBLE -> SINGLE conversion
SKIPE DOUBLE ; Double output?
RETSKP ; Yes, don't bother
SKPON F.NELN ; Non-empty line follows?
RETSKP ; No, it's empty, leave it alone
MOVE T1,LINE ; Current line
MOVEI T2,1 ; Only add one
CALL ILINE ; Insert a line following paragraph
ENDIF.
RETSKP ; Now return
;Moveit subroutine - move the current output line into the input buffer.
MOVEIT: SUBI T4,^D80 ; Get spaces left on line
MOVEI B,SP ; Get a space
IDPB B,P3 ; Deposit it
AOJL T4,.-1 ; Loop until end of line
AOS A,OUTLIN ; Bump output line pointer
IMULI A,20 ; Word offset
ADDI A,JBUF-20 ; Precise location
MOVE B,A ; Copy it
HRLI A,SPARE ; Source
BLT A,17(B) ; Transfer the line
MOVE T4,INDENT ; Reset line parameters
MOVE P3,[POINT 7,SPARE]
SKIPN A,INDENT ; Leading spaces
RET ; Done, none
MOVEI B,SP ; A space
IDPB B,P3 ; Store one
SOJG A,.-1 ; Loop
RET ; Done
;CHKTRM subroutine - check for sentance terminators. Character to be checked
;is in A and skip return is taken if we find one.
CHKTRM: CAIN A,"." ; Look for sentance terminators
RETSKP ; Found one
CAIN A,"!" ; Again
RETSKP
CAIN A,"?" ; And again
RETSKP
RET ; Didn't find one, return
Subttl Pagination routines -- Routines to help auto-pagination
;Insert a page break at the begining of the current line. Set the HardPg
;flag so we know to look for the squiggle when showing soft breaks.
PERMBK: SETZM COL ; Zero the column counter
SOS LINE ; Move up a line
CALL INLN2 ; Insert a blank line
AOS LINE ; Move back down
CALL SETPTR ; Set pointer to start of line
MOVEI A,"~" ; Get a fake form feed
IDPB A,P1 ; Deposit it
SETOM HARDPG ; Say we have hard page breaks
CALL SETPTR ; Set the pointer again
CALL CLREOL ; Erase the line
MOVE A,P1 ; Pointer to the line
CALL DISPLA ; Display the changes
RET ; And return
; Unpaginate the file (remove all hard page breaks):
UNPAG: MOVE T1,HGHLIN ; Get highest line
MOVEM T1,LINE ; Set it
;Loop through the file
UNP.A: CALL CHKPAG ; Check for a page feed
CALL DELLN1 ; Found, delete the line
SOSLE LINE ; Drop line
JRST UNP.A ; Loop through file
SETZM LINE ; Finished, clean up
SETZM COL
SETZM TOPLIN
CALL CLRSCN
FLGON F.INDT ; Indent after refresh
JRST .FFD ; Redisplay the screen
;Set up a header for the output pagination routine.
SETHED: CALL WRKSPC ; Get header work space
CALL SPCON ; Turn on effects
HRROI A,ASC<Header: > ; Load header string
CALL GETSTR ; Get it into spare
HRROI A,SPARE ; Point to string
HRROI B,PGHEAD ; Destination
MOVEI C,^D80 ; Number of bytes
SETZ D, ; Terminator
SIN% ; Do the transfer
CAIGE C,^D79 ; Anything but the cr?
IFSKP. ; Nope
SETZM PGHEAD ; So clear the header
JRST SETH.A ; And return
ENDIF.
SETO A, ; Set a to -1
ADJBP A,B ; Back up the byte pointer
MOVE B,A ; And copy it
HRROI A,SPACES ; Now load up on spaces
SIN% ; Finish up
SETH.A: CALL SPCOFF ; Special effects off
CALL CLRWRK ; Clear the work space
RET ; And return
Subttl Show status command
;This command shows the current parameter settings on the bottom two lines
;of the screen.
SHOW: CALL WRKSPC ; Clear workspace
CALL SPCON ; Turn on the effects
MOVEI A,SP ; Get a space
SKIPG T1,INDENT ; Get starting point
JRST .+3 ; At zero
PBOUT% ; Type a space
SOJG T1,.-1 ; Loop correct number of times
MOVEI A,"[" ; Start screen
PBOUT%
MOVE T1,INDENT ; Get starting point
;Loop here doing spaces and tabs
SHO.A: AOS T2,T1 ; Get copy of column
CAML T2,MAXCOL ; Don't go too far
JRST SHO.B ; We reached the end
ADJBP T2,[POINT 1,TABS] ; Get pointer
ILDB T3,T2 ; Get proper bit
MOVEI A,"-" ; Prepare for a space
SKIPE T3 ; Check
MOVEI A,"T" ; Make it a tab instead
PBOUT% ; Type it
JRST SHO.A ; And loop
;We've reached the margin
SHO.B: MOVEI A,"]" ; End the screen line
PBOUT% ; Type it
MOVEI A,SP ;GET A SPACE
MOVEI T1,^D78 ;GET MARGIN FOR EFFECTS
SUB T1,MAXCOL ;SUBTRACT MAXIMUM
SOJLE T1,SHO.C ;NO MORE SPACES IF THERE ALREADY
PBOUT% ;TYPE A SPACE
JRST .-2 ;AND LOOP
;Now type out the parameters
SHO.C: HRROI A,ASC<
>
PSOUT%
MOVEI A,.PRIOU ;OUTPUT
SETO B, ;CURRENT
MOVX C,OT%NDA!OT%NSC ;FLAGS
ODTIM%
HRROI A,ASC< Ind:> ; String
PSOUT% ; Type it
MOVE B,INDENT ; Get value
CALL TYPNUM ; Type it
HRROI A,ASC< Max:> ; next
PSOUT%
MOVE B,MAXCOL ; Get value
CALL TYPNUM ; Type it
HRROI A,ASC< P-size:> ; next
PSOUT%
MOVE B,PAGSIZ ; Get it
CALL TYPNUM
HRROI A,ASC< A-save:> ; next
PSOUT%
MOVE B,NUMSCH ; Characters between saves
CALL TYPNUM
HRROI A,ASC< Pag:ON> ; Pagination
SKIPN AUTOPG ; Test it
HRROI A,ASC< Pag:OFF> ; Not set
PSOUT%
HRROI A,ASC< Dbl:ON> ; Double spacing
SKIPN DOUBLE ; Test it
HRROI A,ASC< Dbl:OFF>
PSOUT%
HRROI A,ASC< Lines:> ; next
PSOUT%
MOVE B,HGHLIN ; Number of lines
CALL TYPNUM
HRROI A,ASC< L:> ; Current line
PSOUT%
MOVE B,LINE
CALL TYPNUM
HRROI A,ASC< C:> ; Current column
PSOUT%
MOVE B,COL
CALL TYPNUM
CALL SPCOFF ; Turn off the special effects
CALL ICHAR ; Wait for continuation
CALL CLRWRK ; Clear the work space
RET ; And return
;Typnum routine - type out number in B in decimal
TYPNUM: MOVEI A,.PRIOU ; Output
MOVEI C,12 ; Decimal
NOUT% ; Type it
ERCAL [MOVEI A,60 ; Get a zero
PBOUT% ; Type it
RET] ; And return
RET ; Done
Subttl Toggle zero output command
;Here we set a flag, telling us whether or not we are currently outputing
;to the terminal or to null, and set the primary output device accordingly
ZOUT: CLRSKS F.ZOUT ; Were we outputing to null:?
IFSKP. ; Yes...
FLGOFF F.ZOUT ; Not any more
MOVEI A,.FHSLF ; This process
SETO B, ; Assume setting full display
SPJFN% ; Set the primary jfn to tty:
CALL HOMEUP
CALL HOMEUP ; Home the cursor
CALL CLS.A ; Clear the screen
JRST .FFD.B ; Refresh the screen
ENDIF. ; End of yes...
;Here if we are setting the output to null:
FLGON F.ZOUT ; Set the flag
MOVEI A,.FHSLF ; This process
HRROI B,.NULIO ; Input from tty:, output nowhere
SPJFN% ; Set it
RET ; And return
Subttl Special function control commands
;These functions are designed for a Viewpoint terminal, which have
;keys designed for ^B<char> sequences.
.FUN: CALL ICHAR ; Get an invisible character
MOVEI T1,FUNMAX ; Get maximum function
FUN.A: HRRZ T2,FUNTAB(T1) ; Get function code
CAMN A,T2 ; Match?
JRST FUN.B ; Yes
SOJG T1,FUN.A ; Loop
TYPERR <? Illegal function code specified>
FUN.B: SKIPE MOD2 ; Model two viewpoint?
CAILE T1,6 ; And function 1-6?
CAIA ; No to either, regular processing
CALL ICHAR ; Yes, so eat cr after function key
HLRZ T2,FUNTAB(T1) ; Get default destination
IMULI T1,30 ; Thirty words per function
SKIPN FUNCT(T1) ; Is function set up?
JRST (T2) ; No, do the default
MOVE T2,[POINT 7,FUNCT] ; Get pointer
ADD T2,T1 ; Add offset
FUN.B1: MOVEI A,.CTTRM ; This terminal
;Now do the user function via STI jsys
FUN.C: ILDB B,T2 ; Get char
JUMPE B,R ; Done, return
CAIN B,"$" ; Dollar sign?
MOVEI B,.CHESC ; Yes, make into an alt instead
CAIE B,"^" ; An up-arrow?
JRST FUN.D ; Nope, just send it
ILDB B,T2 ; Get controlled char
JUMPE B,R ; None
CAIN B,"^" ; Another up-arrow?
JRST FUN.D ; Yes, send it as regular text
CAIL B,"a" ; Make it upper case
CAILE B,"z"
TRNA ; Skip
SUBI B,SP ; Convert lower to upper
SUBI B,100 ; Make it a control char
SKIPGE B ; Test for negatives
SETZ B, ; Make it a null instead
;Send the character
FUN.D: STI% ; Put it in input buffer
ERJMP FUN.E ; Intercept errors
JRST FUN.C ; And get the next
;Here to intercept errors
FUN.E: MOVEI A,.PRIIN ; Input
CFIBF% ; Clear buffer
HRROI A,ASC<? Input buffer full -- function is too long or recursive>
CALL ERMSA ; Always print the message
RET ; Done
;Here for special functions which are variable
;Connected directory
CONNEC: GJINF% ; Get job info
HRROI A,SPARE ; Point to destination
DIRST% ; Get the name
SETZM SPARE ; Failed
BPM T2,SPARE ; Point to spare buffer
JRST FUN.B1 ; And process the string
;Daytime
DAYTIM: HRROI A,SPARE ; Point to area used
SETO B, ; Current daytime
MOVX C,OT%NSC!OT%SCL ; No seconds
ODTIM% ; Get the time
BPM T2,SPARE ; Point to spare buffer
JRST FUN.B1 ; And process the string
;User name
USRNAM: GJINF% ; Get job info
MOVE B,A ; Get user number
HRROI A,SPARE ; Point to destination
DIRST% ; Get the name
SETZM SPARE ; Failed
BPM T2,SPARE ; Point to spare buffer
JRST FUN.B1 ; And process the string
;Function table
FUNTAB: Z
XWD TRATAB,"1" ; One
XWD INSLIN,"2" ; Two
XWD SEARCH,"3" ; Three
XWD BAKTAB,"!" ; Four
XWD DELLIN,"""" ; Five
XWD POSWRD,"#" ; Six
XWD R,"A" ; Function a
XWD R,"B" ; Function b
XWD CONNEC,"C" ; Function c
XWD DAYTIM,"D" ; Function d
XWD R,"E" ; Function e
XWD R,"F" ; Function f
XWD R,"G" ; Function g
XWD R,"H" ; Function h
XWD R,"I" ; Function i
XWD R,"J" ; Function j
XWD USRNAM,"U" ; Function U
FUNMAX==.-FUNTAB-1 ; Number of entries
Subttl Pattern matcher routines -- Maktab
;Maktab creates the pattern matching automaton. The algorithm is from
;Baase - Computer Algorithms pg. 180. Credit for this particular
;implementation goes to Steve Berlin.
MAKTAB: MOVE T3,CHRNUM ; Get number of characters
SETZM FLINK+1 ; Refer to algorithm for explanation
MOVEI T1,2
MAKT.A: CAMLE T1,T3 ; Reached the end?
RET ; Yes, done
MOVE T2,FLINK-1(T1)
MAKT.B: JUMPE T2,MAKT.C ; If equal
MOVE T4,PAT(T2)
CAMN T4,PAT-1(T1)
JRST MAKT.C
MOVE T2,FLINK(T2)
JRST MAKT.B ; Loop
MAKT.C: MOVEI T4,1(T2)
MOVEM T4,FLINK(T1)
AOJA T1,MAKT.A ; Loop
Subttl Pattern matcher routines -- Getpat
;This routine reads in the pattern to be matched. We read it from the
;first line on the screen and repair it later.
GETPAT: FLGOFF F.REPL ; Not in replacement mode yet
CALL WRKSPC ; Get workspace set up
CALL SPCON ; Turn on special effects
SETZ T3, ; Character counter for maktab
HRROI A,[ASCIZ .String:.]
CALL GETSTR ; Read in input string
CALL SPCOFF ; Special effects off
BPM A,SPARE ; Point to beginning
SKIPGE VALUE ; Are we searching backward?
PUSH P,T3 ; Yes, push a zero to seperate us
;Now run through the string transferring the characters to PAT
GTP.A: ILDB T1,A ; Get a character
CAIN T1,ALT ; Is it an escape?
JRST GTP.B ; Yes, replacement string coming
CAIGE T1,"a" ; Check lower case
JRST .+3 ; It isn't
CAIG T1,"z" ; Within upper bound?
SUBI T1,40 ; Yes, convert to upper case
CAIN T1,"%" ; Wildcard character?
SETO T1, ; Yes
SKIPGE VALUE ; Are we searching backward?
PUSH P,T1 ; Yes, save the string in the stack
MOVEM T1,PAT+1(T3) ; Store character
SKIPE T1 ; Skip if done
AOJA T3,GTP.A ; And keep looping
MOVEM T3,CHRNUM ; Store number of characters
SKIPL VALUE ; Searching backward?
RET ; No, return
;Here when reverse-searching: Read the characters off the stack, reversing
; the characters in the string we're searching for.
GTP.A1: SETZ T3, ; Reset the pointer
POP P,T1 ; Get the zero off the stack
GTP.A2: POP P,T1 ; Get a char from the stack
MOVEM T1,PAT+1(T3) ; Add the char to the search string
SKIPE T1 ; Are we done?
AOJA T3,GTP.A2 ; No, get the next one
RET ; Return
;Here when a replacement string is forthcoming
GTP.B: SKIPL VALUE ; Reverse searching?
JRST GTP.B2 ; No, skip the next part
SETZ T3, ; Reset the pointer
GTP.B1: POP P,T1 ; Get a char from the stack
MOVEM T1,PAT+1(T3) ; Add the char to the search string
SKIPE T1 ; Are we done?
AOJA T3,GTP.B1 ; No, get the next one
GTP.B2: SETZ T1, ; Make it null
MOVEM T1,PAT+1(T3) ; Terminate the array
MOVEM T3,CHRNUM ; Store number of characters
BPM B,REPSTR ; Point to replacement string dest
MOVEI C,^D80 ; Max length
SETZ D, ; End on a null
SIN% ; Copy the string
SUBI C,^D79 ; Find length of string
MOVNM C,REPLEN ; Store it
FLGON F.REPL ; Replacement active
RET ; Done
Subttl Pattern matcher routines -- Match
;Match finds a match for the pattern in PAT, by searching through the text
;until we reach the end.
MATCH: SKIPG T3,CHRNUM ; Get number of chars
RET ; None, return
PUSH P,LINE ; Save line and col
PUSH P,COL
AOS COL ; Bump the current column
CALL SETPTR ; Set up the pointer
PUSH P,P1 ; Save the pointer
MOVE T1,HGHLIN ; Get highest line
AOJ T1, ; Plus one line
MOVEM T1,LINE ; Set it
CALL SETPTR ; Set up a pointer
HRRZ D,P1 ; Save addr for later reference
POP P,P1 ; Restore the pointer
MOVEI T2,1 ; Set up initial conditions
;Loop looking for end of file
MAT.A: HRRZ T1,P1 ; Get current pointer
CAMLE T1,D ; At end of file?
JRST MAT.D ; Yes, failed
SKIPL DIRECT ; Are we searching backward?
JRST .+3 ; No, skip this test
CAMGE T1,BUF ; Are we at the top of file?
JRST MAT.D ; Yes, failed
SKIPL DIRECT ; Are we searching backward?
IFSKP. ; Yes...
SETO A, ; -1 Character
ADJBP A,P1 ; Point to it
MOVE P1,A ; Copy the byte pointer
LDB T1,P1 ; And get the character
ELSE. ; Here if we didn't skip
ILDB T1,P1 ; Get a char
ENDIF. ; End if conditionals
CAIL T1,"a" ; Is it a lower case letter?
CAILE T1,"z"
SKIPA ; No
SUBI T1,40 ; Yes, make it upper case
MAT.B: JUMPE T2,MAT.C ; Got back to beginning of pattern?
SKIPL A,PAT(T2) ; No, get next pattern char
; Skip if pattern is wild
CAMN A,T1 ; Same as file character?
JRST MAT.C ; Yes - check for end of pattern
MOVE T2,FLINK(T2) ; No, follow failure link
JRST MAT.B ; And loop
;Check for end of pattern
MAT.C: CAMN T2,T3 ; At end of pattern?
JRST MAT.E ; Yes, we win
AOJA T2,MAT.A ; No, loop for more
;Here when we've failed
MAT.D: POP P,COL ; Restore line and col
POP P,LINE
RET ; And return
;Here when we've found a match
MAT.E: MOVN A,CHRNUM ; Get negative number of chars
SKIPGE DIRECT ; Searching backward?
SETO A, ; Yes, just move by one character
ADJBP A,P1 ; Adjust pointer
MOVE P1,A ; Save new pointer
CALL SETLC ; Set line and column
POP P,T1 ; Toss out the saved values
POP P,T1
RETSKP ; And return
Subttl Terminal control routines
;Homeup routine - get to the real home position, which is screwed up on
;ADDS terminals.
HOMEUP: MOVE A,TJFN ; Get image tty jfn
HLRO B,HOMTAB(P2) ; Address of homeup string
HRLI B,441000 ; Set up 8-bit pointer
HRRE C,HOMTAB(P2) ; Length of string (negative)
SOUT% ; Type it and home up
RET ; Done
;CLREOL routine - blank out the line from COL to EOL
;This is done by sending the appropriate character sequence to clear to
;end of line, and internally replacing text by spaces.
CLREOL: CALL CURPOS ; Position the cursor
CLL.A: MOVE A,TJFN ; Get image tty jfn
HLRO B,CELTAB(P2) ; Get clear end of line sequence
HRLI B,441000 ; Set up 8-bit pointer
HRRE C,CELTAB(P2) ; Number of characters
SOUT% ; Type it
RET ; Done
;CLREOS routine - blank out the screen from current position down
;Done by sending a clear eos string and internally blanking out the text.
CLREOS: CALL CURPOS ; Position cursor
CLS.A: MOVE A,TJFN ; Get image tty jfn
HLRO B,CESTAB(P2) ; Get address of string for clear eos
HRLI B,441000 ; Set up 8-bit pointer
HRRE C,CESTAB(P2) ; Get count
SOUT% ; Type it and clear to eos
RET ; Done
;CLRSCN -- Clear the screen. Just output a form feed if possible, otherwise
;home up and clear to end of screen.
CLRSCN: SKPOFF F.NFFD ; No form feed?
JRST CLRS.A ; That's right
MOVEI A,14 ; Get a form feed
PBOUT% ; Type it
RET ; And return
;Here to do it the hard way
CLRS.A: CALL HOMEUP ; Home
CALL CLS.A ; And clear
RET ; Done
Subttl NXTWRD - Find the next word in the file
;Find starting and finishing position of next word, and length including
;trailing spaces. If we are in the middle of a word, we back up to the start.
;If not in a word, we advance to the next one. This algorithm will not advance
;lines, and takes the non-skip return if no word is found within bounds.
NXTWRD: MOVE T1,COL ; Get current column
MOVE B,P1 ; Get pointer
ILDB A,B ; Get first char
JUMPE A,NXT.B ; A neo-space?
CAIN A,SP ; A space?
JRST NXT.B ; Yes, go forward
;Look for the start of this word
NXT.A: JUMPLE T1,NXT.B ; Don't back up too far
MOVE A,B ; Character, go backward
MOVNI B,2 ; Go back 2 for ildb loop
ADJBP B,A ; Back it up
ILDB A,B ; Get a char
SOJ T1, ; Count down column
JUMPE A,NXT.B ; Check for neo-space
CAIE A,SP ; A space?
JRST NXT.A ; No, keep searching
;Here at beginning of field, scan to first non-space
NXT.B: JUMPE A,.+3 ; Check for neo-space
CAIE A,SP ; A space?
JRST NXT.C ; Not a space
ILDB A,B ; Get next
CAIGE T1,^D79 ; Too far?
AOJA T1,NXT.B ; Not yet
RET ; Yes, quit
;Here at the beginning of the field
NXT.C: MOVE T2,T1 ; Get current column
NXT.C1: CAIL T2,^D79 ; End of line?
JRST NXT.D ; Yes
ILDB A,B ; Get char
JUMPE A,NXT.D ; Check for a neo-space
CAIN A,SP ; Check for a space
JRST NXT.D ; It is, field is done
AOJA T2,NXT.C1 ; It isn't, keep looking
;We've found the end, now look for number of trailing spaces
NXT.D: MOVEI T3,1(T2) ; Start at next position
NXT.D1: CAIL T3,^D79 ; Are we at the end?
JRST NXT.E ; Yes
ILDB A,B ; Get a char
JUMPE A,.+3 ; A neo-space?
CAIE A,SP ; Space?
JRST NXT.E ; No, done
AOJA T3,NXT.D1 ; Yes, keep looking
;Here when we're done
NXT.E: SUB T2,T1 ; Get counts
SUB T3,T1 ; For both
AOJ T2, ; Count starting char
AOJA T3,RSKP ; Done, return
Subttl Adjustment routines -- FILL
;The FILL routine takes input text terminated by a null and puts it into
;80-column lines buffered with spaces. The JFN of the input file
;is in AC A, and the address of the output buffer is in BUF. The data is
;copied until we exceed MAXLIN lines from the start or until EOF.
FILL: SETZM PGHEAD ; Zero the page header
FLGOFF F.IEOF ; No input end of file
MOVEM A,P3 ; Store the jfn
SETZM HARDPG ; No hard page breaks seen yet
SKIPE T4,CIPHER ; Are we ciphering?
JRST CIP.IN ; Yes, special handling
SETZM HGHLIN ; Start at line zero
SETOM LINE ; Line counter
SETZM COL ; Zero the column
STKVAR <MARDIF> ; Get extra variable
MOVEI T1,^D78 ; Get maximum margin
SUB T1,MAXCOL ; Get difference
MOVEM T1,MARDIF ; Save it
SETZM BFRCNT ; No characters yet
;Check for autopagination in effect in file -- if so, set it
BIN% ; Get first byte of file
ERJMP FIL.D1 ; Can't, assume eof
JUMPN B,[BKJFN% ; Not null, back up
JFCL ; Ignore errors
JRST FIL.A] ; And try again
SKIPE AUTOPG+OFFSET## ; Get original command line switch val
SETOM AUTOPG ; Not off, make sure set
;Loop here making each line into 80 width chunks.
FIL.A: AOS T3,LINE ; Bump the line count
CAMLE T3,MAXLIN ; Don't go too far
JRST FIL.D ; Quit while ahead
SETZM COL ; Clear the column
CALL SETPTR ; Set up the byte pointer
SETOM LSTSPC ; Last space seen
SETZ T1, ; Clear column counter
;Obtain the actual character
FIL.B: CALL NXTCHR ; Get next character
JRST FIL.D1 ; No next, eof
FIL.S: CAIN B,15 ; Ignore cr
JRST FIL.B
SKPON F.PMRK ; Page marks?
JRST FIL.S1 ; No, keep looking
CAIE B,12 ; Line feed?
JRST FIL.B ; No, discard characters
FLGOFF F.PMRK ; Turn off the flag
SETZM COL ; Column zero
SETOM LSTSPC ; No last space
SKIPE HARDPG ; Hard page?
AOS LINE ; Yes, add one
CALL SETPTR ; Set the pointer
MOVEI T1,3 ; Three line feeds
FIL.S0: CALL NXTCHR ; Get next
JRST FIL.D1 ; Eof
CAIN B,12 ; Line feed?
SOJG T1,FIL.S0 ; Yes, continue
JUMPE T1,FIL.B ; Three lfs, get next character
JRST FIL.S ; Not three, process this character
FIL.S1: CAIE B,14 ; Form feed?
JRST FIL.S8 ; No, next test
SKIPE AUTOPG ; Autopagination in effect?
IFSKP. ; No
MOVEI B,"~" ; Get substitution char
JRST FIL.B4 ; And deposit it
ENDIF.
CALL NXTCHR ; Get next character
JRST FIL.D1 ; No next
JUMPE B,FIL.S2 ; Null, soft page mark
;Proceed with hard page mark
SETOM HARDPG ; Hard pages in file
MOVEI A,"~" ; Page marker char
IDPB A,P1 ; Store it
CAIN B,15 ; Cr?
JRST FIL.S4 ; Yes, obtain a header
JRST FIL.S7 ; Proceed with eating characters
;Soft page mark
FIL.S2: CALL NXTCHR ; Get next character
JRST FIL.D1 ; No next
CAIE B,15 ; Cr?
JRST FIL.S7 ; No, soft page w/o header
;Read a header into PGHEAD -- we've found a CR marker
FIL.S4: SKIPE PGHEAD ; Page header stored yet?
JRST FIL.S7 ; Yes, don't repeat it
MOVEI T2,^D70 ; Line limit
BPM T1,PGHEAD ; Point to buffer
CALL NXTCHR ; Read a character
JRST FIL.S7 ; None there
CAIN B,SP ; Space?
SOJG T2,.-3 ; Yes, don't save leading ones
JUMPLE T2,FIL.S7 ; If exhausted, don't save a header
JRST FL.S5A ; Process this character
FIL.S5: CALL NXTCHR ; Get next
JRST FIL.S6 ; Finished
FL.S5A: JUMPE B,FIL.S6 ; End on a null
CAIGE B,SP ; Check for control chars
JRST FL.S5B ; Found one, probably cr, discard line
IDPB B,T1 ; Store it
SOJG T2,FIL.S5 ; Loop until done
FL.S5B: SETZM PGHEAD ; Ran out, don't save header
JRST FIL.S7 ; Proceed with eating line
;Here when header probably finished
FIL.S6: MOVEI B,SP ; Load a space
IDPB B,T1 ; Store it
SOJG T2,.-1 ; Fill up rest of line
;Regular soft page w/o header, discard it
FIL.S7: FLGON F.PMRK ; Flag the mark
JRST FIL.B ; Get and test next one
;Proceed with next test
FIL.S8: CAIN B,12 ; Handle lf specially
JRST FIL.A
JUMPE B,FIL.B4 ; Treat nulls like spaces
CAIE B,11 ; Tab?
JRST FIL.B2 ; No, skip
MOVEI B,SP ; Load a space instead
;Loop inserting multiple spaces in place of a tab
FIL.B1: IDPB B,P1 ; Insert a space
AOJ T1, ; Bump column counter
CAMLE T1,MAXCOL ; Too high?
JRST FIL.B5 ; Yes
TRNN T1,7 ; Check tab position
JRST FIL.B ; Yes, enough spaces
JRST FIL.B1 ; No, keep looping
;Not a tab, continue checking
FIL.B2: CAIGE B,SP ; Check for control characters
JRST FIL.B ; And toss them out!
CAIN B,177 ; Also check for delete
JRST FIL.B ; And discard that too
FIL.B4: IDPB B,P1 ; Deposit character
SKIPE B ; Null?
CAIN B,SP ; Or space?
MOVEM T1,LSTSPC ; Yes, count last space
AOJ T1, ; Bump column counter
CAMG T1,MAXCOL ; Too far?
JRST FIL.B ; Nope, keep going
;Here we handle a line which must be broken at the spot
FIL.B5: SKIPN XPNCOL ; Are we expanding?
JRST FL.B5B ; No
AOS T3,MAXCOL ; Bump maximum column
CAILE T3,^D78 ; Too far?
JRST FL.B5A ; Yes
MOVEM T3,XPNCOL ; Keep track of it
JRST FIL.B ; Keep going
;Here when we really must break
FL.B5A: SOS MAXCOL ; Bump down count again
FL.B5B: JUMPE B,FIL.B8 ; Break on nulls
CAIN B,SP ; And spaces
JRST FIL.B8
SETZ B, ; Make b into a null
SKIPGE T3,LSTSPC ; Get last space position
JRST FIL.B7 ; None, break here
SUB T1,T3 ; Get amount to back up
CAMLE T1,BACKUP ; Too far?
JRST FIL.B7 ; Yes
MOVNI T4,-1(T1) ; Copy length, make negative
ADJBP T4,P1 ; Get copy of byte pointer
AOS LINE ; Bump line count
SKIPE T3,INDENT ; Get indention
MOVEM T3,COL ; Set it
CALL SETPTR ; Set up the pointer
MOVE T3,INDENT ; Remove indent from line length
ADDI T3,2 ; Allow for transferred characters
SETOM LSTSPC ; Clear last space counter
;Loop here transfering characters down a line until done
FIL.B6: SOJLE T1,FIL.B ; Where to go when done
ILDB T2,T4 ; Get a byte
DPB B,T4 ; Overwrite it with a space
IDPB T2,P1 ; Copy to new place
JRST FIL.B6
;Here when we have to break the line in place
FIL.B7: MOVNI T3,2 ; Back two bytes
ADJBP T3,P1 ; Adjust byte pointer
AOS LINE ; Bump the line
SKIPE T1,INDENT ; Get indention
MOVEM T1,COL ; Set it
CALL SETPTR ; And set a new pointer
ILDB T1,T3 ; Get byte
MOVEI T2,"-" ; Get a hyphen
DPB T2,T3 ; Overwrite the character
ILDB T2,T3 ; Get the next byte
DPB B,T3 ; Overwrite with null
IDPB T1,P1 ; Deposit on next line
IDPB T2,P1
MOVE T1,INDENT ; Set starting column for next line
SETOM LSTSPC ; Clear last space counter
JRST FIL.B ; Proceed
;Here when we are breaking the line right on a space. Just remember to
; start the next line on the indentation.
FIL.B8: AOS LINE ; Bump the line
SKIPE T1,INDENT ; Get indention
MOVEM T1,COL ; Set it
CALL SETPTR ; Set the pointer
SETOM LSTSPC ; Clear last space counter
MOVE T1,INDENT ; Set new count
JRST FIL.B ; Proceed
;Here we fill out the very last line.
FIL.D: SOS LINE ; Decrement line (to be Maxlin)
FIL.D1: MOVE T3,LINE ; Get line count
MOVEM T3,HGHLIN ; Store highest line
RETSKP ; Done
;Routine to input next character. Skip return if character in B,
; otherwise non-skip on EOF
;Use SIN% to obtain chunks of the file, then use ILDB on each character.
NXTCHR: SOSL BFRCNT ; Characters remaining?
JRST NXC.C ; Yes, go get one
SKPOFF F.IEOF ; End of file?
RET ; Yes, done
MOVE A,P3 ; Get the jfn
BPM B,SPARE ; Point to buffer
MOVNI C,3000 ; 3000 characters per sin
SIN% ; Get them
ERJMP NXC.A ; Can't
MOVEI C,3000 ; Characters read
MOVEM C,BFRCNT ; How many we've got to read
JRST NXC.B ; Go get one
;Check out an error return from SIN. Probably EOF.
NXC.A: MOVE A,P3 ; Get jfn
GTSTS% ; Get status
TXNN B,GS%EOF ; Skip if eof
JRST NXC.ER ; No, error
ADDI C,3000 ; Find how many actually read
JUMPE C,R ; None, end of file
FLGON F.IEOF ; Say end of file next time
MOVEM C,BFRCNT ; Store count
;Here to set up new byte pointer
NXC.B: SOS BFRCNT ; Reading one
BPM A,SPARE ; Point to buffer
MOVEM A,CHRPTR ; Store in pointer
;Here to obtain the character
NXC.C: ILDB B,CHRPTR ;GET CHARACTER
RETSKP ;AND RETURN SUCCESS
;Here on errors
NXC.ER: TYPE <? Error reading input file, file truncated at error>
MOVEI A,^D3000 ; 3 seconds
DISMS%
RET ;DONE
Subttl Adjustment routines -- EMPTY
;This routine is the opposite of FILL, as might be expected -- it takes the
;buffer which starts at location BUF and transfers it to the block starting
;at location (A), stripping off the trailing spaces as it goes. It does
;HGHLIN lines before terminating.
;UNFILL is an alternate entry used from the WPSIM main routine, which
;specifies that form feed conversion should take place.
UNFILL: SKIPE T4,CIPHER ; Are we ciphering?
JRST CIP.OU ; Yes, special handling
MOVE T4,LETHED ; Set line counter to letterhead if any
SKIPE AUTOPG ; Are we autopaging?
SUBI T4,4 ; Yes, compensate for missing header
SETZM HARDPG ; Assume soft page for now
FLGON F.FFCV!F.TABC ; Form feed conversion
SKIPN T1,STRPAG ; Any starting page number specified?
MOVEI T1,1 ; No, start with page one
MOVEM T1,PAGNUM ; Initialize the numbering
EMPTY: MOVE C,BUF ; Source
MOVE D,A ; Destination
HRLI C,(POINT 7,0) ; Make into pointers
HRLI D,(POINT 7,0)
PUSH P,HGHLIN ; Store highest line
SETZ T1, ; Get a null
SKPON F.FFCV ; Form feed conversion?
IFSKP. ; Yes
SKIPE AUTOPG ; Autopaging?
IDPB T1,D ; Yes, start with a null
ENDIF.
;Loop here doing one line at a time
EMP.A: MOVEI T1,^D80 ; Maximum allowed column
SETZ B, ; Space counter
;Loop here for each character on the line
EMP.B: ILDB T2,C ; Get a character
SKIPN T2 ; Check for a neo-space
MOVEI T2,SP ; Make it a real one
SKPOFF F.TABC ; Tab conversion in progress?
SKIPN FILTAB ; Converting spaces to tabs?
JRST EMP.B1 ; No
JUMPLE B,EMP.B1 ; Any stored spaces?
TRNE T1,7 ; Are we at a tab stop?
JRST EMP.B1 ; No
MOVEI T3,11 ; Load a tab
CAIN B,1 ; Only one space?
MOVEI T3,SP ; Yes, don't use a tab
IDPB T3,D ; Store it
SETZ B, ; Clear stored space count
;Here to check for form feed conversion
EMP.B1: SKPON F.FFCV ; Form feed conversion?
JRST EMP.B2 ; No
CAIE T2,"~" ; Page break?
JRST EMP.B2 ; No, continue
SKIPE AUTOPG ; Autopagination?
IFSKP. ; No
MOVEI T2,14 ; Load form feed
JRST EMP.B2 ; And process it as regular char
ENDIF.
SETOM HARDPG ; A hard page break
JRST EMP.F ; Yes, handle form feeds
EMP.B2: SOJLE T1,EMP.E ; End of line
CAIN T2,SP ; Space?
AOJA B,EMP.B ; Yes, count it
MOVEI T3,SP ; Get a space
;Here when we've got a non-space character
EMP.C: SOJL B,EMP.C1 ; Count down stored spaces
IDPB T3,D ; Deposit them
JRST EMP.C ; Do as many as necessary
;Here when we've processed all stored spaces
EMP.C1: SKIPN CTRLCV ; Convert control chars?
JRST EMP.D ; Nope
CLRSKS F.UPAR ; Up-arrow last character?
IFSKP. ; Yes
CAIL T2,"a" ; Check lower case
SUBI T2,40 ; Yes, convert to upper
SUBI T2,100 ; Make it a control char
SKIPGE T2 ; Allowed value?
SETZ T2, ; No, make it a null
JRST EMP.D ; Go process it
ENDIF.
CAIE T2,"$" ; A dollar sign?
JRST EMP.C2 ; No, try an "^"
MOVEI T2,ALT ; Get an escape
JRST EMP.D ; Deposit and get next character
EMP.C2: CAIE T2,"^" ; An uparrow?
JRST EMP.D ; No, keep checking
FLGON F.UPAR ; Yes, flag it
JRST EMP.B ; And get next char
;Finally, process the character
EMP.D: IDPB T2,D ; Deposit
SETZ B, ; No more stored spaces
JRST EMP.B ; Keep going
;Here at EOL - toss in a CRLF
EMP.E: CAIE T2,SP ; Don't deposit a lone space
IDPB T2,D ; Store the character
EMP.E1: LDB T2,D ; Get the character
CAIE T2,11 ; A tab?
CAIN T2,SP ; Or a space?
IFNSK. ; Yes
SETO T2, ; Set to -1
ADJBP T2,D ; Back up the pointer
MOVEM T2,D ; Reset the pointer
JRST EMP.E1 ; And try next
ENDIF.
MOVEI T2,15 ; Get a cr
IDPB T2,D ; Deposit it
MOVEI T2,12 ; Get a lf
IDPB T2,D ; Deposit it
SOSGE HGHLIN ; Count down number of lines
JRST EMP.EX ; Done, finish up
SKPON F.FFCV ; Are we converting form feeds?
JRST EMP.A ; No, do next line
AOS T4 ; Up the line count
SKIPE AUTOPG ; Are we autopaginating?
CAMGE T4,PAGSIZ ; Ready for a new page?
JRST EMP.A ; No, do next line
AOS HGHLIN ; Correct count, since emp.f changes it
MOVE B,C ; Copy byte pointer
ILDB A,B ; Get first byte of next line
CAIN A,"~" ; Page?
JRST EMP.A ; Yes, don't make two of them
JRST EMP.F ; No, put in a page break
;Finish up and restore flags
EMP.EX: POP P,HGHLIN ; Restore pushed data
SETZ T2, ; Get a null
CLRSKP F.FFCV ; Form feed conversion? (clear, too.)
MOVEI T2,177 ; Yes, use delete instead
IDPB T2,D ; And tack it on.
;Now trim off the trailing blank lines
EMP.E2: MOVNI T1,3 ; Three positions
ADJBP T1,D ; Back up the pointer
LDB T3,T1 ; Get a byte
CAIE T3,12 ; A line feed?
RET ; Done
IDPB T2,T1 ; Yes, null out succeding crlf
MOVEM T1,D ; Set up pointer
JRST EMP.E2 ; And try again
;Handle page header conversion here
EMP.F: SETZ T4, ; Back at line 0
;Eat the rest of the input line
EMP.F0: SOJLE T1,EMP.F1 ; End of line
ILDB T2,C ; Get a character
JRST EMP.F0 ; Loop
EMP.F1: PUSH P,C ; Save c
MOVEI C,12 ; Prepare for number output in decimal
MOVEI A,14 ; Get a form feed
IDPB A,D ; Toss it in
SETZ A, ; A null
SKIPN HARDPG ; Are we writing a hard page break?
IDPB A,D ; No, so follow the ^L with a null
HRROI A,PGHEAD ; Page header string
SKIPN PGHEAD ; Only if set up
JRST EMP.F4 ; Otherwise another type used
MOVEI T2,15 ; Carriage return
IDPB T2,D ; Deposit to say header coming
SKIPG T1,INDENT ; Indention used?
JRST EMP.F2 ; No, regular
MOVEI T2,SP ; Get a space
IDPB T2,D ; Deposit it
SOJG T1,.-1 ; Loop until done
EMP.F2: MOVE T1,MAXCOL ; Get right margin
SUB T1,INDENT ; Sub left
SUBI T1,10 ; Sub page count
BPM T2,PGHEAD ; Point to page header
ILDB T3,T2 ; Get a byte
IDPB T3,D ; Deposit it
SOJG T1,.-2 ; Loop until done
SETZ T2, ; Null
IDPB T2,D ; Tack onto end of header
MOVEI T1,5 ; Get length of page string
BPL T2,<Page > ; Source
ILDB T3,T2 ; Get a byte
IDPB T3,D ; Deposit it
SOJG T1,.-2 ; Loop until done
AOS B,PAGNUM ; Get page
MOVE A,D ; Get pointer
NOUT% ; Type number
JFCL
MOVE D,A ; Restore pointer
JRST EMP.F5 ; Finish up and return
;Here for an alternate paging style
EMP.F4: MOVE T1,MAXCOL ; Get right margin
SUB T1,INDENT ; Subtract left
LSH T1,-1 ; Divide by two
ADD T1,INDENT ; And add indentation
SUBI T1,3 ; Minus three for dashes
MOVEI T2,SP ; Get a space
IDPB T2,D ; Deposit it
SOJG T1,.-1 ; Deposit that many spaces
MOVEI T3,"-" ; Get a dash
IDPB T3,D
IDPB T2,D ; Another space
AOS B,PAGNUM ; Get page number
MOVE A,D ; Copy pointer
NOUT% ; Type the number
JFCL
MOVE D,A ; Restore pointer
IDPB T2,D ; Now the space
IDPB T3,D ; And the dash
;Here to finish up
EMP.F5: BPM T2,[BYTE(7)15,12,12,12,12]
MOVEI T1,5 ; End the line
ILDB T3,T2 ; Get a byte
IDPB T3,D ; Deposit it
SOJG T1,.-2 ; And loop
POP P,C ; Restore the pointer
SOSLE HGHLIN ; Count down lines
JRST EMP.A ; And do the next
JRST EMP.EX ; If done, finish up
;Ciphering support routines for input and output
;Random number routine - Copied from FORLIB version 6
RANDOM: MOVE T1,T4 ; Get seed
MUL T1,[4544,,503720] ; Multiply
DIV T1,[17777,,-1] ; Divide
MOVEM T2,T4 ; Save new seed
RET ; Done
;Input ciphering routine
CIP.IN: MOVE T3,BUF ; Get starting address
CIP.I1: BIN% ; Get a byte
ERJMP CIP.I2 ; Probably eof
CALL RANDOM ; Get a random number
XOR B,T4 ; Xor our byte
MOVEM B,(T3) ; Store it
AOJA T3,CIP.I1 ; And loop for more
;Here on probable eof
CIP.I2: GTSTS% ; Get status
TXNE B,GS%EOF ; Eof?
JRST CIP.I3 ; Yes
TYPE <? Error reading input file, file truncated>
MOVEI A,HLDTIM ; 1.5 seconds
DISMS% ; Leave message on
CIP.I3: SUB T3,BUF ; Get number of words
IDIVI T3,20 ; Get number of lines
MOVEM T3,HGHLIN ; Save the value
SETZM CIPHER ; Don't cipher the output
RETSKP ; Done
;Output ciphering routine
CIP.OU: MOVN B,HGHLIN ; Get highest line
SOJ B, ; Bump it to set up a count
IMULI B,20 ; Get number of words
HRL A,B ; Set up an aobjn
MOVE B,BUF ; Get starting address
CIP.O1: MOVE C,(B) ; Get the byte
CALL RANDOM ; Get a random seed
XOR C,T4 ; Xor it
MOVEM C,(A) ; Store the byte
AOJ B, ; Bump the pointer
AOBJN A,CIP.O1 ; Loop until done
RET ; Done
Subttl General subroutines
;MOVLIN routines - transfer a line from one place in the buffer to
;another. Assumes T1 contains the source line number and the entry
;point indicates whether we're moving up or down.
;Enter here if T2 contains number of words to move
MOVLIN: MOVE A,T1 ; Get source
IMULI A,20 ; Get word address
ADD A,BUF ; Make buffer address
HRLS A ; Put into left hand side
ADDB A,T2 ; Make right side point to proper line
BLT A,17(T2) ; Make the transfer
RET ; Done
;Linlen routine -- set T4 to position of last character on line
LINLEN: PUSH P,COL ; Save current column
MOVEI T4,^D80 ; Get last position
MOVEM T4,COL ; Store it
CALL SETPTR ; Set the pointer
LIN.A: LDB B,P1 ; Get a byte
JUMPE B,LIN.B ; A null
CAIE B,SP ; Space?
JRST LIN.C ; Not a space
LIN.B: SETO A, ; Minus one
ADJBP A,P1 ; Back up the pointer
MOVEM A,P1 ; Restore it
SOJG T4,LIN.A ; Keep looking
MOVEI T4,1 ; Prepare for subsequent lowering
;Here when we've found a non-space character
LIN.C: POP P,COL ; Restore old column
CALL SETPTR ; Restore pointer
SOJA T4,R ; And return
;WRKSPC and CLRWRK -- Obtain/restore workspace at bottom of screen
;Clear bottom two lines of screen for special purpose use
WRKSPC: PUSH P,LINE ; Save line and col
PUSH P,COL
MOVE T1,TOPLIN ; Get top line
ADDI T1,^D22 ; Add most of screen
MOVEM T1,LINE ; Set it
SETZM COL
CALL CLREOS ; Clear the text area
POP P,COL ; Restore line and col
POP P,LINE
RET ; And return
;Restore the bottom two lines to their normal state
CLRWRK: PUSH P,LINE ; Store current line
PUSH P,COL ; And column
MOVE T1,TOPLIN ; Get top of screen
ADDI T1,^D22 ; Get to last line minus one
MOVEM T1,LINE ; Set new line
SETZM COL ; And column
CALL CLREOS ; Clear to end of screen
MOVE T1,LINE ; Get line number back
MOVEI T2,2 ; Two lines to refresh
SKIPN SFIRST ; Search mode?
CALL FFD.A ; No, redisplay the lines
POP P,COL ; Get column and line back
POP P,LINE
CALL CURPOS ; Position
RET ; And return
;FNDBRK - Find blank line nearest current position
;We go down and up three lines from current position searching for a line
;containing all blanks. If found we delete it, if not we return with LINE
;at its original setting.
FNDBRK: MOVE T1,INDENT ; Get indentation
MOVE T2,LINE ; Get line
CALL CHKBRK ; Check for a break
RET ; Found
AOJ T2, ; Bump line
CALL CHKBRK ; Try again
RET
SUBI T2,2 ; Try line-1
CALL CHKBRK ; Try again
RET
SOJ T2, ; Try line-2
CALL CHKBRK
RET
ADDI T2,4 ; Try line+2
CALL CHKBRK
RET
SUBI T2,2 ; Last chance failed
MOVEM T2,LINE ; Reset
RET ; And return
;Chkbrk routine - check for a broken line, return with skip if not found
CHKBRK: MOVEM T1,COL ; Set indentation
MOVEM T2,LINE ; Set the line
CALL SETPTR ; Set the pointer
ILDB A,P1 ; Get a byte
JUMPE A,R ; Return if null
CAIN A,SP ; Or space
RET
RETSKP ; Anything else gets a skip
;CHKPAG routine - check for a page marker at the beginning of the line
CHKPAG: SETZM COL ; Clear column
CALL SETPTR ; Set the pointer
ILDB B,P1 ; Get the character at start of line
CAIN B,"~" ; Page mark?
RET ; Yes, say so
RETSKP ; No
;CURPOS - Cursor positioning routine.
CURPOS: MOVE A,TJFN ; Get image tty jfn
HLRO B,ADRTAB(P2) ; Addressing sequence
HRLI B,441000 ; Set up 8-bit pointer
HRRE C,ADRTAB(P2) ; Get number of chars
SOUT% ; Type the beginning
SKPOFF F.ANSI ; Check for ansi terminals
JRST CURP.A ; They're a different ballgame
MOVE B,LINE ; Get line number
SUB B,TOPLIN ; Make into screen offset
MOVE A,B ; Get line
SKPOFF F.CXBY ; Check for reverse sequence terminals
MOVE A,COL ; Get column instead
ADDI A,SP ; Standard offset
PBOUT% ; Send it
MOVE A,COL ; Get column
SKPOFF F.CXBY ; Check for x before y
MOVE A,B ; Yes, get line instead
ADDI A,SP ; Offset
PBOUT% ; Type it
RET ; Done
;Handle ANSI mode terminals -- the sequence is $[line; colh and the line
;and column have to be done carefully.
CURP.A: SKIPN B,LINE ; Get the line
JRST CURP.B ; It's zero
SUB B,TOPLIN ; Subtract the offset
AOJ B, ; Add in the offset
MOVEI C,12 ; In decimal
NOUT% ; Type it
JFCL ; Ignore errors
CURP.B: SKIPN D,COL ; Is column non-zero?
JRST CURP.C ; No
MOVEI B,";" ; Seperator
BOUT% ; Type it
MOVEI B,1(D) ; Get column with offset
MOVEI C,12 ; Decimal
NOUT% ; Type it
JFCL
CURP.C: MOVEI B,"H" ; Terminates ascii positioning
BOUT%
RET ; Done
;ICHAR subroutine - get an invisible character by turning off the terminal
;echo before doing an input. Raise lower case input to upper.
ICHAR: MOVEI A,.CTTRM ; Controlling terminal
RFMOD% ; Read mode
TXZ B,TT%ECO ; Turn off echo
SFMOD% ; For following character
PBIN% ; Read it in
CAIN A,15 ; Is it a CR?
PBIN% ; Yes, get the LF too
CAIL A,"a" ; Find out if it's lower case
CAILE A,"z" ; ..
TRNA ; No, always skip
SUBI A,SP ; Yes, convert to upper
PUSH P,A ; Save the character
MOVEI A,.CTTRM ; Get terminal designator back
TXO B,TT%ECO ; Echo back
SFMOD% ; And reset
POP P,A ; Restore character
RET ; Done
;ICHAR subroutine - get an invisible character by turning off the terminal
;echo before doing an input.
ICHAR1: MOVEI A,.CTTRM ; Controlling terminal
RFMOD% ; Read mode
TXZ B,TT%ECO ; Turn off echo
SFMOD% ; For following character
PBIN% ; Read it in
CAIN A,15 ; Is it a CR?
PBIN% ; Yes, get the LF too
PUSH P,A ; Save the character
MOVEI A,.CTTRM ; Get terminal designator back
TXO B,TT%ECO ; Echo back
SFMOD% ; And reset
POP P,A ; Restore character
RET ; Done
;Routine to confirm an input request. This is requested by typing a bell
;and requiring one back.
CONFRM: MOVE A,TJFN ; Get jfn
MOVEI B,.CHBEL ; A bell
BOUT% ; Send it
CALL ICHAR ; Get a bell back
CAIE A,.CHBEL ; Valid?
RET ; Nope
RETSKP ; Yes
;Indentation routines for input processing.
; DOIND - Indentation alone
DOIND: MOVE C,INDENT ; Get indention
MOVEM C,COL ; Store it
CALL SETPTR ; Set pointer
CALL CURPOS ; And cursor
RET ; And return
;Routine to type out the current line starting at COL. We assume that the
;line is clear and thus avoid typing trailing spaces. The pointer is in A.
; TYPLN1 type the current line from the beginning:
TYPLN1: PUSH P,COL ; Save the real column
SETZM COL ; Set to the beginning of line
CALL SETPTR ; Point there in the text
CALL CURPOS ; Point to where it would be
MOVE A,P1 ; Copy the current pointer
CALL TYPLIN ; And do TYPLIN
POP P,COL ; Reset the column count
CALL SETPTR ; Reset the pointer
CALLRET CURPOS ; Show where it is and return
TYPLIN: MOVE T1,A ; Store pointer
MOVEI C,^D80 ; Get line
SUB C,COL ; Find characters left
TYP.A: SETZ D, ; Space counter
TYP.B: SOJLE C,TYP.C ; End of line
ILDB B,A ; Get a character
JUMPN B,TYP.B1 ; Look for nulls
MOVEI B,40 ; Make it a space instead
DPB B,A ; And overwrite the null
TYP.B1: CAIN B,SP ; A space?
AOJA D,TYP.B ; Yes, count it
JRST TYP.A ; No, clear space count
;Here when the line is finished
TYP.C: MOVNI C,^D80 ; Find count
ADD C,COL ; Starting column
ADD C,D ; Add trailing spaces
MOVEI A,.PRIOU ; Output
MOVE B,T1 ; Saved pointer
JUMPE C,R ; Don't sout if nothing there
SOUT% ; Type
RET ; And return
;Routine to refresh the display, by rewriting any lines starting at
;LINE and going down.
DISPLA: SETZM COL ; Now at column zero
CALL CLREOS ; Clear to end of screen
MOVE T1,LINE ; Where to start the refresh
MOVE T2,TOPLIN ; Top of screen
ADDI T2,^D24 ; Add end of screen
SUB T2,LINE ; True amount to refresh
FLGON F.INDT ; Indent after refresh
CALL FFD.A ; Refresh rest of screen
RET ; Done
;Routine to check for characters on the current line. Skips if the line
; has characters, non-skip if line is empty.
LINACT: CALL SETPTR ; Reset pointer
MOVE C,P1 ; Copy the pointer
MOVEI A,^D80 ; Load up a column counter
SUB A,COL ; Offset by current column
;Look for characters on this line
LINA.A: ILDB B,C ; Get a char
CAIE B,SP ; Space?
SKIPN B ; Or neo-space?
CAIA ; One or the other
RETSKP ; Not a blank line
SOJG A,LINA.A ; Count down
RET ; No chars found, non-skip return
;Routine to check for characters before the cursor on the current line.
; Skip return if said characters exist.
LINAC2: PUSH P,P1 ; Save pointer
SETZ A, ; Clear an ac
EXCH A,COL ; Get and clear column
CALL SETPTR ; Set the pointer
EXCH A,COL ; Reset column
;Look for characters before the cursor
LIN2.A: CAML A,COL ; At the cursor?
JRST LIN2.C ; Yes, done
ILDB B,P1 ; Get a char
CAIE B,SP ; Space?
SKIPN B ; Neo-space?
CAIA ; Yes
JRST LIN2.B ; No, characters on line
AOJA A,LIN2.A ; Keep looking
;Here when characters found, bump the return pc
LIN2.B: AOS -1(P) ; Remember pushed value
LIN2.C: POP P,P1 ; Restore it
RET ; And return
;Test to see if the modified SIN% jsys is available. Read in a string
; containing a control character and see if the jsys terminates on it.
CHKSIN: BPL A,<134> ; Bell is second char
BPM B,SPARE ; Point to some area
MOVEI C,4 ; The whole string
MOVX D,SI%TCC ; Special JSYS flag
SIN% ; Start reading
SKIPE C ; Did we stop on the ^g?
FLGON F.NSIN ; Yes, new sin% available
RET
Subttl Number input routines
;Routine to read in a number from the screen. Gives skip return if
;it found one.
GETNUM: CALL ICHAR ; Get a character
SUBI A,60 ; Make into an integer
JUMPLE A,GETN.A ; Return if non-positive
CAIG A,11 ; Nine is highest allowed
RETSKP ; Success
;Here if the number is illegal -- return it to it's previous value
GETN.A: ADDI A,60 ; Return to normal
RET ; And return
;Routine to read in a number with an optional minus. Returns the number
;in T1 and the terminator in T2.
GETNIN: MOVEI A,.CTTRM ; Terminal
RFMOD% ; Get mode
MOVEM B,T3 ; Store the value
TXZ B,TT%ECO ; Turn off the echo
SFMOD%
MOVEI A,.PRIIN ; Input
MOVEI C,12 ; In decimal
NIN% ; Get a number
SETZ B, ; Failed, clear number
MOVE T1,B ; Copy the number
MOVEI A,.PRIIN ; In case of failure above
BKJFN% ; Back up the terminator
SKIPA A,14 ; Load a form feed
PBIN% ; Get terminator
CAIL A,"a" ; Check for lower case
CAILE A,"z"
TRNA ; No, skip
SUBI A,SP ; Yes, convert to upper
MOVE T2,A ; Copy it
JRST GTNI.B ; Skip over the clear
;Restore echo and return
GTNI.A: SETZ T1, ; Clear number
GTNI.B: MOVEI A,.CTTRM ; Terminal
MOVE B,T3 ; Old mode
SFMOD% ; Restore
RET ; And return
;Terminal special effects control
SPCON: SKPON F.SPEF ; Special effeects?
RET ; No
SETSKP F.SPON ; Turn on special effects
RET ; They were on already
MOVE A,TJFN ; Terminal jfn
MOVE C,[SEQ<CL(N),ALT,"0","P">]
SKPOFF F.ANSI ; Ansi terminal?
MOVE C,[SEQ<ALT,"7",ALT,"[","7","m">] ; Yes
HLRZ B,C ; Get address
HRLI B,441000 ; Byte pointer
HRRES C ; Get count of chars in c
SOUT% ; Type the string
RET ; Done
SPCOFF: SKPON F.SPEF ; Special effects?
RET ; No
CLRSKS F.SPON ; Turn off special effects
RET ; They weren't on
MOVE A,TJFN ; Get terminal jfn
SKPOFF F.ANSI ; Ansi terminal?
JRST SPCF.A ; Yes, handle differently
MOVEI B,CL(O) ; Get the character
BOUT% ; Send it
RET ; And return
SPCF.A: MOVE C,[SEQ<ALT,"[","0","m",ALT,"8">] ; String to turn off attributes
HLRZ B,C ; Get address
HRLI B,441000 ; Byte pointer
HRRES C ; Get count of chars in c
SOUT% ; Type the string
RET ; Done
;Cursor on and off on a viewpoint terminal
CURSOF: MOVE A,TJFN ; Terminal jfn
MOVEI B,"W"-100 ; Control-w
SKPON F.SPEF ; Special effects?
RET ; No
SKPON F.ANSI ; Ansi terminal?
BOUT% ; No, must be a viewpoint
RET ; Done
CURSON: MOVE A,TJFN ; Terminal jfn
MOVEI B,"X"-100 ; Control-X
SKPON F.SPEF ; Special effects?
RET ; No
SKPON F.ANSI ; Ansi terminal?
BOUT% ; No, must be a viewpoint
RET ; Done
;GETSTR - Read in an input string from the terminal into SPARE
; A points to the prompting string to be displayed
; GETSTU is an alternate entry that raises case of input.
GETSTR: SKIPA B,[RD%BEL!RD%CRF!^D156] ; No raise by default
GETSTU: MOVX B,RD%BEL!RD%CRF!RD%RAI!^D156 ; 156 chars max
STKVAR <<ACSTRG,2>> ; Place to save acs
HRLI A,440700 ; Make it a real pointer
DMOVEM A,ACSTRG ; Save the acs
DMOVE B,CCSTRG ; Save them
XORI B,140000 ; Prevent lf from echoing literally
TRO C,600000 ; Simulate format action for escape
MOVEI A,.CTTRM ; Controlling terminal
SFCOC% ; Reset it
MOVEI B,.MOSLW ; Set terminal line width
MOVE C,WIDTH ; To old value
MTOPR%
SETZ B, ; Line and column zero
SFPOS% ; Set file position
MOVE A,ACSTRG ; Restore the pointer
PSOUT% ; Type the string
MOVEI A,.CTTRM ; Get terminal
RFPOS% ; Read our new position
HRRZ C,B ; Isolate column
DMOVE A,ACSTRG ; Get pointer again
SUB B,C ; Subtract length of prompt
MOVE C,A ; Copy for re-prompt
HRROI A,SPARE ; Storage
RDTTY% ; Read the input
SSTERR (<RDTTY% Jsys failure>,EXIT)
TXNN B,RD%BTM ; Break terminated input?
IBP A ; No, so move over one
SETZ B, ; Clear an ac
DPB B,A ; And terminate the string
MOVEI A,.CTTRM ; This terminal
DMOVE B,CCSTRG ; Get old modes
SFCOC% ; Restore them
MOVEI B,.MOSLW ; Set width
SETZ C, ; To zero again
MTOPR%
RET ; Done
;Ermsg routine - type an error message in the workspace unless we're
; in expert mode. Ermsa entry is for a message that is always typed.
ERMSG: SKIPE EXPERT ; Are we expert?
RET ; Yes
ERMSA: PUSH P,A ; Save string pointer
CALL WRKSPC ; Clear a workspace area
CALL SPCON ; On with effects
POP P,A ; Restore string pointer
PSOUT% ; Type it
MOVEI A,HLDTIM ; Time to wait
DISMS% ; Sleep before returning
CALL SPCOFF ; Off with effects
CALL CLRWRK ; Clear work space
RET ; And return
;End of program
END