.TITLE	HCSMAC
	.ENABL	LC
;
;	CALL HCSETR( KSET ) -- This routine loads the Hershey
;	Character Definition Block (HCDB) which corresponds to
;	KSET.  An improper value of KSET causes HCSET3 to be loaded.
;
;	KSET	Description
;
;	3	Simplex Roman
;	4	Simplex Greek
;	5	Duplex Roman
;	6	Complex Roman
;	7	Complex Greek
;	8	Complex Italic
;	10(M)	Math and special characters
;	11(G)	Gothic English
;	12(W)	Simplex Script
;	13	Complex Script
;	14	Gothic Italian
;	15	Gothic German
;	16	Cyrillic
;	17	Triplex Roman
;	18	Triplex Italic
;	20	Miscellaneous characters.
;	30-37	Chinese.
;	38-39	Japanese.
;
	.PSECT	HCSETR
	.MCALL	WTSE$S
				;
HCSETR::MOV	@2(R5),R1	;GET KSET
	CMP	R1,#3		;TOO SMALL?
	BLT	1$		;BRANCH IF TRUE
	CMP	R1,#29.		;TOO LARGE?
	BLE	2$		;BRANCH IF NOT
1$:	MOV	#3,R1		;SET DEFAULT
2$:	CMP	R1,KSetNo	;IS SET ALREADY LOADED?
	BEQ	DONE		;BRANCH IF TRUE
				;
	MOV	R1,KSetNo	;SAVE CHARACTER SET NUMBER
	SUB	#3,R1		;REMOVE OFFSET
	ASL	R1		;MULTIPLY BY TWO
	ADD	#HCDB,R1	;REFERENCE TO THE HCDB TABLE
	JSR	PC,@(R1)	;EXECUTE ROUTINE
	SUB	#64.,LL0D	;ADD IN OFFSET
DONE:	RTS	PC		;RETURN
				;
HCDB:	.WORD	HCST03, HCST04, HCST05
	.WORD	HCST06, HCST07, HCST08
	.WORD	HCST09, HCST10, HCST11
	.WORD	HCST12, HCST13, HCST14
	.WORD	HCST15, HCST16, HCST17
	.WORD	HCST18, HCST03, HCST20
	.WORD	HCST03, HCST03, HCST03	; 21, 22, 23
	.WORD	HCST03, HCST03, HCST03	; 24, 25, 26
	.WORD	HCST03, HCST03, HCST03	; 27, 28, 29
;	.WORD	HCST30, HCST31, HCST32
;	.WORD	HCST33, HCST34, HCST35
;	.WORD	HCST36, HCST03, HCST38  ; HCST37 HAS BEEN DELETED
;	.WORD	HCST39
	.PAGE
F0=%0	;DEFINE FLOATING POINT
F1=%1	;REGISTERS
	.ENABL	LC
;
;	CALL POINTR(CHAR) -- This subroutine sets the character
;	definition parameters ( NVEC and IWIDTH ) and the pointer
;	( POINT ) to the character definition in the present
;	HCDB based upon the character and case ( CHAR and ICASE ).
;
;	CHAR	ASCII character
;	ICASE	Upper case (0) or Lower case (4)
;	NVEC	Number of vectors required to draw
;		the character
;	IWIDTH	Character width
;	POINT	Internal pointer to the character
;		definition in the HCDB.
;
	.PSECT	POINTR
				;
POINTR::MOVB	@2(R5),R0	;GET CHAR
	CMP	R0,#40		;VALID CHARACTER?
	BLT	4$		;BRANCH IF NOT
				;
	MOV	ICASE,R1	;GET CASE FLAG
	CMP	R0,#141		;IS CHARACTER LOWER CASE?
	BLT	1$		;BRANCH IF NOT
	MOV	#4,R1		;SET LOWER CASE FLAG
	SUB	#40,R0		;MAKE INTO LOWER CASE
1$:	SUB	#40,R0		;SUBTRACT OFFSET
	MOVB	DC(R0),R0	;CONVERT FROM ASCII TO ACD DISPLAY CODE
	ASH	#3,R0		;GENERATE OFFSET
	ADD	R1,R0		;ADD CASE
	ADD	DES,R0		;REFERENCE DESCRIPTOR AREA OF HCDB
				;
	TST	(R0)		;ANYTHING DEFINED?
	BEQ	4$		;BRANCH IF NOT
	MOVB	(R0)+,NVEC	;SET NUMBER OF VECTORS
	MOVB	(R0)+,IWIDTH	;SET WIDTH
	MOV	(R0),POINT	;SET POINTER
	ASL	POINT		;MULTIPLY BY TWO
	ADD	DEF,POINT	;REFERENCE DEFINITION AREA OF HCDB
				;
	TST	NVEC		;ANY VECTORS?
	BEQ	2$		;BRANCH IF NONE.
	CMP	#40000,@POINT	;USE DEFAULTS?
	BGT	3$		;BRANCH IF NOT
				;
2$:	MOV	LL0D,LL0	;SET DEFAULT ORIGIN
	MOV	SCALED,SCALE	;SET DEFAULT SCALE
	MOV	SCALED+2,SCALE+2	;  CONT.
	MOV	COSUPD,COSUPT	;SET DEFAULT TRANSFORM VECTORS.
	MOV	COSUPD+2,COSUPT+2
	MOV	SINUPD,SINUPT
	MOV	SINUPD+2,SINUPT+2
	RTS	PC		;RETURN
				;
3$:	SUB	#3,NVEC		;REMOVE SCALING VECTORS FROM COUNT
	MOV	POINT,R0	;SET ADDRESS
	MOV	(R0)+,LL0	;GET ORIGIN
	SUB	#64.,LL0	;ADD IN OFFSET
				;
	STF	F0,-(SP)	;SAVE F0
	STF	F1,-(SP)	;SAVE F1
	STFPS	-(SP)		;SAVE FPS
	SETI			;SET INTEGER
	SETF			;SET FLOATING
				;
	LDF	(R0)+,F0	;GET SCALE
	STF	F0,SCALE	;STORE SCALE
	LDF	COSUPC,F1	;GET TRANSFORMATION VECTOR
	MULF	F0,F1		;RESCALE
	STF	F1,COSUPT	;SET SCALED TRANSFORMATION
	LDF	SINUPC,F1	;
	MULF	F0,F1		;
	STF	F1,SINUPT	;
				;
	LDFPS	(SP)+		;RESTORE FPS
	LDF	(SP)+,F1	;RESTORE F1
	LDF	(SP)+,F0	;RESTORE F0
	MOV	R0,POINT	;SET NEW ADDRESS
	RTS	PC		;RETURN
				;
4$:	CLR	NVEC		;NO VECTORS
	CLR	IWIDTH		;NO WIDTH
	BR	2$		;BRANCH TO SET DEFAULTS
				;
POINT:	.WORD	0		;POINTER INTO HCDB
				;
DC:	.BYTE	55,66,64,60,53,63,67,70	; <SP> ! " # $ % & '
	.BYTE	51,52,47,45,56,46,57,50	; ( ) * + , - . /
	.BYTE	33,34,35,36,37,40,41,42	; 0 1 2 3 4 5 6 7
	.BYTE	43,44,0,77,72,54,73,71	; 8 9 : ; < = > ?
	.BYTE	74,01,02,03,04,05,06,07	; @ A B C D E F G
	.BYTE	10,11,12,13,14,15,16,17	; H I J K L M N O
	.BYTE	20,21,22,23,24,25,26,27	; P Q R S T U V W
	.BYTE	30,31,32,61,75,62,76,65,70	; X Y Z [ \ ] ^ _ '
	.PAGE
	.ENABL	LC
;
;	CALL VECTOR(IX,IY,IPEN) -- This subroutine decodes the
;	word currently pointed to by POINT.
;
	.PSECT	VECTOR
				;
VECTOR::MOV	POINT,R0	;GET POINTER
	MOV	(R0)+,R1	;GET POINTED TO WORD
	MOV	R0,POINT	;SET POINTER TO NEW LOCATION
				;
	MOV	#2,@6(R5)	;SET PEN DOWN
	ASL	R1		;SHIFT TO TEST PEN BIT
	TST	R1		;TEST PEN BIT
	BGE	1$		;BRANCH IF PEN DOWN
	INC	@6(R5)		;SET PEN UP
				;
1$:	MOVB	R1,R0		;SIGN EXTEND IY
	ASR	R0		;SHIFT TO RE-ALIGN
	SUB	LL0,R0		;ADD IN OFFSET
	MOV	R0,@4(R5)	;STORE IY
				;
	ASL	R1		;SHIFT TO REMOVE PEN BIT
	ASH	#-9.,R1		;SHIFT TO EXTEND SIGN
	SUB	LL0,R1		;ADD IN OFFSET
	MOV	R1,@2(R5)	;STORE IX
				;
	RTS	PC		;RETURN
				;
	.PSECT	HCDB	RW, D, GBL, REL, OVR
ICASE:	.WORD	0	;Upper (0) and Lower (4) case flag.
NVEC:	.WORD	0	;Number of vectors defining character.
IWIDTH:	.WORD	0	;Width of character
LL0:	.WORD	0	;Position of Lower Left origin.
LL0D:	.WORD	0	;Default LL origin.
SCALE:	.FLT2	0.	;Scaling factor.
SCALED:	.FLT2	0.	;Default scaling factor.
COSUPC:	.FLT2	0.	;Transformation Vectors.
SINUPC:	.FLT2	0.	;
COSUPD:	.FLT2	0.	;Default Transformation Vectors.
SINUPD:	.FLT2	0.	;
COSUPT:	.FLT2	0.	;Scaled Transformaton Vectors.
SINUPT:	.FLT2	0.	;
DES:	.WORD	0	;Address of descriptor table.
DEF:	.WORD	0	;Address of definition table.