// ScanDots.bcpl

// last modified by Ramshaw, December 11, 1980 12:42 PM
// - synch halftone screen in B as well as in S direction

// last modified by Butterfield, October 13, 1980 3:57 PM
// - ResolutionB, ResolutionS, 1X instead of 10X - 10/13/80

// errors 1600
//
//ScanDots(s,v,LeftOver)
// Called to process a BEDots entry (v is pointer).
// LeftOver is true if entry came from a LeftOver table.
//
//ScanDotsInit()
//ScanDotsClose()
// Called at beginning and end of scan conversion pass.
//
//

get "PressInternals.df"
get "PressParams.df"

// outgoing procedures
external
[
ScanDotsInit
ScanDotsClose
ScanDots
InitScreen
GCD
]

// outgoing statics
//external
//[
//]
//static
//[
//]

// incoming procedures
external
[
//FREESTORAGE
FSGet

//WINDOWS
WindowInit
WindowClose
WindowSetPosition
WindowNext
WindowReadBlock

//PRESS
PressError;PressErrorV
DblShift
FSGetX
FSPut

//PRESSML
Ugt
DoubleAdd; DoubleSub; DoubleCop
MulDiv;MulMod;DoubleAddV;DivFull;MulFull

//PUTDOTS
ScanPutDots
ScanPutHalfTone

//OS
MoveBlock
SetBlock
Zero
//FILES
FileReadPage
]

// incoming statics
external
[
ScanBuf//Core Buffer
ScanBitWc//Size of scan line
ScanBitMargin
mpSBuf//Map from scan-line to buffer
ScanS//Beginning scanline
ScanMin
ScanMax
Transparent
ResolutionS;ResolutionB//for determining halftone screen size
PressFile
ScratchFile

UseMicroCode
currentScanColor
ScanColorTable
]

// internal statics
static
[
ScanDotsWindowTable//Table of windows on dots files
nDotsWindowsToAllocate//Number of available windows
TempSLBuf//Buffer to make incoming dots contiguous
]

// File-wide structure and manifest declarations.

// Procedures

let ScanDotsInit() be
[
let a=FSGetX(nDotsRegionsB)
ScanDotsWindowTable=a
SetBlock(a,-1,nDotsRegionsB)//-1 => available
nDotsWindowsToAllocate=-nDotsBuffers
TempSLBuf=FSGetX(lTempSL)
if UseMicroCode then
[ @ScanPutDots=ScanPutDotsTrap
@ScanPutHalfTone=ScanPutDotsTrap
]
]

and ScanDotsClose() be
[
FSPut(ScanDotsWindowTable)
]

and ScanDots(v,LeftOver) = valof
[ if (currentScanColor eq 255)&
((v>>BEDots.Code ne 0)%//never print halftones if color setting is white
Transparent) //print white bitmaps unless Transparent
then resultis 0//do nothing
let S=0
let SLWC=v>>BEDots.BitFileSLWC
let ScreenAngle=v>>BEDots.ScreenAngle
let ScreenLPI=v>>BEDots.ScreenModulus//Lines per inch
let ScreenMagnitude=v>>BEDots.ScreenAmplitude

//Do first-time processing, including allocating a slot for window entry
unless LeftOver then
[//First time!
v>>BEDots.Scount=DotsDeltaConst//Initial phase
S=(v>>BEDots.Sstart)&(BANDWidth-1)

let avail=-1
for i=0 to nDotsRegionsB-1 do
if ScanDotsWindowTable!i eq -1 then
[
avail=i
break
]
if avail eq -1 then [ PressError(1600); resultis 0 ]//No more!
ScanDotsWindowTable!avail=0//No present window
v>>BEDots.WindowNumber=avail

if v>>BEDots.Code ne 0 then//grab error distribution buffer, etc.
[ test v>>BEDots.ScreenStart then//user specified dot
[ let scratch=vec 1024
FileReadPage(ScratchFile,v>>BEDots.ScreenStart,scratch)
let nCells=scratch!0
let nLines=scratch!1
let nShifts=scratch!2
let sDef=FSGet(3+nCells+nCells/nLines)
if sDef eq 0 then [ PressError(1620);resultis 0]
MoveBlock(sDef,scratch,3+nCells)
//store in BEDots vector
v>>BEDots.ScreenStart=sDef
v>>BEDots.ScreenAddress=sDef+3+nCells
v>>BEDots.ScreenModulus=nCells/nLines
//and rescale for funny press values
let scale=v>>BEDots.IMax-v>>BEDots.IMin
let half=scale*2
for i=3 to nCells+3 do sDef!i=((scale-sDef!i)*4)-half
]
or //custom made while you wait
if ScreenLPI ne 0 then
unless InitScreen(v) do [ PressError(1620);resultis 0]
//let errorbuffsize=(-v>>BEDots.Bdim)+1
//let errorptr=FSGet(errorbuffsize)
//if errorptr eq 0 then//not enough room
// [ PressError(1620);resultis 0]
//v>>BEDots.ErrorBuffer=errorptr
//let thresh=v>>BEDots.IMax-v>>BEDots.IMin
//SetBlock(errorptr,thresh,errorbuffsize)
]

if SLWC gr lTempSL then [ PressError(1621); resultis 0 ]
]

//Find the window for this dots region
let wi=v>>BEDots.WindowNumber
let w=ScanDotsWindowTable!wi
unless w then
[
test nDotsWindowsToAllocate eq 0 then
[//Must kick one out.
for i=0 to nDotsRegionsB-1 do
[
let s=ScanDotsWindowTable!i
if s ne -1 & s ne 0 then
[
WindowClose(s)
ScanDotsWindowTable!i=0//Kicked out
break
]
]
] or nDotsWindowsToAllocate=nDotsWindowsToAllocate+1
let f=v>>BEDots.File
if (f le FILEPress)&(f ge 0) then f=((f eq FILEPress)? PressFile,ScratchFile)
//Get two pages of buffering here because a typical scan-line will cross
// a page boundary. Because we are almost always blowing the picture
// up, we will backtrack a lot. Extra buffer will prevent another disk
// reference. Note that someday this might be a good place to put
// PageAhead and PageBack strategies, depending on the direction we
// are going in the file!
w=WindowInit(f,2)
ScanDotsWindowTable!wi=w
]

let Sdim=v>>BEDots.Sdim//- # scan lines to go
let Smagnify=v>>BEDots.Smagnify
let Scount=v>>BEDots.Scount
let PutDots=nil
test v>>BEDots.Code eq 0
ifso PutDots=(currentScanColor eq 0)?ScanPutDots,ScanPutShadedDots
ifnot PutDots=ScanPutHalfTone
let bufferPosChanged=true
[
[
if S eq BANDWidth then
[//More to go.
v>>BEDots.Sdim=Sdim
v>>BEDots.Scount=Scount
resultis size BEDots/16//Leave leftover for next time
]

if bufferPosChanged then
[//May need to update buffer info
let wp=vec 1
DoubleCop(wp,lv v>>BEDots.BitFilePos)//Current position
v>>BEDots.BitPhase=(wp!1)&(#17)//Position in word
DblShift(wp,4)//Word position

WindowSetPosition(w,wp)//Reset input line
test -w>>W.Offset ge SLWC
ifso v>>BEDots.BitBuf=w>>W.Base+w>>W.Offset
ifnot
[
WindowReadBlock(w, TempSLBuf, SLWC)
v>>BEDots.BitBuf=TempSLBuf
]
bufferPosChanged=false
]

//if halftone, set up screen
let mod=v>>BEDots.ScreenModulus
unless mod eq 0 do
[ let sDef=v>>BEDots.ScreenStart
let A=sDef!0
let p=sDef!1
let D=sDef!2
let Base=sDef+3+mod*((ScanS+S) rem p)
let firstElement=(MulMod((ScanS+S)/p,D,mod)+(v>>BEDots.Bstart)) rem mod
let thisScreen=v>>BEDots.ScreenAddress
MoveBlock(thisScreen,Base+firstElement,mod-firstElement)
MoveBlock(thisScreen+mod-firstElement,Base,firstElement)
]

//if opaque, zero appropriate output bit range
let Bdim=-(v>>BEDots.Bdim) // # bits to output
let Bstart=v>>BEDots.Bstart
if v>>BEDots.Bincr ls 0 then Bstart=Bstart-Bdim+1 //"start" at bottom
let Bend=Bstart+Bdim-1

if v>>BEDots.Opaque then
[ let BaseAddr=mpSBuf!S
let r1word=Bstart rshift 4
let r2word=Bend rshift 4
let r1mask=-1 lshift (#20-(Bstart))
let r2mask=-1 rshift ((Bend)+1)
BaseAddr!r1word=BaseAddr!r1word&r1mask
if r2word ne r1word then Zero(BaseAddr+r1word+1,(r2word-r1word)-1)
BaseAddr!r2word=BaseAddr!r2word&r2mask
]
if Bstart ls ScanMin then ScanMin=Bstart
if Bstart gr ScanMax then ScanMax=Bstart
if Bend ls ScanMin then ScanMin=Bend
if Bend gr ScanMax then ScanMax=Bend


//Now do all the work:
PutDots(S,v)//Go do a scan line

Sdim=Sdim+1
if Sdim eq 0 then
[//End of bits region
WindowClose(w)//Delete the window.
nDotsWindowsToAllocate=nDotsWindowsToAllocate-1
ScanDotsWindowTable!wi=-1//Available
//if v>>BEDots.Code ne 0 then FSPut(v>>BEDots.ErrorBuffer)
if v>>BEDots.ScreenModulus ne 0 then FSPut(v>>BEDots.ScreenStart)
resultis 0//No leftovers
]
S=S+1

unless Smagnify then break//If reducing, only display once.
Scount=Scount-v>>BEDots.Sdelta
if Scount ls 0 then
[
Scount=Scount+DotsDeltaConst
break
]
] repeat

[
DoubleAdd(lv v>>BEDots.BitFilePos,lv v>>BEDots.BitFileInc) //Get a bit
bufferPosChanged=true
if Smagnify then break
Scount=Scount-v>>BEDots.Sdelta
if Scount ls 0 then
[
Scount=Scount+DotsDeltaConst
break
]
] repeat

] repeat//Many,many scan lines!

]

and ScanPutShadedDots(S,v) be
[ let thisS=ScanS+S
let savedSBuf=mpSBuf!S
let tempSBuf=FSGet(ScanBitWc+1)//+1 because we’re off by one somewhere
// in computing scan length
if tempSBuf eq 0 then [ ScanPutDots(S,v);return]
Zero(tempSBuf,ScanBitWc+1)
tempSBuf=tempSBuf-ScanBitMargin/16
mpSBuf!S=tempSBuf
ScanPutDots(S,v)
mpSBuf!S=savedSBuf
//and now, update color
let cycleLen=ScanColorTable!0
let cyclePerBlock=ScanColorTable!1
let linesPerBlock=ScanColorTable!2
let blockNum=thisS/linesPerBlock
let lineNum=thisS rem linesPerBlock
let colorLine=ScanColorTable+3+lineNum*cycleLen
let lineIndex=(blockNum*cyclePerBlock+(ScanMin rshift 4)) rem cycleLen
test Transparent then
for i=ScanMin rshift 4 to ScanMax rshift 4 do
[ savedSBuf!i=savedSBuf!i%(tempSBuf!i&(colorLine!lineIndex))
lineIndex=lineIndex+1
if lineIndex eq cycleLen then lineIndex=0
]
or //solid
for i=ScanMin rshift 4 to ScanMax rshift 4 do
[ let bitsWord=tempSBuf!i
savedSBuf!i=
(savedSBuf!i&(not bitsWord))%(bitsWord&(colorLine!lineIndex))
lineIndex=lineIndex+1
if lineIndex eq cycleLen then lineIndex=0
]

FSPut(tempSBuf+ScanBitMargin/16)
]

//InitScreen(ptr)
// initialize halftone screen (returns false if no room left)
// v is a pointer to a BEDots entry, containing
//LinesPerInch in ScreenModulus
//Angle in ScreenAngle
// the screen rotation algorithm was inspired by Thomas M. Holladay’s
//internal report "Creation of Variable Angles of Dot Screens for
//Application in Serial Halftoning Techniques."

and InitScreen(v) = valof
[ //first, initialize some tables for calculating xrot,yrot from LPI,ang

//here is Sqrt(1+theta**2) for theta=0 to 89
//entries are multiplies by 1000
//xrot=Resolution/(Sqrt(1+theta**2)*LinesPerInch)
let Sqrt1PlusThetaSq=table
[ 1000;1000;1001;1001;1002
1004;1006;1007;1010;1012
1015;1019;1022;1026;1031
1035;1040;1046;1051;1058
1064;1071;1079;1086;1095
1103;1113;1122;1133;1143
1155;1167;1179;1192;1206
1221;1236;1252;1269;1287
1305;1325;1346;1367;1390
1414
]
//now, we set up a table of tangents
//again, entries are multiplied by 1000
//yrot=xrot*Tan(theta)
let Tan=table
[ 0000;0017;0035;0052;0070
0088;0105;0123;0141;0158
0176;0194;0213;0231;0249
0268;0287;0306;0325;0344
0364;0384;0404;0424;0445
0466;0488;0510;0532;0554
0577;0601;0625;0650;0675
0700;0727;0754;0781;0810
0839;0869;0900;0933;0966
1000
]

let LPI=v>>BEDots.ScreenModulus
let theta=v>>BEDots.ScreenAngle;if theta gr 45 then theta=90-theta
if ResolutionS ne ResolutionB then PressErrorV(1624,ResolutionS)
let t1 = MulDiv(ResolutionS, 100, LPI);
let xrot=MulDiv(t1,10,Sqrt1PlusThetaSq!theta)
let yrot=MulDiv(xrot,Tan!theta,1000)
if v>>BEDots.ScreenAngle gr 45 then //swap xrot, yrot
[ let t=xrot;xrot=yrot;yrot=t]

let xyMat=MakeXYMatrix(xrot,yrot)//0’s on unused spots,
//good stuff elsewhere
if xyMat eq 0 then resultis false//no room

//now, do the magic transformation
let A=xrot*xrot+yrot*yrot//Area of halftone dot
let p=GCD(xrot,yrot)//p is # of repeating strings
//each string is of length A/p
//since p|x and p|y, clearly p|(x**2+y**2)
//to calculate D, the horizontal shift, we have two modular equations:
// (x/p)*D=(mod L) -y!!BUG: was y
// (y/p)*D=(mod L) x!!BUG: was -x
//the fastest way to solve for is
// 1) find k (0 le k ls (x/p)) such that (y+kL) rem (x/p) eq 0
//(that is, D=(y+kL)/(x/p) is a solution to the first equation)
// 2) test that choice of D in the second equation: if it works,
//we’re done
//note that this takes at most x/p trials (and typically x/p ls 20)
// even though there are L <=(x**2+y**2)/p> possible values for D
let D=valof
[ if yrot eq 0 then resultis 0//without this test, we need to have
//xrot rem L in the eq statement
let L=A/p
let xp=xrot/p
let yp=yrot/p
for k=0 to yp-1 do
if ((xrot+MulMod(k,L,yp)) rem yp) eq 0 then//part 1 OK
[ let dv=vec 1
MulFull(k,L,dv)
DoubleAddV(dv,xrot)
let d=DivFull(dv,yp)
if MulMod(xp,d,L) eq (L-yrot) then resultis d
]
PressError(1622)//never happens
]

//the format for a screen definition is:
// Header (3 wds) A,p,D
// string of A elements (permanent)
// A/p blanks in which to store appropriate screen for each line
//note ScreenModulus=A/p
let sDef=FSGet(3+A+A/p)
if sDef eq 0 then resultis false//no room
sDef!0=A
sDef!1=p
sDef!2=D

//re-form xyMat into the linear repeating sequence
let i=3//index into sDef
let side=xrot+yrot//size of xyMat

let initOff=valof
[ for k=0 to side-1 do if xyMat!k gr 0 then resultis k
resultis 0
]

for z=0 to p-1 do//there are p repeating strings
[ let j=z
let off=initOff
[ //tack on elements from rvec line j
let xyPtr=xyMat+j*side
for k=off to side-1 do
if xyPtr!k gr 0 then
[ sDef!i=xyPtr!k;i=i+1]
j=(j+yrot) rem side
off=0
] repeatuntil j eq z
let xyPtr=xyMat+j*side
for k=0 to initOff-1 do
if xyPtr!k gr 0 then [ sDef!i=xyPtr!k;i=i+1]
]
unless i eq (A+3) do PressError(1623)//never happens

//update sequence so:
// 1) sum=0
// 2) scaled for IMin,IMax
let even=(A&1) eq 0
let scale=(A+1)/2
let black=v>>BEDots.IMin
let range=MulDiv(v>>BEDots.IMax-black,v>>BEDots.ScreenAmplitude,50)-1
for i=3 to A+2 do
[ sDef!i=sDef!i-scale
if even&(sDef!i le 0) then sDef!i=sDef!i-1
test sDef!i ge 0 then sDef!i=MulDiv(range,sDef!i,scale)+black
or sDef!i=-MulDiv(range,-(sDef!i),scale)+black
]

//store in BEDots vector
v>>BEDots.ScreenStart=sDef
v>>BEDots.ScreenAddress=sDef+3+A
v>>BEDots.ScreenModulus=A/p

//free up the temporary storage used
FSPut(xyMat)
resultis true
]

//Euclidean algorithm, Knuth vol. 2, p297
and GCD(u,v)=valof
[ if v eq 0 then resultis u
let r=u rem v
u=v
v=r
] repeat

and Min(a,b)=(a ls b)?a,b
and Max(a,b)=(a gr b)?a,b

and MakeXYMatrix(x,y)=valof
[ let side=x+y
let rvec=FSGet(side*side+1)
if rvec eq 0 then resultis 0//no room

//set up middle section (all active)
let a=(y gr x)?(y-x),(x-y)
let z=Min(x,y)
for j=z to z+a-1 do
for i=z to z+a-1 do
rvec!(j*side+i)=32000

//now, set up surrounding rectangles
let Avec=FSGet(x*y+1)
if Avec eq 0 then [ FSPut(rvec);resultis 0]

//first, set the rectangle elements to on or off (32000,-32000)
for i=0 to x-1 do
[let area=((i*2+1)*y+x)/(x*2)//((i*y+(i+1)*y+x))/(2*x)
let sep=y-area
for j=0 to sep-1 do [ Avec!(j*x+i)=-32000]//OFF
for j=sep to y-1 do [ Avec!(j*x+i)=32000]//ON
]

//rotate 90 degrees for side elements
let Bvec=FSGet(x*y+1)
if Bvec eq 0 then [ FSPut(Avec);FSPut(rvec);resultis 0]
for i=0 to x-1 do
for j=0 to y-1 do
[ let roti=(y-1)-j
let rotj=i
Bvec!(roti+rotj*y)=Avec!(i+j*x)
]

//schlong the appropriate rectangles in their places in rvec
Store(Avec,rvec,x,y,true)//store it starting at (0,0)
Store(Avec,rvec+x*side+y,x,y,false)//start at (y,x)
Store(Bvec,rvec+x,y,x,true)//start at (x,0)
Store(Bvec,rvec+y*side,y,x,false)//start at (0,y)

FSPut(Avec)
FSPut(Bvec)

//OK, all "active" squares in rvec are set to 32000
//now, set the active guys to appropriate counter values
let off=side/2
let ylim=(3*side)/2//1.5 > sqrt(2)
let counter=1
let slim=side-1

for yt=0 to ylim do
[ let i=0
let j=yt
let yt1sq=(yt+1)*(yt+1)
[ //for the eight points (i,j),(slim-i,j),(i,slim-j),(slim-i,slim-j),
// (j,i),(slim-j,i),(j,slim-i),(slim-j,slim-i) do:
// if point eq "active" (32000) then set it to counter
Set(rvec,off+j,off+i,side,lv counter)
Set(rvec,off+i,off+j,side,lv counter)
Set(rvec,slim-(off+i),off+j,side,lv counter)
Set(rvec,slim-(off+j),off+i,side,lv counter)
Set(rvec,slim-(off+j),slim-(off+i),side,lv counter)
Set(rvec,slim-(off+i),slim-(off+j),side,lv counter)
Set(rvec,off+i,slim-(off+j),side,lv counter)
Set(rvec,off+j,slim-(off+i),side,lv counter)

i=i+1
if (i*i+j*j) ge yt1sq then [ j=j-1;i=i-1]
] repeatuntil j ls i
]

resultis rvec
]

and Store(inVec,destVec,xlen,ylen,pos) be
[ let side=xlen+ylen//size of destination vector
for j=0 to ylen-1 do
for i=0 to xlen-1 do
[ let z=inVec!(j*xlen+i)
unless pos do z=-z
if z ls 0 then z=0
destVec!(j*side+i)=z
]
]

and Set(v,i,j,side,counterlv) be
[ if (i ge side)%(j ge side)%(i ls 0)%(j ls 0) then return
let p=v+i+j*side
let counter=@counterlv
if @p eq 32000 then [ @p=counter;@counterlv=counter+1]
]