//bldr Scan JasmineUtil jasmc jasswat loadram

get "bcpl.head"

//incoming procedures
external 
 [	//from JasmineDisplay
	InitDisplay
	ResetDisplay
	ShowButton
	RemoveButton
	SetDisplayMode
	GetButtonHit
	GetRectangle

	//from JasmineUtil
	JasmineInit
	JasmineSetDelay
	JasmineSetResolution
	JasmineSetTime
	JasmineSetReadMode	//readOnly=1, readAndStep=2, readStepAndDelay=3
	JasmineLoadRam
	JasmineScanInit
	JasmineScanClose
	JasmineReadLine
	JasmineStep
	JasmineSetWindow	//(xstart,xlen)	in full resolution coords (250 microns)
	JasmineCoord
	JasmineNewPage
	JasmineEject
	JasmineMotorOff

	//from JasmineCalibrate
	JasmineCalibrate

	//from GP
	SetupReadParam;ReadParam

	//from PressML
	MulFull;DoubleAddV;MulDiv;DoubleShr
 ]

//display modes
manifest
 [	LowBank = 0
	HighBank = 1
	TextDisplay = 2
 ]

structure Array :
 [ pixel^0,1000	byte
 ]

manifest
 [	SetX=#356
	SetY=#357
	ShowDots=#374
	Nop=#377
	SetCoding=1	//byte command
	SetMode=2	//byte command
	SetSize=2	//word command
	SetSamplingProperties=6	//word
	SSPInputIntensity=0
	SSPScreen=2
	SetWindow=1
	DotsFollow=3
 ]

static
 [	White=255
	Black=0
	ScanLen=608
	ArraySize=1024
	XStart=0;XLen=1024
	YStart=-1;YLen=1024

	DisplayOn=true
	LeftX=2540
	TopY=2540
	blackDCB
	CalibrationBlock
	TwoBankMode=true
	displayMode
	magMax=2
 ]

let start() be
 [	JasmineInit()
	SetupReadParam()
	InitDisplay()
	SetDisplayMode(TextDisplay)
	Ws("Insert white sheet of paper for Calibration*n*tPress any key when ready")
	Gets(keys)
	JasmineNewPage(10)
	CalibrationBlock=JasmineCalibrate()
	JasmineEject()
	Black=CalibrationBlock!2;White=CalibrationBlock!3+10
	displayMode=LowBank
	SetDisplayMode(LowBank)

	let v=vec 8;blackDCB=v+(v&1)
	blackDCB!0=blackDCB+4;blackDCB!1=#40000;blackDCB!2=0;blackDCB!3=1
	blackDCB!4=0;blackDCB!5=0;blackDCB!6=0;blackDCB!7=0

 [	Ws("*n>")
	JasmineMotorOff()
	unless Endofs(keys) do
	[ //keyboard case
	SetDisplayMode(TextDisplay)
	let ch=Gets(keys)
	switchon ch into
	 [	case $?: Ws("Black: ");Wns(dsp,Black)
			Ws(" White: ");Wns(dsp,White)
			Ws(" XStart: ");Wns(dsp,XStart)
			Ws(" XLen: ");Wns(dsp,XLen)
			Ws(" YStart: ");Wns(dsp,YStart)
			Ws(" YLen: ");Wns(dsp,YLen)
			docase Gets(keys)
			endcase
		case $a: case $A: Ws("Alternate Bank");
		 [	for i=0 to 4 do RemoveButton(i)
			displayMode=displayMode xor 1
			SetDisplayMode(displayMode)
			for i=0 to 4 do ShowButton(i)
			endcase
		 ]
		case $b: case $B: Ws("Black: ");Black=ReadNumber();endcase
		case $c: case $C: Ws("Calibrate");JasmineCalibrate();endcase
		case $d: case $D: Ws("Delay setting: ");JasmineSetDelay(ReadHexDigit())
			endcase
		case $e: case $E: Ws("Erase");ResetDisplay();endcase
		case $f: case $F: Ws("Forward*n*tnSteps: ")
			JasmineStep(ReadNumber(),true);endcase
		case $l: case $L: Ws("Length of scan: ");ScanLen=ReadNumber();endcase
		case $m: Ws("MinMax")
		 [	let block=vec 512*6
			let scanHead = JasmineScanInit(block,512*6)
			while Endofs(keys) do
			 [	let a=JasmineReadLine(scanHead)
				let min=256;let max=0
				for x=0 to JasmineCoord(XLen)-1 do
				 [	if a>>Array.pixel^x ls min then min=a>>Array.pixel^x
					if a>>Array.pixel^x gr max then max=a>>Array.pixel^x	
				 ]
				Ws("(");Wns(dsp,min);Ws(",");Wns(dsp,max);Ws(")")
			 ]
			JasmineScanClose(scanHead)
			endcase
		 ]
		case $o: case $O: Ws("Output File");
		 [	let fileName=vec 20
			let s=ReadParam($O,"file name: ",fileName)
			let dcb=@#420
			@#420=0
			WriteFile(s,fileName)
			@#420=dcb
			endcase
		 ]
		case $q: case $Q: Ws("quit");JasmineEject();JasmineMotorOff()
			finish
		case $r: case $R: Ws("Reverse*n*tnSteps: ")
			JasmineStep(ReadNumber(),false);endcase
		case $s: case $S: Ws("Skip count: ");JasmineSetResolution(ReadHexDigit())
			endcase
		case $t: case $T: Ws("Time for integration: ");JasmineSetTime(ReadNumber())
			endcase
		case $w: case $W: Ws("White: ");White=ReadNumber();endcase
		case $x: case $X: Puts(dsp,$X);switchon Gets(keys) into
			 [	case $l: case $L: Ws("Len: ");XLen=ReadNumber();endcase
				case $s: case $S: Ws("Start: ");XStart=ReadNumber();endcase
				default: Ws("???")
			 ]
			if (XStart+XLen) gr ArraySize then XLen=ArraySize-XStart
			endcase
		case $y: case $Y: Puts(dsp,$Y);switchon Gets(keys) into
			 [	case $l: case $L: Ws("Len: ");YLen=ReadNumber();endcase
				case $s: case $S: Ws("Start: ");YStart=ReadNumber();endcase
				default: Ws("???")
			 ]
			endcase
		case $Z: 
			 [	NewPage()
				Scan()
			 ] repeatwhile Endofs(keys)
			endcase
		case #33:	//escape: flip display mode
			DisplayOn = not DisplayOn
			Ws(DisplayOn?"Display On","Display Off")
			endcase
		default:
	 ]
	SetDisplayMode(displayMode)
	] //end of keyboard case
	switchon GetButtonHit() into
	 [	case -1: endcase //have key hit before button hit
		case 0: if TwoBankMode then 
			 [	displayMode=LowBank;SetDisplayMode(LowBank)
			 ]
			Scan();endcase //scan
		case 1: Zoom();
			if TwoBankMode then 
			 [	displayMode=LowBank;SetDisplayMode(LowBank)
			 ]
			Scan()
			endcase //zoom
		case 2: //reset page
			XStart=CalibrationBlock!0;XLen=CalibrationBlock!1;YStart=0;YLen=1000
			JasmineSetWindow(XStart,XLen,YStart,YLen)
			if TwoBankMode then 
			 [	displayMode=HighBank;SetDisplayMode(HighBank)
			 ]
			endcase
		case 3: NewPage();endcase//new page
		case 4: //special functions (should be quit...?)
	 ]
 ] repeat
]

and NewPage() be
 [	JasmineEject() //first, eject old page
	Ws("*tPress any key when ready")
	SetDisplayMode(TextDisplay)
	Gets(keys)
	JasmineNewPage(10)
	XStart=CalibrationBlock!0;XLen=CalibrationBlock!1;YStart=0;YLen=1000
	JasmineSetWindow(XStart,XLen,YStart,YLen)
	test TwoBankMode then
	 [	displayMode=HighBank
		SetDisplayMode(HighBank)	
		JasmineSetDelay(4)
		JasmineSetResolution(1)
		JasmineSetTime(219)
		let savedDO=DisplayOn
		DisplayOn=false
		Black=CalibrationBlock!4;White=CalibrationBlock!5+10
		Scan()
		Black=CalibrationBlock!2;White=CalibrationBlock!3+10
		JasmineSetDelay(15)
		JasmineSetResolution(0)
		JasmineSetTime(656)
		DisplayOn=savedDO
	 ]
	or SetDisplayMode(displayMode)
 ]

and Scan() be
 [	let block=vec 512*6
	let dcb=@#420
	JasmineSetWindow(XStart,XLen,YStart,YLen)
	let Init=table[ #70000;#1401]
	let Print=table[ #70001;#1401]
	let errorVec=vec 610
	let params=vec 7
	let numPts=JasmineCoord(XLen)
	params!0=numPts	//inpts
	params!1=Black	//black
	params!2=(White-Black)*4	//range
	params!3=ScanLen	//outpts
	params!4=errorVec	//errorVec
	params!5=0	//bitOffset
	params!6=dcb!2	//screen
	params!7=38	//distance
	Init(params)
	blackDCB!3=1
	let depth=1
	let readMode=2	//default is read and step
	test DisplayOn then
	 [	//if there is enough magnification, the halftoning is the speed limit of 
		//the system.  Adding a delay cycle between scans keeps integration 
		//time constant
		if (ScanLen/numPts) ge magMax then readMode=3//readStepAndDelay
	 ]
	or @#420=blackDCB
	JasmineSetReadMode(readMode)
	let scanHead = JasmineScanInit(block,512*6)
	for y = 0 to JasmineCoord(YLen)-1 do if Endofs(keys) then
	 [	let thisPrint = Print(JasmineReadLine(scanHead))
		depth=depth+thisPrint
		blackDCB!3=(depth+1)/2
		if (depth+thisPrint+1) gr 11*72 then break
	 ]
	JasmineScanClose(scanHead)
	@#420=dcb
 ]

and Zoom() be
 [	let v=vec 4
	GetRectangle(v)
	let xStart=v!0;let yStart=v!1
	let xEnd=v!2;let yEnd=v!3
	XStart=XStart + MulDiv(xStart,XLen,ScanLen)
	YStart=YStart + MulDiv(yStart,XLen,ScanLen)
	YLen=MulDiv(yEnd-yStart,XLen,ScanLen)
	XLen=MulDiv(xEnd-xStart,XLen,ScanLen)
 ]

and WriteFile(s,fileName) be
 [	let AISheader=table [ #102252;#2000;#2011;0;0;3;1;1;8;0;#177777]
	AISheader!3=JasmineCoord(YLen)
	AISheader!4=JasmineCoord(XLen)
	AISheader!9=JasmineCoord(XLen)/2	//length of block
	let nPressCommands=22
	let PressCommands=table [ #410;0;0;#1003;SetSize;0;0;
		SetSamplingProperties;7;SSPInputIntensity;0;0;SSPScreen;45;100;85;
		SetWindow;0;0;0;0
		DotsFollow]
	PressCommands!1=JasmineCoord(XLen);PressCommands!2=JasmineCoord(YLen)
	PressCommands!5=MulDiv(ScanLen,2540,100);
	PressCommands!6=MulDiv(PressCommands!5,YLen,XLen)
	PressCommands!5=MulDiv(ScanLen,2540,100)
	PressCommands!10=Black;PressCommands!11=White
	PressCommands!18=JasmineCoord(XLen);PressCommands!20=JasmineCoord(YLen)
	WriteBlock(s,AISheader,1024-nPressCommands)
	WriteBlock(s,PressCommands,nPressCommands)
	let block=vec 512*6
	let scanHead = JasmineScanInit(block,512*6)
	for y=1 to JasmineCoord(YLen) do 
	 [	WriteBlock(s,JasmineReadLine(scanHead),JasmineCoord(XLen)/2)
		@#425=MulDiv(y,800,JasmineCoord(YLen))
	 ]
	JasmineScanClose(scanHead)
	//Trailer commands
	Puts(s,0);Puts(s,0)	//word of zero
	Puts(s,SetX);Puts(s,LeftX rshift 8);Puts(s,LeftX)
	Puts(s,SetY);Puts(s,TopY rshift 8);Puts(s,TopY)
	let nDotsWords=vec 1;
	MulFull(JasmineCoord(XLen),JasmineCoord(YLen),nDotsWords)	//nBytes
	DoubleShr(nDotsWords)	//nWords
	Puts(s,Nop);Puts(s,ShowDots)
	WriteBlock(s,nDotsWords,2)
	let EntityTrailer=vec 11
	EntityTrailer!0=0	//type,fontset
	EntityTrailer!1=0;EntityTrailer!2=2*(1024-nPressCommands)	//beginByte
	MoveBlock(EntityTrailer+3,nDotsWords,2)
	DoubleAdd(EntityTrailer+3,EntityTrailer+3)	//words to bytes
	EntityTrailer!5=0;EntityTrailer!6=0	//Xe,Ye
	EntityTrailer!7=0;EntityTrailer!8=0	//left,bottom
	EntityTrailer!9=0;EntityTrailer!10=0	//width,height
	EntityTrailer!11=18	//length
	WriteBlock(s,EntityTrailer,12)
	//Pad to end of record
	DoubleAddV(nDotsWords,18)	//add entity length
	let padLen=#377-((nDotsWords!1)&#377)
	WriteBlock(s,0,padLen)
	//Write font part (0)
	Puts(s,0);Puts(s,0)	//no font part
	WriteBlock(s,0,255)
	//Write part dir
	let partDir=vec 7
	partDir!0=0	//Page
	partDir!1=0	//recordStart
	let nRecords=nil;nRecords<<lh=nDotsWords>>rh;nRecords<<rh=(nDotsWords!1)<<lh
	nRecords=nRecords+4+1	//4 for 1024 wd hdr, and of course off by 1
	partDir!2=nRecords 
	partDir!3=padLen	//padding
	partDir!4=1	//Font
	partDir!5=partDir!2	//recordStart
	partDir!6=1	//recordLen
	partDir!7=255	//padding
	WriteBlock(s,partDir,256)
	//Write doc dir
	let docDirHdr= vec 4
	docDirHdr!0=27183	//password
	docDirHdr!1=nRecords+3	//data,3=(font,part,doc)
	docDirHdr!2=2	//number of parts (page + font)
	docDirHdr!3=nRecords+1	//part dir start
	docDirHdr!4=1	//part dir length in records
	WriteBlock(s,docDirHdr,5)
	for i=5 to #177 do [ Puts(s,-1);Puts(s,-1)]
	WriteBlock(s,fileName,26)
	WriteBlock(s,UserName,16)
	WriteBlock(s,0,#400-#252)
	Closes(s)
 ]

and ReadHexDigit() = valof
 [ let ch=Gets(keys)
	switchon ch into
 	 [ case $0: case $1: case $2: case $3: case $4: 
		case $5: case $6: case $7: case $8: case $9: 
			Puts(dsp,ch)
			resultis ch-$0
		case $a: case $b: case $c: case $d: case $e: case $f:
			Puts(dsp,$A+(ch-$a))
			resultis 10+ch-$a
		case $A: case $B: case $C: case $D: case $E: case $F:
			Puts(dsp,ch)
			resultis 10+ch-$A
		default:
			Ws(" ??? ")
			resultis ReadHexDigit()
	 ]
 ]

and ReadNumber() = valof
 [ let ch=Gets(keys)
	let val=0
	until ch eq $*n do 
	 [	Puts(dsp,ch)
		val=val*10 + ch-$0
		ch=Gets(keys)
	 ]
	resultis val
 ]
(635)