DECLARE SUB hidemouse ()
DECLARE SUB showmouse ()
DECLARE SUB getmouse (x!, y!, b!)
DECLARE FUNCTION initmouse% ()
DECLARE SUB draw.curve (x1, y1, x2, y2, x3, y3, n, c)
DECLARE SUB draw.curvex (x1, y1, xm, ym, x3, y3, n, c)
'$INCLUDE: 'qb.bi'
IF NOT initmouse THEN
PRINT "No mouse driver"
END
END IF
SCREEN 12
PRINT "Quadratic Bezier Curve... by moi"
PRINT
PRINT "Click 3 points to draw a smooth curve through those points."
PRINT "Use the right button to delete the last point and the up/down"
PRINT "arrow keys to change the number of interpolations."
PRINT "Press space to clear the screen and enter to toggle drawing the"
PRINT "gray grid lines. ESC to exit."
showmouse
n = 50
c = 15
DIM x(2), y(2), mx, my, mb
i = 0
DIM SHARED drawgrid
drawgrid = 0
DO
getmouse mx, my, mb
IF mb = 1 THEN
x(i) = mx
y(i) = my
hidemouse
CIRCLE (x(i), y(i)), 10, 4
i = i + 1
IF i = 3 THEN
i = 0
draw.curvex x(0), y(0), x(1), y(1), x(2), y(2), n, c
END IF
showmouse
WHILE mb = 1
getmouse mx, my, mb
WEND
ELSEIF mb = 2 THEN
IF i > 0 THEN
i = i - 1
hidemouse
CLS
FOR j = 0 TO i - 1
CIRCLE (x(j), y(j)), 10, 4
NEXT j
showmouse
WHILE mb = 2
getmouse mx, my, mb
WEND
END IF
END IF
k$ = INKEY$
SELECT CASE k$
CASE " "
hidemouse
CLS
i = 0
showmouse
CASE CHR$(0) + "H"
n = n + 1
hidemouse
CLS
LOCATE 1, 1
PRINT "n ="; n;
IF i = 0 THEN
FOR j = 0 TO 2
CIRCLE (x(j), y(j)), 10, 4
NEXT j
draw.curvex x(0), y(0), x(1), y(1), x(2), y(2), n, c
END IF
showmouse
CASE CHR$(0) + "P"
IF n > 0 THEN
n = n - 1
hidemouse
CLS
LOCATE 1, 1
PRINT "n ="; n;
IF i = 0 THEN
FOR j = 0 TO 2
CIRCLE (x(j), y(j)), 10, 4
NEXT j
draw.curvex x(0), y(0), x(1), y(1), x(2), y(2), n, c
END IF
showmouse
END IF
CASE CHR$(13)
drawgrid = NOT drawgrid
hidemouse
IF i = 0 THEN
IF NOT drawgrid THEN CLS
FOR j = 0 TO 2
CIRCLE (x(j), y(j)), 10, 4
NEXT j
draw.curvex x(0), y(0), x(1), y(1), x(2), y(2), n, c
END IF
showmouse
CASE CHR$(27)
EXIT DO
END SELECT
LOOP
SUB draw.curve (x1, y1, x2, y2, x3, y3, n, c)
'dim as single dx1,dy1, dx2,dy2, dx,dy, xa,xb, ya,yb, x,y
ox = x1
oy = y1
FOR t = 1 TO n
x = x1 + t * (x2 - x1) / n + (t / n) * (x2 + t * (x3 - x2) / n - x1 - t * (x2 - x1) / n)
y = y1 + t * (y2 - y1) / n + (t / n) * (y2 + t * (y3 - y2) / n - y1 - t * (y2 - y1) / n)
LINE (ox, oy)-(x, y), c
ox = x
oy = y
NEXT t
END SUB
SUB draw.curvex (x1, y1, xm, ym, x3, y3, n, c)
'dim as single dx1,dy1, dx2,dy2, dx,dy, xa,xb, ya,yb
x2 = 2 * xm - x1 / 2 - x3 / 2
y2 = 2 * ym - y1 / 2 - y3 / 2
CIRCLE (x2, y2), 10, 12
ox = x1
oy = y1
DIM x(n), y(n)
x(0) = ox
y(0) = oy
FOR t = 1 TO n
x(t) = x1 + t * (x2 - x1) / n + (t / n) * (x2 + t * (x3 - x2) / n - x1 - t * (x2 - x1) / n)
y(t) = y1 + t * (y2 - y1) / n + (t / n) * (y2 + t * (y3 - y2) / n - y1 - t * (y2 - y1) / n)
IF drawgrid THEN
xa = x1 + t * (x2 - x1) / n
ya = y1 + t * (y2 - y1) / n
xb = x2 + t * (x3 - x2) / n
yb = y2 + t * (y3 - y2) / n
LINE (xa, ya)-(xb, yb), 8
END IF
'line (ox,oy)-(x,y),c
'ox = x
'oy = y
NEXT t
IF drawgrid THEN
LINE (x1, y1)-(x2, y2), 8
LINE (x2, y2)-(x3, y3), 8
END IF
FOR t = 1 TO n
LINE (x(t - 1), y(t - 1))-(x(t), y(t)), c
NEXT t
END SUB
SUB getmouse (x, y, b)
DIM r AS RegType
r.ax = 3
CALL INTERRUPT(&H33, r, r)
x = r.cx
y = r.dx
b = r.bx
END SUB
SUB hidemouse
DIM r AS RegType
r.ax = 2
CALL INTERRUPT(&H33, r, r)
END SUB
DEFINT A-Z
FUNCTION initmouse
DIM r AS RegType
r.ax = 0
CALL INTERRUPT(&H33, r, r)
initmouse = r.ax
END FUNCTION
DEFSNG A-Z
SUB showmouse
DIM r AS RegType
r.ax = 1
CALL INTERRUPT(&H33, r, r)
END SUB
|