c =============================== subroutine pretvori_geom_model_v_GL_gradnike include 'fgl.h' integer p(5,4) real t(8, 3), n(5,3) integer i,j common /geometrija/ t, p, n call fglInitNames call fglPushName(-1) do 10 i=1,5 call fglLoadName(i) call fglBegin(GL_QUADS) do 20 j=1,4 call fglNormal3f( n(i,1),n(i,2),n(i,3)) call fglVertex3f( * t(p(i,j), 1), t(p(i,j), 2), t(p(i,j), 3) ) 20 continue call fglEnd 10 continue call fglPopName return end c =============================== subroutine risi include 'fgl.h' include 'fglut.h' real fi_x, fi_y common /rotacije / fi_x, fi_y data fi_x/-30.0/, fi_y/30.0/ call fglClear(GL_COLOR_BUFFER_BIT+GL_DEPTH_BUFFER_BIT) call fglColor3f(1.0, 0.4, 1.0) call fglLoadIdentity call fglScalef(0.5, 0.5, 0.5) call fglRotatef(fi_x, 1.0, 0.0, 0.0) call fglRotatef(fi_y, 0.0, 1.0, 0.0) call pretvori_geom_model_v_GL_gradnike call fglutSwapBuffers return end c =============================== subroutine miska(x, y) include 'fglut.h' include 'fgl.h' integer x, y integer stari_x, stari_y real fi_x, fi_y common /rotacije/ fi_x, fi_y save stari_x, stari_y data stari_x /0/, stari_y/0/ if (x .gt. stari_x) fi_y = fi_y - 1.0 if (x .lt. stari_x) fi_y = fi_y + 1.0 if (y .gt. stari_y) fi_x = fi_x - 1.0 if (y .lt. stari_y) fi_x = fi_x + 1.0 stari_x = x stari_y = y call fglutPostRedisplay return end c =============================== subroutine obdelaj_zadetke(stevilo_zadetkov, pomnilnik) integer i, j, ii, stevilo_nivojev integer stevilo_zadetkov, pomnilnik(512) character*20 ime_objekta(5) common /ime/ ime_objekta write (*,*) '==== obdelaj zadetke: ======' write (*,*) 'stevilo_zadetkov = ', stevilo_zadetkov write (*,*) (pomnilnik(i), i=1,10) ii = 0 do 10 i=1, stevilo_zadetkov ii = ii + 1 stevilo_nivojev = pomnilnik(ii) ii = ii+3 write(*,*) 'Imena so ', * (pomnilnik(j), j=ii, ii+stevilo_nivojev-1) write(*,*) 'Interpretacija imena:', * ime_objekta(pomnilnik(ii)) 10 continue return end c =============================== real*8 function doubler(a) real a doubler = a return end real*8 function doublei(a) integer a doublei = a return end c =============================== integer function projekcija_kurzorja_na_3dobjekt( * x, y, x_out, y_out, z_out) include 'fgl.h' include 'fglu.h' integer x, y real x_out, y_out, z_out, z real*8 x3d, y3d, z3d real*8 mvmatrix(16), projmatrix(16) integer viewport(4) real*8 doublei, doubler c GLdouble x3d, y3d, z3d; c GLdouble mvmatrix[16]; GLdouble projmatrix[16]; c GLint viewport[4]; call f9y0glReadPixels (x, 500-y, 1, 1, * GL_DEPTH_COMPONENT, GL_FLOAT, z) write (*,*) 'x_window=',x,',y_window=',y,',z=',z if (z .lt. 1.0) then call fglGetIntegerv(GL_VIEWPORT, viewport) call fglGetDoublev(GL_MODELVIEW_MATRIX, mvmatrix) call fglGetDoublev(GL_PROJECTION_MATRIX, projmatrix) istatus = fgluUnProject(doublei(x),doublei(500-y),doubler(z), * mvmatrix, projmatrix, viewport, x3d, y3d, z3d) write(*,*) 'x3d, y3d, z3d=', x3d, y3d, z3d x_out = x3d y_out = y3d z_out = z3d projekcija_kurzorja_na_3dobjekt = 0 else write(*,*)'Ne najdem projekcije!' projekcija_kurzorja_na_3dobjekt = 1 endif return end c =============================== subroutine pritisk_na_gumb_miske(stevilka_gumba, status, x, y) include 'fgl.h' include 'fglu.h' include 'fglut.h' integer stevilka_gumba, status, x, y real x3d, y3d, z3d real*8 doubler, doublei integer selectBuf(512), stevilo_zadetkov, viewport(4) integer projekcija_kurzorja_na_3dobjekt if (stevilka_gumba .eq. GLUT_MIDDLE_BUTTON * .and. status .eq. 0) then call fglGetIntegerv(GL_VIEWPORT, viewport) call fglSelectBuffer(512, selectBuf) stevilo_zadetkov = fglRenderMode(GL_SELECT) call fglMatrixMode(GL_PROJECTION) call fglPushMatrix call fglLoadIdentity call fgluPickMatrix( doublei(x), doublei(viewport(4) - y), * doubler(5.0), doubler(5.0), viewport) call fglOrtho( doubler(-1.0), doubler(1.0), * doubler(-1.0), doubler(1.0), * doubler(-1.0), doubler(1.0) ) * call fglMatrixMode(GL_MODELVIEW) call risi call fglFlush call fglMatrixMode(GL_PROJECTION) call fglPopMatrix call fglMatrixMode(GL_MODELVIEW) stevilo_zadetkov = fglRenderMode(GL_RENDER) write (*,*) 'stevilo_zadetkov=', stevilo_zadetkov if (stevilo_zadetkov .gt. 0) * call obdelaj_zadetke(stevilo_zadetkov, selectBuf) call fglutPostRedisplay endif c ------ if (stevilka_gumba .eq. GLUT_RIGHT_BUTTON * .and. status .eq. 0) then istatus1=projekcija_kurzorja_na_3dobjekt(x,y,x3d,y3d,z3d) if (status1 .eq. 0) then call fglDisable(GL_LIGHTING) call fglColor3f(1.0, 1.0, 1.0) call fglPointSize(5.0) call fglBegin(GL_POINTS) call fglVertex3f(x3d, y3d, z3d) call fglEnd call fglutSwapBuffers call fglEnable(GL_LIGHTING) endif endif return end c ===================================== subroutine izdelaj_geom_model real tocke(8, 3), normale(5,3) integer ploskve(5,4) character*20 ime_objekta(5) common /geometrija/ tocke, ploskve, normale common /ime/ ime_objekta data tocke / -0.5, 0.5, 0.5,-0.5,-0.5, 0.5, 0.5,-0.5, * -0.5,-0.5, 0.5, 0.5,-0.5,-0.5, 0.5, 0.5, * -0.8,-0.8,-0.8,-0.8, 0.8, 0.8, 0.8, 0.8 / data ploskve / 1, 5, 6, 1, 1, * 4, 6, 2, 5, 2, * 3, 7, 3, 8, 6, * 2, 8, 7, 4, 5 / data normale / 0.0, 0.0, 1.0,-1.0, 0.0, * 0.0, 0.0, 0.0, 0.0,-1.0, * -1.0, 1.0, 0.0, 0.0, 0.0 / data ime_objekta / 'stranica xy1', * 'stranica xy2', * 'stranica yz1', * 'stranica yz2', * 'stran spodnja' / return end c =============================== subroutine inicializiraj_gl include 'fgl.h' call fglEnable(GL_LIGHTING) call fglEnable(GL_LIGHT0) call fglEnable(GL_DEPTH_TEST) call fglEnable(GL_COLOR_MATERIAL) call fglLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE) return end c =============================== program glavni implicit none external risi external miska external pritisk_na_gumb_miske include 'fglut.h' integer moje_okno call izdelaj_geom_model call fglutInit call fglutInitWindowSize(500, 500) call fglutInitDisplayMode(GLUT_DOUBLE+GLUT_DEPTH) moje_okno = fglutCreateWindow('risi_miska') call inicializiraj_gl call fglutDisplayFunc(risi) call fglutMotionFunc(miska) call fglutMouseFunc(pritisk_na_gumb_miske) call fglutMainLoop stop end