title	tvdraw	v5.100	err dev. installed
	a=1
	b=2
	c=3
	d=4
	e=5
	n=6
	n2=7
	x=10
	y=11
	mode=12		;0->neutral, 1->circle, 2->draw, 3->erase, 4->vector
	f=13		   ;5->quote
	p=17
	tv=2000*100
	tvend=tv+2000*10-1
	echsiz==1	;size of echo area
	tto==1
	tti==2
	dskchn==0
	neutral==0	;different modes
	circle==1
	draw==2
	erase==3
	vector==4
	blok==5
	reloct==6

	subttl	constants section
pstack:	-50,,.
	block	50

temp1:	0		;useful in various circumstances
temp2:	0

jcl:
macro:	block	20	;used for both jcl and macro definitions

held:	0		;used to store points (h and j commands)
held2:	0
new:	0		;used to hold new points
;cent:	400,,343	;used to hold current point
old:	400,,343	;used to hold previous point
delta:	0		;used to hold delta-x and delta-y
size:	40		;size of circles and the eraser
ofset:	0
inc:	100		;amount that positioning commands move by
const1:	1

crsdat:	0,,0		;data for drawing cross (cursor)
	0,,-1
	0,,1
	1,,0
	-1,,0
	-3,,0
	-2,,0		;   :
	0,,-2		;...:...
	0,,-3		;   :
	2,,0		;   '
	3,,0
	0,,2
	0,,3
crslst:	-15,,crsdat
crsls2:	-1,,crsdat
crsls3:	-4,,crsdat+1

crlfst:	asciz/*/
	subttl	common subroutines

writec:	push	p,a		;routine to output a cross (cursor)
	move	a,crslst
	pushj	p,plotpl
	pop	p,a
	popj	p,

writev:	push	p,a		;routine to draw a vector from CENT to OLD
	move	a,cent
	movem	a,temp1
	move	a,old
	movem	a,temp2
	push	p,cent
	setzm	cent
	movei	a,temp1
	pushj	p,plotv
	pop	p,cent
	pop	p,a
	popj	p,

outpnt:	skipe	prmtflg'
	popj	p,
	pushj	p,ttscrs
	pushj	p,upscml	;routine to output current point
	push	p,a
	move	a,[5,,0]
	pushj	p,ttspos
	movei	a,7
	pushj	p,ttcchr	;delete next 7 chrs. to avoid overprinting
	hlre	n,cent
	pushj	p,decout
	movei	c,",
	.iot	tto,c
	hrre	n,cent
	pushj	p,decout
	pushj	p,dnscml
	pushj	p,ttrcrs
	pop	p,a
	popj	p,

outsiz:	skipe	prmtflg
	popj	p,
	pushj	p,ttscrs
	pushj	p,upscml
	move	a,[70,,0]
	pushj	p,ttspos
	movei	a,7
	pushj	p,ttcchr
	move	n,size
	pushj	p,decout
	movei	c," 
	.iot	tto,c
	move	n,ofset	
	skipl	n
	jrst	outsz2
	movei	c,"-
	.iot	tto,c
	movn	n,n
outsz2:	pushj	p,decout
	pushj	p,dnscml
	pushj	p,ttrcrs
	popj	p,

outinc:	skipe	prmtflg
	popj	p,
	move	a,[40,,0]
	pushj	p,ttscrs
	pushj	p,upscml
	pushj	p,ttspos
	movei	a,3
	pushj	p,ttcchr
	move	n,inc
	pushj	p,decout
	pushj	p,dnscml
	pushj	p,ttrcrs
	popj	p,

decin:	setz	n,		;decin reads a decimal # from the tty.  At least one
	.iot	tti,c		;digit (or a ^c) must be read before it will return,
	cain	c,3		;after thatit returns after the first non-digit
	popj	p,
	cail	c,"0
	caile	c,"9
	jrst	decin+1
dec2:	subi	c,"0
	imuli	n,12
	add	n,c
	.iot	tti,c
	cail	c,"0
	caile	c,"9
	popj	p,
	jrst	dec2

upscml:	.call	[setz
		sixbit/scml/
		1000,,tto
		401000,,echsiz+1]
	.value
	popj	p,

dnscml:	.call	[setz
		sixbit/scml/
		1000,,tto
		401000,,echsiz]
	.value
	popj	p,

dotcmp:	push	p,pmode		;complement the dot at CENT
	movei	pmode,6
	setzb	x,y
	pushj	p,plotp
	pop	p,pmode
	popj	p,

writeb:	push	p,b
	move	a,size		;output a square
	pushj	p,plotl		;|
	move	a,size
	add	a,ofset
	hrli	a,-1		; --
	pushj	p,plotl		;|
	push	p,delta
	move	a,size
	add	a,ofset
	hrl	a,a
	hrr	a,size
	movem	a,delta
	pushj	p,addelt
	movn	a,size
	sub	a,ofset		; __
	pushj	p,plotl		;|__
	movn	a,size
	hrli	a,0		; __
	pushj	p,plotl		;|__|
	pushj	p,sbdelt
	pop	p,delta
	pop	p,b
	popj	p,

plotl:	jumpl	a,plotl2	;plot a vector that is parralell to an axis (x or y)
	hrre	a,a		;call is with a =  <0=vert. -1=horiz.>,,<#number of dots>
	skipl	a
	skipa	b,const1
	movni	b,1
	movm	a,a
	setzb	x,y
plotl4:	pushj	p,plotp
	sojl	a,plotl5
	add	y,b
	jrst	plotl4

plotl2:	hrre	a,a
	skipl	a
	skipa	b,const1
	movni	b,1
	movm	a,a
	setzb	x,y
plotl3:	pushj	p,plotp
	sojl	a,plotl5
	add	x,b
	jrst	plotl3

plotl5:	popj	p,

incvr4:	move	a,inc		;return A=INC/4
	ash	a,-2
	skipg	a
	movei	a,1
	popj	p,

usher:	skipe	prmtflg		;announce a new mode.  Basicly clear Echo area and
	popj	p,		;do an OUTSTR
	push	p,c
	pushj	p,ttclear
	pop	p,c
	pushj	p,outstr
	popj	p,

rtnold:	pushj	p,writec	;***what this hell does this do?
	move	a,old
	movem	a,cent
	pushj	p,writec
	pushj	p,outpnt
	jrst	nstart
	subttl	main program

tvdraw:	move	p,pstack	;set up stack
	.open	tti,['tty	;get tty
			0
			0]
	.value
	.open	tto,[5401,,'tty
			0
			0]
	.value
	setz	b,
	.call	[setz		;map to tv screen
		'corblk
		1000,,300000
		1000,,-1
		[-10,,100]
		1000,,-2
		setz	b]
	.value	[asciz/:?cannot get tv   :kill
/]
	.break	12,[6,,dev]
	.suset	[.rtvcreg,,palu2']
	movei	pmode,6
	pushj	p,ttclear
	pushj	p,outpnt
	pushj	p,outinc
	pushj	p,writec
	pushj	p,nstart

main:	.iot	tti,c		;main loop
	pushj	p,parser
	jrst	main

dev:	0
snam:	0
nam1:	0
nam2:	0
	subttl	command parser		uses a, b, d, e

parser:	movei	a,comlis	;called as a subroutine, it
	movei	b,comend	;performs the function as
	pushj	p,binser	;indicated by c
	popj	p,		;  not found
	hrrz	d,(d)
	jrst	(d)

binser:	move	d,a
	add	d,b
	lsh	d,-1
	hlrz	e,(d)
	camn	e,c
	jrst	binsr2
	camn	a,b
	popj	p,
	camge	e,c
	jrst	binsru
binsrd:	movei	b,-1(d)
	jrst	binser
binsru:	movei	a,1(d)
	jrst	binser
binsr2:	aos	(p)
	popj	p,		;second return, d contains winning address

comlis:	11,,taber		;list of commands,,addresses
	12,,lfder
	15,,crtner
	42,,quotst
	"*,,dotcmp
	54,,comer
	56,,doter
	"/,,slsher
	":,,clner
	";,,semer
	"<,,grow
	">,,shrink
	"?,,helper
	"A,,cngalu
	"C,,chgcrs
	"D,,disabl
	"G,,getstn
	"H,,holdr2
	"J,,jumpr2
	"M,,macrn2
	"N,,macdf2
	"Q,,quiter
	"R,,readtv
	"S,,savstn
	"W,,writtv
	"Z,,zapper
	"[,,upinc
	"],,dninc
	"^,,vstret
	"a,,abspos
	"b,,blokst
	"c,,circst
	"d,,drawst
	"e,,erasst
	"h,,holder
	"i,,ier
	"j,,jumper
	"k,,ker
	"l,,recent
	"m,,macrun
	"n,,macdef
	"o,,oer
	"p,,per
	"r,,relcst
	"t,,copier
	"v,,vectst
	"{,,upofst
	"},,dnofst
	177,,deletr
	comend=.-1
	subttl	command handlers

abspos:	skipe	prmtflg		;"a" command, set position
	jrst	absps2
	movei	c,[asciz/enter x,y coords.:  /]
	pushj	p,usher
absps2:	pushj	p,decin
	hrlm	n,new
	pushj	p,decin
	hrrm	n,new
	movei	c,12
	.iot	tto,c
	jrst	ajllst(mode)

ajllst:	jrst	nutajl
	jrst	cirajl
	jrst	drwajl
	jrst	ersajl
	jrst	vctajl
	jrst	blkajl
	jrst	rlcajl

cngalu:	movei	c,[asciz/enter alu (x=xor, i=ior, a=andcam, s=setam) :/]
	pushj	p,usher
	.iot	tti,c		;change screen alu
	cain	c,"a
	movei	pmode,2
	cain	c,"i
	movei	pmode,16
	cain	c,"s
	movei	pmode,17
	cain	c,"x
	movei	pmode,6
	popj	p,

blokst:	movei	a,bstart
	jrst	newlis(mode)

newlis:	jrst	neutnw
	jrst	circnw
	jrst	drawnw
	jrst	erasnw
	jrst	vectnw
	jrst	bloknw
	jrst	relcnw

chgcrs:	pushj	p,writec	;shift to new cursor
	move	a,crslst
	exch	a,crsls2
	exch	a,crsls3
	movem	a,crslst
	pushj	p,writec
	popj	p,

circst:	movei	a,cstart	;"c" command, draw a circle
	jrst	newlis(mode)

drawst:	movei	a,dstart	;"d" command, start drawing
	jrst	newlis(mode)

disabl:	setcmm	prmtflg		;"D" command, disable output
	.call	[setz ? 'ttyget ? 1000,,tti ? 2000,,a ? 402000,,b]
	.value
	xor	a,[202020,,202020]
	xor	b,[202020,,200020]
	.call	[setz ? 'ttyset ? 1000,,tti ? a ? setz b ]
	.value
	skipe	prmtflg
	jrst	disbl2
	pushj	p,outpnt
	pushj	p,outinc
	popj	p,
disbl2:	pushj	p,ttclear
	pushj	p,upscml
	move	a,[5,,0]
	pushj	p,ttspos
	movei	a,7
	pushj	p,ttcchr
	movei	a,40
	pushj	p,tthpos
	movei	a,3
	pushj	p,ttcchr
	movei	a,70
	pushj	p,tthpos
	movei	a,7
	pushj	p,ttcchr
	pushj	p,tthomd
	pushj	p,ttcntp
	.iot	tto,["B]
	popj	p,

erasst:	movei	a,estart
	jrst	newlis(mode)	;start erasing

holdr2:	skipa	b,const1
holder:	movei	b,0
	move	a,cent		;hold a point in storage  (uses A)
	movem	a,held(b)
	movei	c,crlfst
	pushj	p,outstr
	popj	p,

ier:	movni	a,1		;commands that move the cursor use a, b ,d
	jrst	mover
oer:	hrrzi	a,-1
	jrst	mover
per:	move	a,[1,,-1]	   ; i o p
	jrst	mover		   ; k   ;
semer:	hrlzi	a,1		   ; , . /
	jrst	mover
slsher:	move	a,[1,,1]
	jrst	mover
doter:	hrrzi	a,1
	jrst	mover
comer:	move	a,[-1,,1]
	jrst	mover
ker:	hrlzi	a,-1

mover:	hlre	b,a		;calculations
	imul	b,inc
	hrre	a,a
	imul	a,inc
	hlre	d,cent
	add	b,d		   ;figure x
	hrre	d,cent
	add	a,d		   ;figure y
	hrlm	b,new
	hrrm	a,new
	jrst	ajllst(mode)
	subttl	command handlers cont.

jumpr2:	skipa	b,const1
jumper:	movei	b,0
	move	a,held(b)		;move to held point (uses a)
	movem	a,new
	jrst	ajllst(mode)

macdf2:	movei	b,10
	jrst	macdef+1
macdef:	movei	b,0
	movei	c,[asciz/enter macro:  /]
	pushj	p,usher
	pushj	p,decin
	movem	n,macro(b)
	move	f,[440700,,macro+1]
	add	f,b
macdf1:	.iot	tti,c
	idpb	c,f
	caie	c,3
	jrst	macdf1
	movei	c,crlfst
	pushj	p,outstr
	popj	p,

macrn2:	movei	b,10
	jrst	macrun+1
macrun:	movei	b,0
	skipn	macro(b)
	popj	p,
	push	p,inc		;execute a macro  (uses a,c,f and anything used
	move	a,macro(b)
	movem	a,inc
	move	f,[440700,,macro+1]
	add	f,b
macrn1:	ildb	c,f
	cain	c,3
	jrst	macend
	push	p,f
	pushj	p,parser
	pop	p,f
	jrst	macrn1
macend:	pop	p,inc
	movei	c,crlfst
	skipn	prmtflg
	pushj	p,outstr
	popj	p,

recent:	movei	a,400		;move to center and reset inc. (uses a)
	hrlm	a,new
	movei	a,343
	hrrm	a,new
	movei	a,100
	movem	a,inc
	pushj	p,outinc
	jrst	ajllst(mode)

vectst:	movei	a,vstart
	jrst	newlis(mode)	;go to vector mode

relcst:	movei	a,rstart
	jrst	newlis(mode)

copier:	pushj	p,relcst
	pushj	p,dpnts
	popj	p,

grow:	jrst	.+1(mode)	;most functions dont implement this
	jrst	neutgr
	jrst	circgr
	popj	p,
	jrst	erasgr
	jrst	vectsp
	jrst	blokgr
	popj	p,

shrink:	jrst	.+1(mode)
	jrst	neutsh
	jrst	circsh
	popj	p,
	jrst	erashr
	jrst	vectbs
	jrst	bloksh
	popj	p,

upofst:	cain	mode,blok
	jrst	blkwdr
	pushj	p,incvr4
	addm	a,ofset
	popj	p,

dnofst:	cain	mode,blok
	jrst	blktnr
	pushj	p,incvr4
	sub	a,ofset
	movnm	a,ofset
	popj	p,

dninc:	move	a,inc		;inc=inc/2 (uses a)
	caig	a,1
	popj	p,
	ash	a,-1
	movem	a,inc
	pushj	p,outinc
	popj	p,

upinc:	move	a,inc		;inc=inc*2 (uses a)
	cail	a,400		   ;max. value
	popj	p,
	ash	a,1
	movem	a,inc
	pushj	p,outinc
	popj	p,

taber:	caie	mode,vector
	popj	p,
	jrst	vectab

crtner:	movei	a,nstart
	jrst	newlis(mode)	;cr

lfder:	jrst	.+1(mode)	;line feed
	jrst	neutlf
	jrst	circlf
	jrst	drawlf
	jrst	eraslf
	jrst	vectlf
	jrst	bloklf
	jrst	relclf

deletr:	jrst	.+1(mode)	;cancel what we're doing
	jrst	neutdl
	jrst	circdl
	jrst	drawdl
	jrst	erasdl
	jrst	vectdl
	jrst	blokdl
	jrst	relcdl

clner:	jrst	.+1(mode)	;***does this do complementing? I forgot.
	popj	p,
	jrst	circln
	popj	p,
	popj	p,
	jrst	vectcn
	jrst	blokcn
	jrst	relcln


quotst:	movei	a,qstart
	jrst	newlis(mode)	;"

quiter:	.break	16,160000	;finish

helper:	pushj	p,ttclear	;help uses c
	movei	c,[asciz\ i o p k ; , . /  a b c d e h j l m n v c g h j m n q r s w z [ ] < > esc tab bs cr lf " * ?\]
	pushj	p,outstr
	popj	p,

zapper:	push	p,pmode
	movei	pmode,17		;***this will be altered to dodge cursor
	pushj	p,setalu
	move	a,[setzm tv(d)]		;zap buffer
	move	b,[aobjn d,a]
	move	c,[popj p,]
	movsi	d,-10*2000+1
	pushj	p,a
	pop	p,pmode
	pushj	p,outpnt
	pushj	p,outinc
	pushj	p,writec
	jrst	nstart
	subttl i/o routines

writtv:	movei	c,filnam	;***this has to be altered to allow for new tv format
	pushj	p,usher
	pushj	p,filext
	.call	[setz
		sixbit/open/
		5000,,7		;image, block, output
		1000,,dskchn
		dev
		nam1
		nam2
		snam
		403000,,n]
	jrst	ioerr
	pushj	p,writec	;because of this i/o should be in neutral
	push	p,cent
	move	a,[571.,,<37.-echsiz>*12.]
	movem	a,cent
	push	p,size
	movei	a,12.
	movem	a,size
	pushj	p,outdiam
	pushj	p,cldiam
	pop	p,size
	pop	p,cent
	move	a,[-8192.,,tv]
	.iot	dskchn,a
	.close	dskchn,
	movei	c,crlfst
	pushj	p,usher
	popj	p,

readtv:	movei	c,filnam	;***this has to be altered to allow for new tv format
	pushj	p,usher
	pushj	p,filext
	.call	[setz
		sixbit/open/
		5000,,6		;image
		1000,,dskchn
		dev
		nam1
		nam2
		snam
		403000,,n]
	jrst	ioerr
	push	p,pmode
	pushj	p,cngalu
	pushj	p,setalu
	pushj	p,writec

	move	a,[-8192.,,tv]
	.iot	dskchn,a
	.close	dskchn,

	pushj	p,writec
	pop	p,pmode
	popj	p,

getstn:				;***this would have been a stanford format output routine
savstn:	popj	p,

filnam:	asciz/enter file name:/

ioerr:	.call	[setz
		sixbit/open/
		1000,,dskchn
		[sixbit/err/]
		1000,,4
		setz n]
	.value
ioerr1:	.iot	dskchn,c
	cain	c,15
	popj	p,
	.iot	tto,c
	jrst	ioerr1

	.insrt	ar9:filext >
	subttl	neutral package

nstart:	movei	mode,neutral
	movei	c,[asciz/ neutral /]
	pushj	p,usher
	popj	p,

neutnw:	jrst	(a)

nutajl:	pushj	p,writec
	move	a,new
	movem	a,cent
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

neutlf:	popj	p,

neutdl:	popj	p,

neutgr:	pushj	p,incvr4
	addm	a,size
	popj	p,

neutsh:	pushj	p,incvr4
	sub	a,size
	movnm	a,size
	skiple	size
	popj	p,
	setzm	size
	aos	size
	popj	p,
	subttl	circle package

dcircl:	move	x,size
	setz	y,
	pushj	p,forsqr	;plot 4 times
	exch	x,y
	pushj	p,forsqr

	movei	x,1
cloop:	move	a,size
	imul	a,a
	move	b,x
	imul	b,b
	sub	a,b		;	    2   2
	pushj	p,sqrt		;y=sqrt(size  -x )
	move	y,a
	pushj	p,forsqr
	caml	x,y
	popj	p,
	exch	x,y
	pushj	p,forsqr
	exch	x,y
	aoja	x,cloop

forsqr:	pushj	p,plotp
	movn	x,x
	pushj	p,plotp
	movn	y,y
	pushj	p,plotp
	movn	x,x
	pushj	p,plotp
	movn	y,y
	popj	p,

sqrt:	movei	n,5
sqloop:	move	b,a
	idiv	b,n
	camn	b,n
	jrst	esqrt
	caig	b,1(n)
	caile	n,1(b)
	jrst	.+2
	jrst	sqrt2
	add	n,b
	idivi	n,2
	jrst	sqloop
sqrt2:	move	c,b
	move	d,n
	imul	c,c
	imul	d,d
	sub	c,a
	sub	d,a
	movm	c,c
	movm	d,d
	camg	c,d
	skipa	a,b
esqrt:	move	a,n
	popj	p,

cstart:	movei	mode,circle
	pushj	p,dcircl
	pushj	p,outsiz
	movei	c,[asciz/circle  /]
	pushj	p,usher
	popj	p,


circnw:	push	p,a
	pushj	p,cfinish
	pop	p,a
	jrst	(a)

cirajl:	pushj	p,dcircl
	pushj	p,writec
	move	a,new
	movem	a,cent
	pushj	p,dcircl
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

circlf:	movei	pmode,2
	pushj	p,dcircl
	movei	pmode,6
	jrst	nstart

circdl:	pushj	p,dcircl
circln:	jrst	nstart

circlq:	pushj	p,cfinish
	jrst	qstart


circgr:	pushj	p,dcircl
	pushj	p,incvr4
	addm	a,size
	pushj	p,outsiz
	pushj	p,dcircl
	popj	p,

circsh:	pushj	p,dcircl
	pushj	p,incvr4
	sub	a,size
	movmm	a,size
	skipn	size
	aos	size
	pushj	p,outsiz
	pushj	p,dcircl
	popj	p,

cfinish:movei	pmode,16
	pushj	p,dcircl
	movei	pmode,6
	popj	p,
	subttl	draw package

dstart:	movei	c,[asciz/draw  /]
	pushj	p,usher
	move	a,cent
	movem	a,old
	movei	mode,draw
	pushj	p,dotcmp
	popj	p,

drawnw:	push	p,a
	pushj	p,dfinish
	pushj	p,writec
	pop	p,a
	jrst	(a)

drwajl:	pushj	p,dnewpos
	popj	p,

dnewpos:pushj	p,dfinish
	move	a,new
	exch	a,cent
	movem	a,old
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

dfinish:pushj	p,writec
	move	a,old
	camn	a,cent
	popj	p,
	movei	pmode,16
	pushj	p,writev
	movei	pmode,6
	popj	p,

drawlf:	pushj	p,writec
	move	a,cent
	camn	a,old
	jrst	nstart
	movei	pmode,2
	pushj	p,writev
	movei	pmode,6
	pushj	p,dotcmp
	jrst	nstart

drawdl:	pushj	p,writev
	jrst	nstart
	subttl	eraser package

estart:	pushj	p,writec		;initialize eraser
	movei	mode,erase
	movei	a,4
	movem	a,size
	setzm	ofset
	pushj	p,outdiam
	pushj	p,outsize
	movei	c,[asciz/erase  /]
	pushj	p,usher
	popj	p,

outdia:	movei	pmode,2		;output a square, clearing everthing inside
	move	x,size
outdi2:	move	y,size
outdi3:	pushj	p,plotp
	sojge	y,outdi3
	sojge	x,outdi2
	movei	pmode,6
	pushj	p,writeb
	popj	p,

cldiam:	movei	pmode,2
	pushj	p,writeb
	movei	pmode,6
	popj	p,

erasnw:	push	p,a
	pushj	p,cldiam	;go to circle mode
	pushj	p,writec
	pop	p,a
	jrst	(a)

ersajl:	move	a,cent
	movem	a,old
	pushj	p,cldiam
	move	a,new
	movem	a,cent
	pushj	p,outdia
	pushj	p,outpnt
	popj	p,

erasdl:
eraslf:	pushj	p,cldiam	;go to neutral mode
	pushj	p,writec
	jrst	nstart

erasgr:	pushj	p,incvr4		;make diamond bigger
	addm	a,size
	pushj	p,outdiam
	pushj	p,outsiz
	popj	p,

erashr:	pushj	p,cldiam		;make diamond smaller
	pushj	p,incvr4
	sub	a,size
	movmm	a,size
	skipn	size
	aos	size
	pushj	p,writeb
	pushj	p,outsiz
	popj	p,

	subttl	vector package

vstart:	movei	c,[asciz/vector  /]
	pushj	p,usher
	move	a,cent
	movem	a,old
	movei	mode,vector
	pushj	p,dotcmp
	popj	p,

vectnw:	push	p,a
	pushj	p,dfinish
	pushj	p,writec
	pop	p,a
	jrst	(a)

vctajl:	setom	vecflg'
	pushj	p,writev
	pushj	p,writec
	move	a,new
	movem	a,cent
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

vctadv:	skipl	vecflg
	jrst	vctad2
	hlre	a,cent
	hlre	b,old
	sub	a,b
	hrlm	a,delta2'
	hrre	a,cent
	hrre	b,old
	sub	a,b
	hrrm	a,delta2
vctad2:	hlre	a,delta2	;get delta-x
	hrre	b,delta2	;get delta-y
	movm	a,a
	movm	b,b
	camg	a,b
	skipa	n,b
	move	n,a
	hrre	a,delta2	;delta-y
	imul	a,inc
	idiv	a,n
	hrrm	a,delta
	hlre	a,delta2	;delta-x
	imul	a,inc
	idiv	a,n
	hrlm	a,delta
	setzm	vecflg
	popj	p,

vectsp:	pushj	p,vctadv
	pushj	p,writev
	pushj	p,writec
	pushj	p,addelt
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

vectbs:	pushj	p,vctadv
	pushj	p,writev
	pushj	p,writec
	pushj	p,sbdelt
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

vstret:	popj	p,







vectab:	pushj	p,dfinish
	pushj	p,vctadv
	pushj	p,addelt
	move	a,cent
	movem	a,old
	pushj	p,addelt
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

vectlf:	pushj	p,writec
	movei	pmode,2
	pushj	p,writev
	movei	pmode,6
	pushj	p,writec
	jrst	nstart

vectdl:	pushj	p,writev
vectcn:	jrst	nstart

addelt:	hlre	a,cent
	hlre	b,delta
	add	a,b
	hrlm	a,cent
	hrre	a,cent
	hrre	b,delta
	add	a,b
	hrrm	a,cent
	popj	p,

sbdelt:	hlre	a,cent
	hlre	b,delta
	sub	a,b
	hrlm	a,cent
	hrre	a,cent
	hrre	b,delta
	sub	a,b
	hrrm	a,cent
	popj	p,

	subttl	quote package

qstart:	.call	[setz ? 'ttyget ? 1000,,tti ? 2000,,a ? 2000,,b ? 402000,,c]
	.value
	push	p,a
	push	p,b
	push	p,c
	ior	a,[202020,,202020]
	ior	b,[202020,,200020]
	xor	c,[40000,,0]
	.call	[setz ? 'ttyset ? 1000,,tti ? a ? b ? setz c]
	.value
	pushj	p,writec
qstar2:	movei	c,[asciz/quote  /]
	pushj	p,usher
	pushj	p,upscml
	pushj	p,tthome
	skipn	prmtflg
	pushj	p,ttclin
	movei	a,12.
	movem	a,size
	movnm	a,ofset
	move	a,qulft
	exch	a,cent
	push	p,a

quot1:	.iot	tti,c
	cain	c,""
	jrst	quot2
	caie	c,177
	jrst	quot13
	movei	c,10
	.iot	tto,c
	pushj	p,ttcntp
	movei	c,"K
	.iot	tto,c
	movei	a,6
	sub	a,ofset
	movnm	a,ofset
	jrst	quot1
quot13:	movei	a,6
	addm	a,ofset		;increase width for each accepted char.
	jrst	quot1
quot2:	pushj	p,dnscml
	pushj	p,writec
	pushj	p,rstart
	pop	p,a
	movem	a,new
	pushj	p,rlcajl
	pop	p,c
	pop	p,b
	pop	p,a
	.call	quotcns
	.value
	popj	p,

qulft:	1,,<36.-echsiz>*12.		;check on this
qlrt:	0
qwidth:	6,,0
qlst:	block 100

quotcns:setz ? 'ttyset ? 1000,,tti ? a ? b ? setz c
	subttl	block package

bstart:	pushj	p,writeb
	pushj	p,writec
	movei	mode,blok
	pushj	p,outsiz
	movei	c,[asciz/block  /]
	pushj	p,usher
	popj	p,

bloknw:	push	p,a
	movei	pmode,16
	pushj	p,writeb
	movei	pmode,6
	pushj	p,writec
	pop	p,a
	jrst	(a)

blkajl:	pushj	p,writeb
	move	a,new
	movem	a,cent
	pushj	p,writeb
	pushj	p,outpnt
	popj	p,

blokdl:	pushj	p,writeb
blokcn:	pushj	p,writec
	jrst	nstart

bloklf:	movei	pmode,2
	pushj	p,writeb
	movei	pmode,6
	pushj	p,writec
	jrst	nstart

blokgr:	movei	b,size
	pushj	p,writeb
	pushj	p,incvr4
	addm	a,(b)
blokg2:	pushj	p,writeb
	pushj	p,outsiz
	popj	p,

bloksh:	pushj	p,writeb
	pushj	p,incvr4
	sub	a,size
	movmm	a,size
	skipn	size
	aos	size
	jrst	blokg2

blkwdr:	movei	b,ofset
	jrst	blokgr+1

blktnr:	pushj	p,writeb
	pushj	p,incvr4
	sub	a,ofset
	movnm	a,ofset
	jrst	blokg2
	subttl	relocation package

rstart:	movei	mode,reloct
	pushj	p,writec
	movei	c,[asciz/relocation/]
	pushj	p,usher
	.call	[setz
		'corblk
		1000,,3000
		1000,,-1
		1000,,50
		401000,,-5]
	.value
	move	a,cent
	movem	a,old
	move	f,[440100,,work]
	move	y,size
rlop1:	move	x,size
	add	x,ofset
rlop2:	pushj	p,getco
	move	a,tv(mword)
	and	a,bit
	skipe	a
	skipa	n,const1
	movei	n,0
	idpb	n,f
	sojge	x,rlop2
	sojge	y,rlop1
	popj	p,

dpnts:	pushj	p,setalu
	move	f,[440100,,work]
	move	y,size
rlop11:	move	x,size
	add	x,ofset
rlop12:	ildb	n,f
	skipe	n
	pushj	p,plotp
	sojge	x,rlop12
	sojge	y,rlop11
	popj	p,

relocm:
rlcajl:	pushj	p,dpnts
	move	a,new
	movem	a,cent
	pushj	p,dpnts
	pushj	p,outpnt
	popj	p,

relcnw:	push	p,a
	movei	pmode,16
	pushj	p,dpnts
	movei	pmode,6
	pushj	p,rlcfin
	pop	p,a
	jrst	(a)

relclf:	movei	pmode,2
	pushj	p,dpnts
	movei	pmode,6
	pushj	p,rlcfin
	jrst	nstart

relcdl:	pushj	p,dpnts
	move	a,old
	movem	a,cent
	pushj	p,dpnts
relcln:	pushj	p,rlcfin
	jrst	nstart

rlcfin:	.call	[setz
		'corblk
		1000,,0
		1000,,-1
		401000,,50]
	.value
	pushj	p,writec
	popj	p,