PureVector2D.elm

module Vec2 where

import Transform2D

type Vec = {x: Float, y:Float}
 
type Tform = {a: Float, b:Float, c: Float, d:Float, x: Float, y:Float}
 
eps = 0.0000001
 
--curried version of vector construction
vec : Float -> Float -> Vec
vec x y = {x=x, y=y}
 
--element-wise addition
add : Vec -> Vec -> Vec
add p1 p2 = {x=p1.x + p2.x, y=p1.y + p2.y}
 
 
--Scalar multiplication
smult : Float -> Vec -> Vec
smult s p = {x = s*p.x, y=s*p.y}
 
--Vector subtraction
sub : Vec -> Vec -> Vec
sub p1 p2 = {x=p1.x - p2.x, y=p1.y - p2.y}
 

 
--vector dot product
dot : Vec -> Vec -> Float
dot p1 p2 = (p1.x * p2.x) + (p1.y * p2.y)
 
cross : Vec -> Vec -> Float
cross p1 p2 = p1.x*p2.y - p1.y*p2.x

 
--Euclidean Vector norm
len : Vec -> Float
len v = sqrt <| v `dot` v
 
--Vector length squared, avoid expensive sqrt
lenSq : Vec -> Float
lenSq v = v `dot` v
 
--Euclidean distance between vectors
dist : Vec -> Vec -> Float
dist p1 p2 = len <| p1 `sub` p2
 
--Normalize a vector to length 1
normalize : Vec -> Vec
normalize v = smult (1.0/(len v)) v
 
--Test if two vectors are parallel
parallel : Vec -> Vec -> Bool
parallel p q = (abs <| cross p q) < eps
 
--Test if two vectors are perpendicular
perpendicular : Vec -> Vec -> Bool
perpendicular p q = p `dot` q < eps
 
--Distance squared between vectors, avoids costly sqrt
distSq : Vec -> Vec -> Float
distSq p1 p2 = lenSq <| p1 `sub` p2
--Manhattan distance between vectors
manh : Vec -> Vec -> Float
manh p1 p2 = (abs <| p1.x-p2.x) + (abs <| p1.y-p2.y)
 
--2D identity
id2 : Tform
id2 = {a=1.0, b=0.0, c=0.0, d=1.0, x=0.0, y=0.0}

--Create an affine transformation from a given 2x2 matrix and translation vector
affine2 : ((Float, Float), (Float, Float)) -> Vec -> Tform
affine2 ((a,b),(c,d)) v = {a=a, b=b, c=c, d=d, x=v.x, y=v.y}

--Translate by a given vector
translate : Vec -> Tform
translate v = {a=1.0, b=0.0, c=0.0, d=1.0, x=v.x, y=v.y}
 
--Scale x and y equally by a given factor
scale : Float -> Tform
scale s = {a=s, b=0.0, c=0.0, d=s, x=0.0, y=0.0}
 
--Scale x by a given factor
scaleX : Float -> Tform
scaleX s = {a=s, b=0.0, c=0.0, d=1.0, x=0.0, y=0.0}
 
--Scale y by a given factor
scaleY : Float -> Tform
scaleY s = {a=1.0, b=0.0, c=0.0, d=s, x=0.0, y=0.0}

--Convert a Tform to Transform2D
toTransform : Tform -> Transform2D.Transform2D
toTransform m = Transform2D.matrix m.a m.b m.c m.d m.x m.y
 
--Parametric representation of a line
--We assume that dir is of unit length
type Line = {point : Vec, dir : Vec}
 
--A line segment is a line with unit length direction
--And a distance past the initial point
type Segment = {line : Line, length : Float}
 
--Find the unique line connecting two points
line : Vec -> Vec -> Line
line p q = let
    dir = normalize <| q `sub` p
  in {point = p, dir = dir}
--Find the line segment connecting two points
--By finding the line connecting them and their distance
segment : Vec -> Vec -> Segment
segment p q = let
    line = Line p q
    length = dist p q
  in {line = line, length = length}
 
 
--Line intersection, find the parameter values along line1 and Line where they cross
lineInter : Line -> Line -> Maybe (Float, Float)
lineInter l1 l2 = if
  | parallel l1.dir l2.dir -> Nothing
  | otherwise -> let
        d1 = l1.dir
        d2 = l2.dir
        p1 = l1.point
        p2 = l2.point
        factor = d2.y - (d1.y*d2.x)/d1.x
        lhs = p1.y + (d1.y*p2.x - d1.y*p1.x)/d1.x - p2.y
        t2 = lhs / factor
        t1 = (p2.x - p1.x + t2*d2.x)/d1.x
      in Just (t1,t2)
 
--Line segment intersection
segInter : Segment -> Segment -> Bool
segInter s1 s2 = case lineInter s1.line s2.line of
  Nothing -> False
  Just (t1, t2) -> t1 >= 0 && t2 >= 0 && t1 <= s1.length && t2 <= s2.length 
 
--All the data we need to make an axis-aligned bounding box
--This is NOT meant to be used as a constructor
data AABB = AABB {width : Float,
             height : Float,
             tl : Vec,
             tr : Vec,
             bl : Vec,
             br : Vec,
             leftEdge : Segment,
             rightEdge: Segment,
             topEdge : Segment,
             bottomEdge : Segment}
             
--Given a top-left corner, width and height, make an AABB object

makeAABB : Vec -> Float -> Float -> AABB
makeAABB tl width height = let
    tr = {tl | x <- tl.x + width}
    bl = {tl | y <- tl.y + height}
    br = {bl | x <- bl.x + width}
    topEdge = segment tl tr
    bottomEdge = segment bl br
    leftEdge = segment bl tl
    rightEdge = segment br tr
  in AABB {width = width, height=height, tr = tr, bl = bl, br=br, tl=tl, topEdge=topEdge, bottomEdge = bottomEdge, leftEdge = leftEdge, rightEdge = rightEdge}


boxEdges : AABB -> [Segment]
boxEdges (AABB box) = [box.leftEdge, box.rightEdge, box.topEdge, box.bottomEdge]

boxCorners : AABB -> [Vec]
boxCorners (AABB box) = [box.tl, box.tr, box.bl, box.br]

inAABB : Vec -> AABB -> Bool
inAABB v (AABB box) = v.x >= box.tl.x && v.x <= box.tr.x && v.y >= box.bl.y && v.x <= box.tl.x

flatten : [[c]] -> [c]
flatten l = case l of
  [] -> []
  (h :: t) -> h ++ flatten t

listCross: [a] -> [b] -> [(a,b)]
listCross l1 l2 = flatten <| map (\s1 -> map (\s2 -> (s1, s2)) l2)  l1

null l = case l of 
  [] -> True
  _ -> False

collideAABB : AABB -> AABB -> Bool
collideAABB b1 b2 = let
    edgePairs = listCross (boxEdges b1) (boxEdges b2)
    crossings = filter (\(s1, s2) -> segInter s1 s2)  edgePairs
  in case crossings of
      (_::_) -> True
      [] -> let
          pointsIn2 = map (\v -> inAABB v b2) <| boxCorners b1
          pointsIn1 = map (\v -> inAABB v b1) <| boxCorners b2
        in if null (pointsIn1 ++ pointsIn2) then False else True

main = plainText "Hello"