Bitmap/Bresenham's line algorithm: Difference between revisions
Content deleted Content added
RapidQ added |
fortran |
||
Line 271:
**
ok
=={{header|Fortran}}==
{{works with|Fortran|90 and later}}
<lang fortran>module RCImagePrimitive
use RCImageBasic
type point
integer :: x, y
end type point
private :: swapcoord
contains
subroutine swapcoord(p1, p2)
integer, intent(inout) :: p1, p2
integer :: t
t = p2
p2 = p1
p1 = t
end subroutine swapcoord
subroutine draw_line(img, from, to, color)
type(rgbimage), intent(inout) :: img
type(point), intent(in) :: from, to
type(rgb), intent(in) :: color
type(point) :: rfrom, rto
integer :: dx, dy, error, ystep, x, y
logical :: steep
rfrom = from
rto = to
steep = (abs(rto%y - rfrom%y) > abs(rto%x - rfrom%x))
if ( steep ) then
call swapcoord(rfrom%x, rfrom%y)
call swapcoord(rto%x, rto%y)
end if
if ( rfrom%x > rto%x ) then
call swapcoord(rfrom%x, rto%x)
call swapcoord(rfrom%y, rto%y)
end if
dx = rto%x - rfrom%x
dy = abs(rto%y - rfrom%y)
error = dx / 2
y = rfrom%y
if ( rfrom%y < rto%y ) then
ystep = 1
else
ystep = -1
end if
do x = rfrom%x, rto%x
if ( steep ) then
call put_pixel(img, y, x, color)
else
call put_pixel(img, x, y, color)
end if
error = error - dy
if ( error < 0 ) then
y = y + ystep
error = error + dx
end if
end do
end subroutine draw_line
end module RCImagePrimitive</lang>
Usage example:
<lang fortran>program BasicImageTests
use RCImageBasic
use RCImageIO
use RCImagePrimitive
type(rgbimage) :: animage
integer :: x, y
animage = alloc_img(200, 200)
call fill_img(animage, rgb(255,255,255))
call draw_line(animage, point(0,0), point(255,255), rgb(0,0,0))
do y=0,219,20
call draw_line(animage, point(0,0), point(255, y), &
rgb(0,0,0))
end do
open(unit=10, file='outputimage.ppm', status='new')
call output_ppm(10, animage)
close(10)
call free_img(animage)
end program BasicImageTests</lang>
=={{header|MAXScript}}==
| |||