Kenneth_Smith
Joined: 18 May 2012
Posts: 801
Location: Hamilton, Lanarkshire, Scotland.
|
 Posted: Tue Feb 04, 2025 4:03 pm Post subject: |
 |
|
Here is another fractal - the Barnsley fern.
There a few tricks with the %pl margin, frame, etched, external_ticks and x_min etc, options, which along with an offset in the x axis values passed to %pl which combine to hide all axis annotations.
Not a good example to ask the %pl[external,buffered] to update on each iteration however.
| Code: | options (optimise)
program bfern
use clrwin
implicit none
integer, parameter :: n = 100000
integer :: i, current, iw, control, idx, gh
real*8 :: temp_x, temp_y, r, x_shift = 5.5d0
real*8, allocatable, dimension(:) :: x, y
real*8, dimension(4, 6) :: coeffs
data coeffs/0.0d0, 0.2d0, -0.15d0, 0.84d0, 0.0d0, -0.26d0, 0.28d0, 0.04d0, &
0.0d0, 0.23d0, 0.26d0,-0.04d0, 0.16d0, 0.22d0, 0.24d0, 0.85d0, &
0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 1.6d0, 0.44d0, 1.6d0 /
write(*,'(a)') 'Initialising'
allocate(x(n),y(n))
gh = 0.80*clearwin_info@('screen_depth')
iw = winio@('%mn[Exit]&','Exit')
iw = winio@('%gr[grey]%lw',gh,gh,control)
x(1) = 0.d0
y(1) = 0.d0
current = 1
write(*,'(a,f6.2)') '% complete ',0.d0
do i = 2, n
call random_number(r)
temp_x = x(current)
temp_y = y(current)
if (r .le. 0.01d0) then
idx = 1
else if (r .le. 0.08d0) then
idx = 2
else if (r .le. 0.15d0) then
idx = 3
else
idx = 4
end if
x(i) = coeffs(idx, 1) * temp_x + coeffs(idx, 2) * temp_y + coeffs(idx, 5)
y(i) = coeffs(idx, 3) * temp_x + coeffs(idx, 4) * temp_y + coeffs(idx, 6)
current = i
if ( mod(i,1000) .eq. 0 ) call temporary_yield@()
if ( mod(i,n/20) .eq. 0 ) then
iw = winio@('%`bg[grey]&')
call winop_int@('%pl[n_graphs]',1)
call winop_clr@('%pl[colour]', rgb@(1,130,32))
call winop@('%pl[x_array,independent,link=none,symbol=11,symbol_size=1]')
call winop@('%pl[frame,etched,external_ticks,margin=2]')
call winop@('%pl[x_min=0,x_max=11,y_min=0,y_max=11]')
iw = winio@('%pl[external,buffered]', i, x + x_shift, y)
call perform_graphics_update@()
call temporary_yield@()
write(*,'(a,f6.2)') '% complete ',dble(i)/n*100
end if
end do
write(*,'(a)') 'all done'
end program bfern |
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
