10-06-2022, 11:31 PM
nice, there's also this B+ mod from back in the qb64 golden age, it's loaded with trig
Code: (Select All)
CONST g = &HFF000088 'hnd5s and numbers
pi = _PI
sw = 800
sh = 600
s$ = "33111121131112121222132114211123113231"
SCREEN _NEWIMAGE(sw, sh, 32)
hhand& = _NEWIMAGE(360, 80, 32) ' make hour hand image and save
b = -pi / 2
PSET (sw / 2, sh / 2)
FOR a = 0 TO pi STEP 0.01
x = 140 * (0.8 * COS(a)) ^ 5 * ABS(3 * COS(8 * a) ^ 2) * SIN(a) * COS(b) - 176 * SIN(a) * SIN(b)
y = 140 * (0.8 * COS(a)) ^ 5 * ABS(3 * COS(8 * a) ^ 2) * SIN(a) * SIN(b) + 176 * SIN(a) * COS(b)
LINE -(sw / 2 + x, sh / 2 + y), g
NEXT
PAINT (sw / 2 + 10, sh / 2), g, g
PAINT (sw / 2 + 60, sh / 2), g, g
PAINT (sw / 2 + 120, sh / 2), g, g
PAINT (sw / 2 + 160, sh / 2), g, g
_PUTIMAGE , 0, hhand&, (sw / 2 - 180, sh / 2 - 39)-STEP(359, 79)
'check
'CLS
'RotoZoom sw / 2, sh / 2, hhand&, 1, 0
'CIRCLE (sw / 2, sh / 2), 6, &HFFFFFF00
SCREEN _NEWIMAGE(sw, sh, 32) ' cls screen without cls keep back transparent
mhand& = _NEWIMAGE(560, 80, 32) 'make minute hand
b = -pi / 2
FOR a = 0 TO pi STEP 0.01
x = 55 * (COS(a)) ^ 5 * ABS(2 * (COS(4 * a)) ^ 2 - 0.5) * SIN(a) * COS(b) - 270 * SIN(a) * SIN(b)
y = 55 * (COS(a)) ^ 5 * ABS(2 * (COS(4 * a)) ^ 2 - 0.5) * SIN(a) * SIN(b) + 270 * SIN(a) * COS(b)
LINE -(sw / 2 + x, sh / 2 + y), g
NEXT
PAINT (sw / 2 + 20, sh / 2), g, g
PAINT (sw / 2 + 120, sh / 2), g, g
PAINT (sw / 2 + 160, sh / 2), g, g
_PUTIMAGE , 0, mhand&, (sw / 2 - 280, sh / 2 - 39)-STEP(559, 79)
'check
'CLS
'RotoZoom sw / 2, sh / 2, mhand&, 1, 36
'RotoZoom sw / 2, sh / 2, hhand&, 1, 150
'CIRCLE (sw / 2, sh / 2), 6, &HFFFFFF00
CLS
face& = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
fcirc sw / 2, sh / 2, 280 + 10, &HFFFF0000
fcirc sw / 2, sh / 2, 280 + 5, &HFFFFFFFF
fcirc sw / 2, sh / 2, 205, &HFFDDDDFF
FOR a = 0 TO 2 * pi STEP 0.01
x = 100 * COS(a) + 100 * COS(14 * a)
y = 100 * SIN(a) + 100 * SIN(14 * a)
IF a = 0 THEN PSET (sw / 2 + x, sh / 2 + y) ELSE LINE -(sw / 2 + x, sh / 2 + y), _RGB(0, 255, 128)
NEXT
fcirc sw / 2, sh / 2, 12, &HFFFFFF00
fcirc sw / 2, sh / 2, 6, &HFF000000
CIRCLE (sw / 2, sh / 2), 210 - 5, &HFF000000
CIRCLE (sw / 2, sh / 2), 280 + 5, &HFF000000
CIRCLE (sw / 2, sh / 2), 280 + 10, &HFF000000
a = -pi / 2
COLOR g
DO WHILE i < LEN(s$) - 1
i = i + 1
c$ = MID$(s$, i, 1)
b = a - 0.05 * (VAL(c$)) * 0.5
FOR k = 0 TO VAL(c$) - 1
i = i + 1
SELECT CASE MID$(s$, i, 1)
CASE "1"
LINE (sw / 2 + 210 * COS(b), sh / 2 + 210 * SIN(b))-STEP(70 * COS(b), 70 * SIN(b))
CASE "2"
IF VAL(c$) > 1 THEN c = b + 0.05 * 0.5 * ((k = 0) - (k <> 0)) ELSE c = b
LINE (sw / 2 + 210 * COS(c), sh / 2 + 210 * SIN(c))-STEP(70 * COS(c - 0.05 * 3), 70 * SIN(c - 0.05 * 3))
LINE (sw / 2 + 210 * COS(c), sh / 2 + 210 * SIN(c))-STEP(70 * COS(c + 0.05 * 3), 70 * SIN(c + 0.05 * 3))
CASE "3"
IF VAL(c$) > 1 THEN c = b + 0.05 * 0.5 * ((k = 0) - (k <> 0)) ELSE c = b
LINE (sw / 2 + 210 * COS(c - 0.05 * 0.8), sh / 2 + 210 * SIN(c - 0.05 * 0.8))-(sw / 2 + 280 * COS(c + 0.05 * 0.8), sh / 2 + 280 * SIN(c + 0.05 * 0.8))
LINE (sw / 2 + 210 * COS(c + 0.05 * 0.8), sh / 2 + 210 * SIN(c + 0.05 * 0.8))-(sw / 2 + 280 * COS(c - 0.05 * 0.8), sh / 2 + 280 * SIN(c - 0.05 * 0.8))
END SELECT
b = b + 0.05
NEXT
a = a + pi / 6
LOOP
_PUTIMAGE , 0, face&
DO
_PUTIMAGE , face&, 0
m = VAL(MID$(TIME$, 4, 2)) / 60
h = VAL(LEFT$(TIME$, 2))
IF h > 12 THEN h = h - 12
h = (h / 12 + m / 12) * 360
RotoZoom sw / 2, sh / 2, hhand&, 1, h - 90
RotoZoom sw / 2, sh / 2, mhand&, 1, m * 360 - 90
_DISPLAY
_LIMIT 100
LOOP UNTIL _KEYHIT = 27
SLEEP
SYSTEM
SUB RotoZoom (X AS LONG, Y AS LONG, hdl AS LONG, Scale AS SINGLE, Rotation AS SINGLE)
DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
W& = _WIDTH(hdl): H& = _HEIGHT(hdl)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
FOR I& = 0 TO 3
x2& = (px(I&) * cosr! + sinr! * py(I&)) * Scale + X: y2& = (py(I&) * cosr! - px(I&) * sinr!) * Scale + Y
px(I&) = x2&: py(I&) = y2&
NEXT
_MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), hdl TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), hdl TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
'from Steve Gold standard
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
DIM Radius AS INTEGER, RadiusError AS INTEGER
DIM X AS INTEGER, Y AS INTEGER
Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
LINE (CX - X, CY)-(CX + X, CY), C, BF
WHILE X > Y
RadiusError = RadiusError + Y * 2 + 1
IF RadiusError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
END IF
X = X - 1
RadiusError = RadiusError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
WEND
END SUB