products/sources/formale Sprachen/Fortran/f90gl-1.2.15/examples/  image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: olympic3.f90   Sprache: Fortran

Untersuchung f90gl©
! This variant of olympic allows command line arguments.  Handling command line
! arguments in Fortran is a nonstandard extension that is done differently
! by different compilers.  This routine uses the form that SGI uses.  It can
! be used with other compilers that use the same convention, or can be
! modified for other conventions.

module olympic_mod
use opengl_gl
use opengl_glu
use opengl_glut

integer, parameter :: &
   XSIZE      = 100, &
   YSIZE      = 75, &
   RINGS      = 5, &
   BLUERING   = 0, &
   BLACKRING  = 1, &
   REDRING    = 2, &
   YELLOWRING = 3, &
   GREENRING  = 4, &
   BLACK      = 0, &
   RED        = 1, &
   GREEN      = 2, &
   YELLOW     = 3, &
   BLUE       = 4, &
   MAGENTA    = 5, &
   CYAN       = 6, &
   WHITE      = 7

real(glfloat), parameter :: BACKGROUND = 8.

integer, parameter :: double = kind(0.0d0)

real, parameter :: M_PI = 3.141592654

integer(glenum) rgb, doubleBuffer, directRender

integer(glubyte) rgb_colors(0:RINGS-1,0:2)
integer(glint) mapped_colors(0:RINGS-1)
real(glfloat) dests(0:RINGS-1,0:2)
real(glfloat) offsets(0:RINGS-1,0:2)
real(glfloat) angs(0:RINGS-1)
real(glfloat) rotAxis(0:RINGS-1,0:2)
integer iters(0:RINGS-1)
integer(gluint) theTorus

contains

subroutine FillTorus(rc, numc, rt, numt)
real, intent(in) :: rc, rt
integer, intent(in) :: numc, numt

  integer :: i, j, k
  real :: s, t
  real(glfloat) x, y, z
  real pi, twopi

  pi = M_PI
  twopi = 2 * pi

  do i = 0, numc-1
    call glBegin(GL_QUAD_STRIP)
    do j = 0, numt
      do k = 1, 0, -1
        s = mod((i + k), numc) + 0.5
        t = mod(j, numt)

        x = cos(t * twopi / numt) * cos(s * twopi / numc)
        y = sin(t * twopi / numt) * cos(s * twopi / numc)
        z = sin(s * twopi / numc)
        call glNormal3f(x, y, z)

        x = (rt + rc * cos(s * twopi / numc)) * cos(t * twopi / numt)
        y = (rt + rc * cos(s * twopi / numc)) * sin(t * twopi / numt)
        z = rc * sin(s * twopi / numc)
        call glVertex3f(x, y, z)
      end do
    end do
    call glEnd()
  end do
return
end subroutine filltorus

function Clamp(iters_left,t)
real :: clamp
integer, intent(in) :: iters_left
real, intent(in) :: t

  if (iters_left < 3) then
    clamp = 0.0
  else
    clamp = (iters_left - 2) * t / iters_left
  endif
return
end function clamp

function MyRand()
real :: myrand
real :: rval

  call random_number(rval)
  myrand = 10.0 * (rval - 0.5)

return
end function myrand

subroutine ReInit()

  integer :: i
  real :: deviation

  deviation = MyRand() / 2
  deviation = deviation * deviation
  do i = 0, RINGS-1
    offsets(i,0) = MyRand()
    offsets(i,1) = MyRand()
    offsets(i,2) = MyRand()
    angs(i) = 260.0 * MyRand()
    rotAxis(i,0) = MyRand()
    rotAxis(i,1) = MyRand()
    rotAxis(i,2) = MyRand()
    iters(i) = (deviation * MyRand() + 60.0)
  end do

return
end subroutine reinit

subroutine Init()

  real(glfloat) :: top_y = 1.0
  real(glfloat) :: bottom_y = 0.0
  real(glfloat) :: top_z = 0.15
  real(glfloat) :: bottom_z = 0.69
  real(glfloat) :: spacing = 2.5
  real(glfloat), save :: lmodel_ambient(4) = (/0.0, 0.0, 0.0, 0.0/)
  real(glfloat), save :: lmodel_twoside(1) = (/GL_FALSE/)
  real(glfloat), save :: lmodel_local(1) = (/GL_FALSE/)
  real(glfloat), save :: light0_ambient(4) = (/0.1, 0.1, 0.1, 1.0/)
  real(glfloat), save :: light0_diffuse(4) = (/1.0, 1.0, 1.0, 0.0/)
  real(glfloat), save :: light0_position(4) = (/0.8660254, 0.5, 1.0, 0.0/)
  real(glfloat), save :: light0_specular(4) = (/1.0, 1.0, 1.0, 0.0/)
  real(glfloat), save :: bevel_mat_ambient(4) = (/0.0, 0.0, 0.0, 1.0/)
  real(glfloat), save :: bevel_mat_shininess(1) = (/40.0/)
  real(glfloat), save :: bevel_mat_specular(4) = (/1.0, 1.0, 1.0, 0.0/)
  real(glfloat), save :: bevel_mat_diffuse(4) = (/1.0, 0.0, 0.0, 0.0/)

  call random_seed()
  call ReInit()
  rgb_colors = 0
  rgb_colors(BLUERING,2) = ibset(127,7)
  rgb_colors(REDRING,0) = ibset(127,7)
  rgb_colors(GREENRING,1) = ibset(127,7)
  rgb_colors(YELLOWRING,0) = ibset(127,7)
  rgb_colors(YELLOWRING,1) = ibset(127,7)
  mapped_colors(BLUERING) = BLUE
  mapped_colors(REDRING) = RED
  mapped_colors(GREENRING) = GREEN
  mapped_colors(YELLOWRING) = YELLOW
  mapped_colors(BLACKRING) = BLACK

  dests(BLUERING,:) = (/-spacing, top_y, top_z/)
  dests(BLACKRING,:) = (/0.0, top_y, top_z/)
  dests(REDRING,:) = (/spacing, top_y, top_z/)
  dests(YELLOWRING,:) = (/-spacing / 2.0, bottom_y, bottom_z/)
  dests(GREENRING,:) = (/spacing / 2.0, bottom_y, bottom_z/)

  theTorus = glGenLists(1)
  call glNewList(theTorus, GL_COMPILE)
  call FillTorus(0.1, 8, 1.0, 25)
  call glEndList()

  call glEnable(GL_CULL_FACE)
  call glCullFace(GL_BACK)
  call glEnable(GL_DEPTH_TEST)
  call glClearDepth(1.0_glclampd)

  if (rgb == GL_TRUE) then
    call glClearColor(0.5_glclampf, 0.5_glclampf, 0.5_glclampf, 0.0_glclampf)
    call glLightfv(GL_LIGHT0, GL_AMBIENT, light0_ambient)
    call glLightfv(GL_LIGHT0, GL_DIFFUSE, light0_diffuse)
    call glLightfv(GL_LIGHT0, GL_SPECULAR, light0_specular)
    call glLightfv(GL_LIGHT0, GL_POSITION, light0_position)
    call glEnable(GL_LIGHT0)

    call glLightModelfv(GL_LIGHT_MODEL_LOCAL_VIEWER, lmodel_local)
    call glLightModelfv(GL_LIGHT_MODEL_TWO_SIDE, lmodel_twoside)
    call glLightModelfv(GL_LIGHT_MODEL_AMBIENT, lmodel_ambient)
    call glEnable(GL_LIGHTING)

    call glMaterialfv(GL_FRONT, GL_AMBIENT, bevel_mat_ambient)
    call glMaterialfv(GL_FRONT, GL_SHININESS, bevel_mat_shininess)
    call glMaterialfv(GL_FRONT, GL_SPECULAR, bevel_mat_specular)
    call glMaterialfv(GL_FRONT, GL_DIFFUSE, bevel_mat_diffuse)

    call glColorMaterial(GL_FRONT_AND_BACK, GL_DIFFUSE)
    call glEnable(GL_COLOR_MATERIAL)
    call glShadeModel(GL_SMOOTH)
  else
    call glClearIndex(BACKGROUND)
    call glShadeModel(GL_FLAT)
  endif

  call glMatrixMode(GL_PROJECTION)
  call gluPerspective(45._gldouble, 1.33_gldouble, 0.1_gldouble, 100.0_gldouble)
  call glMatrixMode(GL_MODELVIEW)

return
end subroutine init

end module olympic_mod

subroutine Idle()
use olympic_mod

  integer :: i, j
  integer(glenum) :: more = GL_FALSE

  do i = 0, RINGS-1
    if (iters(i) /= 0) then
      do j = 0, 2
        offsets(i,j) = Clamp(iters(i), offsets(i,j))
      end do
      angs(i) = Clamp(iters(i), angs(i))
      iters(i) = iters(i) - 1
      more = GL_TRUE
    end if
  end do
  if (more == GL_TRUE) then
    call glutPostRedisplay()
  else
    call glutIdleFunc(glutnullfunc)
  endif

return
end subroutine idle

subroutine Reshape(width,height)
use olympic_mod
integer(glcint) width, height

! if glcint is not the same as glsizei, width and height will
! need to be copied to variables of the later kind

  call glViewport(0_glint, 0_glint, width, height)

return
end subroutine reshape

subroutine Key(ikey, x, y)
use olympic_mod
integer(glcint) ikey, x, y
interface
  subroutine idle()
  end subroutine idle
end interface

  select case(ikey)
  case (27) ! esc
    stop
  case (iachar(' '))
    call ReInit()
    call glutIdleFunc(Idle)
  end select

return
end subroutine key

subroutine visible(vis)
use olympic_mod
integer(glcint) vis
interface
  subroutine idle()
  end subroutine idle
end interface

  if (vis == GLUT_VISIBLE) then
    call glutIdleFunc(Idle)
  else
    call glutIdleFunc(glutnullfunc)
  endif

return
end subroutine visible

subroutine DrawScene()
use olympic_mod

  integer :: i

  call glPushMatrix()

  call glClear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT))
  call gluLookAt(0._gldouble, 0._gldouble, 10._gldouble, &
                    0._gldouble, 0._gldouble, 0._gldouble, &
                    0._gldouble, 1._gldouble, 0._gldouble)

  do i = 0, RINGS-1
    if (rgb == GL_TRUE) then
      call glColor3ubv(rgb_colors(i,:))
    else
      call glIndexi(mapped_colors(i))
    endif
    call glPushMatrix()
    call glTranslatef(dests(i,0) + offsets(i,0), dests(i,1) + offsets(i,1), &
      dests(i,2) + offsets(i,2))
    call glRotatef(angs(i), rotAxis(i,0), rotAxis(i,1), rotAxis(i,2))
    call glCallList(theTorus)
    call glPopMatrix()
  end do

  call glPopMatrix()
  if (doubleBuffer == GL_TRUE) then
    call glutSwapBuffers()
  else
    call glFlush()
  endif
return
end subroutine drawscene

program main

  use olympic_mod

  integer(glenum) :: type
  integer :: i
  interface
    subroutine Reshape(width,height)
    use olympic_mod
    integer(glcint), intent(inout):: width, height
    end subroutine reshape

    subroutine Key(ikey, x, y)
    use olympic_mod
    integer(glcint), intent(inout):: ikey, x, y
    end subroutine key

    subroutine visible(vis)
    use olympic_mod
    integer(glcint), intent(inout):: vis
    end subroutine visible

    subroutine drawscene
    end subroutine drawscene
  end interface

! declarations for command line arguments
  integer(kind=glcint) :: num_arg
  character(len=32), allocatable, dimension(:) :: args
  integer, external :: iargc

  call glutInitWindowSize(400_glcint, 300_glcint)

  rgb = GL_TRUE
  doubleBuffer = GL_TRUE
  num_arg = iargc()+1
  allocate(args(num_arg))
  args(1) = "olympic"
  do i=2,num_arg
    call getarg(i-1,args(i))
    if (args(i) == "-ci") then
      rgb = GL_FALSE
    else if (args(i) == "-rgb") then
      rgb = GL_TRUE
    else if (args(i) == "-sb") then
      doubleBuffer = GL_FALSE
    else if (args(i) == "-db") then
      doubleBuffer = GL_TRUE
    end if
  end do
  call glutinit(num_arg,args)

  if (rgb == GL_TRUE) then
     type = GLUT_RGB
  else
     type = GLUT_INDEX
  endif

  if (doubleBuffer == GL_TRUE) then
     type = ior(type,GLUT_DOUBLE)
  else
     type = ior(type,GLUT_SINGLE)
  endif
  call glutInitDisplayMode(type)

  i = glutCreateWindow("Olympic")

  call Init()

  call glutReshapeFunc(Reshape)
  call glutKeyboardFunc(Key)
  call glutDisplayFunc(DrawScene)

  call glutVisibilityFunc(visible)

  call glutMainLoop()

end program main

¤ Diese beiden folgenden Angebotsgruppen bietet das Unternehmen0.7Angebot  Wie Sie bei der Firma Beratungs- und Dienstleistungen beauftragen können  ¤



Druckansicht
unsichere Verbindung
Druckansicht
Hier finden Sie eine Liste der Produkte des Unternehmens

Mittel




Lebenszyklus

Die hierunter aufgelisteten Ziele sind für diese Firma wichtig


Ziele

Entwicklung einer Software für die statische Quellcodeanalyse


Bot Zugriff