Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/techea.mac
There are 3 other files named techea.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1980 Stevens Institute of Technology, Hoboken, New Jersey
; 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1136 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(HEA,<TECO Heathkit terminal support routines>) ; Generate the TITLE and other stuff
$CODE ; Put into code PSECT
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECHEA - Heathkit terminal support
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. Macro definitions. . . . . . . . . . . . . . . . . . . 4
; 5. Tables
; 5.1. H19 . . . . . . . . . . . . . . . . . . . . . 5
; 5.2. H19A. . . . . . . . . . . . . . . . . . . . . 6
; 6. Support routines
; 6.1. H19
; 6.1.1. Initialization routine . . . . . . . 7
; 6.1.2. Reset terminal . . . . . . . . . . . 8
; 6.1.3. XY positioning . . . . . . . . . . . 9
; 6.1.4. Delete a line feed . . . . . . . . . 10
; 6.1.5. Delete a vertical tab. . . . . . . . 11
; 6.1.6. Delete a form feed . . . . . . . . . 12
; 6.1.7. Control-U. . . . . . . . . . . . . . 13
; 6.1.8. Insert character . . . . . . . . . . 14
; 6.1.9. Type a character . . . . . . . . . . 15
; 6.1.10. Delete N lines . . . . . . . . . . . 16
; 6.1.11. Insert N lines . . . . . . . . . . . 17
; 6.1.12. Delete a character . . . . . . . . . 18
; 6.1.13. Cost initialization routine. . . . . 19
; 6.1.14. Replacement cost calculation . . . . 20
; 6.1.15. Insert cost calculation. . . . . . . 21
; 6.1.16. Delete cost calculation. . . . . . . 22
; 6.1.17. Move cost calculation. . . . . . . . 23
; 6.1.18. Delete to End of line. . . . . . . . 24
; 6.2. H19A
; 6.2.1. Delete the end of line . . . . . . . 25
; 6.2.2. Initialization routine . . . . . . . 26
; 6.2.3. Reset terminal . . . . . . . . . . . 27
; 6.2.4. XY positioning . . . . . . . . . . . 28
; 6.2.5. Delete a line feed . . . . . . . . . 29
; 6.2.6. Delete a vertical tab. . . . . . . . 30
; 6.2.7. Delete a form feed . . . . . . . . . 31
; 6.2.8. Control-U. . . . . . . . . . . . . . 32
; 6.2.9. Insert character . . . . . . . . . . 33
; 6.3. H1A
; 6.3.1. Type a character . . . . . . . . . . 34
; 6.4. H19A
; 6.4.1. Delete N lines . . . . . . . . . . . 35
; 6.4.2. Insert N lines . . . . . . . . . . . 36
; 6.4.3. Delete a character . . . . . . . . . 37
; 6.4.4. Cost initialization routine. . . . . 38
; 6.4.5. Replacement cost calculation . . . . 39
; 6.4.6. Insert cost calculation. . . . . . . 40
; 6.4.7. Delete cost calculation. . . . . . . 41
; 6.4.8. Insert line cost calculation . . . . 42
; 6.4.9. Delete line cost calculation . . . . 43
; 6.4.10. Move cost calculation. . . . . . . . 44
; 7. Low segment for TECHEA . . . . . . . . . . . . . . . . 45
; 8. End of TECHEA. . . . . . . . . . . . . . . . . . . . . 46
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1011 By: Nick Bush On: 6-August-1980
Fix the positioning cost routine to include the use of a tab for
the forward movement.
Modules: TECHEA
1067 By: Robert McQueen/Nick Bush On: 6-January-1981
The cost algorithms where wrong for a few cases (ANSII mode positioning
only). Fix them.
Modules: TECDEC,TECHEA,TECTEK
Start of Version 200A(1126)
1136 By: Nick Bush On: 1-January-1982
Don't use a tab to address past column 72 on H-19's. They only move one
space per tab at that point.
Modules: TECHEA
|
SUBTTL Macro definitions
; Macro to define a word of five characters
DEFINE TB(A<.CHNUL>,B<.CHNUL>,C<.CHNUL>,D<.CHNUL>,E<.CHNUL>)
< BYTE (7)A,B,C,D,E>
SUBTTL Tables -- H19
; Heathkit H19 (CHEAP) terminal (VT52 compat mode)
CRTINI VH19
CRTENT INT,<PUSHJ P,H19INT> ; Initialize the terminal handling
CRTENT WID,^D79 ; 80 by
CRTENT LIN,^D24 ; 25 lines
CRTENT CIN,<PUSHJ P,H19CIN> ; Cost initialization
CRTENT CRP,<PUSHJ P,H19CRP> ; Cost of replace character
CRTENT CIC,<PUSHJ P,H19CIC> ; Cost of insert character
CRTENT CDC,<PUSHJ P,H19CDC> ; Cost of delete character
CRTENT CIL,<MOVX T1,<<INSVL.($OPICH,CS$OPR)>!<INSVL.(2,CS$CST)>>> ; Cost of insert line
CRTENT CDL,<MOVX T1,<<INSVL.($OPDCH,CS$OPR)>!<INSVL.(2,CS$CST)>>> ; Cost of delete line
CRTENT CPP,<PUSHJ P,H19CPP> ; Cost of point to point move
CRTENT BCK,<TB(.CHCNH)>
CRTENT SPC,<TB(.CHESC,"C")>
CRTENT DBS,<TB(" ",.CHCNH)>
CRTENT DLF,<PUSHJ P,H19DLF> ; Delete a line feed
CRTENT DVT,<PUSHJ P,H19DVT> ; Delete a vertical tab
CRTENT DFF,<PUSHJ P,H19DFF> ; Delete a form feed
CRTENT CRB,<TB(.CHCNH)>
CRTENT CTU,<PUSHJ P,H19CTU> ; Routine to do control U processing
CRTENT FIN,<PUSHJ P,H19FIN>
CRTENT ERS,<TB(.CHESC,"E")>
CRTENT DEL,<PUSHJ P,H19DEL> ; Routine to delete to the end of a line
CRTENT DSP,.CHSPC
CRTENT INL,<PUSHJ P,H19INL> ; Routine to insert lines
CRTENT DLL,<PUSHJ P,H19DLL> ; Routine to delete lines
CRTENT TCH,<PUSHJ P,H19TCH> ; Type a character
CRTENT DCH,<PUSHJ P,H19DCH> ; Routine to delete a character
CRTENT ICH,<PUSHJ P,H19ICH> ; Routine to insert a character
CRTENT XYP,<PUSHJ P,H19XY> ; Routine to do XY positioning
CRTENT CDE,<MOVEI T1,2> ; Cost of 2
CRTEND
SUBTTL Tables -- H19A
; H19 - ANSI mode
CRTINI VH19A
CRTENT INT,<PUSHJ P,H1AINT> ; Initialize the terminal handling
CRTENT WID,^D79 ; 80 wide by
CRTENT LIN,^D24 ; 25 lines long (H-19)
CRTENT BCK,<TB(.CHCNH)> ; Back cursor (non-destructive)
CRTENT CIN,<PUSHJ P,H1ACIN> ; Cost initialization
CRTENT CRP,<PUSHJ P,H1ACRP> ; Cost of replace character
CRTENT CIC,<PUSHJ P,H1ACIC> ; Cost of insert character
CRTENT CDC,<PUSHJ P,H1ACDC> ; Cost of delete character
CRTENT CIL,<PUSHJ P,H1ACIL> ; Cost of insert line
CRTENT CDL,<PUSHJ P,H1ACDL> ; Cost of delete line
CRTENT CPP,<PUSHJ P,H1ACPP> ; Cost of point to point move
CRTENT SPC,<TB(.CHESC,"[","C")> ; Forward cursor (non-destructive)
CRTENT DBS,<TB(" ",.CHCNH)> ; String to delete a character
CRTENT DLF,<PUSHJ P,H1ADLF> ; Routine to delete a line feed
CRTENT DVT,<PUSHJ P,H1ADVT> ; Routine to delete a veritcal tab
CRTENT DFF,<PUSHJ P,H1ADFF> ; Routine to delete a form feed
CRTENT CRB,<TB(.CHCNH)> ; String to cancel effect of rubout
CRTENT CTU,<PUSHJ P,H1ACTU> ; String to delete entire line
CRTENT FIN,<PUSHJ P,H1AFIN> ; String to put cursor home
CRTENT ERS,<TB(.CHESC,"[","2","J")> ; String to home and erase screen
CRTENT DEL,<PUSHJ P,H1ADEL> ; String to delete to end of line
CRTENT DSP,.CHSPC ; Destructive forward space
CRTENT INL,<PUSHJ P,H1AINL> ; Routine to insert lines
CRTENT DLL,<PUSHJ P,H1ADLL> ; Routine to delete lines
CRTENT DCH,<PUSHJ P,H1ADCH> ; Routine to delete a character
CRTENT ICH,<PUSHJ P,H1AICH> ; Routine to insert a character
CRTENT TCH,<PUSHJ P,H1ATCH> ; Routine to type a character
CRTENT XYP,<PUSHJ P,H1AXY> ; XY positioning instruction
CRTENT CDE,<MOVEI T1,3> ; Cost of 3
CRTEND
SUBTTL Support routines -- H19 -- Initialization routine
;+
;.HL1 H19INT
;This routine will initialize the terminal handling routines for the
;specific terminal. It will also initialize the H19 terminal
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRINT(CRT)
; (Return)
;
;.end literal
;-
H19INT: SETZM INSFLG ; Flag not in insert mode
MOVEI T1,[$STRING(<^A[?2hOx1>)] ; Get the string to put terminal
; in VT-52 mode, not insert
PJRST SC$STR ; And output it
SUBTTL Support routines -- H19 -- Reset terminal
;+
;.HL1 H19FIN
;This routine will reset the terminal to set up for exiting from
;TECO.
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRFIN(CRT)
; (Return)
;
;.end literal
;-
H19FIN: SKIPN INSFLG ; In insert mode?
POPJ P, ; No, just return
SETZM INSFLG ; Flag not in insert mode
MOVX T1,<BYTE(7).CHESC,"O"> ; Get string to take out of insert mode
PJRST SC$STR ; And output it
SUBTTL Support routines -- H19 -- XY positioning
;+
;.HL H19XY
;This routine will do the positioning for the Heathkit H19 terminal.
;.literal
;
; Usage:
; MOVE X,X.postion
; MOVE Y,Y.postion
; MOVE CRT,CRT.block.index
; PUSHJ P,@$CRXYP(CRT)
; (Return)
;
;.end literal
;-
H19XY: $SAVE <X,Y> ; Save the args
DMOVE T1,CURPOS ; Get the current position
DMOVEM X,CURPOS ; Save the current position
SUB T1+$OFSX,X ; Determine if it is an up/down/right/left by one
SUB T1+$OFSY,Y ; movement
SKIPE T1+$OFSX ; Is the X zero ?
SKIPN T1+$OFSY ; Or the Y ?
SKIPA ; Yes - Handle differently
JRST H19XYA ; No - Handle normally
SKIPN T1+$OFSY ; No change in the Y offset ?
JUMPE X,H19XYC ; Yes - Only need a CR
MOVM T3,T1+$OFSX ; Get the X offset
SOJE T3,H19XYX ; Just X by one
MOVM T3,T1+$OFSY ; Get the Y offset
SOJE T3,H19XYY ; Just the Y by one
JUMPE T1+$OFSX,H19XYA ; If X change is zero, must do full address
TXNE X,7 ; Heading for a tab stop?
JRST H19XYA ; No, must do full address
JUMPG T1,H19XYA ; Going forward?
CAXG X,^D72 ; Can't use tabs past column 72
CAXGE T1,-^D8 ; Yes, is it the next tab stop?
JRST H19XYA ; No, do the full address
$SAVE <CH> ; Yes, save CH
MOVX CH,.CHTAB ; Get a tab
PJRST SC$IMG ; And type it
H19XYA: SKIPN X ; Is this non-zero ?
JUMPE Y,H19XYH ; Just home it
ADDX X," " ; Convert to a position
ADDX Y," " ; Convert to a position
MOVEI T1,[$STRING(<Y^8/Y/^8/X/>)]
PJRST SC$STR ; Output the string
; Here to just home the cursor
H19XYH: MOVX T1,<BYTE (7).CHESC,"H"> ; Get the home string
PJRST SC$STR ; Send it
; Here to just output a CR
H19XYC: $SAVE <CH> ; Save current character
MOVX CH,.CHCRT ; Just output a CR
PJRST SC$IMG ; . . .
; Here to move in the X direction by one
H19XYX: SKIPGE T1+$OFSX ; Is this negative ?
SKIPA T1,[BYTE (7).CHESC,"C"] ; No - To the right
MOVX T1,<BYTE(7).CHCNH> ; Yes, use a backspace
PJRST SC$STR ; Output the string
; Here to move in the Y direction by one
H19XYY: CAXN Y,^D25-1 ; Going to the 25th line?
JRST H19XYA ; Yes, have to use the direct addressing
SKIPL T1+$OFSY ; Is this negative ?
SKIPA T1,[BYTE (7).CHESC,"A"] ; No - Move up
MOVX T1,<BYTE(7).CHLFD> ; Yes, move down with a line feed
PJRST SC$STR ; Output the string
SUBTTL Support routines -- H19 -- Delete a line feed
;+
;.HL1 H19DLF
;This routine will send the character string to delete a line feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,@$CRDLF(CRT)
; (Return)
;.end literal
;-
H19DLF: MOVX T1,<BYTE (7).CHESC,"A"> ; Get the string
PJRST SC$STR ; And output it
SUBTTL Support routines -- H19 -- Delete a vertical tab
;+
;.HL1 H19DVT
;This routine will send the character string to delete a vertical tab.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,@$CRDVT(CRT)
; (Return)
;
;.end literal
;-
H19DVT: $SAVE <P1> ; Save P1
MOVX P1,4 ; Get the number of times to repeat
H19CMN: MOVX T1,<BYTE (7).CHESC,"A"> ; Get the string
PUSHJ P,SC$STR ; Output the string
SOJG P1,H19CMN ; Loop until done
POPJ P, ; Return to the caller
SUBTTL Support routines -- H19 -- Delete a form feed
;+
;.HL1 H19DFF
;This routine will send the character string to delete a form feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,$CRDFF(CRT)
; (Return)
;
;.end literal
;-
H19DFF: $SAVE <P1> ; Save P1
MOVX P1,10 ; Get the number of times to repeat
PJRST H19CMN ; Go to the common routine
SUBTTL Support routines -- H19 -- Control-U
;+
;.HL1 H19CTU
;This routine will process the control U in the command parser. It
;may be called without CRT being set up.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,@$CRCTU(CRT)
; (Return)
;
;.end literal
;-
H19CTU: MOVX T1,<BYTE(7).CHESC,"l"> ; Get the characters
; Here from either H19CTU or H1ACTU with string in T1
CTUFIN: PUSHJ P,SC$STR ; Output them
MOVX CH,.CHCRT ; And the free carriage return
PJRST T$OCHR ; Output it
SUBTTL Support routines -- H19 -- Insert character
;+
;.HL H19ICH
;This routine will cause a character to be inserted. It is called
;with the character. It is assumed that the positioning has been done
;before this routine is called.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRICH(CRT)
;
;.end literal
;-
H19ICH: SKIPE INSFLG ; In insert mode ?
PJRST SC$CHR ; Yes, then just type it
PUSH P,T1 ; Save T1
MOVX T1,<BYTE (7).CHESC,"@"> ; Enter insert mode string
PUSHJ P,SC$STR ; Type the string
POP P,T1 ; Restore T1
SETOM INSFLG ; Flag we are now in insert mode
PJRST SC$CHR ; Type the character
SUBTTL Support routines -- H19 -- Type a character
;+
;.HL1 H19TCH
;This routine will type a character on the terminal. It will first check
;to see if the terminal is in insert character mode and take it out if it
;is in insert character mode.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRTCH(CRT)
; (Return)
;
;.end literal
;-
H19TCH: SKIPN INSFLG ; In insert character mode ?
PJRST SC$CHR ; No - Type the character
PUSH P,T1 ; Save T1
MOVX T1,<BYTE (7).CHESC,"O"> ; Get the string
PUSHJ P,SC$STR ; Type the string
POP P,T1 ; And return
SETZM INSFLG ; Not in insert mode now
PJRST SC$CHR ; Type the character
SUBTTL Support routines -- H19 -- Delete N lines
;+
;.HL1 H19DLL
;This routine will cause N lines to be deleted from the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRDLL(CRT)
; (Return)
;
;.end literal
;-
H19DLL: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the repeat count
H19DL0: MOVX T1,<BYTE (7).CHESC,"M"> ; Get the text to send
PUSHJ P,SC$STR ; Output the string
SOJG P1,H19DL0 ; Loop for all the lines
POPJ P, ; Return
SUBTTL Support routines -- H19 -- Insert N lines
;+
;.HL1 H19INL
;This routine will cause N lines to be inserted on the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRINL(CRT)
; (Return)
;
;.end literal
;-
H19INL: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the count
H19IN0: MOVX T1,<BYTE (7).CHESC,"L"> ; Get the text to send
PUSHJ P,SC$STR ; Output the string
SOJG P1,H19IN0 ; Loop for all the lines
POPJ P, ; Return to the caller
SUBTTL Support routines -- H19 -- Delete a character
;+
;.HL1 H19DCH
;This routine will cause n characters to be deleted from the screen.
;It is assumed that all cursor positioning has been done before this
;routine is called.
;.literal
;
; Usage:
; MOVX T1,Number.of.character.to.delete
; MOVEI CRT,CRT.block.address
; XCT $CRDCH(CRT)
; (Return)
;
;.end literal
;-
H19DCH: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the value
H19CI0: MOVX T1,<BYTE (7).CHESC,"N"> ; Get the string to delete a char
PUSHJ P,SC$STR ; Type it
SOJG P1,H19CI0 ; Loop back
POPJ P, ; Return to the caller
SUBTTL Support routines -- H19 -- Cost initialization routine
;+
;.hl 1 H19CIN
; This routine will return the initial cost word for the character
;by character comparison of a line.
;.b.lit
;
; Usage:
; MOVE CRT,CRTTYP
; PUSHJ P,@$CRCIN(CRT) or XCT $CRCIN(CRT)
; (return, first array element in T1)
;
;.end literal
;-
CS$INS==1 ; Term dependent info - terminal in insert mode
H19CIN: MOVX T1,<INSVL.(0,CS$DEP)>!<INSVL.($OPACH,CS$OPR)>
SKIPE INSFLG ; In insert mode?
MOVX T1,<INSVL.(CS$INS,CS$DEP)>!<INSVL.($OPACH,CS$OPR)>
POPJ P, ; Return the cost word
SUBTTL Support routines -- H19 -- Replacement cost calculation
;+
;.hl 1 H19CRP
; This routine will return the cost of replacing a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVE X,[-n,,Column]
; MOVE Y,[-n,,Row]
; MOVE CRT,CRTTYP
; XCT $CRCRP(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H19CRP: MOVE T2,T1 ; Copy the old word
MOVX T1,<<INSVL.($OPRCH,CS$OPR)>!<INSVL.(1,CS$CST)>> ; Get the operation
TXNN T2,<INSVL.(CS$INS,CS$DEP)> ; Check if in insert mode
POPJ P, ; No, return now
STORI. 3,T2,CSTCST,+T1 ; Store the cost if we are coming from insert mode
POPJ P, ; And return
SUBTTL Support routines -- H19 -- Insert cost calculation
;+
;.hl 1 H19CIC
; This routine will return the cost of inserting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVE X,[-n,,Column]
; MOVE Y,[-n,,Row]
; MOVE CRT,CRTTYP
; XCT $CRCIC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H19CIC: MOVE T2,T1 ; Get a copy of the old entry
MOVX T1,<<INSVL.(CS$INS,CS$DEP)>!<INSVL.($OPICH,CS$OPR)>!<INSVL.(1,CS$CST)>>
TXNE T2,<INSVL.(CS$INS,CS$DEP)> ; Already in insert mode?
POPJ P, ; Yes, return
STORI. 3,T2,CSTCST,+T1 ; Store the cost if we must put into insert mode
POPJ P, ; And return
SUBTTL Support routines -- H19 -- Delete cost calculation
;+
;.hl 1 H19CDC
; This routine will return the cost of deleting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVE X,[-n,,Column]
; MOVE Y,[-n,,Row]
; MOVE CRT,CRTTYP
; XCT $CRCDC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H19CDC: ANDX T1,CS$DEP ; Keep only the dependant portion
TXO T1,<<INSVL.($OPDCH,CS$OPR)>!<INSVL.(2,CS$CST)>> ; Store the operation
POPJ P, ; And return
SUBTTL Support routines -- H19 -- Move cost calculation
;+
;.hl 1 H19CPP
; This routine will return the cost of moving the cursor from
;one point to another.
;.b.lit
;
; Usage:
; MOVE T1,[XWD X pos,Y pos] ; Source position
; MOVE X,[-n,,Column]
; MOVE Y,[-n,,Row]
; MOVE CRT,CRTTYP
; XCT $CRCPP(CRT)
; (return, T1= cost in characters)
;
;.end literal
;-
H19CPP: MOVE T3,T2 ; Get a copy of where we are moving to
XOR T3,T1 ; Xor together
JUMPE T3,.RET0 ; Return a zero if not moving
TXNN T3,LH.ALF ; Same X position line ?
JRST H19CPY ; Yes - Check more
TXNN T3,RH.ALF ; Same Y position ?
JRST H19CPX ; Yes - Check more
JUMPE T2,.RET2 ; If moving home return cost of two
H19CPA: MOVX T1,4 ; Have to type four characters
POPJ P, ; Return
; Here if possible same column movement
H19CPY: MOVEI T2,(T2) ; Get just the Y position
SUBI T2,(T1) ; Determine if just one line movement
MOVM T1,T2 ; . . .
SOJG T1,H19CPA ; Go return the full position cost
JUMPL T2,.RET2 ; If less than zero return two
JRST .RET1 ; Else return one
; Here if possible same line movement
H19CPX: HLRZ T2,T2 ; Get just the X position
JUMPE T2,.RET1 ; If moving to the beginning of the line
; then return one
HLRZ T1,T1 ; See if moving only one position
SUBI T1,(T2) ; . . .
MOVM T3,T1 ; Get the magntude
JUMPG T1,H19CPZ ; Moving forward?
CAXL T1,-^D8 ; Less than a tab stop?
TXNE T2,7 ; And ending on a tab stop?
JRST H19CPZ ; No, check other posibilities
PJRST .RET1 ; Yes, return a one
H19CPZ: SOJG T3,H19CPA ; If more than one - return four
JUMPL T1,.RET1 ; If backing up then only one
JRST .RET2 ; Else return two
SUBTTL Support routines -- H19 -- Delete to End of line
;+
;.hl1 H19DEL
;This routine will delete to the end of the line.
;.literal
;
; Usage:
; MOVEI T1,# of characters to delete
; XCT $CRDEL(CRT)
;
;.end literal
;-
H19DEL: MOVX T1,<BYTE (7) .CHESC,"K">
PJRST SC$STR ; Print out the string
SUBTTL Support routines -- H19A -- Delete the end of line
;+
;.hl1 H1ADEL
;This routine will delete to the end of the line.
;.literal
;
; Usage:
; MOVEI T1,# of characters to delete
; XCT $CRDEL(CRT)
;
;.end literal
;-
H1ADEL: MOVX T1,<BYTE (7).CHESC,"[","K">
PJRST SC$STR ; Print it out
SUBTTL Support routines -- H19A -- Initialization routine
;+
;.HL1 H1AINT
;This routine will initialize the terminal handling routines for the
;specific terminal. It will also initialize the H19A terminal
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRINT(CRT)
; (Return)
;
;.end literal
;-
H1AINT: SETZM INSFLG ; Flag not in insert mode
MOVEI T1,[$STRING(<^A[4l[^R1h>)] ; Put in ANSI mode, not insert
PJRST SC$STR ; Output the string
SUBTTL Support routines -- H19A -- Reset terminal
;+
;.HL1 H1AFIN
;This routine will reset the terminal to set up for exiting from
;TECO.
;.literal
;
; Usage:
; MOVEI CRT,CRT.block.address
; XCT $CRFIN(CRT)
; (Return)
;
;.end literal
;-
H1AFIN: SKIPN INSFLG ; In insert mode?
POPJ P, ; No, just return
SETZM INSFLG ; Flag not in insert mode
MOVX T1,<BYTE(7).CHESC,"[","4","l"> ; Get string to take out of insert mode
PJRST SC$STR ; And output it
SUBTTL Support routines -- H19A -- XY positioning
;+
;.hl1 H19XY
;This routine will do the positioning for the Heathkit H19 (ANSI mode) terminal.
;.literal
;
; Usage:
; MOVE X,X.postion
; MOVE Y,Y.postion
; MOVE CRT,CRT.block.index
; XCT $CRXYP(CRT)
; (Return)
;
;.end literal
;-
H1AXY: ; H19 in ANSI mode
$SAVE <X,Y> ; Save X and Y
DMOVE T1,CURPOS ; Get the current position
DMOVEM X,CURPOS ; Save the current position
SUB T1+$OFSX,X ; Determine if it is an up/down/right/left by one
SUB T1+$OFSY,Y ; movement
SKIPE T1+$OFSX ; Is the X zero ?
SKIPN T1+$OFSY ; Or the Y ?
SKIPA ; Yes - Handle differently
JRST H1AXYA ; No - Handle normally
JUMPN T1+$OFSX,H1AXYX ; Just moving in the X direction
JUMPN T1+$OFSY,H1AXYY ; Just moving in the Y direction
POPJ P, ; If we get here, we don't have to move at all
; Here to do a full address
H1AXYA: SKIPN X ; Going home?
JUMPE Y,H1AXYH ; . . .
ADDI X,1 ; Bump both of the coordinates so home is 1,1
ADDI Y,1 ; . . .
MOVEI T1,[$STRING(<[^D/Y/;^D/X/H>)] ; Get the string address
PJRST SC$STR ; And go position the cursor
; Here if we are just going to home the cursor
H1AXYH: MOVX T1,<BYTE (7).CHESC,"[","H"> ; Get the string
PJRST SC$STR ; Type the string
; Here to move only in the X direction
H1AXYX: TXNE X,7 ; Heading for a tab stop?
JRST HAXY.9 ; No, do normal movement
JUMPG T1,HAXY.9 ; Going forward?
CAXG X,^D72 ; Tabs don't work past column 72
CAXGE T1,-^D8 ; Yes, is it the next tab stop?
JRST HAXY.9 ; No, do the full address
$SAVE <CH> ; Yes, save CH
MOVX CH,.CHTAB ; Get a tab
PJRST SC$IMG ; And type it
; Here if we are not going to a tab stop
HAXY.9: MOVM X,T1 ; Get the number of spaces to move
CAXN X,1 ; Only one space?
JRST H1AX.1 ; Yes, go handle it
SKIPL T1+$OFSX ; Load the offset and check the string
SKIPA T1,[[$STRING(<[^D/X/D>)]] ; Get the string to type
MOVEI T1,[$STRING(<[^D/X/C>)] ; Get the other way
PJRST SC$STR ; Output the string
; Here to move in the X direction one position
H1AX.1: SKIPG T1 ; Backwards
SKIPA T1,[BYTE(7).CHESC,"[","C"] ; Go forward one
MOVX T1,<BYTE(7).CHCNH> ; Go backwards one
PJRST SC$STR ; Go output the string
; Here to move only in the Y direction
H1AXYY: CAXN Y,^D25-1 ; Going to the extra line?
JRST H1AXYA ; Yes, use direct addressing
MOVM Y,T1+$OFSY ; Get the number to move
CAXN Y,1 ; Only one line?
JRST H1AY.1 ; Yes, go handle it
SKIPL Y,T1+$OFSY ; Is this negative ?
SKIPA T1,[[$STRING(<[^D/Y/A>)]] ; No - Move up
MOVEI T1,[$STRING(<[^D/Y/B>)] ; Yes - Move down
MOVMS Y ; Make this positive
PJRST SC$STR ; Output the string
; Here to move one position in the Y direction
H1AY.1: SKIPL T2 ; Up or down?
SKIPA T1,[BYTE(7).CHESC,"[","A"] ; Up, use escape seqeunce
MOVX T1,<BYTE(7).CHLFD> ; Down, use a line feed
PJRST SC$STR ; All done
SUBTTL Support routines -- H19A -- Delete a line feed
;+
;.HL1 H1ADLF
;This routine will send the character string to delete a line feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; XCT $CRDLF(CRT)
; (Return)
;.end literal
;-
H1ADLF: MOVX T1,<BYTE (7).CHESC,"[","A">
PJRST SC$STR ; Output the string
SUBTTL Support routines -- H19A -- Delete a vertical tab
;+
;.HL1 H1ADVT
;This routine will send the character string to delete a vertical tab.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; XCT $CRDVT(CRT)
; (Return)
;
;.end literal
;-
H1ADVT: MOVX T1,<BYTE (7).CHESC,"[","4","A">
PJRST SC$STR ; Output the string
SUBTTL Support routines -- H19A -- Delete a form feed
;+
;.HL1 H1ADFF
;This routine will send the character string to delete a form feed.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; PUSHJ P,$CRDFF(CRT)
; (Return)
;
;.end literal
;-
H1ADFF: MOVX T1,<BYTE (7).CHESC,"[","8","A">
PJRST SC$STR ; Output the string
SUBTTL Support routines -- H19A -- Control-U
;+
;.HL1 H1ACTU
;This routine will process the control U in the command parser. It
;may be called without CRT being set up.
;.literal
;
; Usage:
; MOVE CRT,CRT.block.address
; XCT $CRCTU(CRT)
; (Return)
;
;.end literal
;-
H1ACTU: MOVX T1,<BYTE(7).CHESC,"[","2","K"> ; Get the string
PJRST CTUFIN ; And go finish it up
SUBTTL Support routines -- H19A -- Insert character
;+
;.HL H1AICH
;This routine will cause a character to be inserted. It is called
;with the character. It is assumed that the positioning has been done
;before this routine is called.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRICH(CRT)
;
;.end literal
;-
H1AICH: SKIPE INSFLG ; In insert mode ?
PJRST SC$CHR ; Yes, Just type the character
PUSH P,T1 ; Save T1
MOVX T1,<BYTE (7).CHESC,"[","4","h"> ; Get the string to enter insert mode
PUSHJ P,SC$STR ; Type the string
POP P,T1 ; Restore T1
SETOM INSFLG ; Flag in insert mode now
PJRST SC$CHR ; Type it
SUBTTL Support routines -- H1A -- Type a character
;+
;.HL1 H1ATCH
;This routine will type a character on the terminal. It will first check
;to see if the terminal is in insert character mode and take it out if it
;is in insert character mode.
;.literal
;
; Usage:
; MOVX CH,Character
; MOVEI CRT,CRT.block.address
; XCT $CRTCH(CRT)
; (Return)
;
;.end literal
;-
H1ATCH: SKIPN INSFLG ; In insert character mode ?
PJRST SC$CHR ; No - Type the character
PUSH P,T1 ; Save T1
MOVX T1,<BYTE (7).CHESC,"[","4","l"> ; Get the string
PUSHJ P,SC$STR ; Type the string
POP P,T1 ; Restore T1
SETZM INSFLG ; Not in insert mode now
PJRST SC$CHR ; Type the character
SUBTTL Support routines -- H19A -- Delete N lines
;+
;.HL1 H1ADLL
;This routine will cause N lines to be deleted from the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRDLL(CRT)
; (Return)
;
;.end literal
;-
H1ADLL: $SAVE <P1> ; Save the repeat count
MOVE P1,T1 ; Copy the number of times
CAXE P1,1 ; Is this only one ?
SKIPA T1,[[$STRING(<[^D/P1/M>)]] ; Get the text
MOVX T1,<BYTE (7).CHESC,"[","M"> ; Get the other text
PUSHJ P,SC$STR ; Output the text
SETZ X, ; At right margin now
DMOVEM X,CURPOS ; Remember where we are
POPJ P, ; Return
SUBTTL Support routines -- H19A -- Insert N lines
;+
;.HL1 H1AINL
;This routine will cause N lines to be inserted on the screen. It is
;called with a repeat count.
;.literal
;
; Usage:
; MOVEI T1,Repeat.count
; MOVEI CRT,CRT.block.address
; XCT $CRINL(CRT)
; (Return)
;
;.end literal
;-
H1AINL: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the repeat count
CAXE P1,1 ; Is there only one item ?
SKIPA T1,[[$STRING(<[^D/P1/L>)]] ; Get the string
MOVX T1,<BYTE (7).CHESC,"[","L"> ; Or the shorter string
PUSHJ P,SC$STR ; Output the string and return
SETZ X, ; At right column now
DMOVEM X,CURPOS ; Remember it
POPJ P, ; And return
SUBTTL Support routines -- H19A -- Delete a character
;+
;.HL1 H1ADCH
;This routine will cause n characters to be deleted from the screen.
;It is assumed that all cursor positioning has been done before this
;routine is called.
;.literal
;
; Usage:
; MOVX T1,Number.of.character.to.delete
; MOVEI CRT,CRT.block.address
; XCT $CRDCH(CRT)
; (Return)
;
;.end literal
;-
H1ADCH: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the number
CAXN P1,1 ; Only one character?
SKIPA T1,[BYTE(7).CHESC,"[","P"] ; Get the string for one character
MOVEI T1,[$STRING(<[^D/P1/P>)] ; Get the string to send
PJRST SC$STR ; Send the string
SUBTTL Support routines -- H19A -- Cost initialization routine
;+
;.hl 1 H1ACIN
; This routine will return the initial cost word for the character
;by character comparison of a line.
;.b.lit
;
; Usage:
; MOVE CRT,CRTTYP
; XCT $CRCIN(CRT)
; (return, first array element in T1)
;
;.end literal
;-
H1ACIN==H19CIN ; Same as VT52 mode
SUBTTL Support routines -- H19A -- Replacement cost calculation
;+
;.hl 1 H1ACRP
; This routine will return the cost of replacing a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCRP(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H1ACRP: MOVE T2,T1 ; Get the old word
MOVX T1,<<INSVL.($OPRCH,CS$OPR)>!<INSVL.(1,CS$CST)>> ; Get the basic cost
TXNN T2,<INSVL.(CS$INS,CS$DEP)> ; Check if in insert mode
POPJ P, ; No, just return
STORI. 5,T2,CSTCST,+T1 ; Yes, taking out takes 4 chars
POPJ P, ; Return the cost
SUBTTL Support routines -- H19A -- Insert cost calculation
;+
;.hl 1 H1ACIC
; This routine will return the cost of inserting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCIC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H1ACIC: MOVE T2,T1 ; Get the old word
MOVX T1,<INSVL.(CS$INS,CS$DEP)>!<INSVL.($OPICH,CS$OPR)>!<INSVL.(1,CS$CST)>
TXNE T2,<INSVL.(CS$INS,CS$DEP)> ; Already in insert mode?
POPJ P, ; Yes, just return
STORI. 5,T2,CSTCST,+T1 ; No, must put in insert mode first
POPJ P, ; Return the cost
SUBTTL Support routines -- H19A -- Delete cost calculation
;+
;.hl 1 H1ACDC
; This routine will return the cost of deleting a character in the
;line.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCDC(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H1ACDC: $SAVE <P1,P2,P3> ; Save some room
LOAD. P1,CSTOPR,+T1 ; Get the last operation
LOAD. P2,CSTRPT,+T1 ; And the repeat count
MOVEI P3,1 ; Get the basic cost
ANDX T1,CS$DEP ; Keep only dependant portion
TXO T1,<INSVL.($OPDCH,CS$OPR)>!<INSVL.(3,CS$CST)> ; Store the operation
CAXE P1,$OPDCH ; Was the last operation the same?
POPJ P, ; No, return now
AOJ P2, ; Add one to the repeat count
CAXN P2,2 ; Is this the second delete?
AOJ P3, ; Yes, bump the cost
CAXN P2,^D10 ; Is it the first that requires two digits?
AOJ P3, ; Yes, bump the cost
STOR. P3,CSTCST,+T1 ; Store the cost
POPJ P, ; And return
SUBTTL Support routines -- H19A -- Insert line cost calculation
;+
;.hl 1 H1ACIL
; This routine will return the cost of inserting a line in the
;screen.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCIL(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H1ACIL: LOAD. T2,CSTOPR,+T1 ; Get the previous operation
CAXE T2,$OPICH ; Already inserting?
JRST [MOVX T1,<<INSVL.($OPICH,CS$OPR)>!<INSVL.(3,CS$CST)>>
POPJ P,] ; Return a three for the initial cost
H1ACID: LOAD. T2,CSTRPT,+T1 ; Get the number of inserts already done
ANDX T1,CS$OPR ; Keep only the operation
SETZ T3, ; Clear basic cost
CAIN T2,1 ; Going to first insert that needs a digit?
AOJ T3, ; Yes, count the first digit
CAIN T2,^D9 ; First that requires two digits?
AOJ T3, ; Yes, count that
STOR. T3,CSTCST,+T1 ; Store the cost
POPJ P, ; And return
SUBTTL Support routines -- H19A -- Delete line cost calculation
;+
;.hl 1 H1ACDL
; This routine will return the cost of deleting a line in the
;screen.
;.b.lit
;
; Usage:
; MOVE T1,CST entry
; MOVX X,[XWD -n,Column]
; MOVE Y,[XWD -n,Row]
; MOVE CRT,CRTTYP
; XCT $CRCDL(CRT)
; (return, T1=CST entry
;
;.end literal
;-
H1ACDL: CFXN. T2,CSTOPR,+T1,$OPDCH ; Last operation a delete?
JRST H1ACID ; Yes, go calculate any extra cost
MOVX T1,<<INSVL.($OPDCH,CS$OPR)>!<INSVL.(3,CS$CST)>> ; Get the initial cost
POPJ P, ; And return it
SUBTTL Support routines -- H19A -- Move cost calculation
;+
;.hl 1 H1ACPP
; This routine will return the cost of moving the cursor from
;one point to another.
;.b.lit
;
; Usage:
; MOVE T1,[XWD X pos,Y pos] ; Source position
; MOVE T2,[XWD X pos,Y pos]
; MOVE CRT,CRTTYP
; XCT $CRCPP(CRT)
; (return, T1= cost in characters)
;
;.end literal
;-
H1ACPP: CAMN T1,T2 ; Really moving somewhere?
PJRST .RET0 ; No, return a zero
HRRZ T3,T1 ; Get the X positions
HRRZ T4,T2 ; Of both
HLRZ T1,T1 ; Keep only the Y positions
HLRZ T2,T2 ; . . .
CAIE T3,(T4) ; Same line?
JRST HACP.1 ; No, go check for same column
JUMPE T2,.RET1 ; Going to column 0 takes only 1 char
MOVE T3,T2 ; Get the destination column
SUB T2,T1 ; Get the dest-source positions
MOVE T4,T1 ; Get the destination column
MOVM T1,T2 ; Get the magnitude
JUMPL T2,HACP.3 ; Skip if going backwards
; Check if we can use a tab
TXNN T3,7 ; Going to a tab stop?
CAXLE T1,^D8 ; Yes, is it the next one?
JRST HACP.4 ; No, figure out how many chars it will take
PJRST .RET1 ; Yes, return a one
; Here for either a forward cursor or an up cursor
HACP.4: MOVEI T1,3 ; Assume simple case of one char
CAIE T2,1 ; Is it?
AOJ T1, ; No, need at least one more
HACP.0: CAIL T2,^D10 ; Need two digits
AOJ T1, ; Yes, count the second
POPJ P, ; And return
; Here if position is on the same line before current position
; or is in the same column, but below the current line
HACP.3: MOVE T2,T1 ; Get the number of columns to move
MOVEI T1,1 ; Assume one
CAIE T2,1 ; Is it?
ADDI T1,3 ; No, need the relative movement
JRST HACP.0 ; Go count the digits we need
; Here if new position is on a different line.
HACP.1: CAIE T1,(T2) ; Same column?
JRST HACP.2 ; No, try for home
SUB T4,T3 ; Yes, get the number to move
MOVM T1,T4 ; And the magnitude
JUMPGE T4,HACP.3 ; Going down?
JRST HACP.4 ; No, go handle like forward cursor
; Here if not the same column or line
HACP.2: SKIPN T1 ; Is the destination home?
SKIPE T3 ; . . .
JRST HACP.5 ; No, go handle it
MOVEI T1,3 ; Yes, only takes two chars
POPJ P, ; All done
; Here if we must do the cursor position
HACP.5: MOVE T2,T1 ; Get the destination column
MOVEI T1,4 ; Get the basic cost
CAIL T3,^D9 ; Before line 10?
AOJ T1, ; No, takes another digit
CAIL T2,^D9 ; Before column 10
AOJ T1, ; No, another digit
POPJ P, ; All done
SUBTTL Low segment for TECHEA
$IMPURE
HEABEG:!
INSFLG: BLOCK 1 ; Flag whether we are in insert mode (0 if not)
LOWVER(HEA,<.-HEABEG>) ; Define the version number
SUBTTL End of TECHEA
END ; End of TECHEA