Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: dmw/prjeuler
base: 1ad7d7be26
...
head fork: dmw/prjeuler
compare: 0874eee613
Checking mergeability… Don't worry, you can still create the pull request.
  • 2 commits
  • 1 file changed
  • 0 commit comments
  • 1 contributor
Showing with 74 additions and 22 deletions.
  1. +74 −22 src/problem102.hs
View
96 src/problem102.hs
@@ -6,9 +6,11 @@ module Main (main) where
import Data.List.Split
import Data.String.Utils (strip)
import Graphics.Rendering.OpenGL
+import qualified Graphics.Rendering.FTGL as F
import Graphics.UI.GLUT
import System.Environment
-import System.IO
+import System.Exit
+import Text.Printf
data LPt = LPt (Int, Int)
@@ -40,45 +42,64 @@ instance Num LPt where
crossPt :: LPt -> LPt -> LPt
crossPt x y = LPt (0, fstp x * sndp y - sndp x * fstp y)
+
zidxZero :: GLfloat
zidxZero = 0.0 :: GLfloat
+
+colorCyan :: IO ()
+colorCyan = color $ Color3 0 (1.0 :: GLfloat) (1.0 :: GLfloat)
+
+
+colorGreen :: IO ()
+colorGreen = color $ Color3 0 (1.0 :: GLfloat) 0
+
+
zeroPt :: LPt
zeroPt = LPt (0, 0)
+
fstp :: LPt -> Int
fstp (LPt (x, y)) = x
+
sndp :: LPt -> Int
sndp (LPt (x, y)) = y
+
ptGlF :: LPt -> (GLfloat, GLfloat)
ptGlF p = ((fromIntegral (fstp p) / 1000.0) :: GLfloat,
(fromIntegral (sndp p) / 1000.0) :: GLfloat)
+
ptToGlPt :: LPt -> IO ()
ptToGlPt p = vertex $ uncurry Vertex3 (ptGlF p) zidxZero
+
mkTriangle :: String -> LTrg
mkTriangle s = LTrg { tA = head g, tB = g !! 1, tC = last g }
where g = fmap (\x -> LPt (head x, last x) )
$ splitEvery 2 ln
ln = fmap (read . strip) $ splitOn "," s
+
trgColor :: LTrg -> IO ()
-trgColor xs = if trgContained zeroPt xs
- then color $ Color3 0 0 (1.0 :: GLfloat)
- else color $ Color3 0 (0.25 :: GLfloat) 0
+trgColor xs | trgContained zeroPt xs = colorCyan
+trgColor xs = colorGreen
+
+
+displayText :: String -> F.Font -> IO ()
+displayText text font = do
+ F.renderFont font text F.All
+ flush
-displayTriangle :: LTrg -> IO ()
-displayTriangle xs = do renderPrimitive Polygon $ do
- trgColor xs
- mapM ptToGlPt [tA xs, tB xs, tC xs]
- flush
-displayTriangles :: [LTrg] -> IO ()
-displayTriangles xs = do clear [ ColorBuffer, DepthBuffer ]
- mapM_ displayTriangle xs
+trgTextCont :: [LTrg] -> F.Font -> IO ()
+trgTextCont xs = displayText text
+ where text = printf "Match: %d | Unmatch: %d" cnts cnts2
+ cnts2 = length xs - cnts
+ cnts = length $ filter (trgContained zeroPt) xs
+
mkTriangles :: String -> Int -> Int -> [LTrg]
mkTriangles s l h = drop l
@@ -87,6 +108,7 @@ mkTriangles s l h = drop l
$ filter (\ x -> length x > 0 )
$ lines s
+
trgContained :: LPt -> LTrg -> Bool
trgContained p t = sndp crs1 >= 0 && sndp crs2 >= 0 && sndp crs3 >= 0
|| sndp crs1 <= 0 && sndp crs2 <= 0 && sndp crs3 <= 0
@@ -97,16 +119,46 @@ trgContained p t = sndp crs1 >= 0 && sndp crs2 >= 0 && sndp crs3 >= 0
seg2 = tC t - tB t
seg3 = tA t - tC t
+
+displayTriangle :: LTrg -> IO ()
+displayTriangle xs = do _ <- renderPrimitive Polygon $ do
+ trgColor xs
+ mapM ptToGlPt [tA xs, tB xs, tC xs]
+ flush
+
+
+displayTriangles :: [LTrg] -> F.Font -> IO ()
+displayTriangles xs f = do clear [ ColorBuffer, DepthBuffer ]
+ mapM_ displayTriangle xs
+ trgTextCont xs f
+ flush
+
+
+handlerIOError :: IOError -> IO ()
+handlerIOError e = putStrLn (printf "IOError: %s" $ show e)
+ >> putStrLn (printf "Usage: problem102 triangles.txt low-bound hi-bound")
+ >> exitFailure
+
+
+
+mainGl :: IO ()
+mainGl = do [x,y,z] <- getArgs
+ inp <- readFile x
+ (progname, _) <- getArgsAndInitialize
+ loadIdentity
+ initialWindowSize $= Size 800 800
+ _ <- createWindow "Triangles Display"
+ matrixMode $= Projection
+ polygonMode $= (Line, Line)
+ font <- F.createPixmapFont "aller.ttf"
+ _ <- F.setFontFaceSize font 24 24
+ _ <- F.setFontDepth font 1.0
+ displayCallback $= displayTriangles (mkTriangles inp (read y) (read z)) font
+ mainLoop
+
+
+
main :: IO ()
-main = do [x,y,z] <- getArgs
- inp <- readFile x
- (progname, _) <- getArgsAndInitialize
- loadIdentity
- initialWindowSize $= Size 800 800
- createWindow "Trimatrix Display"
- matrixMode $= Projection
- polygonMode $= (Line, Line)
- displayCallback $= displayTriangles (mkTriangles inp (read y) (read z))
- mainLoop
+main = mainGl `catch` handlerIOError

No commit comments for this range

Something went wrong with that request. Please try again.