QB / QB64 Discussion Forum      Other Subforums, Links and Downloads
 Return to Index  

Cubic bezier curve

July 1 2008 at 8:20 AM
moi  (Login moiqb)


Response to Quadratic Bezier Curve

DECLARE SUB getmouse (x!, y!, b!)
DECLARE SUB hidemouse ()
DECLARE SUB showmouse ()
DECLARE FUNCTION initmouse% ()
DECLARE SUB draw.cubic.curve (x1, y1, x2, y2, x3, y3, x4, y4, n, c)

'$INCLUDE: 'qb.bi'
IF NOT initmouse THEN
PRINT "No mouse driver"
END
END IF
SCREEN 12
PRINT "Cubic Bezier Curve... by moi"
PRINT
PRINT "Click 4 points to draw a curve through those points."
PRINT "Press space to clear the screen. ESC to exit."

showmouse
n = 100
c = 15
DIM x(3), y(3), mx, my, mb
i = 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 = 4 THEN
i = 0
draw.cubic.curve x(0), y(0), x(1), y(1), x(2), y(2), x(3), y(3), 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$(27)
EXIT DO
END SELECT
LOOP

SUB draw.cubic.curve (x1, y1, x2m, y2m, x3m, y3m, x4, y4, n, c)

x2 = 3 * x2m - x1 * 5 / 6 - x3m * 3 / 2 + x4 / 3
y2 = 3 * y2m - y1 * 5 / 6 - y3m * 3 / 2 + y4 / 3
x3 = 3 * x3m + x1 / 3 - x2m * 3 / 2 - x4 * 5 / 6
y3 = 3 * y3m + y1 / 3 - y2m * 3 / 2 - y4 * 5 / 6

ox = x1
oy = y1
DIM k AS SINGLE, r AS SINGLE

FOR t = 1 TO n
k = t / n
r = 1 - k
x = x1 * (r ^ 3) + x2 * (3 * k * (r ^ 2)) + x3 * (3 * (k ^ 2) * r) + x4 * (k ^ 3)
y = y1 * (r ^ 3) + y2 * (3 * k * (r ^ 2)) + y3 * (3 * (k ^ 2) * r) + y4 * (k ^ 3)
LINE (ox, oy)-(x, y), c
ox = x
oy = y
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


 
 Respond to this message   
Responses

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums