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

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Ź)*32
let threshold=(@#425)Ź
for x=0 to 511 do
[if ((scanLine>>Array.pixel↑x)Ź) le threshold then loop
let Word=base + ((x rshift 2) rshift 2)
@Word = @Word - BitTable!(x)
]
]
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)))
]
] //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()
]
]