Posts: 33
Threads: 2
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,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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: 1,847
Threads: 190
Joined: Apr 2022
Reputation:
88
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
If eggs are brain food, Biden has his scrambled.
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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: 1,847
Threads: 190
Joined: Apr 2022
Reputation:
88
Thanks Mark for restocking my short supply of Jewish throwing stars!
Pete 
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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,548
Threads: 165
Joined: Apr 2022
Reputation:
172
Thumbs up tp triggered for this cool way to do a fractal, luv it!
b = b + ...
Posts: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
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: 256
Threads: 11
Joined: Apr 2022
Reputation:
29
(06-02-2022, 03:37 PM)triggered Wrote: Code: (Select All) PReset (x0, y0)
WTF is this abomination
Posts: 3,548
Threads: 165
Joined: Apr 2022
Reputation:
172
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 + ...
|
