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