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