module listlink
! _X(Contains a user-derived type - vector)
	use vector3
	implicit none
! _X(Implement a singularly-linked list)
	type llink
		type(vector3d) ::	point	! can use other derived types
		logical ::		visible
		integer ::		magnitude
		type(llink), pointer :: next
	end type llink
contains
!
! _X(Use object-oriented methods - encapsulate and isolate)
! Try to hide the implementation details by providing "methods" for the 
! "objects".  If you change the internal details, then you don't have
! to change the program except in the module itself
!
	subroutine setnext(link,next)
		implicit none
		type(llink), pointer :: link, next
		if (associated(link) .and. associated(next)) then
			if (.not. associated(link%next)) then
				link%next => next
			endif
		endif
	end subroutine setnext

	function nextlink(link)
		implicit none
		type(llink), pointer :: nextlink, link
			nextlink => link%next
	end function nextlink

	subroutine showpoint(link)
		implicit none
		type(llink) :: link
		write(6, '(1x,l5,i5,3f15.5)') link%visible, link%magnitude, &
			link%point%x, link%point%y, link%point%z
	end subroutine showpoint

! _X(must return the allocated space as a pointer, else it)
! _X(disappears at routine end.)
	function addpoint(pt, vis, mag)
		implicit none
		type(llink), pointer :: addpoint, link
		type(vector3d), intent(in) ::	pt
		logical, intent(in) ::		vis
		integer, intent(in) ::		mag

		allocate(addpoint)
		addpoint%point%x = pt%x
		addpoint%point%y = pt%y
		addpoint%point%z = pt%z
		addpoint%visible = vis
		addpoint%magnitude = mag
		nullify(addpoint%next)
	end function addpoint

end module listlink

program tllink
	use vector3
	use listlink
	implicit none

	type(llink), pointer :: head
	type(llink), pointer :: ptr, tmp
	type(vector3d), dimension(8) :: cube = (/ &
		vector3d( .5, .5, .5), &
		vector3d( .5, .5,-.5), &
		vector3d( .5,-.5, .5), &
		vector3d( .5,-.5,-.5), &
		vector3d(-.5, .5, .5), &
		vector3d(-.5, .5,-.5), &
		vector3d(-.5,-.5, .5), &
		vector3d(-.5,-.5,-.5) /)
	integer :: i

! _X(Nullify pointers to clear them - else ...)
	nullify(head)
	nullify(ptr)

! set up linked list
	head => addpoint(pt=cube(1), vis=.TRUE.,mag=9)
	ptr => head
	write (6,'(1x,"adding ")', advance='NO')
! _X(Note that at no time we use the internal)
! _X(structure, and confine all accesses to the)
! _X(provided ``methods'')
	do i=2, size(cube)
		write (6,'(i3)', advance='NO') i
		tmp => addpoint(pt=cube(i), vis=.TRUE., mag=9-i)
		call setnext(link=ptr,next=tmp)
		ptr => nextlink(ptr)
	end do

! print out linked list
	write (6,'(/,1x,"viewing - ")')
	ptr => head
	i = 0
	do
		i = i + 1
		if (.not. associated(ptr)) exit
		write (6,'(i3," : ")', advance='NO') i
		call showpoint(ptr)
		ptr => nextlink(ptr)
	enddo

! deallocate list (clean-up)
	write (6,'(1x,"deallocating ")', advance='NO')
	ptr => head
	i = 0
	do
		i = i + 1
		if (.not. associated(ptr)) exit
		write (6,'(i3)', advance='NO') i
		tmp => ptr
		ptr => nextlink(ptr)
		deallocate(tmp)
	enddo
	write(6,'(/,1x,"End of Program")')
		
end program tllink
