!******************************************************************************
!*       This is a part of the Compaq Visual Fortran Source Code Samples.
!******************************************************************************
subroutine Animate()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Animate@0' :: Animate
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Animate' :: Animate
!DEC$ ENDIF
use twaveinc
use dfwin
use dfopngl
interface

integer(4) function GETFACET (frame, x, y)
!DEC$ ATTRIBUTES VALUE :: frame
!DEC$ ATTRIBUTES VALUE :: x
!DEC$ ATTRIBUTES VALUE :: y
integer(4)  frame, x, y
end function GETFACET

integer(4) function GETCOORD (frame, x, y)
!DEC$ ATTRIBUTES VALUE :: frame
!DEC$ ATTRIBUTES VALUE :: x
!DEC$ ATTRIBUTES VALUE :: y
integer(4)  frame, x, y
end function GETCOORD

end interface



    integer(4)  pcoord     ! pointer to coord structure
    integer(4)  pfacet     ! pointer to facet structure
    integer(4)  lastColor    ! pointer to real number
    integer(4)  thisColor    ! pointer to real number
    type(coord) coord1
    type(facet) facet1
    integer(4)  i, j
    integer(4)  tc0, lc0

    call fglClear(clearMask)

    if (nextFrame .OR. NOT(stepMode)) then
        curFrame = curFrame + 1
    end if

    if (curFrame >= theMesh%frames) then
        curFrame = 0
    end if

    if ((nextFrame .OR. NOT(stepMode)) .AND. spinMode) then
        call fglRotatef(5.0, 0.0, 0.0, 1.0)
    end if
    nextFrame = 0

    do i = 0, theMesh%widthX - 1
      call fglBegin(GL_QUAD_STRIP)
      lastColor = 0
      do j = 0, theMesh%widthY - 1
         pfacet = GETFACET(curFrame, i, j)
         call CopyMemory (LOC(facet1), pfacet, 24)
         if (NOT(smooth) .AND. lighting) then
                call fglNormal3fv(LOC(facet1%normal))
                end if
                if (lighting) then
                if (rgbValue) then
                        thisColor = LOC(facet1%color)
                        call fglColor3fv(LOC(facet1%color))
                else
                        thisColor = LOC(facet1%color)
                        call fglMaterialfv(GL_FRONT_AND_BACK, GL_COLOR_INDEXES, LOC(facet1%color))
                end if
                else
                if (rgbValue) then
                        thisColor = LOC(facet1%color)
                        call fglColor3fv(LOC(facet1%color))
                else
                        thisColor = LOC(facet1%color)
                        call CopyMemory (LOC(c1), pfacet+4, 4)
                        call fglIndexf(c1)
                end if
                end if
                call CopyMemory (LOC(tc0), thiscolor, 4)
                if (lastcolor) then
                    call CopyMemory (LOC(lc0), lastcolor, 4)
                else
                    lc0 = 0
                end if

                if (NOT(lastColor) .OR. (tc0 .NE. lc0 .AND. smooth)) then
                if (lastColor) then
                        call fglEnd()
                        call fglBegin(GL_QUAD_STRIP)
                end if
                pcoord = GETCOORD(curFrame, i, j)
                call CopyMemory (LOC(coord1), pcoord, 24)
                if (smooth .AND. lighting) then
                        call fglNormal3fv(LOC(coord1%normal))
                end if

                call fglVertex3fv(LOC(coord1%vertex))

                pcoord = GETCOORD(curFrame, i+1, j)
                call CopyMemory (LOC(coord1), pcoord, 24)
                if (smooth .AND. lighting) then
                        call fglNormal3fv(LOC(coord1%normal))
                end if

                call fglVertex3fv(LOC(coord1%vertex))
                end if

                pcoord = GETCOORD(curFrame, i, j+1)
                call CopyMemory (LOC(coord1), pcoord, 24)
                if (smooth .AND. lighting) then
                call fglNormal3fv(LOC(coord1%normal))
                end if
                call fglVertex3fv(LOC(coord1%vertex))

                pcoord = GETCOORD(curFrame, i+1, j+1)
                call CopyMemory (LOC(coord1), pcoord, 24)
                if (smooth .AND. lighting) then
                call fglNormal3fv(LOC(coord1%normal))
                end if
                call fglVertex3fv(LOC(coord1%vertex))

                lastColor = thisColor
        end do
        call fglEnd()
    end do

    call fglFlush()
    if (doubleBuffer) then
        call fauxSwapBuffers()
    end if
end

subroutine SetColorMap()
use twaveinc
use dfopngl
use dfwin
    real(4) green(3)
    real(4) red(3)
    integer(4) color        ! pointer to real number
    real(4) percent
    integer(4) indexes
    integer(4) entries, i, j
    integer(4)  i0, i1, i2
    real(4)     c0, c1, c2

    save green, red
    data green /0.2, 1.0, 0.2/ , red /1.0, 0.2, 0.2/

    entries = fauxGetColorMapSize()

    colorIndexes1(1) = 1
    colorIndexes1(2) = 1 + INT((entries - 1) * 0.3)
    colorIndexes1(3) = INT((entries - 1) * 0.5)
    colorIndexes2(1) = 1 + INT((entries - 1) * 0.5)
    colorIndexes2(2) = 1 + INT((entries - 1) * 0.8)
    colorIndexes2(3) = entries - 1

    do i = 0, 1
         select case (i)
            case (0)
               color = LOC(green)
               indexes = LOC(colorIndexes1)
            case (1)
               color = LOC(red)
               indexes = LOC(colorIndexes2)
         end select

         call CopyMemory(LOC(i0), LOC(indexes), 4)
         call CopyMemory(LOC(i1), LOC(indexes+4), 4)
         call CopyMemory(LOC(i2), LOC(indexes+8), 4)
         call CopyMemory(LOC(c0), LOC(color), 4)
         call CopyMemory(LOC(c1), LOC(color+4), 4)
         call CopyMemory(LOC(c2), LOC(color+8), 4)

         do j = i0, i1 -1
            percent = 0.2 + 0.8 * (j - i0) / REAL(i1 - i0)
            call fauxSetOneColor(j, percent*c0, percent*c1, percent*c2)
         end do

         call CopyMemory(LOC(i2), LOC(indexes+8), 4)
         do j = i1, i2
            percent = (j - i1) / REAL(i2 - i1)
            call fauxSetOneColor(j, percent*(1-c0)+c0,  &
                     percent*(1-c1)+c1,                 &
                     percent*(1-c2)+c2)
         end do
    end do
end


