-
Notifications
You must be signed in to change notification settings - Fork 4
/
Geometry2D.hs
83 lines (63 loc) · 2.59 KB
/
Geometry2D.hs
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
{-
2D Geometry
HGamer3D Library (A project to enable 3D game development in Haskell)
Copyright 2011-2015 Peter Althainz
Distributed under the Apache License, Version 2.0
(See attached file LICENSE or copy at
http://www.apache.org/licenses/LICENSE-2.0)
file: HGamer3D/Data/Geometry2D.hs
-}
{-# LANGUAGE FlexibleInstances, DatatypeContexts #-}
-- | Type definitions for 2D geometry
module HGamer3D.Data.Geometry2D
(
-- * Geometry
Point (..),
Rectangle (..),
ctScreenRect,
rectFromPoints,
pointsFromRect
) where
import Data.MessagePack
import Fresco
-- | A point has two coordinates an x and y one
data Num a => Point a = Point {
ptX :: a,
ptY :: a
} deriving (Eq, Show)
instance ComponentClass (Point Float) where
toObj (Point a b) = ObjectArray [ObjectFloat a, ObjectFloat b]
fromObj (ObjectArray [ObjectFloat a, ObjectFloat b]) = (Point a b)
instance ComponentClass (Point Int) where
toObj (Point a b) = ObjectArray [ObjectInt (fromIntegral a), ObjectInt (fromIntegral b)]
fromObj (ObjectArray [ObjectInt a, ObjectInt b]) = (Point (fromIntegral a) (fromIntegral b))
-- | A rectangle has an a position as x and y and widht and height
data Num a => Rectangle a = Rectangle {
xpos :: a,
ypos :: a,
width :: a,
height :: a } deriving (Eq, Show)
ctScreenRect :: ComponentType (Rectangle Int)
ctScreenRect = ComponentType 0x16877957e32da6b1
instance ComponentClass (Rectangle Float) where
toObj (Rectangle x y w h) = ObjectArray [ObjectFloat x, ObjectFloat y, ObjectFloat w, ObjectFloat h]
fromObj (ObjectArray [ObjectFloat x, ObjectFloat y, ObjectFloat w, ObjectFloat h]) = (Rectangle x y w h)
instance ComponentClass (Rectangle Int) where
toObj (Rectangle x y w h) = ObjectArray [ObjectInt (fromIntegral x), ObjectInt (fromIntegral y), ObjectInt (fromIntegral w), ObjectInt (fromIntegral h)]
fromObj (ObjectArray [ObjectInt x, ObjectInt y, ObjectInt w, ObjectInt h]) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
-- | derive a rectangle from upper left and lower right points
rectFromPoints :: Num a => Point a -> Point a -> Rectangle a
rectFromPoints upperLeft lowerRight = Rectangle rx ry rw rh where
rx = ptX upperLeft
ry = ptY upperLeft
rw = (ptY lowerRight) - rx
rh = (ptY lowerRight) - ry
-- | get upper left and lower right point from a rect
pointsFromRect :: Num a => Rectangle a -> (Point a, Point a)
pointsFromRect rect = (ul, lr) where
rx = xpos rect
ry = ypos rect
rx' = rx + (width rect)
ry' = ry + (height rect)
ul = Point rx ry
lr = Point rx' ry'