rem This program written by Rick3137 for NaaLaa
rem rb23.yolasite.com
visible:
pendown = 0 ; PenX# = 0.0 ; PenY# = 0.0 ; Angle# = 0.0 ; Angle2# = 0.0 ; x1# =0.0 ; y1# = 0.0
x2# = 0.0 ; y2# = 0.0 ; dx# = 0.0 ; dy# = 0.0 ; d# = 0.0 ; cnt2 = 0 ; red =0 ; green = 0 ; blue = 0 ; key = 0
stx# = 0.0 ; sty# = 0.0 ; cnt3 = 0 ; cnt = 0 ; n1# = 1.0 ; clr = 1
Angle# = 0.0 ; AngleR# = 120.0 ; c1 = 0 ; c2 = 0 ; d# = 0.0
hidden:
a = 0
rem Starts Program
set redraw off
set window 0, 0, 1200, 700, true, 1
set color 25, 25, 60
cls
redraw
set color 100, 0, 200
pendown = 1
do
d# = 420.0
c1 = 1
c2 = 3
n1# = 3.0
Angle# = 54.0
AngleR# = 72.0
PenX# = -250.0
PenY# = 20.0
a = Fractal (d#)
redraw
wln " HIT SPACEBAR TO END "
redraw
wait keydown
a = 1
set color 25, 25, 60
cls
redraw
set color 100, 0, 200
until a > 0
aa
rem wait keydown
end
rem This ends the program.
function Fractal ( Distance# )
zcnt = 0
while zcnt < 5
proc MoveSteps Distance#
proc RotateRight AngleR#
a = Fractal2 ( Distance# / 2.0)
zcnt = zcnt + 1
redraw
wend
endfunc
function Fractal2 ( Distance# )
zcnt = 0
while zcnt < 5
proc MoveSteps Distance#
proc RotateRight AngleR#
a = Fractal3 ( Distance# / 2.0)
zcnt = zcnt + 1
wend
proc makecolor(clr)
clr = clr + 1
if clr > 70 then clr = 1
endfunc
function Fractal3 ( Distance# )
zcnt = 0
while zcnt < 5
proc MoveSteps Distance#
proc RotateRight AngleR#
a = Fractal4 ( Distance# /2.0 )
zcnt = zcnt + 1
wend
proc makecolor(clr)
clr = clr + 1
if clr > 70 then clr = 1
endfunc
function Fractal4 ( Distance# )
zcnt = 0
while zcnt < 5
proc MoveSteps Distance#
proc RotateRight AngleR#
a = Fractal5 ( Distance# /3.0 )
zcnt = zcnt + 1
wend
proc makecolor(clr)
clr = clr + 1
if clr > 70 then clr = 1
endfunc
function Fractal5 ( Distance# )
zcnt = 0
while zcnt < 5
proc MoveSteps Distance#
proc RotateRight AngleR#
rem a = Fractal6 ( Distance# /2.0 )
zcnt = zcnt + 1
wend
proc makecolor(clr)
clr = clr + 1
if clr > 70 then clr = 1
endfunc
procedure makecolor( abc) ; rem All variables are local
if clr > 70 then clr = 1
if clr = 0 then clr = 1
if clr < 0 then clr = 1
if clr = 1 then set color 10, 20, 255
if clr = 2 then set color 20, 40, 255
if clr = 3 then set color 30, 60, 255
if clr = 4 then set color 40, 80, 255
if clr = 5 then set color 50, 100, 255
if clr = 6 then set color 60, 120, 255
if clr = 7 then set color 70, 140, 255
if clr = 8 then set color 80, 160, 255
if clr = 9 then set color 90, 180, 255
if clr = 10 then set color 150, 200, 255
if clr = 11 then set color 10, 255, 255
if clr = 12 then set color 20, 255, 255
if clr = 13 then set color 30, 255, 255
if clr = 14 then set color 40, 255, 255
if clr = 15 then set color 50, 255, 255
if clr = 16 then set color 60, 255, 255
if clr = 17 then set color 70, 255, 255
if clr = 18 then set color 80, 255, 255
if clr = 19 then set color 90, 255, 255
if clr = 20 then set color 100, 255, 255
if clr = 21 then set color 0, 255, 100
if clr = 22 then set color 0, 255, 90
if clr = 23 then set color 0, 255, 80
if clr = 24 then set color 0, 255, 70
if clr = 25 then set color 0, 255, 60
if clr = 26 then set color 0, 255, 50
if clr = 27 then set color 0, 255, 40
if clr = 28 then set color 0, 255, 30
if clr = 29 then set color 0, 255, 20
if clr = 30 then set color 0, 255, 10
if clr = 31 then set color 255, 255, 10
if clr = 32 then set color 255, 255, 20
if clr = 33 then set color 255, 255, 30
if clr = 34 then set color 255, 255, 40
if clr = 35 then set color 255, 255, 50
if clr = 36 then set color 255, 255, 60
if clr = 37 then set color 255, 255, 70
if clr = 38 then set color 255, 255, 80
if clr = 39 then set color 255, 255, 90
if clr = 40 then set color 255, 255, 100
if clr = 41 then set color 255, 10, 255
if clr = 42 then set color 255, 20, 255
if clr = 43 then set color 255, 30, 255
if clr = 44 then set color 255, 40, 255
if clr = 45 then set color 255, 50, 255
if clr = 46 then set color 255, 60, 255
if clr = 47 then set color 255, 70, 255
if clr = 48 then set color 255, 80, 255
if clr = 49 then set color 255, 90, 255
if clr = 50 then set color 255, 200, 255
if clr = 51 then set color 10, 255, 0
if clr = 52 then set color 20, 255, 0
if clr = 53 then set color 30, 255, 0
if clr = 54 then set color 40, 255, 0
if clr = 55 then set color 50, 255, 0
if clr = 56 then set color 60, 255, 0
if clr = 57 then set color 70, 255, 0
if clr = 58 then set color 80, 255, 0
if clr = 59 then set color 90, 255, 0
if clr = 60 then set color 100, 255, 0
if clr = 61 then set color 0, 255, 10
if clr = 62 then set color 0, 255, 20
if clr = 63 then set color 0, 255, 30
if clr = 64 then set color 0, 255, 40
if clr = 65 then set color 0, 255, 50
if clr = 66 then set color 0, 255, 60
if clr = 67 then set color 0, 255, 70
if clr = 68 then set color 0, 255, 80
if clr = 69 then set color 0, 255, 90
if clr = 70 then set color 0, 155, 0
endproc
procedure ChangeColor(n)
blue = blue + n
if blue > 255 then blue = blue - 150
red = red + n
if red > 255 then red = red - 200
green = green + n
if green > 255 then green = green - 230
if blue < 90 then blue = blue + 100
if red < 70 then red = red + 80
if green < 50 then green = green + 50
set color red,green,blue
endproc
procedure RotateRight(n#)
Angle# = Angle# + n#
if Angle# > 360.0 then Angle# = Angle# - 360.0
if Angle# = 360.0 then Angle# = 0.0
endproc
procedure RotateLeft(n#)
if Angle# = n#
Angle# = 0.0
n# = 0.0
endif
if Angle# > n#
Angle# = Angle# - n#
else
Angle# = n# - Angle#
Angle# = 360.0 - Angle#
endif
endproc
rem math degrees = 450 - compass degrees
procedure GetAngle (n#) ; rem input compass degrees, output math degrees
n# = 450.0 - n#
if n# = 450.0 then n# = 90.0
if n# > 450.0 then n# = n# - 360.0
Angle2# = n#
endproc
procedure MoveSteps ( t# )
lx = 0 ; ly = 0 ; lx2 = 0 ; ly2 = 0
x1# = 500.0 + PenX#
y1# = 300.0 - PenY#
proc GetAngle Angle#
dx# = cos (Angle2#)
dy# = sin (Angle2#)
x2# = x1# + ( dx# * t# )
y2# = y1# - (dy# * t# )
lx = int(x1#) ; lx2 = int(x2#) ; ly = int(y1#) ; ly2 = int(y2#)
if pendown = 1 then draw line lx,ly,lx2,ly2
PenX# = PenX# + (dx# * t#)
PenY# = PenY# + (dy# * t#)
endproc