User:CPMcE/qbasic

' Spiro.bas ' DECLARE SUB MoveTo (x AS DOUBLE, y AS DOUBLE) DECLARE SUB Spiro (ns AS INTEGER, nw AS INTEGER, nt AS INTEGER, d AS INTEGER, spos AS INTEGER, x AS DOUBLE, y AS DOUBLE, col AS INTEGER) DECLARE FUNCTION HighestCommonFactor (a AS INTEGER, b AS INTEGER) ' ' TEST ROUTINE DIM s AS INTEGER ' loop counter DIM col AS INTEGER ' Drawing color DIM diam AS INTEGER, spos AS INTEGER, x AS DOUBLE, y AS DOUBLE

SCREEN 9 ' Set screen mode to 640x350, 16 colors

x = 320 ' or Max x coordinate / 2 y = 175 ' or Max y coordinate / 2 col = 1 diam = 2 spos = 100 FOR b = 1 TO 12 Spiro 360, 120, 360, diam, spos, x, y, col diam = diam + 2 spos = spos + 10 col = col + 1 NEXT

' Highest common factor - Euclid's algorithm FUNCTION HighestCommonFactor (a AS INTEGER, b AS INTEGER)

DIM i AS INTEGER, j AS INTEGER, r AS INTEGER

IF a > b THEN i = a: j = b   ELSE i = b: j = a   END IF

r = i \ j   WHILE (r <> 0) i = j: j = r: r = i \ j   WEND HighestCommonFactor = j END FUNCTION

' MoveTo x, y ' For QBasic ' For other languages, replace or omit SUB MoveTo (x AS DOUBLE, y AS DOUBLE) DIM dr AS STRING

dr = "BM " + STR$(INT(x)) + "," + STR$(INT(y)) DRAW "X" + VARPTR$(dr) END SUB

'   Draw the loci of a point on a circle revolving inside '   another circle, or a circle revolving round another circle. ' ' Parameters: ' ns,  No. teeth in stationary part (-ve = outside) ' nw,  No. teeth in wheel (-ve = clockwise) ' nt,  No. of teeth to 'do' ' d,   Radius ' spos, tooth to start at ' x, y Coordinates of centre ' col    Drawing color SUB Spiro (ns AS INTEGER, nw AS INTEGER, nt AS INTEGER, d AS INTEGER, spos AS INTEGER, x AS DOUBLE, y AS DOUBLE, col AS INTEGER)

DIM n1 AS INTEGER, n2 AS INTEGER, i AS INTEGER, n AS INTEGER, no AS INTEGER DIM a AS DOUBLE, b AS DOUBLE, alpha AS DOUBLE, beta AS DOUBLE DIM offang AS DOUBLE, dab AS DOUBLE, adif AS DOUBLE, aob AS DOUBLE DIM x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE DIM PI AS DOUBLE

PI = 3.141592658979324# n1 = ABS(ns) n2 = ABS(nw) a = n1 / (2# * PI) b = n2 / (2# * PI) IF ns < 0 THEN dab = a + b       d = -d ELSE dab = a - b   END IF    offang = (spos - 1) * 2# * PI / n1    alpha = 0# adif = PI / n1   aob = a / b    n = (n2 / HighestCommonFactor(n1, n2)) no = 2 * n * ABS(nt) x1 = dab + d   y1 = 0# x2 = x1 * COS(offang) + x   y2 = x1 * SIN(offang) + y    MoveTo x2, y2    FOR i = 0 TO no - 1 IF nw < 0 THEN alpha = alpha - adif ELSE alpha = alpha + adif IF ns < 0 THEN beta = -alpha * aob ELSE beta = alpha * aob x1 = dab * COS(alpha) + d * COS(alpha - beta) y1 = dab * SIN(alpha) + d * SIN(alpha - beta) x2 = x1 * COS(offang) - y1 * SIN(offang) + x       y2 = x1 * SIN(offang) + y1 * COS(offang) + y        'setcolor col 'lineto(x2, y2) LINE -(x2, y2), col NEXT END SUB