perm filename MKVID[GEM,BGB]3 blob sn#092042 filedate 1974-03-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00019 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ALTERNATE PDP-10 MNEMONICS.
C00007 00003	TITLE MKVID  -  MAKE VIDEO  -   B. G. BAUMGART  -  12 MARCH 1974.
C00009 00004	START ADDRESS ENTRY & MAIN EXECUTION.
C00011 00005	SUBR(GETFIL,EXT)	SETUP FILE SPEC FROM TTY LINE.
C00014 00006	SUBR(SWITCH)		FILE NAME SWITCH SCANNER & EXECUTION.
C00016 00007	SUBR(MEMORY)		ALLOCATE BUFFER SPACE.
C00018 00008	
C00021 00009	SUBR(ESETUP)		SETUP AND SORT THE EDGE BLOCKS.
C00023 00010	SUBR(ESET,EDGE)		SETUP AN EDGE BLOCK.
C00026 00011	
C00030 00012	SUBR(HEAP,ADR,NN)	HEAP SORT AN ARRAY[1:N] OF N ELEMENTS.
C00034 00013	SUBR(MKVIDEO)		MAKE VIDEO IMAGE.
C00036 00014	SUBR(EFETCH)		FETCH EDGES RMIN ≤ UROW.
C00038 00015	SUBR(FILL)		FILL SCAN FROM XLIST SPANS.
C00040 00016	SUBR(ADVANCE)		ADVANCE THE EDGES OF THE XLIST.
C00042 00017	SUBR(PACK)		PACK A SCAN INTO THE CURRENT TV BUFFER.
C00043 00018	SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
C00045 00019	SUBR(RGB2IC)		CONVERT RGB TO QUAM'S IC COLOR FORMAT.
C00047 ENDMK
C⊗;
;ALTERNATE PDP-10 MNEMONICS.
	OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]
	OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
	OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF GO[JRST]
	OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
	↓P←←17↔DEFINE POP0J<POPJ P,>
	↓POP1J.:SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
	DEFINE ACCUMULATORS(LIST){ACPTR←←2	;DECLARE ACCUMULATORS.
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM:0↔>}

;MACROS TO SAVE AND RESTORE AC'S  -  SAVAC, GETAC.
	DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}

;SAIL LIKE SUBROUTINE LINKAGE.
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.

;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}
	↓NAME:;}

;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}

;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }

;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1 }}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
TITLE MKVID  -  MAKE VIDEO  -   B. G. BAUMGART  -  12 MARCH 1974.
COMMENT ⊗
	MKVID convert  a vector 2-D  (V2D) file into  a corresponding
video  raster file  (TMP). The features  of MKVID  include: coloring,
Gourand smoothing,  XY  clipping, anti-rastering  and  pseudo  random
intensity round off.
;-------------------------------------------------------------------⊗

PDL:	BLOCK 20

;IMAGE SIZES.
	SCALE:	1.0
	ORGX:	0
	ORGY:	0
	MAG:	3	;NUMBER OF (LINEAR) MICRO PIXELS PER MACRO PIXEL.
	MAGMAG:	3*3	;NUMBER OF MICROS PIXELS PER MACRO PIXEL.
	MROWS:	=216	;NUMBER OF MACRO ROWS.	  HEIGHT OF IMAGE.
	NCOLS:	=288	;NUMBER OF MACRO COLUMNS.  WIDTH OF IMAGE.
	UROWS:	=216*3	;NUMBER OF MICRO ROWS.
	UCOLS:	=288*3	;NUMBER OF MICRO COLUMNS.
	UROW:	0	;CURRENT MICRO ROW.

;CRE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
;=128 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.

	OLDTOP:	0	;INITIAL TOP OF CORE.
	BUFFER:	0	;POINTER TO V2D INPUT BUFFER.
	SCAN:	0	;POINTER TO SCAN LINE BUFFER. SIZE = MROWS*MAG.

	TVBUF:	0	;POINTER TO VIDEO BUFFER.
	TVRED:	0	;POINTER TO RED TV BUFFER.
	TVGRN:	0
	TVBLU:	0
;START ADDRESS ENTRY & MAIN EXECUTION.

SA:	JFCL↔RESET
	LAC P,[IOWD 20,PDL]	;SUBROUTINE RETURN ADDRESS STACK.
	CALL(MAIN)
	LAC OLDTOP↔CORE↔JFCL	;RETURN CORE SPACE TO SYSTEM.
	EXIT

SUBR(MAIN)		;MAIN EXECUTION.
COMMENT.-------------------------------------------------------------

;RESET SWITCHABLE'S.
	SETZM CSFLG
	MOVEI 3↔DAC MAG
	MOVEI 9↔DAC MAGMAG

;GET FILE NAME, FILE SIZE AND CONTROL SWITCHS.
	CALL(GETFIL,[SIXBIT/V2D/])↔EXIT
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	LOOKUP 1,FILNAM↔GO SA+1

;ALLOCATE CORE SPACE.
	CALL(MEMORY)
	SKIPN CSFLG↔GO[
	
;BLACK & WHITE VIDEO SYNTHESIS.
	CALL(MKVIDEO)
	CALL(TVDSKO)		;OUTPUT TV BUFFER TO DISK FILE.
	POP0J]

;COLOR VIDEO SYNTHESIS.
	CALL(MKVIDEO)↔AOS CSFLG	;RED 
	CALL(MKVIDEO)↔AOS CSFLG	;GREEN
	CALL(MKVIDEO)		;BLUE

	CALL(RGB2IC)		;CONVERT INTO INTENSITY-COLOR FORMAT.
	MOVEI 1↔DAC CSFLG
	CALL(TVDSKO)↔AOS CSFLG	;OUTPUT TV BUFFER TO DISK FILE.
	CALL(TVDSKO)↔POP0J	;OUTPUT TV BUFFER TO DISK FILE.

ENDR MAIN;3/13/74(BGB)-----------------------------------------------
SUBR(GETFIL,EXT)	;SETUP FILE SPEC FROM TTY LINE.
COMMENT .-----------------------------------------------------------.

	SETZM FILNAM↔SETZM EXTION
	SETZM EXTION+1↔SETZM PPPN
	OUTSTR[ASCIZ/	FILE = /]

	LAC 1,[POINT 6,FILNAM]↔MOVEI 2,6;SIX LETTER FILE NAME.
	INCHWL↔CAIL"a"↔SUBI 40
	CAIN 15↔GO[INCHWL↔POP1J]↔AOSA(P)

L:	INCHWL↔CAIL"a"↔SUBI 40
	CAIN"/"↔GO[CALL(SWITCH)↔GO L]	;SNARF SWITCH STRINGS.
	CAIN"."↔GO[SETZM EXT		;EXTENSION PREFIX.
	LAC 1,[POINT 6,EXTION,-1]
	MOVEI 2,3↔GO L]
	CAIN"["↔GO[			;PROJECT PREFIX.
	LAC 1,[POINT 6,PPPN,-1]
	MOVEI 2,3↔GO L]
	CAIN","↔GO[			;PROGRAMMER PREFIX.
	LAC 1,[POINT 6,PPPN,17]
	MOVEI 2,3↔GO L]
	CAIN"]"↔GO L			;PPPN SUFFIX.

	CAIN 15↔GO EOL			;END OF THE LINE.
	CAIN 12↔GO EOL
	CAIG" "↔GO L			;IGNORE GARBAGE.
	SOJL 2,L
	SUBI 40↔IDPB 1↔GO L		;ASCII TO SIXBIT.

EOL:	INCHWL↔CAR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6	;RIGHT ADJUST PROJECT.
	DIP PPPN↔CDR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6	;RIGHT ADJUST PROGRAMMER.
	DAP PPPN
	SKIPN 1,EXTION
	LAC 1,EXT↔DAC 1,EXTION 		;DEFAULT EXTENSION.
	LAC [XWD FILNAM,IFILE]
	BLT IFILE+3↔POP1J		;SAVE COPY OF FILE NAME.
ENDR GETFIL;2/18/73(BGB)---------------------------------------------

;INPUT-OUTPUT VARIABLES.
	INARG:	0↔0
	IFILE:	0↔0↔0↔0		;SAVED COPY OF INPUT FILE NAME.
	OFILE:	0↔0↔0↔0		;SAVED COPY OF OUTPUT FILE NAME.
	FILNAM:	0		;UUO FILE NAME ARGUMENT.
	EXTION:	0↔0
	PPPN:	0

;COLOR SYNTHESIS VARIABLES.
	CSFLG:	0	;COLOR SYNTHESIS COUNT W=0,R=1,G=2,B=3.
SUBR(SWITCH)		;FILE NAME SWITCH SCANNER & EXECUTION.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{A2,A3,CHR,N}
	SETZ N,
L0:	SNEAKW CHR,
	CAIL CHR,"0"↔CAILE CHR,"9"↔GO L1

;ACCUMULATE DIGITS.
	INCHRW CHR↔ANDI CHR,17
	IMULI N,=10↔ADD N,CHR↔GO L0

;TEST FOR POSSIBLE SWITCH LETTERS.
L1:	CAIN CHR,"-"↔GO[INCHRW CHR,↔MOVNS N↔GO L0]
	CAIN CHR,"M"↔GO[INCHRW CHR,			;MAG SWITCH.
		CAIGE N,1↔MOVEI N,1↔CAILE N,9↔MOVEI N,9
		DAC N,MAG↔IMUL N,N↔DAC N,MAGMAG↔POP0J]
	CAIN CHR,"C"↔GO[INCHRW CHR,↔AOS CSFLG↔POP0J]	;COLOR SWITCH.
	POP0J
ENDR SWITCH;3/16/74(BGB)---------------------------------------------
SUBR(MEMORY)		;ALLOCATE BUFFER SPACE.
COMMENT .-----------------------------------------------------------.
	CDR JOBREL↑↔DAC OLDTOP			;TOP OF CORE.

;SCAN BUFFER.
	DAC SCAN
	LAC 1,MAG↔IMUL 1,MROWS↔DAC 1,UROWS
	LAC 1,MAG↔IMUL 1,NCOLS↔DAC 1,UCOLS
	ADD 0,1					;SIZE OF SPAN BUFFER.

;V2D BUFFER.
	DAC BUFFER
	HLRE 1,PPPN↔MOVN 1,1			;SIZE OF V2D FILE.
	ADD 0,1
	IDIVI 1,=9↔DAC 1,ECOUNT+1		;INITIAL EDGE COUNT.

;YLIST BUFFER.
	DAC YLIST+1
	ADD 0,1

;VIDEO BUFFERS.
	DAC TVRED↔DAC TVBUF
	ADDI =10496↔DAC TVGRN
	ADDI =10496↔DAC TVBLU
	ADDI =10496
	SKIPN CSFLG↔SUBI =20992

;REQUEST CORE EXPANSION - AND CLEAR NEW CORE.
	CORE↔GO[OUTSTR[ASCIZ/FATAL: CAN'T GET ENUF CORE./]↔EXIT]
	LAC OLDTOP↔SETZM @↔DIP↔AOS↔LAC 1,JOBREL↑↔BLT 0,(1)↔POP0J

ENDR MEMORY;3/13/74(BGB)---------------------------------------------

	XLIST:  0
	YLIST:	0↔0		;CONTAINS SORTED: XWD RMIN,EDGE.
	ECOUNT: 0↔0		;NUMBER OF EDGES IN V2D.

;V2D FILE EDGE FORMAT:

;WORD0:		NFACE,,PFACE		;FACE SERIAL NUMBERS.
;WORD1:		X1 =	XPP(PVT(E))	;FLOATING PP ENDPOINT LOCII.
;WORD2:		Y1 =	YPP(PVT(E))
;WORD3:		X2 =	XPP(NVT(E))
;WORD4:		Y2 =	YPP(NVT(E))
;WORD5:		BYTE(9)RED,GRN,BLU,INT	;LEFT  V1.	NCCW(E).
;WORD6:		BYTE(9)RED,GRN,BLU,INT	;RIGHT V1.	PCW(E).
;WORD7:		BYTE(9)RED,GRN,BLU,INT	;LEFT  V2.	NCW(E).
;WORD8:		BYTE(9)RED,GRN,BLU,INT	;RIGHT V2.	PCCW(E).
;--------------------------------------------------------------------

;MKVID INTERNAL EDGE FORMAT:

;WORD0:	NFACE,,PFACE	;FACE SERIAL NUMBERS.
;WORD1:	NED,,PED	;XLIST EDGE RING.
;WORD2:	RMIN,,RMAX	;INITIAL & FINAL ROW.
	COLUMN ←← 3	;CURRENT COLUMN POSITION ON CURRENT UROW.
	DELCOL ←← 4	;DELTA COLUMN PER UROW.
	LINT   ←← 5	;CURRENT LEFT SIDE INTENSITY.
	RINT   ←← 6	;DELTA LEFT INTENSITY PER UROW.
	DLINT  ←← 7	;CURRENT RIGHT SIDE INTENSITY.
	DRINT  ←← 8	;DELTA RIGHT INTENSITY PER UROW.
;--------------------------------------------------------------------
	DEFINE NFACE(A,X){CAR A,0(X)}↔DEFINE PFACE(A,X){CDR A,0(X)}
	DEFINE NED  (A,X){CAR A,1(X)}↔DEFINE PED  (A,X){CDR A,1(X)}
	DEFINE NED. (A,X){DIP A,1(X)}↔DEFINE PED. (A,X){DAP A,1(X)}
	DEFINE RMIN (A,X){CAR A,2(X)}↔DEFINE RMAX (A,X){CDR A,2(X)}
	DEFINE RMIN.(A,X){DIP A,2(X)}↔DEFINE RMAX.(A,X){DAP A,2(X)}
SUBR(ESETUP)		;SETUP AND SORT THE EDGE BLOCKS.
COMMENT .-----------------------------------------------------------.
	IPTR ←← 15	;INPUT  POINTER.
	OPTR ←← 16	;OUTPUT POINTER.

;FLOATING SCALE QUANTIES FOR ESET.
	LAC MROWS↔ASH -1↔FLOAT↔DAC DY
	LAC NCOLS↔ASH -1↔FLOAT↔DAC DX
	LAC MAG↔FLOAT↔DAC DZ
	LAC IPTR,BUFFER		
	LAC OPTR,YLIST↔SOS OPTR

L1:	CALL(ESET,IPTR)↔ADDI IPTR,=9
	JUMPE 1,L2↔PUSH OPTR,1		;SAVE EDGE IN YLIST.
	RMIN 0,1↔DIP 0,(OPTR)		;XWD RMIN,EDGE

L2:	SOSLE ECOUNT↔GO L1
	HLRZM OPTR,ECOUNT		;UPDATE EDGE COUNT.
	CALL(HEAP,YLIST,ECOUNT)		;HEAP SORT THE Y-LIST BY RMIN.
	POP0J

ENDR ESETUP;3/13/74(BGB)---------------------------------------------

	DECLARE{DX,DY,DZ}	;NCOLS/2 ;MROWS/2 ;MAG
SUBR(ESET,EDGE)		;SETUP AN EDGE BLOCK.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{E,R1,C1,R2,C2,I1L,I1R,I2L,I2R,RDEL1,RDEL2};15,16,17
	X1←←1 ↔ Y1←←2 ↔	X2←←3 ↔ Y2←←4
	LAC E,EDGE

;UROW ← (NROWS/2 - SCALE*(YPP - ORGY))*MAG
;UCOL ← (MCOLS/2 + SCALE*(XPP + ORGX))*MAG

	LAC Y1(E)↔FSB ORGY↔FMP SCALE↔LAC R1,DY↔FSBR R1,0↔FMPR R1,DZ
	LAC X1(E)↔FSB ORGX↔FMP SCALE↔LAC C1,DX↔FADR C1,0↔FMPR C1,DZ
	LAC Y2(E)↔FSB ORGY↔FMP SCALE↔LAC R2,DY↔FSBR R2,0↔FMPR R2,DZ
	LAC X2(E)↔FSB ORGX↔FMP SCALE↔LAC C2,DX↔FADR C2,0↔FMPR C2,DZ

;MAKE CERTAIN THAT R1 IS LESS THAN R2.

	CAMLE R1,R2↔GO[EXCH R1,R2↔EXCH C1,C2
	LAC 5(E)↔EXCH 8(E)↔DAC 5(E)
	LAC 6(E)↔EXCH 7(E)↔DAC 6(E)↔GO .+1]

;CLIP AND QUANTIZE THE ROW COORDINATES R1 AND R2.

  ;RMIN ← TRUNCATE(R1+1.0) MAX 0;	= FIRST INTEGRAL ROW.
  ;RMAX ← TRUNCATE(R2);			= LAST  INTEGRAL ROW.
  ;RDEL1 ← FLOAT(RMIN) - R1 ;		= ROWS TIL START OF EDGE.

	LAC RDEL2,R2↔FSB RDEL2,R1	;NUMBER OF ROWS.
	SETZ 1,↔JUMPL R2,POP1J.		;EASY NORTH CLIP: R2<0
	LAC 0,R1↔FADRI 0,(1.0)↔FIXX 0,	;TRUNCATE(R1+1.0)
	SKIPGE↔SETZ↔RMIN. 0,E		;INTEGER RMIN TO E'S NODE.
	CAMLE 0,UROWS↔POP1J		;EASY SOUTH CLIP: RMIN > UROWS.
	FIXX R2,↔RMAX. R2,E		;RMAX ← TRUNCATE(R2)
	CAMGE R2,0↔POP1J		;IGNORE HORIZONTAL EDGES.
	LAC RDEL1,0↔FLOAT RDEL1,	;RMIN FROM ACCUMULATOR 0.
	FSBR RDEL1,R1			;RDEL1 ← FLOAT(RMIN) - R1;

;FLOAT THE COLOR BYTES. 	00.0 TO 63.875
	CALL(FCOLOR,{5(E)})↔DAC I1L
	CALL(FCOLOR,{6(E)})↔DAC I1R
	CALL(FCOLOR,{7(E)})↔DAC I2L
	CALL(FCOLOR,{8(E)})↔DAC I2R

;COMPUTE THE DELTAS PER U-ROW.
	FSBR C2,C1↔FDVR C2,RDEL2	;DELTA COLUMNS PER U-ROW.
	FSBR I2L,I1L↔FDVR I2L,RDEL2	;DELTA LEFT INTENSITY PER U-ROW.
	FSBR I2R,I1R↔FDVR I2R,RDEL2	;DELTA RIGHT INTENSITY PER U-ROW.

;ADJUST INITIAL VALUES TO START ON INTEGRAL ROW NUMBER RMIN.
L2:	LAC 0,C2 ↔FMPR 0,RDEL1↔FADR C1, 0	;INITIAL COLUMN
	LAC 0,I2L↔FMPR 0,RDEL1↔FADR I1L,0	;INITIAL LEFT INTENSITY.
	LAC 0,I2R↔FMPR 0,RDEL1↔FADR I1R,0	;INITIAL RIGHT INTENSITY.

;FIX TO 18 BIT INTEGER WITH 18 BIT FRACTION.
L3:	CALL(F18.18,C1)↔DAC 1,C1
	CALL(F18.18,C2)↔DAC 1,C2
	FIX I1L,211000↔FIX I1R,211000
	FIX I2L,211000↔FIX I2R,211000

;STORE INTO EDGE BLOCK.
L4:	DAC C1,COLUMN(E)			;INITIAL COLUMN POSITION.
	DAC C2,DELCOL(E)			;DELTA COLUMN PER U-ROW.
	DAC I1L,LINT(E)↔ DAC I1R,RINT(E)	;INITIAL INTENSITIES.
	DAC I2L,DLINT(E)↔DAC I2R,DRINT(E)	;DELTA INTENSITIES.
	SETZM 1(E)				;XLIST LINKS.
L5:	LAC 1,E↔POP1J				;RETURN THE EDGE.
ENDR ESET;3/13/74(BGB)-----------------------------------------------

SUBR(FCOLOR,XX)		;FLOAT THE PROPER COLOR BYTE.
COMMENT .-----------------------------------------------------------.
	LAC 0,XX↔LAC 1,CSFLG
	XCT[JFCL↔ROT 9↔MOVS↔ROT -9](1)	;WHT - RED - GRN - BLU.
	ANDI 777↔FSC 230↔POP1J		;00.0
ENDR FCOLOR;3/133/74(BGB)--------------------------------------------

SUBR(F18.18,X)		;FIX(X) TO 000000.000000 FORMAT.
COMMENT .-----------------------------------------------------------.
 	MOVM 1,X↔CAMGE 1,[511.0]↔GO[
	FIX 1,211000↔SKIPGE X↔MOVNS 1↔POP1J]	;FEWER THAN 9 HIGH BITS.
	LAC 0,1↔FIXX 1,↔FLOAT 1,	;INTEGER  PART TO AC-1
	FSB 0,1↔FIX 0,211000		;FRACTION PART TO AC-0
	FIXX 1,↔MOVSS 1↔DAP 0,1		;COMBINE.
	SKIPGE X↔MOVNS 1↔POP1J		;SET SIGN AND RETURN.
ENDR F18.18;---------------------------------------------------------
SUBR(HEAP,ADR,NN)	;HEAP SORT AN ARRAY[1:N] OF N ELEMENTS.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{X,I,J,K,N}
	A←←0
;MODIFY ALL INSTRUCTIONS THAT HAVE A NON-ZERO INDEX FIELD.
	LAC N,NN↔LAC ADR↔SOS↔MOVEI 1,L1↔CAIG 1,L5↔GO[
	CAR X,(1)↔TRNE X,17↔DAP 0,(1)↔AOJA 1,.-1]
;--------------------------------------------------------------------
; PHASE ONE, PUT 'EM UNDER THE HEAP & BIGGIES TRICKLE UP;
;	FOR K←2 STEP 1 UNTIL N DO
;	BEGIN
;		I←K;
;		X←A[K];
;		WHILE I>1 ∧ X>A[J←I%2] DO
;		BEGIN A[I]←A[J]; I←J END;
;		A[I]←X;
;	END;
;--------------------------------------------------------------------
	SKIPA K,[2]
L1:	DAC X,A(I)↔CAMLE K,N↔SOJA K,L3↔LAC I,K↔LAC X,A(K)
L2:	CAIG I,1↔AOJA K,L1↔LAC J,I↔ASH J,-1
	CAMG X,A(J)↔AOJA K,L1↔LAC A(J)↔DAC A(I)
	LAC I,J↔GO L2
;--------------------------------------------------------------------
; PHASE TWO, TAKE 'EM OFF THE TOP & PROMOTE SUBORDINATES;
;	FOR K←N STEP -1 UNTIL 2 DO
;	BEGIN
;		X←A[K];A[K]←A[1];I←1;
;		WHILE (J←2*I)<K DO
;		BEGIN
;			IF A[J+1]>A[J] ∧ (J+1)<K THEN J←J+1;
;			IF X≥A[J] THEN DONE ELSE
;			BEGIN A[I]←A[J];I←J;END;
;		END;	A[I]←X;
;	END;
;--------------------------------------------------------------------
L3:	LAC X,A(K)↔MOVEI I,1↔LAC A(I)↔DAC A(K)
L4:	LAC J,I↔ASH J,1↔CAML J,K↔GO L5
	LAC A(J)↔AOS J↔CAMGE A(J)↔CAML J,K↔SOS J
	CAML X,A(J)↔GO L5
	LAC A(J)↔DAC A(I)↔LAC I,J↔GO L4
L5:	DAC X,A(I)↔CAIN K,2↔POP2J↔SOJA K,L3
ENDR HEAP;3/12/74(BGB)-----------------------------------------------

COMMENT ⊗
SUBR(BUBBLE,ADR,NN)
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{I,J,K}
	A←←0
;FOR I←1 STEP 1 UNTIL N-1 DO
;FOR J←I+1 STEP 1 UNTIL N DO
;IF A[I] > A[J] THEN A[I] ↔ A[J];
	LAC ADR↔SOS↔DAP L1↔DAP L2↔DAP L2+1↔DAP L3
	MOVEI I,1
L1:	LAC A(I)↔CAML I,NN↔POP2J
	MOVEI J,1(I)
L2:	CAMLE A(J)↔EXCH A(J)
	CAME J,NN↔AOJA J,L2
L3:	DAC A(I)↔AOJA I,L1
ENDR BUBBLE;--------------------------------------------------------⊗
SUBR(MKVIDEO)		;MAKE VIDEO IMAGE.
COMMENT .-----------------------------------------------------------.

;REDO FILE LOOKUP FOR GREEN AND BLUE.
	LAC CSFLG↔CAILE 1↔GO[			;COLOR SYNTHESIS RE-READ.
	LAC[XWD IFILE,FILNAM]↔BLT FILNAM+3	;RESTORE FILENAME.
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT		;RE-INIT.
	LOOKUP 1,FILNAM↔GO[OUTSTR[
	ASCIZ/V2D FILE DISAPPEARED./]↔POP0J]↔GO .+1]

;INPUT V2D FILE AND CONVERT THE EDGES INTO ROW,,COLUMN FORMAT.
	LAC PPPN↔HRR BUFFER↔SOS↔DAC INARG
	IN 1,INARG↔RELEASE 1,
	SETZM XLIST
	LAC YLIST+1↔DAC YLIST
	LAC ECOUNT+1↔DAC ECOUNT
	CALL(ESETUP)		;SETUP AND SORT EDGE BLOCKS.

	LAC [POINT 6,0]↔LAC 1,CSFLG
	HRR @[TVBUF↔TVRED↔TVGRN↔TVBLU](1)
	ADDI 200↔DAC TVPTR	;FOR PACK ROUTINE.

;FILL ALL THE MICRO ROWS.
	SETZM UROW		;FIRST MICRO ROW.

L1:	SETZM SUBROW#		;FOR SUBROW ← 0 STEP 1 UNTIL MAG-1 DO
	LAC 1,UCOLS↔ADD 1,SCAN	;CLEAR THE SCAN BUFFER.
	CDR SCAN↔SETZM @
	HRL↔AOS↔BLT 0,-1(1)

L2:	CALL(EFETCH)		;FETCH EDGES RMIN ≤ UROW.
	CALL(FILL)		;FILL SCAN FROM XLIST SPANS.
	CALL(ADVANCE)		;ADVANCE THE EDGES OF THE XLIST.
	AOS 1,UROW
	AOS 1,SUBROW
	CAMGE 1,MAG↔GO L2

	CALL(PACK)		;ACCUMULATE SCAN INTO TVBUF.
	LAC UROW
	CAMGE UROWS↔GO L1
	POP0J
ENDR MKVIDEO;3/13/74(BGB)--------------------------------------------
SUBR(EFETCH)		;FETCH EDGES RMIN ≤ UROW.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{E,E1,E2}

L1:	SKIPN 1,YLIST↔POP0J			;YLIST NON-EMPTY.
	CAR 0,(1)↔CAMLE 0,UROW↔POP0J		;WHEN RMIN ≤ UROW.
	CDR E,(1)
	AOS YLIST↔SOSG ECOUNT↔SETZM YLIST	;ADVANCE DOWN YLIST.

;INSERT EDGE INTO XLIST.
	SETZ  E1,
	SKIPN E2,XLIST↔GO[DAC E,XLIST↔GO L1]	;EMPTY XLIST CASE.
	LAC 0,COLUMN(E)↔LAC 1,DELCOL(E)

;SCAN XLIST UNTIL COLUMN(E) < COLUMN(E2) OR E2=0.
	CAMN 0,COLUMN(E2)↔GO[
	 CAML 1,DELCOL(E2)↔GO .+2↔GO .+3]
	CAML 0,COLUMN(E2)↔GO[
	 LAC E1,E2↔PED E2,E2			;NEXT EDGE.
	 JUMPN E2,.-3↔GO .+1]			;END OF XLIST

;PLACE E IN XLIST.

	NED. E1,E↔PED. E2,E			;PLACE E IN LIST.
	SKIPE E1↔PED. E,E1
	SKIPN E1↔DAC E,XLIST			;NEW HEAD OF XLIST.
	SKIPE E2↔NED. E,E2↔GO L1

ENDR EFETCH;3/13/74(BGB)---------------------------------------------
SUBR(FILL)		;FILL SCAN FROM XLIST SPANS.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{E1,E2,C1,C2}

	SKIPN E2,XLIST↔POP0J	;FIRST EDGE OF XLIST.
	LAC SCAN↔DAP L2

L1:	LAC E1,E2↔PED E2,E2	;NEXT EDGE OF XLIST.
	SKIPN E2↔POP0J		;END OF XLIST.

;FILL MICRO PIXELS C1 TO C2-1 INCLUSIVE.
	HLRE  C2,COLUMN(E2)↔JUMPL C2,L1		;RIGHT COLUMN OF SPAN.
	CAMLE C2,UCOLS↔LAC C2,UCOLS		;EAST CLIPPING.
	HLRE  C1,COLUMN(E1)			;LEFT COLUMN OF SPAN.
	CAMLE C1,UCOLS↔POP0J			;SPAN IS TOO FAR EAST.

	SUB C2,C1		;C2 ← NUMBER OF MICRO COLUMNS.
	JUMPLE C2,L1		;SEGMENT TOO SHORT OR BACKWARDS.

;DELTA INTENSITY PER INTEGRAL MICRO COLUMN TO AC-0.
	LAC LINT(E2)
	SUB RINT(E1)
	IDIV  0,C2		;AC0 ←  DELTA  INTENSITY.
	LAC   1,RINT(E1)	;AC1 ← INITIAL INTENSITY.

;WEST SIDE CLIPPING.
	JUMPL C1,[ADD C2,C1	;DECREMENT SPAN COUNT.
	 IMUL C1,0↔SUB 1,C1	;UPDATE STARTING INTENSITY.
	 SETZ C1,↔GO .+1]	;START IN COLUMN ZERO.
	MOVNS C2↔DIP C2,C1	;SETUP AOBJN POINTER.

;INNER MOST LOOP - FILL IN A SEGMENT OF A MICRO SCAN LINE.
L2:	ADDM  1,SCAN(C1)	;ADDRESS MODIFICATION.
	ADD   1,0		;ADD IN DELTA INTENSITY.
	AOBJN C1,.-2↔GO L1

ENDR FILL;3/13/74(BGB)-----------------------------------------------
SUBR(ADVANCE)		;ADVANCE THE EDGES OF THE XLIST.
COMMENT .-----------------------------------------------------------.
	E ←← 3

	SKIPA E,XLIST
L1:	PED E,E↔JUMPE E,L9

;WHEN RMAX(E) ≤ UROW DELETE EDGE FROM XLIST.

	RMAX 0,E↔CAMG 0,UROW↔GO[
	NED 1,E↔PED 2,E
	SKIPE 1↔PED. 2,1
	SKIPE 2↔NED. 1,2
	CAMN E,XLIST↔DAC 2,XLIST	;KILLED FIRST EDGE.
	LAC E,2↔GO L1+1]

;ADVANCE EDGE PARAMETERS.

	LAC DELCOL(E)↔ADDM COLUMN(E)	;COLUMN POSITION.
	LAC DLINT (E)↔ADDM  LINT (E)	;LEFT  INTENSITY.
	LAC DRINT (E)↔ADDM  RINT (E)	;RIGHT INTENSITY.
	GO L1

;(SHOULD MAKE CERTIAN THAT THE XLIST IS IN ORDER AND THAT
; ADJACENT EDGES HAVE EQUAL FACES)
L9:	POP0J

ENDR ADVANCE;3/13/74(BGB)--------------------------------------------

SUBR(PACK)		;PACK A SCAN INTO THE CURRENT TV BUFFER.
COMMENT .-----------------------------------------------------------.
	ACCUMULATORS{I,J,N}

;PACK SCAN BUFFER INTO TV BUFFER.
	MOVN N,MAG		;NUMBER OF MICROS PER LINEAR MACRO.
	MOVE I,NCOLS		;NUMBER OF MACRO COLUMNS.
	MOVE J,SCAN		;POINTER TO SCAN BUFFER.
L1:	SETZ↔DIP N,J		;XWD -MAG,,SCAN
	ADD (J)↔AOBJN J,.-1	;ACCUMULATE A MACRO PIXEL.
	SKIPE↔IDIV MAGMAG
	CAR
L2:	SKIPE↔JFCL
	IDPB 0,TVPTR
	SOJG I,L1↔POP0J

ENDR PACK;3/13/74(BGB)-----------------------------------------------

TVPTR:	0			;INITIALIZED BY MKVIDEO.
SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
COMMENT .--------------------------------------------------------.

;GET FILENAME.
	LAC IFILE↔SKIPN 1,CSFLG↔GO .+3
	LAC 1,['X'↔'I'↔'C'↔'X'](1)↔ROTC 0,-6↔DAC FILNAM
	LAC[SIXBIT/TMP/]↔DAC EXTION↔SETZM EXTION+1↔SETZM PPPN

;INITIALIZE DISK.
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/	ENTER FAILED.
/]↔GO .+4]

;RESET HEADER.
	LAC 1,CSFLG↔LAC 1,TVBUF(1)
	DAP 1,DUMARG↔SOS DUMARG
	MOVSI 0,HEAD1↔HRR 0,1↔BLT 177(1)

;DUMP MODE OUTPUT TO DISK.
	OUT 1,DUMARG↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,↔POP0J

;STANDARD TELEVISION FILE HEADER.
HEAD1:	-1
	6	; BITS PER BYTE.
	=48	;WORDS PER LINE.
	=20	;FIRST AND LAST ROW.
	=235
	=28
	=315	;FIRST AND LAST COL.
	XWD -=10368,200
	BLOCK 200
DUMARG:	IOWD 24400,TVBUF↔0	;ADDRESS MODIFICATION !
ENDR TVDSKO;7/1/73(BGB)----------------------------------------------
SUBR(RGB2IC)		;CONVERT RGB TO QUAM'S IC COLOR FORMAT.
COMMENT .-----------------------------------------------------------.

	ACCUMULATORS{P1,P2,P3,Q1,Q2,I1,B1,I2,B2,R1,R2,G1,G2}

	MOVEI =31104↔DAC CNT#
	LAC[POINT 6,0]
	HRR TVRED↔ADDI 200↔DAC P1↔DAC Q1
	HRR TVGRN↔ADDI 200↔DAC P2↔DAC Q2
	HRR TVBLU↔ADDI 200↔DAC P3

L:	ILDB R1,P1↔ILDB G1,P2↔ILDB B1,P3	;PICK'EM UP.
	ILDB R2,P1↔ILDB G2,P2↔ILDB B2,P3

	LAC I1,R1↔ADD I1,G1↔ADD I1,B1		;ADD'EM UP.
	LAC I2,R2↔ADD I2,G2↔ADD I2,B2

	IDIVI I1,3↔IDPB I1,Q1			;INTENSITY BYTE-1.
	IDIVI I2,3↔IDPB I2,Q1			;INTENSITY BYTE-2.

	ADD R1,R2↔ADD G1,G2↔ADD I1,I2
	LAC R1↔SUB I1↔IDIVI 6↔ADDI 40↔IDPB Q2	;COLOR BYTE-1.
	LAC G1↔SUB I1↔IDIVI 6↔ADDI 40↔IDPB Q2	;COLOR BYTE-2.

	SOSLE CNT↔GO L
	POP0J
ENDR RGB2IC;7/20/73(BGB)---------------------------------------------

END SA