gloss-examples 1.3.0.1 → 1.3.1.1
raw patch · 7 files changed
+36/−46 lines, 7 filesdep ~vector
Dependency ranges changed: vector
Files
- Visibility/Array.hs +0/−7
- Visibility/Draw.hs +5/−6
- Visibility/Geometry/Randomish.hs +8/−9
- Visibility/Geometry/Segment.hs +13/−14
- Visibility/Interface.hs +1/−1
- Visibility/World.hs +4/−5
- gloss-examples.cabal +5/−4
− Visibility/Array.hs
@@ -1,7 +0,0 @@--module Array- ( Array- , module Data.Vector.Unboxed)-where-import Data.Vector.Unboxed-type Array = Vector
Visibility/Draw.hs view
@@ -8,8 +8,7 @@ import Geometry.Segment import Graphics.Gloss import Graphics.Gloss.Geometry.Line-import qualified Array as A-import Array (Array)+import qualified Data.Vector.Unboxed as V import Data.Maybe @@ -60,7 +59,7 @@ picSegsHit = Pictures $ [ Line [p1, p2]- | (_, p1, p2) <- A.toList $ worldSegments world+ | (_, p1, p2) <- V.toList $ worldSegments world , isJust $ intersectSegSeg p1 p2 pView pTarget ] in Color red $ Pictures [picTarget, picLine, picSegsHit] @@ -84,7 +83,7 @@ = let visible pTarget = not $ any isJust $ map (\(_, p1, p2) -> intersectSegSeg pView pTarget p1 p2)- $ A.toList + $ V.toList $ worldSegments world picGrid = Pictures@@ -105,11 +104,11 @@ -- | Draw an array of segments.-drawSegments :: Array Segment -> Picture+drawSegments :: V.Vector Segment -> Picture drawSegments segments = Pictures $ map drawSegment- $ A.toList + $ V.toList $ segments
Visibility/Geometry/Randomish.hs view
@@ -6,10 +6,9 @@ , randomishDoubles) where import Data.Word-import qualified Array as A import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed.Mutable as MV-import Array (Array)+import qualified Data.Vector.Unboxed as V -- | Some uniformly distributed points randomishPoints@@ -17,13 +16,13 @@ -> Int -- ^ number of points -> Float -- ^ minimum coordinate -> Float -- ^ maximum coordinate- -> Array (Float, Float)+ -> V.Vector (Float, Float) randomishPoints seed' n pointMin pointMax = let pts = randomishFloats (n*2) pointMin pointMax seed' xs = G.slice 0 n pts ys = G.slice n n pts- in A.zip xs ys+ in V.zip xs ys -- | Use the "minimal standard" Lehmer generator to quickly generate some random@@ -40,7 +39,7 @@ -> Int -- Minumum value in output. -> Int -- Maximum value in output. -> Int -- Random seed. - -> Array Int -- Vector of random numbers.+ -> V.Vector Int -- Vector of random numbers. randomishInts !len !valMin' !valMax' !seed' @@ -85,7 +84,7 @@ -> Double -- Minimum value in output -> Double -- Maximum value in output -> Int -- Random seed.- -> Array Double -- Vector of randomish doubles.+ -> V.Vector Double -- Vector of randomish doubles. randomishDoubles !len !valMin !valMax !seed = let range = valMax - valMin@@ -94,7 +93,7 @@ mxf = fromIntegral mx ints = randomishInts len 0 mx seed - in A.map (\n -> valMin + (fromIntegral n / mxf) * range) ints+ in V.map (\n -> valMin + (fromIntegral n / mxf) * range) ints -- | Generate some randomish doubles with terrible statistical properties.@@ -104,7 +103,7 @@ -> Float -- Minimum value in output -> Float -- Maximum value in output -> Int -- Random seed.- -> Array Float -- Vector of randomish doubles.+ -> V.Vector Float -- Vector of randomish doubles. randomishFloats !len !valMin !valMax !seed = let range = valMax - valMin@@ -113,4 +112,4 @@ mxf = fromIntegral mx ints = randomishInts len 0 mx seed - in A.map (\n -> valMin + (fromIntegral n / mxf) * range) ints+ in V.map (\n -> valMin + (fromIntegral n / mxf) * range) ints
Visibility/Geometry/Segment.hs view
@@ -10,8 +10,7 @@ import Graphics.Gloss.Geometry.Line import Data.Maybe import Data.Function-import qualified Array as A-import Array (Array)+import qualified Data.Vector.Unboxed as V -- | A line segement in the 2D plane. type Segment = (Int, (Float, Float), (Float, Float))@@ -24,45 +23,45 @@ -- | Split segments that cross the line y = y0, for some y0.-splitSegmentsOnY :: Float -> Array Segment -> Array Segment+splitSegmentsOnY :: Float -> V.Vector Segment -> V.Vector Segment splitSegmentsOnY y0 segs = let -- TODO: we only need to know IF the seg crosse the line here, -- not the actual intersection point. Do a faster test. (segsCross, segsOther)- = A.unstablePartition + = V.unstablePartition (\(_, p1, p2) -> isJust $ intersectSegHorzLine p1 p2 y0) segs -- TODO: going via lists here is bad.- splitCrossingSeg :: Segment -> Array Segment+ splitCrossingSeg :: Segment -> V.Vector Segment splitCrossingSeg (n, p1, p2) = let Just pCross = intersectSegHorzLine p1 p2 y0- in A.fromList [(n, p1, pCross), (n, pCross, p2)]+ in V.fromList [(n, p1, pCross), (n, pCross, p2)] -- TODO: vector append requires a copy. - in segsOther A.++ (A.concat $ map splitCrossingSeg $ A.toList segsCross)+ in segsOther V.++ (V.concat $ map splitCrossingSeg $ V.toList segsCross) -- | Split segments that cross the line x = x0, for some x0.-splitSegmentsOnX :: Float -> Array Segment -> Array Segment+splitSegmentsOnX :: Float -> V.Vector Segment -> V.Vector Segment splitSegmentsOnX x0 segs = let -- TODO: we only need to know IF the seg crosse the line here, -- not the actual intersection point. Do a faster test. (segsCross, segsOther)- = A.unstablePartition + = V.unstablePartition (\(_, p1, p2) -> isJust $ intersectSegVertLine p1 p2 x0) segs -- TODO: going via lists here is bad.- splitCrossingSeg :: Segment -> Array Segment+ splitCrossingSeg :: Segment -> V.Vector Segment splitCrossingSeg (n, p1, p2) = let Just pCross = intersectSegVertLine p1 p2 x0- in A.fromList [(n, p1, pCross), (n, pCross, p2)]+ in V.fromList [(n, p1, pCross), (n, pCross, p2)] -- TODO: vector append requires a copy. - in segsOther A.++ (A.concat $ map splitCrossingSeg $ A.toList segsCross)+ in segsOther V.++ (V.concat $ map splitCrossingSeg $ V.toList segsCross) -- | Decide where to split the plane.@@ -73,9 +72,9 @@ -- - the one closes to the middle of the field. -- - some combination of above. ---chooseSplitX :: Array Segment -> Float+chooseSplitX :: V.Vector Segment -> Float chooseSplitX segments- = let Just (_, (x1, _), _) = segments A.!? (A.length segments `div` 2)+ = let Just (_, (x1, _), _) = segments V.!? (V.length segments `div` 2) in x1
Visibility/Interface.hs view
@@ -1,4 +1,4 @@-+{-# LANGUAGE PatternGuards #-} module Interface ( handleInput , stepState)
Visibility/World.hs view
@@ -8,15 +8,14 @@ import Graphics.Gloss import Geometry.Randomish import Geometry.Segment-import qualified Array as A-import Array (Array)+import qualified Data.Vector.Unboxed as V -- We keep this unpacked so we can use unboxed vector. -- index, x1, y1, x2, y2 data World = World- { worldSegments :: Array Segment }+ { worldSegments :: V.Vector Segment } -- | Generate the initial world.@@ -35,7 +34,7 @@ let makePoint n' (cX, cY) (dX, dY) = (n', (cX, cY), (cX + dX, cY + dY)) - let segs = A.zipWith3 makePoint (A.enumFromTo 0 (n - 1)) centers deltas+ let segs = V.zipWith3 makePoint (V.enumFromTo 0 (n - 1)) centers deltas return $ World segs @@ -44,7 +43,7 @@ -- and split segements that cross the y=0 line. normaliseWorld :: Point -> World -> World normaliseWorld (px, py) world- = let segments_trans = A.map (translateSegment (-px) (-py)) + = let segments_trans = V.map (translateSegment (-px) (-py)) $ worldSegments world segments_split = splitSegmentsOnY 0 segments_trans
gloss-examples.cabal view
@@ -1,5 +1,5 @@ Name: gloss-examples-Version: 1.3.0.1+Version: 1.3.1.1 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -101,7 +101,7 @@ Build-depends: base == 4.*, gloss == 1.3.*,- vector >= 0.5 && < 0.8+ vector == 0.7.* Main-is: Main.hs other-modules: Cell World hs-source-dirs: Conway@@ -119,9 +119,10 @@ Executable gloss-visibility Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.3.*,+ vector == 0.7.* Main-is: Main.hs- other-modules: Array Draw Interface State World Geometry.Randomish Geometry.Segment+ other-modules: Draw Interface State World Geometry.Randomish Geometry.Segment hs-source-dirs: Visibility ghc-options: -O2