//
// drawfile.bcpl - DoDrawFile and DoSpline
//
// Copyright 1980 Bruce D. Lucas
//
get "Redraw.d"
get "Streams.d"
get "vec.d"
// for accessing word two of .AL files
structure BASELINEWORD [
proportional bit 1
baseline bit 7
maxWidth bit 8
]
// Draw file word describing spline attributes
structure [
spare1 bit 3
Dashed bit 1
BrushShape bit 2
BrushSize bit 2
spare2 bit 5
Color bit 3
]
// Draw file word giving number of knots and type
structure [
SplineType bit 1 // 0=open, 1=closed
NumKnots bit 15
]
let DoDrawFile(DrawFileName) be [
// check Min and Max Delta, and adjust MIN and MAX DIFF
if MinDelta gr MaxDelta do MinDelta = MaxDelta
if ((MinDelta ne 1) & (MinDelta ne 2) & (MinDelta ne 4) & (MinDelta ne 8) & (MinDelta ne 16))
% ((MaxDelta ne 1) & (MaxDelta ne 2) & (MaxDelta ne 4) & (MaxDelta ne 8) & (MaxDelta ne 16)) do
Abort("bad value for min or max delta")
FLDI(MAXDIFF,MinDelta)
FLDI(MINDIFF,MinDelta); FDV(MINDIFF,KTwo)
// open draw file
let DrawStream = OpenFile(DrawFileName,ksTypeReadOnly,wordItem)
if DrawStream eq 0 do Abort("couldn' open draw file")
// why are these two words of zero at the beginning of draw files?
let w1 = Gets(DrawStream); let w2 = Gets(DrawStream);
test (w1 eq 0) & (w2 eq 0) ifso [
PutTemplate(dsp,"Old style draw file; may have to be run through new draw*c");
] ifnot if (w1 ne -1) % (w2 ne -1) do [
Abort("Sorry, I don't understand Draw files without two -1's at the beginning.*cAre you sure this is a draw file?")
]
let NumSplines = Gets(DrawStream)
// do the splines
for s=1 to NumSplines do [
// make sure entities don't get too big
if ((s rem 100) eq 0) do VecEndEntity()
let SplineDescription = Gets(DrawStream)
let SizeWord = Gets(DrawStream)
if SizeWord<<NumKnots gr MAXKNOTS do Abort("too many knots")
ReadBlock(DrawStream,p0x,2*(SizeWord<<NumKnots))
ReadBlock(DrawStream,p0y,2*(SizeWord<<NumKnots))
for k=1 to SizeWord<<NumKnots do [
// 5000 alto dots < 2↑15 dover scan lines
FLD(TEMP,lv(p0x>>LIST↑k))
if (FTR(TEMP) gr 5000) % (FTR(TEMP) ls -5000) do Abort("knot out of range")
FMP(TEMP,KAltoDover)
FST(TEMP,lv(p0x>>LIST↑k))
FLD(TEMP,lv(p0y>>LIST↑k))
if (FTR(TEMP) gr 5000) % (FTR(TEMP) ls -5000) do Abort("knot out of range")
FMP(TEMP,KAltoDover)
FST(TEMP,lv(p0y>>LIST↑k))
]
let psize = BrushTable>>FONTS↑(SplineDescription<<BrushSize).Size
let family = lv(BrushTable>>FONTS↑(SplineDescription<<BrushShape).Family)
let color = SplineDescription<<Color
if ColorFlag & (SplineDescription<<Color) do
[ psize = (psize*3)/4; psize = psize - psize rem 2 ]
VecColor(SplineDescription<<Color);
DoSpline(SizeWord<<NumKnots,SizeWord<<SplineType,
family,psize,SplineDescription)
]
VecEndEntity()
// put the text parts
for t=1 to Gets(DrawStream) do [
// make sure entities don't get too big
if ((t rem 100) eq 0) do VecEndEntity()
if not QuietFlag do PutTemplate(dsp,"T")
// get the info
let xpos = Gets(DrawStream)
let ypos = Gets(DrawStream)
let FontNum = Gets(DrawStream)
let Color = Gets(DrawStream)
Gets(DrawStream)
let Text = vec (size STRING)/16
Text!0 = Gets(DrawStream)
ReadBlock(DrawStream,lv(Text!1),(Text>>STRING↑0.data)/2)
// calculate the position
// first, find out the baseline
if TextTable>>FONTS↑FontNum.Baseline eq -1 do [
let ALStream = OpenFile(lv(TextTable>>FONTS↑FontNum.ALFileName),
ksTypeReadOnly,wordItem)
test ALStream eq 0 ifso [
TextTable>>FONTS↑FontNum.Baseline = (17*TextTable>>FONTS↑FontNum.Size)/20;
PutTemplate(dsp,"*ccould not open $S; using 17/20 hack*c",
lv(TextTable>>FONTS↑FontNum.ALFileName))
] ifnot [
Gets(ALStream);
TextTable>>FONTS↑FontNum.Baseline
= Gets(ALStream)<<BASELINEWORD.baseline
Closes(ALStream);
]
// PutTemplate(dsp,"*cbaseline for $S is $D*c",
// lv(TextTable>>FONTS↑FontNum.ALFileName),
// TextTable>>FONTS↑FontNum.Baseline)
]
// apply baseline adjusment
ypos = ypos - TextTable>>FONTS↑FontNum.Baseline;
// convert to micas
xpos = MICASperALTO*xpos; ypos = MICASperALTO*ypos
// if it's 1 arrow, apply the Ramshaw adjustment
if StringEqual(lv(TextTable>>FONTS↑FontNum.Family),"ARROWS",false)
& (Text>>STRING↑0 eq 1) do [
ArrowsMicaAdjust(Text>>STRING↑1,lv xpos,lv ypos);
// PutTemplate(dsp,"A");
]
// convert to Dover scan lines
FLDI(TEMP,SCANSperIN); FLDI(TEMPOTHER,MICASperIN); FDV(TEMP,TEMPOTHER)
FLDI(XT,xpos); FLDI(YT,ypos)
FMP(XT,TEMP); FMP(YT,TEMP)
// go for it
VecFont(lv(TextTable>>FONTS↑FontNum.Family),
TextTable>>FONTS↑FontNum.Size,
TextTable>>FONTS↑FontNum.Face)
VecPosn(FTR(XT),FTR(YT))
VecColor(Color);
VecText(Text)
]
VecEndEntity()
Closes(DrawStream)
]
// implicit arguments are p0x, p0y, p1x, p1y, p2x, p2y, p3x, p3y, and various
// global parameters, e.g. DashOn and DashOff
and let DoSpline(N,type,family,psize,SplineDescription) be [
if not QuietFlag do PutTemplate(dsp,"S")
FLD(TEMP,lv(p0x>>LIST↑1)); FAD(TEMP,KHalf); let ix = FTR(TEMP)
FLD(TEMP,lv(p0y>>LIST↑1)); FAD(TEMP,KHalf); let iy = FTR(TEMP)
FLD(TEMP,lv(p0x>>LIST↑N)); FAD(TEMP,KHalf); let endx = FTR(TEMP)
FLD(TEMP,lv(p0y>>LIST↑N)); FAD(TEMP,KHalf); let endy = FTR(TEMP)
// if it's an orthogonal straight line or a dot, optimize it and return
if ( (ix eq endx) % (iy eq endy) ) & ( (N eq 1) % (N eq 2) )
& OptFlag & (not SplineDescription<<Dashed) do [
if not QuietFlag do PutTemplate(dsp,"r")
switchon SplineDescription<<BrushShape into [
case ROUNDBRUSH:
VecFont(family,psize,0)
VecPosn(ix,iy)
VecPut(0,0)
if (N ne 1) do [
VecPosn(endx,endy)
VecPut(0,0)
test ix eq endx ifso VecRectangle(ix,iy,endx,endy,psize/2,0)
ifnot VecRectangle(ix,iy,endx,endy,0,psize/2)
]
endcase
case SQUAREBRUSH:
VecRectangle(ix,iy,endx,endy,psize/2,psize/2)
endcase
case HORIZBRUSH:
VecRectangle(ix,iy,endx,endy,psize/2,1)
endcase
case VERTBRUSH:
VecRectangle(ix,iy,endx,endy,1,psize/2)
endcase
default:
Abort("internal problem: bad brush code")
]
return
]
// otherwise, GO FOR IT
ParametricSpline(N,p0x,p0y,p1x,p2x,p3x,p1y,p2y,p3y,type)
VecFont(family,psize,0)
VecPosn(ix,iy)
let dx = nil; let dy = nil
FLDI(T,0);
let delta = MaxDelta
let DashCount = 0 // ranges from -DashOff to DashOn-1. Output vector
// only if DashCount ge 0
// handle duplicated knots specially--see below
let DuplicateKnot = nil
test (FCM(FLD(TEMP,lv(p0x>>LIST↑1)),lv(p0x>>LIST↑2)) eq 0)
& (FCM(FLD(TEMP,lv(p0y>>LIST↑1)),lv(p0y>>LIST↑2)) eq 0)
ifso DuplicateKnot = true
ifnot DuplicateKnot = false
for k=1 to N-1 do [
if not QuietFlag do PutTemplate(dsp,"k")
// ignore stuff between duplicated knots, so try to hit the first of a
// series of duplicated knots exactly, since the derivative will change
let extraneous = DuplicateKnot
test (k ne N-1)
& (FCM(FLD(TEMP,lv(p0x>>LIST↑(k+1))),lv(p0x>>LIST↑(k+2))) eq 0)
& (FCM(FLD(TEMP,lv(p0y>>LIST↑(k+1))),lv(p0y>>LIST↑(k+2))) eq 0)
ifso DuplicateKnot = true
ifnot DuplicateKnot = false
if extraneous do loop
LoadPoly(k,p0x,p1x,p2x,p3x,XTPOLY,XPTPOLY)
LoadPoly(k,p0y,p1y,p2y,p3y,YTPOLY,YPTPOLY)
EvalPoly(XT,XTPOLY,T,3)
EvalPoly(YT,YTPOLY,T,3)
let DoneWithKnot = false
[
EvalPoly(XPT,XPTPOLY,T,2)
EvalPoly(YPT,YPTPOLY,T,2)
if FSN(XPT) eq 0 do FLD(XPT,KEpsilon)
test FSN(XPT) gr 0 ifso dx = delta ifnot dx = -delta
FLDI(XWALLDT,ix + dx)
FSB(XWALLDT,XT)
FDV(XWALLDT,XPT)
if FSN(YPT) eq 0 do FLD(YPT,KEpsilon)
test FSN(YPT) gr 0 ifso dy = delta ifnot dy = -delta
FLDI(YWALLDT,iy + dy)
FSB(YWALLDT,YT)
FDV(YWALLDT,YPT)
FLD(NEWT,T)
test FCM(XWALLDT,YWALLDT) ls 0 ifso [
FAD(NEWT,XWALLDT)
FLD(TEMP,XWALLDT)
FMP(TEMP,YPT)
FAD(TEMP,YT)
test FSN(TEMP) gr 0 ifso FAD(TEMP,KHalf) ifnot FSB(TEMP,KHalf)
dy = FTR(TEMP) - iy
] ifnot [
FAD(NEWT,YWALLDT)
FLD(TEMP,YWALLDT)
FMP(TEMP,XPT)
FAD(TEMP,XT)
test FSN(TEMP) gr 0 ifso FAD(TEMP,KHalf) ifnot FSB(TEMP,KHalf)
dx = FTR(TEMP) - ix
]
// if it's last knot or we're approaching a knot which is duplicated,
// make T=1 our objective, i.e. try to hit it exactly
if (DuplicateKnot % (k eq N-1)) & (FCM(NEWT,KOne) gr 0) do
FLD(NEWT,KOne)
EvalPoly(NEWXT,XTPOLY,NEWT,3)
EvalPoly(NEWYT,YTPOLY,NEWT,3)
FLDI(XDIFF,ix+dx); FLDI(YDIFF,iy+dy)
FSB(XDIFF,NEWXT); FSB(YDIFF,NEWYT)
if FSN(XDIFF) ls 0 do FNEG(XDIFF); if FSN(YDIFF) ls 0 do FNEG(YDIFF)
test (delta gr MinDelta)
& ( ((DashCount+delta gr DashOn) & SplineDescription<<Dashed)
% ((DashCount ls 0) & (DashCount+delta gr 0) & SplineDescription<<Dashed)
% (FCM(XDIFF,MAXDIFF) gr 0)
% (FCM(YDIFF,MAXDIFF) gr 0)
) ifso [
delta = delta/2
] ifnot [
if FCM(NEWT,KOne) ge 0 do DoneWithKnot = true
test DashCount ge 0 ifso [
if VerboseFlag do PutTemplate(dsp,"$D ",delta)
VecPut(dx,dy)
] ifnot [
if VerboseFlag do PutTemplate(dsp,"($D) ",delta)
VecSkip(dx,dy)
]
if SplineDescription<<Dashed do [
DashCount = DashCount + delta
if DashCount ge DashOn do DashCount = -DashOff
]
ix = ix + dx; iy = iy + dy
FLD(T,NEWT); FLD(XT,NEWXT); FLD(YT,NEWYT)
if (delta ls MaxDelta) &
((FCM(XDIFF,MINDIFF) ls 0) & (FCM(YDIFF,MINDIFF) ls 0))
do delta = 2*delta
]
] repeatuntil DoneWithKnot
FSB(T,KOne)
if VerboseFlag do WaitForKey()
]
]
and let LoadPoly(k,p0,p1,p2,p3,POLY,PPOLY) be [
// t(x) or t(y)
FLD(POLY,lv(p3>>LIST↑k)); FDV(POLY,KSix)
FLD(POLY+1,lv(p2>>LIST↑k)); FDV(POLY+1,KTwo)
FLD(POLY+2,lv(p1>>LIST↑k))
FLD(POLY+3,lv(p0>>LIST↑k))
// t'(x) or t'(y)
FLD(PPOLY,lv(p3>>LIST↑k)); FDV(PPOLY,KTwo)
FLD(PPOLY+1,lv(p2>>LIST↑k))
FLD(PPOLY+2,lv(p1>>LIST↑k))
]
and let EvalPoly(result,poly,point,degree) be [
FLD(result,poly)
for i=1 to degree do [
FMP(result,point)
FAD(result,poly+i)
]
]