//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,1000byte
]

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