WIRING UP WIREWORLD Using Haskell
primecontents
assignment_1_student_template.zipAssignment 1 student template/make_n_run_Wireworld
./make_Wireworld ./Wireworld
Assignment 1 student template/make_n_run_Wireworld_on_Windows.bat
./make_Wireworld_on_Windows ./Wireworld
Assignment 1 student template/make_Wireworld
ghc --make -O2 -W Sources/Wireworld.hs -iSources -odir `uname -m` -hidir `uname -m` -o Wireworld
Assignment 1 student template/make_Wireworld_compile_everything
ghc --make -O2 -W Sources/Wireworld.hs -fforce-recomp -iSources -odir `uname -m` -hidir `uname -m` -o Wireworld
Assignment 1 student template/make_Wireworld_compile_everything_on_Windows.bat
ghc --make -O2 -W Sources/Wireworld.hs -fforce-recomp -iSources -odir "Objects" -hidir "Interfaces" -o Wireworld
Assignment 1 student template/make_Wireworld_on_Windows.bat
ghc --make -O2 -W Sources/Wireworld.hs -iSources -odir "Objects" -hidir "Interfaces" -o Wireworld
Assignment 1 student template/Sources/Commandline/Options.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Commandline.Options ( Options (world_filename, no_of_tests, model, fps), Data_Structure (List_2D, Ordered_Lists_2D), default_options, -- :: Options args_to_options -- :: [String] -> Options ) where import System.Console.GetOpt (getOpt, ArgOrder (Permute), usageInfo, OptDescr (Option), ArgDescr (OptArg)) data Data_Structure = List_2D | Ordered_Lists_2D deriving Eq data Options = Options { world_filename :: String, no_of_tests :: Int, model :: Data_Structure, fps :: Int } default_options :: Options default_options = Options { world_filename = "Wireworlds/Playfield.bmp", no_of_tests = 25, model = Ordered_Lists_2D, fps = 25 } data Flags = World_Filename String | No_Of_Tests Int | Model Data_Structure | FPS Int header = "Usage: Wireworld [OPTION...]" :: String available_options :: [OptDescr Flags] available_options = [ Option ['w'] ["world"] (OptArg from_maybe_filename "<Filename/path>" ) "a bmp file which contains a wireworld", Option ['t'] ["tests"] (OptArg from_maybe_no_of_tests "<Natural number>" ) "number of test transitions performed", Option ['m'] ["model"] (OptArg from_maybe_model "List_2D | Ordered_Lists_2D") "data structure for the wireworld state", Option ['f'] ["fps" ] (OptArg from_maybe_fps "<Positive number>" ) "frames per second for the animation" ] from_maybe_filename :: Maybe String -> Flags from_maybe_filename maybe_filename = case maybe_filename of Nothing -> World_Filename (world_filename default_options) Just filename -> World_Filename filename from_maybe_no_of_tests :: Maybe String -> Flags from_maybe_no_of_tests maybe_no_of_tests = case maybe_no_of_tests of Nothing -> No_Of_Tests (no_of_tests default_options) Just no_of_tests_string -> No_Of_Tests (read no_of_tests_string) from_maybe_model :: Maybe String -> Flags from_maybe_model maybe_name = case maybe_name of Nothing -> Model (model default_options) Just "List_2D" -> Model List_2D Just "Ordered_Lists_2D" -> Model Ordered_Lists_2D _ -> error "Unknown model given in option '-m'" from_maybe_fps :: Maybe String -> Flags from_maybe_fps maybe_fps = case maybe_fps of Nothing -> FPS (fps default_options) Just f -> FPS (read f) flags_to_options :: [Flags] -> Options flags_to_options flags = flags_to_options' flags default_options where flags_to_options' :: [Flags] -> Options -> Options flags_to_options' flags current_options = case flags of World_Filename name: cs -> flags_to_options' cs (current_options {world_filename = name}) No_Of_Tests n : cs -> flags_to_options' cs (current_options {no_of_tests = n}) Model name: cs -> flags_to_options' cs (current_options {model = name}) FPS f : cs -> flags_to_options' cs (current_options {fps = f}) [] -> current_options args_to_options :: [String] -> Options args_to_options args = case getOpt Permute available_options args of (flags, [], []) -> flags_to_options flags (_, nonOpts, [] ) -> error $ "unrecognized arguments: " ++ unwords nonOpts (_, _ , msgs) -> error $ concat msgs ++ usageInfo header available_options
Assignment 1 student template/Sources/Data/Cell.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Data.Cell ( Cell (Head, Tail, Conductor, Empty) ) where data Cell = Head | Tail | Conductor | Empty deriving Eq instance Show Cell where show cell = case cell of Head -> "H" Tail -> "T" Conductor -> "C" Empty -> " "
Assignment 1 student template/Sources/Data/Coordinates.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Data.Coordinates ( Distance, X_Coord, Y_Coord, Coord, Element_w_Coord, ) where type Distance = Integer; type X_Coord = Integer; type Y_Coord = Integer; type Coord = (X_Coord, Y_Coord); type Element_w_Coord e = (e, Coord)
Assignment 1 student template/Sources/Data/List_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Data.List_2D ( List_2D, {- the central data structure of this module: A single list containing elements with their associated coordinates. No order on the coordinates is assumed or preseverd -} singleton_world, -- :: Element_w_Coord e -> List_2D e insert_element, -- :: Element_w_Coord e -> List_2D e -> List_2D e combine_List_2D, -- :: List_2D e -> List_2D e -> List_2D e read_element, -- :: Coord -> List_2D e -> Maybe e element_occurrence, -- :: Eq e => e -> List_2D e -> Int first_coord, -- :: List_2D e -> Maybe Coord next_coord, -- :: Coord -> List_2D e -> Maybe Coord remove_elements_less_than_x, -- :: X_Coord -> List_2D e -> List_2D e remove_elements_less_than_y, -- :: Y_Coord -> List_2D e -> List_2D e local_lines, -- :: Y_Coord -> List_2D e -> List_2D e -- +/- 1 y coordinate lines neighbourhood (including the y line itself, if it exists) local_elements, -- :: Coord -> List_2D e -> List_2D e local_elements_list, -- :: Coord -> List_2D e -> [e] -- +/- 1 (x, y) coordinates elements neighbourhood - including the element at (x, y) itself, if it exists map_list_2D, -- :: (Element_w_Coord e -> b) -> List_2D e -> List_2D b map_list_2D_to_list, -- :: (Element_w_Coord e -> b) -> List_2D e -> [b] map_list_2D_w_context, -- :: (Element_w_Coord e -> c -> b) -> c -> List_2D e -> List_2D b map_List_2D_w_context_to_list, -- :: (Element_w_Coord e -> c -> b) -> c -> List_2D e -> [b] -- apply a function with or without a context to all elements in a list_2D structure -- and return the results in the same structure or in a flat list size, -- :: List_2D e -> Int list_2D_to_list, -- :: List_2D e -> [e] -- roll out a list_2D structure to a flat list containing the elements only ) where import Data.Coordinates (Distance, Coord, Element_w_Coord, X_Coord, Y_Coord) type List_2D e = [Element_w_Coord e] singleton_world :: Element_w_Coord e -> List_2D e singleton_world element = [element] insert_element :: Element_w_Coord e -> List_2D e -> List_2D e insert_element element world = element: world combine_List_2D :: List_2D e -> List_2D e -> List_2D e combine_List_2D list world = list ++ world read_element :: Coord -> List_2D e -> Maybe e read_element (x, y) world = case world of (element, (x_e, y_e)): cs | x == x_e && y == y_e -> Just element | otherwise -> read_element (x, y) cs [] -> Nothing element_occurrence :: Eq e => e -> List_2D e -> Int element_occurrence element list = case list of (local_element, _): cs | local_element == element -> 1 + element_occurrence element cs | otherwise -> element_occurrence element cs [] -> 0 first_coord :: List_2D e -> Maybe Coord first_coord world = scan_world_first world Nothing where scan_world_first :: List_2D e -> Maybe Coord -> Maybe Coord scan_world_first world candidate = case world of (_, (x_e, y_e)): cs -> case candidate of Just (x_c, y_c) | y_e < y_c || (y_e == y_c && x_e < x_c) -> scan_world_first cs (Just (x_e, y_e)) | otherwise -> scan_world_first cs candidate Nothing -> scan_world_first cs (Just (x_e, y_e)) [] -> candidate next_coord :: Coord -> List_2D e -> Maybe Coord next_coord coord world = scan_world_next coord world Nothing where scan_world_next :: Coord -> List_2D e -> Maybe Coord -> Maybe Coord scan_world_next (x, y) world candidate = case world of (_, (x_e, y_e)): cs -> case candidate of Just (x_c, y_c) | (y_e > y || (y_e == y && x_e > x )) && (y_e < y_c || (y_e == y_c && x_e < x_c)) -> scan_world_next (x, y) cs (Just (x_e, y_e)) | otherwise -> scan_world_next (x, y) cs candidate Nothing | y_e > y || (y_e == y && x_e > x) -> scan_world_next (x, y) cs (Just (x_e, y_e)) | otherwise -> scan_world_next (x, y) cs candidate [] -> candidate remove_elements_less_than_x :: X_Coord -> List_2D e -> List_2D e remove_elements_less_than_x x world = case world of (element, (x_e, y_e)): cs | x_e < x -> remove_elements_less_than_x x cs | otherwise -> (element, (x_e, y_e)): remove_elements_less_than_x x cs [] -> [] remove_elements_less_than_y :: Y_Coord -> List_2D e -> List_2D e remove_elements_less_than_y y world = case world of (element, (x_e, y_e)): cs | y_e < y -> remove_elements_less_than_y y cs | otherwise -> (element, (x_e, y_e)): remove_elements_less_than_y y cs [] -> [] local_lines :: Y_Coord -> List_2D e -> List_2D e local_lines y world = read_neighbouring_lines y 1 world where read_neighbouring_lines :: Y_Coord -> Distance -> List_2D e -> List_2D e read_neighbouring_lines y dist list = case list of (element, (x_e, y_e)): cs | abs (y_e - y) <= dist -> (element, (x_e, y_e)): read_neighbouring_lines y dist cs | otherwise -> read_neighbouring_lines y dist cs [] -> [] local_elements :: Coord -> List_2D e -> List_2D e local_elements (x, y) list = read_neighbours (x, y) 1 list where read_neighbours :: Coord -> Distance -> List_2D e -> List_2D e read_neighbours (x, y) dist list = case list of (element, (x_e, y_e)): cs | abs (x_e - x) <= dist && abs (y_e - y) <= dist -> (element, (x_e, y_e)): read_neighbours (x, y) dist cs | otherwise -> read_neighbours (x, y) dist cs [] -> [] local_elements_list :: Coord -> List_2D e -> [e] local_elements_list (x, y) list = read_neighbours_list (x, y) 1 list where read_neighbours_list :: Coord -> Distance -> List_2D e -> [e] read_neighbours_list (x, y) dist list = case list of (element, (x_e, y_e)): cs | abs (x_e - x) <= dist && abs (y_e - y) <= dist -> element: read_neighbours_list (x, y) dist cs | otherwise -> read_neighbours_list (x, y) dist cs [] -> [] map_list_2D :: (Element_w_Coord e -> b) -> List_2D e -> List_2D b map_list_2D f list = case list of (element, (x_e, y_e)): cs -> (f (element, (x_e, y_e)), (x_e, y_e)): map_list_2D f cs [] -> [] map_list_2D_to_list :: (Element_w_Coord e -> b) -> List_2D e -> [b] map_list_2D_to_list f list = map f list map_list_2D_w_context :: (Element_w_Coord e -> c -> b) -> c -> List_2D e -> List_2D b map_list_2D_w_context f context list = case list of (element, (x_e, y_e)): cs -> (f (element, (x_e, y_e)) context, (x_e, y_e)): map_list_2D_w_context f context cs [] -> [] map_List_2D_w_context_to_list :: (Element_w_Coord e -> c -> b) -> c -> List_2D e -> [b] map_List_2D_w_context_to_list f context list = case list of c: cs -> f c context: map_List_2D_w_context_to_list f context cs [] -> [] size :: List_2D e -> Int size list = length list list_2D_to_list :: List_2D e -> [e] list_2D_to_list list = case list of (element, _): cs -> element: list_2D_to_list cs [] -> []
Assignment 1 student template/Sources/Data/Ordered_Lists_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Data.Ordered_Lists_2D ( Ordered_Lists_2D, {- the central data structure of this module: A list of lists where y coordinate are attached to every list at top level (the "lines") and every element inside the line lists has an x coordinate attached to it. All lists are sorted in ascending order, yet the coordinates do not need to be consecutive (or "dense") -} Sparse_Line (Sparse_Line, y_pos, entries), Placed_Element (Placed_Element, x_pos, entry), Placed_Elements, singleton_world, -- :: Element_w_Coord e -> Ordered_Lists_2D e insert_element, -- :: Element_w_Coord e -> Ordered_Lists_2D e -> Ordered_Lists_2D e insert_list, -- :: List_2D e -> Ordered_Lists_2D e -> Ordered_Lists_2D e combine_Ordered_Lists_2D, -- :: Ordered_Lists_2D e -> Ordered_Lists_2D e -> Ordered_Lists_2D e read_element, -- :: Coord -> Ordered_Lists_2D e -> Maybe e element_occurrence, -- :: Eq e => e -> Ordered_Lists_2D e -> Int first_coord, -- :: Ordered_Lists_2D e -> Maybe Coord next_coord, -- :: Coord -> Ordered_Lists_2D e -> Maybe Coord remove_elements_less_than_x, -- :: X_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e remove_elements_less_than_y, -- :: Y_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e local_lines, -- :: Y_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e -- +/- 1 y coordinate lines neighbourhood (including the y line itself, if it exists) local_elements, -- :: Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e local_elements_list, -- :: Coord -> Ordered_Lists_2D e -> [e] -- +/- 1 (x, y) coordinates elements neighbourhood - including the element at (x, y) itself, if it exists map_Ordered_Lists_2D, -- :: (Element_w_Coord e -> b) -> Ordered_Lists_2D e -> Ordered_Lists_2D b map_Ordered_Lists_2D_to_list, -- :: (Element_w_Coord e -> b) -> Ordered_Lists_2D e -> [b] map_Ordered_Lists_2D_w_context, -- :: (Element_w_Coord e -> c -> b) -> c -> Ordered_Lists_2D e -> Ordered_Lists_2D b map_Ordered_Lists_2D_w_context_to_list, -- :: (Element_w_Coord e -> c -> b) -> c -> Ordered_Lists_2D e -> [b] -- apply a function with or without a context to all elements in a sparse_list_2D structure -- and return the results in the same structure or in a flat list size, -- :: Ordered_Lists_2D e -> Int sparse_list_2D_to_list, -- :: Ordered_Lists_2D e -> [e] sparse_list_2D_to_list_2D, -- :: Ordered_Lists_2D e -> List_2D e -- roll out a sparse_list_2D structure to a flat list containing the elements only or the elements with their coordinates ) where import Data.Coordinates (Distance, X_Coord, Y_Coord, Coord, Element_w_Coord) import Data.List_2D (List_2D) data Placed_Element e = Placed_Element {x_pos :: X_Coord, entry :: e} type Placed_Elements e = [Placed_Element e] data Sparse_Line e = Sparse_Line {y_pos :: Y_Coord, entries :: Placed_Elements e} type Ordered_Lists_2D e = [Sparse_Line e] instance (Show e) => Show (Sparse_Line e) where show line = (show (y_pos line)) ++ ": " ++ show (entries line) ++ "\r" ++ "\n" instance (Show e) => Show (Placed_Element e) where show element = (show (x_pos element)) ++ ": " ++ show (entry element) singleton_world :: Element_w_Coord e -> Ordered_Lists_2D e singleton_world (cell, (x, y)) = [Sparse_Line {y_pos = y, entries = [Placed_Element {x_pos = x, entry = cell}]}] insert_element :: Element_w_Coord e -> Ordered_Lists_2D e -> Ordered_Lists_2D e insert_element (cell, (x, y)) world = case world of l: ls | y < y_pos l -> (Sparse_Line {y_pos = y, entries = insert_cell_to_entries cell x []}): world | y == y_pos l -> (Sparse_Line {y_pos = y, entries = insert_cell_to_entries cell x (entries l)}): ls | otherwise -> l: insert_element (cell, (x, y)) ls [] -> singleton_world (cell, (x, y)) where insert_cell_to_entries :: e -> X_Coord -> Placed_Elements e -> Placed_Elements e insert_cell_to_entries cell x entries = case entries of c: cs | x < x_pos c -> Placed_Element {x_pos = x, entry = cell}: entries | x == x_pos c -> Placed_Element {x_pos = x, entry = cell}: cs | otherwise -> c: insert_cell_to_entries cell x cs [] -> [Placed_Element {x_pos = x, entry = cell}] insert_list :: List_2D e -> Ordered_Lists_2D e -> Ordered_Lists_2D e insert_list list world = case list of element_with_coord: cs -> insert_element element_with_coord (insert_list cs world) [] -> world combine_Ordered_Lists_2D :: Ordered_Lists_2D e -> Ordered_Lists_2D e -> Ordered_Lists_2D e combine_Ordered_Lists_2D left right = case left of [] -> right l: ls -> case entries l of c: cs -> combine_Ordered_Lists_2D ((Sparse_Line {y_pos = y_pos l, entries = cs}): ls) (insert_element ((entry c), (x_pos c, y_pos l)) right) [] -> combine_Ordered_Lists_2D ls right read_element :: Coord -> Ordered_Lists_2D e -> Maybe e read_element (x, y) world = case world of l: ls | y < y_pos l -> Nothing | y == y_pos l -> case entries l of c: cs | x < x_pos c -> Nothing | x == x_pos c -> Just (entry c) | otherwise -> read_element (x, y) [(Sparse_Line {y_pos = y_pos l, entries = cs})] [] -> Nothing | otherwise -> read_element (x, y) ls [] -> Nothing element_occurrence :: Eq e => e -> Ordered_Lists_2D e -> Int element_occurrence element world = case world of l: ls -> contains_element_line element (entries l) + element_occurrence element ls where contains_element_line :: Eq e => e -> Placed_Elements e -> Int contains_element_line element cells = case cells of c: cs | (entry c) == element -> 1 + contains_element_line element cs | otherwise -> contains_element_line element cs [] -> 0 [] -> 0 first_coord :: Ordered_Lists_2D e -> Maybe Coord first_coord world = case world of [] -> Nothing l: ls -> case (entries l) of [] -> first_coord ls c: _ -> Just (x_pos c, y_pos l) next_coord :: Coord -> Ordered_Lists_2D e -> Maybe Coord next_coord (x, y) world = case world of [] -> Nothing l: ls | y < y_pos l -> Nothing | y == y_pos l -> next_coord_in_entries x (entries l) l ls | otherwise -> next_coord (x, y) ls where next_coord_in_entries :: X_Coord -> Placed_Elements e -> Sparse_Line e -> Ordered_Lists_2D e -> Maybe Coord next_coord_in_entries x current_entries current_line rest_world = case current_entries of [] -> Nothing c: cs | x < x_pos c -> Nothing | x == x_pos c -> case cs of c2: _ -> Just (x_pos c2, y_pos current_line) [] -> case rest_world of [] -> Nothing l2: _ -> case (entries l2) of [] -> Nothing c2: _ -> Just(x_pos c2, y_pos l2) | otherwise -> next_coord_in_entries x cs current_line rest_world remove_elements_less_than_x :: X_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e remove_elements_less_than_x x world = case world of l: ls -> remove_from_line x l: remove_elements_less_than_x x ls [] -> [] where remove_from_line :: X_Coord -> Sparse_Line e -> Sparse_Line e remove_from_line x line = Sparse_Line {y_pos = y_pos line, entries = remove_from_entries x (entries line)} where remove_from_entries :: X_Coord -> Placed_Elements e -> Placed_Elements e remove_from_entries x cells = case cells of c: cs | x_pos c < x -> remove_from_entries x cs | otherwise -> cells [] -> [] remove_elements_less_than_y :: Y_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e remove_elements_less_than_y y world = case world of [] -> [] l: ls | y_pos l < y -> remove_elements_less_than_y y ls | otherwise -> world local_lines :: Y_Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e local_lines y world = read_neighbouring_lines y 1 world where read_neighbouring_lines :: Y_Coord -> Distance -> Ordered_Lists_2D e -> Ordered_Lists_2D e read_neighbouring_lines y dist world = case world of l: ls | y < (y_pos l) - dist -> [] | abs (y - y_pos l) <= dist -> l: read_neighbouring_lines y dist ls | otherwise -> read_neighbouring_lines y dist ls [] -> [] local_elements :: Coord -> Ordered_Lists_2D e -> Ordered_Lists_2D e local_elements (x, y) world = read_neighbours (x, y) 1 world where read_neighbours :: Coord -> Distance -> Ordered_Lists_2D e -> Ordered_Lists_2D e read_neighbours (x, y) dist world = case world of l: ls | y < (y_pos l) - dist -> [] | abs (y - y_pos l) <= dist -> neighbours_in_line l: (read_neighbours (x, y) dist ls) | otherwise -> read_neighbours (x, y) dist ls [] -> [] where neighbours_in_line :: Sparse_Line e -> Sparse_Line e neighbours_in_line line = Sparse_Line {y_pos = y_pos line, entries = neighbours_in_entries (entries line)} where neighbours_in_entries :: Placed_Elements e -> Placed_Elements e neighbours_in_entries list = case list of c: cs | x < (x_pos c) - dist -> [] | abs (x - x_pos c) <= dist -> Placed_Element {x_pos = (x_pos c), entry = (entry c)}: neighbours_in_entries cs | otherwise -> neighbours_in_entries cs [] -> [] local_elements_list :: Coord -> Ordered_Lists_2D e -> [e] local_elements_list (x, y) world = read_neighbours_list (x, y) 1 world where read_neighbours_list :: Coord -> Distance -> Ordered_Lists_2D e -> [e] read_neighbours_list (x, y) dist world = case world of l: ls | y < (y_pos l) - dist -> [] | abs (y - y_pos l) <= dist -> neighbours_in_entries (entries l) ++ (read_neighbours_list (x, y) dist ls) | otherwise -> read_neighbours_list (x, y) dist ls [] -> [] where neighbours_in_entries :: Placed_Elements e -> [e] neighbours_in_entries list = case list of c: cs | x < (x_pos c) - dist -> [] | abs (x - x_pos c) <= dist -> entry c: neighbours_in_entries cs | otherwise -> neighbours_in_entries cs [] -> [] map_Ordered_Lists_2D :: (Element_w_Coord e -> b) -> Ordered_Lists_2D e -> Ordered_Lists_2D b map_Ordered_Lists_2D f world = case world of l: ls -> map_line f l: map_Ordered_Lists_2D f ls [] -> [] where map_line :: (Element_w_Coord e -> b) -> Sparse_Line e -> Sparse_Line b map_line f line = Sparse_Line {y_pos = (y_pos line), entries = map_elements f (y_pos line) (entries line)} where map_elements :: (Element_w_Coord e -> b) -> Y_Coord -> Placed_Elements e -> Placed_Elements b map_elements f y elements = case elements of c: cs -> Placed_Element {x_pos = (x_pos c), entry = f ((entry c), ((x_pos c), y))}: map_elements f y cs [] -> [] map_Ordered_Lists_2D_to_list :: (Element_w_Coord e -> b) -> Ordered_Lists_2D e -> [b] map_Ordered_Lists_2D_to_list f world = case world of l: ls -> map_line f l ++ map_Ordered_Lists_2D_to_list f ls [] -> [] where map_line :: (Element_w_Coord e -> b) -> Sparse_Line e -> [b] map_line f line = map_elements f (y_pos line) (entries line) where map_elements :: (Element_w_Coord e -> b) -> Y_Coord -> Placed_Elements e -> [b] map_elements f y elements = case elements of c: cs -> f ((entry c), ((x_pos c), y)): map_elements f y cs [] -> [] map_Ordered_Lists_2D_w_context :: (Element_w_Coord e -> c -> b) -> c -> Ordered_Lists_2D e -> Ordered_Lists_2D b map_Ordered_Lists_2D_w_context f context world = case world of l: ls -> map_line f context l: map_Ordered_Lists_2D_w_context f context ls [] -> [] where map_line :: (Element_w_Coord e -> c -> b) -> c -> Sparse_Line e -> Sparse_Line b map_line f context line = Sparse_Line {y_pos = (y_pos line), entries = map_elements f context (y_pos line) (entries line)} where map_elements :: (Element_w_Coord e -> c -> b) -> c -> Y_Coord -> Placed_Elements e -> Placed_Elements b map_elements f context y elements = case elements of c: cs -> Placed_Element {x_pos = (x_pos c), entry = f ((entry c), ((x_pos c), y)) context}: map_elements f context y cs [] -> [] map_Ordered_Lists_2D_w_context_to_list :: (Element_w_Coord e -> c -> b) -> c -> Ordered_Lists_2D e -> [b] map_Ordered_Lists_2D_w_context_to_list f context world = case world of l: ls -> map_line f context l ++ map_Ordered_Lists_2D_w_context_to_list f context ls [] -> [] where map_line :: (Element_w_Coord e -> c -> b) -> c -> Sparse_Line e -> [b] map_line f context line = map_elements f context (y_pos line) (entries line) where map_elements :: (Element_w_Coord e -> c -> b) -> c -> Y_Coord -> Placed_Elements e -> [b] map_elements f context y elements = case elements of c: cs -> f ((entry c), ((x_pos c), y)) context : map_elements f context y cs [] -> [] size :: Ordered_Lists_2D e -> Int size world = case world of l: ls -> length (entries l) + size ls [] -> 0 sparse_list_2D_to_list :: Ordered_Lists_2D e -> [e] sparse_list_2D_to_list world = case world of l: ls -> (entries_to_list (entries l)) ++ sparse_list_2D_to_list ls [] -> [] where entries_to_list :: Placed_Elements e -> [e] entries_to_list entries = case entries of c: cs -> (entry c): entries_to_list cs [] -> [] sparse_list_2D_to_list_2D :: Ordered_Lists_2D e -> List_2D e sparse_list_2D_to_list_2D world = case world of l: ls -> (entries_to_list (y_pos l) (entries l)) ++ sparse_list_2D_to_list_2D ls [] -> [] where entries_to_list :: Y_Coord -> Placed_Elements e -> List_2D e entries_to_list y entries = case entries of c: cs -> (entry c, (x_pos c, y)): entries_to_list y cs [] -> []
Assignment 1 student template/Sources/Drawing/Cell.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Drawing.Cell ( draw_cell -- :: (Cell, Coord) -> Float -> Picture ) where import Data.Cell (Cell) import Data.Coordinates (Coord) import Drawing.Cell_To_Colour (cell_to_colour) import Graphics.Gloss (Picture, rectangleSolid, translate, color) draw_cell :: (Cell, Coord) -> Float -> Picture draw_cell (cell, (x, y)) size = translate x' y' (color (cell_to_colour cell) (rectangleSolid (size - 1) (size - 1))) where x' = size * fromIntegral x y' = size * fromIntegral y
Assignment 1 student template/Sources/Drawing/Cell_To_Colour.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Drawing.Cell_To_Colour ( cell_to_colour -- :: Cell -> Color ) where import Data.Cell (Cell (Head, Tail, Conductor, Empty)) import Graphics.Gloss (Color, red, blue, yellow, black, dark) cell_to_colour :: Cell -> Color cell_to_colour cell = case cell of Head -> dark blue Tail -> dark red Conductor -> dark yellow Empty -> black
Assignment 1 student template/Sources/Drawing/Constants.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Drawing.Constants ( Window_Size (x_dim, y_dim), Window_Pos (x_pos, y_pos), window_size, window_pos, cell_size ) where import World_Class (World_Dimensions (w_width, w_height)) data Window_Size = Window_Size {x_dim, y_dim :: Int} data Window_Pos = Window_Pos {x_pos, y_pos :: Int} window_size = Window_Size {x_dim = 800, y_dim = 800} :: Window_Size window_pos = Window_Pos {x_pos = 10, y_pos = 10} :: Window_Pos cell_size :: World_Dimensions -> Float cell_size dim = (1.0 - border_percentage) * min (x_window_size / f_width) (y_window_size / f_height) where (x_window_size, y_window_size) = (fromIntegral (x_dim window_size), fromIntegral (y_dim window_size)) (f_width, f_height) = (fromInteger (w_width dim) , fromInteger (w_height dim)) border_percentage = 0.05 -- meaning 5% of the tighter dimension will be used for border
Assignment 1 student template/Sources/Drawing/Simulation (for gloss <= 1.5.2.1).hs
-- -- Uwe R. Zimmer -- Australia 2012 -- -- Version for gloss 1.5.2.1 (or older). module Drawing.Simulation ( simulate -- :: Attributed_World world -- starting state -- -> (Attributed_World world -> Picture) -- drawing function -- -> (ViewPort -> Float -> Attributed_World world -> Attributed_World world) -- transition function -- -> Int -- frames per second -- -> IO () ) where import Drawing.Constants (Window_Size (x_dim, y_dim), Window_Pos (x_pos, y_pos), window_size, window_pos) import Graphics.Gloss (simulateInWindow, black, Picture) import World_Class (Attributed_World) simulate :: Attributed_World world -> (Attributed_World world -> Picture) -> (Attributed_World world -> Attributed_World world) -> Int -> IO () simulate a_world draw transfer fps = do simulateInWindow "Wireworld" -- Window title (x_dim window_size, y_dim window_size) -- Window size (x_pos window_pos , y_pos window_pos) -- Window position black -- Background colour fps -- Transitions per second a_world -- Starting state draw -- Function to draw world (\_ _ -> transfer) -- Step world one state
Assignment 1 student template/Sources/Drawing/Simulation (for gloss >= 1.6.0.1).hs
-- -- Uwe R. Zimmer -- Australia 2013 -- -- Version for gloss 1.6.0.1 (or newer). module Drawing.Simulation ( simulate -- :: Attributed_World world -- starting state -- -> (Attributed_World world -> Picture) -- drawing function -- -> (ViewPort -> Float -> Attributed_World world -> Attributed_World world) -- transition function -- -> Int -- frames per second -- -> IO () ) where import Drawing.Constants (Window_Size (x_dim, y_dim), Window_Pos (x_pos, y_pos), window_size, window_pos) import Graphics.Gloss (Display (InWindow), black, Picture) import qualified Graphics.Gloss (simulate) import World_Class (Attributed_World) simulate :: Attributed_World world -> (Attributed_World world -> Picture) -> (Attributed_World world -> Attributed_World world) -> Int -> IO () simulate a_world draw transfer fps = do Graphics.Gloss.simulate (InWindow -- In a window "Wireworld" -- Window title (x_dim window_size, y_dim window_size) -- Window size (x_pos window_pos , y_pos window_pos)) -- Window position black -- Background colour fps -- Transitions per second a_world -- Starting state draw -- Function to draw world (\_ _ -> transfer) -- Step world one state
Assignment 1 student template/Sources/Drawing/Simulation.hs
-- -- Uwe R. Zimmer -- Australia 2013 -- -- Version for gloss 1.6.0.1 (or newer). module Drawing.Simulation ( simulate -- :: Attributed_World world -- starting state -- -> (Attributed_World world -> Picture) -- drawing function -- -> (ViewPort -> Float -> Attributed_World world -> Attributed_World world) -- transition function -- -> Int -- frames per second -- -> IO () ) where import Drawing.Constants (Window_Size (x_dim, y_dim), Window_Pos (x_pos, y_pos), window_size, window_pos) import Graphics.Gloss (Display (InWindow), black, Picture) import qualified Graphics.Gloss (simulate) import World_Class (Attributed_World) simulate :: Attributed_World world -> (Attributed_World world -> Picture) -> (Attributed_World world -> Attributed_World world) -> Int -> IO () simulate a_world draw transfer fps = do Graphics.Gloss.simulate (InWindow -- In a window "Wireworld" -- Window title (x_dim window_size, y_dim window_size) -- Window size (x_pos window_pos , y_pos window_pos)) -- Window position black -- Background colour fps -- Transitions per second a_world -- Starting state draw -- Function to draw world (\_ _ -> transfer) -- Step world one state
Assignment 1 student template/Sources/Drawing/Worlds/For_List_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Drawing.Worlds.For_List_2D ( draw_world -- :: List_2D Cell -> Float -> Picture ) where import Data.Cell (Cell) import Data.List_2D (List_2D, map_List_2D_w_context_to_list) import Drawing.Cell (draw_cell) import Graphics.Gloss (Picture (Pictures)) draw_world :: List_2D Cell -> Float -> Picture draw_world world cell_size = Pictures (map_List_2D_w_context_to_list draw_cell cell_size world)
Assignment 1 student template/Sources/Drawing/Worlds/For_Ordered_Lists_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Drawing.Worlds.For_Ordered_Lists_2D ( draw_world -- :: Ordered_Lists_2D Cell -> Float -> Picture ) where import Data.Cell (Cell) import Data.Ordered_Lists_2D (Ordered_Lists_2D, map_Ordered_Lists_2D_w_context_to_list) import Drawing.Cell (draw_cell) import Graphics.Gloss (Picture (Pictures)) draw_world :: Ordered_Lists_2D Cell -> Float -> Picture draw_world world cell_size = Pictures (map_Ordered_Lists_2D_w_context_to_list draw_cell cell_size world)
Assignment 1 student template/Sources/Load/Pixel_To_Cell.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Load.Pixel_To_Cell ( Pixel (Pixel, red, green, blue, alpha), pixel_to_cell -- :: Pixel -> Cell ) where import Data.Cell (Cell (Head, Tail, Conductor, Empty)) import Data.Word (Word8) data Pixel = Pixel {red, green, blue, alpha :: Word8} pixel_to_cell :: Pixel -> Cell pixel_to_cell Pixel {red = r, green = g, blue = b, alpha = _} | r >= 128 && g >= 128 && b < 128 = Conductor -- somewhat yellow | r >= 128 && g < 128 && b < 128 = Tail -- somewhat red | r < 128 && g < 128 && b >= 128 = Head -- somewhat blue | otherwise = Empty
Assignment 1 student template/Sources/Load/Wireworld.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- -- based on a module by: -- -- By Ludvik 'Probie' Galois -- Modified 10 Feb 2012 module Load.Wireworld ( read_world_from_bmp_file -- :: String -- Filename -- -> Attributed_World world -- Empty world -- -> (Loaded_World -> Attributed_World world) -- prepare function -- -> IO (Attributed_World world) -- returns the loaded and prepared world ) where import Codec.BMP (readBMP, BMP, bmpDimensions, unpackBMPToRGBA32) import Data.ByteString (unpack) import Data.Cell (Cell (Empty)) import Data.Word (Word8) import Load.Pixel_To_Cell (Pixel (Pixel, red, green, blue, alpha), pixel_to_cell) import System.IO (stderr, hPutStrLn) import World_Class ( Attributed_World, Loaded_World (L_World, loaded_dim, loaded_world), World_Dimensions (World_Dim, w_width, w_height)) read_world_from_bmp_file :: String -> Attributed_World world -> (Loaded_World -> Attributed_World world) -> IO (Attributed_World world) read_world_from_bmp_file filename empty_world prepare_world = do inputbmp <- readBMP filename case inputbmp of Left e -> hPutStrLn stderr (show e) >> return empty_world -- show error Right bmp -> return (bmp_to_world bmp prepare_world) -- return the loaded world bmp_to_world :: BMP -> (Loaded_World -> Attributed_World world) -> Attributed_World world bmp_to_world bmp prepare_world = prepare_world (L_World { loaded_dim = World_Dim {w_width = width, w_height = height}, loaded_world = cells_with_coordinates}) where cells_with_coordinates = filter non_empty (zip cells coordinates) where non_empty (cell, _) = not (cell == Empty) cells = map pixel_to_cell rgba_pixels where rgba_pixels = split_into_pixel (unpack (unpackBMPToRGBA32 bmp)) coordinates = [(x - (width `div` 2), y - (height `div` 2)) | y <- [0 .. height - 1], x <- [0 .. width - 1]] (width, height) = (fromIntegral width', fromIntegral height') where (width', height') = bmpDimensions bmp split_into_pixel :: [Word8] -> [Pixel] split_into_pixel list = case list of r: g: b: a: xs -> Pixel {red = r, green = g, blue = b, alpha = a}: split_into_pixel xs [] -> [] _ -> error "bitmap does not spit up into four byte pixels"
Assignment 1 student template/Sources/Measure/Time.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Measure.Time ( time_expression -- :: IO e -> IO e -- prints the elapsed time for evaluating the expression e ) where import Data.Time.Clock (getCurrentTime, diffUTCTime) -- import System.CPUTime (getCPUTime) import Text.Printf (printf) -- Time is currently measured in overall time which has been found to be more predictable. -- While CPU time measurements seem more appropriate, Haskell doesn't quite seem to deliver as -- advertised on those functions. time_expression :: IO e -> IO e time_expression expression = do start_time <- getCurrentTime -- getCPUTime value <- expression stop_time <- getCurrentTime -- getCPUTime let diff = diffUTCTime stop_time start_time -- (fromIntegral (stop_time - start_time)) / (10^12) printf "\tElapsed time: %0.3f sec" (realToFrac diff :: Double) -- (diff :: Double) return value
Assignment 1 student template/Sources/Transitions/For_List_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Transitions.For_List_2D ( transition_world -- :: List_2D Cell -> List_2D Cell ) where import Data.Cell (Cell (Head, Tail, Conductor, Empty)) import Data.Coordinates import Data.List_2D -- Replace this function with something more meaningful: transition_world :: List_2D Cell -> List_2D Cell transition_world world = world
Assignment 1 student template/Sources/Transitions/For_Ordered_Lists_2D.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module Transitions.For_Ordered_Lists_2D ( transition_world -- :: Ordered_Lists_2D Cell -> Ordered_Lists_2D Cell ) where import Data.Cell (Cell (Head, Tail, Conductor, Empty)) import Data.Coordinates import Data.Ordered_Lists_2D -- Replace this function with something more meaningful: transition_world :: Ordered_Lists_2D Cell -> Ordered_Lists_2D Cell transition_world world = world
Assignment 1 student template/Sources/Wireworld.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- import Data.Cell (Cell (Head)) import Commandline.Options (args_to_options, Data_Structure (List_2D, Ordered_Lists_2D), Options (world_filename, no_of_tests, model, fps)) import Drawing.Simulation (simulate) import Load.Wireworld (read_world_from_bmp_file) import Measure.Time (time_expression) import System.Environment (getArgs) import Worlds.As_List_2D -- (World_model, World_Class (empty_world, prepare_world, transition_world, draw_world, element_occurrence, size)) import Worlds.As_Ordered_Lists_2D -- (World_model, World_Class (empty_world, prepare_world, transition_world, draw_world, element_occurrence, size)) import World_Class (Attributed_World) iterate_function_n_times :: (a -> a) -> Int -> a -> a iterate_function_n_times f n x | n > 0 = iterate_function_n_times f (n - 1) (f x) | otherwise = x run_tests :: Attributed_World world -> Int -> (Attributed_World world -> Int) -> (Cell -> Attributed_World world -> Int) -> IO () run_tests a_world runs size element_occurrence | runs > 0 = do putStr "Active heads in the world: " time_expression (putStr (show (element_occurrence Head a_world))) putStrLn ("\tafter " ++ show runs ++ " transitions on " ++ show (size a_world) ++ " cells") | otherwise = do putStrLn "No measurements are taken - number of tests has been set to zero" main :: IO () main = do args <- getArgs let options = args_to_options args case model options of List_2D -> do world <- read_world_from_bmp_file (world_filename options) empty_world prepare_world :: IO (Attributed_World Worlds.As_List_2D.World_model) let transformed_world = iterate_function_n_times transition_world (no_of_tests options) world run_tests transformed_world (no_of_tests options) size element_occurrence simulate world draw_world transition_world (fps options) Ordered_Lists_2D -> do world <- read_world_from_bmp_file (world_filename options) empty_world prepare_world :: IO (Attributed_World Worlds.As_Ordered_Lists_2D.World_model) let transformed_world = iterate_function_n_times transition_world (no_of_tests options) world run_tests transformed_world (no_of_tests options) size element_occurrence simulate world draw_world transition_world (fps options)
Assignment 1 student template/Sources/World_Class.hs
-- -- Uwe R. Zimmer -- Australia 2012 -- module World_Class ( World_Class ( empty_world, -- :: Attributed_World world prepare_world, -- :: Loaded_World -> Attributed_World world transition_world, -- :: Attributed_World world -> Attributed_World world draw_world, -- :: Attributed_World world -> Picture element_occurrence, -- :: Cell -> Attributed_World world -> Int size -- :: Attributed_World world -> Int ), World_Dimensions (World_Dim, w_width, w_height), Loaded_World (L_World, loaded_dim, loaded_world), Attributed_World (A_World, world_dim, world_itself), fun_world -- :: (world -> world) -> Attributed_World world -> Attributed_World world -- Applies a function to the world inside an attributed world - simple helper to make things readable ) where import Data.Cell (Cell) import Data.Coordinates (Distance) import Data.List_2D (List_2D) import Graphics.Gloss (Picture) data World_Dimensions = World_Dim {w_width, w_height :: Distance} data Loaded_World = L_World {loaded_dim :: World_Dimensions, loaded_world :: List_2D Cell} data Attributed_World world = A_World {world_dim :: World_Dimensions, world_itself :: world} class World_Class world where empty_world :: Attributed_World world prepare_world :: Loaded_World -> Attributed_World world transition_world :: Attributed_World world -> Attributed_World world draw_world :: Attributed_World world -> Picture element_occurrence :: Cell -> Attributed_World world -> Int size :: Attributed_World world -> Int fun_world :: (world -> world) -> Attributed_World world -> Attributed_World world fun_world f a_world = A_World {world_dim = world_dim a_world, world_itself = f (world_itself a_world)}
Assignment 1 student template/Sources/Worlds/As_List_2D.hs
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} -- -- Uwe R. Zimmer -- Australia 2012 -- module Worlds.As_List_2D ( World_model, World_Class ( empty_world, -- :: World_model prepare_world, -- :: List_2D Cell -> World_model transition_world, -- :: World_model -> World_model draw_world, -- :: World_model -> Float -> Picture element_occurrence, -- :: Cell -> World_model -> Int size -- :: World_model -> Int ) ) where import Data.Cell (Cell) import Data.List_2D (List_2D, element_occurrence, size) import Drawing.Constants (cell_size) import Drawing.Worlds.For_List_2D (draw_world) import Transitions.For_List_2D (transition_world) import World_Class ( World_Class ( empty_world, prepare_world, transition_world, draw_world, element_occurrence, size), World_Dimensions (World_Dim, w_width, w_height), Loaded_World (loaded_dim, loaded_world), Attributed_World (A_World, world_dim, world_itself), fun_world) type World_model = List_2D Cell instance World_Class World_model where empty_world = A_World {world_dim = World_Dim {w_width = 0, w_height = 0}, world_itself = []} prepare_world l_world = A_World {world_dim = loaded_dim l_world, world_itself = (loaded_world l_world)} transition_world a_world = fun_world Transitions.For_List_2D.transition_world a_world draw_world a_world = Drawing.Worlds.For_List_2D.draw_world (world_itself a_world) (cell_size (world_dim a_world)) element_occurrence cell a_world = Data.List_2D.element_occurrence cell (world_itself a_world) size world = Data.List_2D.size (world_itself world)
Assignment 1 student template/Sources/Worlds/As_Ordered_Lists_2D.hs
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} -- -- Uwe R. Zimmer -- Australia 2012 -- module Worlds.As_Ordered_Lists_2D ( World_model, World_Class ( empty_world, -- :: World_model prepare_world, -- :: List_2D Cell -> World_model transition_world, -- :: World_model -> World_model draw_world, -- :: World_model -> Float -> Picture element_occurrence, -- :: Cell -> World_model -> Int size -- :: World_model -> Int ) ) where import Data.Cell (Cell) import Data.Ordered_Lists_2D (Ordered_Lists_2D, insert_list, element_occurrence, size) import Drawing.Constants (cell_size) import Drawing.Worlds.For_Ordered_Lists_2D (draw_world) import Transitions.For_Ordered_Lists_2D (transition_world) import World_Class ( World_Class ( empty_world, prepare_world, transition_world, draw_world, element_occurrence, size), World_Dimensions (World_Dim, w_width, w_height), Loaded_World (loaded_dim, loaded_world), Attributed_World (A_World, world_dim, world_itself), fun_world) type World_model = Ordered_Lists_2D Cell instance World_Class World_model where empty_world = A_World {world_dim = World_Dim {w_width = 0, w_height = 0}, world_itself = []} prepare_world l_world = A_World {world_dim = loaded_dim l_world, world_itself = insert_list (loaded_world l_world) []} transition_world a_world = fun_world Transitions.For_Ordered_Lists_2D.transition_world a_world draw_world a_world = Drawing.Worlds.For_Ordered_Lists_2D.draw_world (world_itself a_world) (cell_size (world_dim a_world)) element_occurrence cell a_world = Data.Ordered_Lists_2D.element_occurrence cell (world_itself a_world) size world = Data.Ordered_Lists_2D.size (world_itself world)
