<html><head> <link rel="stylesheet" href="_style.css" type="text/css"> <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type"> <link rel="Start" href="index.html"> <link title="Index of types" rel=Appendix href="index_types.html"> <link title="Index of values" rel=Appendix href="index_values.html"> <link title="Index of modules" rel=Appendix href="index_modules.html"> <link title="GL" rel="Chapter" href="GL.html"> <link title="Glu" rel="Chapter" href="Glu.html"> <link title="Glut" rel="Chapter" href="Glut.html"> <link title="VertArray" rel="Chapter" href="VertArray.html"> <link title="GLE" rel="Chapter" href="GLE.html"> <link title="Ftgl" rel="Chapter" href="Ftgl.html"> <link title="Jpeg_loader" rel="Chapter" href="Jpeg_loader.html"> <link title="Png_loader" rel="Chapter" href="Png_loader.html"> <link title="Svg_loader" rel="Chapter" href="Svg_loader.html"> <link title="Genimg_loader" rel="Chapter" href="Genimg_loader.html"> <link title="FunGL" rel="Chapter" href="FunGL.html"> <link title="FunGlut" rel="Chapter" href="FunGlut.html"><title>FunGlut.fun_glut</title> </head> <body> <code class="code"><span class="keyword">let</span> fun_glut ~display<br> ?reshape ?keyboard ?keyboard_up ?special ?special_up ?mouse ?motion ?passive<br> ?visibility ?entry ?timer ?idle<br> ?(full_screen=<span class="keyword">false</span>)<br> ?(window_size=800, 600)<br> ?title ?display_mode<br> ?init_gl<br> ~init () =<br> <br> ignore(glutInit <span class="constructor">Sys</span>.argv);<br> <span class="keyword">begin</span> <span class="keyword">match</span> display_mode <span class="keyword">with</span><br> <span class="constructor">Some</span> display_mode <span class="keywordsign">-></span> glutInitDisplayMode display_mode<br> <span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> glutInitDisplayMode []<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> window_size <span class="keyword">with</span><br> <span class="keywordsign">|</span> width, height <span class="keywordsign">-></span> glutInitWindowSize width height<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> title <span class="keyword">with</span><br> <span class="constructor">Some</span> title <span class="keywordsign">-></span> ignore(glutCreateWindow title)<br> <span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ignore(glutCreateWindow <span class="constructor">Sys</span>.argv.(0))<br> <span class="keyword">end</span>;<br> <span class="keyword">if</span> full_screen <span class="keyword">then</span> glutFullScreen();<br> <br> <span class="keyword">begin</span> <span class="keyword">match</span> init_gl <span class="keyword">with</span><br> <span class="constructor">Some</span> f <span class="keywordsign">-></span> f()<br> <span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keyword">end</span>;<br> <br> <span class="keyword">let</span> app = ref init <span class="keyword">in</span><br> <br> <span class="keyword">begin</span> <span class="keyword">match</span> reshape <span class="keyword">with</span><br> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutReshapeFunc cb<br> <span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> glutReshapeFunc (<span class="keyword">fun</span> ~width:w ~height:h <span class="keywordsign">-></span><br> <span class="keyword">let</span> h = <span class="keyword">if</span> h = 0 <span class="keyword">then</span> 1 <span class="keyword">else</span> h <span class="keyword">in</span><br> glViewport 0 0 w h;<br> glMatrixMode <span class="constructor">GL_PROJECTION</span>;<br> glLoadIdentity();<br> gluPerspective 60. ((float w)/.(float h)) 0.1 1000.0;<br> glMatrixMode <span class="constructor">GL_MODELVIEW</span>;<br> glutPostRedisplay())<br> <span class="keyword">end</span>;<br> <br> glutDisplayFunc (<span class="keyword">fun</span> () <span class="keywordsign">-></span> display !app);<br> <br> <span class="keyword">begin</span> <span class="keyword">match</span> keyboard <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutKeyboardFunc (<span class="keyword">fun</span> ~key ~x ~y <span class="keywordsign">-></span> app := cb !app ~key ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> keyboard_up <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutKeyboardUpFunc (<span class="keyword">fun</span> ~key ~x ~y <span class="keywordsign">-></span> app := cb !app ~key ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> special <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutSpecialFunc (<span class="keyword">fun</span> ~key ~x ~y <span class="keywordsign">-></span> app := cb !app ~key ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> special_up <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutSpecialUpFunc (<span class="keyword">fun</span> ~key ~x ~y <span class="keywordsign">-></span> app := cb !app ~key ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> mouse <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutMouseFunc (<span class="keyword">fun</span> ~button ~state ~x ~y <span class="keywordsign">-></span> app := cb !app ~button ~state ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> motion <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutMotionFunc (<span class="keyword">fun</span> ~x ~y <span class="keywordsign">-></span> app := cb !app ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> passive <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutPassiveMotionFunc (<span class="keyword">fun</span> ~x ~y <span class="keywordsign">-></span> app := cb !app ~x ~y)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> visibility <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutVisibilityFunc (<span class="keyword">fun</span> ~state <span class="keywordsign">-></span> app := cb !app ~state)<br> <span class="keyword">end</span>;<br> <span class="keyword">begin</span> <span class="keyword">match</span> entry <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> cb <span class="keywordsign">-></span> glutEntryFunc (<span class="keyword">fun</span> ~state <span class="keywordsign">-></span> app := cb !app ~state)<br> <span class="keyword">end</span>;<br> <br> <span class="keyword">begin</span> <span class="keyword">match</span> timer <span class="keyword">with</span><br> <span class="keywordsign">|</span> <span class="constructor">Some</span> [] <span class="keywordsign">|</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> timers <span class="keywordsign">-></span><br> <span class="constructor">ListLabels</span>.iter timers ~f:<br> (<span class="keyword">fun</span> (_timer, msecs) <span class="keywordsign">-></span><br> <span class="keyword">let</span> <span class="keyword">rec</span> timer =<br> (<span class="keyword">fun</span> ~value <span class="keywordsign">-></span><br> <span class="keyword">let</span> _app = _timer !app <span class="keyword">in</span><br> app := _app;<br> glutTimerFunc ~msecs ~value:_app ~timer<br> )<br> <span class="keyword">in</span><br> glutTimerFunc ~msecs ~value:!app ~timer<br> )<br> <span class="keyword">end</span>;<br> <br> <span class="keyword">begin</span> <span class="keyword">match</span> idle <span class="keyword">with</span> <span class="constructor">None</span> <span class="keywordsign">-></span> ()<br> <span class="keywordsign">|</span> <span class="constructor">Some</span> idle <span class="keywordsign">-></span><br> glutIdleFunc (<span class="keyword">fun</span> () <span class="keywordsign">-></span> app := idle !app;)<br> <span class="keyword">end</span>;<br> <br> glutMainLoop();</code></body></html>