Skip to content

Commit 55fb55f

Browse files
jutarojutaro
committedJul 9, 2015
All examples work again after meltdown release!
·
v1.3.0v0.3
1 parent 3ca0523 commit 55fb55f

13 files changed

+98
-2287
lines changed
 

‎README.md

+4-12
Original file line numberDiff line numberDiff line change
@@ -9,18 +9,10 @@ Build with:
99
~~~
1010
npm install
1111
bower update
12-
grunt example1 (1,...)
12+
./run.sh
1313
~~~
1414

15-
Then open index.html in browser. Later examples may need a different index file,
16-
e.g. index7.html for example7.
17-
18-
A recent purescript compiler with version >= 0.6.6 is needed.
19-
20-
For later examples you need to start chrome with --allow-file-access-from-files
21-
to be able to load local files for textures. I'm not aware how other browsers react.
22-
23-
Have peace.
24-
Jürgen
25-
15+
Then open index#.html in browser.
2616

17+
For later examples you need to start chrome with --allow-file-access-from-files
18+
to be able to load local files for textures.

‎examples/Example4.purs

-245
This file was deleted.

‎examples/Example5.purs

-244
This file was deleted.

‎examples/Example6.purs

-360
This file was deleted.

‎examples/Example7.purs

-453
This file was deleted.

‎examples/Example8.purs

-475
This file was deleted.

‎examples/Example9.purs

-385
This file was deleted.

‎examples/Main.purs ‎examples/Example9Variant.purs

File renamed without changes.

‎html/index9.html

+2-2
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,8 @@
22
<html>
33
<head>
44
<title>Webgl Lesson 9</title>
5-
<script type="text/javascript" src="../dist/Main9.js"></script>
6-
<script type="text/javascript"> var gl; onload = PS.Example9.main;</script>
5+
<script type="text/javascript" src="../dist/Main9ST.js"></script>
6+
<script type="text/javascript"> var gl; onload = PS.Example9ST.main;</script>
77
</head>
88
<body>
99
<canvas id="glcanvas" width="600" height="600"

‎html/index9ST.html

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
<title>Webgl Lesson 9</title>
5+
<script type="text/javascript" src="../dist/Main9.js"></script>
6+
<script type="text/javascript"> var gl; onload = PS.Example9.main;</script>
7+
</head>
8+
<body>
9+
<canvas id="glcanvas" width="600" height="600"
10+
style="border: 1px solid black; display: block; margin: auto;">
11+
Your browser doesn't appear to support the
12+
HTML5 <code>&lt;canvas&gt;</code> element.
13+
</canvas>
14+
<br/>
15+
<input type="checkbox" id="twinkle" /> Twinkle<br/>
16+
(Use up/down cursor keys to rotate, and <code>Page Up</code>/<code>Page Down</code> to zoom out/in)
17+
18+
<br/>
19+
</body>
20+
</html>

‎package.json

+7-6
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
11
{
22
"private": true,
33
"devDependencies": {
4-
"gulp": "~3.8.10",
5-
"gulp-purescript": "~0.1.2",
6-
"gulp-run": "~1.6.4",
7-
"run-sequence": "~1.0.1",
8-
"gulp-jsvalidate": "~1.0.1"
4+
"pulp": "^4.0.2",
5+
"browserify": "*",
6+
"benchmark": "~1.0.0",
7+
"microtime": "~1.2.0"
8+
},
9+
"scripts": {
10+
"bench": "./benchmarks/run.sh"
911
}
10-
}

‎run.sh

+1-1
Original file line numberDiff line numberDiff line change
@@ -14,4 +14,4 @@ psc-bundle output/**/*.js -m Example6 -o dist/Main6.js
1414
psc-bundle output/**/*.js -m Example7 -o dist/Main7.js
1515
psc-bundle output/**/*.js -m Example8 -o dist/Main8.js
1616
psc-bundle output/**/*.js -m Example9 -o dist/Main9.js
17-
# psc-bundle output/**/*.js -m Example9ST -o dist/Main9ST.js
17+
psc-bundle output/**/*.js -m Example9ST -o dist/Main9ST.js

‎examples/Example9ST.purs ‎src/Example9ST.purs

+64-104
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module Example9ST where
22

3+
import Prelude
34
import Control.Monad.Eff.WebGL
45
import Graphics.WebGL
56
import Graphics.WebGLRaw
@@ -19,7 +20,7 @@ import Control.Monad.Eff
1920
import Control.Monad.Eff.Random
2021
import Control.Monad
2122
import Control.Monad.ST
22-
import Debug.Trace
23+
import Control.Monad.Eff.Console
2324
import Data.Tuple
2425
import Data.Foldable (for_)
2526
import Data.Date
@@ -28,11 +29,13 @@ import Data.Maybe
2829
import Data.Maybe.Unsafe (fromJust)
2930
import Data.Array
3031
import Data.Array.ST
31-
import Math
32-
import Prelude.Unsafe (unsafeIndex)
32+
import Math hiding (log)
33+
import Data.Int (toNumber)
34+
import KeyEvent
35+
import Data.Array.Unsafe (unsafeIndex)
3336

3437

35-
starCount = 50 :: Number
38+
starCount = 50 :: Int
3639
spinStep = 0.1 :: Number
3740

3841
type MyBindings =
@@ -83,13 +86,13 @@ type State bindings = {
8386
starVertices :: Buffer T.Float32,
8487
textureCoords :: Buffer T.Float32,
8588
texture :: WebGLTex,
86-
lastTime :: Maybe Number,
89+
lastTime :: Maybe Int,
8790

88-
stars :: [Star],
91+
stars :: Array Star,
8992
spin :: Number,
9093
tilt :: Number,
9194
z :: Number,
92-
currentlyPressedKeys :: [Number]
95+
currentlyPressedKeys :: Array Int
9396
}
9497

9598
vertices = [
@@ -125,15 +128,15 @@ type Star =
125128
-- Star methods
126129
starDefault :: Number -> Number -> Star
127130
starDefault startDist rotSpeed =
128-
{ angle : 0
131+
{ angle : 0.0
129132
, dist : startDist
130133
, rotationSpeed : rotSpeed
131-
, r : 0
132-
, g : 0
133-
, b : 0
134-
, twinkleR : 0
135-
, twinkleG : 0
136-
, twinkleB : 0
134+
, r : 0.0
135+
, g : 0.0
136+
, b : 0.0
137+
, twinkleR : 0.0
138+
, twinkleG : 0.0
139+
, twinkleB : 0.0
137140
}
138141

139142
starCreate x y =
@@ -150,7 +153,7 @@ starRandomiseColors star = do
150153
, twinkleB = colors `unsafeIndex` 5
151154
}
152155

153-
starAnimate :: forall eff . Number -> Star -> EffWebGL (random :: Random |eff) Star
156+
starAnimate :: forall eff . Int -> Star -> EffWebGL (random :: RANDOM |eff) Star
154157
starAnimate elapsedTime star = do
155158
let
156159
star' = star
@@ -161,39 +164,39 @@ starAnimate elapsedTime star = do
161164
then starRandomiseColors star' {dist = star'.dist + 5.0}
162165
else return star'
163166
where
164-
step = (elapsedTime * 60) / 1000
167+
step = (toNumber elapsedTime * 60.0) / 1000.0
165168

166169
starDraw :: forall h eff . State MyBindings -> Boolean -> M.STMat4 h -> Tuple Star Number -> EffWebGL (st :: ST h |eff) Unit
167170
starDraw s twinkle mvMatrix (Tuple star mySpin) = do
168171
mv <- M.cloneSTMat mvMatrix
169-
M.rotateST (degToRad star.angle) (V.vec3' [0, 1, 0]) mv
170-
M.translateST (V.vec3 star.dist 0 0) mv
171-
M.rotateST (degToRad $ negate star.angle) (V.vec3' [0, 1, 0]) mv
172-
M.rotateST (degToRad $ negate s.tilt) (V.vec3' [1, 0, 0]) mv
172+
M.rotateST (degToRad star.angle) (V.vec3' [0.1, 1.0, 0.0]) mv
173+
M.translateST (V.vec3 star.dist 0.0 0.0) mv
174+
M.rotateST (degToRad $ negate star.angle) (V.vec3' [0.0, 1.0, 0.0]) mv
175+
M.rotateST (degToRad $ negate s.tilt) (V.vec3' [1.0, 0.0, 0.0]) mv
173176

174177
when twinkle $ do
175178
setUniformFloats s.bindings.uColor [star.twinkleR, star.twinkleG, star.twinkleB]
176179
drawStar s mv
177180

178-
M.rotateST (degToRad mySpin) (V.vec3' [0, 0, 1]) mv
181+
M.rotateST (degToRad mySpin) (V.vec3' [0.0, 0.0, 1.0]) mv
179182
setUniformFloats s.bindings.uColor [star.r, star.g, star.b]
180183
drawStar s mv
181184

182185

183-
main :: Eff (trace :: Trace, alert :: Alert, now :: Now, random :: Random) Unit
186+
main :: Eff (console :: CONSOLE, alert :: Alert, now :: Now, random :: RANDOM) Unit
184187
main = do
185188
runWebGL
186189
"glcanvas"
187190
(\s -> alert s)
188191
\ context -> do
189-
trace "WebGL started"
192+
log "WebGL started"
190193
withShaders
191194
shaders
192195
(\s -> alert s)
193196
\ bindings -> do
194197
vs <- makeBufferFloat vertices
195198
textureCoords <- makeBufferFloat texCoo
196-
let starParams i = Tuple ((i / starCount) * 5.0) (i / starCount)
199+
let starParams i = Tuple ((toNumber i / toNumber starCount) * 5.0) (toNumber i / toNumber starCount)
197200
ss <- mapM (uncurry starCreate <<< starParams) (0 .. (starCount-1))
198201
clearColor 0.0 0.0 0.0 1.0
199202
texture2DFor "star.gif" MIPMAP \texture -> do
@@ -218,17 +221,17 @@ main = do
218221
onKeyUp (handleKeyU stRef)
219222
tick (stRef :: STRef _ (State MyBindings))
220223

221-
tick :: forall h eff. STRef h (State MyBindings) -> EffWebGL (st :: ST h, trace :: Trace, now :: Now, random :: Random |eff) Unit
224+
tick :: forall h eff. STRef h (State MyBindings) -> EffWebGL (st :: ST h, console :: CONSOLE, now :: Now, random :: RANDOM |eff) Unit
222225
tick stRef = do
223226
drawScene stRef
224227
handleKeys stRef
225228
animate stRef
226229
requestAnimationFrame (tick stRef)
227230

228-
unpackMilliseconds :: Milliseconds -> Number
231+
unpackMilliseconds :: Milliseconds -> Int
229232
unpackMilliseconds (Milliseconds n) = n
230233

231-
animate :: forall h eff . STRef h (State MyBindings) -> EffWebGL (st :: ST h, now :: Now, random :: Random |eff) Unit
234+
animate :: forall h eff . STRef h (State MyBindings) -> EffWebGL (st :: ST h, now :: Now, random :: RANDOM |eff) Unit
232235
animate stRef = do
233236
s <- readSTRef stRef
234237
timeNow <- liftM1 (unpackMilliseconds <<< toEpochMilliseconds) now
@@ -237,7 +240,7 @@ animate stRef = do
237240
Just lastt ->
238241
let
239242
elapsed = timeNow - lastt
240-
spin' = s.spin + (spinStep * length s.stars)
243+
spin' = s.spin + (spinStep * toNumber (length s.stars))
241244
in do
242245
stars' <- mapM (starAnimate elapsed) s.stars
243246
writeSTRef stRef (s {lastTime = Just timeNow, spin=spin', stars=stars'})
@@ -259,7 +262,7 @@ drawScene stRef = do
259262
withTexture2D s.texture 0 s.bindings.uSampler 0
260263

261264
let
262-
pMatrix = M.makePerspective 45 (canvasWidth / canvasHeight) 0.1 100.0
265+
pMatrix = M.makePerspective 45.0 (toNumber canvasWidth / toNumber canvasHeight) 0.1 100.0
263266
ss = zip s.stars (iterateN (+spinStep) (length s.stars) s.spin)
264267

265268
setUniformFloats s.bindings.uPMatrix (M.toArray pMatrix)
@@ -271,7 +274,7 @@ initialMVMatrix :: forall h r. Number -> Number -> Eff (st :: ST h | r) (M.STMat
271274
initialMVMatrix tilt zoom = do
272275
m <- M.identityST
273276
M.translateST (V.vec3' [0.0, 0.0, zoom]) m
274-
M.rotateST (degToRad tilt) V.i m
277+
M.rotateST (degToRad tilt) V.i3 m
275278
return m
276279

277280
drawStar s (M.STMat mvMatrix) = do
@@ -280,112 +283,69 @@ drawStar s (M.STMat mvMatrix) = do
280283

281284

282285
-- | collects results of repeated function application, up to n times
283-
iterateN :: forall a . (a -> a) -> Number -> a -> [a] -- pfff... I miss Haskell's laziness...
286+
iterateN :: forall a . (a -> a) -> Int -> a -> Array a
284287
iterateN f = iterate' []
285288
where
286289
iterate' res 0 _ = reverse res
287290
iterate' res n x = iterate' (x:res) (n-1) (f x)
288291

289292

290-
foreign import getElementByIdFloat
291-
"""
292-
function getElementByIdFloat(targ_id) {
293-
return function () {
294-
return parseFloat(document.getElementById(targ_id).value);
295-
};
296-
}
297-
""" :: forall eff. String -> (EffWebGL eff Number)
298-
299-
foreign import getElementByIdBool
300-
"""
301-
function getElementByIdBool(targ_id) {
302-
return function () {
303-
return document.getElementById(targ_id).checked;
304-
};
305-
}
306-
""" :: forall eff. String -> (EffWebGL eff Boolean)
307-
308293
-- | Convert from radians to degrees.
309294
radToDeg :: Number -> Number
310-
radToDeg x = x/pi*180
295+
radToDeg x = x/pi*180.0
311296

312297
-- | Convert from degrees to radians.
313298
degToRad :: Number -> Number
314-
degToRad x = x/180*pi
299+
degToRad x = x/180.0*pi
315300

316301

317302
-- * Key handling
318303

319-
handleKeys :: forall h eff . STRef h (State MyBindings) -> EffWebGL (trace :: Trace, st :: ST h |eff) Unit
304+
-- * Key handling
305+
306+
handleKeys :: forall h eff . STRef h (State MyBindings) -> EffWebGL (console :: CONSOLE, st :: ST h |eff) Unit
320307
handleKeys stRef = do
321308
s <- readSTRef stRef
322309
if null s.currentlyPressedKeys
323310
then return unit
324311
else
325-
let z' = if elemIndex 33 s.currentlyPressedKeys /= -1
326-
then s.z - 0.1
327-
else s.z
328-
z'' = if elemIndex 34 s.currentlyPressedKeys /= -1
329-
then z' + 0.1
330-
else z'
331-
tilt' = if elemIndex 38 s.currentlyPressedKeys /= -1
332-
then s.tilt - 2
333-
else s.tilt
334-
tilt'' = if elemIndex 40 s.currentlyPressedKeys /= -1
335-
then tilt' + 2
336-
else tilt'
312+
let z' = case elemIndex 33 s.currentlyPressedKeys of
313+
Just _ -> s.z - 0.1
314+
Nothing -> s.z
315+
z'' = case elemIndex 34 s.currentlyPressedKeys of
316+
Just _ -> z' + 0.1
317+
Nothing -> z'
318+
tilt' = case elemIndex 38 s.currentlyPressedKeys of
319+
Just _ -> s.tilt - 2.0
320+
Nothing -> s.tilt
321+
tilt'' = case elemIndex 40 s.currentlyPressedKeys of
322+
Just _ -> tilt' + 2.0
323+
Nothing -> tilt'
337324
in do
338325
writeSTRef stRef (s{z=z'',tilt=tilt''})
339-
-- trace (show s.currentlyPressedKeys)
326+
-- log (show s.currentlyPressedKeys)
340327
return unit
341328

342-
handleKeyD :: forall h eff. STRef h (State MyBindings) -> Event -> Eff (st :: ST h, trace :: Trace | eff) Unit
329+
handleKeyD :: forall h eff. STRef h (State MyBindings) -> Event -> Eff (st :: ST h, console :: CONSOLE | eff) Unit
343330
handleKeyD stRef event = do
344-
-- trace "handleKeyDown"
331+
-- log "handleKeyDown"
345332
let key = eventGetKeyCode event
346333
s <- readSTRef stRef
347-
let cp = if elemIndex key s.currentlyPressedKeys /= -1
348-
then s.currentlyPressedKeys
349-
else key : s.currentlyPressedKeys
334+
let cp = case elemIndex key s.currentlyPressedKeys of
335+
Just _ -> s.currentlyPressedKeys
336+
Nothing -> key : s.currentlyPressedKeys
350337
writeSTRef stRef (s {currentlyPressedKeys = cp})
351-
-- trace (show s.currentlyPressedKeys)
338+
-- log (show s.currentlyPressedKeys)
352339
return unit
353340

354-
handleKeyU :: forall h eff. STRef h (State MyBindings) -> Event -> Eff (st :: ST h, trace :: Trace | eff) Unit
341+
handleKeyU :: forall h eff. STRef h (State MyBindings) -> Event -> Eff (st :: ST h, console :: CONSOLE | eff) Unit
355342
handleKeyU stRef event = do
356-
-- trace "handleKeyUp"
343+
-- log "handleKeyUp"
357344
let key = eventGetKeyCode event
358345
s <- readSTRef stRef
359-
if elemIndex key s.currentlyPressedKeys == -1
360-
then return unit
361-
else do
346+
case elemIndex key s.currentlyPressedKeys of
347+
Nothing -> return unit
348+
Just _ -> do
362349
writeSTRef stRef (s {currentlyPressedKeys = delete key s.currentlyPressedKeys})
363-
-- trace (show s.currentlyPressedKeys)
350+
-- log (show s.currentlyPressedKeys)
364351
return unit
365-
366-
foreign import data Event :: *
367-
368-
foreign import onKeyDown
369-
"""
370-
function onKeyDown(handleKeyDown) {
371-
return function() {
372-
document.onkeydown = function(event) {handleKeyDown(event)()};
373-
};}
374-
""" :: forall eff. (Event -> Eff (webgl :: WebGl | eff) Unit)
375-
-> Eff (webgl :: WebGl | eff) Unit
376-
377-
foreign import onKeyUp
378-
"""
379-
function onKeyUp(handleKeyUp) {
380-
return function() {
381-
document.onkeyup = function(event) {handleKeyUp(event)()};
382-
};}
383-
""" :: forall eff. (Event -> Eff (webgl :: WebGl | eff) Unit)
384-
-> Eff (webgl :: WebGl | eff) Unit
385-
386-
foreign import eventGetKeyCode
387-
"""
388-
function eventGetKeyCode (event) {
389-
return (event.keyCode);
390-
}
391-
""" :: Event -> Number

0 commit comments

Comments
 (0)
Please sign in to comment.