Compare commits
3 Commits
a0d63856af
...
e060fad764
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
e060fad764 | ||
|
|
be961b46fc | ||
|
|
1dd0e71577 |
@@ -57,10 +57,21 @@ subroutine genp_get_offset(ox, oy)
|
||||
ox = xoffset ; oy = yoffset
|
||||
end subroutine
|
||||
! ---------------------------------------------------------
|
||||
! new Tue May 12 06:51:57 PM UTC 2026
|
||||
subroutine genp_set_scale(sx, sy)
|
||||
real, intent(in) :: sx, sy
|
||||
xscale = sx ; yscale = sy
|
||||
end subroutine
|
||||
subroutine genp_get_scale(sx, sy)
|
||||
real, intent(out) :: sx, sy
|
||||
sx = xscale ; sy = yscale
|
||||
end subroutine
|
||||
! ---------------------------------------------------------
|
||||
subroutine genp_move (px, py)
|
||||
real, intent(in) :: px, py
|
||||
real :: lx, ly
|
||||
lx = px + xoffset ; ly = py + yoffset
|
||||
lx = (px*xscale) + xoffset
|
||||
ly = (py*yscale) + yoffset
|
||||
write (outunit, '(2F12.5, I5)') lx, ly, -1
|
||||
if (lx .lt. xmin) xmin = lx
|
||||
if (lx .gt. xmax) xmax = lx
|
||||
@@ -72,7 +83,8 @@ subroutine genp_draw (px, py, color)
|
||||
real, intent(in) :: px, py
|
||||
integer, intent(in) :: color
|
||||
real :: lx, ly
|
||||
lx = px + xoffset ; ly = py + yoffset
|
||||
lx = (px*xscale) + xoffset
|
||||
ly = (py*yscale) + yoffset
|
||||
write (outunit, '(2F12.5, I5)') lx, ly, color
|
||||
if (lx .lt. xmin) xmin = lx
|
||||
if (lx .gt. xmax) xmax = lx
|
||||
@@ -95,6 +107,34 @@ subroutine genp_plot_axes(amp)
|
||||
call genp_draw( amp, 0.0, 7)
|
||||
end subroutine
|
||||
! ---------------------------------------------------------
|
||||
subroutine genp_circle(radius, steps, color)
|
||||
real, intent(in) :: radius
|
||||
integer, intent(in) :: steps, color
|
||||
|
||||
integer :: idx
|
||||
real :: fk, ang, x, y
|
||||
logical :: firstdot
|
||||
|
||||
if (steps .LT.3 ) then
|
||||
write(0, '("circle: steps ", I3, " bad value")') steps
|
||||
return
|
||||
endif
|
||||
|
||||
firstdot = .TRUE.
|
||||
do idx=0, steps
|
||||
fk = real(idx) / real(steps)
|
||||
ang = 6.283185307 * fk
|
||||
! write(0, '(I5, " -> ", 2F10.5)') idx, fk, ang
|
||||
x = radius * cos(ang) ; y = radius * sin(ang)
|
||||
if (firstdot) then
|
||||
call genp_move(x, y) ; firstdot = .FALSE.
|
||||
else
|
||||
call genp_draw(x, y, color)
|
||||
endif
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
! ---------------------------------------------------------
|
||||
subroutine genp_end (foo)
|
||||
integer, intent(in) :: foo
|
||||
|
||||
|
||||
15
testbed.f90
15
testbed.f90
@@ -2,8 +2,21 @@ program testbed
|
||||
use genplotting
|
||||
implicit none
|
||||
|
||||
integer idx
|
||||
real fdx, xp, yp, scx, scy
|
||||
|
||||
call genp_init(0, "foo.scratch")
|
||||
call genp_plot_axes(13.37)
|
||||
scx = 0.8 ; scy = 1.5
|
||||
do idx=5, 60
|
||||
fdx = real(idx)
|
||||
xp = 3.5 * cos((fdx/14.0)-0.7)
|
||||
yp = 3.5 * sin((fdx/10.0)+0.3)
|
||||
call genp_set_offset(xp, yp)
|
||||
call genp_set_scale(scx, scy)
|
||||
call genp_circle(fdx, 60, 1+mod(idx, 3))
|
||||
scx = scx + 0.0075
|
||||
scy = scy - 0.0075
|
||||
enddo
|
||||
call genp_end(0)
|
||||
call genp_do_render("foo.scratch", "foo.tga", 512, 512)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user