File: PXDELT.SB of Tape: Sources/Other/new-14

(Source file text) 

---

/	SUBROUTINE DELTA(X,Y,INCHR)

	ENTRY DELTA

	DUMMY \X
	DUMMY \Y
	DUMMY \INCHR
\X,	BLOCK 2
\Y,	BLOCK 2
\INCHR, BLOCK 2

\IN,	0
XPNT,	\X
NBYTE,	0

/	DELTA CONTROL BYTE IS DEFINED AS FOLLOWING:

/			+Y
/	     44(8)    40(8)    24(8)
/	     36(10)   32(10)   20(10)
/		\	|	/
/		 \	|      /
/		  \	|     /
/		   \	|    /
/		    \	|   /
/		     \	|  /
/		      \	| /
/	     30(8)     \|/     20(8)
/	-X	-------	* -------	+X
/	     24(10)    /|\     16(10)
/		      / | \
/		     /  |  \
/		    /   |   \
/		   /	|    \
/		  /	|     \
/		 /	|      \
/		/	|	\
/	    34(8)     50(8)    54(8)
/	    28(10)    40(10)   44(10)
/			-Y

DELTA,	BLOCK 2
	TAD XPNT
	DCA \IN
	TAD (-6
	DCA NBYTE
TRLUP,	TAD I DELTA		/TRANSFER PARAMETERS
	DCA I \IN
	INC DELTA#
	INC \IN
	ISZ NBYTE
	JMP TRLUP
	TAD I \INCHR
	DCA \IN			/DELTA CONTROL BYTE
	TAD \IN
	AND (3
	DCA NBYTE		/NUMBER OF DELTAS FOLLOWING
	DCA IXVAL
	DCA IYVAL
	DCA IXSGN
	DCA IYSGN		/RESET
	TAD \IN
	AND (34			/4: BOTH BIT; TO SIGN
	CLL RTR			/10: ONLY SIGN BIT; TO LINK
	RTR			/20: ONLY X BIT; TO AC
	SPA			/BOTH DIRECTIONS ?
	JMP BOTH		/YES
	SZA			/NO, 1 DIR
	JMP XONLY		/ONLY X-DIRECTION
YONLY,	INC IYVAL		/ONLY Y-DIRECTION
	CLA RAL
	DCA IYSGN		/SIGN WAS IN LINK
	JMP GBYTES

XONLY,	INC IXVAL		/ONLY X-DIRECTION
	CLA RAL
	DCA IXSGN		/SIGN WAS IN LINK
	JMP GBYTES
	
BOTH,	AND (1			/PICK OUT 20 BIT
	SZA
	JMP XVYV		/+X,+Y DIAGONAL
	INC IXVAL		/+X,-Y DIAGONAL
	SNL
	INC IXSGN		/-X
	JMP YONLY

XVYV,	INC IYVAL		/+X,+Y DIAGONAL
	SZL
	INC IYSGN		/-Y
	JMP XONLY

GBYTES,	CALL 0,CLEAR		/BE SURE
	CALL 1,STO
	ARG \XRES
	CALL 1,STO
	ARG \YRES		/CLEAR THEM
	TAD IXVAL
	SNA CLA			/ANY X BYTES ?
	JMP GBYTY		/NO, GET Y BYTES
	TAD NBYTE
	CMA
	DCA ITEM		/ALWAYS 1 BYTE
XLUP,	CALL 1,IGETC		/GET BYTE FROM STREAM
	ARG (1
	CALL 0,FLOT
	CALL 1,STO
	ARG \BYTE		/TEMP
	CALL 1,FAD
	ARG \XRES
	CALL 1,FMP
	ARG \F64
	CALL 1,FAD
	ARG \BYTE
	CALL 1,STO		/XRES=XRES*64.+BYTE
	ARG \XRES
	ISZ ITEM		/MORE ?
	JMP XLUP
GBYTY,	TAD IYVAL
	SNA CLA			/Y BYTES ?
	JMP DELEX		/NO, THE END
	TAD NBYTE
	CMA
	DCA ITEM		/COUNT FOR Y BYTES
YLUP,	CALL 1,IGETC
	ARG (1
	CALL 0,FLOT
	CALL 1,STO
	ARG \BYTE
	CALL 1,FAD
	ARG \YRES
	CALL 1,FMP
	ARG \F64
	CALL 1,FAD
	ARG \BYTE
	CALL 1,STO		/YRES=YRES*64.+BYTE
	ARG \YRES
	ISZ ITEM
	JMP YLUP
DELEX,	CALL 1,FAD		/NOW CHECK SIGNS
	ARG \XRES
	TAD IXSGN		/X NEGATIVE ?
	SNA CLA
	JMP XPOS
	CALL 0,CHS		/YES, CHANGE SIGN
XPOS,	CALL 1,ISTO
	ARG \X			/FINAL ARG
	CALL 1,FAD
	ARG \YRES
	TAD IYSGN		/Y NEGATIVE ?
	SNA CLA
	JMP YPOS
	CALL 0,CHS		/YES, CHANGE SIGN
YPOS,	CALL 1,ISTO
	ARG \Y			/FINAL ARG
	RETRN DELTA		/TERMINATO
IXVAL,	0
IXSGN,	0
\XRES,	BLOCK 3
IYVAL,	0
IYSGN,	0
\YRES,	BLOCK 3
ITEM,	0
\BYTE,	BLOCK 3
\F64,	2074
	0
	0
END 

---