Posts: 28
Threads: 1
Joined: May 2022
I decided to try and implement a graphics method I'm particularly fond of:
Code: (Select All) Screen 12
Dim a$
a$ = "FRRFRRF"
Dim j
For j = 1 To 4
a$ = stReplace$(a$, "F", "FLFRRFLF")
Next j
TurtleGraphics 320 / 2, 240 / 2, 0, 5, a$
End
Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)
Dim As Double x, y, angle, stepsize
Dim w As String
Dim t As String
x = x0
y = y0
angle = a0
w = path
stepsize = ssize
PReset (x0, y0)
Do While Len(w)
t = Left$(w, 1)
w = Right$(w, Len(w) - 1)
Select Case t
Case "F"
x = x + stepsize * Cos(angle)
y = y + stepsize * Sin(angle)
Case "L"
angle = angle - 60 * _Pi / 180
Case "R"
angle = angle + 60 * _Pi / 180
End Select
Line -(x, y), 15
Loop
End Sub
Function stReplace$ (a As String, b As String, c As String)
Dim i As Integer
Dim g As String
Dim r As String
For i = 1 To Len(a)
g = Mid$(a, i, 1)
If g = b Then
r = r + c
Else
r = r + g
End If
Next
stReplace = r
End Function
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
Yeah aren't those the "best" kind of programs, ones that you are "particularly fond of".
That's a good one, I like the use of string replacements to build the draw string for Koch Flake.
b = b + ...
Posts: 2,186
Threads: 222
Joined: Apr 2022
Reputation:
104
Hey look, another triggered snowflake!
Code: (Select All) SCREEN 12
DIM a$
a$ = "FRRFRRF"
DIM j
FOR j = 1 TO 4
a$ = stReplace$(a$, "F", "RFSFRFSF")
NEXT j
TurtleGraphics 460 / 2, 120 / 2, 0, 5, a$
TurtleGraphics 840 / 2, 120 / 2, 0, 5, a$
TurtleGraphics 650 / 2, 340 / 2, 0, 5, a$
TurtleGraphics 550 / 2, 540 / 2, 0, 5, a$
TurtleGraphics 750 / 2, 540 / 2, 0, 5, a$
TurtleGraphics 480 / 2, 690 / 2, 0, 5, a$
TurtleGraphics 820 / 2, 690 / 2, 0, 5, a$
TurtleGraphics 550 / 2, 840 / 2, 0, 5, a$
TurtleGraphics 750 / 2, 840 / 2, 0, 5, a$
SLEEP
SYSTEM
SUB TurtleGraphics (x0 AS DOUBLE, y0 AS DOUBLE, a0 AS DOUBLE, ssize AS DOUBLE, path AS STRING)
DIM AS DOUBLE x, y, angle, stepsize
DIM w AS STRING
DIM t AS STRING
x = x0
y = y0
angle = a0
w = path
stepsize = ssize
PRESET (x0, y0)
DO WHILE LEN(w)
t = LEFT$(w, 1)
w = RIGHT$(w, LEN(w) - 1)
SELECT CASE t
CASE "F"
x = x + stepsize * COS(angle)
y = y + stepsize * SIN(angle)
CASE "L"
angle = angle - 60 * _PI / 180
CASE "R"
angle = angle + 60 * _PI / 180
END SELECT
LINE -(x, y), 15
LOOP
END SUB
FUNCTION stReplace$ (a AS STRING, b AS STRING, c AS STRING)
DIM i AS INTEGER
DIM g AS STRING
DIM r AS STRING
FOR i = 1 TO LEN(a)
g = MID$(a, i, 1)
IF g = b THEN
r = r + c
ELSE
r = r + g
END IF
NEXT
stReplace = r
END FUNCTION
Shoot first and shoot people who ask questions, later.
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
Well my mod isn't all trumped up!
Code: (Select All) _Title "Koch Curve" ' by triggered mod b+ 2022-06-02
Screen _NewImage(700, 700, 12) ' b+ mod tirggered Koch curve
_ScreenMove 300, 20
mx = _Width / 2: my = _Height / 2
Dim a$
a$ = "FRRFRRF"
ss = 600
Circle (mx, my), 1
Circle (mx, my), ss / Sqr(3)
x0 = _Width / 2 + ss / Sqr(3) * Cos(_D2R(210))
y0 = _Height / 2 + ss / Sqr(3) * Sin(_D2R(210))
TurtleGraphics x0, y0, 0, ss, a$
_Delay 1
Dim j
For j = 1 To 4
'Cls
ss = ss / 3
a$ = stReplace$(a$, "F", "FLFRRFLF")
TurtleGraphics x0, y0, 0, ss, a$
_Limit 2 ' pause 2 x's per sec
Next j
Sleep
Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)
Dim As Double x, y, angle, stepsize
Dim w As String
Dim t As String
x = x0
y = y0
angle = a0
w = path
stepsize = ssize
PReset (x0, y0)
Do While Len(w)
t = Left$(w, 1)
w = Right$(w, Len(w) - 1)
Select Case t
Case "F"
x = x + stepsize * Cos(angle)
y = y + stepsize * Sin(angle)
Case "L"
angle = angle - 60 * _Pi / 180
Case "R"
angle = angle + 60 * _Pi / 180
End Select
Line -(x, y), 15
Loop
End Sub
Function stReplace$ (a As String, b As String, c As String)
Dim i As Integer
Dim g As String
Dim r As String
For i = 1 To Len(a)
g = Mid$(a, i, 1)
If g = b Then
r = r + c
Else
r = r + g
End If
Next
stReplace = r
End Function
b = b + ...
Posts: 2,186
Threads: 222
Joined: Apr 2022
Reputation:
104
Thanks Mark for restocking my short supply of Jewish throwing stars!
Pete 
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
06-03-2022, 03:49 AM
(This post was last modified: 06-03-2022, 03:51 AM by bplus.)
And another thing...
Code: (Select All) _Title "Koch Boch" ' by triggered mod b+ 2022-06-02
Screen _NewImage(700, 700, 12) ' b+ mod tirggered Koch curve
_ScreenMove 300, 20
mx = _Width / 2: my = _Height / 2
Dim a$
a$ = "FRFRFRF"
ss = 350
'Circle (mx, my), 1
'Circle (mx, my), .5 * ss * Sqr(2)
x0 = _Width / 2 + .5 * ss * Sqr(2) * Cos(_D2R(225))
y0 = _Height / 2 + ss / Sqr(2) * Sin(_D2R(225))
TurtleGraphics x0, y0, 0, ss, a$
Sleep
Dim j
For j = 1 To 5
ss = ss / 3
a$ = stReplace$(a$, "F", "FLFRFRFLF")
TurtleGraphics x0, y0, 0, ss, a$
_Limit 1 ' pause 2 x's per sec
Next j
Sleep
Sub TurtleGraphics (x0 As Double, y0 As Double, a0 As Double, ssize As Double, path As String)
Dim As Double x, y, angle, stepsize
Dim w As String
Dim t As String
x = x0
y = y0
angle = a0
w = path
stepsize = ssize
PReset (x0, y0)
Do While Len(w)
t = Left$(w, 1)
w = Right$(w, Len(w) - 1)
Select Case t
Case "F"
x = x + stepsize * Cos(angle)
y = y + stepsize * Sin(angle)
Case "L"
angle = angle - 90 * _Pi / 180
Case "R"
angle = angle + 90 * _Pi / 180
End Select
Line -(x, y), 15
Loop
End Sub
Function stReplace$ (a As String, b As String, c As String)
Dim i As Integer
Dim g As String
Dim r As String
For i = 1 To Len(a)
g = Mid$(a, i, 1)
If g = b Then
r = r + c
Else
r = r + g
End If
Next
stReplace = r
End Function
It's sleeping after the first square hit spacebar for fractal.
b = b + ...
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
Thumbs up tp triggered for this cool way to do a fractal, luv it!
b = b + ...
Posts: 301
Threads: 16
Joined: Apr 2022
Reputation:
51
Nice mods, B+. A couple of old fractalesque demos of mine:
alternate Kock snowflake
Code: (Select All) dim shared pi
dim shared c
dim shared cc
pi = 4*atn(1)
c = 2*sqr(3)/9
cc = sqr(12) / 6
sw = 1024
sh = 768
screen _newimage(sw, sh, 12)
tri sw/2, sh/2, 600, 0
tri sw/2, sh/2, 600, pi
cock sw/2, sh/2, 600, 3
sleep
system
sub cock(x, y, s, i)
if i = 0 then exit sub
for a = pi/6 to 2*pi + pi/6 step pi/3
xx = s*c*cos(a) + x
yy = s*c*sin(a) + y
tri xx, yy, s/3, a+pi/6
tri xx, yy, s/3, a+pi/6+pi
cock xx, yy, s/3, i - 1
next
end sub
sub tri(x, y, s, a)
line (x,y)-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a)),8
line (x,y)-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a)),8
line (x,y)-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a)),8
line (x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))-(x+s*cc*cos(5*pi/6 + a),y+s*cc*sin(5*pi/6 + a))
line-(x-s*cc*cos(pi/2 + a),y-s*cc*sin(pi/2 + a))
line-(x+s*cc*cos(pi/6 + a),y+s*cc*sin(pi/6 + a))
end sub
Flower of justice
Code: (Select All) const sw = 800
const sh = 600
dim shared pi as double
pi = 4*atn(1)
screen _newimage(sw, sh, 32)
r = 100
do
for a = 0.1 to 1 step 0.01
cls
fcirc sw/2, sh/2, a*r + (1-a)*150, a, 3
_display
_limit 5
next
_delay 2
loop
sleep
system
sub fcirc (x, y, r, a, n)
if n > 0 then
for t=0 to 2*pi step 2*pi/6
xx = x + r*cos(t)
yy = y + r*sin(t)
circle (xx, yy), r
fcirc xx, yy, a*r, a, n - 1
next
end if
end sub
Logistic map or the '1-dimensional Mandelbrot'
Code: (Select All) deflng a-z
dim xx as double, uu as double
screen 12
for u=0 to 640
uu=2.8 + 1.2*u/640
for x=0 to 480
xx = x/480
for i=0 to 500
xx = uu*xx*(1-xx)
next
pset(u,480*(1-xx))
next
next
sleep
system
Posts: 301
Threads: 16
Joined: Apr 2022
Reputation:
51
(06-02-2022, 03:37 PM)triggered Wrote: Code: (Select All) PReset (x0, y0)
WTF is this abomination
Posts: 3,987
Threads: 178
Joined: Apr 2022
Reputation:
222
06-03-2022, 07:07 PM
(This post was last modified: 06-03-2022, 07:09 PM by bplus.)
(06-03-2022, 06:31 PM)vince Wrote: (06-02-2022, 03:37 PM)triggered Wrote: Code: (Select All) PReset (x0, y0)
WTF is this abomination
Yeah I had to look it up, like PSet, PReset colors a pixel. Unlike PSet using the forecolor of Color, PReset uses the background color of Color, puts it back into the background so to speak.
Makes sense for older code when it was too expensive to CLS and redraw everything every loop.
Also if you don't know if you are going to always draw a line or not from a pset, why make a dot?
b = b + ...
|
