# gousiosg/teapots

Merge pull request #10 from jjpe/master

`Added the Triangles project`
2 parents e67f8e9 + 171fd01 commit 9aa501184b3e2b3bdf2bf0e3e5144278707d9257 committed Oct 12, 2012
7 Triangles/.gitignore
 @@ -0,0 +1,7 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +RawTriangleData.hs
97 Triangles/Decomposition.hs
 @@ -0,0 +1,97 @@ +module Decomposition ( decompose, Triangle ) where + +import Graphics.Gloss +import Data.List + +type Triangle = (Point, Point, Point) + +-- sorts a list of points based on the Double returned from the given function +sortByCoord :: (Point->Float)->Point->Point->Ordering +sortByCoord f a b = compare (f a) (f b) + +-- returns the x coordinate of a point +xCoord :: Point -> Float +xCoord (a,b) = a + +-- returns the y coordinate of a point +yCoord :: Point -> Float +yCoord (a,b) = b + +-- returns the points of a triangle +points :: Triangle -> [Point] +points (a,b,c) = [a,b,c] + +-- determines if any of the points are the same after applying the given function +isStraight :: (Point->Float)->Triangle -> Bool +isStraight f t + | f (ps !! 0) == (f (ps !! 1)) = True + | f (ps !! 1) == (f (ps !! 2)) = True + | otherwise = False + where ps = sortBy (sortByCoord f) (points t) + +-- shortcut to check if a triangle has 2 points with the same y +isHorizontal :: Triangle -> Bool +isHorizontal t = isStraight yCoord t + +-- shortcut to check if a triangle has 2 points with the same x +isVertical :: Triangle -> Bool +isVertical t = isStraight xCoord t + +-- checks if a triangle is both vertical and horizontal +isRight :: Triangle -> Bool +isRight t = isHorizontal t && isVertical t + +-- returns the point with the middle value, determined by the given function +middle :: (Point->Float)->Triangle->Point +middle f t = sortBy (sortByCoord f) (points t) !! 1 + +-- projects the middle horizontal point on the opposing edge, resulting in 2 triangles +-- both with 1 horizontal edge, don't call this on horizontal triangles +projectHorizontal :: Triangle -> [Triangle] +projectHorizontal t = project yCoord xCoord combineY t + +-- see projectHorizontal, only this time we project vertical +projectVertical :: Triangle -> [Triangle] +projectVertical t = project xCoord yCoord combineX t + + +combineX :: Float->Float->Point +combineX x y = (x,y) + +combineY :: Float->Float->Point +combineY y x = (x,y) + +-- project the middle point to the opposing edge and return the two triangles it creates +-- f1 is the coordinate to keep steady +-- f2 is the other coordinate +-- f3 is the combine function, which will be handed the steady and the computed coordinate +project :: (Point->Float)->(Point->Float)->(Float->Float->Point)->Triangle->[Triangle] +project f1 f2 f3 t = + [(a,b,p), (b,p,c)] + where + ps = sortBy (sortByCoord f1) (points t) + a = ps !! 0 + b = ps !! 1 + c = ps !! 2 + r = (f2 c - f2 a) / (f1 c - f1 a) + p = f3 (f1 b) (f2 a + (f1 b - f1 a) * r) + +distance :: Point -> Point -> Float +distance a b = + sqrt ((xCoord b - xCoord a)^2 + (yCoord b - yCoord a)^2) + +decomposeToHorizontal :: Triangle -> [Triangle] +decomposeToHorizontal t + | isHorizontal t = [t] + | otherwise = projectHorizontal t + +-- decomposes until the distance treshold is met +-- FIXME treshold not implemented +decomposeToRight :: Triangle -> [Triangle] +decomposeToRight t + | not (isHorizontal t) = concat (map decomposeToRight (projectHorizontal t)) + | isRight t = [t] + | otherwise = concat(map decomposeToRight (projectVertical t)) + +decompose :: [Triangle] -> [Triangle] +decompose ts = concat (map decomposeToRight ts)
 @@ -0,0 +1,28 @@ +Triangles +========= + +# Prerequisites + +* The Glasgow Haskell Compiler (GHC) +* The Gloss graphics library +* Python 3 (Tested only on 3.2) +* sh-compatible shell (Sorry windows users) +* The Gloss library +* GLUT (necessary for Gloss) + +# Compilation + +Just run ./compile.sh. +It will first generate a necessary haskell source file +(RawTriangleData.hs), then compile the system. + +# Running the program + +Just run ./run.sh. +Alternatively, ./Visualizatuon can be run, but that will only be +available after compilation. + +# Cleanup + +Just run ./clean.sh. +This will remove all generated files, including RawTriangleData.hs.
880 Triangles/TweakedPot.txt
880 additions, 0 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
18 Triangles/Visualization.hs
 @@ -0,0 +1,18 @@ +-- Visualize triangles using the Gloss library + +import Graphics.Gloss +import System.Random +--Custom algorithm module to decompose to right triangles (contains the Triangle type) +import Decomposition +import RawTriangleData + +tupletolist3 :: (a, a, a) -> [a] +tupletolist3 (x, y, z) = [x, y, z, x] + +pathFromTriangle :: Triangle -> Path +pathFromTriangle triangle = tupletolist3 triangle + +picturesFromTriangles :: [Triangle] -> [Picture] +picturesFromTriangles triangles = map line (map pathFromTriangle triangles) + +main = display (InWindow "Triangles" (800, 600) (10, 10)) white (color black (pictures (picturesFromTriangles (decompose (triangles triangleList)))))
3 Triangles/clean.sh
 @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +rm -rf *.hi *.o RawTriangleData.hs Visualization
3 Triangles/compile.sh
 @@ -0,0 +1,3 @@ +#!/usr/bin/env bash + +./reader.py TweakedPot.txt && ghc Visualization.hs