TITLE PICTURE OUTPUT

;; Type :TVWRITE <file-name> CR to dump TV screen as disk-file.
;; [Optional argument Tnm will use that tty's screen instead of yours.]
;; File will be binary image file in new format occupying 8 disk blocks.
;; Default file-name is SCREEN >.

A=1
B=2
C=3
D=4
E=5
F=6
G=7

P=17

tvpage==370	;last ten pages in core

tv==tvpage*2000			;address of beg of tv buffot

dtyoc==1

;; DOES NOT CHECK WHETHER YOU ARE ON A TV CONSOLE -- DUMPS RANDOM SCREEN IF NOT

BEG:	MOVE P,[-20,,PDL]
	PUSHJ P,TVMAPC	;APPEND TV SCREEN TO ADDRESS SPACE
	pushj p,readnm	;read jcl (file-name and so on)
	skipn b,ttynum'
	 jrst doit		;no tvcreg hair
	tlo b,400000		;<tty>
	.call [setz ? 'tvwher ? b ? movem b ? setzm b]
	 .lose %lssys
	.suset [.rtvcreg,,a]	;get our tvcreg
	tlz a,1774		;mask out our buffer number
	lsh b,2
	tso a,b			;put in his
	.suset [.stvcreg,,a]	;set it (isn't memory mapping fun?)
doit:	pushj p,packit	;pack TV screen into PDP10 words
	pushj p,write	;write it to disk

kill:	.break 16,124000	;:KILL 

failur:	.value [asciz /:err
:vp
/]
	jrst kill	;something failed -- exit

TVMAPC:	MOVE A,[-10,,TVPAGE]
	MOVEI B,0
	.CALL [	SETZ
		SIXBIT \CORBLK\
		1000,,600000
		1000,,-1
		A
		1000,,-2
		SETZ B]
	jrst failur
	POPJ P,

packit:	movei c,tv	;setup input pointer
	movei d,buffot	;setup output pointer
	movei e,454.	;454. lines
	lsh e,1		;2 * 9 words per line on screen
pcklop:	pushj p,blkpck	;pack one 9. word block into 8. words
	addi c,9.	;advance input pointer by 9.
	addi d,8.	;advance output pointer by 8.
	sojg e,pcklop
	popj p,

WRITE:	.call [	setz
		sixbit \open  \
	   	5000,,7
	    	,,outchn
	    	,,outfnm
	    	,,outfnm+1
	     	,,outfnm+2
	  	setz outfnm+3]
	jrst failur
	move a,[-454.*16.-200,,headot]
	.call [	setz
		sixbit \iot   \   
		,,outchn
		setz a]
	jrst failur
	.call [	setz
		sixbit \close \
		setz outchn]
	jrst failur
	popj p,

blkpck:	move a,(c)	;grab first word
	lsh a,-4.	;right justify
	move b,1(c)	;grab second word
	lshc a,4.	;shift in 4 bits
	movem a,(d)	;store first packed word

	lshc a,36.-8.
	move b,2(c)
	lshc a,8.
	movem a,1(d)	;store second packed word

	lshc a,36.-12.
	move b,3(c)
	lshc a,12.
	movem a,2(d)

	lshc a,36.-16.
	move b,4(c)
	lshc a,16.
	movem a,3(d)

	lshc a,36.-20.
	move b,5(c)
	lshc a,20.
	movem a,4(d)

	lshc a,36.-24.
	move b,6(c)
	lshc a,24.
	movem a,5(d)

	lshc a,36.-28.
	move b,7(c)
	lshc a,28.
	movem a,6(d)

	lshc a,36.-32.
	move b,8(c)
	lshc a,32.
	movem a,7(d)

	popj p,


readnm:	.break 12,[5,,jcl]	;get job control language
	move c,[440700,,jcl]
	movei f,outfnm+1
scanon:	move d,[440600,,g]	;first file name ?
	setz g,
cntrlp:	ildb a,c
	skipn a		;look for end of jcl
	popj p,
	cain a,"
	 jrst param
	cain a,^q
	jrst quoted
	caig a,40	;ignore CR, LF and so on
	jrst cntrlp
goblop:	cain a,":
	jrst colons
	cain a,";
	jrst semico
	cain a,^q
	jrst quoted
	caig a,40
	jrst spacer	;space
putint:	caige a,140
	subi a,40	;lower case
	idpb a,d
	ildb a,c
	jrst goblop

param:	ildb a,c	;ignore for now (the slash)
	cain a,"t
	 jrst param		;flush the T in T53...
	cain a,"T
	 jrst param
	cail a,"0
	 caile a,"7
	  jrst spacer
	subi a,"0
	move b,ttynum
	imuli b,10
	add b,a
	movem b,ttynum
	jrst param

quoted:	ildb a,c
	jrst putint

spacer:	jumpe g,scanon	;see if any characters accumulated
	movem g,(f)
	movei f,outfnm+2	;ready for second file-name
	jrst scanon

semico:	movem g,outfnm+3	;user name
	jrst scanon

colons:	movem g,outfnm		;device
	jrst scanon


outchn:	2

outfnm:	sixbit \dsk   \
	sixbit \screen\
	sixbit \>     \
	0


jcl:	block 20

pdl:	block 20

headot:	-1
	1	;bits per pixel
	16.	;words per line
	0
	454.-1	;lines in image - 1
	0
	576.-1	;pixels per line - 1
	0

	block 200-10

buffot: block 454.*16.	;space for packed binary picture


	end beg