hasufell/cga
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Port to diagrams >1.3

Browse Source
This commit is contained in:
hasufell 2015-05-21 01:39:34 +02:00
parent e9786df1e2
commit 7fe3aa8458
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
8 changed files with 52 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Algebra/Vector.hs
View File

@ -13,8 +13,8 @@ import GHC.Float
import MyPrelude
type Vec = R2
type PT = P2
type Vec = V2 Double
type PT = P2 Double
type Coord = (Double, Double)
type Segment = (PT, PT)
type Square = (Coord, Coord)
@ -64,12 +64,12 @@ vecLength v = sqrt (x^(2 :: Int) + y^(2 :: Int))
-- |Compute the scalar product of two vectors.
scalarProd :: Vec -> Vec -> Double
scalarProd (R2 a1 a2) (R2 b1 b2) = a1 * b1 + a2 * b2
scalarProd (V2 a1 a2) (V2 b1 b2) = a1 * b1 + a2 * b2
-- |Multiply a scalar with a vector.
scalarMul :: Double -> Vec -> Vec
scalarMul d (R2 a b) = R2 (a * d) (b * d)
scalarMul d (V2 a b) = V2 (a * d) (b * d)
-- |Construct a vector that points to a point from the origin.

18
CG2.cabal
View File

@ -81,9 +81,9 @@ executable Gtk
bytestring >= 0.10.4.0,
containers >= 0.5.0.0,
dequeue >= 0.1.5,
diagrams-lib >=1.2,
diagrams-cairo >=1.2,
diagrams-contrib >= 1.1.2.1,
diagrams-lib >=1.3,
diagrams-cairo >=1.3,
diagrams-contrib >= 1.3.0.0,
directory >=1.2,
filepath >= 1.3.0.2,
glade >=0.12,
@ -131,9 +131,9 @@ executable Gif
bytestring >= 0.10.4.0,
containers >= 0.5.0.0,
dequeue >= 0.1.5,
diagrams-lib >=1.2,
diagrams-cairo >=1.2,
diagrams-contrib >= 1.1.2.1,
diagrams-lib >=1.3,
diagrams-cairo >=1.3,
diagrams-contrib >= 1.3.0.0,
gloss >= 1.2.0.1,
JuicyPixels >= 3.1.7.1,
safe >= 0.3.8,
@ -179,9 +179,9 @@ executable Test
base >=4.6,
bytestring >= 0.10.4.0,
containers >= 0.5.0.0,
diagrams-lib >=1.2,
diagrams-cairo >=1.2,
diagrams-contrib >= 1.1.2.1,
diagrams-lib >=1.3,
diagrams-cairo >=1.3,
diagrams-contrib >= 1.3.0.0,
gloss >= 1.2.0.1,
QuickCheck >= 2.4.2,
safe >= 0.3.8

8
GUI/Gtk.hs
View File

@ -63,9 +63,9 @@ data MyGUI = MkMyGUI {
-- |Path entry widget for the quad tree.
quadPathEntry :: Entry,
-- |Horizontal box containing the path entry widget.
vbox7 :: Box,
vbox7 :: Graphics.UI.Gtk.Box,
-- |Horizontal box containing the Rang search entry widgets.
vbox10 :: Box,
vbox10 :: Graphics.UI.Gtk.Box,
-- |Range entry widget for lower x bound
rangeXminEntry :: Entry,
-- |Range entry widget for upper x bound
@ -299,9 +299,9 @@ saveAndDrawDiag fp fps mygui =
renderDiag winWidth winHeight buildDiag =
renderDia Cairo
(CairoOptions fps
(Dims (fromIntegral winWidth) (fromIntegral winHeight))
(mkSizeSpec2D (Just $ fromIntegral winWidth) (Just $ fromIntegral winHeight))
SVG False)
(buildDiag (def{
(buildDiag (MyPrelude.def{
dotSize = scaleVal,
xDimension = fromMaybe (0, 500) xDim,
yDimension = fromMaybe (0, 500) yDim,

2
Graphics/Diagram/AlgoDiags.hs
View File

@ -233,7 +233,7 @@ treePretty = Diag f
getCurQT (q:qs) z = case q of
Right x -> getCurQT qs (fromMaybe z (findNeighbor x z))
Left x -> getCurQT qs (fromMaybe z (goQuad x z))
prettyRoseTree :: Tree String -> Diagram Cairo R2
prettyRoseTree :: Tree String -> Diagram Cairo
prettyRoseTree tree =
-- HACK: in order to give specific nodes a specific color
renderTree (\n -> case head n of

14
Graphics/Diagram/Core.hs
View File

@ -16,7 +16,7 @@ data Diag =
{
mkDiag :: DiagProp
-> [[PT]]
-> Diagram Cairo R2
-> Diagram Cairo
}
| GifDiag
{
@ -24,9 +24,9 @@ data Diag =
-> Colour Double
-> ([PT] -> [[PT]])
-> [PT]
-> [Diagram Cairo R2]
-> [Diagram Cairo]
}
| EmptyDiag (Diagram Cairo R2)
| EmptyDiag (Diagram Cairo)
-- |Holds the properties for a Diagram, like thickness of 2d points etc.
@ -148,19 +148,19 @@ diagDimSquare p = dimToSquare (xDimension p) $ yDimension p
-- |Draw a list of points.
drawP :: [PT] -- ^ the points to draw
-> Double -- ^ dot size
-> Diagram Cairo R2 -- ^ the resulting diagram
-> Diagram Cairo -- ^ the resulting diagram
drawP [] _ = mempty
drawP vt ds =
position (zip vt (repeat dot))
where
dot = circle ds :: Diagram Cairo R2
dot = circle ds :: Diagram Cairo
-- |Create a rectangle around a diagonal line, which has sw
-- as startpoint and nw as endpoint.
rectByDiagonal :: (Double, Double) -- ^ sw point
-> (Double, Double) -- ^ nw point
-> Diagram Cairo R2
-> Diagram Cairo
rectByDiagonal (xmin, ymin) (xmax, ymax) =
fromVertices [p2 (xmin, ymin)
, p2 (xmax, ymin)
@ -172,7 +172,7 @@ rectByDiagonal (xmin, ymin) (xmax, ymax) =
-- |Creates a Diagram from a point that shows the coordinates
-- in text format, such as "(1.0, 2.0)".
pointToTextCoord :: PT -> Diagram Cairo R2
pointToTextCoord :: PT -> Diagram Cairo
pointToTextCoord pt =
text ("(" ++ (show . trim') x ++ ", " ++ (show . trim') y ++ ")") # scale 10
where

4
Graphics/Diagram/Gif.hs
View File

@ -16,7 +16,7 @@ import Parser.Meshparser
-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo, GifDelay)]
gifDiag p xs =
fmap ((\x -> (x, 50)) . (<> nonChDiag))
(upperHullList
@ -35,5 +35,5 @@ gifDiag p xs =
-- |Same as gifDiag, except that it takes a string containing the
-- mesh file content instead of the the points.
gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo R2, GifDelay)]
gifDiagS :: DiagProp -> B.ByteString -> [(Diagram Cairo, GifDelay)]
gifDiagS p = gifDiag p . filterValidPT p . meshVertices

6
Graphics/Diagram/Gtk.hs
View File

@ -46,7 +46,7 @@ diagTreAlgos =
-- |Create the Diagram from the points.
diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo R2
diag :: DiagProp -> [DiagAlgo] -> [[PT]] -> Diagram Cairo
diag p das vts = maybe mempty (\x -> mkDiag x p vts)
$ mconcat
-- get the actual [Diag] array
@ -58,7 +58,7 @@ diag p das vts = maybe mempty (\x -> mkDiag x p vts)
-- |Create the Diagram from a String which is supposed to be the contents
-- of an obj file.
diagS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagS :: DiagProp -> B.ByteString -> Diagram Cairo
diagS p mesh =
diag p diagAlgos
. fmap (filterValidPT p)
@ -69,7 +69,7 @@ diagS p mesh =
-- |Create the tree diagram from a String which is supposed to be the contents
-- of an obj file.
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo R2
diagTreeS :: DiagProp -> B.ByteString -> Diagram Cairo
diagTreeS p mesh =
diag p diagTreAlgos
. fmap (filterValidPT p)

44
Test/Vector.hs
View File

@ -21,19 +21,19 @@ newtype PosRoundDouble = PosRoundDouble { getPRD :: Double }
deriving (Eq, Ord, Show, Read)
newtype RoundR2 = RoundR2 { getRR2 :: R2 }
newtype RoundR2 = RoundR2 { getRR2 :: V2 Double }
deriving (Eq, Ord, Show, Read)
newtype PosRoundR2 = PosRoundR2 { getPRR2 :: R2 }
newtype PosRoundR2 = PosRoundR2 { getPRR2 :: V2 Double }
deriving (Eq, Ord, Show, Read)
newtype RoundP2 = RoundP2 { getRP2 :: P2 }
newtype RoundP2 = RoundP2 { getRP2 :: P2 Double }
deriving (Eq, Ord, Show, Read)
newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 }
newtype PosRoundP2 = PosRoundP2 { getPRP2 :: P2 Double }
deriving (Eq, Ord, Show, Read)
@ -72,11 +72,11 @@ instance Arbitrary PosRoundP2 where
<*> (arbitrary :: Gen PosRoundDouble)
instance Arbitrary R2 where
instance Arbitrary (V2 Double) where
arbitrary = curry r2 <$> arbitrary <*> arbitrary
instance Arbitrary P2 where
instance Arbitrary (P2 Double) where
arbitrary = curry p2 <$> arbitrary <*> arbitrary
@ -131,42 +131,42 @@ onPTProp1 pt = onPT id pt == pt
-- add a random value to the point coordinates
onPTProp2 :: PT -> Positive R2 -> Bool
onPTProp2 pt (Positive (R2 rx ry))
onPTProp2 :: PT -> Positive (V2 Double) -> Bool
onPTProp2 pt (Positive (V2 rx ry))
= onPT (\(x, y) -> (x + rx, y + ry)) pt /= pt
-- angle between two vectors both on the x-axis must be 0
getAngleProp1 :: Positive Vec -> Positive Vec -> Bool
getAngleProp1 (Positive (R2 x1 _)) (Positive (R2 x2 _))
= getAngle (R2 x1 0) (R2 x2 0) == 0
getAngleProp1 (Positive (V2 x1 _)) (Positive (V2 x2 _))
= getAngle (V2 x1 0) (V2 x2 0) == 0
-- angle between two vectors both on the y-axis must be 0
getAngleProp2 :: Positive Vec -> Positive Vec -> Bool
getAngleProp2 (Positive (R2 _ y1)) (Positive (R2 _ y2))
= getAngle (R2 0 y1) (R2 0 y2) == 0
getAngleProp2 (Positive (V2 _ y1)) (Positive (V2 _ y2))
= getAngle (V2 0 y1) (V2 0 y2) == 0
-- angle between two vectors both on the x-axis but with opposite direction
-- must be pi
getAngleProp3 :: Positive Vec -> Positive Vec -> Bool
getAngleProp3 (Positive (R2 x1 _)) (Positive (R2 x2 _))
= getAngle (R2 (negate x1) 0) (R2 x2 0) == pi
getAngleProp3 (Positive (V2 x1 _)) (Positive (V2 x2 _))
= getAngle (V2 (negate x1) 0) (V2 x2 0) == pi
-- angle between two vectors both on the y-axis but with opposite direction
-- must be pi
getAngleProp4 :: Positive Vec -> Positive Vec -> Bool
getAngleProp4 (Positive (R2 _ y1)) (Positive (R2 _ y2))
= getAngle (R2 0 (negate y1)) (R2 0 y2) == pi
getAngleProp4 (Positive (V2 _ y1)) (Positive (V2 _ y2))
= getAngle (V2 0 (negate y1)) (V2 0 y2) == pi
-- angle between vector in x-axis direction and y-axis direction must be
-- p/2
getAngleProp5 :: Positive Vec -> Positive Vec -> Bool
getAngleProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2))
= getAngle (R2 x1 0) (R2 0 y2) == pi / 2
getAngleProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2))
= getAngle (V2 x1 0) (V2 0 y2) == pi / 2
-- commutative
@ -213,8 +213,8 @@ scalarProdProp4 (RoundDouble s1) (RoundDouble s2) (RoundR2 v1) (RoundR2 v2)
-- orthogonal
scalarProdProp5 :: Positive Vec -> Positive Vec -> Bool
scalarProdProp5 (Positive (R2 x1 _)) (Positive (R2 _ y2))
= scalarProd (R2 x1 0) (R2 0 y2) == 0
scalarProdProp5 (Positive (V2 x1 _)) (Positive (V2 _ y2))
= scalarProd (V2 x1 0) (V2 0 y2) == 0
-- this is almost the same as the function definition
@ -262,10 +262,10 @@ vp2Prop1 p1' p2'
vp2Prop2 :: PT -> PT -> Bool
vp2Prop2 p1' p2'
| p1' == origin && p2' == origin = True
| otherwise = vp2 p1' p2' == (\(R2 x y) -> negate x ^& negate y)
| otherwise = vp2 p1' p2' == (\(V2 x y) -> negate x ^& negate y)
(vp2 p2' p1')
&&
vp2 p2' p1' == (\(R2 x y) -> negate x ^& negate y)
vp2 p2' p1' == (\(V2 x y) -> negate x ^& negate y)
(vp2 p1' p2')