/usr/share/doc/libghc-gloss-doc/html/src/Graphics-Gloss-Internals-Interface-Simulate-Idle.html is in libghc-gloss-doc 1.7.8.3-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 | <?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
<title>Graphics/Gloss/Internals/Interface/Simulate/Idle.hs</title>
<link type='text/css' rel='stylesheet' href='hscolour.css' />
</head>
<body>
<pre><a name="line-1"></a><span class='hs-comment'>{-# OPTIONS_HADDOCK hide #-}</span>
<a name="line-2"></a><span class='hs-comment'>{-# LANGUAGE RankNTypes #-}</span>
<a name="line-3"></a>
<a name="line-4"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>Simulate</span><span class='hs-varop'>.</span><span class='hs-conid'>Idle</span>
<a name="line-5"></a> <span class='hs-layout'>(</span> <span class='hs-varid'>callback_simulate_idle</span> <span class='hs-layout'>)</span>
<a name="line-6"></a><span class='hs-keyword'>where</span>
<a name="line-7"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>ViewPort</span>
<a name="line-8"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>Callback</span>
<a name="line-9"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>Backend</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>Backend</span>
<a name="line-10"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>Animate</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>AN</span>
<a name="line-11"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Graphics</span><span class='hs-varop'>.</span><span class='hs-conid'>Gloss</span><span class='hs-varop'>.</span><span class='hs-conid'>Internals</span><span class='hs-varop'>.</span><span class='hs-conid'>Interface</span><span class='hs-varop'>.</span><span class='hs-conid'>Simulate</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>SM</span>
<a name="line-12"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>IORef</span>
<a name="line-13"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span>
<a name="line-14"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>GHC</span><span class='hs-varop'>.</span><span class='hs-conid'>Float</span> <span class='hs-layout'>(</span><span class='hs-varid'>double2Float</span><span class='hs-layout'>)</span>
<a name="line-15"></a>
<a name="line-16"></a>
<a name="line-17"></a><a name="callback_simulate_idle"></a><span class='hs-comment'>-- | The graphics library calls back on this function when it's finished drawing</span>
<a name="line-18"></a><span class='hs-comment'>-- and it's time to do some computation.</span>
<a name="line-19"></a><span class='hs-definition'>callback_simulate_idle</span>
<a name="line-20"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-comment'>-- ^ the simulation state</span>
<a name="line-21"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>AN</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-comment'>-- ^ the animation statea</span>
<a name="line-22"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>ViewPort</span> <span class='hs-comment'>-- ^ the viewport state</span>
<a name="line-23"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-varid'>world</span> <span class='hs-comment'>-- ^ the current world</span>
<a name="line-24"></a> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>world</span> <span class='hs-comment'>-- ^ the initial world</span>
<a name="line-25"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ViewPort</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Float</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>world</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>world</span><span class='hs-layout'>)</span> <span class='hs-comment'>-- ^ fn to advance the world</span>
<a name="line-26"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Float</span> <span class='hs-comment'>-- ^ how much time to advance world by </span>
<a name="line-27"></a> <span class='hs-comment'>-- in single step mode</span>
<a name="line-28"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdleCallback</span>
<a name="line-29"></a>
<a name="line-30"></a><span class='hs-definition'>callback_simulate_idle</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>animateSR</span> <span class='hs-varid'>viewSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldStart</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>singleStepTime</span> <span class='hs-varid'>backendRef</span>
<a name="line-31"></a> <span class='hs-keyglyph'>=</span> <span class='hs-comment'>{-# SCC "callbackIdle" #-}</span>
<a name="line-32"></a> <span class='hs-keyword'>do</span> <span class='hs-varid'>simS</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>simSR</span>
<a name="line-33"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>result</span>
<a name="line-34"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateReset</span> <span class='hs-varid'>simS</span>
<a name="line-35"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simulate_reset</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldStart</span>
<a name="line-36"></a>
<a name="line-37"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateRun</span> <span class='hs-varid'>simS</span>
<a name="line-38"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simulate_run</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>animateSR</span> <span class='hs-varid'>viewSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldAdvance</span>
<a name="line-39"></a>
<a name="line-40"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateStep</span> <span class='hs-varid'>simS</span>
<a name="line-41"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simulate_step</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>viewSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>singleStepTime</span>
<a name="line-42"></a>
<a name="line-43"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span>
<a name="line-44"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyglyph'>\</span><span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>return</span> <span class='hs-conid'>()</span>
<a name="line-45"></a>
<a name="line-46"></a> <span class='hs-varid'>result</span> <span class='hs-varid'>backendRef</span>
<a name="line-47"></a>
<a name="line-48"></a>
<a name="line-49"></a><a name="simulate_reset"></a><span class='hs-comment'>-- reset the world to </span>
<a name="line-50"></a><span class='hs-definition'>simulate_reset</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdleCallback</span>
<a name="line-51"></a><span class='hs-definition'>simulate_reset</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldStart</span> <span class='hs-varid'>backendRef</span>
<a name="line-52"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span> <span class='hs-varid'>writeIORef</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldStart</span>
<a name="line-53"></a>
<a name="line-54"></a> <span class='hs-varid'>simSR</span> <span class='hs-varop'>`modifyIORef`</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c</span>
<a name="line-55"></a> <span class='hs-layout'>{</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateReset</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span>
<a name="line-56"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateIteration</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span>
<a name="line-57"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateSimTime</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>0</span> <span class='hs-layout'>}</span>
<a name="line-58"></a>
<a name="line-59"></a> <span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-varid'>postRedisplay</span> <span class='hs-varid'>backendRef</span>
<a name="line-60"></a>
<a name="line-61"></a>
<a name="line-62"></a><a name="simulate_run"></a><span class='hs-comment'>-- take the number of steps specified by controlWarp</span>
<a name="line-63"></a><span class='hs-definition'>simulate_run</span>
<a name="line-64"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span>
<a name="line-65"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>AN</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span>
<a name="line-66"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>ViewPort</span>
<a name="line-67"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-varid'>world</span>
<a name="line-68"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ViewPort</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Float</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>world</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>world</span><span class='hs-layout'>)</span>
<a name="line-69"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdleCallback</span>
<a name="line-70"></a>
<a name="line-71"></a><span class='hs-definition'>simulate_run</span> <span class='hs-varid'>simSR</span> <span class='hs-keyword'>_</span> <span class='hs-varid'>viewSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>backendRef</span>
<a name="line-72"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-73"></a> <span class='hs-varid'>simS</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>simSR</span>
<a name="line-74"></a> <span class='hs-varid'>viewS</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>viewSR</span>
<a name="line-75"></a> <span class='hs-varid'>worldS</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>worldSR</span>
<a name="line-76"></a>
<a name="line-77"></a> <span class='hs-comment'>-- get the elapsed time since the start simulation (wall clock)</span>
<a name="line-78"></a> <span class='hs-varid'>elapsedTime</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>fmap</span> <span class='hs-varid'>double2Float</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-varid'>elapsedTime</span> <span class='hs-varid'>backendRef</span>
<a name="line-79"></a>
<a name="line-80"></a> <span class='hs-comment'>-- get how far along the simulation is</span>
<a name="line-81"></a> <span class='hs-varid'>simTime</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>simSR</span> <span class='hs-varop'>`getsIORef`</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateSimTime</span>
<a name="line-82"></a>
<a name="line-83"></a> <span class='hs-comment'>-- we want to simulate this much extra time to bring the simulation</span>
<a name="line-84"></a> <span class='hs-comment'>-- up to the wall clock.</span>
<a name="line-85"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>thisTime</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>elapsedTime</span> <span class='hs-comment'>-</span> <span class='hs-varid'>simTime</span>
<a name="line-86"></a>
<a name="line-87"></a> <span class='hs-comment'>-- work out how many steps of simulation this equals</span>
<a name="line-88"></a> <span class='hs-varid'>resolution</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>simSR</span> <span class='hs-varop'>`getsIORef`</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateResolution</span>
<a name="line-89"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>timePerStep</span> <span class='hs-keyglyph'>=</span> <span class='hs-num'>1</span> <span class='hs-varop'>/</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>resolution</span>
<a name="line-90"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>thisSteps_</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>truncate</span> <span class='hs-varop'>$</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>resolution</span> <span class='hs-varop'>*</span> <span class='hs-varid'>thisTime</span>
<a name="line-91"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>thisSteps</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-varid'>thisSteps_</span> <span class='hs-varop'><</span> <span class='hs-num'>0</span> <span class='hs-keyword'>then</span> <span class='hs-num'>0</span> <span class='hs-keyword'>else</span> <span class='hs-varid'>thisSteps_</span>
<a name="line-92"></a>
<a name="line-93"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>newSimTime</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>simTime</span> <span class='hs-varop'>+</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>thisSteps</span> <span class='hs-varop'>*</span> <span class='hs-varid'>timePerStep</span>
<a name="line-94"></a>
<a name="line-95"></a><span class='hs-comment'>{- putStr $ "elapsed time = " ++ show elapsedTime ++ "\n"
<a name="line-96"></a> ++ "sim time = " ++ show simTime ++ "\n"
<a name="line-97"></a> ++ "this time = " ++ show thisTime ++ "\n"
<a name="line-98"></a> ++ "this steps = " ++ show thisSteps ++ "\n"
<a name="line-99"></a> ++ "new sim time = " ++ show newSimTime ++ "\n"
<a name="line-100"></a> ++ "taking = " ++ show thisSteps ++ "\n\n"
<a name="line-101"></a>-}</span>
<a name="line-102"></a> <span class='hs-comment'>-- work out the final step number for this display cycle</span>
<a name="line-103"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>nStart</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateIteration</span> <span class='hs-varid'>simS</span>
<a name="line-104"></a> <span class='hs-keyword'>let</span> <span class='hs-varid'>nFinal</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nStart</span> <span class='hs-varop'>+</span> <span class='hs-varid'>thisSteps</span>
<a name="line-105"></a>
<a name="line-106"></a> <span class='hs-comment'>-- keep advancing the world until we get to the final iteration number</span>
<a name="line-107"></a> <span class='hs-layout'>(</span><span class='hs-keyword'>_</span><span class='hs-layout'>,</span><span class='hs-varid'>world'</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>untilM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-keyword'>_</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>n</span> <span class='hs-varop'>>=</span> <span class='hs-varid'>nFinal</span><span class='hs-layout'>)</span>
<a name="line-108"></a> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-layout'>,</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>liftM</span> <span class='hs-layout'>(</span><span class='hs-keyglyph'>\</span><span class='hs-varid'>w'</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>n</span><span class='hs-varop'>+</span><span class='hs-num'>1</span><span class='hs-layout'>,</span><span class='hs-varid'>w'</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>viewS</span> <span class='hs-varid'>timePerStep</span> <span class='hs-varid'>w</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
<a name="line-109"></a> <span class='hs-layout'>(</span><span class='hs-varid'>nStart</span><span class='hs-layout'>,</span> <span class='hs-varid'>worldS</span><span class='hs-layout'>)</span>
<a name="line-110"></a>
<a name="line-111"></a> <span class='hs-comment'>-- write the world back into its IORef</span>
<a name="line-112"></a> <span class='hs-comment'>-- We need to seq on the world to avoid space leaks when the window is not showing.</span>
<a name="line-113"></a> <span class='hs-varid'>world'</span> <span class='hs-varop'>`seq`</span> <span class='hs-varid'>writeIORef</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>world'</span>
<a name="line-114"></a>
<a name="line-115"></a> <span class='hs-comment'>-- update the control state</span>
<a name="line-116"></a> <span class='hs-varid'>simSR</span> <span class='hs-varop'>`modifyIORef`</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c</span>
<a name="line-117"></a> <span class='hs-layout'>{</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateIteration</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>nFinal</span>
<a name="line-118"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateSimTime</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>newSimTime</span>
<a name="line-119"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateStepsPerFrame</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>fromIntegral</span> <span class='hs-varid'>thisSteps</span> <span class='hs-layout'>}</span>
<a name="line-120"></a>
<a name="line-121"></a> <span class='hs-comment'>-- tell glut we want to draw the window after returning</span>
<a name="line-122"></a> <span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-varid'>postRedisplay</span> <span class='hs-varid'>backendRef</span>
<a name="line-123"></a>
<a name="line-124"></a>
<a name="line-125"></a><a name="simulate_step"></a><span class='hs-comment'>-- take a single step</span>
<a name="line-126"></a><span class='hs-definition'>simulate_step</span>
<a name="line-127"></a> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-conid'>State</span>
<a name="line-128"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-conid'>ViewPort</span>
<a name="line-129"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IORef</span> <span class='hs-varid'>world</span>
<a name="line-130"></a> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ViewPort</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Float</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>world</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>world</span><span class='hs-layout'>)</span>
<a name="line-131"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Float</span>
<a name="line-132"></a> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IdleCallback</span>
<a name="line-133"></a>
<a name="line-134"></a><span class='hs-definition'>simulate_step</span> <span class='hs-varid'>simSR</span> <span class='hs-varid'>viewSR</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>singleStepTime</span> <span class='hs-varid'>backendRef</span>
<a name="line-135"></a> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>do</span>
<a name="line-136"></a> <span class='hs-varid'>viewS</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>viewSR</span>
<a name="line-137"></a> <span class='hs-varid'>world</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>worldSR</span>
<a name="line-138"></a> <span class='hs-varid'>world'</span> <span class='hs-keyglyph'><-</span> <span class='hs-varid'>worldAdvance</span> <span class='hs-varid'>viewS</span> <span class='hs-varid'>singleStepTime</span> <span class='hs-varid'>world</span>
<a name="line-139"></a>
<a name="line-140"></a> <span class='hs-varid'>writeIORef</span> <span class='hs-varid'>worldSR</span> <span class='hs-varid'>world'</span>
<a name="line-141"></a> <span class='hs-varid'>simSR</span> <span class='hs-varop'>`modifyIORef`</span> <span class='hs-keyglyph'>\</span><span class='hs-varid'>c</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>c</span>
<a name="line-142"></a> <span class='hs-layout'>{</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateIteration</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateIteration</span> <span class='hs-varid'>c</span> <span class='hs-varop'>+</span> <span class='hs-num'>1</span>
<a name="line-143"></a> <span class='hs-layout'>,</span> <span class='hs-conid'>SM</span><span class='hs-varop'>.</span><span class='hs-varid'>stateStep</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>False</span> <span class='hs-layout'>}</span>
<a name="line-144"></a>
<a name="line-145"></a> <span class='hs-conid'>Backend</span><span class='hs-varop'>.</span><span class='hs-varid'>postRedisplay</span> <span class='hs-varid'>backendRef</span>
<a name="line-146"></a>
<a name="line-147"></a>
<a name="line-148"></a><a name="getsIORef"></a><span class='hs-definition'>getsIORef</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>IORef</span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>r</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>r</span>
<a name="line-149"></a><span class='hs-definition'>getsIORef</span> <span class='hs-varid'>ref</span> <span class='hs-varid'>fun</span>
<a name="line-150"></a> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>liftM</span> <span class='hs-varid'>fun</span> <span class='hs-varop'>$</span> <span class='hs-varid'>readIORef</span> <span class='hs-varid'>ref</span>
<a name="line-151"></a>
<a name="line-152"></a><a name="untilM"></a><span class='hs-definition'>untilM</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Monad</span> <span class='hs-varid'>m</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>a</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-varid'>a</span>
<a name="line-153"></a><span class='hs-definition'>untilM</span> <span class='hs-varid'>test</span> <span class='hs-varid'>op</span> <span class='hs-varid'>i</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>go</span> <span class='hs-varid'>i</span>
<a name="line-154"></a> <span class='hs-keyword'>where</span>
<a name="line-155"></a> <span class='hs-varid'>go</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>test</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varid'>x</span>
<a name="line-156"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>op</span> <span class='hs-varid'>x</span> <span class='hs-varop'>>>=</span> <span class='hs-varid'>go</span>
<a name="line-157"></a>
</pre></body>
</html>
|