//bldr xjas jasmc jasswat loadram

get "bcpl.head"

//incoming procedures
external 
 [	LoadRam;SetBLV
	JasmineSwatContextProc

	//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

 ]

//incoming statics
external RamImage

manifest
 [ SafeLoc=#177022
	StepLoc=#177020
	Outport=#177016
	ITQUAN=#422
	ITIBITS=#423
	ITTIME=#525
	ScanTime=#526
	ScanCBHead=#736
	StartCommand=#737
 ]

structure Array :
 [ pixel^0,1000	byte
 ]

static [ ArraySize=1024;testArray;TimerMode=0;
		CursorTime=false;Time=656	//38 usec ticks
		zArray;forward = true; StepCommand
		Black=#170
		Range=#400
		Late=0;Bad=0
		ScanMode=2	//Read,Step,Delay
		nBlocks=1
		savedUFP;savedSCP
		ScannerTaskBits=#177376
		maxSamples=1024
Debug=true
		]


let start() be
 [	JasmineInit()

	let t=vec 512*6
	testArray=t

	let dcbs=vec 4*5+32*256+32*256+1
	let top=InitDisplay(dcbs)
	let bottom=top+32*256
	let topDCB=@#420
	let DisplayOn=true

let lastLoc=0
 [ 	JasmineMotorOff()	//turn off motor
	let ch=Gets(keys)
	Puts(dsp,$*n)
	Puts(dsp,ch)
	switchon ch into
	 [	case $f: case $F: Ws("orward");JasmineStep(1,true);forward=true;endcase
		case $b: case $B: Ws("ack");JasmineStep(1,false);forward=false;endcase
case $m: case $M: Ws("em: ")
 [	let ch=Gets(keys)
	test ch eq $*n then Wo(lastLoc)
	or 
	 [	lastLoc=0
		until ch eq $*n do [ Puts(dsp,ch);lastLoc=lastLoc*8+ch-$0;ch=Gets(keys)]
	 ]
	Ws("^ = ");Wo(@lastLoc)
 	endcase
 ]
		case $h: case $H: Ws("alftone")
		 [	let scanHead = JasmineScanInit(testArray,512*6)
			let Init=table[ #70000;#1401]
			let Print=table[ #70001;#1401]
			let errorVec=vec 610
			let topdispDCB=top-16
			let params=vec 7
			params!0=512	//inpts
			params!1=Black	//black
			params!2=Range	//range
			params!3=512	//outpts
			params!4=errorVec	//errorVec
			params!5=0	//bitOffset
			params!6=top	//screen
			params!7=32	//distance
			topdispDCB!0=topdispDCB+8
			Init(params)
let dcbHead=@#420
unless DisplayOn do @#420=0
			for y = 0 to 255 do if Endofs(keys) then
				Print(JasmineReadLine(scanHead))
			params!6=bottom
			Init(params)
			for y = 256 to 511 do if Endofs(keys) then
				Print(JasmineReadLine(scanHead))
unless DisplayOn do @#420=dcbHead
			while Endofs(keys) % (@ScanCBHead ne 0) do [ ]
			JasmineScanClose(scanHead)
			topdispDCB!0=topdispDCB+4
			endcase
		 ]
		case $p: case $P: Ws("lot")
		 [	let BitTable=table [ #100000;#40000;#20000;#10000;#4000;#2000
				#1000;#400;#200;#100;#40;#20;#10;4;2;1]
			let scanHead = JasmineScanInit(testArray,512*6)
			SetBlock(top,-1,32*256)
			SetBlock(bottom,-1,32*256)
			let topdispDCB=top-16
			topdispDCB!0=topdispDCB+8
			for y = 0 to 511 do if Endofs(keys) then
 			 [	let scanLine = JasmineReadLine(scanHead)
				let base=((y ge 256)?bottom,top) + (y&#377)*32
				let threshold=(@#425)&#377
				for x=0 to 511 do
				 [	if ((scanLine>>Array.pixel^x)&#377) le threshold then loop
					let Word=base + ((x rshift 2) rshift 2)
					@Word = @Word - BitTable!(x&#17)
				 ]
			 ]
			while Endofs(keys) % (@ScanCBHead ne 0) do [ ]
			topdispDCB!0=topdispDCB+4
			JasmineScanClose(scanHead)
			endcase
		 ]
case $v: case $V: Ws("isualize")
 [	let BitTable=table [ #100000;#40000;#20000;#10000;#4000;#2000
		#1000;#400;#200;#100;#40;#20;#10;4;2;1]
	let scanHead = JasmineScanInit(testArray,512*6)
	let ReadArraySize=JasmineCoord(ArraySize)
	while Endofs(keys) do
	 [ //reset display
		SetBlock(top,-1,32*256)
		SetBlock(bottom,-1,32*256)
		for line=1 to nBlocks do if Endofs(keys) then
		 [	let scanLine=JasmineReadLine(scanHead)
			for i=0 to ReadArraySize-1 do
			 [	let x=i&511
				let column=((i ge 512)?bottom,top)+(x rshift 4)
				let Word=column+(scanLine>>Array.pixel^i)*32
				@Word=@Word & (not (BitTable!(x&#17)))
			 ]
		 ] //for line
	 ] //while Endofs
	JasmineScanClose(scanHead)
 ]
endcase
case $o: case $O: Ws("ffset increment")
 [	let block=vec 1024
	for i=0 to 1023  do
	 [	block!i = (i rshift 4) lshift 6
	 ]
	JasmineLoadRam(block)
	endcase
 ]
case $g: case $G: Ws("ain increment")
 [	let block=vec 1024
	for i=0 to 1023  do
	 [	block!i = i rshift 4
	 ]
	JasmineLoadRam(block)
	endcase
 ]
		case $d: case $D: Ws("elay setting: ")
			JasmineSetDelay(ReadHexDigit())
			endcase
		case $l: case $L: Ws("oad RAM with constant: ")
			[ let block=vec 1024
			  let constant=(ReadHexDigit() lshift 8)+(ReadHexDigit() lshift 4)+
			  		ReadHexDigit()
			for i=0 to 1023  do
			 [	block!i = constant
			 ]
			JasmineLoadRam(block)
			  endcase
			 ]
		case $s: case $S: Ws("tart; skip count: ")
			 [	JasmineSetResolution(ReadHexDigit())
				endcase
			 ]
		case #33:	//escape: flip display mode
			DisplayOn = not DisplayOn
			@#420 = DisplayOn?topDCB,0
			endcase
		case $q: case $Q: Ws("uit")
			finish
		default:
	 ]
 ] repeat
]


and InitDisplay(dcbs) = valof
 [ let lastdcb=@#420;until @lastdcb eq 0 do lastdcb=@lastdcb
	dcbs=dcbs+(dcbs&1)
	let top=dcbs+4*5
	let bottom=top+32*256
	SetBlock(top,-1,32*256)
	SetBlock(bottom,-1,32*256)

	dcbs!0=dcbs+4
	dcbs!1=#40000	//invert
	dcbs!2=0
	dcbs!3=16

	dcbs!4=dcbs+8
	dcbs!5=#41440
	dcbs!6=top
	dcbs!7=128

	dcbs!8=dcbs+12
	dcbs!9=#40000	//invert
	dcbs!10=0
	dcbs!11=16

	dcbs!12=dcbs+16
	dcbs!13=#41440
	dcbs!14=bottom
	dcbs!15=128

	dcbs!16=0
	dcbs!17=#40000	//invert
	dcbs!18=0
	dcbs!19=1
	@lastdcb=dcbs
	resultis top
 ]

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()
	 ]
 ]

(635)\1222b14B