Code: Select all
REM Dissection of a regular heptagon into two heptagons
REM by Richard Russell, https://bbcbasic.com/, 21-Sep-2025
REM Requires BBC BASIC for Windows or BBC BASIC for SDL 2.0
MODE 8 : OFF
ORIGIN 640,512
INSTALL @lib$ + "aagfxlib"
s = 400 : t = -2*PI/7 : u = 0.25 / TAN(5*PI/14) : v = 0.003
DIM r(1,1), q(1,2) : r() = COS(t*2), SIN(t*2), -SIN(t*2), COS(t*2)
DIM shape1(1,8), shape2(1,2), shape3(1,8), shape4(1,2)
DIM shape5(1,5), shape6(1,2), shape7(1,6), shape8(1,2)
x0=0 : y0=0 : x1=u : y1=0.25 : x2=0 : y2=0.5 : x3=u : y3=0.75
x4=0 : y4=1 : x5=SIN(t) : y5=COS(t) : x9=SIN(t*2) : y9=COS(t*2)
q() = x1,x2,x3, y1,y2,y3 : q() = r() . q()
x6 =q(0,0): y6=q(1,0): x7=q(0,1): y7=q(1,1): x8=q(0,2): y8=q(1,2)
x10=SIN(t*3) : y10=COS(t*3) : q() = r() . q()
x11=q(0,0):y11=q(1,0):x12=q(0,1):y12=q(1,1):x13=q(0,2):y13=q(1,2)
x14=SIN(t*4) : y14=COS(t*4) : x15=SIN(t*5) : y15=COS(t*5)
x17=SIN(t*6) : y17=COS(t*6) : x16=(x15+x17)/2 : y16=(y15+y17)/2
x18=x16 * 0.846 : y18=y16 * 0.846 : w = PI * 3 / 14
shape1() = x0,x1,x2,x3,x5,x9,x8,x7,x6, y0,y1,y2,y3,y5,y9,y8,y7,y6
shape2() = x3,x4,x5, y3,y4,y5 : shape4() = x8,x9,x10, y8,y9,y10
shape3() = x0,x6,x7,x8,x10,x14,x13,x12,x11,y0,y6,y7,y8,y10,y14,y13,y12,y11
shape5() = x0,x11,x12,x13,x15,x16, y0,y11,y12,y13,y15,y16
shape6() = x13,x14,x15, y13,y14,y15 : shape8() = x18,x16,x17, y18,y16,y17
shape7() = x0,x18,x17,x4,x3,x2,x1, y0,y18,y17,y4,y3,y2,y1
shape1() *= s : shape2() *= s : shape3() *= s : shape4() *= s
shape5() *= s : shape6() *= s : shape7() *= s : shape8() *= s
*REFRESH OFF
z = -PI/2
REPEAT
CLS
d = PI * (SIN(z + v) - SIN(z)) * 20.3
z += v
PROCplot(shape1(), &FF0000FF) : PROCplot(shape2(), &FF00FF00)
PROCplot(shape3(), &FF00FFFF) : PROCplot(shape4(), &FFFF4000)
PROCplot(shape5(), &FFFF00FF) : PROCplot(shape6(), &FFFFFF00)
PROCplot(shape7(), &FF0080FF) : PROCplot(shape8(), &FF808080)
PROCmove(shape1(), w, d) : PROCmove(shape2(), w, d)
PROCmove(shape3(), w + t*2, d) : PROCmove(shape4(), w + t*2, d)
PROCmove(shape5(), w + t*4, d) : PROCmove(shape6(), w + t*4, d)
PROCmove(shape7(), w + t*5, d) : PROCmove(shape8(), w + t*5, d)
PROCturn(shape2(), 0.0317 * d) : PROCturn(shape4(), 0.0317 * d)
PROCturn(shape6(), 0.0317 * d) : PROCturn(shape8(), 0.0248 * d)
WAIT 1 : *REFRESH
UNTIL FALSE
END
DEF PROCplot(s(), C%)
PROC_aapolygon(DIM(s(),2)+1, s(0,0 TO), s(1,0 TO), C%)
ENDPROC
DEF PROCmove(s(), a, m)
s(0,0 TO) += SIN(a) * m : s(1,0 TO) += COS(a) * m
ENDPROC
DEF PROCturn(s(), a) : LOCAL x,y,r() : DIM r(1,1)
r() = COS(a), SIN(a), -SIN(a), COS(a)
x = s(0,0) : y = s(1,0) : s(0,0 TO) -= x : s(1,0 TO) -= y
s() = r() . s() : s(0,0 TO) += x : s(1,0 TO) += y
ENDPROC
https://www.youtube.com/watch?v=5NLYOLRHVRQ