//File: JasmineAIS.bcpl

//Bcpl/f JasmineAIS.bcpl

//BLDR/L/V JasmineAIS JasmineCalibrate JasmineUtil jasmc jasswat GP loadram PressML LeafPackageMain LeafBFS LeafDSKUtil LeafError LeafOpen LeafPageAct Leaf

//Last modified May 13, 1980  2:11 PM by Kerry LaPrade, XEOS

get "AISFile.d"
get "bcpl.head"

//incoming procedures
external 
 [	JasmineInit
	JasmineSetDelay
	JasmineSetResolution
	JasmineSetTime
	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
 ]


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
XKludgeA=1;XKludgeB=1	//funny lens correction
 ]

let start() be
 [	JasmineInit()
	SetupReadParam()

	let dcb=vec 5+38*700;dcb=dcb+(dcb&1)
	let Screen=dcb+4
	dcb!0=@#420
	dcb!1=38
	dcb!2=Screen
	dcb!3=350
	Zero(Screen,700*38)
	@#420=dcb
	let blackDCB=vec 8;blackDCB=blackDCB+(blackDCB&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()
	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)
			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");Zero(Screen,700*38);endcase
		case $f: case $F: Ws("Forward*n*tnSteps: ")
			JasmineStep(ReadNumber(),true);endcase
//h out of place for zoom
		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 $n: case $N: 
		 [	Ws("New Page*n")
			JasmineEject() //first, eject old page
			Ws("*tPress any key when ready")
			Gets(keys)
			JasmineNewPage(14)
			XStart=0;XLen=1024;YStart=0;YLen=1400
			JasmineSetWindow(XStart,XLen,YStart,YLen)
			endcase
		 ]
		case $o: case $O: Ws("Output File");
		 [	let fileName=vec 20
			let s=ReadParam($O,"file name: ",fileName)
			@#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: Ws("Zoom ")
		 [	while (@#177030&7) eq 7 do [ ]
			let xStart=@#424;let yStart=@#425
			while (@#177030&7) ne 7 do [ ]
			let xEnd=@#424;let yEnd=@#425
			XStart=XStart + MulDiv(xStart,XLen,ScanLen)
			YStart=YStart + MulDiv(yStart,XLen,ScanLen)
			YLen=MulDiv(yEnd-yStart,XLen,ScanLen)
			XLen=MulDiv(xEnd-xStart,XLen,ScanLen)
			//endcase intentionally omitted
		 ]
		case $h: case $H: Ws("Halftone")
		 [	let block=vec 512*6
			JasmineSetWindow(XStart,XLen,YStart,YLen)
			let scanHead = JasmineScanInit(block,512*6)
			let Init=table[ #70000;#1401]
			let Print=table[ #70001;#1401]
			let errorVec=vec 610
			let params=vec 7
			params!0=JasmineCoord(XLen)	//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=Screen	//screen
			params!7=38	//distance
			Init(params)
			blackDCB!3=1
			let depth=1
			unless DisplayOn do @#420=blackDCB
			for y = 0 to JasmineCoord(YLen)-1 do if Endofs(keys) then
			 [	depth=depth+Print(JasmineReadLine(scanHead))
				blackDCB!3=(depth+1)/2
				if depth gr 690 then break
			 ]
			JasmineScanClose(scanHead)
			@#420=dcb
			endcase
		 ]
		case #33:	//escape: flip display mode
			DisplayOn = not DisplayOn
			Ws(DisplayOn?"Display On","Display Off")
			endcase
		default:
	 ]
 ] repeat
]

//*********************************************
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 AISAttributeSection = vec (AISWordsperPage - 1)
   let AISAttributeSection = Allocate(sysZone, AISWordsperPage)
   Zero(AISAttributeSection, AISWordsperPage)

   AISAttributeSection!0 = AISPassword //From AISFILE.D
   AISAttributeSection!1 =
      AISWordsperPage //Length of attribute section

   //Raster attributes
   let rp = AISAttributeSection + 2
   (lv rp>> RPART.rpartHeader)>> APH.type = rasterPart
   (lv rp>> RPART.rpartHeader)>> APH.length = lRPARTmax
   rp>> RPART.scanCount = JasmineCoord(YLen)
   rp>> RPART.scanLength = JasmineCoord(XLen)
   rp>> RPART.scanDir = 3 //Left to right, then down
   rp>> RPART.samplesperPixel = 1
   rp>> RPART.codingType =
      UCACodingType //UnCompressed Array
   rp>> RPART.bitsperSample = 8
   rp>> RPART.wordsperSL = (rp>> RPART.scanLength) / 2
   rp>> RPART.SLperBlock = -1 //(Unblocked)
   rp>> RPART.paddingperBlock = -1 //(Unblocked)

   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(MulDiv(ScanLen, 2540, 100), XKludgeB, XKludgeA)
   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, AISAttributeSection, AISWordsperPage - nPressCommands)
   Free(sysZone, AISAttributeSection)
   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)\f1 940b46B4741b50B19b33B1b42B