// R O T A T E  (PREPRESS)
// BCPL/f Rotate.bcpl
 
//ROTATE is used to rotate character descriptions (AC) by some multiple
// of 90 degrees.

//Last modified January 10, 1980  4:05 PM by Kerry A. LaPrade, (XEOS)
//  Fixed typo in RotateOne() case 0:

//Modified December 19, 1979  5:38 PM by Lyle Ramshaw (PARC) to put in
//  rotations by other than +90, and to fix the off-by-one baseline bug.
//  The new version believes that the origin is located at the corner where
//  four pixels meet, and leaves the origin fixed under rotations.

get "ix.dfs"

// outgoing procedures
external
	[
	Rotate
	]

// outgoing statics
//external
//	[
//	]
//static
//	[
//	]

// incoming procedures
external
	[
//WINDOW
	WindowRead
	WindowReadBlock
	WindowWrite
	WindowWriteBlock
	WindowGetPosition
	WindowSetPosition
	WindowCopy
	WindowClose

//MAPACTEMP
	MapACtemp

//PREPRESSUTIL
	FSGetX
	FSPut
	MoveBlock
	DoubleAdd
	Scream

//OS
	Usc
	]

// incoming statics
external
	[
	@angleToRotate
	]

// internal statics
//static
//	[
//	]

// File-wide structure and manifest declarations.


// Procedures

let Rotate(inputName,outputName;numargs na) be 
 [	if na eq 0 then [ inputName="ACtemp";outputName="ACtemp"]
	MapACtemp(RotateIx, RotateOne, nil,inputName,outputName)
 ]

and RotateIx(ix, nil) be
[
	unless ix>>IX.Type eq IXTypeChars then
		Scream("Rotate called with wrong input type")
	while angleToRotate ls 0 do angleToRotate = angleToRotate+360
	while angleToRotate ge 360 do angleToRotate = angleToRotate-360
	switchon angleToRotate into
		[
	  case 0: case 90: case 180: case 270: endcase
	  default:
		Scream("Can't rotate rasters by other than multiples of 90 degrees")
		]
	let r=ix>>IX.rotation+angleToRotate*60		//Rotated form
	if Usc(r, 360*60) ge 0 then r=r-360*60
	ix>>IX.rotation=r
]

and RotateOne(cp, si, so, nil) be
[
	let a=WindowRead(si)		//FHEAD
	let ns=a<<FHEAD.ns
	let hw=a<<FHEAD.hw

	let bufSize=hw*ns
	let C=FSGetX(bufSize)		//Space to hold the bits
	WindowReadBlock(si, C, bufSize)

	let w=cp>>CharWidth.W
	let h=cp>>CharWidth.H
	let xl=cp>>CharWidth.XL
	let yb=cp>>CharWidth.YB

//nx,ny denote new x, new y
	let nw, nh, nxl, nyb = nil, nil, nil, nil
	switchon angleToRotate into
		[
	  case 0:
		nw=w; nh=h; nxl=xl; nyb=yb; endcase
	  case 90:
		nw=h; nh=w; nxl=-(yb+h); nyb=xl; endcase
	  case 180:
		nw=w; nh=h; nxl=-(xl+w); nyb=-(yb+h); endcase
	  case 270:
		nw=h; nh=w; nxl=yb; nyb=-(xl+w); endcase
		]

//And fill into char descr
	cp>>CharWidth.W=nw
	cp>>CharWidth.H=nh
	cp>>CharWidth.XL=nxl
	cp>>CharWidth.YB=nyb

//Now set the widths correctly
	let widthX, widthY = vec 1, vec 1
	MoveBlock(widthX, lv cp>>CharWidth.WX, 2)
	MoveBlock(widthY, lv cp>>CharWidth.WY, 2)
	let minusWidthX, minusWidthY = vec 1, vec 1
	DoubleNegate(minusWidthX, widthX)
	DoubleNegate(minusWidthY, widthY)
	switchon angleToRotate into
		[
	  case 0:
		MoveBlock(lv cp>>CharWidth.WX, widthX, 2)
//		MoveBlock(lv cp>>CharWidth.WY, widthY, w)
		MoveBlock(lv cp>>CharWidth.WY, widthY, 2)
		endcase
	  case 90:
		MoveBlock(lv cp>>CharWidth.WX, minusWidthY, 2)
		MoveBlock(lv cp>>CharWidth.WY, widthX, 2)
		endcase
	  case 180:
		MoveBlock(lv cp>>CharWidth.WX, minusWidthX, 2)
		MoveBlock(lv cp>>CharWidth.WY, minusWidthY, 2)
		endcase
	  case 270:
		MoveBlock(lv cp>>CharWidth.WX, widthY, 2)
		MoveBlock(lv cp>>CharWidth.WY, minusWidthX, 2)
		endcase
		]

	let nhw=(nh+15)/16
	a<<FHEAD.ns=nw
	a<<FHEAD.hw=nhw
	WindowWrite(so, a)

	for nx=0 to nw-1 do
		for nwy=0 to nhw-1 do
		[
		let nword=0
		let nybase=nwy*16
		for y=0 to 15 do
			[
			let ny=y+nybase
//We want to write the bit at (nx,ny) (0,0) at lower left of whole box.
			let ox, oy = nil, nil
			switchon angleToRotate into
				[
			  case 0:
				ox=nx; oy=ny; endcase
			  case 90:
				ox=ny; oy=nw-nx-1; endcase
			  case 180:
				ox=nw-nx-1; oy=nh-ny-1; endcase
			  case 270:
				ox=nh-ny-1; oy=nx; endcase
				]
//Read bit at (ox,oy)
			let nbit=0
			if ox ge 0 & ox ls w & oy ge 0 & oy ls h then
				[
				let wd=C+(ox*hw)+(oy/16)
				nbit=@wd&(#100000 rshift (oy&#17))
				]
//Put it in word
			if nbit then nword=nword%(#100000 rshift y)
			]
		WindowWrite(so, nword)
		]

	FSPut(C)
]

and DoubleNegate(dest, source) be
[
dest!0 = not source!0		//take one's complement
dest!1 = not source!1
DoubleAdd(dest, (table [ 0;1 ] ) )	//and add 1
]