/ 
/ 3	OS/8 - FORTRAN II DISPLAY - SOFTWARE FUER 4006-1
/ 
/  COPYRIGHT   (C)  1978 BY ERDOELCHEMIE GMBH, 5 KOELN 71
/ 
/ 
/ 
/                           *******
/                        ***       ***
/                     ***             ***
/                    *                   *
/                   *                     *
/                  *     EEEEE    CCC      *
/                  *     E       C   C     *
/                 *      E       C          *
/                 *      EEEE    C          *
/                 *      E       C          *
/                  *     E       C   C     *
/                  *     EEEEE    CCC      *
/                   *                     *
/                    *                   *
/                    *   *****   *****   *
/                    *   *   *   *   *   *
/                    *   *   *   *   *   *
/                    *****   *****   *****
/ 
/ 
/ 
/             BBBB  K   K       PPPP  DDDD  V   V
/             B   B K   K       P   P D   D V   V
/             B   B K  K        P   P D   D V   V
/             BBBB  KKK    ===  PPPP  D   D V   V
/             B   B K  K        P     D   D V   V
/             B   B K   K       P     D   D  V V
/             BBBB  K   K       P     DDDD    V
/ 
/ 
/ 
/                       1  999  77777  888
/                      11 9   9     7 8   8
/                     1 1 9   9    7  8   8
/                    1  1  999    7    888
/                       1     9   7   8   8
/                       1     9   7   8   8
/                       1  9999   7    888
/ 
/ 
/ 
/      27-JAN-78                       W. HOUBEN
/ 
/      LETZTE AENDERUNG :	30-JAN-78	SPEED UP CHANGES
/ 
/      ENTRYPOINTS :   PLOT,   PLOTS,  WHERE,  FACTOR, PLINIT
/ 
	ABSYM	TOPS8	1
	OPDEF KRS 6034
	OPDEF JMPI 5400
	OPDEF MQA 7501
	OPDEF MQL 7421
ENTRY	PLOT
DUMMY \JPEN
DUMMY \YPAGE
DUMMY	\XPAGE
/**********************************************************
/	UNTERPROGRAMM PLOT ( XPAGE , YPAGE , IPEN )
/**********************************************************
\XPAGE,	BLOCK	2
\YPAGE,	BLOCK	2
\JPEN,	BLOCK	2
\XPOS,	BLOCK	3
\YPOS,	BLOCK	3
\IPEN,	BLOCK	1
\FACT,	BLOCK	3
\LUN,	BLOCK	1
\IX,	BLOCK	1
\IXORG,	BLOCK	1
\IY,	BLOCK	1
\IYORG,	BLOCK	1
XPNT,	\XPAGE
PNTR,	0
CNTR,	0
]A,	BLOCK	3
]6,	2066;2270;5333
]3,	2065;7501;3702
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
/ 
/      X UND Y - KOORDINATEN UEBERNEHMEN, MIT DEM MASS-
/      STABSFACTOR UND DEN SCALENFACTOREN MULTIPLIZIEREN
/      UND UMWANDELN IN INTEGER DARSTELLUNG.
/ 
/      XPOS = XPAGE * FACT
/
CALL 1,IFAD
ARG \XPAGE
CALL 1,FMP
ARG \FACT
CALL 1,STO
ARG \XPOS
/      YPOS = YPAGE * FACT
CALL 1,IFAD
ARG \YPAGE
CALL 1,FMP
ARG \FACT
CALL 1,STO
ARG \YPOS
/      IPEN = JPEN
TAD I \JPEN
DCA \IPEN
/ 
/      UMRECHNEN DER KOORDINATEN IN INCREMENTE UND
/      URSPRUNG ADDIEREN.
/ 
/105   IX = IXORG + IFIX( XPOS * 47.6279 )
 CALL 1,FAD
ARG ]3
CALL 1,FMP
ARG \XPOS
CALL 0,FIX
TAD \IXORG
DCA \IX
/      IY = IYORG + IFIX( YPOS * 50.3607 )
CALL 1,FAD
ARG ]6
CALL 1,FMP
ARG \YPOS
CALL 0,FIX
TAD \IYORG
DCA \IY
/
/ 
/      VECTOR TYP TESTEN
/ 
	TAD	\IPEN
	SMA CLA
	JMP	\140
/
	TAD	\IX
	DCA	\IXORG
	TAD	\IY
	DCA	\IYORG
	TAD	\IPEN
	CIA
	DCA	\IPEN
/
\140,	TAD	\IPEN
	TAD	(-2
	SNA CLA
	JMP	\170		/ OUTPUT LIGHT VECTOR
/
	TAD	\IPEN
	TAD	(-3
	SZA CLA
	JMP	\150
/
	TAD	(35
	JMS	OUTPUT
	JMP	\170		/ OUTPUT DARK VECTOR
/
\150,	TAD	\IPEN
	TAD	(-4
	SZA CLA
	JMP	\160
/
	TAD	(33
	JMS	OUTPUT
	TAD	(14
	JMS	OUTPUT
	TAD	(-100
	DCA	WCTR		/ LOAD WAIT COUNTER
	DCA	NULL
LP1,	ISZ	NULL
	JMP	LP1
	ISZ	WCTR
	JMP	LP1
	TAD	(35
	JMS	OUTPUT
	JMP	\170
/
\160,	TAD	\IPEN
	TAD	(-1747
	SZA CLA
	JMP	\190
	TAD	(15
	JMS	OUTPUT
	TAD	(12
	JMS	OUTPUT
	JMP	\190
/
NULL,	0
WCTR,	0
/
/      X- UND Y-KOORDINATEN IN STEUERZEICHEN FUER
/      TEKTRONIXS 4006-1 GRAPHIC DISPLAY UMRECHNEN
/ 
\170, TAD \IY
RTR;RTR;RAR
AND (37
TAD (40
	JMS	OUTPUT
TAD \IY
AND (37
TAD (140
	JMS	OUTPUT
TAD \IX
RTR;RTR;RAR
AND (37
TAD (40
	JMS	OUTPUT
TAD \IX
AND (37
TAD (100
	JMS	OUTPUT
/ 
/190   RETURN
\190,	CLA CLL
 RETRN PLOT
/ 
/	AUSGABE - UNTERPROGRAMM
/
OUTPUT,	0
	TLS
	CLA CLL
	JMP I	OUTPUT
DUMMY \JLUN
DUMMY \NLOC
DUMMY \IBUF
ENTRY PLOTS
ENTRY PLINI
/**********************************************************
/	UNTERPROGRAMM PLOTS ( IBUF , NLOC , LUN )
/**********************************************************
\IBUF, BLOCK 2
\NLOC, BLOCK 2
\JLUN, BLOCK 2
]61, 0
0
0
]31, 2014
0
0
/      SUBROUTINE PLOTS ( IBUF , NLOC , JLUN )
PLINI,
PLOTS, BLOCK 2
/      FACT = 1.
CALL 1,FAD
ARG ]31
CALL 1,STO
ARG \FACT
	DCA	\IXORG
	DCA	\IYORG
/ 
/      CALL PLOT ( 0.0 , 0.0 , -4 )
CALL 3,PLOT
ARG ]61
ARG ]61
ARG (-4
/ 
/      RETURN
	TAD	PLOTS#
	TAD	(6
	DCA	PLOTS#
RETRN PLOTS
/ 
DUMMY \FACTO
ENTRY FACTO
/**********************************************************
/	UNTERPROGRAMM FACTOR ( FACT )
/**********************************************************
\FACTO, BLOCK 2
/      SUBROUTINE FACTOR (FACTOR)
FACTO, BLOCK 2
TAD I FACTO
DCA \FACTO
INC FACTO#
TAD I FACTO
DCA \FACTO#
INC FACTO#
/      FACT = FACTOR
CALL 1,IFAD
ARG \FACTO
CALL 1,STO
ARG \FACT
/ 
/      RETURN
RETRN FACTO
/ 
ENTRY WHERE
/**********************************************************
/	UNTERPROGRAMM WHERE ( X , Y , FACT )
/**********************************************************
/      SUBROUTINE WHERE ( XPAGE , YPAGE , FACTOR )
WHERE, BLOCK 2
TAD I WHERE
DCA \XPAGE
INC WHERE#
TAD I WHERE
DCA \XPAGE#
INC WHERE#
TAD I WHERE
DCA \YPAGE
INC WHERE#
TAD I WHERE
DCA \YPAGE#
INC WHERE#
TAD I WHERE
DCA \FACTO
INC WHERE#
TAD I WHERE
DCA \FACTO#
INC WHERE#
/      XPAGE = XPOS
CALL 1,FAD
ARG \XPOS
CALL 1,ISTO
ARG \XPAGE
/      YPAGE = YPOS
CALL 1,FAD
ARG \YPOS
CALL 1,ISTO
ARG \YPAGE
/      FACTOR = FACT
CALL 1,FAD
ARG \FACT
CALL 1,ISTO
ARG \FACTO
/ 
/      RETURN
RETRN WHERE
/ 
/      END
END