Directory of image this file is from
This file as a plain text file

/ 15	OS/8 PLOTTER SUBROUTINES FUER VC8E - INTERFACE
/
/	V 002.C
/
/ FEB-MAR 1976		W. HOUBEN
/ OCT     1978		W. HOUBEN
/
/	AUFRUFE :
/
/			CALL PLOTS
/
/			CALL PLOT  ( XPAGE , YPAGE , IPEN )
/
/			CALL WHERE  ( XPAGE , YPAGE , FACT )
/
/			CALL FACTOR ( FACT )
/
/	XPAGE :	X - KOORDINATE IN CM
/
/	YPAGE :	Y - KOORDINATE IN CM
/
/	IPEN :	PEN STATUS	( 2=PEN DOWN , 3=PEN UP )
/
/	FACT :	PLOT FACTOR
/
	OPDEF	DILC	6050
	OPDEF	DICD	6051
	SKPDF	DISD	6052
	OPDEF	DILX	6053
	OPDEF	DILY	6054
	OPDEF	DIXY	6055
	OPDEF	DILE	6056
	OPDEF	DIRE	6057
	OPDEF	MQL	7421
	OPDEF	MQA	7501
	ENTRY	PLOT
	ENTRY	WHERE
	ENTRY	PLOTS
	ENTRY	FACTO
	DUMMY ARG1
	DUMMY ARG2
	DUMMY ARG3
	OPDEF JMPI 5400
	OPDEF CDI 6203
ARG1,	BLOCK 2
ARG2,	BLOCK 2
ARG3,	BLOCK 2
XPNT,   ARG1
IPEN,
PNTR,   0
CNTR,   0
/
PLOTDX,	0
PLOTDY,	0
PLOTNA,	0
PLOTNX,	1
PLOTNY,	1
XINCR,	0
YINCR,	0
PLOTMV,	0
IX,	0
IY,	0
/
PLOT,  BLOCK 2
        TAD XPNT
        DCA PNTR
        TAD (-6
	DCA CNTR
A1,     TAD I PLOT
        INC PLOT#
        DCA I PNTR
        INC PNTR
        ISZ CNTR
       JMP	A1
	TAD I	ARG3	/ NEW PEN STATUS
	DCA	IPEN
	TAD	IPEN
	SPA
	CIA		/ IABS(IPEN)
	TAD	(-2
	SZA CLA
	JMP	PL1
	JMS	PENDN
	JMP	PLOT1
PL1,	JMS	PENUP
PLOT1,	CALL	1,IFAD;	ARG	ARG1	/ GET X-PAGE
	CALL	1,FMP;	ARG	FACT
	CALL	1,STO;	ARG	XPOS
	CALL	1,FAD;	ARG	XPOS
	CALL	1,FMP;	ARG	HSCA
	CALL	0,FIX
	TAD	IX
	MQL
	TAD	IPEN
	RAL
	CLA MQA
	SZL
	DCA	IX
	MQA
	AND	(1777	/ MASK OF 10 BIT
	CIA CLL CML
	TAD	PLOTNX	/
	SZL		/ L = 0 : X < PX
	CIA
	DCA	PLOTDX	/ ABSOLUTE VALUE OF DIFFERENCE
	CLA IAC		/ AC = 1
	SNL		/ L = 1  AC = 1 , COUNT UP
	CIA		/ L = 0  AC = -1 , COUNT DOWN
	TAD	(-777	/ SHIFT TO HARDWARE GRID
	DCA	XINCR
	CALL	1,IFAD;	ARG	ARG2	/ GET Y-PAGE
	CALL	1,STO;	ARG	YPOS
	CALL	1,FAD;	ARG	YPOS
	CALL	1,FMP;	ARG	HSCA
	CALL	0,FIX
	TAD	IY
	MQL
	TAD	IPEN
	RAL
	CLA MQA
	SZL
	DCA	IY
	MQA
	AND	(1777	/ MASK OF 10 BIT
	CIA CLL CML
	TAD	PLOTNY	/ FETCH PREVIOUS Y
	SZL		/ L = 0 : Y < PY
	CIA
	DCA	PLOTDY	/ ABSOLUTE VALUE OF DIFFERENCE
	CLA IAC		/ AC = 1
	SNL		/ L = 1 , AC = 1 , COUNT UP
	CIA		/ L = 0 , AC = -1 , COUNT DOWN
	TAD	(-777	/ SHIFT TO HARDWARE GRID
	DCA	YINCR
	TAD	PLOTDY	/ DETERMINE DELTA X - DELTA Y
	CIA CLL
	TAD	PLOTDX
	SZL CLA		/ L = 0 : DELTA X < DELTA Y
	JMP	PLOT2
	TAD	PLOTDX	/ CHANGE DELTA X AND DELTA Y
	DCA	PLOT4	/ STORE TEMPORARY
	TAD	PLOTDY
	DCA	PLOTDX
	TAD	PLOT4	/ EXCHANGE DELTA Y AND DELTA X
	DCA	PLOTDY
	TAD	(10	/ SET AC=10 TO MAKE JMS SUBRY
PLOT2,	TAD	PLDIXI	/ AC=JMS SUBRX OR JMS SUBRY
	DCA	PLOT4	/ STORE IN PLOT4
	TAD	PLOTDX
	CLL RAR
	DCA	PLOTNA
	TAD	PLOTDX
	CMA
	DCA	PLOTMV
PLOT3,	ISZ	PLOTMV
	JMP	PLOT5
PLOT6,	RETRN	PLOT	/ ALL DONE
PLOT5,	TAD	PLOTDY
	TAD	PLOTNA
	DCA	PLOTNA
	TAD	PLOTNA
	CMA CLL
	TAD	PLOTDX
	SZL CLA
	JMP	PLOT4
	TAD	PLOTDX
	CIA
	TAD	PLOTNA
	DCA	PLOTNA
	JMS	SUBRY	/ DOUBLE MOTION
PLDIXI,	JMS	SUBRX
	SKP
PLOT4,	0		/ SINGLE MOTION
	DIXY		/ INTENSIFY
PLOT7,	DISD		/ WAIT FOR FLAG
	JMP	PLOT7
	KSF
	JMP	PLOT3
	TAD	(200
	6034
	TAD	(-203
	SZA CLA
	JMP	PLOT3
	6203
	JMPI	(7600
	CPAGE	20
SUBRX,	0
	TAD	PLOTNX
	TAD	XINCR
	DILX		/ INC OR DEC X
	TAD	(777
	DCA	PLOTNX
	JMPI	SUBRX
SUBRY,	0
	TAD	PLOTNY
	TAD	YINCR
	DILY		/ INC OR DEC Y
	TAD	(777
	DCA	PLOTNY
	JMPI	SUBRY
/
/	GET CURRENT POSITION 
/
WHERE,  BLOCK 2
        TAD XPNT
        DCA PNTR
        TAD (-6
	DCA CNTR
A2,     TAD I WHERE
        INC WHERE#
        DCA I PNTR
        INC PNTR
        ISZ CNTR
        JMP A2
	CALL	1,FAD;	ARG	XPOS
	CALL	1,ISTO;	ARG	ARG1
	CALL	1,FAD;	ARG	YPOS
	CALL	1,ISTO;	ARG	ARG2
	CALL	1,FAD;	ARG	FACT
	CALL	1,ISTO;	ARG	ARG3
        RETRN WHERE
/
/	PEN CONTROL ROUTINES
/
	CPAGE	10
PENUP,	0
	DIRE
	RTR
	SNL CLA
	JMPI	PENUP
	DILE
	JMS	WAIT
	JMPI	PENUP
	CPAGE	11
PENDN,	0
	DIRE
	RTR
	SZL CLA
	JMPI	PENDN
	CLA CLL IAC RAL	/ AC=2
	DILE
	JMS	WAIT
	JMPI	PENDN
	CPAGE	12
WAIT,	0
	TAD	(7757
	DCA	WT1
W1,	ISZ	WT2
	JMP	W1
	ISZ	WT1
	JMP	W1
	JMPI	WAIT
WT1,	0
WT2,	0
HSCA,	2065;6000;0000	/ + 30.0
FACT,	2014;0000;0000
XPOS,	0000;0000;0000
YPOS,	0000;0000;0000
/
/	SUBROUTINE PLOTS
/
PLOTS,	BLOCK	2
	TAD	(6
	TAD	PLOTS#
	DCA	PLOTS#
	DCA	IX
	DCA	IY
	JMS	PENUP
	CALL	3,PLOT
	ARG	ZERO
	ARG	ZERO
	ARG	(-3
	JMS	WAIT
	RETRN	PLOTS
ZERO,	0000;0000;0000
	END


*F