// P R E D O T S
// errors 1100
//modified by Lyle Ramshaw, February 9, 1983 3:32 PM
// changed computation of Sdelta and Bdelta when reducing
// or maghifying dots arrays so that the associated input process
// won't run off the end of the input due to rounding error
// in the computation of delta. Mike Plass points out that this
// problem could have been avoided completely by a different
// choice of algorithm: instead of using integers scaled by the
// fixed constant DotsDeltaConstant as if they were rational
// numbers, just use integers scaled by the denominator of the
// fraction that you want, either the number of input or output
// scanlines.
//
//Prescan processing for "dots"
//
// ShowDots(dpc,opaque-flag)
// dpc is double-precision of word count in DL
// opaque-flag is true if white dots are opaque
//
//
get "PressInternals.df"
get "PressParams.df"
get "PressFile.df"
// outgoing procedures
external
[
ShowDots
]
// outgoing statics
//external
// [
// ]
//static
// [
// ]
// incoming procedures
external
[
//PREUTIL
DoubleMult
GetExternalFile
EqStr
Rotor
Rotor8
//WINDOWS
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowInit
WindowClose
//PARTS
GetPositioninPart
SetPositioninPart
CheckAvailinPart
//PRESCAN
CoordsUpdate
CoordsBound
CoordsConvert
CoordsConvertBox
//PREBAND
BandSync
BandWrite
//PRESSML
DoubleAdd; DoubleSub; DoubleCop;DoubleAddV
MulDiv
MulFull;DivFull
//PRESS
PressError
PressErrorV
DblShift
FSGet
FSPut
GetTime
//CURSOR
CursorToggle
//OS
Zero
]
// incoming statics
external
[
DL //Window on bits file
BandFree
PreScratchW //Window on scratch file
ScratchLen //DP length of scratch file
UseMicroCode
Report
portrait
BandCurHue;BandCurSat;BandCurBright
ScreenModulus //Defaults stated at install time
ScreenMagnitude
ScreenAngle
ExternalFileList
]
// internal statics
//static
// [
// ]
// File-wide structure and manifest declarations.
structure DParm : //For recording dots parameters
[
Code word //Code 0=bitmap; 1-16 = sample size
Mode word //Scanning mode
File word //File bits reside in
FilePos word 2 //Position in file
//Following must be grouped
// (ReadParam sign check!)
Dots word //No. of dots.
Lines word //No. of lines.
pl word //Same as in "window" spec
dl word
pd word
dd word
Width word //Size on screen
Height word
IMin word //Intensity ranges for 1/2 tone
IMax word
ScrFreq word //screen frequency
ScrAng word //screen angle
ScrAmp word //screen amplitude
[ OMinB byte
OMinH byte
OMinS byte
OMaxB byte
OMaxH byte
OMaxS byte
]
=OStats word 3
ScreenStart word
]
structure str:
[ n byte
ch↑1,128 byte
]
// Procedures
let ShowDots(dpc,opaque) be
[
if DL>>W.WhichByte then PressError(1109)
let endcp=vec 1
GetPositioninPart(DL,endcp) //Find out where the end is
DoubleAdd(endcp,dpc) // here
CheckAvailinPart(DL,2,dpc) //Check that bits are available
//Here is the magic table that decides whether to rotate, and how the
// bits run. If con=0, the mode is illegal. If con<0, rotation is
// required, after which the bits will have type abs(con).
// If (con&2)=0, bit direction is the same as the printer
// If (con&1)=0, scan direction is the same as the printer
let con=table
[ 0;0;-4;-6; //3 (Alto screen)
0;0;-5; -7;4; //8 (SLOT 3100 printer)
5;0;0;6;7;0;0
]
if portrait then con=table
[ 0;0;5;4; //3 (Alto screen)
0;0;7;6;-5; //8 (SLOT 3100 printer)
-7;0;0;-4;-6;0;0
]
let good=valof
[
let v=vec size DParm/16
Zero(v,size DParm/16)
unless ReadParams(v,con) then resultis false
let code=v>>DParm.Code
unless code ge 0 & code le 16 then [ PressErrorV(1100); resultis false ]
let sampleSize=code
if sampleSize eq 0 then sampleSize=1
// Locate the rectangular box on the output array:
let Sstart=nil; let Sdim=nil
let Bstart=nil; let Bdim=nil
unless CoordsConvertBox(v>>DParm.Width,v>>DParm.Height,
lv Sstart, lv Sdim, lv Bstart, lv Bdim) then resultis false
Sdim=Sdim-Sstart+1
Bdim=Bdim-Bstart+1
Zero(BandFree, size BEDots/16)
BandFree>>BEDots.H=BEDotsH //Op code
BandFree>>BEDots.Sstart=Sstart
BandFree>>BEDots.Sdim=-Sdim
BandFree>>BEDots.Bdim=-Bdim
compileif ReportSw then
[
test code eq 0
ifso Report>>REP.nDots=Report>>REP.nDots+1
ifnot Report>>REP.nHalfTones=Report>>REP.nHalfTones+1
let vv=vec 1
MulFull(Sdim, Bdim, vv)
DoubleAdd(lv Report>>REP.DotsOut, vv)
]
let mode=v>>DParm.Mode
con=con!mode
unless con ne 0 & mode ge 0 & mode le 15 then [ PressErrorV(1101); resultis false ]
//Rotate!
if con ls 0 then
[
con=-con
unless RotateDots(v) then resultis false
]
//Now deal with the bit direction (simplest!)
let Bincr=(con&2) eq 0 //True if B moves +
BandFree>>BEDots.Bincr=(Bincr? 1,-1)
BandFree>>BEDots.Bstart=Bstart+(Bincr? 0,Bdim-1) //Top if need be
//Deal with the scan direction.
// If file is going correct direction,
// startpos=(filepos*16)+(pl*Dots+pd)*sampleSize;
// increment=Dots*sampleSize
// else
// startpos=(filepos*16)+((pl+dl-1)*Dots+pd)*sampleSize;
// increment=-Dots*sampleSize
let Sincr=(con&1) eq 0
let sum=vec 1
DoubleCop(sum,lv v>>DParm.FilePos) //File posn
DblShift(sum,-4) //filepos*16
let v1=vec 1
let b=(Sincr? 0,v>>DParm.dl-1)+v>>DParm.pl
MulFull(v>>DParm.Dots, b, v1)
let v2=vec 1; v2!0=0; v2!1=v>>DParm.pd
DoubleAdd(v1, v2) //v1= (xxx*Dots)+pd
DoubleMult(v1, sampleSize) //v1←v1*sampleSize
DoubleAdd(sum, v1)
DoubleCop(lv BandFree>>BEDots.BitFilePos,sum) //answer
test Sincr then [ sum!0=0; sum!1=v>>DParm.Dots ]
or [ sum!0=-1; sum!1=-v>>DParm.Dots ]
DoubleMult(sum, sampleSize)
DoubleCop(lv BandFree>>BEDots.BitFileInc,sum)
sum!0=0; sum!1=v>>DParm.dd
DoubleMult(sum, sampleSize)
DoubleAdd(sum, table [ 0; 15 ] )
DblShift(sum, 4) // /16
BandFree>>BEDots.BitFileSLWC=sum!1
BandFree>>BEDots.File=v>>DParm.File
//Sample sizes, intensities:
BandFree>>BEDots.Code=v>>DParm.Code
BandFree>>BEDots.IMin=v>>DParm.IMin
BandFree>>BEDots.IMax=v>>DParm.IMax
BandFree>>BEDots.ScreenStart=v>>DParm.ScreenStart
for i=0 to 2 do (lv BandFree>>BEDots.OStats)!i=(lv v>>DParm.OStats)!i
//set up screen information (if required)
unless v>>DParm.ScrFreq eq 0 do
[ BandFree>>BEDots.ScreenModulus=v>>DParm.ScrFreq
BandFree>>BEDots.ScreenAmplitude=v>>DParm.ScrAmp
BandFree>>BEDots.ScreenAngle=v>>DParm.ScrAng
]
//Now deal with reduction and magnification.
//Here starts Lyle Ramshaw's patch:
let Sin=v>>DParm.dl //# scan lines source
let magFlag=(Sin gr Sdim ? false, true)
BandFree>>BEDots.Sdelta=ComputeDelta(magFlag, Sin, Sdim)
BandFree>>BEDots.Smagnify=magFlag
let Bin=v>>DParm.dd
magFlag=(Bin gr Bdim ? false, true)
BandFree>>BEDots.Bdelta=ComputeDelta(magFlag, Bin, Bdim)
BandFree>>BEDots.Bmagnify=magFlag
//and finally, set opaque bit and color sync
BandFree>>BEDots.Opaque=opaque
if opaque then
[ let temp=BandCurHue //BandSync will change this global
BandSync(temp xor 1,BandCurSat,BandCurBright) //just make it different
BandSync(temp,BandCurSat,BandCurBright)
]
//If we got this far, it's OK!!!
resultis true
]
test good then BandWrite(BandFree>>BEDots.Sstart,size BEDots/16)
or PressErrorV(1110)
SetPositioninPart(DL,endcp)
]
and ComputeDelta(magFlag, In, Out)= valof
// part of Lyle Ramshaw's patch: try computing the delta the
// old way, but then check a condition in each case. If
// magnifying, then guarantee that
// delta <= In*DotsDeltaConst/(Out-1).
// If reducing, then guarantee that
// delta > (Out-1)*DotsDeltaConst/(In-1).
[
let delta=nil
test magFlag
ifso
[
delta=MulDiv(In, DotsDeltaConst, Out)
let a=vec 1
let b=vec 1
MulFull(In, DotsDeltaConst, a)
MulFull(delta, Out-1, b)
DoubleSub(a,b)
if a!0 ls 0 then delta=delta-1
]
ifnot
[
delta=MulDiv(Out, DotsDeltaConst, In)
let a=vec 1
let b=vec 1
MulFull(delta, In-1, a)
MulFull(DotsDeltaConst, Out-1, b)
DoubleSub(a,b); DoubleAdd(a, table [ -1;-1 ] )
if a!0 ls 0 then delta=delta+1
]
resultis delta
]
// ReadParams(v)
// Reads the dots commands in the DL and stuffs them into the DParm
// structure v. Returns true if the specification was invalid.
// This procedure implements defaults, but makes no restrictions on
// what the program can handle.
and ReadParams(v,con) =valof
[
if DL>>W.WhichByte then PressError(1102)
v>>DParm.Code=0 //Default.
v>>DParm.pd=0
v>>DParm.pl=0
v>>DParm.Mode=3 //default=alto bitmap
let seen=0 //Flags for parts.
let dotsPage=nil
let dotsFileName=vec 20;dotsFileName!0=0
[
let a=WindowRead(DL) //Get a word
let al=a𫓸 //Left byte
let ar=aŹ
switchon al into
[
case DDotCode:
[
let sampleSize=0
if ar ge 1 & ar le 16 then sampleSize=ar
v>>DParm.Code=sampleSize
v>>DParm.Dots=WindowRead(DL)
v>>DParm.Lines=WindowRead(DL)
seen=seen%1
]
endcase
case DDotMode:
[
v>>DParm.Mode=ar //Mode
seen=seen%2
]
endcase
case 0:
switchon ar into
[
case DSampleProps:
[ let numWords=WindowRead(DL)
until numWords le 0 do
[ switchon WindowRead(DL) into
[ case SSPInputIntensity: v>>DParm.IMin=WindowRead(DL)
v>>DParm.IMax=WindowRead(DL)
numWords=numWords-3
seen=seen%32
endcase
case SSPOutputIntensity:
WindowReadBlock(DL,lv v>>DParm.OStats,3)
numWords=numWords-4
seen=seen%64
endcase
case SSPScreen: v>>DParm.ScrAng=WindowRead(DL) rem 90
v>>DParm.ScrAmp=WindowRead(DL)
v>>DParm.ScrFreq=WindowRead(DL)
numWords=numWords-4
seen=seen%128
endcase
case SSPDot:
[ let scratch=vec 260
let nCells=WindowRead(DL)
scratch!0=nCells
WindowReadBlock(DL,scratch+1,nCells+2)
numWords=numWords-(nCells+3+1)
seen=seen%256
//and store it away in scratch file
let s=vec 1
s!0=0; s!1=PreScratchW>>W.BufSize-1
DoubleAdd(ScratchLen,s);
ScratchLen!1=(ScratchLen!1)&(not s!1)
WindowSetPosition(PreScratchW,ScratchLen)
WindowWriteBlock(PreScratchW,scratch,nCells+3)
DoubleCop(scratch,ScratchLen)
v>>DParm.ScreenStart=
DblShift(scratch,PreScratchW>>W.LogBufSize)
DoubleAddV(ScratchLen,nCells+3)
endcase
]
default: PressError(1108) //Illegal SSP thing...
break
]
]
endcase
]
case DDotWindow:
[
v>>DParm.pd=WindowRead(DL)
v>>DParm.dd=WindowRead(DL)
v>>DParm.pl=WindowRead(DL)
v>>DParm.dl=WindowRead(DL)
seen=seen%4
]
endcase
case DDotSize:
[
v>>DParm.Width=WindowRead(DL)
v>>DParm.Height=WindowRead(DL)
seen=seen%8
]
endcase
case DDotsFromPressFile: PressError(1103);break
case DDotsFromFile:
seen=seen%16
dotsPage=WindowRead(DL)
dotsFileName!0=WindowRead(DL)
for i=1 to (dotsFileName!0 rshift 9) do
dotsFileName!i=WindowRead(DL)
break
case DDotsFollow:
seen=seen%16
break
default: break
]
endcase
default: break
]
] repeat
let good=true
//Warning: there is no defaulting of the "size" parameters. Such a default
// is a bad idea -- PRESS should be changed.
if (seen&(1+8+16)) ne 1+8+16 then [ PressError(1104); good=false ]
if (seen&4) eq 0 then
[
v>>DParm.dd=v>>DParm.Dots
v>>DParm.dl=v>>DParm.Lines
]
if (seen&32) eq 0 then
[ v>>DParm.IMin=0
v>>DParm.IMax=(1 lshift v>>DParm.Code)-1
]
if (seen&64) eq 0 then
[ v>>DParm.OMinB=0;v>>DParm.OMinH=0;v>>DParm.OMinS=0
v>>DParm.OMaxB=255;v>>DParm.OMaxH=255;v>>DParm.OMaxS=255
]
test v>>DParm.Code eq 0 then v>>DParm.ScrFreq=0
or if (seen&128) eq 0 then
[ v>>DParm.ScrFreq=ScreenModulus
v>>DParm.ScrAmp=ScreenMagnitude
v>>DParm.ScrAng=ScreenAngle
]
if v>>DParm.pd+v>>DParm.dd gr v>>DParm.Dots %
v>>DParm.pl+v>>DParm.dl gr v>>DParm.Lines then good=false
for i=0 to 8-1 do
if (lv v>>DParm.Dots)!i ls 0 then good=false
WindowGetPosition(DL,lv v>>DParm.FilePos)
v>>DParm.File=FILEPress
unless good do resultis false
if dotsFileName!0 ne 0 then //dots file!!
[ //look throught tridentDisk,sysDisk to find file
let dotsFile=GetExternalFile(dotsFileName)
if dotsFile eq 0 then [ PressError(1111,dotsFileName);resultis false]
let dotsPageV=vec 1;MulFull(dotsPage,256,dotsPageV)
test con!(v>>DParm.Mode) ls 0 then //rotate!!
[ let dotsWindow=WindowInit(dotsFile)
WindowSetPosition(dotsWindow,dotsPageV)
RotateDots(v,dotsWindow)
WindowClose(dotsWindow)
let oldMode=v>>DParm.Mode
v>>DParm.Mode=((oldMode&3) lshift 2)+(oldMode rshift 2)
]
or
[ DoubleCop(lv v>>DParm.FilePos,dotsPageV)
v>>DParm.File=dotsFile
]
] //end of if dotsFileName!0 eq 0
resultis true
]
//RotateDots(v,[inputWindow])
// Rotates the dots described by the DParm structure v, and fixes
// up the structure to reflect the rotation.
and RotateDots(v,inputWindow;numargs na) = valof
[ if na ls 2 then inputWindow=DL
let inTime=GetTime()
if UseMicroCode then @Rotor=PreRotorTrap
//Position scratch file to a page boundary for efficiency
let s=vec 1
s!0=0; s!1=PreScratchW>>W.BufSize-1
DoubleAdd(ScratchLen,s);
ScratchLen!1=(ScratchLen!1)&(not s!1)
WindowSetPosition(PreScratchW,ScratchLen)
//Rotate the bit map!
unless Rotate(v,inputWindow,PreScratchW,s) then resultis false
DoubleCop(lv v>>DParm.FilePos,ScratchLen)
v>>DParm.File=FILEScratch
DoubleAdd(ScratchLen,s) //New end
//Exchange dots,lines
let l=v>>DParm.Dots
v>>DParm.Dots=v>>DParm.Lines
v>>DParm.Lines=l
//Exchange pl,pd and dl,dd
let t=v>>DParm.pl; v>>DParm.pl=v>>DParm.pd; v>>DParm.pd=t
let t=v>>DParm.dl; v>>DParm.dl=v>>DParm.dd; v>>DParm.dd=t
compileif ReportSw then [ GetTime(lv Report>>REP.RotTime, inTime) ]
resultis true
]
//Rotate(v,Win,Wout,WorkingPos)
// Rotate image defined by v (DParms structure)
// Result is Lines scanlines of Dots recorded on window Win.
// Each sample is SampleSize bits in length. Note that if SampleSize=1
// (the default value), this is a bit map rotation.
// Put the output on window Wout (starting at its
// present position), and stuff into len the double precision length
// of the output data.
// Returns true if all is well, else false
and Rotate(v,Win,Wout,WorkingPos) = valof
[
let SampleSize=1
if v>>DParm.Code ne 0 then SampleSize=v>>DParm.Code
let nScans=v>>DParm.Lines
let nSamples=v>>DParm.Dots
let BeginPos=vec 1
WindowGetPosition(Wout,BeginPos) //Here's where we start
DoubleCop(WorkingPos,BeginPos)
let SamplesPerWord=16/SampleSize
let Bwordlen=nSamples/SamplesPerWord
if (nSamples rem SamplesPerWord) ne 0 then //Scan lines must begin
[ // on a word boundary for now
PressError(1105)
resultis false
]
let WordsPerBlock=16*SampleSize //a Block is 16x16 samples
//a Chunk is NxN Blocks, where
//N is chosen to be as large as possible without making the chunk larger than 256 words
let BlocksPerLine= //Sqrt(256/WordsPerBlock)
selecton 256/WordsPerBlock into
[ case 16: 4
case 4: 2
case 2: 1
default: 0
]
if BlocksPerLine eq 0 then resultis false //some illegal SampleSize
// Round up the Dots,Lines parameters because we are re-blocking
// the file.
let round=BlocksPerLine*16
v>>DParm.Lines=(nScans+round-1)&(-round)
v>>DParm.Dots=(nSamples+round-1)&(-round)
let BlocksPerChunk=BlocksPerLine*BlocksPerLine
let WordsPerChunk=BlocksPerChunk*WordsPerBlock
let BChunkLen=(nSamples-1)/(BlocksPerLine*16) //num chunks-1 (in dot direction)
let SStripLen=(nScans-1)/(BlocksPerLine*16) //num strips-1
let SBlockLen=(SStripLen+1)*BlocksPerLine
let Swordlen=(SBlockLen*16)/SamplesPerWord
let Separation=BlocksPerLine*SampleSize*16 //separation of words on adjacent lines
if SBlockLen*Separation le 0 then
[ //we'll overflow simple counter (a, alim) on merge pass
PressError(1106)
resultis false
]
//The workstrip will hold 16*BlocksPerLine scan-lines of input data.
let ScansPerStrip=16*BlocksPerLine
let workstripsize=((Bwordlen gr Swordlen)?Bwordlen,Swordlen)*ScansPerStrip
let WorkSpace=nil //Address of "workspace" ScansPerStrip input scanlines
let FlipSpace=nil //Address of "flip space" (in core rotate)
let FlipPage=nil //Address of a single "flip page" (not in core)
let Quickie=nil //True if incore rotate
//Compute the space needed for an in-core rotate:
//WATCH OUT!!! This is a very tricky calculation for big files
let incorespace=vec 1 //may need more than 2**16 words
MulFull(WordsPerChunk,(BChunkLen+1)*(SStripLen+1),incorespace)
let v=vec 1
v!0=0; v!1=workstripsize
DoubleAdd(incorespace, v)
let c=0
if incorespace!0 eq 0 then c=FSGet(incorespace!1) //FSGet on unsigned # !!!
test c eq 0 then
[
c=FSGet(workstripsize+WordsPerChunk+Swordlen)
if c eq 0 then
[
PressError(1107)
resultis false
]
Quickie=false
WorkSpace=c
FlipPage=c+workstripsize
]
or
[
WorkSpace=c
FlipSpace=c+workstripsize
Quickie=true
]
// Process all the strips
let nScansRemaining=nScans
for strips=0 to SStripLen do
[
CursorToggle(3)
let nScansToDo=(ScansPerStrip ls nScansRemaining)?ScansPerStrip,nScansRemaining
WindowReadBlock(Win,WorkSpace,Bwordlen*nScansToDo) //Read ScansPerStrip scan lines
for chunks=0 to BChunkLen do
[
//set up chunk to flip,flip,write out
let workchunk=WorkSpace+chunks*BlocksPerLine*SampleSize
if Quickie then
FlipPage=FlipSpace+(chunks*(SStripLen+1)+strips)*WordsPerChunk
let next=0
for s=0 to BlocksPerChunk-1 do //Put all blocks for this chunk into FlipPage
[ let work=workchunk+(s/BlocksPerLine)*Bwordlen*16+(s rem BlocksPerLine)
for b=0 to 15 do
[ let In=work+b*Bwordlen
for w=0 to SampleSize-1 do //16 samples fit in SampleSize words
[ FlipPage!next=In!w ; next=next+1
]
]
]
switchon SampleSize into //special case for speed
[ case 1: Rotor(FlipPage);endcase
case 8: Rotor8(FlipPage);endcase
default: resultis false
]
unless Quickie do
[
let thispos=vec 1
let ChunkLen=(chunks*(SStripLen+1)+strips)
//OK, got to be careful here:
// ChunkLen*WordsPerChunk may be greater than 16 bits
MulFull(ChunkLen,WordsPerChunk,thispos)
DoubleAdd(thispos,WorkingPos)
WindowSetPosition(Wout,thispos)
WindowWriteBlock(Wout,FlipPage,WordsPerChunk)
]
]
nScansRemaining=nScansRemaining-nScansToDo
]
//Now merge along S axis
WindowSetPosition(Wout,WorkingPos)
let WorkStrip=WorkSpace
for strips=0 to BChunkLen do
[
let inputlen=(SStripLen+1)*WordsPerChunk
test Quickie then
[
WorkSpace=FlipSpace+strips*inputlen
FlipPage=WorkStrip
]
or
[
WindowReadBlock(Wout,WorkSpace,inputlen)
WindowSetPosition(Wout,WorkingPos)
]
let astart=0
let thisstart=0
let Separation=BlocksPerLine*SampleSize*16 //separation of words on adjacent lines
let alim=SBlockLen*Separation
[
let next=0
[
let workchunk=WorkSpace+thisstart
// for a=astart to alim-1 by Separation do //can't say this in BCPL, so simulate it
let a=astart
until a ge alim do
[ let In=workchunk+a
for w=0 to SampleSize-1 do
[ FlipPage!next=In!w
next=next+1
]
a=a+Separation
]
if next ge WordsPerChunk then break //FlipPage is only big enough to
//hold WordsPerChunk words
astart=0
thisstart=thisstart+SampleSize //SampleSize words per Block row
] repeat
test Quickie then FlipPage=FlipPage+WordsPerChunk
or WindowWriteBlock(Wout,FlipPage,WordsPerChunk)
astart=ScansPerStrip*(Swordlen-(next-WordsPerChunk))
if astart eq alim then
[
thisstart=thisstart+SampleSize
astart=0
]
] repeatuntil thisstart eq Separation
test Quickie
then WindowWriteBlock(Wout,WorkStrip,inputlen)
or WindowGetPosition(Wout,WorkingPos)
]
if Quickie then WindowGetPosition(Wout,WorkingPos)
DoubleSub(WorkingPos,BeginPos) //Length
FSPut(c)
resultis true
]