Quelle logo.f90 Sprache: Fortran

module logo_mod

use opengl_gl
use opengl_glu
use opengl_glut
implicit none
private

private :: make_letter, recalcModelView, number, animate
public :: redraw, mouse, motion, freshape, controlLights, draw_logo

type, private :: coord
   real(kind=glfloat) :: x,y
end type coord

type(coord), private, save :: angle = coord(0.0,0.0) ! in degrees
type(coord), private :: begin
logical, private :: moving
logical, private, save :: newModel = .true.
logical, private, save :: show_colorbars = .false.
real(kind=glfloat), private, dimension(4), save :: &
        lightZeroPosition = (/10.0, 4.0, 10.0, 1.0/), &
        lightZeroColor = (/1.0, 1.0, 1.0, 1.0/), &
        lightOnePosition = (/-1.0, -2.0, 1.0, 0.0/), &
        lightOneColor = (/0.5, 0.5, 0.5, 1.0/), &
        logocolor = (/1.0, 0.72, 0.0, 1.0/)

logical, private, save :: lightZeroSwitch = .true., lightOneSwitch = .false.
integer(kind=glint), private, parameter :: thelist = 20
real (kind=glfloat), private, parameter :: PI = 3.1415926
integer(kind=glint), private :: window_width, window_height

contains

subroutine make_letter(centers,radii)
type (coord), dimension(:), intent(in) :: centers
real (kind=glfloat), dimension(:), intent(in) :: radii
integer, parameter :: npoints_around_circle = 10
integer :: npoints
real (kind=glfloat) :: x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,alpha
type (coord) :: center1, center2
real (kind=glfloat), dimension(size(radii)) :: orient
real (kind=glfloat) :: radius1, radius2, orient1, orient2
integer :: point, i

npoints = size(radii)

do point=1,npoints
   center1 = centers(max(1,point-1))
   center2 = centers(min(npoints,point+1))
   if (center1%x==center2%x .and. center1%y==center2%y) then
      orient(point) = 0.0
   else
      orient(point) = atan2(center2%y-center1%y,center1%x-center2%x)
   end if
end do

call glbegin(GL_QUADS)

do point=1,npoints-1
   center1 = centers(point)
   center2 = centers(point+1)
   radius1 = radii(point)
   radius2 = radii(point+1)
   orient1 = orient(point)
   orient2 = orient(point+1)
   x3 = radius2*sin(orient2)+center2%x
   y3 = radius2*cos(orient2)+center2%y
   z3 = 0.0_glfloat
   x4 = radius1*sin(orient1)+center1%x
   y4 = radius1*cos(orient1)+center1%y
   z4 = 0.0_glfloat
   do i=1,npoints_around_circle
      alpha = 2.0_glfloat * PI * i / real(npoints_around_circle,glfloat)
      x1 = x4
      y1 = y4
      z1 = z4
      x2 = x3
      y2 = y3
      z2 = z3
      x3 = radius2*sin(orient2)*cos(alpha)+center2%x
      y3 = radius2*cos(orient2)*cos(alpha)+center2%y
      z3 = radius2*sin(alpha)
      x4 = radius1*sin(orient1)*cos(alpha)+center1%x
      y4 = radius1*cos(orient1)*cos(alpha)+center1%y
      z4 = radius1*sin(alpha)
      call glnormal3f(x1-center1%x,y1-center1%y,z1)
      call glvertex3f(x1,y1,z1)
      call glnormal3f(x2-center2%x,y2-center2%y,z2)
      call glvertex3f(x2,y2,z2)
      call glnormal3f(x3-center2%x,y3-center2%y,z3)
      call glvertex3f(x3,y3,z3)
      call glnormal3f(x4-center1%x,y4-center1%y,z4)
      call glvertex3f(x4,y4,z4)
   end do
end do

call glend()

return
end subroutine make_letter

subroutine recalcModelView()

  call glpopmatrix()
  call glpushmatrix()
  call gltranslatef(2.5_glfloat,0.0_glfloat,0.0_glfloat)
  call glrotatef(angle%x, 0.0, 0.0, 1.0)
  call glrotatef(angle%y, cos(PI*angle%x/180.0), -sin(PI*angle%x/180.0),0.0)
  call gltranslatef(-2.5_glfloat,0.0_glfloat,0.0_glfloat)
  newModel = .false.
  return
end subroutine recalcModelView

!          ------
subroutine number(n,x,y)
!          ------
integer, intent(in) :: n
real(kind=gldouble), intent(in) :: x,y

character(len=4) :: chn
integer :: i

write(unit=chn,fmt="(i4)") n
call glmatrixmode(GL_MODELVIEW)
call glpushmatrix()
call gltranslated(x,y,0.0_gldouble)
do i=1,4
   call glutbitmapcharacter(GLUT_BITMAP_8_BY_13,ichar(chn(i:i)))
end do
call glpopmatrix()

return
end subroutine number

subroutine redraw()

  if (newModel) then
    call recalcModelView()
  end if
  call glclear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT))
  call glcalllist(thelist)
  call glutswapbuffers()
  return
end subroutine redraw

subroutine mouse(button, state, x, y)
integer(kind=glcint), intent(in out) :: button, state, x, y
real :: value,xfract,yfract

  if (button == GLUT_LEFT_BUTTON .and. state == GLUT_DOWN) then
    moving = .true.
    begin = coord(x,y)
  end if
  if (button == GLUT_LEFT_BUTTON .and. state == GLUT_UP) then
    moving = .false.
  end if
  if (button == GLUT_MIDDLE_BUTTON .and. state == GLUT_DOWN) then
    xfract = real(x)/real(window_width)
    yfract = real(y)/real(window_height)
    value = (xfract-0.1)*2.0
    if (value >= 0.0 .and. value <= 1.0) then
       if (yfract > 0.05 .and. yfract < 0.10) then
          logocolor(1) = value
       else if (yfract > 0.15 .and. yfract < 0.20) then
          logocolor(2) = value
       else if (yfract > 0.25 .and. yfract < 0.30) then
          logocolor(3) = value
       end if
!       print *,logocolor
       call draw_logo()
       call glutpostredisplay()
    end if
  end if

  return
end subroutine mouse

subroutine motion(x, y)
integer(kind=glcint), intent(in out) :: x, y

  if (moving) then
    angle%x = angle%x + (x - begin%x)
    angle%y = angle%y + (y - begin%y)
    begin = coord(x,y)
    newModel = .true.
    call glutpostredisplay()
  end if
  return
end subroutine motion

subroutine freshape(w,h)
integer(kind=glcint), intent(in out) :: w,h
window_width = w
window_height = h
call glviewport(0,0,w,h)
return
end subroutine freshape

subroutine controlLights(value)
integer(kind=glcint), intent(in out) :: value

  select case (value)
  case (1)
    lightZeroSwitch = .not. lightZeroSwitch
    if (lightZeroSwitch) then
      call glenable(GL_LIGHT0)
    else
      call gldisable(GL_LIGHT0)
    end if
  case (2)
    lightOneSwitch = .not. lightOneSwitch
    if (lightOneSwitch) then
      call glenable(GL_LIGHT1)
    else
      call gldisable(GL_LIGHT1)
    end if
  case (3)
    show_colorbars = .not. show_colorbars
  case (4)
    call animate()
  end select
  call draw_logo()
  call glutpostredisplay()
  return
end subroutine controlLights

subroutine animate()
real(kind=glfloat) :: transx,transy,transz,angx,angy
integer :: nstep,i

nstep = 19
do i=0,nstep

  transx = -6.0*(nstep-i)/real(nstep) + 2.5
  transy = -4.0*(nstep-i)/real(nstep)
  transz = -160.0*(nstep-i)/real(nstep)
  angx = -10.0 -80.0*(nstep-i)/real(nstep)
  angy = -50.0 + 320.0*(nstep-i)/real(nstep)
  call glpopmatrix()
  call glpushmatrix()
  call gltranslatef(transx,transy,transz)
  call glrotatef(angx, 0.0, 0.0, 1.0)
  call glrotatef(angy, cos(PI*angx/180.0), -sin(PI*angx/180.0),0.0)
  call gltranslatef(-transx,0.0,0.0)
  call glclear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT))
  call glcalllist(thelist)
  call glutswapbuffers()

end do
return
end subroutine animate

subroutine draw_logo()
type (coord),allocatable,dimension(:) :: centers
real (kind=glfloat),allocatable,dimension(:) :: radii
real (kind=glfloat) :: x, alpha
integer :: int_color, i

  x = 247.0/255.0
!  x = 0.
  call glclearcolor(x,x,x,1.0)
  call gldeletelists(thelist,1_glsizei)
  call glnewlist(thelist,GL_COMPILE)

! color bars

  if (show_colorbars) then
    call gldisable(GL_LIGHTING)
    call glmatrixmode(GL_MODELVIEW)
    call glpushmatrix()
    call glloadidentity()
    call glmatrixmode(GL_PROJECTION)
    call glpushmatrix()
    call glloadidentity()
    call glortho(0.0_gldouble,1.0_gldouble,0.0_gldouble,1.0_gldouble,-1.0_gldouble,1.0_gldouble)
    call glcolor3f(1.0_glfloat,0.0_glfloat,0.0_glfloat)
    call glrectf(0.1_glfloat,0.9_glfloat,0.1_glfloat+0.5_glfloat*logocolor(1),0.95_glfloat)
    call glcolor3f(0.0_glfloat,1.0_glfloat,0.0_glfloat)
    call glrectf(0.1_glfloat,0.8_glfloat,0.1_glfloat+0.5_glfloat*logocolor(2),0.85_glfloat)
    call glcolor3f(0.0_glfloat,0.0_glfloat,1.0_glfloat)
    call glrectf(0.1_glfloat,0.7_glfloat,0.1_glfloat+0.5_glfloat*logocolor(3),0.75_glfloat)
    call glcolor3f(1.0_glfloat,1.0_glfloat,1.0_glfloat)
    call glrectf(0.1_glfloat,0.9_glfloat,0.6_glfloat,0.95_glfloat)
    call glrectf(0.1_glfloat,0.8_glfloat,0.6_glfloat,0.85_glfloat)
    call glrectf(0.1_glfloat,0.7_glfloat,0.6_glfloat,0.75_glfloat)
!    int_color = int(logocolor(1)*256)
!    call number(int_color,.7_gldouble,.9_gldouble)
!    int_color = int(logocolor(2)*256)
!    call number(int_color,.7_gldouble,.8_gldouble)
!    int_color = int(logocolor(3)*256)
!    call number(int_color,.7_gldouble,.7_gldouble)
    call glmatrixmode(GL_PROJECTION)
    call glpopmatrix()
    call glmatrixmode(GL_MODELVIEW)
    call glpopmatrix()
  end if

  call gllightmodelfv(GL_LIGHT_MODEL_AMBIENT, (/0.25,0.25,0.25,1.0/))
  call gllightfv(GL_LIGHT0, GL_POSITION, lightZeroPosition)
  call gllightfv(GL_LIGHT0, GL_DIFFUSE, lightZeroColor)
  call gllightfv(GL_LIGHT0, GL_SPECULAR, lightZeroColor)
  call gllightfv(GL_LIGHT1, GL_POSITION, lightOnePosition)
  call gllightfv(GL_LIGHT1, GL_DIFFUSE, lightOneColor)
  if (lightZeroSwitch) then
    call glenable(GL_LIGHT0)
  else
    call gldisable(GL_LIGHT0)
  end if
  if (lightOneSwitch) then
    call glenable(GL_LIGHT1)
  else
    call gldisable(GL_LIGHT1)
  end if
  call glenable(GL_LIGHTING)
  call glpolygonmode(GL_FRONT_AND_BACK, GL_FILL)
! curve of f
  allocate(centers(41),radii(41))
  call glpushmatrix()
  call glrotatef(25.0_glfloat,0.0_glfloat,0.0_glfloat,1.0_glfloat)
  do i=1,41
     x = (i-21)/20.0_glfloat
     centers(i)%x = x
     centers(i)%y = -x*(x-1.3)*(x+1.3)
     if (x<=-0.5) then
        radii(i) = 0.2*x+0.2
     else if (x>=0.5) then
        radii(i) = 0.2-0.2*x
     else
        radii(i) = 0.1_glfloat
     end if
  end do
  call glmaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, logocolor)
  call glmaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, logocolor)
  call glmaterialf(GL_FRONT_AND_BACK, GL_SHININESS, 128.0_glfloat)
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)
! crossbar of f
  allocate(centers(4),radii(4))
  centers(1) = coord(-0.4,0.0)
  centers(2) = coord(-0.4,0.0)
  centers(3) = coord(0.4,0.0)
  centers(4) = coord(0.4,0.0)
  radii(1) = 0.0
  radii(2) = 0.1
  radii(3) = 0.1
  radii(4) = 0.0
  call make_letter(centers,radii)
  deallocate(centers,radii)
! left part of 9
  allocate(centers(28),radii(28))
  call glpushmatrix()
  call gltranslatef(1.0_glfloat,0.0_glfloat,0.0_glfloat)
  call glrotatef(10.0_glfloat,0.0_glfloat,0.0_glfloat,-1.0_glfloat)
  do i=1,28
     alpha = (i-6)*PI/20.0 + PI/2.0 + PI/10.0
     centers(i)%x = 0.4*cos(alpha)
     centers(i)%y = 0.4*sin(alpha) + 0.4
     radii(i) = 0.1
     if (i>20) then
        radii(i) = (28-i)/80.0
     end if
  end do
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)
! right part of 9
  allocate(centers(25),radii(25))
  call glpushmatrix()
  call gltranslatef(1.0_glfloat,0.0_glfloat,0.0_glfloat)
  call glrotatef(10.0_glfloat,0.0_glfloat,0.0_glfloat,-1.0_glfloat)
  do i=1,25
     alpha = (i-1)*PI/20.0 - PI/2.0 - 4.0*PI/20.0
     centers(i)%x = 0.5*cos(alpha)
     centers(i)%y = 0.8*sin(alpha)
     radii(i) = 0.1
     if (i<5) then
        radii(i) = i/50.0
     end if
  end do
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)
! 0
  allocate(centers(42),radii(42))
  call glpushmatrix()
  call gltranslatef(2.4_glfloat,0.0_glfloat,0.0_glfloat)
  do i=1,42
     alpha = (i-1)*PI/20.0
     centers(i)%x = 0.6*cos(alpha)
     centers(i)%y = 0.8*sin(alpha)
     radii(i) = 0.1
  end do
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)
! g
  allocate(centers(15+56),radii(15+56))
! right part of g
  call glpushmatrix()
  call gltranslatef(3.6_glfloat,-0.5_glfloat,0.0_glfloat)
!  call glrotatef(10.0_glfloat,0.0_glfloat,0.0_glfloat,-1.0_glfloat)
  do i=1,15
     alpha = (i-1)*PI/20.0 - PI/2.0 - 4.0*PI/20.0
     centers(i)%x = 0.5*cos(alpha) - 0.1
     centers(i)%y =1.2*sin(alpha)
     radii(i) = 0.1
     if (i<5) then
         radii(i) = i/50.0
     end if
  end do
! left part of g
!  call glrotatef(20.0_glfloat,0.0_glfloat,0.0_glfloat,-1.0_glfloat)
  do i=1+15,55+15
     alpha = 3.0*(i-1-15)*PI/80.0
     centers(i)%x = 0.4*cos(alpha)
     centers(i)%y = 0.4*sin(alpha)
     radii(i) = 0.1
  end do
  centers(56+15) = centers(55+15)
  radii(56+15) = 0.0
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)
! l
  allocate(centers(41),radii(41))
  call glpushmatrix()
  call gltranslatef(4.6_glfloat,0.0_glfloat,0.0_glfloat)
  call glrotatef(25.0_glfloat,0.0_glfloat,0.0_glfloat,1.0_glfloat)
  do i=1,41
     x = (i-21)/20.0_glfloat
     centers(i)%x = x
     centers(i)%y = -x*(x-1.4)*(x+1.4)
     if (x<=-0.5) then
        radii(i) = 0.2*x+0.2
     else if (x>=0.5) then
        radii(i) = 0.2-0.2*x
     else
        radii(i) = 0.1_glfloat
     end if
  end do
  call make_letter(centers,radii)
  call glpopmatrix()
  deallocate(centers,radii)

  call glendlist()

  return
end subroutine draw_logo

end module logo_mod

program main

use opengl_gl
use opengl_glu
use opengl_glut
use logo_mod
implicit none

integer :: i, window_width, window_height

  call glutinit()
  call glutinitdisplaymode(ior(ior(GLUT_RGB,GLUT_DOUBLE),GLUT_DEPTH))
  i = glutcreatewindow("f90gl logo")
  call glutreshapewindow(320,320)
  window_width = 320
  window_height = 320
  call glutdisplayfunc(redraw)
  call glutmousefunc(mouse)
  call glutmotionfunc(motion)
  call glutreshapefunc(freshape)
  call glutcreatemenu(controlLights,i)
  call glutaddmenuentry("Toggle right light", 1)
  call glutaddmenuentry("Toggle left light", 2)
  call glutaddmenuentry("Toggle color bars", 3)
  call glutaddmenuentry("Animate",4)
  call glutattachmenu(GLUT_RIGHT_BUTTON)
  call glenable(GL_CULL_FACE)
  call glenable(GL_DEPTH_TEST)
  call glenable(GL_LIGHTING)
  call glenable(GL_NORMALIZE)
  call glmatrixmode(GL_PROJECTION)
  call gluperspective(10.0_gldouble, & ! field of view in degree
                          1.0_gldouble, & ! aspect ratio
                          1.0_gldouble, & ! Z near
                        400.0_gldouble)   ! Z far
  call glmatrixmode(GL_MODELVIEW)
  call glulookat( &
   2.0_gldouble, 0.0_gldouble, 40.0_gldouble, & ! eye is at (0,0,30)
   2.0_gldouble, 0.0_gldouble, 0.0_gldouble, & ! center is at (0,0,0)
   0.0_gldouble, 1.0_gldouble, 0.0_gldouble) ! up is in postivie Y direction
  call glpushmatrix()  ! dummy push so we can pop on model recalc
  call draw_logo()

  call glutmainloop()
  stop
end program main

quality91%

¤ Dauer der Verarbeitung: 0.2 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.