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 output 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 cons.  At least one
	.iot	tti,c		;digit must be read before it will return, after that,
	cail	c,"0		;it returns after the first non-digit
	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

bcheck:	push	p,a		;this routine makes sure that CENT is actually on the
	hlre	a,cent		;screen, changing it if needed
	caige	a,0
	movei	a,0
	caile	a,576.
	movei	a,576.
	hrlm	a,cent
	hrre	a,cent
	caige	a,0
	movei	a,0
	caile	a,454.
	movei	a,454.
	hrrm	a,cent
	pop	p,a
	popj	p,

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
	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-1	;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
	caml	e,c
	skipa	b,d
	move	a,d
	caile	b,1(a)
	jrst	binser
	popj	p,		;first return d contains garbage
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:	0
	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
	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)	;lf
	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)
	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
	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
	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
	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:
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,bcheck
	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,bcheck
	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,bcheck
	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,bcheck
	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,bcheck
	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,bcheck
	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,bcheck
	pushj	p,writev
	pushj	p,writec
	pushj	p,outpnt
	popj	p,

vstret:	popj	p,







vectab:	pushj	p,dfinish
	pushj	p,vctadv
	pushj	p,addelt
	pushj	p,bcheck
	move	a,cent
	movem	a,old
	pushj	p,addelt
	pushj	p,bcheck
	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
	work=50*2000

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,bcheck
	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,
	subttl	the end
	.insrt ar9:ttpak >
	.insrt	ar9:plotpk >
	end tvdraw