.TITLE	IMGTEK	Image data interface
	.NLIST	BEX
	.ENABL	LC
;
; Image data interface
;
; This module decodes a data stream in text, bitmap or facsimile (dacom)
; format and produces a data stream for the Tektronix emulator.
;
; This program requires the VCG Driver module TEKVCG along with the Peritek
; CSP-2 subroutine package.
;
; Dacom 450 frame format (all bits are inverted in file)
;
;  0                   1                   2                   3
;  0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0
; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
; |             Synchronization Code              |  Flags  |Seq|
; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;  3                 4                   5                   6
;  1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0
; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
; |     Samples       |      X Position       | M |  W  |  B  |
; +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;
; Synchronization Code	{000110,111001,111001,000110}
; Flags			{Run,CFB,Rpt,Spr,SUB}
; Seq			frame sequence (tumbled)
; Samples		count of data bits (0-512)
; X Position		current X position (0-1725)
; M			current mode 0: w-w, 1: b-w, 2: w-b, 3: b-b
; W			current white run length
; B			current black run length
;
; External symbols
;
	.GLOBL	TKINIT,TKSEND	;flashy graphics
;
; Entry symbols
;
	.GLOBL	VCGINI,VCGWRT	;image data interface
;
; System definitions
;
	.ASECT
	.MCALL	.COM,.CHR	;dcnlib definitions
	.COM			;define common data
	.CHR			;define ascii character codes
;
; Module definitions
;
PXMAX	=	1726.		;max x pels
;
; Dacom 450 facsimile frame format
;
.	=	0
FM.CNT:	.BLKB	1		;frame count (octets)
FM.COD:	.BLKB	1		;frame code
FC.SET	=	070		;setup frame
FC.DAT	=	071		;data frame
FC.EOF	=	072		;eof frame
FM.DAT:	.BLKB	74.		;data field (585 bits)
SYCOD1	=	^B01000110	;sync codes (inverted)
SYCOD2	=	^B10011110
SYCOD3	=	^B00011011
SSRCRF	=	^B00000100
FM.LEN	=	.		;end of frame
;
; Procedure segment
;
	.PSECT	$BOSI,RO,I
;
; Subroutine to initialize this module and VCG driver
; vcgini( <data type>, <max x>, <max y>, <image mode>)
;
; Data type
; 0	Tektronix emulator (text/vector graphics)
; 1	bitmap graphics
; 2	facsimile graphics
;
; Image mode
; 0	undetermined
; 1	landscape
; 2	portrait
;
VCGINI:	MOV	R5,-(SP)	;c/ulp entry
	MOV	SP,R5
	MOV	R1,-(SP)
	MOV	4(R5),TYPE	;save parameters
	MOV	6(R5),XMAX
	MOV	10(R5),YMAX
	MOV	12(R5),LPMODE
	TSTB	TKRUN		;is vcg running
	BNE	2$		;branch if yes
	JSR	PC,TKINIT	;no. initialize vcg driver
	INCB	TKRUN
2$:	MOV	#ESC,R0		;make clean slate
	JSR	PC,TKSEND
	MOV	#FF,R0
	JSR	PC,TKSEND
	ASL	TYPE		;is this text mode
	BEQ	3$		;branch if no
	MOV	#SOH,R0		;initialize image parameters
	JSR	PC,TKSEND
	MOV	#33.,R1
	MOV	XMAX,R0		;send width (33-34)
	JSR	PC,VCGSIZ
	MOV	YMAX,R0		;send height (35-36)
	JSR	PC,VCGSIZ
	MOV	#1,R0		;send scale (37)
	JSR	PC,VCGSIX
	MOV	LPMODE,R0	;send image mode (38)
	JSR	PC,VCGSIX
	MOV	#FS,R0		;turn on bitmap
	JSR	PC,TKSEND
	MOV	#FRAME,FRMPTR	;initialize decoders
	CLR	LACVAL
	CLR	XPOSN
	CLR	MODE
	CLR	RUN
3$:	MOV	(SP)+,R1	;evas
	MOV	(SP)+,R5
	RTS	PC
;
; Subroutine to send parameter values to VCG driver
; R0 = parameter value, r1 = parameter index
;
VCGSIX:	MOV	R0,-(SP)	;send one parameter
	BR	VCG20
;	
VCGSIZ:	MOV	R0,-(SP)	;send two parameters
	MOV	R1,R0		;send parameter number
	INC	R1
	BIC	#^C077,R0
	ADD	#040,R0
	JSR	PC,TKSEND
	MOV	@SP,R0		;send high-order bits
	ASH	#-6,R0
	BIC	#^C077,R0
	ADD	#040,R0
	JSR	PC,TKSEND
VCG20:	MOV	R1,R0		;send parameter number
	INC	R1
	BIC	#^C077,R0
	ADD	#040,R0
	JSR	PC,TKSEND
	MOV	(SP)+,R0	;send low-order bits
	BIC	#^C077,R0
	ADD	#040,R0
	JSR	PC,TKSEND
	RTS	PC
;
; Subroutine to decode image data
; vcgwrt( <data word>)
;
VCGWRT:	MOV	R5,-(SP)	;c/ulp entry
	MOV	SP,R5
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	4(R5),R0	;get data octet
	ADD	TYPE,PC
	BR	TXTDEC		;0 text data
	BR	BITDEC		;1 bitmap data
	BR	FAXDEC		;2 facsimile data
;
; Text-mode decode
; R0 = word
;
TXTDEC:	JSR	PC,TKSEND	;send first octet
	SWAB	R0
	JSR	PC,TKSEND	;send second octet
	BR	HOME
;
; Bitmap-mode decode
; R0 = word
;
BITDEC:	MOV	#16.,R2		;initialize
	MOV	R0,R1
	SWAB	R1
1$:	TST	LACVAL		;is current run white
	BMI	4$		;branch if no
2$:	ROL	R1		;yes. is pel white
	BCC	5$		;branch if yes
	MOV	LACVAL,R0	;no. output white run
	BEQ	3$
	JSR	PC,OUTFIL
	CLR	LACVAL
3$:	DEC	LACVAL		;update black run
	BR	6$
;
4$:	ROL	R1		;black. is pel black
	BCS	3$		;branch if yes
	MOV	LACVAL,R0	;no. output black run
	BEQ	5$
	JSR	PC,OUTFIL
	CLR	LACVAL
5$:	INC	LACVAL		;update white run
6$:	INC	XPOSN
	CMP	XPOSN,XMAX	;is this line overflow
	BHIS	7$		;branch if yes
	SOB	R2,1$		;no. tout suite
	BR	HOME
;
7$:	CLR	XPOSN		;line overflow. reset x position
	MOV	LACVAL,R0	;is this white run
	BGE	8$		;branch if yes
	JSR	PC,OUTFIL	;no. output black run
8$:	CLR	LACVAL
	CLR	R0		;end line
	JSR	PC,OUTFIL
HOME:	MOV	(SP)+,R1	;evas
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RTS	PC
;
; Facsimile-mode decode
; R0 = word
;
FAXDEC:	COM	R0		;tumbleweed
	MOV	R0,@FRMPTR	;stash word
	ADD	#2,FRMPTR
	CMP	FRMPTR,#FRMEND	;is buffer full
	BLO	HOME		;branch if no
	MOV	#FRAME,FRMPTR	;yes. extract header fields
	CMPB	FRAME+FM.COD,#^C<FC.DAT> ;is this data frame
	BNE	1$		;branch if no
	MOV	FRAME+FM.DAT+2,R1 ;yes. extract sample count
	MOV	FRAME+FM.DAT+4,R0
	ASHC	#1,R0
	BIC	#^C1777,R0
	MOV	R0,SAMPLE
	MOV	FRAME+FM.DAT+4,R1 ;extract x position
	MOV	FRAME+FM.DAT+6,R0
	ASHC	#7,R0
	BIC	#^C7777,R0
	MOV	R0,XPOSN
	MOV	FRAME+FM.DAT+6,R0 ;extract run cods
	ASH	#-5,R0
	BIC	#^C377,R0
	MOV	R0,CODE
	JSR	PC,DACOM	;decode frame
	BR	HOME
;
1$:	CMPB	FRAME+FM.COD,#^C<FC.SET> ;is this setup frame
	BNE	HOME		;branch if no
	MOV	#SOH,R0		;yes. initialize image parameters
	JSR	PC,TKSEND
	MOV	#33.,R1
	MOV	#1726.,R0	;send width (33-34)
	JSR	PC,VCGSIZ
	MOVB	FRAME+FM.DAT+10,R0 ;extract length code
	BIC	#^C3,R0		;0: 11", 1: 14", 2: 5-1/2"
	ASL	R0
	MOV	HGTCOD(R0),R0
	JSR	PC,VCGSIZ	;send height (35-36)
	MOVB	FRAME+FM.DAT+7,R0 ;extract speed code
	ASH	#-6,R0		;0: quality, 1: express, 2: detail
	BIC	#^C3,R0
	ASL	R0
	MOV	SPECOD(R0),R0
	JSR	PC,VCGSIX	;send scale (37)
	MOVB	FRAME+FM.DAT+10,R0 ;extract length code
	BIC	#^C3,R0		;0: 11", 1: 14", 2: 5-1/2"
	ASL	R0
	MOV	LNGCOD(R0),R0	;is image mode specified
	BNE	2$		;branch if yes
	MOV	LPMODE,R0	;no. use supplied one
2$:	JSR	PC,VCGSIX	;send image mode (38)
	MOV	#FS,R0		;turn on bitmap
	JSR	PC,TKSEND
	BR	HOME
;
; Decode dacom 450 encoded fax data
; See: weber, d.r. an adaptive run length encoding algorithm. icc-75?
; Uses r0-r5
;
; Decoding state variables (set in header of current frame)
;
; SAMPLE	count of data bits remaining (0-512)
; XPOSN		current X position (0-1725)
; BLKSIZ	current size of black run-length word (2-7)
; WHTSIZ	current size of white run-length word (2-7)
; MODE		current state (column) 0: w-w, 1: b-w, 2: w-b, 3: b-b
; RUN		run length this mode
;
DACOM:	TST	SAMPLE		;is frame trivial
	BEQ	RETURN		;branch if yes
	MOV	#FRAME+FM.DAT+7,R1 ;no. initialize for bit scan
	MOV	#8.-5+1,R2
	MOVB	(R1)+,R3	;get first octet
	ASH	#-5,R3
	MOV	#FRAME,R0
STATE:	TST	SAMPLE		;is this last bit
	BNE	LATER		;branch if no
	JSR	PC,UPDATE	;yes. clean out run
RETURN:	RTS	PC
;
LATER:	CMP	MODE,#3		;is new-frame data valid
	BHI	1$		;branch if no
	MOV	CODE,R5		;yes. is new frame ready
	BEQ	1$		;branch if no
	CLR	CODE		;yes. copy state variables
	MOV	R5,R0
	BIC	#^C7,R0
	MOV	R0,BLKSIZ
	ASH	#-3,R5
	MOV	R5,R0
	BIC	#^C7,R0
	MOV	R0,WHTSIZ
	ASH	#-3,R5
	BIC	#^C3,R5
	MOV	R5,MODE
1$:	MOV	MODE,R0		;flick off to right state
	ASL	R0
	ADD	R0,PC
	BR	STAT00		;0 w-w
	BR	STAT01		;1 b-w
	BR	STAT02		;2 w-b
	BR	STAT03		;3 b-b
	BR	STAT04		;4 p
	BR	STAT05		;5 i=1 from b-w
	BR	STAT06		;6 i=0 from 5
	BR	STAT07		;7 i=1 from 5
	BR	STAT08		;8 i=0 from w-b
	BR	STAT09		;9 i=1 from 8
	BR	STAT10		;10 i=0 from 8
;
STAT00:	MOV	#WHTSIZ,R0	;w-w. decode run length word
	JSR	PC,WORD
	BEQ	STATE		;branch if last word
	JSR	PC,UPDATE	;update run
	MOV	#4,MODE		;assume p state
	JSR	PC,BIT		;get p bit
	BCS	STATE		;branch if p=1
	MOV	#3,MODE		;p=0. switch to b-b
	BR	STATE
;
STAT03:	MOV	#BLKSIZ,R0	;b-b. decode run length word
	JSR	PC,WORD
	BEQ	STATE		;branch if last word
	JSR	PC,UPDATE	;update run
	MOV	#4,MODE		;assume p state
	JSR	PC,BIT		;get p bit
	BCS	STATE		;branch if p=1
	MOV	#0,MODE		;p=0. switch to w-w
	BR	STATE
;
STAT04:	JSR	PC,BIT		;p. get i bit
	BCC	1$		;branch if i=0
	MOV	#2,MODE		;i=1. switch to w-b
	BR	EXIT
;
1$:	MOV	#1,MODE		;i=0. switch to b-w
	BR	EXIT
;
STAT02:	JSR	PC,BIT		;w-b. get i bit
	BCS	EXIT		;branch if i=1
	JSR	PC,UPDATE	;i=0. update run
	MOV	#8.,MODE	;go to state 8
	BR	JUMP
;
STAT01:	JSR	PC,BIT		;b-w. get next bit
	BCC	EXIT		;branch if i=0
	JSR	PC,UPDATE	;i=1. update run length
	MOV	#5,MODE		;go to state 5
	BR	JUMP
;
EXIT:	INC	RUN		;update run length
	BR	JUMP
;
STAT05:	INC	MODE		;assume state 6
	JSR	PC,BIT		;get next bit
	BCC	JUMP		;branch if zero
	INC	MODE		;one. go to state 7
	BR	JUMP
;
STAT06:	MOV	#0,MODE		;assume w-w
	JSR	PC,BIT		;get next bit
	BCC	JUMP		;branch if zero
	MOV	#2,MODE		;one. go to w-b
	BR	EXIT
;
STAT07:	MOV	#3,MODE		;assume b-b
	JSR	PC,BIT		;get next bit
	BCS	JUMP		;branch if one
	BR	ERROR		;zero. error
;
STAT08:	INC	MODE		;assume state 9
	JSR	PC,BIT		;get next bit
	BCS	JUMP		;branch if one
	INC	MODE		;zero. go to state 10
	BR	JUMP
;
STAT09:	MOV	#3,MODE		;assume b-b
	JSR	PC,BIT		;get next bit
	BCS	JUMP		;branch if one
	MOV	#1,MODE		;one. go to b-w
	BR	EXIT
;
STAT10:	MOV	#0,MODE		;assume w-w
	JSR	PC,BIT		;get next bit
	BCC	JUMP		;branch if zero
ERROR:	CLR	MODE		;abort remainder of frame
	CLR	RUN
	CLR	SAMPLE
JUMP:	JMP	STATE
;
; Subroutine to update runs
;
UPDATE:	MOV	R1,-(SP)	;save registers
1$:	MOV	RUN,R1		;is anything there
	BEQ	7$		;branch if no
	ADD	XPOSN,R1	;reduce modulo xmax
	CMP	R1,#PXMAX
	BLO	2$
	MOV	#PXMAX,R1
2$:	SUB	XPOSN,R1
	ADD	R1,XPOSN
	SUB	R1,RUN
	TST	MODE		;is this white (both rows white)
	BEQ	3$		;branch if yes
	NEG	R1		;no. (one or both rows black)
3$:	TST	R1		;is this run white
	BMI	4$		;branch if no
	TST	LACVAL		;yes. is previous run white
	BPL	6$		;branch if yes
	BR	5$		;no. output run
;
4$:	TST	LACVAL		;black run. is previous run black
	BMI	6$		;branch if yes
5$:	MOV	LACVAL,R0	;no. output run
	BEQ	6$
	JSR	PC,OUTFIL
	CLR	LACVAL
6$:	ADD	R1,LACVAL	;update run
	CMP	XPOSN,#PXMAX	;is this end of line
	BLO	1$		;branch if no
	SUB	#PXMAX,XPOSN	;yes. reset x position
	MOV	LACVAL,R0	;is this white run
	BGE	8$		;branch if yes
	JSR	PC,OUTFIL	;no. output black run
8$:	CLR	LACVAL
	CLR	R0		;end line
	JSR	PC,OUTFIL
	BR	1$
;
7$:	MOV	(SP)+,R1	;restore registers
	RTS	PC
;
; Subroutine to output run word
; R0 = word
;
OUTFIL:	MOV	R1,-(SP)	;save
	MOV	R0,R1		;determine run type
	BGT	2$		;branch if white
	BLT	1$		;branch if black
	MOV	#100,R0		;end of line
	JSR	PC,TKSEND
	BR	4$
;
1$:	CMP	R1,#-37		;black
	BHIS	3$
	MOV	#100-37,R0
	JSR	PC,TKSEND
	ADD	#37,R1
	BR	1$
;
2$:	CMP	R1,#37		;white
	BLOS	3$
	MOV	#100+37,R0
	JSR	PC,TKSEND
	SUB	#37,R1
	BR	2$
;
3$:	MOV	R1,R0		;output residual
	ADD	#100,R0
	JSR	PC,TKSEND
4$:	MOV	(SP)+,R1	;evas
	RTS	PC
;
; Subroutine to get next bit
; R1 = frame pointer, r2 = remaining bits, r3 = octet, returns c(cc) = bit
;
BIT:	TST	SAMPLE		;are any bits remaining
	BEQ	2$		;branch if no
	DEC	SAMPLE		;yes. update trivia
	DEC	R2
	BNE	1$
	MOV	#8.,R2
	MOVB	(R1)+,R3	;get next octet
1$:	ROR	R3		;get next bit
2$:	RTS	PC
;
; Subroutine to decode run length word
; R0 = run-length code pointer, r4-r5 = scratch
;
WORD:	CLR	-(SP)		;initialize continuation switch
	MOV	R0,R5		;save run-length code pointer
1$:	MOV	@R5,R4		;get next subword
	MOV	#-1,R0
2$:	JSR	PC,BIT
	RORB	R0
	DEC	R4
	BNE	2$
	BIC	#^C377,R0	;leave it left-justified in byte
	MOV	R0,-(SP)
	MOV	@R5,R4		;right justify it
	SUB	#8.,R4
	ASH	R4,R0
	ADD	R0,RUN		;update run length
	MOV	(SP)+,R0
	CMPB	R0,#-1		;is this continue mode
	BNE	4$		;branch if no
	INC	@SP		;yes. make sure no decrease later
	CMP	@R5,#7		;increase size
	BHIS	3$
	INC	@R5
3$:	TST	SAMPLE		;is this end of frame
	BNE	1$		;branch if no
	BR	5$
;
4$:	INC	RUN		;update run length
	TST	@SP		;are we in continue mode
	BNE	5$		;branch if yes
	MOV	@R5,R4		;get size again
	MOVB	THRESH(R4),R4	;is lower limit 
	BEQ	5$		;branch if yes
	BITB	R4,R0		;no. are selected high-order bits zero
	BNE	5$		;branch if no
	DEC	@R5		;yes. decrease size
5$:	TST	(SP)+
	TST	SAMPLE		;set cc
	RTS	PC
	.PAGE
;
; Data segment
;
	.PSECT	$BOSD,RO,D
;
HGTCOD:	.WORD	2200.,2800.,1100.,2200. ;height. 0: 11", 1: 14", 2: 5-1/2"
SPECOD:	.WORD	4,6,2,4		;scale. 0: quality, 1: express, 2: detail
LNGCOD:	.WORD	0,0,1,0		;image mode. 0: 11", 1: 14", 2: 5-1/2"
THRESH:	.BYTE	0,0,0,200,300,300,300,300 ;thresholds
;
; Initialized variables
;
TKRUN:	.BYTE	0		;vcg initialized flag
	.EVEN
;
; Variables
;
TYPE:	.BLKW	1		;data type (0: text, 1: bitmap, 2: fax)
LPMODE:	.BLKW	1		;image mode
XMAX:	.BLKW	1		;max x coordinate
YMAX:	.BLKW	1		;max y coordinate
LACVAL:	.BLKW	1		;current run length
SAMPLE:	.BLKW	1		;remaining bits in frame
XPOSN:	.BLKW	1		;current x position
CODE:	.BLKW	1		;initial run codes
MODE:	.BLKW	1		;current mode (state)
RUN:	.BLKW	1		;run length this mode
WHTSIZ:	.BLKW	1		;white code size
BLKSIZ:	.BLKW	1		;black code size
FRMPTR:	.BLKW	1		;frame pointer
FRMCNT:	.BLKW	1		;frame counter
FRAME:	.BLKW	FM.LEN/2	;frame buffer
FRMEND	=	.		;end of frame buffer
	.EVEN
;
	.END