diff --git a/Ordinary.cabal b/Ordinary.cabal
--- a/Ordinary.cabal
+++ b/Ordinary.cabal
@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 9909577fb7437b58a07f0ec82a4f7210e1deae44f65f791093471b1b3806d17d
+-- hash: ebc3c9bd3445afb4088fcc7e3f742e5565a5fd65b9b047efb8617eee3beb80f2
 
 name:           Ordinary
-version:        0.2018.1.3
+version:        0.2018.1.4
 synopsis:       Short description of your package
 description:    Please see the README on Github at <https://github.com/MarisaKirisame/Ordinary#readme>
 homepage:       https://github.com/MarisaKirisame/Ordinary#readme
diff --git a/src/Lib.hs b/src/Lib.hs
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -7,6 +7,7 @@
 import qualified Graphics.UI.Threepenny as UI
 import Graphics.UI.Threepenny.Core
 import Safe
+import Data.List
 
 someFunc :: IO ()
 someFunc = startGUI defaultConfig setup
@@ -42,8 +43,8 @@
 currentStroke :: MonadIO m => Element -> m (Behavior (Reversed (Int, Int)))
 currentStroke e = do
   mouseIsDown <- (fmap . fmap) (const . (== MouseDown)) $ mouseState e
-  mouseDownMove <- return $ fmap (\x (Reversed xs) -> Reversed (x:xs)) $ filterApply mouseIsDown $ UI.mousemove e
-  mouseUpClear <- return $ fmap (const $ const $ Reversed []) $ UI.mouseup e
+  let mouseDownMove = fmap (\x (Reversed xs) -> Reversed (x:xs)) $ filterApply mouseIsDown $ UI.mousemove e
+  let mouseUpClear = fmap (const $ const $ Reversed []) $ UI.mouseup e
   accumB (Reversed []) (unionWith undefined mouseDownMove mouseUpClear)
 
 mouseStroke :: MonadIO m => Element -> m (Event (Reversed (Int, Int)))
@@ -54,19 +55,81 @@
 smooth :: Double -> [UI.Point] -> [UI.Point]
 smooth smoothFact x = scanl1 (\(xl, xr) (yl, yr) -> (smoothFact * xl + (1 - smoothFact) * yl, smoothFact * xr + (1 - smoothFact) * yr)) x
 
+thin :: Double -> [UI.Point] -> [UI.Point]
+thin dist [] = []
+thin dist (x@(lx, ly):xs) = x : thin dist (dropWhile (\(rx, ry) -> (lx - rx) ** 2 + (ly - ry) ** 2 < dist ** 2) xs)
+
+data Curvature = CUp | CDown | CLeft | CRight deriving (Eq, Ord, Show)
+
+mapBetween :: (a -> a -> b) -> [a] -> [b]
+mapBetween f x | length x < 2 = []
+mapBetween f x = zipWith f x (tail x)
+
+mapBetween4 :: (a -> a -> a -> a -> b) -> [a] -> [b]
+mapBetween4 f x | length x < 4 = []
+mapBetween4 f x = zipWith4 f x tx ttx tttx
+  where
+    tx = tail x
+    ttx = tail tx
+    tttx = tail ttx
+
+direction :: UI.Point -> UI.Point -> Curvature
+direction (lx, ly) (rx, ry) =
+  if abs (lx - rx) < abs (ly - ry)
+  then if ly < ry then CDown else CUp
+  else if lx < rx then CRight else CLeft
+
+directions :: [UI.Point] -> [Curvature]
+directions = map head . group . mapBetween direction
+
+toPoint :: (Int, Int) -> UI.Point
+toPoint (x, y) = (fromIntegral x, fromIntegral y)
+
+withAngles :: [UI.Point] -> [(UI.Point, Double)]
+withAngles = mapBetween (\(lx, ly) (rx, ry) -> ((rx, ry), atan2 (ly - ry) (rx - lx)))
+
+corners :: Double -> Double -> [UI.Point] -> [UI.Point]
+corners sameLimit changeLimit =
+  map fst . filter snd .
+  mapBetween4 (\(_, a0) (_, a1) (p, a2) (_, a3) -> (p, abs (a0 - a1) < sameLimit && abs (a2 - a3) < sameLimit && abs (a1 - a2) > changeLimit)) .
+  withAngles
+
+data Grid = Grid { gridLeftTop :: UI.Point, gridRightDown :: UI.Point }
+
+makeGrid :: [UI.Point] -> Maybe Grid
+makeGrid [] = Nothing
+makeGrid l = Just $ Grid (left, top) (right, down)
+  where
+    xs = map fst l
+    ys = map snd l
+    left = minimum xs
+    right = maximum xs
+    top = minimum ys
+    down = maximum ys
+
+locateInRange :: Double -> Double -> Int -> Double -> Maybe Int
+locateInRange down up numBracket val = if down <= val && val <= up then Just (min (floor ((val - down) / (up - down) * (fromIntegral numBracket))) numBracket) else Nothing
+ 
+locateInGrid :: Grid -> Int -> Int -> UI.Point -> Maybe (Int, Int)
+locateInGrid (Grid (left, top) (right, down)) numCol numRow (x, y) = do
+  x' <- locateInRange left right numCol x
+  y' <- locateInRange top down numRow y
+  return (x', y')
+
 setup :: Window -> UI ()
 setup w = do
   return w # set UI.title "Ordinary"
   wrap <- wrapper 1024 640
   smoothFactIn <- UI.input
   getBody w #+ [row [element wrap, column [string "smooth by", element smoothFactIn]]]
-  smoothFact <- stepper 0.5 $ filterJust $ fmap (readMay :: _ -> Maybe Double) $ UI.valueChange smoothFactIn
+  smoothFact <- stepper 0.5 $ filterJust $ fmap (readMay :: String -> Maybe Double) $ UI.valueChange smoothFactIn
   stroke <- mouseStroke wrap
   unEvent <- onEvent stroke $
     \(Reversed x) -> do
-      return w # set UI.title (show (reverse x))
-      points <- return $ map (\(l, r) -> (fromIntegral l, fromIntegral r)) (reverse x)
+      let points = map toPoint $ reverse x
       mapM (\p -> circle blue p 5 wrap) points
       smoothFactCur <- currentValue smoothFact
-      mapM (\p -> circle black p 5 wrap) (smooth smoothFactCur points)
+      let processedPoints = thin 20 $ smooth smoothFactCur points
+      mapM (\p -> circle black p 5 wrap) $ processedPoints
+      mapM (\p -> circle black p 20 wrap) $ corners (pi/6) (pi/3) processedPoints
   return ()