51 lines
1.3 KiB
Fortran
51 lines
1.3 KiB
Fortran
!
|
|
! SQUARMANIA
|
|
! new Thu Apr 23 04:27:03 PM UTC 2026
|
|
!
|
|
! this crapware is released by tTh under the
|
|
! DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
|
|
!
|
|
program squarmania
|
|
use genplotting
|
|
implicit none
|
|
|
|
write (0, '(A)') "----[ genplotting squarmania ]----"
|
|
|
|
call genp_init (0, 'WS/squarmania.scratch')
|
|
call do_squarmania (40, 0.934)
|
|
call genp_end (0)
|
|
|
|
contains
|
|
! ---------------------------------------------------------
|
|
subroutine do_squarmania (nbr, k0)
|
|
integer, intent(in) :: nbr
|
|
real, intent(in) :: k0
|
|
|
|
integer :: idx
|
|
real :: xa, xb, xc, xd, ya, yb, yc, yd
|
|
real :: va, vb, vc, vd, wa, wb, wc, wd, k2
|
|
|
|
k2 = 1.0 - k0
|
|
xa = 1 ; ya = 1 ; xb = 1 ; yb = -1
|
|
xc = -1 ; yc = -1 ; xd = -1 ; yd = 1
|
|
|
|
do idx=1, nbr
|
|
call genp_move(xa, ya)
|
|
call genp_draw(xb, yb, 1) ; call genp_draw(xc, yc, 1)
|
|
call genp_draw(xd, yd, 2) ; call genp_draw(xa, ya, 2)
|
|
|
|
va = k0*xa + k2*xb ; wa = k0*ya + k2*yb
|
|
vb = k0*xb + k2*xc ; wb = k0*yb + k2*yc
|
|
vc = k0*xc + k2*xd ; wc = k0*yc + k2*yd
|
|
vd = k0*xd + k2*xa ; wd = k0*yd + k2*ya
|
|
|
|
xa = va ; xb = vb ; xc = vc ; xd = vd
|
|
ya = wa ; yb = wb ; yc = wc ; yd = wd
|
|
|
|
enddo
|
|
|
|
end subroutine
|
|
|
|
! ---------------------------------------------------------
|
|
end program
|