// M A K E P A T T E R N S   
// errors --
//
//MakePatterns()
//	Build 8 pages of patterns on the disk that can be printed.
//

get "PDInternals.d"

// outgoing procedures
external
	[
	MakePatterns
	]

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

// incoming procedures
external
	[
//PDPRINT
	WritePageStructure
	FSGetX

//WINDOWS
	WindowInit
	WindowGetPosition
	WindowSetPosition
	WindowWrite
	WindowWriteBlock
	WindowClose
	FileWritePage

//OS
	MoveBlock; SetBlock; Zero

//CURSOR
	CursorChar
	CursorDigit
	CursorToggle
	]

// incoming statics
external
	[
	BitsFile
	nBitsPerScan
	nScans
	]

// internal statics
static
	[
	line; buff; scanLineLength
	]

// File-wide structure and manifest declarations.
manifest bandWidth=16

// Procedures

let MakePatterns() be
[
	CursorChar($C)
	let pages=vec 8*(size PageG/16)
	let page=pages
	scanLineLength=(nBitsPerScan+31)/32
	scanLineLength=scanLineLength*2
	let bufferLength=scanLineLength*bandWidth
	let mainBuffer=FSGetX(bufferLength+40)	//Slop for MoveBlock's below
	let recordsPerBuffer=(bufferLength+1023)/1024
	let diskRecord=1

	for pn=1 to 8 do
	[
	CursorDigit()
	let op=selecton pn into
		[
		case 1: Grid1
		case 2: Grid2
		case 3: Grid3
		case 4: Vruler
		case 5: Hruler
		case 6: Dots
		case 7: Black
		case 8: White
		]

	Zero(page, (size PageG/16))
	page>>PageG.BitPage=diskRecord

//Write in the scan lines:
	for i=0 to nScans-1 do
		[
		if (i rem bandWidth) eq 0 then Zero(mainBuffer, bufferLength)
		line=i
		buff=mainBuffer+(i rem bandWidth)*scanLineLength
		op()
		if ((i rem bandWidth) eq (bandWidth-1)) % (i eq nScans-1) then
			[
			CursorToggle(0)
			FileWritePage(BitsFile,diskRecord, mainBuffer,recordsPerBuffer)
			diskRecord=diskRecord+recordsPerBuffer
			]
		]

	page>>PageG.BandWidth=bandWidth
	page>>PageG.FirstBand=0
	page>>PageG.LastBand=(nScans+bandWidth-1)/bandWidth-1
	page>>PageG.BitMargin=0
	page>>PageG.BitWc=scanLineLength
	page=page+(size PageG/16)
	]

	WritePageStructure(pages, 8)
]

//All pattern generators assume three statics:
//	line=	number of scan-line on which we are: 0,1,2,...
//	buff=	pointer to scan-line buffer
//	scanLineLength= number of words in scan-line buffer

and Grid1() be	// 1/8 inch
	[
	let wrds = vec 3; Zero(wrds,3); wrds!0 = #170000 
	if RemRange(48, 0, 3) then SetBlock(wrds,-1,3)
	for wrd = 0 to scanLineLength by 3 do
		MoveBlock(buff+wrd,wrds,3)
	if not wrds!1 then buff!(scanLineLength-1)=#17
	]

and Grid2() be	// 1/4 inch
	[
	let wrds = vec 6; Zero(wrds,6); wrds!0 = #170000 
	if RemRange(96, 0, 3) then SetBlock(wrds,-1,6)
	for wrd = 0 to scanLineLength by 6 do
		MoveBlock(buff+wrd,wrds,6)
	if not wrds!1 then buff!(scanLineLength-1)=#17
	]

and Grid3() be	// 1/4 inch, in from edge
	[
	if line ls 16 then return
	let wrds = vec 6; Zero(wrds,6); wrds!0 = #170000 
	if RemRange(96, 16, 19) then SetBlock(wrds,-1,6)
	for wrd = 6 to scanLineLength-6 by 6 do
		MoveBlock(buff+wrd,wrds,6)
	if not wrds!1 then buff!(scanLineLength-1-6)=#17
	]

and Vruler() be
	[
	let pattern = table
		[
		#177700; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #77
		#176000; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #1777
		] 
	let black = vec 24; SetBlock(black,-1,24) 
	let ptr = (RemRange(384, 0, 3))? black,pattern
	for wrd = 0 to scanLineLength by 24 do
		MoveBlock(buff+wrd,ptr,24)
	]

and Hruler() be
	[
	let pattern = table
		[
		#177700; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #77
		#176000; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #1777
		] 
	let black = vec 24; SetBlock(black,-1,24) 
	let white = vec 24; Zero(white,24) 
	let position = line rem 384
	let ptr = ((pattern!(position rshift 4))&(#100000 rshift (position & #17))) eq 0? white,black
	for wrd = 0 to scanLineLength by 24 do
		MoveBlock(buff+wrd,ptr,24)
	]

and Dots() be
	[
	let pattern = table
		[
		#177700; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #77
		#176000; #600; #3; #140000; #600; #17
		#170000; #600; #3; #140000; #600; #1777
		] 
	let white = vec 24; Zero(white,24) 
	let position = line rem 384
	let ptr = ((pattern!(position rshift 4))&(#100000 rshift (position & #17))) eq 0? white,pattern
	for wrd = 0 to scanLineLength by 24 do
		MoveBlock(buff+wrd,ptr,24)
	]

and White() be
	[
	Zero(buff,scanLineLength) 
	]

and Black() be
	[
	SetBlock(buff,-1,scanLineLength) 
	]

and RemRange(modulus, fNum, lNum) = valof
	[
	let j=line rem modulus
	if fNum le j & j le lNum then resultis true
	resultis false
	]