******************************************************
* 右回転（半角は回転不可）
******************************************************
*	a1	font buffer(必ず偶数アドレスから始まること)
*	d1.w	xdot
*	d2.w	ylines-1
*　一旦ワークエリア内に回転フォントを作ってそれを転送する
******************************************************
	.if	0
	.text
	.include	defines.mac
FNTTEST	macro	size,code,wx,wy,x,call
	lea	work(pc),a1
	move.l	#size.shl.16+code,d1
	IOCS	_FNTGET
	lea	work+4(pc),a1
	move.w	#wy,d2
	move.w	#wx,d1
	bsr	call
	lea	work(pc),a1
	move.w	#x*8,d1
	move.w	#430,d2
	IOCS	_TEXTPUT
	endm

	* 8*16
	FNTTEST	8,'R',8,15,0,rrot0
	* 12*24
	FNTTEST	12,'R',12,23,4,rrot1
	* 16*16
	FNTTEST	8,'Ｒ',16,15,8,rrot1
	* 24*24
	FNTTEST	12,'Ｒ',24,23,16,rrot2
	clr.w	-(sp)
	DOS	_EXIT2

work:	.ds.w	2
	.ds.b	3*24
fontwork:
	.ds.b	4*24		* 高速化のためlongword単位処理をするから
	.even
	.else
	.xref	fontwork	* フォント加工ワークエリア（外部）
	.endif
******************************************************

	.text
	.xdef	rrot1
rrot1:				* x=12/16
	cmp.w	#12,d1
	beq	rrot0		* x=12:半角は回転できない

	lea	(d2.w,a1),a0	* buffer last address copy
	add.w	d2,a0
	addq.w	#2,a0		* +2 for -(a0)
r_r11:	* 16*16
	lea	fontwork,a2	* ワークエリアアドレス : (pc)では届かないことがある
	move.w	-(a0),d0
	rept	16		* 16bit分処理
	add.w	d0,d0
	roxl.w	(a2)+
	endm
	dbf	d2,r_r11
	* ワークエリアからバッファーへ転送
	lea	fontwork,a2	* ワークエリアアドレス
	moveq.l	#16/2-1,d0
rtw1:	move.l	(a2)+,(a1)+
	dbf	d0,rtw1
	.xdef	rrot0
rrot0:				* x=8,12dot = 半角文字は回転できない
	rts

******************************************************

	.xdef	rrot2
rrot2:				* x=24
	lea	(d2.w,a1),a0	* buffer last address copy
	add.w	d2,a0
	add.w	d2,a0
	lsr.w	#1,d2		* 2line単位処理
r_r21:	* line 1
	lea	fontwork,a2	* ワークエリアアドレス
	move.b	(a0),d0
	swap	d0
	move.w	1(a0),d0
	lsl.l	#8,d0
	rept	24
	add.l	d0,d0
	*addx.l	(a2),(a2)+
	move.l	(a2),d1
	addx.l	d1,d1
	move.l	d1,(a2)+
	endm
	subq.w	#3,a0
	* line 0
	lea	fontwork,a2	* ワークエリアアドレス
	move.w	(a0),d0
	swap	d0
	move.b	2(a0),d0
	lsl.w	#8,d0
	rept	24
	add.l	d0,d0
	*addx.l	(a2),(a2)+
	move.l	(a2),d1
	addx.l	d1,d1
	move.l	d1,(a2)+
	endm
	subq.w	#3,a0
	dbf	d2,r_r21
	* ワークエリアからバッファーへ転送
	lea	fontwork,a2	* ワークエリアアドレス
	moveq.l	#24/2-1,d0	* 2line単位転送
rtw2:	* line 0
	addq.w	#1,a2
	move.b	(a2)+,(a1)+
	move.b	(a2)+,(a1)+
	move.b	(a2)+,(a1)+
	* line 1
	addq.w	#1,a2
	move.b	(a2)+,(a1)+
	move.w	(a2)+,(a1)+
	dbf	d0,rtw2
	rts

******************************************************
	.end
