~hwkrus/f03gl/trunk

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
module callbacks

  use opengl_gl

  integer(kind=GLint)  :: winWidth = 300, winHeight = 300

end module callbacks
program fgl08

  use opengl_gl
  use opengl_glu
  use opengl_glut
    
  use callbacks
  
  interface 
    subroutine display() bind(C)
    end subroutine display

    subroutine myreshape(w,h) bind(C)
      use opengl_gl
      integer(glcint), value :: w,h
    end subroutine myreshape

    subroutine mouse(b,a,x,y) bind(C)
      use OpenGL_GL
      integer(GLint), value :: b,a,x,y
    end subroutine mouse
  end interface 

  integer(kind=GLint) :: iwin
    
  call glutInit
  call glutInitDisplayMode(GLUT_SINGLE + GLUT_RGB )
  call glutInitWindowPosition( 100, 100)
  call glutInitWindowSize( winWidth, winHeight )
  iwin = glutCreateWindow("fgl08 Mouse droppings"//char(0))

  call glClearColor(0.0,0.0,0.0,0.0)

  call glMatrixMode(GL_PROJECTION)

  call gluOrtho2D( 0.0_gldouble,  150.0_gldouble, &
                   0.0_gldouble,  150.0_gldouble  )
  
  call glutMouseFunc( mouse )
  call glutDisplayFunc( display )
  call glutReshapeFunc( myreshape )

  call glutMainLoop()
  
end program
subroutine display() bind(C)

  use OpenGL_GL

  call glClear(GL_COLOR_BUFFER_BIT)

  call glColor3f(1.0,0.0,0.0)

  call glPointSize(3.0)
  call glFlush()

end subroutine display
subroutine myreshape(newWidth, newHeight) bind(C)

  use OpenGL_GL
  use OpenGL_GLU

  use callbacks

  integer(kind=GLcint), value :: newWidth, newHeight
  real(kind=GLdouble) :: Zero, Width, Height

  Zero   = 0.0
  Width  = newWidth
  Height = newHeight

  call glviewport(0,0,newWidth,newHeight)

  call glMatrixMode(GL_PROJECTION)
  call glLoadIdentity()

  call gluOrtho2D( Zero, Width, Zero, Height )
  
  call glClear(GL_COLOR_BUFFER_BIT)

  winWidth  = newWidth
  winHeight = newHeight
  
end subroutine myreshape
subroutine plotpoint(ix,iy)
  
  use OpenGL_GL

  integer(GLint), intent(in) :: ix, iy  
  
  call glBegin(GL_POINTS)
  call glVertex2i(ix,iy)
  call glEnd()
  
end subroutine plotpoint
subroutine mouse( ibutton, iaction, ix, iy ) bind(C)

  use OpenGL_GL
  use OpenGL_GLUT
  use callbacks

  integer(GLint), value :: ibutton, iaction, ix, iy  

  if( ibutton == GLUT_LEFT_BUTTON .and. &
      iaction == GLUT_DOWN )then
      
    call plotpoint(ix,winHeight-iy)
  
    call glFlush()
    
  endif
  
end subroutine mouse