diff --git a/HW4.fedorind.hs b/HW4.fedorind.hs new file mode 100644 index 0000000..9d166f2 --- /dev/null +++ b/HW4.fedorind.hs @@ -0,0 +1,183 @@ +-- Authors: Danila Fedorin, Ryan Alder, Matthew Sessions +-- ONIDs: fedorind, alderr, sessionm +module HW3 where + +import MiniMiniLogo +import Render +import System.Random +import Data.Maybe +import System.IO.Unsafe + +-- +-- * Semantics of MiniMiniLogo +-- + +-- NOTE: +-- * MiniMiniLogo.hs defines the abstract syntax of MiniMiniLogo and some +-- functions for generating MiniMiniLogo programs. It contains the type +-- definitions for Mode, Cmd, and Prog. +-- * Render.hs contains code for rendering the output of a MiniMiniLogo +-- program in HTML5. It contains the types definitions for Point and Line. + +-- | A type to represent the current state of the pen. +type State = (Mode,Point) + +-- | The initial state of the pen. +start :: State +start = (Up,(0,0)) + +-- | A function that renders the image to HTML. Only works after you have +-- implemented `prog`. Applying `draw` to a MiniMiniLogo program will +-- produce an HTML file named MiniMiniLogo.html, which you can load in +-- your browswer to view the rendered image. +draw :: Prog -> IO () +draw p = let (_,ls) = prog p start in toHTML ls + + +-- Semantic domains: +-- * Cmd: State -> (State, Maybe Line) +-- * Prog: State -> (State, [Line]) + + +-- | Semantic function for Cmd. +-- +-- >>> cmd (Pen Down) (Up,(2,3)) +-- ((Down,(2,3)),Nothing) +-- +-- >>> cmd (Pen Up) (Down,(2,3)) +-- ((Up,(2,3)),Nothing) +-- +-- >>> cmd (Move 4 5) (Up,(2,3)) +-- ((Up,(4,5)),Nothing) +-- +-- >>> cmd (Move 4 5) (Down,(2,3)) +-- ((Down,(4,5)),Just ((2,3),(4,5))) +-- +cmd :: Cmd -> State -> (State, Maybe Line) +cmd (Move l r) s = case fst s of + Up -> ((fst s, (l, r)), Nothing) + Down -> ((fst s, (l, r)), Just (snd s, (l, r))) +cmd (Pen m) s = ((m, snd s), Nothing) + +-- | Semantic function for Prog. +-- +-- >>> prog (nix 10 10 5 7) start +-- ((Down,(15,10)),[((10,10),(15,17)),((10,17),(15,10))]) +-- +-- >>> prog (steps 2 0 0) start +-- ((Down,(2,2)),[((0,0),(0,1)),((0,1),(1,1)),((1,1),(1,2)),((1,2),(2,2))]) +prog :: Prog -> State -> (State, [Line]) +prog cs is = (fs, catMaybes ls) + where + step (s, xs) c = let (ns, ml) = cmd c s in (ns, xs ++ [ml]) + (fs, ls) = foldl step (is, []) cs + + +type Cell = (Bool, Bool, Bool, Bool, Bool) +type Coord = (Int, Int) +type Maze = [(Coord, Cell)] +data Wall = WTop | WBottom | WLeft | WRight + +visited :: Cell -> Bool +visited (b, _, _, _, _) = b + +neighbors :: Maze -> Coord -> [Coord] +neighbors m (x, y) = [ c | c <- map fst m, + abs (x - fst c) + abs (y - snd c) == 1, + maybe False (not . visited) (lookup c m) ] + +pickNeighbor :: Maze -> StdGen -> Coord -> (Maybe Coord, StdGen) +pickNeighbor m sg c = + case ns of + [] -> (Nothing, sg) + _ -> (Just (ns !! v), g) + where + (v, g) = randomR (0, length ns - 1) sg + ns = neighbors m c + +breakCellWall :: Wall -> Cell -> Cell +breakCellWall WTop (b1, b2, b3, b4, b5) = (b1, False, b3, b4, b5) +breakCellWall WBottom (b1, b2, b3, b4, b5) = (b1, b2, False, b4, b5) +breakCellWall WLeft (b1, b2, b3, b4, b5) = (b1, b2, b3, False, b5) +breakCellWall WRight (b1, b2, b3, b4, b5) = (b1, b2, b3, b4, False) + +getWall :: Coord -> Coord -> Wall +getWall (x, y) (x2, y2) = case (x - x2, y - y2) of + (0, 1) -> WBottom + (0, -1) -> WTop + (1, 0) -> WLeft + (-1, 0) -> WRight + +update :: Eq a => (b -> b) -> a -> [(a, b)] -> [(a, b)] +update f a = map changeFunc + where + changeFunc (a', b) = if a == a' then (a', f b) else (a', b) + +breakWall :: Wall -> Coord -> Maze -> Maze +breakWall w = update (breakCellWall w) + +visit :: Coord -> Maze -> Maze +visit = update (\(b1, b2, b3, b4, b5) -> (True, b2, b3, b4, b5)) + +generate :: Coord -> StdGen -> Maze -> (Maze, StdGen) +generate c s m = maybe (nm, s) fixpointMove mc + where + nm = visit c m + (mc, g) = pickNeighbor nm s c + fixpointMove c2 = let (nm', g') = moveCell c2 in generate c g' nm' + moveCell c2 = generate c2 g $ + breakWall (getWall c c2) c $ + breakWall (getWall c2 c) c2 nm + +emptyMaze :: Int -> Int -> Maze +emptyMaze w h = [ ((x, y), (False, True, True, True, True)) | x <- [0..w - 1], y <- [0..h - 1] ] + +transform :: (Int -> Int) -> (Int -> Int) -> Coord -> Coord +transform fx fy (x, y) = (fx x, fy y) + +offset :: Coord -> Coord -> Coord +offset (ox, oy) = transform (+ox) (+oy) + +line :: Coord -> Coord -> Prog +line (x1, y1) (x2, y2) = [ Pen Up, Move x1 y1, Pen Down, Move x2 y2 ] + +spotToLogo :: (Coord, Cell) -> Prog +spotToLogo (c, (_, top, bottom, left, right)) = lineMovements + where + ls = + [ (offset (0, 1) c, offset (1, 1) c, top) + , (c, offset (1, 0) c, bottom) + , (c, offset (0, 1) c, left) + , (offset (1, 0) c, offset(1, 1) c, right) + ] + lineMovements = ls >>= (\(c1, c2, b) -> if b then line c1 c2 else []) + +mazeToLogo :: Maze -> Prog +mazeToLogo m = m >>= spotToLogo + +drawFlower :: Int -> Coord -> Prog +drawFlower n (xi, yi) = [ Pen Up, Move xi yi, Pen Down, Move xi (yi + n * 2) ] ++ linesFromCenter (xi, yi + n * 2) + where + pointsAround xs ys = [ (xs + x, ys + y) | x <- [-n..n], y <- [-n..n], abs x + abs y == n ] + linesFromCenter c@(x, y) = pointsAround x y >>= line c +-- +-- * Extra credit +-- + +generateMaze :: Int -> Int -> Maze +generateMaze w h = m + where + mi = emptyMaze w h + r = mkStdGen 5 + (m, _) = generate (0, 0) r mi + +-- | This should be a MiniMiniLogo program that draws an amazing picture. +-- Add as many helper functions as you want. +amazing :: Prog +amazing = + drawFlower 3 (5, 20) ++ + drawFlower 3 (12, 20) ++ + drawFlower 4 (27, 20) ++ + drawFlower 6 (40, 20) ++ + drawFlower 5 (65, 20) ++ + (mazeToLogo $ generateMaze 80 20) diff --git a/MiniMiniLogo.hs b/MiniMiniLogo.hs new file mode 100644 index 0000000..f1f20f6 --- /dev/null +++ b/MiniMiniLogo.hs @@ -0,0 +1,63 @@ +-- | This module defines the syntax of MiniMiniLogo. It also provides +-- functions to generate programs that draw some basic shapes. +-- +-- NOTE: You should not change the definitions in this file! +-- +module MiniMiniLogo where + +-- +-- * Syntax +-- + +-- | A program is a sequence of commands. +type Prog = [Cmd] + +-- | The mode of the pen. +data Mode = Down | Up + deriving (Eq,Show) + +-- | Abstract syntax of commands. +data Cmd = Pen Mode + | Move Int Int + deriving (Eq,Show) + +-- | Generate a MiniMiniLogo program that draws a 2x2 box starting from the +-- specified point. Conceptually, this program looks like the following, but +-- the additions are carried out in Haskell rather than in MiniMiniLogo. +-- +-- pen up; move (x,y); +-- pen down; move (x+2,y); move (x+2,y+2); +-- move (x,y+2); move (x,y); +-- +-- >>> box 7 3 +-- [Pen Up,Move 7 3,Pen Down,Move 9 3,Move 9 5,Move 7 5,Move 7 3] +-- +box :: Int -> Int -> Prog +box x y = [Pen Up, Move x y, Pen Down, + Move (x+2) y, Move (x+2) (y+2), Move x (y+2), Move x y] + +-- | Generate an 'X' from (x,y) to (x+w,y+h). +-- +-- >>> nix 10 10 5 7 +-- [Pen Up,Move 10 10,Pen Down,Move 15 17,Pen Up,Move 10 17,Pen Down,Move 15 10] +-- +nix :: Int -> Int -> Int -> Int -> Prog +nix x y w h = [Pen Up, Move x y, Pen Down, Move (x+w) (y+h), + Pen Up, Move x (y+h), Pen Down, Move (x+w) y] + +-- | Generate a MiniMiniLogo program that draws n steps starting from +-- point (x,y). +-- +-- >>> steps 3 2 4 +-- [Pen Up,Move 2 4,Pen Down,Move 2 5,Move 3 5,Move 3 6,Move 4 6,Move 4 7,Move 5 7] +-- +steps :: Int -> Int -> Int -> Prog +steps n x y = [Pen Up, Move x y, Pen Down] ++ step n + where + step 0 = [] + step n = step (n-1) ++ [Move (x+n-1) (y+n), Move (x+n) (y+n)] + +-- | Draw an example picture. The expected output is given on the HW4 +-- description page. +demo :: Prog +demo = box 7 3 ++ nix 6 6 4 3 ++ steps 3 2 4 diff --git a/Render.hs b/Render.hs new file mode 100644 index 0000000..744629e --- /dev/null +++ b/Render.hs @@ -0,0 +1,82 @@ +-- | A module for rendering lines as an HTML5 file containing an SVG image. +-- This can be used to visualize the denotational semantics of a MiniLogo +-- program. +-- +-- NOTE: You should not change the definitions in this file! +-- +module Render (Point,Line,toHTML,toGridHTML) where + +import Data.List (intercalate) + + +-- | A point is a cartesian pair (x,y). +type Point = (Int,Int) + +-- | A line is defined by its endpoints. +type Line = (Point,Point) + +-- | Output a list of lines as an HTML5 file containing an SVG image. +toHTML :: [Line] -> IO () +toHTML ls = writeFile "MiniMiniLogo.html" (header ++ content ls ++ footer) + +-- | Alternate version of 'toHTML' that adds a grid to the background. +toGridHTML :: [Line] -> IO () +toGridHTML ls = writeFile "MiniMiniLogo.html" (header ++ grid ++ content ls ++ footer) + +-- +-- Private definitions. All definitions below this point will not be visible +-- from within a module that imports this module. +-- + +scale, margin, width, height :: Int +scale = 10 +margin = 10 +width = 800 +height = 400 + +gridStep = 5 +maxX = width `div` scale +maxY = height `div` scale + +gridStyle = "fill:none;stroke:lightgrey;stroke-width:1" +drawStyle = "fill:none;stroke:red;stroke-width:2" + +title = "MiniLogo Semantics Viewer" +view = "" +border = "" + +header = unlines ["", "", title, "", view, border] +footer = unlines ["","",""] + +grid = unlines (map (poly gridStyle) lines) + where lines = [ [(x,0), (x,maxY)] | x <- [0,gridStep..maxX] ] + ++ [ [(0,y), (maxX,y)] | y <- [0,gridStep..maxY] ] + +content :: [Line] -> String +content = unlines . map (poly drawStyle) . chunk + +-- | A canvas-adjusted point as a string. +point :: Point -> String +point (x,y) = show xp ++ "," ++ show yp + where xp = x*scale + margin + yp = height - y*scale + margin + +-- | Chunk a bunch of lines into sequences of connected points. +chunk :: [Line] -> [[Point]] +chunk [] = [] +chunk [(p,q)] = [[p,q]] +chunk ((p,q):ls) | q == head ps = (p:ps) : pss + | otherwise = [p,q] : ps : pss + where (ps:pss) = chunk ls + +-- | Draw a sequence of connected points. +poly :: String -> [Point] -> String +poly style ps = ""