// March 31, 1978 10:42 AM *** overlay A *** get "zpDefs.bcpl" // outgoing procedures: external [ createSpline createCyclicSpline redrawSpline dashSpline addNewKnot backUp startAgain clearSelection deleteSelection addSplineSelection addTextSelection selectAll prepareTransform clearTransform copyItem transformItem ] // incoming procedures: external [ MoveBlock // SYSTEM FLDI; FST; FLD; FML // FLOAT FAD; FDV; FSB; FNEG FTR; FSN giveUp // ZPUTIL typeForm makeSpline // ZPMAKE computeSpline splineType newSplineID obtainBlock // ZPBLOCK putBlock curve // ZPDRAW drawSpline markSpline checkSplineID XORdot giveMeXY showText // ZPTEXT eraseText markText checkTextID newTextID DTTitems // ZPITEM (same overlay) addItemTable countItemTable checkItemID showItem eraseItem markItem flushItem ] // incoming statics: external [ @splineTable // ZPINIT @textTable @selectionTable @maxSplineID @maxTextID @maxKnots @newSplineXYtable @transformXYtable @bitmap00 @scanlineWidth @Xmax @Ymax @brush @color brushFont // ZPFONT @currentTextId // ZPEDIT ] //**************************************************************** // Spline operations: create / redraw / dash //**************************************************************** let createSpline() = valof [createSpline let n=clearXYtable(newSplineXYtable) unless n resultis 0 let xTable=obtainBlock(4*n) unless xTable resultis giveUp("[createSpline]") let yTable=xTable+2*n makeKnotTable(xTable, yTable, n) let id=makeSpline(n, xTable, yTable, brush, color) putBlock(xTable) resultis id ]createSpline and createCyclicSpline() = valof [createCyclicSpline if newSplineXYtable>>XYTABLE.n le 2 resultis createSpline() // one more knot (to close the curve) let n=clearXYtable(newSplineXYtable)+1 let xTable=obtainBlock(4*n) unless xTable resultis giveUp("[createCyclicSpline]") let yTable=xTable+2*n makeKnotTable(xTable, yTable, n-1) //close the curve (knot n = knot 1) FST(FLD(0, xTable), xTable+2*(n-1)) FST(FLD(0, yTable), yTable+2*(n-1)) let id=makeSpline(n, xTable, yTable, brush, color, periodicSpline) putBlock(xTable) resultis id ]createCyclicSpline and addNewKnot(x, y) be [addNewKnot test newSplineXYtable>>XYTABLE.n+1 le maxKnots ifso putXYtable(newSplineXYtable, x, y) ifnot typeForm(0, "Sorry, no more than ", 10, maxKnots, 0, " knots!*N", 0, "To allow more knots, start DRAW with switch /K (e.g.: DRAW ", 10, 2*maxKnots, 0, "/K )*N") ]addNewKnot and redrawSpline(id) be [redrawSpline let splinePointer=checkSplineID(id) unless splinePointer return if splinePointer>>SPLINE.drawBrush eq brush<>SPLINE.drawBrush=brush<>SPLINE.dashed=splinePointer>>SPLINE.dashed ? 0, 1 curve(splinePointer, drawMode) ]dashSpline //**************************************************************** // Transform operation //**************************************************************** and prepareTransform(x, y) be [prepareTransform let n=putXYtable(transformXYtable, x, y) let npoints=transformXYtable>>XYTABLE.npoints if n eq npoints then [ clearTransform() let ns=countItemTable(selectionTable) let q0=lv(transformXYtable>>XYTABLE.xy0) let doTransform=transformXYtable>>XYTABLE.transf test checkTransform(q0, npoints) ifso test transformXYtable>>XYTABLE.copy // copy ifso for s=1 to ns do [ let oldItemID=selectionTable!s let newItemID=copyItem(oldItemID, doTransform) unless newItemID loop markItem(oldItemID, 0) selectionTable!s=newItemID transformItem(newItemID, q0, npoints) unless doTransform then showItem(newItemID) ] // move ifnot DTTitems(selectionTable, q0, npoints) ifnot typeForm(0, "*NIllegal transform parameters*N") ] ]prepareTransform and checkTransform(q0, npoints) = selecton npoints into [ case 2: (q0>>XY.x ne (q0+2)>>XY.x) % (q0>>XY.y ne (q0+2)>>XY.y); case 4: set4pointTransform(q0); case 6: set6pointTransform(q0) ] and clearTransform() be [clearTransform clearXYtable(transformXYtable) ]clearTransform //**************************************************************** // Item operations: move - copy / translate - transform //**************************************************************** and copyItem(itemID, noChain) = valof [copyItem // noChain is a boolean let newID, newItemID, pointerTable, blockSize=nil, nil, nil, nil let itemPointer=checkItemID(itemID) unless itemPointer resultis 0 test itemID<>STRING.length)/2 + 1 ] ifnot [ newID=newSplineID() unless newID resultis 0 newItemID=newID pointerTable=splineTable blockSize=SPLINEknotBase + 4*(itemPointer>>SPLINE.nKnots) ] let newItemPointer=obtainBlock(blockSize) unless newItemPointer resultis giveUp("[CopyItem-1]") MoveBlock(newItemPointer, itemPointer, blockSize) unless itemID<>SPLINE.chain if chainPointer then [ let chainSize=(itemPointer>>SPLINE.nBeads)*(BEADsize+2) let chainBlockSize=chainSize + chainPointer!(chainSize-1) newChainPointer=obtainBlock(chainBlockSize) unless newChainPointer resultis giveUp("[copyItem-2]", newItemPointer) MoveBlock(newChainPointer, chainPointer, chainBlockSize) ] ] newItemPointer>>SPLINE.chain=newChainPointer ] pointerTable!newID=newItemPointer pointerTable!0=pointerTable!0 + 1 resultis newItemID ]copyItem and transformItem(itemID, q0, npoints) = valof [transformItem // 2-point (translate), 4-point or 6-point transform // q0 is the base of a 2, 4 or 6 point vector (length 2*npoints) let itemPointer=checkItemID(itemID) unless itemPointer resultis 0 if npoints eq 2 then [ // 2-point transform = translation let p0=q0+2 let deltax=p0>>XY.x-q0>>XY.x let deltay=p0>>XY.y-q0>>XY.y test itemID<>TEXT.left=itemPointer>>TEXT.left + deltax itemPointer>>TEXT.top=itemPointer>>TEXT.top + deltay ] ifnot [ // translate knots let xTable=itemPointer+SPLINEknotBase let n=itemPointer>>SPLINE.nKnots translateKnotTable(xTable, xTable+2*n, n, deltax, deltay) // translate special points let knotPointer=itemPointer+SPLINEheaderSize for k=1 to SPLINExyPairs do [ knotPointer>>XY.x=knotPointer>>XY.x + deltax knotPointer>>XY.y=knotPointer>>XY.y + deltay knotPointer=knotPointer+2 ] ] resultis true ] // 4-point & 6-point transform unless (selecton npoints into [ case 4: set4pointTransform(q0); case 6: set6pointTransform(q0) ]) resultis 0 let p0=q0+npoints test itemID<>TEXT.left, lv itemPointer>>TEXT.top, q0, p0) showItem(itemID) ] ifnot [ // transform spline let n=itemPointer>>SPLINE.nKnots let chainPointer=itemPointer>>SPLINE.chain if chainPointer then [ putBlock(chainPointer) itemPointer>>SPLINE.chain=0 ] let xTable=itemPointer+SPLINEknotBase transformKnotTable(xTable, xTable+2*n, n, q0, p0) splineType(itemPointer) transform1point(lv itemPointer>>SPLINE.xSelect, lv itemPointer>>SPLINE.ySelect, q0, p0) transform1point(lv itemPointer>>SPLINE.xColor, lv itemPointer>>SPLINE.yColor, q0, p0) computeSpline(itemPointer) ] resultis true ]transformItem //**************************************************************** // Knot table operations //**************************************************************** and makeKnotTable(xTable, yTable, n) be [makeKnotTable let knotPointer=lv(newSplineXYtable>>XYTABLE.xy0) for k=0 to n-1 do [ FST(FLDI(0, knotPointer>>XY.x), xTable+2*k) FST(FLDI(0, knotPointer>>XY.y), yTable+2*k) knotPointer=knotPointer+2 ] ]makeKnotTable and translateKnotTable(xTable, yTable, n, deltax, deltay) be [translateKnotTable // xTable & yTable: floating point // deltax & deltay: integer // CAUTION: uses register 0 for k=0 to n-1 do [ FST(FAD(FLDI(0, deltax), xTable+2*k), xTable+2*k) FST(FAD(FLDI(0, deltay), yTable+2*k), yTable+2*k) ] ]translateKnotTable and sumProduct(r, a, b, c, d) be [sumProduct // r, a, b, c & d are floating point registers // compute r = a*b + c*d // CAUTION: uses register 0 manifest t=0 FAD(FML(FLD(r, a), b), FML(FLD(t, c), d)) ]sumProduct and diffProduct(r, a, b, c, d) be [diffProduct // r, a, b, c & d are floating point registers // compute r = a*b - c*d // CAUTION: uses register 0 manifest t=0 FSB(FML(FLD(r, a), b), FML(FLD(t, c), d)) ]diffProduct and transformKnotTable(xTable, yTable, n, q0, p0) be [transformKnotTable // xTable & yTable: floating point // performs matrix computation // CAUTION: // coefficients are expected in registers a, b, c, d & delta // uses registers 0 through 6 manifest [ // coefficients for transformation a=20; b=21; c=22; d=23; delta=24 // registers for computation t=0 fpx0=1; fpy0=2; x=3; y=4; nx=5; ny=6 ] let x0=p0>>XY.x; FLDI(fpx0, x0) let y0=p0>>XY.y; FLDI(fpy0, y0) translateKnotTable(xTable, yTable, n, x0-q0>>XY.x, y0-q0>>XY.y) for k=0 to n-1 do [ FSB(FLD(x, xTable+2*k), fpx0) FSB(FLD(y, yTable+2*k), fpy0) // X _ (a x + b y)/delta sumProduct(nx, a, x, b, y) FST(FAD(FDV(nx, delta), fpx0), xTable+2*k) // Y _ (c x + d y)/delta sumProduct(ny, c, x, d, y) FST(FAD(FDV(ny, delta), fpy0), yTable+2*k) ] ]transformKnotTable and transform1point(lvX, lvY, q0, p0) be [transform1point let x=vec 2 let y=vec 2 FST(FLDI(0, @lvX), x) FST(FLDI(0, @lvY), y) transformKnotTable(x, y, 1, q0, p0) @lvX=FTR(FLD(0, x)) @lvY=FTR(FLD(0, y)) ]transform1point and set4pointTransform(q0) = valof [set4pointTransform let q1, p0, p1=q0+2, q0+4, q0+6 // 4-point transformation mapping q0 & q1 onto p0 & p1 // general translation/rotation/scaling transformation manifest [ // coefficients of transformation // CAUTION: these registers should be the same as those // used by transformKnotTable a=20; b=21; c=22; d=23; delta=24 // for computing of coefficients x1=1; y1=2; x2=3; y2=4 ] FLDI(x1, q1>>XY.x-q0>>XY.x); FLDI(y1, q1>>XY.y-q0>>XY.y) FLDI(x2, p1>>XY.x-p0>>XY.x); FLDI(y2, p1>>XY.y-p0>>XY.y) // delta= x1*x1 + y1*y1 sumProduct(delta, x1, x1, y1, y1) // points q0 & q1 should be DISTINCT unless FSN(delta) resultis 0 // a= x1*x2 + y1*y2 sumProduct(a, x1, x2, y1, y2) // d=a FLD(d, a) // c= x1*y2 - y1*x2 diffProduct(c, x1, y2, y1, x2) // b=-c FNEG(FLD(b, c)) resultis true ]set4pointTransform and set6pointTransform(q0) = valof [set6pointTransform let q1, q2, p0, p1, p2=q0+2, q0+4, q0+6, q0+8, q0+10 // general 6 point transformation mapping q0, q1, q2 onto p0, p1, p2 // general linear transformation manifest [ // coefficients of transformation // CAUTION: these registers should be the same as those // used by transformKnotTable a=20; b=21; c=22; d=23; delta=24 // points q1, q2, p1, p2 for computing coefficients xp1=10; xp2=11; xq1=12; xq2=13 yp1=14; yp2=15; yq1=16; yq2=17 ] let x0=p0>>XY.x let y0=p0>>XY.y let z0=q0>>XY.x let w0=q0>>XY.y // compute coefficients FLDI(xp1, p1>>XY.x-x0); FLDI(yp1, p1>>XY.y-y0) FLDI(xp2, p2>>XY.x-x0); FLDI(yp2, p2>>XY.y-y0) FLDI(xq1, q1>>XY.x-z0); FLDI(yq1, q1>>XY.y-w0) FLDI(xq2, q2>>XY.x-z0); FLDI(yq2, q2>>XY.y-w0) // delta=xq1*yq2-xq2*yq1 diffProduct(delta, xq1, yq2, xq2, yq1) // points q0, q1 & q2 SHOULD NOT BE COLINEAR unless FSN(delta) resultis 0 // a=xp1*yq2-xp2*yq1 diffProduct(a, xp1, yq2, xp2, yq1) // b=xq1*xp2-xq2*xp1 diffProduct(b, xq1, xp2, xq2, xp1) // c=yp1*yq2-yp2*yq1 diffProduct(c, yp1, yq2, yp2, yq1) // d=xq1*yp2-xq2*yp1 diffProduct(d, xq1, yp2, xq2, yp1) resultis true ]set6pointTransform //**************************************************************** // selection operations //**************************************************************** and selectAll() be [selectAll for id=1 to maxSplineID do addSplineSelection(id) for id=1 to maxTextID do addTextSelection(id) ]selectAll and clearSelection() be [clearSelection let ns=countItemTable(selectionTable) for i=1 to ns do markItem(selectionTable!i, 0) selectionTable!0=0 ]clearSelection and deleteSelection() be [deleteSelection DTTitems(selectionTable) selectionTable!0=0 ]deleteSelection and addSplineSelection(id, h; numargs n) be [addSplineSelection let x=h>>HITPOINT.x // might be garbage! let y=h>>HITPOINT.y let splinePointer=checkSplineID(id) unless splinePointer return if addItemTable(selectionTable, id) then [ if n ne 2 then giveMeXY(splinePointer, lv x, lv y) splinePointer>>SPLINE.xSelect=x splinePointer>>SPLINE.ySelect=y markSpline(id, 1) ] ]addSplineSelection and addTextSelection(id) be [addTextSelection unless checkTextID(id) return if addItemTable(selectionTable, textFlag+id) then markText(id, 1) ]addTextSelection //**************************************************************** // operations on XY tables //**************************************************************** and putXYtable(xyTable, x, y) = valof [putXYtable let n=xyTable>>XYTABLE.n let xyPointer=lv(xyTable>>XYTABLE.xy0)+2*n xyPointer>>XY.x=x xyPointer>>XY.y=y knotSymbol(x, y) xyTable>>XYTABLE.n=n+1 resultis n+1 ]putXYtable and removeXYtable(xyTable) be [removeXYtable let n=xyTable>>XYTABLE.n-1 unless n ge 0 return let xyPointer=lv(xyTable>>XYTABLE.xy0)+2*n knotSymbol(xyPointer>>XY.x, xyPointer>>XY.y) xyTable>>XYTABLE.n=n ]removeXYtable and clearXYtable(xyTable) = valof [clearXYtable let n=xyTable>>XYTABLE.n unless n gr 0 resultis 0 let xyPointer=lv(xyTable>>XYTABLE.xy0) for k=1 to n do [ knotSymbol(xyPointer>>XY.x, xyPointer>>XY.y) xyPointer=xyPointer+2 ] xyTable>>XYTABLE.n=0 resultis n ]clearXYtable and knotSymbol(x0, y0) be [knotSymbol for x=x0-4 to x0+4 do XORdot(x, y0) for y=y0-4 to y0+4 do XORdot(x0, y) ]knotSymbol //**************************************************************** // startAgain/back up (XY tables) //**************************************************************** and startAgain() be [startAgain test currentTextId ifso [ eraseText(currentTextId) flushItem(currentTextId + textFlag) ] ifnot [ clearXYtable(newSplineXYtable) clearTransform() ] ]startAgain and backUp() be [backUp test currentTextId ifso [ eraseText(currentTextId) flushItem(currentTextId + textFlag) ] ifnot [ removeXYtable(newSplineXYtable) removeXYtable(transformXYtable) ] ]backUp