//  PREPRESS W I N D O W  (PREPRESS) 
// catalog number ???
//
//Comments about what procedures lie herein (optional)
//
//Modified May 20, 1980  12:10 PM by Lyle Ramshaw:
//  Added WindowLength for the new MergeDelete
 
// outgoing procedures
external
	[
	WindowInit
	WindowClose
	WindowFlush
	WindowSetPosition
	WindowGetPosition
	WindowReadBlock
	WindowWriteBlock
	WindowRead
	WindowWrite
	WindowCopy
	WindowEnd
	WindowLength
	]

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

// incoming procedures
external
	[
	Gets
	Puts
	Endofs
	ReadBlock
	WriteBlock
	Resets
	FilePos
	SetFilePos
	FileLength
	Closes
	TruncateDiskStream
	CleanupDiskStream
	DPSB
	DPCop
	DblShift
	FSGetBiggest
	FSPut
	]

// incoming statics
//external
//	[
//	]

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

// File-wide structure and manifest declarations.

// Procedures


let

WindowInit(w, n) = w

and

//WindowClose(w [,len])
// If len is missing, len=0 is assumed
// If len=0, do not truncate file
// If len=-1, truncate file at current position
//  otherwise, assume len is a DP number for length

WindowClose(w, len; numargs n) be [
	if n eq 1 then len=0
	if len ne 0 then
	   [
	   let v=vec 1
	   if len ne -1 then WindowSetPosition(w, len)
	   TruncateDiskStream(w)
	   ]
	Closes(w)
]

and

WindowFlush(w)  be CleanupDiskStream(w)

and

WindowEnd(w) = Endofs(w)

and

WindowSetPosition(w, di) be [
	let d=vec 1
	DPCop(d, di)
	DblShift(d, -1)	//Convert to byte positon
	SetFilePos(w, d)
]

and

WindowGetPosition(w,di) be [
	FilePos(w,di)
	DblShift(di, 1)
]

and

WindowLength(w,dp)  be [
	FileLength(w,dp)
	DblShift(dp,1)	//convert bytes to words
]

and

WindowReadBlock(w,adr,cnt) be [
	if cnt ne 0 then ReadBlock(w, adr, cnt)
]

and

WindowWriteBlock(w,adr,cnt) be [
	if cnt ne 0 then WriteBlock(w, adr, cnt)
]

and

WindowRead(w) = Gets(w)

and

WindowWrite(w, val) be Puts(w, val)

and

WindowCopy(si, so, dpp) be [
//Copy a bunch of words from input to output
	let dp=vec 1
	dp!0=dpp!0; dp!1=dpp!1		//Copy dp number

//Use as big a buffer as possible-- Trident disk just hums.
	let buflen=nil
	let buf=FSGetBiggest(lv buflen)
	let dl=vec 1
	dl!0=0; dl!1=buflen

	while dp!0 ge 0 do
		[
		let l=dp!1
		if DPSB(dp,dl) ge 0 then l=buflen
		WindowReadBlock(si, buf, l)
		WindowWriteBlock(so, buf, l)
		]
	FSPut(buf)
]