// S C V M A I N -- SCAN CONVERTER (PREPRESS) // catalog number ??? //Scan Converter for PREPRESS and PRESS // Throughout, the terminology "s" is for "scan-line direction" and // "r" is for "run direction". The distinction is simply // one of how the sorting is done -- first on s, then on r. // For an Alto screen, s=vertical(y), r=horizontal(x); for Slot, // s=horizontal(x), r=vertical(y) // INITIALIZATION, etc: //SCVInit(getblock,putblock,error) // Begins operation. The three arguments are the addresses of // three subroutines needed: for getting and releasing free-storage // blocks, and for error conditions. // This routine may be called any number of times. //SCVMatrix(a,b,c,d) // Sets (scale) transformation matrix from floating // point numbers. An argument of 0 is taken as short for 0. // Transformation is: // s' = a*s + c*r // r' = b*s + d*r //SCVTransFormF(s,r [,v]) // Carefully transform the points s and r by the matrix, // and return in v (optional): // v!0=s v!1=r // also leaves results in FPac's 8,9. // BUILDING OBJECT DESCRIPTIONS: //SCVBeginObject([care, monotonic, segproc, makebothmonotone]) // Called to initialize for a new object. "care" is true // if you wish careful scan-conversion to be done; default false. // "monotonic" is true if you know that all splines will be monotonic // in the s direction; default false. "segproc," if not 0, is called // each time a boundary segment is ready (see code); default 0. // "makebothmonotone," if true, will cause segments to be monotonic // in r and s directions; default false. //SCVMoveTo(s,r) and SCVMoveToF(s,r) // Like PICO MOVETO, fixed and floating point versions //SCVDrawTo(s,r) and SCVDrawToF(s,r) // Like PICO DRAWTO, fixed and floating point versions //SCVDrawCurve(s',r',s''/2,r''/2,s'''/6,r'''/6) // Like PICO DRAWCURVE, except arguments are coefficients of // the polynomial, rather than derivatives. //SCVEndObject(v) // Finishes out an object, and returns in v (structure SCV): // v>>SCV.Smin, v>>SCV.Smax Extent of object in s. // v>>SCV.Rmin, v>>SCV.Rmax Extent of object in r. // v>>SCV.Object Object descriptor for the object (not to tamper!) // v>>SCV.Error Non-zero if error // 1= no more core // 2,3= infinite loops in spline evaluations // NB: the r values are only filled in accurately for // splines if "care" is true in SCVBeginObject!!! // SCAN CONVERSION: //SCVReadRuns(v,buffer,bufsize) // Calculate a bunch of intersections: // v>>SCV.Sbegin and v>>SCV.Send are the limits (inclusive) of the // region you are requesting scan-conversion of. You // must proceed from min s to max s (as returned by // SCVEndObject in v>>SCV.Smin and v>>SCV.Smax). // "buffer" is the address of a buffer of "bufsize" words to // use to store intersections. // Returns in v: // v>>SCV.Send Maximum S value converted to // intersections (will be less than you // requested if there was insufficient buffer) // v>>SCV.IntPtr Pointer to first intersection. // v>>SCV.IntCnt Number of intersections returned (even no.). // v>>SCV.Object Updated object descriptor (not to tamper!) //SCVFlush(v) // If you get an object back, and do not wish to actually // go through with the scan conversion, you can return all // storage gracefully with SCVFlush(v). //Comment about buffer layout internally. // 2 words - infinity // 2n words intersections // 2 words + infinity get "scv.dfs" // outgoing procedures external [ SCVInit SCVMatrix SCVTransformF SCVBeginObject SCVMoveTo SCVMoveToF SCVDrawTo SCVDrawToF SCVDrawCurve SCVEndObject SCVReadRuns SCVFlush Floor ] // outgoing statics //external // [ // ] //static // [ // ] // incoming procedures external [ Zero; SetBlock; MoveBlock QuickSort FLD; FST; FTR; FLDI; FNEG; FAD; FSB; FML; FDV; FCM; FSN; FLDV; FSTV; FLDDP; FSTDP; DPAD; DPSB; DPSHR ] // incoming statics //external // [ // ] // internal statics static [ SCVGetB //Routine to get free storage SCVPutB //Routine to return free storage careful //True if careful scan conversion monotone //True if splines monotonic in s makermonotone //True if splines to be made monotone in r segproc //Non-zero if segment procedure exists --this is it nomoco //True if no more core available simplescale //True if off-diagnoal matrix elements zero 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 ] // Procedures let SCVInit(getb,putb) be [ SCVGetB=getb SCVPutB=putb ] and SCVMatrix(a,b,c,d) be [ simplescale=false for i=0 to 3 do test (lv a)!i eq 0 then FLDI(sssac+i,0) or FLD(sssac+i,(lv a)!i) if FSN(srsac) eq 0 & FSN(ssrac) eq 0 then simplescale=true ] and SCVTransformF(s,r,v; numargs nargs) be [ FLD(t1,s); FLD(t2,r) scaleit(t1,t2) //Do transformation. if nargs eq 2 then return FLDI(t3,1); FLDI(t4,2); FDV(t3,t4); FLD(t4,t3) FAD(t3,t1); FAD(t4,t2); v!0=FTR(t3) v!1=FTR(t4) ] and scaleit(s,r) be [ test simplescale ifso [ FML(s,sssac) FML(r,srrac) ] ifnot [ FLD(t3,s); FML(t3,sssac) FLD(t4,r); FML(t4,srsac) FAD(t3,t4) //T1=new s FLD(t4,s) FLD(s,t3) FML(t4,ssrac) FML(r,srrac) FAD(r,t4) ] ] and SCVBeginObject(care,mono,seg,makemono; numargs nargs) be [ switchon nargs into [ //Fill in defaults case 0: care=false case 1: mono=false case 2: seg=0 case 3: makemono=false endcase ] careful=care //Save in statics monotone=mono segproc=seg makermonotone=makemono todolist=0 firstpiece=true //Flag for MoveTo firstpiecep=SCVGetB(4*(orac-esd+1)) nomoco=(firstpiecep eq 0) //True if no more fs rdirmin=plusinfinity; sdirmin=plusinfinity rdirmax=minusinfinity; sdirmax=minusinfinity ] and SCVMoveTo(sdir,rdir) be [ unless firstpiece then flushit() FLDI(osac,sdir) FLDI(orac,rdir) SCVMoveToF() //..continue here.. ] and SCVMoveToF(sac,rac; numargs n) be [ //Flush any previous closed curve and load the "old" point if n then [ unless firstpiece then flushit() FLD(osac,sac) FLD(orac,rac) ] scaleit(osac,orac) //Do Matrix multiply FLD(fsac,osac) //Save memory of first position. FLD(frac,orac) ] and SCVDrawTo(sdir,rdir) be [ FLDI(csac,sdir) FLDI(crac,rdir) SCVDrawToF() //..continue here.. ] and SCVDrawToF(sac,rac; numargs n) be [ if n then [ FLD(csac,sac) FLD(crac,rac) ] scaleit(csac,crac) //Do Matrix multiply //Now draw line from "old" point to "current" point. putsegment(1) //Enter a description. FLD(osac,csac) //Old←New FLD(orac,crac) ] // Spline stuff. and SCVDrawCurve(s,nil,nil,nil,nil,nil) be [ compileif SplineHandling ne NoSplines then [ FLD(esd,osac) FLD(erd,orac) //Get 0Th derivative for i=0 to 5 do FLD(esc+i,(lv s)!i) for i=esc to esa by 2 do scaleit(i,i+1) //Transform. //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. if careful then findextrema(0,1) let ptr=vec 13; Zero(ptr, 13); ptr!0=2; ptr!3=#40300 if not monotone then [ if makermonotone then findextrema(ptr,1) findextrema(ptr,0) ] //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) ] ] //Conditional assembly ] and SCVEndObject(v) be [ flushit() SCVPutB(firstpiecep) v>>SCV.Smin=sdirmin v>>SCV.Smax=sdirmax v>>SCV.Rmin=rdirmin v>>SCV.Rmax=rdirmax v>>SCV.Object=todolist v>>SCV.Error=(nomoco ne 0? 1,0) ] and SCVFlush(v) be [ let s=v>>SCV.Object while s do [ let ns=s>>HD.next SCVPutB(s) s=ns ] v>>SCV.Object=0 ] and flushit() 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 segproc then [ //Lineflag=0,1 only!!!! segproc(lineflag) return ] 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 let nxsiz=nil compileif SplineHandling eq AdditiveSplines then [ nxsiz=size SPLINE/16 ] compileif SplineHandling eq RecursiveSplines then [ nxsiz=size RSPLINE/16 ] let nx=SCVGetB((lineflag? size LINE/16,nxsiz)) 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 SCVPutB(p) p=np ] return ] //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 compileif SplineHandling eq AdditiveSplines then [ nx>>SPLINE.type=SPLINEtype test thisdirection ls 0 then [ FLD(t1,tminac) FLD(t2,tmaxac); FSB(t2,tminac) ] or [ FLD(t1,tmaxac) FLD(t2,tminac); FSB(t2,tmaxac) ] FLDI(t3,((stop-sbot) rshift 1)+2) //Nevals FDV(t2,t3) //Delta T FST(t1,lv nx>>SPLINE.t0) FST(t2,lv nx>>SPLINE.dt) //Save in block for i=0 to era-esd do FST(i+esd,(lv nx>>SPLINE.coeffs)+i*2) ] //Conditional assy compileif SplineHandling eq RecursiveSplines then [ 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) ] //Conditional assy ] //SPLINE //Record some common information in the block. nx>>HD.smin=sbot nx>>HD.smax=stop nx>>HD.next=todolist; todolist=nx ] and //Here is the main routine for calculating intersections, and stuffing // them in the buffer. Calls QuickSort to sort intersections. SCVReadRuns(v,buffer,bufsize) be [ let ibufsize=(bufsize rshift 1)-2 //Max no. of intersections //(leave room for 2 guards) let LScan=v>>SCV.Sbegin let RScan=v>>SCV.Send let p,c,l,r=nil,nil,nil,nil [ c=0 p=v>>SCV.Object while p ne 0 do [ //See if enough room if p>>HD.smin le RScan then [ //We need to look at it l=p>>HD.smin if l ls LScan then l=LScan r=p>>HD.smax if r gr RScan then r=RScan c=c+r-l+1 //Number of intersections ] p=p>>HD.next ] test c gr ibufsize ifso RScan=(LScan+RScan)/2 ifnot break ] repeat //Now it is safe to scan from LScan to RScan inclusive -- // buffer will not overflow. let b=buffer+2 //Pointer to intersections. let pp=(lv v>>SCV.Object)-(lv 0>>HD.next) p=pp>>HD.next while p ne 0 do [ //Loop scan converting. if p>>HD.smin le RScan then [ l=p>>HD.smin; if l ls LScan then l=LScan r=p>>HD.smax; if r gr RScan then r=RScan switchon p>>HD.type into [ case LINEtype: for s=l to r do [ b!0=s; b!1=(lv p>>LINE.x)!0 b=b+2 DPAD(lv p>>LINE.x,lv p>>LINE.dx) ] endcase case SPLINEtype: compileif SplineHandling eq AdditiveSplines then [ for i=0 to era-esd do FLD(i+esd,(lv p>>SPLINE.coeffs)+i*2) FLD(t1,lv p>>SPLINE.t0) FLD(tt1,lv p>>SPLINE.dt) FAD(FLD(t2,t1),tt1) feval(0,t1,t3) feval(0,t2,t4) //Idea is to always have two points (say 0 and 1) //that span the S value required. Then we use secant approximation //to calculate an intersection. The initialization code tries //to get: // AC t1 = T0 **stored in block // AC t2 = T1 // AC t3 = Fs(T0) // AC t4 = Fs(T1) // AC tt1 = dt **stored in block for s=l to r do [ //Main loop FLDI(tt2,s) //S sought //If s<Fs(T0) use T0 test FCM(tt2,t3) ls 0 then FLD(tt2,t1) or [ let cnt=-100 while FCM(tt2,t4) eq 1 do [ //s>Fs(T1) FLD(t1,t2) //T0←T1 FLD(t3,t4) FAD(t2,tt1) //T1←T1+delta T feval(0,t2,t4) // new value cnt=cnt+1 if cnt eq 0 then [ v>>SCV.Error=2 //Infinite loop return ] ] FML(FSB(tt2,t3),tt1) //Secant FSB(FLD(tt3,t4),t3) FAD(FDV(tt2,tt3),t1) ] feval(1,tt2,tt3) //tt3 = Fr(T) let lx=Floor(tt3) b!0=s; b!1=lx //All the work for 2 values! b=b+2 ] FST(t1,lv p>>SPLINE.t0) //Save for more?? ] //Conditional assy compileif SplineHandling eq RecursiveSplines then [ let onehalf=table [ 0;#100000 ] //DP 1/2 let tolerance=table [ 0;#100000 ] //DP 1/2 //Layout of "stack": each entry is 16 words, divided into // 4 DP numbers for S direction, followed by // 4 DP numbers for R direction (see structure RSPLINE) //Each block of four is: // F(tright) // G(tright,n) // F(tleft) // G(tleft,n) // (see Sproull notes for meaning of F,G) let sp=vec 200 //Stacks. let se=sp-16 //End if you get here MoveBlock(sp,lv p>>RSPLINE.str,16) let s=l //Scan-line number if sp!4 eq s then //Begins exactly at s. [ b!0=l; b!1=sp!12 //Intersection. b=b+2; s=s+1 ] [ if sp eq se then break //Stack empty test sp!0 ls s then //Right edge < sl [ sp=sp-16; //Pop stack, move right ] or test sp!0 eq s &(valof [ let v=vec 2 v!0=sp!0; v!1=sp!1 //Larger S. DPSB(v,sp+4) //minus smaller S. let a=DPSB(v,tolerance) if a ls 0 then resultis true //Small enough resultis false //Search to finer detail ]) then [ //Output a point. let ra=DPAD(sp+8,sp+12) //Average two R's b!0=s; b!1=(ra+1)/2 //R value (rounded) b=b+2 if s eq r then break //done s=s+1 //Bump scan-line count sp=sp-16 //Pop stack. ] or [ //Subdivide.... let x=sp //Part of stack to subdivide for i=0 to 1 do //Two blocks on stack. [ //Subdivide stack "x": // x!0,1 F(tright) // x!2,3 G(tright,n) // x!4,5 F(tleft) // x!6,7 G(tleft,n) let x2=x+2; let x6=x+6; let x4=x+4 DPSHR(x2); DPSHR(x2) //Gright DPSHR(x6); DPSHR(x6) //Gleft x!22=x!6;x!23=x!7 //Gleft in place DPAD(x6,x2) //Gleft+Gright DPSHR(x6) //Gmiddle x!18=x!6;x!19=x!7 // and again x!20=x!4;x!21=x!5 //Xleft in place DPAD(x4,x) //Xleft+Xright DPSHR(x4) // *.5 DPSB(x4,x6) //.5(Xleft+Xright)-Gmiddle x!16=x!4;x!17=x!5 //Xmiddle again x=x+8 //Do the other block next time. ] sp=sp+16 //Bump stacks. ] //Subdivide ] repeat //Recursive loop if s ne r then [ v>>SCV.Error=3 return ] ] //Conditional assy endcase ] //switchon if p>>HD.smax le RScan then [ //Exhausts pp>>HD.next=p>>HD.next SCVPutB(p) p=pp ] ] pp=p p=p>>HD.next //Look at next ] //while p ne 0 QuickSort(buffer,c) //Sort the intersections v>>SCV.Send=RScan //Speak to user v>>SCV.IntCnt=c v>>SCV.IntPtr=buffer+2 ] and feval(indx,tac,rac) be [ compileif SplineHandling ne NoSplines then [ //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) ] //Conditional assy ] 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 ]