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