!******************************************************************************
!*       This is a part of the Compaq Visual Fortran Source Code Samples.
!******************************************************************************

use twaveinc
use dfopngl

interface
integer(4) function Args (argc)
!DEC$ ATTRIBUTES VALUE :: argc
integer(4)  argc
end function Args

subroutine ReshapeFunction(width, height)
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_ReshapeFunction@8' :: ReshapeFunction
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'ReshapeFunction' :: ReshapeFunction
!DEC$ ENDIF
integer(4)  width, height
end subroutine ReshapeFunction

subroutine Animate()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Animate@0' :: Animate
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Animate' :: Animate
!DEC$ ENDIF
end subroutine Animate

subroutine Key_c()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_c@0' :: Key_c
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_c' :: Key_c
!DEC$ ENDIF
end subroutine Key_c

subroutine Key_s()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_s@0' :: Key_s
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_s' :: Key_s
!DEC$ ENDIF
end subroutine Key_s

subroutine Key_l()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_l@0' :: Key_l
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_l' :: Key_l
!DEC$ ENDIF
end subroutine Key_l

subroutine Key_d()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_d@0' :: Key_d
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_d' :: Key_d
!DEC$ ENDIF
end subroutine Key_d

subroutine Key_SPACE()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_SPACE@0' :: Key_SPACE
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_SPACE' :: Key_SPACE
!DEC$ ENDIF
end subroutine Key_SPACE

subroutine Key_n()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_n@0' :: Key_n
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_n' :: Key_n
!DEC$ ENDIF
end subroutine Key_n

subroutine Key_a()
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_Key_a@0' :: Key_a
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'Key_a' :: Key_a
!DEC$ ENDIF
end subroutine Key_a

end interface

integer(4)  type
integer(4)  argc


    ! Doing all global variable initializations here.

    clearmask = IOR(GL_COLOR_BUFFER_BIT , GL_DEPTH_BUFFER_BIT)

    smooth = GL_TRUE
    lighting = GL_FALSE
    depth = GL_TRUE
    stepMode = GL_FALSE
    spinMode = GL_FALSE
    contouring = 0
    curFrame = 0
    nextFrame = 0

    do i = 1,12
        contourTexture1(i) = 255
    end do

    do i = 13,16
        contourTexture1(i) = 127
    end do

    do i = 1,4
        contourTexture2(i) = 255
    end do
    do i = 5,13,4
        contourTexture2(i) = 255
    end do
    do i = 6,8
        contourTexture2(i) = 127
    end do
    do i = 10,12
        contourTexture2(i) = 127
    end do
    do i = 14,16
        contourTexture2(i) = 127
    end do

    argc = nargs()

    if (Args(argc) == GL_FALSE) then
      call fauxQuit()
    end if

    call fauxInitPosition(0, 0, 300, 300)

    type = AUX_DEPTH16

    if (rgbValue) then
      type = IOR(type, AUX_RGB)
    else
      type = IOR(type, AUX_INDEX)
    end if

    if (doublebuffer) then
      type = IOR(type, AUX_DOUBLE)
    else
      type = IOR(type, AUX_SINGLE)
    end if

    call fauxInitDisplayMode(type)
    if (fauxInitWindow("Wave Demo"C) == GL_FALSE) then
      call fauxQuit()
    end if

    call Init()

    call fauxExposeFunc(LOC(ReshapeFunction))
    call fauxReshapeFunc(LOC(ReshapeFunction))
    call fauxKeyFunc(INT(AUX_c), LOC(Key_c))
    call fauxKeyFunc(AUX_s, LOC(Key_s))
    call fauxKeyFunc(AUX_l, LOC(Key_l))
    call fauxKeyFunc(AUX_d, LOC(Key_d))
    call fauxKeyFunc(AUX_SPACE, LOC(Key_SPACE))
    call fauxKeyFunc(AUX_n, LOC(Key_n))
    call fauxKeyFunc(AUX_a, LOC(Key_a))
    call fauxIdleFunc(LOC(Animate))
    call fauxMainLoop(0)
end


integer(4) function GETFACET (frame, x, y)
!DEC$ ATTRIBUTES VALUE :: frame
!DEC$ ATTRIBUTES VALUE :: x
!DEC$ ATTRIBUTES VALUE :: y
use twaveinc
integer(4)  frame, x, y
integer(4)  i
    i = frame*theMesh%numFacets+(x)+(y*theMesh%widthX)
    GETFACET = theMesh%facets + i * 24

    return
end

