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-----------------------------------------------------