perm filename CRE.OLD[CAR,BGB] blob sn#019089 filedate 1973-01-08 generic text, type T, neo UTF8
00100	TITLE CAREYE  -  CART'S EYE THREE  -  DECEMBER 1972.
00200	
00300	;CONTROL FLAGS.
00400		INTERN FLGSIX,FLGARC,FLGBK
00500	
00600		FLGKRK:-1		;ENABLE KRAKAUER TREE.
00700		FLGSIX:-1		;SIX BIT TELEVISON.
00800		FLGARC:-1		;ENABLE MAKE ARC SMOOTHING.
00900	
01000		FLGBK:-1		;ENABLE BABY KILLER.
01100		VCUT: 14		;VERTEX CONTRAST THRESHOLD.
01200		FLGWED:0		;DISPLAY WINGED EDGED IMAGE.
01300	
01400		FLGBGB:0		;RUNNING UNDER A BGB PPPN.
01500		FLGRAR:1		;DISPLAY RECIPROCAL ARC RADIALS.
01600					;-1 BOTH, 0 VIC, +1 ARCS.
01700		FLGKINK:0		;DISPLAY KINKS.
01800		FLGU:-1			;KILVIC ENABLE.
01900	
02000	;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
02100	ARCWID:
02200		FOR I←0,3{2.0↔}
02300		FOR I←4,5{1.5↔}
02400		FOR I←6,12{1.25↔}
02500		FOR I←13,17{1.0↔}
02600		FOR I←20,37{1.0↔}
02700		FOR I←40,77{0.7↔}
02800		0
02900	
03000	
03100	;POINTERS TO SKY ROWS - COLUMN ACCUMULATOR-3.
03200	SKY:	FOR I←0,=216{
03300		1B18+=289*I(3)}
03400	
03500		SUBR(LOCKIN)
03600		LAC[XWD 400017,.+3]↔CALLI 400003↔POP0J↔HALT
03700		DEFINE UNLOCK{043000636367}
     

00100	;CAREYE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
00200	;=10 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.
00300	;=118 WORD TRAILER.
00400	
00500		HI ←← 400000
00600		$←400000
00700	
00800		PAC ← HI ↔ HI ←← HI + =1728	;PICTURE ACCUMULATOR.
00900		VSEG← HI ↔ HI ←← HI + =1729	;VERTICAL SEGMENTS.
01000		HSEG← HI ↔ HI ←← HI + =1736	;HORIZONTAL SEGMENTS.
01100	
01200			   HI ←← HI + =86	;NEGATIVE ROWS.
01300	HEADER←HI	↔  HI ←← HI + =10
01400	TVBUF ←HI	↔  HI ←← HI + =10368	;TV BUFFER 6 BITS PER PIXEL.
01500	HISTO ←HI	↔  HI ←← HI + =64	;HISTOGRAM.
01600	FTVSIX←HI	↔  HI ←← HI + 1		;FLAG TV SIX BIT.
01700	FTVHIS←HI	↔  HI ←← HI + 1		;FLAG TV HISTOGRAM PRESENT.
01800	
01900		HI ←← HI + =54			;FREE SPACE.
02000	
02100	;POINTERS TO TV SEGMENT.
02200	TV:	0
02300		POINT 6,-1,29	;COLUMN -2.
02400		POINT 6,-1,35	;COLUMN -1.
02500	COLPTR:	FOR I←0,=48{
02600		I+<POINT 6,0,05>↔I+<POINT 6,0,11>↔I+<POINT 6,0,17>
02700		I+<POINT 6,0,23>↔I+<POINT 6,0,29>↔I+<POINT 6,0,35>}
02800	ROWPTR:	FOR I←0,=216{
02900		I*=48+TVBUF}
03000		ISAVED: 0
03100	
03200		TVSEG:	0
03300		SKYSEG:	0
03400		O(ATTSEG,CALLI 400016)
03500		O(DETSEG,CALLI 400017)
03600		O(SEGNUM,CALLI 400021)
03700	
     

00100	;INITIALIZATION---------------------------------------------------
00200		OPDEF PPIOT[702B8]
00300		PDL: BLOCK 100
00400	
00500	;START ADDRESS
00600	SA:	LAC 17,[IOWD 100,PDL]
00700		CALL(MORCOR)
00800	
00900	;RE-ENTRY ADDRESS.
01000	REE:	LACI .↔DAC 124
01100		PPIOT 2,-=250↔PPIOT 3,3003
01200		MOVEI 20↔CRLF↔SOJG .-1
01300		SETZ↔CALLI 24↔CDR
01400		CAIN'BGB'↔SETOM FLGBGB
01500		LAC 17,[IOWD 100,PDL]
01600		CALL(CROP)
01700		CALL(DPYIMG)
01800		PUSHJ TTY
01900		CALLI 12
02000	;6/12/72----------------------------------------------------------
02100	;TELETYPE COMMAND STATE.
02200		DECLARE{CTRL,META,CHR}
     

00100	SUBR(TTY)---------------------------------------------------------
00200	BEGIN TTY;CAREYE TELETYPE COMMAND JUMP TABLE  -BGB-  NOVEMBER 1972.
00300	L0:	CRLF
00400	L1:	OUTCHR["*"]
00500		INCHRW
00600		SETZM CTRL↔TRZE 200↔SETOM CTRL
00700		SETZM META↔TRZE 400↔SETOM META
00800		CAIN 0,15↔GO L1+1
00900		CAIN 0,12↔GO L1
01000		DAC 0,CHR
01100	
01200	;TEST FOR LETTER COMMAND.
01300		LAC 1,0↔ANDI 1,37
01400		CAIGE 0,"A"↔GO .+3
01500		CAIG  0,"Z"↔GO L3
01600		CAIGE 0,"a"↔GO .+3
01700		CAIG  0,"z"↔GO L3
01800	
01900	;WINDOW MOVING COMMANDS.
02000		CAIN 0," "↔GO L2
02100		CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
02200		CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
02300		CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
02400		CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
02500		CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
02600		CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
02700		CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
02800		CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
02900	
03000	;QBLK CHANGING COMMANDS.
03100		CAIN 0,"!"↔GO[SETZ 1,↔GO L2B+1]
03200		CAIN 0,"+"↔GO[LAC 1,FILM↔GO L2B+1]
03300		CAIN 0,","↔GO[SKIPE 1,QBLK↔CW 1,1↔GO L2B]
03400		CAIN 0,"."↔GO[SKIPE 1,QBLK↔CCW 1,1↔GO L2B]
03500		CAIN 0,"↓"↔GO[SKIPE 1,QBLK↔ENDO 1,1↔GO L2B]
03600		CAIN 0,"↑"↔GO[SKIPE 1,QBLK↔EXO 1,1↔GO L2B]
03700		CAIN 0,"↔"↔GO[SKIPE 1,QBLK↔ARC  1,1↔GO L2B]
03710		CAIN 0,"≥"↔GO[SKIPE 1,QBLK↔PED  1,1↔GO L2B]
03720		CAIN 0,"≤"↔GO[SKIPE 1,QBLK↔NED  1,1↔GO L2B]
03730		CAIN 0,"<"↔GO[SKIPE 1,QBLK↔NCCW  1,1↔GO L2B]
03800		CAIN 0,">"↔GO[SKIPE 1,QBLK↔SON 1,1↔GO L2B]
03900		CAIN 0,"→"↔GO[SKIPE 1,QBLK↔PGON 1,1↔GO L2B]
04000		CAIN 0,"←"↔GO[SKIPE 1,QBLK↔NGON 1,1↔GO L2B]
04100		CAIN 0,"6"↔GO[SETOM FLGSIX↔SETOM FTVSIX↔GO L1]
04200		CAIN 0,"4"↔GO[SETZM FLGSIX↔SETZM FTVSIX↔GO L1]
04300		GO L0
04400	
04500	L2:	CALL(CROP)↔CALL(DPYIMG)↔GO L1+1
04600	L2B:	SKIPE 1↔DAC 1,QBLK↔CALL(DPYBLK)↔GO L1+1
     

00100	
00200	L3:	PUSHJ P,@L4(1)↔GO L1
00300	
00400	L4:	NOP		;null.
00500		FLGA.		;"A" ARC MAKE FLAG.
00600		CART		;"B" DRIVE BACKWARDS.
00700		MAKCUT		;"C" MAKE THRESHOLD CUT.
00800		FLGB.		;"D" DELETE BABY POLYGONS.
00900		FLGE.		;"E"
01000		CART		;"F" DRIVE FORWARDS.
01100		NOP		;"G"
01200		DPYHIS		;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
01300		TVDSKI		;"I" INPUT TV PICTURE FROM DISK.
01400		BIMOD		;"J" TWO CUTS AT 3% FROM ENDS.
01500		FLGK.		;"K" KRAKAUER FLAG.
01600		CART		;"L" TURN LEFT. "αL" PAN CAMERA LEFT.
01700		NEXIMG+1	;"M" IMAGE ADVANCE.
01800		NEXIMG		;"N" IMAGE RETREAT.
01900		CEDSKO		;"O" OUTPUT CAREYE FILE.
02000		PLOTO 		;"P" PLOT OUTPUT FILE.
02100		MKCUTS		;"Q" EQUI-SPACED CUTS.
02200		CART		;"R" TURN RIGHT. "αR" PAN CAMERA RIGHT.
02300		CAMERA		;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.
02400		TVCAMI		;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
02500		FLGU.		;"U"
02600		CART		;"V" CART DIAGONOSTIC COMMAND MODE.
02700		AWIDTH		;"W"
02800		[CALLI 12]	;"X"	CAREYE JOB EXIT.
02900		FLGR.		;"Y" DISPLAY RECIPROCAL ARC RADIALS.
03000		KILLER		;"Z"	ZERO DATA BUFFERS.
03100	
03200	NOP:	CRLF
03300		POP0J
03400	FLGA.:	SETCMM FLGARC↔CRLF↔POP0J
03500	FLGB.:	SETCMM FLGBK ↔CRLF↔POP0J
03600	FLGE.:	SETCMM FLGWED↔CALL(DPYIMG)↔CRLF↔POP0J
03700	FLGK.:	SETCMM FLGKRK↔CRLF↔POP0J
03800	FLGU.:	SETCMM FLGU↔CRLF↔POP0J
03900	FLGR.:	SETZM FLGWED
04000		LAC CTRL↔AND META
04100		JUMPN[SETOM FLGKINK↔GO .+8]↔SETZM FLGKINK
04200		LACI 1↔DAC FLGRAR
04300		SKIPE CTRL↔SETOM FLGRAR
04400		SKIPE META↔SETZM FLGRAR
04500		CALL(DPYIMG)↔CRLF↔POP0J
04600		LIT
04700	BEND;12/8/72------------------------------------------------------
     

00100	SUBR(GETFIL)------------------------------------------------------
00200	BEGIN GETFIL;SETUP FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
00300		SETZM FILNAM↔SETZM EXTION↔SETZM EXTION+1↔SETZM PPPN
00400		OUTSTR[ASCIZ/	FILE = /]
00500		LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
00600		INCHWL↔CAIN 15↔GO[INCHWL↔POP2J]↔AOSA(P)
00700	L:	INCHWL
00800		CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
00900		CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
01000		CAIN","↔GO[LAC 1,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
01100		CAIN"]"↔GO L
01200		CAIN 15↔GO EOL			;END OF THE LINE.
01300		CAIN 12↔GO EOL
01400		CAIG" "↔GO L	;IGNORE GARBAGE.
01500		SOJL 2,L↔SUBI 40↔IDPB 1↔GO L
01600	
01700	EOL:	INCHWL
01800		SKIPN 1,EXTION↔LAC 1,ARG2↔DAC 1,EXTION
01900		SKIPN FLGBGB↔POP2J
02000	;BGB'S DEFAULT PROJECT SPECIFICATION.
02100		SKIPN 1,PPPN↔  LAC 1,ARG1↔DAC 1,PPPN
02200		POP2J
02300	BEND;12/10/72------------------------------------------------------
02400	
02500	FILNAM:	0	;FILE NAME.
02600	EXTION:	0	;EXTENSION.
02700		0
02800	PPPN:	0	;PROJECT-PROGRAMMER.
     

00100	SUBR(TVDSKI)------------------------------------------------------
00200	BEGIN TVDSKI;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
00300		CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
00400		CALL(SEGTV)
00500		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00600		LOOKUP 1,FILNAM↔GO[OUTSTR[ASCIZ/	LOOKUP FAILED.
00700	/]↔GO .+4]
00800		IN 1,DUMARG↔JFCL
00900		OUTSTR[ASCIZ"	EOF.
01000	"]↔	RELEASE 1,
01100		POP0J
01200	DUMARG:	IOWD 24400,HEADER↔0
01300	BEND;12/14/72-----------------------------------------------------
01400	
01500	SUBR(TVDSKO)------------------------------------------------------
01600	BEGIN TVDSKO;INPUT TV PICTURE FROM A DISK FILE - BGB 6 DEC 72.
01700		CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
01800		CALL(SEGTV)
01900		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
02000		ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/	ENTER FAILED.
02100	/]↔GO .+4]
02200		OUT 1,DUMARG↔JFCL
02300		OUTSTR[ASCIZ"	EOF.
02400	"]↔	RELEASE 1,
02500		POP0J
02600	DUMARG:	IOWD 24400,HEADER↔0
02700	BEND;12/14/72-----------------------------------------------------
     

00100	SUBR(SEGTV)-------------------------------------------------------
00200	;GET THE OLD TVSEG.
00300		SETZ↔SEGNUM
00400		SKIPE 1,TVSEG
00500		GO[	CAMN 0,1↔POP0J↔SKIPE↔DETSEG
00600			ATTSEG 1,↔GO[FATAL(TVSEG ATTACH FAILURE.)]↔POP0J]
00700		SKIPE↔DETSEG
00800	;MAKE A NEW TVSEG.
00900		LACI HI
01000		CALLI 400015↔GO[FATAL(AIN'T NO CORE UP YONDER.)]
01100		LAC[SIXBIT/TVSEG/]↔CALLI 400036↔JFCL
01200		SETZ↔SEGNUM↔DAC TVSEG
01300		LAC[XWD $,$+1]↔SETZM $↔BLT HI-1
01400		POP0J
01500	;16/12/72---------------------------------------------------------
     

00100	
00200	SUBR(PLOTO)-------------------------------------------------------
00300	BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
00400		CALL(GETFIL,[SIXBIT/PLT/],[0])↔POP0J
00500		LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
00600		CDR 2,(1)↔SETZM 1(2)
00700		MOVS↔LAPI -1(1)↔DAC DUMLST
00800		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
00900		ENTER 1,FILNAM↔GO .+4
01000		OUT 1,DUMLST↔JFCL
01100		OUTSTR[ASCIZ"	EOF.
01200	"]↔	RELEASE 1,
01300		POP0J
01400	DUMLST:	0↔0
01500	BEND;12/10/72------------------------------------------------------
     

00100	SUBR(CEDSKO)------------------------------------------------------
00200	BEGIN;CAREYE DISK OUTPUT - BGB - 6 DECEMBER 1972.
00300		SKIPE CTRL↔GO TVDSKO
00400		CALL(GETFIL,[SIXBIT/CE3/],[0])↔POP0J
00500		LACN FILM
00600		CALL(RELLOC,0)
00700	;SETUP DUMP OUT ARGUMENT  IOWD.
00800		LAC OLD44↔SUB 44↔MOVSS↔LAP OLD44↔DAC OUTARG
00900	;FILE OUTPUT RITUAL.
01000		INIT 1,17↔SIXBIT/DSK/↔0↔HALT
01100		ENTER 1,FILNAM
01200		GO[OUTSTR[ASCIZ/	ENTER FAILED.
01300	/]↔GO .+4]
01400		OUT 1,OUTARG↔JFCL
01500		OUTSTR[ASCIZ"	EOF.
01600	"]↔	RELEASE 1,
01700		SETZM FILNAM↔SETZ EXTION↔SETZM EXTION+1↔SETZM PPPN
01800		CALL(RELLOC,FILM)
01900		POP0J
02000	OUTARG:	0↔0
02100	BEND;12/9/72------------------------------------------------------
02200	
02300	SUBR(RELLOC)BASE--------------------------------------------------
02400	BEGIN RELLOC;RELOCATE ALL POINTERS - BGB - 6 DECEMBER 1972.
02500		ACCUMULATORS{A,B,C}
02600		DEFINE KAR(Q){CAR Q(A)↔SKIPE↔ADD B↔DIP Q(A)}
02700		DEFINE KDR(Q){CDR Q(A)↔SKIPE↔ADD B↔DAP Q(A)}
02800	
02900		LAC B,ARG1	;BASE ADDRESS.
03000		LAC A,FILM	;BLOCK POINTER.
03100		MARK A,FILBIT
03200	L1:	SKIPN(A)2↔GO[KDR 0↔GO L2]
03300		TESTZ A,VBIT↔GO[
03400		KAR 0↔KAR 3↔KDR 0↔KDR 2↔KDR 3↔KDR 4↔GO L2]
03500		TESTZ A,PBIT↔GO[
03600		KAR 0↔KAR 3↔KAR 4↔KDR 0↔KDR 1↔KDR 2↔KDR 3↔KDR 4↔GO L2]
03700		TESTZ A,LBIT↔GO[KAR 0↔KDR 0↔KDR 1↔GO L2]
03800		TESTZ A,IBIT↔GO[KAR 0↔KDR 0↔KDR 1↔GO L2]
03900		TESTZ A,FILBIT↔GO[KDR 1↔KDR 3↔GO L2]
04000		FATAL(RELLOC - WEIRD BLK.)
04100	L2:	ADDI A,6+6
04200		CAML A,44↔POP1J
04250		SUBI A,6
04300		GO L1
04400		LIT
04500	BEND;12/20/72-----------------------------------------------------
     

00100	SUBR(TVIN4)------------------------------------------------------
00200	BEGIN TVIN4; FOUR BIT TELEVISION INPUT - BGB - 14 DEC 1972.
00300	
00400	L0:	INIT 17,17↔SIXBIT/TV/↔0
00500		GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00600		SETZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,
00700	
00800	;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
00900		LAC 1,TVERR
01000		TRNE	1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
01100	/]↔	TRNE	1,40	↔OUTSTR[ASCIZ/TV DATA MISS.
01200	/]↔	TRNE	1,20	↔OUTSTR[ASCIZ/TV NON EX MEM.
01300	/]↔	TRNE	1,100060↔JRST L0
01400		CALLI 22↔DAC TVTIME#
01500		CALLI 14↔DAC TVDATE#
01600	
01700		LAC[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
01800		SETZM FTVSIX↔SETOM FTVHIS
01900	
02000	;CONVERT FROM GREY CODE TO GRAY CODE.
02100		LAC 16,[XWD L,0]↔BLT 16,12
02200		LAP TVPTR↔GO 4
02300	
02400	L:	POINT 4,0,-1↔		FROM←←0
02500		POINT 6,TVBUF,-1↔	TO←←1
02600		=62208	↔		CNT←←2
02700		0	↔		BYT←←3
02800		ILDB BYT,FROM		;4
02900		LAC BYT,GRAY(BYT)	;3
03000		LSH BYT,2		;6
03100		AOS HISTO(BYT)		;7
03200		IDPB BYT,TO		;8
03300		SOJG CNT,4		;9
03400		POP0J			;12
03500	
03600	BEND;12/16/72-----------------------------------------------------
03700	
03800	TVPTR:	XWD -=6912,0
03900	TVCLIP:	701002		;BCLIP=7 TCLIP=0 CAM=1.
04000	TVYXW:	BYTE(9)50,34,40
04100	TVERR:	0
04200	GRAY:	OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
     

00100	SUBR(TVIN6)------------------------------------------------------
00200	BEGIN TVIN6; SIX BIT TELEVISION INPUT - BGB - 14 DEC 1972.
00300	
00400	L0:	INIT 17,17↔SIXBIT/TV/↔0
00500		GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
00600		SETZM TVERR6#↔PUSH P,TVCLIP
00700		LACI 76↔DPB[POINT 6,TVCLIP,23]
00800		LAC TVPTR↔LIPI 440400↔DAC P1#
00900	L1:	SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01000		IORM TVERR6↔TRNE 100060↔GO L1
01100		LACI 54↔DPB[POINT 6,TVCLIP,23]
01200		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P2#
01300	L2:	SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01400		IORM TVERR6↔TRNE 100060↔GO L2
01500		LACI 32↔DPB[POINT 6,TVCLIP,23]
01600		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P3#
01700	L3:	SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
01800		IORM TVERR6↔TRNE 100060↔GO L3
01900		LACI 10↔DPB[POINT 6,TVCLIP,23]
02000		LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P4#
02100	L4:	SETZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
02200		IORM TVERR6↔TRNE 100060↔GO L4
02300		POP P,TVCLIP
02400	
02500	;REPORT ON THE ERROR BITS.
02600		LAC 1,TVERR6
02700		TRNE	1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
02800	/]↔	TRNE	1,40	↔OUTSTR[ASCIZ/TV DATA MISS.
02900	/]↔	TRNE	1,20	↔OUTSTR[ASCIZ/TV NON EX MEM.
03000	/]
03100		CALLI 22↔DAC TVTIME#
03200		CALLI 14↔DAC TVDATE#
03300	
03400		LAC[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
03500		SETOM FTVSIX↔SETOM FTVHIS↔AOS(P);SKIP !!
03600	
03700	;CONVERT FROM GREY CODE TO GRAY CODE.
03800		LAC[POINT 6,TVBUF,-1]↔DAC P5#
03900		LAC[XWD L,3]↔BLT 16↔LACI =62208
04000		GO 3
04100	
04200	;SIX BIT AC-LOOP.
04300	L:	ILDB 1,P1↔LAC 2,GRAY(1)
04400		ILDB 1,P2↔ADD 2,GRAY(1)
04500		ILDB 1,P3↔ADD 2,GRAY(1)
04600		ILDB 1,P4↔ADD 2,GRAY(1)
04700		IDPB 2,P5↔AOS  HISTO(2)
04800		SOJG 0,3↔POP0J
04900	
05000	BEND;12/16/72-----------------------------------------------------
     

00100	SUBR(TVCAMI)------------------------------------------------------
00200	BEGIN TVCAMI;TELEVISION CAMERA INPUT - BGB - 14 DEC 1972.
00300		CALL(LOCKIN)
00400		LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
00500		ADDI =6912↔SKIPE CTRL↔ADDI 3*=6912
00600		CALLI 11↔GO[FATAL(NO CORE FOR TVTAKE.)]
00700		CALL(SEGTV)
00800		LAC[XWD TVBUF,TVBUF+1]
00900		SETZM TVBUF↔BLT TVBUF+=10367
01000		SKIPE CTRL↔CALL(TVIN6)↔CALL(TVIN4)
01100		LAC TMP44↔CALLI 11↔JFCL
01200		CRLF↔UNLOCK↔POP0J
01300	BEND;12/16/72-----------------------------------------------------
     

00100	SUBR(CART)--------------------------------------------------------
00200	BEGIN CART
00300		OPDEF RADIO[7702B11]
00400		OPDEF HALTSW[043000636367]
00500		LAC 2,CHR	;INITIAL COMMAND CHARACTER.
00600		CAIN 2,"V"↔GO L0
00700		SKIPE CTRL↔TRO 2,200↔SKIPA ;SHIT.
00800	M0:	INCHRW 2	;WAIT FOR COMMAND CHARACTER.
00900		SETZM CNT0↔SETZM CNT1 ;ZIP TIME OF ANY PREVIOUS COMMAND.
01000		SETZM CTRL↔TRZE 2,200↔SETOM CTRL
01100		DAC 2,CHR
01200		SLACI 0,=20	;ONE-THIRD OF A SECOND.
01300	
01400	;DRIVE ONE MINUTE FORWARDS OR BACKWARDS.
01500		CAIN 2,"F"↔GO[LAC 1,[XWD =3600,12]↔GO M1]
01600		CAIN 2,"B"↔GO[LAC 1,[XWD =3600,12]↔LAPI 0,2↔GO M1]
01700		SKIPE CTRL↔GO .+5
01800	
01900	;STEERING 5 SECONDS LEFT OR RIGHT.
02000		CAIN 2,"L"↔GO[LAC 1,[XWD =300,11]↔LAPI 1↔GO M1]
02100		CAIN 2,"R"↔GO[LAC 1,[XWD =300,11]↔LAPI 0↔GO M1]
02200	
02300	;CAMERA PAN 10 SECONDS LEFT OR RIGHT.
02400		CAIN 2,"L"↔GO[LAC 1,[XWD =600,14]↔GO M1]
02500		CAIN 2,"R"↔GO[LAC 1,[XWD =600,14]↔LAPI 0,4↔GO M1]
02600	
02700		CAIN 2,"0"↔GO M0  ;HALT WITH SPACEWAR RUNNING.
02800		CAIN 2," "↔GO M0  ;HALT WITH SPACEWAR RUNNING.
02900	EX:	SETZM FIREUP#↔HALTSW↔CRLF↔POP0J
03000		
03100	M1:	HLRZM 0,CNT0 ↔ DAPZ 0,WORD0
03200		HLRZM 1,CNT1 ↔ DAPZ 1,WORD1
03300	
03400	;FIREUP SPACE WAR MODULE.
03500		SKIPE FIREUP↔GO M0↔SETOM FIREUP
03600		LAC[XWD 200001,L4]↔CALLI $+3↔GO M0
03700	
     

00100	; FIRE UP SPACE WAR JOB.
00200	L0:	SETZM CNT0↔SETZM CNT1
00300		LAC 1,[XWD 200001,L4]
00400		CALLI 1,400003
00500	
00600		OUTCHR["*"]↔LACI 7↔DAC WORD2
00700	;OLDE DIAGONOSTIC TTY LISTEN LOOP.
00800	L1:	INCHRW↔CAIN "X"↔GO EX
00900		CAIGE"0"↔GO L2
01000		CAILE"8"↔GO L2
01100		ANDI 7↔DAC WORD2↔GO L1
01200	L2:	CAIGE"A"↔GO L3
01300		CAILE"H"↔ANDI 7
01400		IORI 10↔DAC WORD2↔GO L1
01500	L3:	CAIN 15↔OUTCHR["*"]↔GO L1
01600		
01700	; SPACE WAR OUTPUT TO RADIO TRANSMITTER.
01800	
01900	L4:	SOSLE CNT0↔GO[LAC WORD0↔GO L5]↔SETZM CNT0
02000		SOSLE CNT1↔GO[LAC WORD1↔GO L5]↔SETZM CNT1
02100		LAC WORD2
02200	L5:	TRNE 8↔RADIO 400054;	1 SELECT ACTION RELAYS.
02300		TRNN 8↔RADIO 620054;	0 SELECT DIRECTION RELAYS.
02400		TRNE 1↔RADIO 440053;	1 STEERING MOTOR.
02500		TRNN 1↔RADIO 620053;	0 ;
02600		TRNE 2↔RADIO 410052;	1 DRIVE MOTOR.
02700		TRNN 2↔RADIO 600052;	0 ;
02800		TRNE 4↔RADIO 360051;	1 CAMERA PAN MOTOR.
02900		TRNN 4↔RADIO 570051;	0;
03000		RADIO 340050
03100		RADIO 340055
03200		CALLI 400024;EXIT SPACEWAR JOB.
03300		DECLARE{WORD0,WORD1,WORD2,CNT0,CNT1}
03400	
03500	BEND;12/18/72-----------------------------------------------------
     

00100	SUBR(CAMERA)------------------------------------------------------
00200	BEGIN CAMERA
00300		OUTSTR[ASCIZ/	CAMERA = /]
00400		INCHRW
00500		ANDI 3
00600		LSH 9
00700		IORI 700002
00800		DAC TVCLIP
00900		CRLF
01000		POP0J
01100	BEND;12/6/72------------------------------------------------------
01200	
01300	SUBR(KILLER)------------------------------------------------------
01400	BEGIN KILLER
01500		SKIPE CTRL↔GO L
01550		SETZM QBLK
01600		LAC OLD44↔CALLI 11↔JFCL↔SETZM OLD44
01700		SETZM AVAIL↔SETZM BLKCNT↔SETZM FILM
01800		CALL(MORCOR)
01900	L:	SETZM SX↔SETZM SY↔LAC[32.0]↔DAC DEL↔LAC[3.4]↔DAC MAG
02000		CALL(CROP)↔CALL(DPYIMG)
02100		CRLF↔POP0J
02200	BEND;12/31/72-----------------------------------------------------
02300	
02400	SUBR(NEXIMG)------------------------------------------------------
02500	BEGIN NEXIMG;NEXT IMAGE - BGB - 11 DEC 72.
02600		SKIPA
02700		SETOM CTRL
02800		LAC 1,FILM
02900		SON 2,1
03000		CDR 3,(2)↔SKIPE CTRL↔CAR 3,(2)
03100		SON. 3,1
03200		CALL(DPYIMG)
03300		SKIPE META↔GO[INCHRS↔GO NEXIMG↔GO .+1]
03400		CRLF
03500		POP0J
03600	BEND;12/11/72-----------------------------------------------------
     

00100	SUBR(MAKCUT)------------------------------------------------------
00200	BEGIN MAKCUT
00300		SETZ 1,
00400	L1:	INCHWL
00500		CAIN 15↔GO L2
00600		IMULI 1,=8
00700		ANDI 17
00800		ADD 1,0
00900		GO L1
01000	L2:	INCHWL
01100		CAIL 1,=64
01200		POP0J
01300		MOVNS 1
01400		SETZ 3,
01500		SLACI 2,1B18
01600		LSHC 2,(1)
01700		CALL(MKIMAG,2,3)
01800		CALL(DPYIMG)
01900		POP0J
02000	BEND;12/6/72------------------------------------------------------
02100	
02200	SUBR(MKCUTS)------------------------------------------------------
02300	BEGIN MKCUTS; MAKE CUTS Q-COMMAND - BGB - 9 DEC 1972.
02400		SETZ 1,
02500		SKIPE CTRL↔LACI 1,1
02600		SKIPE META↔ADDI 1,2
02700		PUSH P,Q1(1)
02800		PUSH P,Q2(1)
02900		CALL(MKIMAG)
03000		CALL(DPYIMG)
03100		POP0J
03200	
03300	;THREE, SEVEN, EIGHT OR FIFTEEN CUTS  -  EQUALLY SPACED.
03400	Q1:	    1B16     +1B32
03500		1B8+1B16+1B24+1B32  ↔  1B4+1B12+1B20+1B28
03600		1B8+1B16+1B24+1B32  +  1B4+1B12+1B20+1B28
03700	Q2:	    1B12
03800		1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
03900		1B4+1B12+1B20 + 1B0+1B8+1B16+1B24
04000	BEND;12/9/72------------------------------------------------------
     

00100	SUBR(AWIDTH)------------------------------------------------------
00200	BEGIN AWIDTH; SELECT ARC WIDTH - BGB - 16 DEC 1972.
00300		ACCUMULATORS{DEL,XLO,XHI,X1,X2}
00400		TDCA X2,X2↔INCHWL
00500	L1:	OUTSTR[ASCIZ/	#/]
00600	
00700		INCHRW↔CAIN 15↔GO L1-1
00800		CAIL"0"↔CAILE"7"↔GO L4
00900		ANDI 7↔LSH 3↔DAC 1
01000	
01100		INCHRW↔CAIN 15↔GO L1-1
01200		CAIL"0"↔CAILE"7"↔GO L4
01300		ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1
01400	
01500	L2:	CALL(TYPOUT)
01600		CALL(REALIN)
01700		JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
01800		CAIE 1,12↔GO .+3↔OUTCHR[15]↔AOJA X2,L3
01900		CAIN 1,15↔INCHWL
02000		CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
02100	L3:	CAILE X2,77↔LACI X2,77
02200	   	CAIGE X2,00↔LACI X2,00
02300		LAC[ASCIZ/	#00/]
02400		DPB X2,[POINT 3,0,27]↔ROT X2,-3
02500		DPB X2,[POINT 3,0,20]↔ROT X2, 3
02600		OUTSTR↔GO L2
02700	L4:	CRLF↔POP0J
02800	
02900	TYPOUT:	LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
03000		IDIVI 0,=1000
03100		SKIPE↔IORI"0"↔IORI" "   ↔DPB 0,[POINT 7,STR,13]
03200		IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
03300		IDIVI 2,=10  ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
03400		              IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
03500		OUTSTR STR↔POP0J
03600	STR:	ASCIZ/	99.99	/
03700	
03800	ALTER:	DAC ARCWID(X2)
03900		LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
04000		LAC XHI↔SUB XLO↔FLOAT
04100		LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
04200		LAC ARCWID(XLO)↔AOS XLO
04300	L5:	CAML XLO,XHI↔POP0J
04400		FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5
04500	
04600	BEND;12/16/72-----------------------------------------------------
     

00100	SUBR(REALIN)------------------------------------------------------
00200	BEGIN REALIN; INPUT FROM TTY SMALL REAL NUMBER - BGB - 16 DEC 1972.
00300	;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
00400	;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
00500	;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
00600	;AC-3 MINUS SIGN FLAG.
00700		SETZ↔SETZB 2,3
00800	L1:	INCHWL 1
00900		CAIE 1,"-"↔GO .+3↔SETCMM 3↔GO L1
01000		CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
01100		CAIL 1,"0"↔CAILE 1,"9"↔GO L2
01200		JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
01300		ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
01400	L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
01500		SKIPE 3↔MOVNS↔POP0J
01600	BEND;12/16/72-----------------------------------------------------