// PreObjects.bcpl // last modified by Butterfield, October 22, 1980 4:08 PM // - ShowObject, turn off rectangle checking temporarily - 10/22 // - ShowObject, if a rectangle, use extended rectangle if necessary - 10/15 // - ShowRectangle, have 15 extended rectangles - 10/15 // - ShowObject, let sdirmin eq sdirmax & rdirmin eq rdirmax - 9/10/80 // errors 1000 // //ShowRectangle(w,h) // Called to put a rectangle description in the band list. //ShowObject(n) // Called with word count of object stuff in DL to put in // band list. // %%%% Note: variant needed to deal with characters that // were so big that spline encodings were left %%%% // get "PressInternals.df" get "PressParams.df" get "PressFile.df" get "Scv.dfs" // outgoing procedures external [ ShowRectangle ShowObject ] // outgoing statics //external // [ // ] //static // [ // ] // incoming procedures external [ //BAND BandWrite BandSync //PRESCAN CoordsConvert CoordsConvertBox CoordsConvertF CoordsBound //PARTS CheckAvailinPart SkipinPart //WINDOWS WindowRead WindowReadBlock //PRESS PressError PressErrorV FSGet; FSGetX; FSPut //PRESSML DoubleCop DoubleAdd TGr Ugt //OS MoveBlock; SetBlock; Zero //FLOAT FLD; FST; FTR; FLDI; FNEG; FAD; FSB; FML; FDV; FCM; FSN; FLDV; FSTV; FLDDP; FSTDP ] // incoming statics external [ Entity //Entity we are working on DL PreScratchW //Window on scratch file BandFree Report printerDevice //for bits structure: ORbit only handles 12 bits of x ] // internal statics static [ //fontpass has these guys already defined nomoco //True if no more core available sdirmin //Current min and max values sdirmax rdirmin rdirmax lasts //State for putsegment firstpiece //True if new MoveTo firstpieceflag //State for putsegment firstpiecep // " todolist //list of all things to scan convert KlugeCycleColors ] // File-wide structure and manifest declarations. // Procedures let ShowRectangle(w,h) be [ compileif ReportSw then [ Report>>REP.nObjects=Report>>REP.nObjects+1 ] let s,st,b,bt=nil,nil,nil,nil unless CoordsConvertBox(w,h,lv s,lv st,lv b,lv bt) then [ PressErrorV(1004); return ] if b ge 4096 then //not printable in ORbit worldd [ if b ge 8192 then //too big to handle [ PressErrorV(1006);return] if printerDevice le printerDurango then //ORbit, blown [ PressErrorV(1007);return] ] BandFree>>BERectangle.Type = (((b & #170000) eq 0)? BERectangleH, BEExtendedRectangleH - 1 + b rshift 12); BandFree>>BERectangle.Sr=s BandFree>>BERectangle.Bit=b BandFree>>BERectangle.nHeight=-(bt-b+1) BandFree>>BERectangle.widthM1=st-s BandWrite(s, size BERectangle/16) ] and ShowObject(n,xoff,yoff;numargs na) = valof //returns true is simple object (rectangle) [ let InFile=nil test na eq 1 then [ InFile=DL;xoff=Entity>>EH.Xe;yoff=Entity>>EH.Ye] or [ InFile=PreScratchW] if InFile>>W.WhichByte then PressError(1005) //Not word-aligned if KlugeCycleColors then [ BandSync((KlugeCycleColors rem 256)) //Something non-white KlugeCycleColors=KlugeCycleColors+153 ] compileif ReportSw then [ Report>>REP.nObjects=Report>>REP.nObjects+1 ] if InFile eq DL then CheckAvailinPart(DL,1,n) //Make sure n words avail. //******* From SCVBeginObject todolist=0 firstpiece=true //Flag for MoveTo firstpiecep=FSGetX(4*(orac-esd+1)) nomoco=(firstpiecep eq 0) //True if no more fs rdirmin=plusinfinity; sdirmin=plusinfinity rdirmax=minusinfinity; sdirmax=minusinfinity //******* end from SCVBeginObject let v=vec 20 FLDI(3,xoff) FLDI(4,yoff) while n gr 0 do [ let a=WindowRead(InFile) n=n-1 switchon a into [ case DMoveTo: [ unless firstpiece then ObjFlushit() WindowReadBlock(InFile,v,2) //Get coords n=n-2 FLDI(1,v!0); FLDI(2,v!1) FAD(1,3); FAD(2,4) //Add Xe,Ye CoordsConvertF(1,2,osac,orac,true) FLD(fsac,osac) FLD(frac,orac) ] endcase case DDrawTo: [ WindowReadBlock(InFile,v,2) n=n-2 FLDI(1,v!0); FLDI(2,v!1) FAD(1,3); FAD(2,4) //Add Xe,Ye CoordsConvertF(1,2,csac,crac,true) putsegment(1) FLD(osac,csac) FLD(orac,crac) ] endcase case DDrawCurve: [ WindowReadBlock(InFile,v,12) n=n-12 FLD(esd,osac) FLD(erd,orac) //Get 0Th derivative for i=0 to 5 by 2 do [ CoordsConvertF(v+i*2,v+2+i*2,esc+i,esc+i+1,false) ] ObjDrawCurve() //Do it. ] endcase default: [ PressError(1000) if InFile eq DL then SkipinPart(DL,1,n) //Skip remaining words n=0 ] ] ] if n ne 0 then PressError(1001) //**** From SCVEndObject if nomoco then [ PressError(1002) resultis true //nothing done, so still simple ] ObjFlushit() //Flush object FSPut(firstpiecep) //**** End from SCVEndObject //If no object results, min>max. CoordsBound might do the right thing // if it were modified to use "true greater than", but it would probably // expand several dimensions of the bounding box in the process, which // is simply wasteful. However, because SCV itself uses Bcpl gr tests, // we may have a non-zero todolist and still have an illegal object. let GoodObj=(todolist ne 0)& (TGr(sdirmax+1,sdirmin))&(TGr(rdirmax+1,rdirmin)) if GoodObj then GoodObj=CoordsBound(sdirmin,sdirmax,rdirmin,rdirmax) let s=sdirmin //first, check for a rectangle if 0 & GoodObj&(@todolist ne 0)&(@@todolist eq 0)& // turned off (todolist>>HD.type eq LINEtype)& ((@todolist)>>HD.type eq LINEtype)& (todolist>>HD.smin eq (@todolist)>>HD.smin)& (todolist>>HD.smax eq (@todolist)>>HD.smax)& ((lv todolist>>LINE.dx)!0 eq 0)& ((lv todolist>>LINE.dx)!1 eq 0)& ((lv (@todolist)>>LINE.dx)!0 eq 0)& ((lv (@todolist)>>LINE.dx)!1 eq 0) then //RECTANGLE!!! [ let b1=lv todolist>>LINE.x let b2=lv (@todolist)>>LINE.x test b1!1 ls 0 then b1=b1!0+1 or b1=b1!0 //round up if fraction>1/2 test b2!1 ls 0 then b2=b2!0+1 or b2=b2!0 if Ugt(b1, b2) then [ let t = b1; b1 = b2; b2 = t; ] BandFree>>BERectangle.Type = (((b1 & #170000) eq 0)? BERectangleH, BEExtendedRectangleH - 1 + b1 rshift 12); BandFree>>BERectangle.Type=BERectangleH BandFree>>BERectangle.Sr=todolist>>HD.smin BandFree>>BERectangle.Bit=b1 BandFree>>BERectangle.nHeight=-(b2-b1+1) BandFree>>BERectangle.widthM1=todolist>>HD.smax-todolist>>HD.smin BandWrite(s, size BERectangle/16) while todolist do [ let p=todolist todolist=p>>HD.next FSPut(p) ] resultis true //still a simple page ] //Now loop through all entries in todolist, putting out band stuff. while todolist do [ let p=todolist todolist=p>>HD.next BandFree>>SH.Sbegin=p>>HD.smin BandFree>>SH.Send=p>>HD.smax test p>>HD.type eq LINEtype then [ BandFree>>BELine.H=BELineH //A line DoubleCop(lv BandFree>>BELine.Bit,lv p>>LINE.x) DoubleCop(lv BandFree>>BELine.dBit,lv p>>LINE.dx) if GoodObj then BandWrite(s,size BELine/16) ] or [ BandFree>>BESpline.H=BESplineH //A spline MoveBlock(lv BandFree>>BESpline.Stuff,lv p>>RSPLINE.str,16) if GoodObj then BandWrite(s,size BESpline/16) ] FSPut(p) ] BandFree>>BEEndObject.H=BEEndObjectH //And a terminator test GoodObj then BandWrite(s,size BEEndObject/16) or PressErrorV(1003) resultis not GoodObj ] and ObjDrawCurve() be [ //Now bust the spline into sections // that are monotonic in the scan direction. //ROOT records the value of t in FPAC t1 as a spot on // the curve that is an internal extremum in scan direction. // it sorts this value into a table of floating point // numbers, pointed to by PTR. PTR!0 is the number of roots // so far (initially 2, t=0 and t=1). // (If ptr=0, we are calculating r extrema) let root(ptr) be [ if FSN(t1) eq 1 & FCM(t1,table [ #40300;0]) eq -1 then test ptr ne 0 then [ //Root lies between 0 and 1 let i=(@ptr)*2-1; let j=i while FCM(t1,ptr+i) eq -1 do i=i-2 for k=j+1 to i+2 by -1 do ptr!(k+2)=ptr!k FST(t1,ptr+i+2) @ptr=@ptr+1 ] or [ feval(1,t1,t2) //get r value let r=Floor(t2) //truncate if r ls rdirmin then rdirmin=r if r gr rdirmax then rdirmax=r ] ] and findextrema(ptr,d) be [ let esbd=esb+d test FSN(esa+d) ne 0 then [ //A ne 0 FLDI(t2,-3); FML(t2,esa+d) //-3A FLD(t1,esbd); FML(t1,esbd) FLD(t3,t2); FML(t3,esc+d); FAD(t1,t3) //B^2-3AC let b=FSN(t1) //Sign of discriminant if b ne -1 then [ //Possible root test b eq 0 then [ FLD(t1,esbd); FDV(t1,t2) ] //-B/3A or [ //Take square root let a=vec 3; FSTV(t1,a);a!1=a!1/2;FLDV(t3,a) for i=0 to 2 do [ FLD(t4,t1);FDV(t4,t3);FAD(t3,t4) FLDI(t4,2);FDV(t3,t4) ] FDV(t3,t2) //SQRT(b^2-3ac)/-3a FLD(t4,esbd);FDV(t4,t2) //B/-3A FLD(t1,t4);FSB(t1,t3) //+root root(ptr) FLD(t1,t4);FAD(t1,t3) //-root ] root(ptr) //Other root ] //Possible root ] or [ //A=0 if FSN(esbd) ne 0 then [ FLD(t1,esc+d);FDV(t1,esbd);FNEG(t1) FLDI(t2,2);FDV(t1,t2) //-C/2B root(ptr) ] ] ] //If we need bounding box, record extreme values of s and r // at any interior extrema. Putsegment will take care of endpoint // extrema. //***** Edits near here ***** findextrema(0,1) let ptr=vec 9; Zero(ptr,9); ptr!0=2; ptr!3=#40300 findextrema(ptr,0) //***** End edits ***** //Now table ptr has values of t // that cause junctions between monotonic segments. //"Old" points already set up. FLDI(tmaxac,0) for i=1 to ptr!0-1 do [ FLD(tminac,tmaxac) //New tmin is old tmax FLD(tmaxac,ptr+i*2+1) //Get junction from table feval(0,tmaxac,csac) //Evaluate current points feval(1,tmaxac,crac) putsegment(0) //Do the spline FLD(osac,csac) //Set old points FLD(orac,crac) ] ] and ObjFlushit() be [ unless firstpiece then [ FLD(csac,fsac) FLD(crac,frac) putsegment(2) //Join up. putsegment(-1) //Flush last piece. firstpiece=true ] ] and //This function checks for closure and builds LINE and SPLINE //blocks for later reference. //Entry conditions: //Line (lineflag=1 or 2): // Draw a line from (osac,orac) to (csac,crac) // Must leave csac,crac untouched because they are used // to reset the "old" point for next time. //Spline (lineflag=0): // Draw a spline from (osac,orac) to (csac,crac) which // corresponds to values of t, tminac le t le tmaxac. // Coefficients are in esa...esd and era...erd // Must leave csac, crac unchanged. //Finish up call (lineflag=-1): // There is global state in: firstpiece, // firstpiecep and firstpieceflag.. // Firstpiece is true if this is the first segment of a closed curve. putsegment(lineflag) be [ // external TypeForm // let str=vec 2 // TypeForm(2,csac,32,2,crac,1,str) if lineflag ls 0 then [ //Restore accumulators lineflag=firstpieceflag let p=firstpiecep for i=(lineflag? csac,esd) to orac do [ FLDV(i,p); p=p+4 ] ] let smin=Floor(osac) //Value of S at tmin let smax=Floor(csac) //Value of S at tmax //Update r direction extrema (must do before checking smin=smax because // we only check "current" value of r direction, so we must check every // leg of the closed curve). let r=Floor(crac) if r ls rdirmin then rdirmin=r if r gr rdirmax then rdirmax=r if smin eq smax then return //No intersections. if firstpiece then [ firstpiece=false firstpieceflag=lineflag let p=firstpiecep for i=(lineflag? csac,esd) to orac do [ FSTV(i,p); p=p+4 ] lasts=smax //This is what we need to know. return ] let stop,sbot=nil,nil //Thisdirection is 1 if increasing t gives decreasing s let thisdirection=(smin gr smax)?1,-1 test thisdirection eq 1 then [ stop=lasts; sbot=smax+1 ] or [ stop=smax; sbot=lasts+1 ] //Update s direction extrema if sbot ls sdirmin then sdirmin=sbot if stop gr sdirmax then sdirmax=stop //Save scan-line intersection state for next time. lasts=smax //Get free storage block to hold this line or spline if nomoco then return //None available, return //***** Edits near here to remove cond assy, FSGet ***** let nx=FSGet((lineflag? size LINE/16,size RSPLINE/16)) if nx eq 0 then [ //Out of free storage nomoco=true //Say so. let p=todolist // while p do //Release core [ let np=p>>HD.next FSPut(p) p=np ] return ] //***** End of edits ***** //Build description of line or spline segment test lineflag then [ //LINE nx>>LINE.type=LINEtype FLD(t1,crac);FSB(t1,orac) //Delta r FLD(t2,csac);FSB(t2,osac) //Delta s FDV(t1,t2);FSTDP(t1,lv nx>>LINE.dx) //Increment each scan line FLDI(t2,sbot);FSB(t2,osac) FML(t1,t2);FAD(t1,orac) //Bottom point. FSTDP(t1,lv nx>>LINE.x) //and save it. ] //LINE or [ //SPLINE nx>>RSPLINE.type=SPLINEtype test thisdirection ls 0 then [ FLD(t1,tminac) //t1 is at low s end FLD(t2,tmaxac) ] or [ FLD(t1,tmaxac) FLD(t2,tminac) ] // CEVAL computes and fills in F(tac) values and G(tac) values. // Indx=0 for s direction, 1 for r. let ceval(indx,tac,ptr) be [ feval(indx,tac,t4) //Get value of function. FSTDP(t4,ptr) //Put down value. FLDI(t4,3);FML(t4,esa+indx);FML(t4,tac) //3At FAD(t4,esb+indx) //3At+B FML(t4,t3) //(dt^2)(3At+B) FSTDP(t4,ptr+2) //Put it down. ] FLD(t3,t2);FSB(t3,t1);FML(t3,t3) //(dt^2) ceval(0,t1,lv nx>>RSPLINE.stl) ceval(1,t1,lv nx>>RSPLINE.rtl) ceval(0,t2,lv nx>>RSPLINE.str) ceval(1,t2,lv nx>>RSPLINE.rtr) ] //SPLINE //Record some common information in the block. nx>>HD.smin=sbot nx>>HD.smax=stop nx>>HD.next=todolist; todolist=nx ] and feval(indx,tac,rac) be [ //Evaluate the spline (indx=0, s direction; 1 r direction) // tac=AC with value of t; rac=AC for result FLD(rac,esa+indx) FML(rac,tac) FAD(rac,esb+indx) FML(rac,tac) FAD(rac,esc+indx) FML(rac,tac) FAD(rac,esd+indx) ] and Floor(ac) = valof [ //Standard floor function let a=FTR(ac) if FSN(ac) ls 0 then [ let s1=vec 3 let s2=vec 3 FSTV(ac,s1) //Save some ac's FSTV(31,s2) a=-a+4 //Get number to make positive FLDI(31,a) FAD(ac,31) //Make it positive a=FTR(ac)-a //Take floor and subtract offset FLDV(31,s2) FLDV(ac,s1) ] resultis a ]