Initial data commit
This commit is contained in:
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
|
|
@ -0,0 +1,70 @@
|
|||
module RCImagePrimitive
|
||||
use RCImageBasic
|
||||
|
||||
implicit none
|
||||
|
||||
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
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
program BasicImageTests
|
||||
use RCImageBasic
|
||||
use RCImageIO
|
||||
use RCImagePrimitive
|
||||
|
||||
implicit none
|
||||
|
||||
type(rgbimage) :: animage
|
||||
integer :: x, y
|
||||
|
||||
call alloc_img(animage, 200, 200)
|
||||
call fill_img(animage, rgb(255,255,255))
|
||||
|
||||
call draw_line(animage, point(0,0), point(199,199), rgb(0,0,0))
|
||||
|
||||
do y=0,219,20
|
||||
call draw_line(animage, point(0,0), point(199, 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue