// SCVTEST.Bcpl -- SCV Demonstration
// Copyright Xerox Corporation 1979

// BLDR SCVTEST SCVMAIN SCVSORT FLOAT

get "scv.dfs"


// outgoing procedures
//external
//	[
//	]

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

// incoming procedures
external
	[
	SCVInit
	SCVMatrix
	SCVTransformF

	SCVBeginObject
	SCVMoveTo
	SCVMoveToF
	SCVDrawTo
	SCVDrawToF
	SCVDrawCurve
	SCVEndObject

	SCVReadRuns

	FLD; FST; FTR; FLDI; FNEG; FAD; FSB; FML; FDV;
	FCM; FSN; FLDV; FSTV; FLDDP; FSTDP; DPAD; DPSB;

	InitializeZone; Allocate; Free

	GetFixed
	Gets; Zero; SetBlock; Ws
	]

// incoming statics
external
	[
	keys
	]


static
	[
	Disp
	TZone
	]
// File-wide structure and manifest declarations.


manifest DBptr=#420

structure DB: [
	next word
	resolution bit 1
	background bit 1
	indentation bit 6
	width bit 8
	bitMapAddress word
	height word
	]
manifest lDB = size DB/16

manifest [
	DisHeight=400
	DisWidthWords=36
	]

// Procedures

let

Main() be [
	let dc=GetFixed(DisWidthWords*DisHeight+6)
	if (dc&1) ne 0 then dc=dc+1
	Disp=dc+lDB		//Pointer to bits.
	Zero(Disp,DisWidthWords*DisHeight)

	dc>>DB.resolution=0
	dc>>DB.background=0
	dc>>DB.indentation=0
	dc>>DB.width=DisWidthWords
	dc>>DB.bitMapAddress=Disp
	dc>>DB.height=DisHeight/2
	dc>>DB.next=@DBptr
	@DBptr=dc		//Linked in.

	let z=GetFixed(2000)	//For ALLOC
	TZone=InitializeZone(z,2000)

//Now "show" goodies.
	Convert(true,Triangle)	//Show a triangle.
]

and

Convert(wipe,figure) be [
	if wipe then Zero(Disp,DisWidthWords*DisHeight)	//White screen.

	SCVInit(TAlloc,TFree,Error)	//Initialize SCV
	FLDI(2,1)
	SCVMatrix(2,0,0,2)	//Set matrix.


	let v=vec size SCV/16
	SCVBeginObject(false)	//Start an object
	figure()			//Call the figure.
	SCVEndObject(v)		//Done.


	let b=vec 200
	v>>SCV.Sbegin=v>>SCV.Smin	//First range
		[
		v>>SCV.Send=v>>SCV.Smax	//Assume entire range fits.
		SCVReadRuns(v,b,200)	//Calculate intersections.
		let n=v>>SCV.IntCnt
		if n eq 0 then break	//All done.
		let p=v>>SCV.IntPtr
		for i=1 to n by 2 do	//Loop for each run.
			[
			let S=p!0		//S value
			ShowRun(S,p!1,p!3-1)
			p=p+4		//Next intersection pair.
			]
		v>>SCV.Sbegin=v>>SCV.Send+1 //Prepare next S range.
		] repeat
	Gets(keys)			//Wait a bit.
]

and

ShowRun(s,r1,r2) be [
//Show run on scan-line s, r1 to r2 inclusive.
	unless r2 ge r1 then return
	let bitpattern=-1

	let r1word=r1 rshift 4
	let r2word=r2 rshift 4
	let r1mask=not (-1 rshift (r1 & #17))
	let r2mask=not (-1 rshift ((r2 & #17)+1))
	let fw=(DisHeight-s-1)*DisWidthWords+Disp

	let bits=(fw!r1word & r1mask)%(bitpattern & (not r1mask))
	for i=r1word to r2word-1 do [ fw!i=bits; bits=bitpattern ]
	fw!r2word=(bits & r2mask)%(fw!r2word & (not r2mask))
]

and

Triangle() be [
	SCVMoveTo(0,0)
	SCVDrawTo(10,0)
	SCVDrawTo(5,10)
]

and

Error(s) be [
	Ws("Error!!!!*N")
	finish
]

and

TAlloc(a) = Allocate(TZone, a)

and

TFree(a) = Free(TZone, a)