// May 1, 1978 2:37 PM *** OVERLAY D ***
get "zpDefs.bcpl"
get "zpComDf.bcpl"
// outgoing procedures
external [
drawFreeHand
getEventFreeHand
freeHandCursor
]
// outgoing statics
external [
@sampleBuffer
@maxSampleCount
]
static [
@sampleBuffer
@maxSampleCount
]
// incoming procedures:
external [
MoveBlock // SYSTEM
Zero
Gets
Endofs
FLDI; FST // FLOAT
FTR; FAD; FML; FDV
giveUp // ZPUTIL
typeForm
grid // ZPEDIT
curveHitDetect // ZPINTER
makeSpline // ZPMAKE
erase // ZPDRAW
draw
initBitBlt
XORdot
obtainBlock // ZPBLOCK
putBlock
paintDot // ZPCONVERT
]
// incoming statics:
external [
@Xmax // ZPINIT
@Ymax
@Xref0
@Yref0
@textWidth
@textHeight
@scanlineWidth
@bitmap00
@brush
@color
@maxKnots
@newSplineXYtable
brushFont // ZPCONVERT
@Xref // ZPINTER
@Yref
keys // SYSTEM
]
// local statics:
static [
@sampleBufferLength
// various parameters for line & spline fitting:
@areaMax=200
@areaMin=40
@showFit=false
@averagingSpan=8
@checkLineCount=4
@checkLineRatio=4
@curvatureSpan=32
@computeCurvature=0
@curvatureScale=256
]
// local definitions:
//*****************************************************************
let getEventFreeHand(h) = valof [getEventFreeHand
// h is a HITPOINT vector
// return an EVENT word (i.e.: switch code | event code)
structure SWITCH [
blank bit 13
sw1 bit 1
sw3 bit 1
sw2 bit 1
]
manifest [
mouseX= #424
mouseY= #425
mouseSW= #177030
]
let XrefOffset, YrefOffset=0,0
let brushPt=brushFont + brush
initBitBlt(brushPt + brushPt!0, drawMode)
[ // keyboard ? => result= 0 | char code
unless Endofs(keys) resultis Gets(keys)
// mouse switches ?
let x1,y1,x2,y2=nil,nil,nil,nil
//wait till some switch is on
let s1=(@mouseSW & 7) xor 7
unless s1 loop
x1=@mouseX-Xref
y1=Yref-@mouseY
// then check first point:
// outside display area ?
if (x1 gr Xmax) % (y1 gr Ymax) % (x1 ls 0) % (y1 ls 0) then [
while ((@mouseSW & 7) xor 7) ne 0 do [ let t=nil ]
// outside menu area ? => try again
if (x1 gr Xmax) % (y1 gr Ymax) loop
// menu & text buffer area ? => result= 0 | menu code
if (y1 ls 0) then
test (x1 ge 0) & (x1 le textWidth) & ((y1+16+textHeight) ge 0)
// text buffer area
ifso resultis (menuCode + (2*symbolCount + 1))
ifnot loop
if (x1 ls 0) then [
// menu code is a menu number + menuCode
// ( 0 < menu number < 2*symbolCount+1 )
let r=(Ymax-y1)/symbolHeight+1
unless r ge 1 & r le symbolCount loop
resultis (selecton ((-x1)/symbolHeight) into [
case 0: r; case 1: r+symbolCount; default: 0 ]) + menuCode
]
]
// display area ? => save & draw the sample points, result= 1 | 0
if (s1<<SWITCH.sw3) then [
let gx=grid(x1)
let gy=grid(y1)
XrefOffset=gx-x1
YrefOffset=gy-y1
x1=gx
y1=gy
Xref=Xref-XrefOffset
Yref=Yref+YrefOffset
]
sampleBuffer!0=x1
sampleBuffer!1=y1
draw(x1, y1)
sampleBufferLength=2
x2=x1
y2=y1
//wait till all switches are off
[ let s2=(@mouseSW & 7) xor 7
unless s2 break
let x=@mouseX-Xref
let y=Yref-@mouseY
let dx= (x gr x2) ? x-x2, x2-x
let dy= (y gr y2) ? y-y2, y2-y
if ((dx gr 1) % (dy gr 1)) & (sampleBufferLength ls maxSampleCount) then [
sampleBuffer!sampleBufferLength=x
sampleBuffer!(sampleBufferLength+1)=y
sampleBufferLength=sampleBufferLength+2
draw(x,y)
x2=x; y2=y
]
] repeat
if (s1<<SWITCH.sw3) then [
let x=sampleBuffer!(sampleBufferLength-2)
let y=sampleBuffer!(sampleBufferLength-1)
x=grid(x)
y=grid(y)
sampleBuffer!(sampleBufferLength-2)=x
sampleBuffer!(sampleBufferLength-1)=y
draw(x,y)
]
Xref=Xref+XrefOffset
Yref=Yref-YrefOffset
resultis (1 lshift 8)
] repeat
]getEventFreeHand
and drawFreeHand() = valof [drawFreeHand
let sampleCount=sampleBufferLength/2
// select knots; erase sample points
let brushPt=brushFont + brush
initBitBlt(brushPt + brushPt!0, eraseMode)
let knotTable=lv(newSplineXYtable>>XYTABLE.xy0)
let area, a1, a2, posA1A2= 0,0,areaMax,areaMax
// smoothing by "cumulative" running average
let avrgSpan=2*averagingSpan
if averagingSpan ne 0 then [
unless showFit for i=0 to avrgSpan-2 by 2 do
erase(sampleBuffer!i, sampleBuffer!(i+1))
for i=avrgSpan to sampleBufferLength-avrgSpan-2 by 2 do [
unless showFit then erase(sampleBuffer!i, sampleBuffer!(i+1))
sampleBuffer!i=
(sampleBuffer!(i-avrgSpan)+sampleBuffer!(i+avrgSpan))/2
sampleBuffer!(i+1)=
(sampleBuffer!(i+1-avrgSpan)+sampleBuffer!(i+1+avrgSpan))/2
]
unless showFit then
for i=sampleBufferLength-avrgSpan to sampleBufferLength-2 by 2 do
erase(sampleBuffer!i, sampleBuffer!(i+1))
]
// experiment with curvature
initBitBlt(brushPt + brushPt!0, drawMode)
let curvSpan=2*curvatureSpan
if computeCurvature ne 0 then [
let cOffset=vec 2
let cScaling=vec 2
FML(FLDI(0, curvatureSpan), FLDI(1, curvatureSpan))
FST(FAD(0, 0), cOffset)
FST(FDV(FLDI(0, curvatureScale/2), cOffset), cScaling)
for i=curvSpan to sampleBufferLength-curvSpan-2 by 2 do [
let x1=sampleBuffer!i - sampleBuffer!(i-curvSpan)
let x2=sampleBuffer!(i+curvSpan) - sampleBuffer!i
let y1=sampleBuffer!(i+1) - sampleBuffer!(i+1-curvSpan)
let y2=sampleBuffer!(i+1+curvSpan) - sampleBuffer!(i+1)
test computeCurvature eq 1
ifso FLDI(0, x1*x2 + y1*y2)
ifnot FLDI(0, x1*y2 - x2*y1)
FML(FAD(0, cOffset), cScaling)
draw((i-curvSpan)/2, FTR(0))
]
]
// first knot
let kx=sampleBuffer!0
let ky=sampleBuffer!1
knotTable!0=kx
knotTable!1=ky
XORknot(kx, ky)
// is it a straight line ???
let notAline=false
let lx=sampleBuffer!(sampleBufferLength-2)
let ly=sampleBuffer!(sampleBufferLength-1)
let halfCount=sampleCount
for i=1 to checkLineCount do [
let midx=(kx+lx)/2
let midy=(ky+ly)/2
halfCount=(halfCount+1)/2
let lineTolerance=distance(kx, ky, lx, ly) rshift checkLineRatio
lx=sampleBuffer!(2*(halfCount-1))
ly=sampleBuffer!(2*(halfCount-1)+1)
if distance(midx, midy, lx, ly) gr lineTolerance
then [ notAline=true; break ]
]
// last knot:
let knotCount=1
let nx=notAline ? sampleBuffer!2, sampleBuffer!(sampleBufferLength-2)
let ny=notAline ? sampleBuffer!3, sampleBuffer!(sampleBufferLength-1)
// if not a line, select knots for spline fit:
let distMax=500
if notAline then for i=4 to sampleBufferLength-2 by 2 do [
let x0=nx
let y0=ny
nx=sampleBuffer!i
ny=sampleBuffer!(i+1)
let a0=(x0-kx)*(ny-ky) - (y0-ky)*(nx-kx)
area=area + a0
let dist=distance(x0, y0, kx, ky)
let posArea= area gr 0 ? area, -area
test (posArea gr areaMax)
% (dist gr distMax)
% ((posArea gr areaMin) & ((a0 gr 0 ? a0, -a0) gr posA1A2))
ifso [
// new knot
area=0; a1=0; a2=areaMax; posA1A2=areaMax
knotTable!(2*knotCount)=x0
knotTable!(2*knotCount+1)=y0
distMax=2*dist
kx=x0; ky=y0
XORknot(kx, ky)
knotCount=knotCount+1
if knotCount eq (maxKnots-1) break
]
ifnot [
a2=a1; a1=a0
posA1A2=a1+a2
posA1A2=posA1A2 gr 0 ? posA1A2, -posA1A2
]
]
// last knot
if sampleCount gr 1 then [
knotTable!(2*knotCount)=nx
knotTable!(2*knotCount+1)=ny
knotCount=knotCount+1
XORknot(nx, ny)
]
// make new spline
let xTable=obtainBlock(4*knotCount)
unless xTable resultis giveUp("[drawFreeHand]")
let yTable=xTable+2*knotCount
for k=0 to knotCount-1 do [
FLDI(0, knotTable!(2*k)); FST(0, xTable+2*k)
FLDI(0, knotTable!(2*k+1)); FST(0, yTable+2*k)
unless showFit then
XORknot(knotTable!(2*k), knotTable!(2*k+1))
]
let id=makeSpline(knotCount, xTable, yTable, brush, color)
sampleBufferLength=0
putBlock(xTable)
resultis id
]drawFreeHand
and freeHandCursor() be [freeHandCursor
let saveScanlineWidth=scanlineWidth
Zero(lvAltoCursor, 16)
scanlineWidth=1
paintDot(lvAltoCursor+8-YdotOffset, 8-XdotOffset, brushFont+brush)
scanlineWidth=saveScanlineWidth
Xref=Xref0 - 8
Yref=Yref0 - 8
]freeHandCursor
and distance(x1, y1, x2, y2) = valof [distance
let dx= x1 gr x2 ? x1-x2, x2-x1
let dy= y1 gr y2 ? y1-y2, y2-y1
resultis ((dx gr dy) ? (dx+dy/2), (dy+dx/2))
]distance
and XORknot(x0, y0) be [XORknot
for x=x0-4 to x0+4 do XORdot(x, y0)
for y=y0-4 to y0+4 do XORdot(x0, y)
]XORknot