diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+Copyright (c) 2008, Stephan Friedrichs
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,8 @@
+#! /usr/bin/env runhaskell
+
+> module Main where
+>
+> import Distribution.Simple
+>
+> main = defaultMain
+
diff --git a/piet.cabal b/piet.cabal
new file mode 100644
--- /dev/null
+++ b/piet.cabal
@@ -0,0 +1,45 @@
+
+Name:               piet
+Version:            0.1
+Stability:          beta
+
+Category:           Compilers/Interpreters
+Synopsis:           A Piet interpreter
+Description:        An interpreter for the Piet programming language,
+                    see <http://www.dangermouse.net/esoteric/piet.html>.
+
+License:            BSD3
+License-File:       LICENSE
+Copyright:          (c) 2008, Stephan Friedrichs
+
+Author:             Stephan Friedrichs
+Maintainer:         Stephan Friedrichs (deduktionstheorem at web dot de)
+
+Build-Type:         Custom
+Cabal-Version:      >= 1.2
+
+Library
+  Build-Depends:
+      array >= 0.1
+    , base >= 3.0
+    , containers >= 0.1
+    , Imlib >= 0.1
+    , mtl >= 1.1
+  Exposed-Modules:
+      Data.RollStack
+    , Language.Piet
+    , Language.Piet.Commands
+    , Language.Piet.Compiler
+    , Language.Piet.Interpreter
+    , Language.Piet.PietMonad
+    , Language.Piet.Types
+  Hs-Source-Dirs:   sources
+  GHC-Options:      -threaded -Wall -O2
+  Extensions:       CPP
+
+Executable          piet
+  Main-Is:          Main.hs
+  Hs-Source-Dirs:   sources
+  GHC-Options:      -threaded -Wall -O2
+  Extensions:       CPP
+
diff --git a/sources/Data/RollStack.hs b/sources/Data/RollStack.hs
new file mode 100644
--- /dev/null
+++ b/sources/Data/RollStack.hs
@@ -0,0 +1,115 @@
+
+-- | This module implements a customized stack for the Piet programming
+-- language.
+--
+-- In addition to the common 'push', 'pop' and 'top' operations, the
+-- a 'RollStack' provides a 'roll' (see below) command, which is the
+-- reason for using a 'Seq'uence and not a list as underlying data
+-- structure.
+--
+-- Whenever the /O/-notation is used, /n/ describes the number of elements
+-- within the stack.
+module Data.RollStack
+	(
+	-- * Stack type
+	  RollStack
+	
+	-- * Query
+	, isEmpty
+	, top
+	
+	-- * Construction
+	, Data.RollStack.empty
+	, Data.RollStack.singleton
+	
+	-- * Insert delete and roll operations
+	, push
+	, pop
+	, roll
+
+	-- * List conversion
+	, Data.RollStack.fromList
+	, Data.RollStack.toList
+	) where
+
+import Data.Foldable as Foldable
+import Data.Maybe
+import Data.Sequence  as Seq
+import Prelude hiding (foldl, foldr)
+
+-- | The 'RollStack' type.
+newtype RollStack a
+	= Stack (Seq a)
+
+instance (Show a) => Show (RollStack a) where
+	show (Stack xs) = show xs
+
+instance (Eq a) => Eq (RollStack a) where
+	(Stack xs) == (Stack ys) = xs == ys
+
+instance (Ord a) => Ord (RollStack a) where
+	compare (Stack xs) (Stack ys) = compare xs ys
+
+instance Functor RollStack where
+	fmap f (Stack xs) = Stack $ fmap f xs
+
+instance Foldable RollStack where
+	fold      (Stack xs) = fold      xs
+	foldMap f (Stack xs) = foldMap f xs
+	foldr f z (Stack xs) = foldr f z xs
+	foldl f z (Stack xs) = foldl f z xs
+
+-- | /O(1)/. Tests, if a 'RollStack' is empty.
+isEmpty :: RollStack a -> Bool
+isEmpty = isNothing . top
+
+-- | /O(1)/. Looks at the top element of the 'RollStack'. Returns
+-- 'Nothing' if the stack is empty.
+top :: RollStack a -> Maybe a
+top stack = fst `fmap` pop stack
+
+-- | /O(1)/. Construct an empty 'Stack'.
+empty :: RollStack a
+empty = Stack Seq.empty
+
+-- | /O(1)/. Construct a 'RollStack' containing a single element.
+singleton :: a -> RollStack a
+singleton = Stack . Seq.singleton
+
+-- | /O(1)/. Push an element on the 'RollStack'.
+push :: a -> RollStack a -> RollStack a
+push x (Stack xs) = Stack (x <| xs)
+
+-- | /O(1)/. Pop the top element from the 'RollStack' if it is not empty.
+pop :: RollStack a -> Maybe (a, RollStack a)
+pop (Stack xs) = case viewl xs of
+	EmptyL   -> fail "empty RollStack"
+	y :< ys -> return (y, Stack ys)
+
+-- | /O(log(n))/. A single roll to depth /n/ is defined as burying the top
+-- value on the stack /n/ deep and bringing all values above it up by 1
+-- place. A negative number of rolls rolls in the opposite direction. A
+-- negative depth results in an 'error'.
+roll :: Int		-- ^ Number of rolls
+	-> Int		-- ^ Depth
+	-> RollStack a	-- ^ Original 'RollStack'
+	-> RollStack a	-- ^ Rotated 'RollStack'
+roll rolls depth unmodified@(Stack xs)
+	| depth < 0                = error $ "negative depth in Data.RollStack.roll: " ++ show depth
+	| rolls == 0 || depth == 0 = unmodified
+	| otherwise                = let
+		(xs1, xs2)   = Seq.splitAt depth xs
+		(xs1a, xs1b) = Seq.splitAt (rolls `mod` depth) xs1
+		in
+		Stack (xs1b >< xs1a >< xs2)
+
+-- | /O(n)/. Convert a list into a 'Stack'. The list's head will be
+-- the first element of the 'Stack'
+fromList :: [a] -> RollStack a
+fromList = Stack . Seq.fromList
+
+-- | /O(n)/. Convert a 'RollStack' to a list. The 'top' of the 'RollStack'
+-- will be the list's head.
+toList :: RollStack a -> [a]
+toList (Stack xs) = Foldable.toList xs
+
diff --git a/sources/Language/Piet.hs b/sources/Language/Piet.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet.hs
@@ -0,0 +1,17 @@
+
+-- | Comprehensive module of the Piet interpreter. See
+-- <http://www.dangermouse.net/esoteric/piet.html>.
+module Language.Piet
+	( module Language.Piet.Commands
+	, module Language.Piet.Compiler
+	, module Language.Piet.Interpreter
+	, module Language.Piet.PietMonad
+	, module Language.Piet.Types
+	) where
+
+import Language.Piet.Commands
+import Language.Piet.Compiler
+import Language.Piet.Interpreter
+import Language.Piet.PietMonad
+import Language.Piet.Types
+
diff --git a/sources/Language/Piet/Commands.hs b/sources/Language/Piet/Commands.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet/Commands.hs
@@ -0,0 +1,218 @@
+
+-- | This module contains the implementation of the Piet language
+-- constructs. Most of the documentation is copied from the
+-- Piet specification at <http://www.dangermouse.net/esoteric/piet.html>.
+module Language.Piet.Commands
+	(
+	-- * Stack access
+	  piet_push
+	, piet_pop
+	
+	-- * Arithmetic operators
+	, piet_add
+	, piet_subtract
+	, piet_multiply
+	, piet_divide
+	, piet_mod
+	
+	-- * Boolean operations
+	, piet_not
+	, piet_greater
+	
+	-- * Movement
+	, piet_pointer
+	, piet_switch
+	
+	-- * Stack modification
+	, piet_duplicate
+	, piet_roll
+	
+	-- * I/O
+	, piet_in_number, piet_in_char
+	, piet_out_number, piet_out_char
+	) where
+
+import Control.Monad
+import Language.Piet.PietMonad
+import Language.Piet.Types
+
+-- | Pushes the value of the colour block just exited on to the stack.
+-- Note that values of colour blocks are not automatically pushed on
+-- to the stack - this push operation must be explicitly carried out.
+piet_push :: Int -> PietMonad ()
+piet_push n = do
+	logWithPosition $ "push " ++ show n
+	stackPush n
+
+-- | Pops the top value off the stack and discards it.
+piet_pop :: PietMonad ()
+piet_pop = do
+	logWithPosition "pop"
+	forcePopFail "pop"
+	return ()
+
+-- | Pops the top two values off the stack, adds them, and pushes the
+-- result back on the stack.
+piet_add :: PietMonad ()
+piet_add = do
+	logWithPosition "add"
+	onStack2 "add" (+)
+
+-- | Pops the top two values off the stack, subtracts the top value from
+-- the second top value, and pushes the result back on the stack.
+piet_subtract :: PietMonad ()
+piet_subtract = do
+	logWithPosition "subtract"
+	onStack2 "subtract" (flip (-))
+
+-- | Pops the top two values off the stack, multiplies them, and pushes the
+-- result back on the stack. 
+piet_multiply :: PietMonad ()
+piet_multiply = do
+	logWithPosition "multiply"
+	onStack2 "multiply" (*)
+
+-- | Pops the top two values off the stack, calculates the integer division
+-- of the second top value by the top value, and pushes the result back on
+-- the stack.
+piet_divide :: PietMonad ()
+piet_divide = do
+	logWithPosition "divide"
+	onStack2 "divide" (flip div)
+
+-- | Pops the top two values off the stack, calculates the second top value
+-- modulo the top value, and pushes the result back on the stack.
+piet_mod :: PietMonad ()
+piet_mod = do
+	logWithPosition "mod"
+	onStack2 "mod" (flip Prelude.mod)
+
+-- | Replaces the top value of the stack with 0 if it is non-zero, and 1 if
+-- it is zero.
+piet_not :: PietMonad ()
+piet_not = do
+	logWithPosition "not"
+	onStack1 "not" not'
+	where
+	not' 0 = 1
+	not' _ = 0
+
+-- | Pops the top two values off the stack, and pushes 1 on to the stack if
+-- the second top value is greater than the top value, and pushes 0 if it
+-- is not greater.
+piet_greater :: PietMonad ()
+piet_greater = do
+	logWithPosition "greater"
+	onStack2 "greater" greater'
+	where
+	greater' a b
+		| a < b     = 1
+		| otherwise = 0
+
+-- | Pops the top value off the stack and rotates the DP clockwise that many
+-- steps (anticlockwise if negative).
+piet_pointer :: PietMonad ()
+piet_pointer = do
+	n	<- forcePopFail "pointer"
+	dp	<- getDP
+	let dp'	= (rotate n dp)
+	setDP dp'
+	logWithPosition $ "pointer " ++ show dp'
+
+-- | Pops the top value off the stack and toggles the CC that many times.
+piet_switch :: PietMonad ()
+piet_switch = do
+	n	<- forcePopFail "switch"
+	cc	<- getCC
+	let cc'	= toggle n cc
+	setCC cc'
+	logWithPosition $ "switch " ++ show cc'
+
+-- | Pushes a copy of the top value on the stack on to the stack.
+piet_duplicate :: PietMonad ()
+piet_duplicate = do
+	logWithPosition "duplicate"
+	x <- forcePopFail "duplicate"
+	stackPush x
+	stackPush x
+
+-- | Pops the top two values off the stack and \"rolls\" the remaining stack
+-- entries to a depth equal to the second value popped, by a number of
+-- rolls equal to the first value popped. A single roll to depth /n/ is
+-- defined as burying the top value on the stack /n/ deep and bringing all
+-- values above it up by 1 place. A negative number of rolls rolls in the
+-- opposite direction. A negative depth is an error and the command is
+-- ignored.
+--
+-- In this implementation, \"ignored\" means that the top two values
+-- remain pushed off the stack, while the rest of the stack remains
+-- unmodified.
+piet_roll :: PietMonad ()
+piet_roll = do
+	logWithPosition "roll"
+	rolls <- forcePopFail "roll"
+	depth <- forcePopFail "roll"
+	when (depth > 0 && rolls /= 0) $ stackRoll rolls depth
+
+-- | Reads a number from STDIN and pushes it on to the stack. 
+piet_in_number :: PietMonad ()
+piet_in_number = do
+	logWithPosition "in_number"
+	n <- readNumber
+	stackPush n
+
+-- | Reads a char from STDIN and pushes it on to the stack.
+piet_in_char :: PietMonad ()
+piet_in_char = do
+	logWithPosition "in_char"
+	n <- readChar
+	stackPush n
+
+-- | Pops the top value off the stack and prints it to STDOUT
+-- as a number.
+piet_out_number :: PietMonad ()
+piet_out_number = do
+	n <- forcePopFail "out_number"
+	logWithPosition $ "out_number " ++ show n
+	printNumber n
+
+-- | Pops the top value off the stack and prints it to STDOUT
+-- as a char.
+piet_out_char :: PietMonad ()
+piet_out_char = do
+	n <- forcePopFail "out_char"
+	logWithPosition $ "out_char " ++ show n
+	printChar n
+
+-- | Pops the top element of the stack, applies a function to it
+-- and pushes the result back on the stack. The 'String' describes
+-- the calling Piet function for possible errors.
+onStack1 :: String -> (Int -> Int) -> PietMonad ()
+onStack1 location f = liftM f (forcePopFail location) >>= stackPush
+
+-- | Pops the top two elements of the stack, applies a function to
+-- them (the first argument will be the first element popped from
+-- the stack, the 2nd will be the 2nd) and pushes the result back
+-- on the stack. The 'String' describes the calling Piet function
+-- and might be needed to give error messages.
+onStack2 :: String -> (Int -> Int -> Int) -> PietMonad ()
+onStack2 location f = liftM2 f (forcePopFail location) (forcePopFail location) >>= stackPush
+
+-- | Pops the top element from the stack and 'fail's if none is
+-- available (with the given 'String' as location).
+forcePopFail :: String -> PietMonad Int
+forcePopFail location = forcePop (fail $ "Empty stack at " ++ location)
+
+-- | Tries to pop the top element from the stack and returns it.
+-- If the stack is empty, the alternative action is performed.
+forcePop :: PietMonad Int -- ^ Will be executed if the stack is empty.
+	-> PietMonad Int  -- ^ Returns the top stack entry otherwise.
+forcePop errorAction = stackPop >>= maybe errorAction return
+
+-- | Helper that issues a 'Verbosed' log message and prefixes
+-- it with the current position.
+logWithPosition :: String -> PietMonad ()
+logWithPosition msg = do
+	pos	<- getPosition
+	logMessage Verbosed $ show pos ++ ' ' : msg
+
diff --git a/sources/Language/Piet/Compiler.hs b/sources/Language/Piet/Compiler.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet/Compiler.hs
@@ -0,0 +1,210 @@
+
+-- |
+-- This module implements the image processing part of this library. It
+-- is able to do basic image I/O and provides funcions for labelling
+-- images and extracting Piet-relevant information at the same time.
+module Language.Piet.Compiler
+	(
+	-- * I/O
+	  imgFromFile
+	
+	-- * The \"compiler\"
+	, compile
+	
+	-- * Labelling
+	, label4, label4With
+	) where
+
+import Control.Exception
+import Control.Monad
+import Data.IntMap hiding (filter)
+import Data.List hiding (insert)
+import Data.Monoid
+import Graphics.Imlib
+import Language.Piet.Types
+
+-- | Load an 'Image' holding Piet 'Colour's from a given file.
+-- If the codel length is known, it should be passed as 'Just'
+-- argument, otherwise, it is guessed from the file. Note that
+-- \"codel length\" means the edge length of the codels and
+-- not their size.
+--
+-- /This function is not thread safe due to imlib2!/
+imgFromFile :: Maybe Int	-- ^ Codel length or 'Nothing' if unknown
+	-> FilePath		-- ^ The image file location
+	-> IO (Either ImlibLoadError (Image Colour))
+imgFromFile codelInfo file = do
+	(img, err)	<- loadImageWithErrorReturn file
+	case err of
+		ImlibLoadErrorNone	-> bracket
+				(contextSetImage img)
+				(const freeImageAndDecache)
+				$ const $ do
+			codelLength	<- maybe imageGuessCodelLength return codelInfo
+			img'		<- imageFromContext (max 1 codelLength)
+			return (Right img')
+		_			-> return (Left err)
+
+-- | Build an @'Image' 'Colour'@ from the current imlib2 context.
+imageFromContext :: Int		-- ^ Codel length (not size)
+	-> IO (Image Colour)	-- ^ The image data
+imageFromContext codelLength = do
+	width	<- (`div` codelLength) `liftM` imageGetWidth
+	height	<- (`div` codelLength) `liftM` imageGetHeight
+	alpha	<- imageHasAlpha
+
+	pixels	<- mapM (\xy@(x, y) -> do
+			ImlibColor a r g b <- imageQueryPixel
+				(x * codelLength)
+				(y * codelLength)
+			return (xy, if alpha then rgba2Colour r g b a else rgb2Colour  r g b)
+		) [ (x, y) | x <- [ 0 .. width-1 ], y <- [ 0 .. height-1 ] ]
+
+	return $ imgNew width height pixels
+
+-- | Guess the codel length from the image that is currently loaded in
+-- the imlib2 buffer. The guess simply is the the gcd of the image
+-- width, length and the length of all equally coloured subrows and
+-- -cols.
+imageGuessCodelLength :: IO Int
+imageGuessCodelLength = do
+	width	<- imageGetWidth
+	height	<- imageGetHeight
+
+	rows	<- mapM (\y -> mapM (\x -> imageQueryPixel x y)
+		[ 0 .. width-1 ]) [ 0 .. height-1 ]
+	cols	<- mapM (\x -> mapM (\y -> imageQueryPixel x y)
+		[ 0 .. height-1 ]) [ 0 .. width-1 ]
+	
+	return $ lastUntil (==1) $ scanl gcd (gcd width height)
+		$ fmap length (group rows) ++ fmap length (group cols)
+	
+	where
+
+	-- Get the first item of a list that fulfills @p@ or its
+	-- last element.
+	lastUntil :: Ord a => (a -> Bool) -> [a] -> a
+	lastUntil _ [x]    = x
+	lastUntil p (x:xs) = if p x then x else lastUntil p xs
+	lastUntil _ _      = error "empty list in lastUntil helper (imageGuessCodelLength)"
+
+-- | Compile an @'Image' 'Colour'@ to a Piet 'Program'.
+compile :: Image Colour -> Program
+compile image_ = let
+	(mask_, info_)	= label4 image_
+	in
+	Program
+		{ image	= image_
+		, mask	= mask_
+		, info	= info_
+		}
+
+-- | Status of the labelling algorithm.
+data LabellingStatus = LabellingStatus
+	{ _currentCoords	:: (Int, Int)		-- ^ Current pixel to investigate
+	, _nextKey		:: LabelKey		-- ^ Next unused 'LabelKey'
+	, _mask			:: Image LabelKey	-- ^ Each pixel contains a label key
+	, _infoMap		:: IntMap LabelInfo	-- ^ Mapping from 'LabelKey's to 'LabelInfo's
+	, _equivalences		:: EquivalenceMap	-- ^ Holds information about label equivalences
+	} deriving (Show, Eq, Ord)
+
+-- | Label an image with 4-neighbourship and equivalence as neighbouring
+-- condition, which is @'label4With' (==)@.
+label4 :: Eq a => Image a -> (Image LabelKey, IntMap LabelInfo)
+label4 = label4With (==)
+
+-- | Labels an image with 4-neighbourship.
+label4With :: (a -> a -> Bool)	-- ^ Decides whether two neighbouring pixels are adjacent.
+	-> Image a		-- ^ The 'Image' to be labelled.
+	-> (Image LabelKey, IntMap LabelInfo)
+				-- ^ A mask 'Image' (containing a key for every pixel)
+				-- and a mapping from these keys to 'LabelInfo'.
+label4With neighbours img = let
+	status	= label4With' neighbours img LabellingStatus
+		{ _currentCoords	= (0, 0)
+		, _nextKey		= 0
+		, _mask			= imgNew (imgWidth img) (imgHeight img) []
+		, _infoMap		= mempty
+		, _equivalences		= mempty
+		}
+	img'	= fmap ((flip equivClass) (_equivalences status)) $ _mask status
+	inf	= foldWithKey
+		(\label labelInfo mergedMap -> let
+			label'	= equivClass label $ _equivalences status
+			in
+			alter (maybe (Just labelInfo) (Just . (mappend labelInfo))) label' mergedMap
+		) mempty
+		$ _infoMap status
+	in (img', inf)
+
+-- | Labelling algorithm expressed in terms of a 'LabellingStatus', see
+-- 'label4With'.
+label4With' :: (a -> a -> Bool) -> Image a -> LabellingStatus -> LabellingStatus
+{-# SPECIALISE
+    label4With' :: (Colour -> Colour -> Bool) -> Image Colour -> LabellingStatus -> LabellingStatus
+    #-}
+
+label4With' neighbours img status = let
+	xy@(x, y)	= _currentCoords status
+	pixel		= imgPixel x y img
+
+	mergeLabels	= fmap (\(x', y', _) -> imgPixel x' y' (_mask status))
+		$ filter (\(_, _, e) -> neighbours pixel e)
+		$ fmap (\(x', y') -> (x', y', imgPixel x' y' img))
+		$ previousNeighbours (_currentCoords status)
+	
+	status'		= case mergeLabels of
+		[]		-> let label = _nextKey status in status
+			{ _nextKey	= succ label
+			, _mask		= imgSetPixel x y label (_mask status)
+			, _infoMap	= insert label (addPixel x y mempty) (_infoMap status)
+			}
+		[label]		-> status
+			{ _mask		= imgSetPixel x y label (_mask status)
+			, _infoMap	= adjust (addPixel x y) label (_infoMap status)
+			}
+		[l1, l2]	-> let
+			label	= max l1 l2
+			in status
+				{ _mask		= imgSetPixel x y label (_mask status)
+				, _infoMap	= adjust (addPixel x y) label (_infoMap status)
+				, _equivalences	= equivInsert l1 l2 (_equivalences status)
+				}
+		_		-> error
+			"too many neighbours in Language.Piet.Compiler.ImageProcessor.label4With'"
+	in case nextCoords xy of
+		Just xy' -> label4With' neighbours img $ status' { _currentCoords = xy' }
+		Nothing  -> status'
+
+	where
+	previousNeighbours :: (Int, Int) -> [(Int, Int)]
+	previousNeighbours (x, y) = filter (\(x', y') -> x' >= 0 && y' >= 0) [ (x-1, y), (x, y-1) ]
+
+	nextCoords :: (Int, Int) -> Maybe (Int, Int)
+	nextCoords (x, y)
+		| x < imgWidth img - 1	= Just (x + 1, y)
+		| y < imgHeight img - 1	= Just (0, y + 1)
+		| otherwise		= Nothing
+
+-- | Detects equivalence classes. Invariant: Every element is mapped to the
+-- minimum of it's equivalence class.
+type EquivalenceMap = IntMap LabelKey
+
+-- | Find the equivalence class of a given element.
+equivClass :: LabelKey -> EquivalenceMap -> LabelKey
+equivClass e = findWithDefault e e
+
+-- | Insert a new equivalence.
+equivInsert :: LabelKey -> LabelKey -> EquivalenceMap -> EquivalenceMap
+equivInsert x y mp = let
+	class1		= equivClass x mp
+	class2		= equivClass y mp
+	classes		= [x, y, class1, class2]
+	newClass	= minimum classes
+	in
+	if x /= y
+		then fmap (\eqClass -> if or (fmap (== eqClass) classes) then newClass else eqClass)
+			$ insert x newClass
+			$ insert y newClass mp
+		else mp
+
diff --git a/sources/Language/Piet/Interpreter.hs b/sources/Language/Piet/Interpreter.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet/Interpreter.hs
@@ -0,0 +1,170 @@
+
+-- | This module implements an interpreter for the Piet programming
+-- language.
+module Language.Piet.Interpreter
+	(
+	-- * Interpreter implementation
+	  interpret
+	
+	-- * Helper functions
+	-- ** Movement
+	, interpretWhite
+	, nonBlackSucc
+	, succCoordinates
+	-- ** Colour difference handling
+	, colours2Command
+	, colourDiff2Command
+	) where
+
+import Control.Monad
+import Data.IntMap hiding (filter)
+import Data.Maybe
+import Language.Piet.Commands
+import Language.Piet.PietMonad
+import Language.Piet.Types
+
+-- | Interpret a Piet 'Program'.
+interpret :: Program -> PietMonad ()
+interpret = interpret' Nothing
+
+-- | Interpret a Piet 'Program'
+interpret' :: Maybe (Lightness, HueColour, Int)	-- ^ Previous' block colour and size if it was a hue-block
+	-> Program				-- ^ Program
+	-> PietMonad ()
+interpret' previous program = do
+	(x, y)	<- getPosition
+	case imgPixel x y (image program) of
+		Hue l c	-> do
+			maybe (return ())
+				(\(oldL, oldC, oldS) -> colours2Command oldL oldC l c oldS)
+				previous
+			
+			dp		<- getDP
+			cc		<- getCC
+			let key		= imgPixel x y (mask program)
+			let label	= findWithDefault EmptyInfo key (info program)
+			
+			case nonBlackSucc program label dp cc of
+				Just (x', y', dp', cc')	-> do
+					setPosition x' y'
+					setDP dp'
+					setCC cc'
+					interpret' (Just (l, c, labelSize label)) program
+				Nothing			-> do
+					terminate
+		White	-> interpretWhite program
+		Black	-> do
+			logMessage Fatal "Entered black block, terminate"
+			terminate
+
+-- | Find a way out of the current 'White' block. 'terminate' if there
+-- is no way out.
+interpretWhite :: Program -> PietMonad ()
+interpretWhite program = do
+	(x, y)		<- getPosition
+	let key		= imgPixel x y (mask program)
+	let codels	= labelSize $ findWithDefault EmptyInfo key (info program)
+	
+	-- The Maximum steps without loop:
+	--   every DP/CC combination * size of white block
+	-- Is there a better way without actually tracking coordinate/DP/CC tuples?
+	
+	when (White == imgPixel x y (image program))
+		$ interpretWhite' (8 * codels) program
+
+-- | See 'interpretWhite'. The 'Int' determines the maximum remaining
+-- moves by one codel and DP/CC changes.
+interpretWhite' :: Int -> Program -> PietMonad ()
+interpretWhite' limit program
+	| limit <= 0	= terminate
+	| otherwise	= do
+		(x, y)	<- getPosition
+		case imgPixel x y (image program) of
+			White	-> do
+				dp		<- getDP
+				let (x', y')	= addCoordinates dp x y
+				if isBlocked x' y' program
+					then do
+						cc	<- getCC
+						setDP $ rotate 1 dp
+						setCC $ toggle 1 cc
+						interpretWhite' (limit - 1) program
+					else do
+						setPosition x' y'
+						interpretWhite' (limit - 1) program
+			_	-> interpret' Nothing program -- found a way out
+
+-- | Find coordinates and resulting DP/CC of the successing non-black block,
+-- if it exists, 'Nothing' otherwise.
+nonBlackSucc :: Program		-- ^ Program
+	-> LabelInfo		-- ^ Current block
+	-> DirectionPointer	-- ^ DP
+	-> CodelChooser		-- ^ CC
+	-> Maybe (Int, Int, DirectionPointer, CodelChooser)
+				-- ^ Next coordinates, DP and CC (if available)
+nonBlackSucc program label dp cc = let
+	directions	= fmap (\(r, t) -> (rotate r dp, toggle t cc))
+		$ zip [ 0, 0, 1, 1, 2, 2, 3, 3 ] (0 : cycle [ 1, 1, 0, 0 ])
+	in
+	fmap (\((x, y), (d, c)) -> (x, y, d, c)) $ listToMaybe
+		$ filter (\((x, y), _) -> not (isBlocked x y program))
+		$ zip (fmap (uncurry (succCoordinates label)) directions) directions
+
+-- | Given a label, a 'DirectionPointer' and a 'CodelChooser', this
+-- function finds the coordinates of the next block to enter. These
+-- coordinates are not guaranteed to be valid, they might be out of
+-- range or point to a 'Black' or 'White' block.
+succCoordinates :: LabelInfo	-- ^ Current label
+	-> DirectionPointer	-- ^ DP
+	-> CodelChooser		-- ^ CC
+	-> (Int, Int)		-- ^ Where to enter the next block
+succCoordinates label dp cc = let
+	(getX, getY) = case (dp, cc) of
+		(DPRight, CCLeft)  -> (borderCoord . labelRight, borderMin . labelRight)
+		(DPRight, CCRight) -> (borderCoord . labelRight, borderMax . labelRight)
+		(DPDown,  CCLeft)  -> (borderMax . labelBottom,  borderCoord . labelBottom)
+		(DPDown,  CCRight) -> (borderMin . labelBottom,  borderCoord . labelBottom)
+		(DPLeft,  CCLeft)  -> (borderCoord . labelLeft,  borderMax . labelLeft)
+		(DPLeft,  CCRight) -> (borderCoord . labelLeft,  borderMin . labelLeft)
+		(DPUp,    CCLeft)  -> (borderMin . labelTop,     borderCoord . labelTop)
+		(DPUp,    CCRight) -> (borderMax . labelTop,     borderCoord . labelTop)
+	in
+	addCoordinates dp (getX label) (getY label)
+
+-- | Piet's commands are issued by a colour change, see
+-- <http://www.dangermouse.net/esoteric/piet.html>. This function
+-- takes two neighbouring colours and returns the resulting Piet
+-- command, which is a function consuming (or more likely,
+-- ignoring) an 'Int' (the size of the colour block that is being
+-- left) and returning a @'PietMonad' ()@.
+colours2Command :: Lightness	-- ^ 'Lightness' of the \"from\"-block
+	-> HueColour		-- ^ 'HueColour' of the \"from\"-block
+	-> Lightness		-- ^ 'Lightness' of the \"to\"-block
+	-> HueColour		-- ^ 'HueColour' of the \"to\"-block
+	-> Int			-- ^ The size of the \"from\"-block
+	-> PietMonad ()		-- ^ Resulting Piet operation
+colours2Command fromLight fromColour toLight toColour = colourDiff2Command
+	(lightnessChange fromLight toLight) (hueChange fromColour toColour)
+
+-- | Converts a colour difference calculated by 'Language.Piet.Types.colourChange' and
+-- 'lightnessChange' to a @'PietMonad' ()@, compare 'colours2Command'.
+colourDiff2Command :: Lightness -> HueColour -> Int -> PietMonad ()
+colourDiff2Command Light  Red     _ = return ()
+colourDiff2Command Normal Red     n = piet_push n
+colourDiff2Command Dark   Red     _ = piet_pop
+colourDiff2Command Light  Yellow  _ = piet_add
+colourDiff2Command Normal Yellow  _ = piet_subtract
+colourDiff2Command Dark   Yellow  _ = piet_multiply
+colourDiff2Command Light  Green   _ = piet_divide
+colourDiff2Command Normal Green   _ = piet_mod
+colourDiff2Command Dark   Green   _ = piet_not
+colourDiff2Command Light  Cyan    _ = piet_greater
+colourDiff2Command Normal Cyan    _ = piet_pointer
+colourDiff2Command Dark   Cyan    _ = piet_switch
+colourDiff2Command Light  Blue    _ = piet_duplicate
+colourDiff2Command Normal Blue    _ = piet_roll
+colourDiff2Command Dark   Blue    _ = piet_in_number
+colourDiff2Command Light  Magenta _ = piet_in_char
+colourDiff2Command Normal Magenta _ = piet_out_number
+colourDiff2Command Dark   Magenta _ = piet_out_char
+
diff --git a/sources/Language/Piet/PietMonad.hs b/sources/Language/Piet/PietMonad.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet/PietMonad.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+-- | A module implementing the Piet interpreter as a monad. The monad
+-- encapsulates the interpreter's status, i. e. the side-effects of
+-- Piet programs.
+module Language.Piet.PietMonad
+	(
+	-- * The Piet interpreter monad
+	  PietMonad
+	, InterpreterStatus
+	, LogLevel(..)
+	
+	-- * Status access
+	-- ** Direction Pointer, Codel Chooser and position
+	, getDP, setDP
+	, getCC, setCC
+	, getPosition, setPosition
+	-- ** Stack primitives
+	, stackPush, stackPop, stackRoll
+	
+	-- * I/O
+	, printNumber, printChar
+	, readNumber, readChar
+	, logMessage
+	
+	-- * Termination
+	, terminate
+	
+	-- * Execution
+	, runPietMonad
+	) where
+
+import Control.Concurrent
+import Control.Monad.Error ()
+import Control.Monad.State
+import Data.RollStack
+import Language.Piet.Types
+
+-- | The status of a Piet interpreter.
+data InterpreterStatus = InterpreterStatus
+	{ dp		:: DirectionPointer	-- ^ Direction Pointer
+	, cc		:: CodelChooser		-- ^ Codel Chooser
+	, position	:: (Int, Int)		-- ^ Position
+	, stack		:: RollStack Int	-- ^ Stack
+	}
+
+-- | A request a Piet interpreter may send to it's environment.
+data PietRequest
+	= Read  PietType	-- ^ The interpreter wants to read from STDIN.
+	| Print PietType Int	-- ^ The interpreter wants to print something to STDOUT.
+	| Log LogLevel String	-- ^ A log message has been issued.
+	| Terminate		-- ^ The Program has terminated.
+	deriving (Show, Eq, Ord)
+
+-- | Describes the importance of a log message.
+data LogLevel
+	= Verbosed	-- ^ Rather verbosed output.
+	| Info		-- ^ Usual log level.
+	| Error		-- ^ A recoverable error has occured.
+	| Fatal		-- ^ A fatal error has occured.
+	deriving (Eq, Ord)
+
+instance Show LogLevel where
+	show Verbosed	= "VERBOSED"
+	show Info	= "INFO    "
+	show Error	= "ERROR   "
+	show Fatal	= "FATAL   "
+
+-- | A monad encapsulating the status of a Piet interpreter.
+newtype PietMonad a = PietMonad (InterpreterStatus
+	-> Chan PietRequest
+	-> Chan Int
+	-> IO (Either String (a, InterpreterStatus)))
+
+instance Monad PietMonad where
+	return x = PietMonad (\status _ _ -> return (return (x, status)))
+	
+	(PietMonad m01) >>= f = PietMonad (\status0 requestChan inputChan -> do
+			either1	<- m01 status0 requestChan inputChan
+			case either1 of
+				Left msg		-> return (fail msg)
+				Right (x1, status1)	-> do
+					let (PietMonad m12) = f x1
+					m12 status1 requestChan inputChan
+		)
+	
+	fail msg = do
+		logMessage Fatal msg
+		PietMonad (\_ _ _ -> return (fail msg))
+
+instance MonadState InterpreterStatus PietMonad where
+	get        = PietMonad $ \status _ _ -> return (return (status, status))
+	put status = PietMonad $ \_      _ _ -> return (return ((),     status))
+
+-- | Returns the current Direction Pointer.
+getDP :: PietMonad DirectionPointer
+getDP = gets dp
+
+-- | Sets the Direction Pointer.
+setDP :: DirectionPointer -> PietMonad ()
+setDP newDP = modify (\status -> status { dp = newDP })
+
+-- | Returns the current Codel Chooser.
+getCC :: PietMonad CodelChooser
+getCC = gets cc
+
+-- | Sets the current Codel Chooser.
+setCC :: CodelChooser -> PietMonad ()
+setCC newCC = modify (\status -> status { cc = newCC })
+
+-- | Returns the current position.
+getPosition :: PietMonad (Int, Int)
+getPosition = gets position
+
+-- | Sets the current position.
+setPosition :: Int -> Int -> PietMonad ()
+setPosition x y = modify (\status -> status { position = (x, y) })
+
+-- | Pushes a given 'Int' value on the stack.
+stackPush :: Int -> PietMonad ()
+stackPush n = modify (\status -> status { stack = push n (stack status) })
+
+-- | Pops the top value from the stack. If the stack was empty,
+-- 'Nothing' is returned, 'Just' the top value otherise.
+stackPop :: PietMonad (Maybe Int)
+stackPop = do
+	response <- gets (pop . stack)
+	case response of
+		Nothing      -> return Nothing
+		Just (x, xs) -> do
+			modify (\status -> status { stack = xs })
+			return (Just x)
+
+-- | Performs the 'roll' operation on the stack.
+stackRoll :: Int	-- ^ Roll number
+	-> Int		-- ^ Depth
+	-> PietMonad ()
+stackRoll rolls depth = modify (\status -> status { stack = roll rolls depth (stack status) })
+
+-- | Reads the given 'PietType' from STDIN.
+readType :: PietType -> PietMonad Int
+readType pType = PietMonad $ \status requestChan inputChan -> do
+	writeChan requestChan (Read pType)
+	response <- readChan inputChan
+	return $ return (response, status)
+
+-- | Reads a number from STDIN.
+readNumber :: PietMonad  Int
+readNumber = readType PietNumber
+
+-- | Reads a character from STDIN. Note that it is returned as an 'Int'.
+readChar :: PietMonad Int
+readChar = readType PietChar
+
+-- | Issue log message with given priority.
+logMessage :: LogLevel -> String -> PietMonad ()
+logMessage level msg = PietMonad $ \status requestChan _ -> do
+	writeChan requestChan (Log level msg)
+	return $ return ((), status)
+
+-- | Prints a representation of a given 'PietType' to STDOUT.
+printType :: PietType -> Int -> PietMonad ()
+printType pType n = PietMonad $ \status requestChan _ -> do
+	writeChan requestChan (Print pType n)
+	return $ return ((), status)
+
+-- | Prints a number to STDOUT.
+printNumber :: Int -> PietMonad ()
+printNumber = printType PietNumber
+
+-- | Converts a given number to a character and prints it to STDOUT.
+printChar :: Int -> PietMonad ()
+printChar = printType PietChar
+
+-- | Quit a program. Any command following this one will be ignored.
+terminate :: PietMonad ()
+terminate = PietMonad $ \status requestChan _ -> do
+	writeChan requestChan Terminate
+	return $ return ((), status)
+
+-- | Executes a program represented by a 'PietMonad'. I/O operations
+-- (reading and writing numbers or characters) is delegated to
+-- callback functions.
+runPietMonad :: (PietType -> IO Int)		-- ^ Callback to read from STDIN
+	-> (PietType -> Int -> IO ())		-- ^ Print callback
+	-> (LogLevel -> String -> IO ())	-- ^ Logging callback
+	-> PietMonad a				-- ^ The program to be executed
+	-> IO (Either String a)			-- ^ Result of the 'PietMonad' or an error message
+runPietMonad readCallback printCallback logCallback program = do
+	requestChannel	<- newChan
+	responseChannel	<- newChan
+	lock		<- newEmptyMVar
+
+	-- Fork the actual monadic calculation.
+
+	forkIO $ do
+		let PietMonad piet = do
+			x <- program
+
+			-- This guarantees, that the service routine (see
+			-- below) terminates iff the Piet program terminates,
+			-- no matter how broken the program text is
+			terminate
+
+			return x
+
+		x <- piet InterpreterStatus
+				{ dp		= DPRight
+				, cc		= CCLeft
+				, position	= (0, 0)
+				, stack		= empty
+				}
+			requestChannel
+			responseChannel
+		
+		putMVar lock x
+	
+	-- Run the IO part in the current thread. Thus the caller does
+	-- not have to worry about thread-safe callbacks as all the IO
+	-- stays in the same thread, which is the invoking thread.
+
+	let serviceRoutine = do
+		request <- readChan requestChannel
+		case request of
+			Read pType	-> do
+				n <- readCallback pType
+				writeChan responseChannel n
+				serviceRoutine
+			Print pType n	-> do
+				printCallback pType n
+				serviceRoutine
+			Log level msg	-> do
+				logCallback level msg
+				serviceRoutine
+			Terminate	-> return ()
+
+	serviceRoutine
+	
+	-- Block until the monadic calculation is completed and
+	-- return its result.
+	
+	(liftM fst) `liftM` takeMVar lock 
+
diff --git a/sources/Language/Piet/Types.hs b/sources/Language/Piet/Types.hs
new file mode 100644
--- /dev/null
+++ b/sources/Language/Piet/Types.hs
@@ -0,0 +1,288 @@
+{-# LANGUAGE CPP #-}
+
+-- | A module providing a couple of Piet-specific types
+-- and simple associated functions needed throughout the library.
+module Language.Piet.Types
+	(
+	-- * Piet Interpreter
+	-- ** Direction Pointer and Codel Chooser
+	  DirectionPointer(..), addCoordinates, rotate
+	, CodelChooser(..), toggle
+	-- ** Piet's type system
+	, PietType(..)
+	-- ** Runtime program representation
+	, Program(..), isBlocked
+
+	-- * Colour system
+	, Colour(..), rgba2Colour, rgb2Colour
+	, HueColour(..), hueChange
+	, Lightness(..), lightnessChange
+
+	-- * Images
+	, Image, imgWidth, imgHeight, imgInRange, imgNew, imgPixel, imgSetPixel
+	, LabelKey, LabelInfo(..), labelSize, addPixel, LabelBorder(..)
+	) where
+
+import Data.Array.IArray
+import Data.IntMap hiding ((!))
+import Data.Monoid
+import Data.Ord
+
+-- | The Direction Pointer (DP).
+data DirectionPointer
+	= DPRight
+	| DPDown
+	| DPLeft
+	| DPUp
+	deriving (Show, Read, Eq, Ord, Enum)
+
+-- | Move coordinates by one in the direction of the 'DirectionPointer'.
+addCoordinates :: DirectionPointer	-- ^ Direction to move to
+	-> Int				-- ^ x-coordinate
+	-> Int				-- ^ y-coordinate
+	-> (Int, Int)			-- ^ New x-/y-coordinates
+addCoordinates DPRight	x y = (x + 1, y)
+addCoordinates DPDown	x y = (x, y + 1)
+addCoordinates DPLeft	x y = (x - 1, y)
+addCoordinates DPUp	x y = (x, y - 1)
+
+-- | Rotate a 'DirectionPointer' clockwise (counter clockwise if the 'Int' is
+-- negative) a given number of times. 
+rotate :: Int -> DirectionPointer -> DirectionPointer
+rotate n dp = let n' = (n + fromEnum dp) `rem` 4
+	in toEnum $ if n' < 0 then n' + 4 else n'
+
+-- | The Codel Chooser (CC).
+data CodelChooser
+	= CCLeft
+	| CCRight
+	deriving (Show, Read, Eq, Ord, Enum)
+
+-- | Toggle a 'CodelChooser' a given number of times.
+toggle :: Int -> CodelChooser -> CodelChooser
+toggle n cc = let n' = (n + fromEnum cc) `rem` 2
+	in toEnum $ if n' < 0 then n' + 2 else n'
+
+-- | Piet types. Relevant to distinguish in-/output strategies.
+data PietType
+	= PietNumber
+	| PietChar
+	deriving (Show, Read, Eq, Ord)
+
+-- | Runtime program representation.
+data Program = Program
+	{ image	:: Image Colour		-- ^ Original image
+	, mask	:: Image LabelKey	-- ^ Labelled image
+	, info	:: IntMap LabelInfo	-- ^ Information about the labels
+	}
+
+-- | Returns if a given codel in a program is blocked in the Piet
+-- sense (which is the case when it is out of the image's range or
+-- 'Black').
+isBlocked :: Int -> Int -> Program -> Bool
+isBlocked x y program = (not (imgInRange x y (image program)))
+	|| (Black == imgPixel x y (image program))
+
+-- | The colours that make up a Piet program text.
+data Colour
+	= Black
+	| White
+	| Hue {-# UNPACK #-} !Lightness {-# UNPACK #-} !HueColour
+	deriving (Show, Read, Eq, Ord)
+
+-- | Converts red\/green\/blue\/alpha values to a 'Colour'. The alpha channel
+-- is ignored for now, but may be used in future implementations or
+-- dialects, so please use this function instead of 'rgb2Colour' whenever
+-- an alpha channel is available.
+rgba2Colour :: Num w => w	-- ^ red
+	-> w			-- ^ green
+	-> w			-- ^ blue
+	-> w			-- ^ alpha
+	-> Colour
+rgba2Colour r g b _ = rgb2Colour r g b
+
+-- | Converts red\/green\/blue values to a 'Colour'. If the supplied
+-- arguments do not form a proper Piet 'Colour', 'White' is returned.
+rgb2Colour :: Num w => w	-- ^ red
+	-> w		-- ^ green
+	-> w		-- ^ blue
+	-> Colour
+rgb2Colour 0x00 0x00 0x00 = Black
+rgb2Colour 0xff 0xff 0xff = White
+rgb2Colour 0xff 0xc0 0xc0 = Hue Light  Red
+rgb2Colour 0xff 0x00 0x00 = Hue Normal Red
+rgb2Colour 0xc0 0x00 0x00 = Hue Dark   Red
+rgb2Colour 0xff 0xff 0xc0 = Hue Light  Yellow
+rgb2Colour 0xff 0xff 0x00 = Hue Normal Yellow
+rgb2Colour 0xc0 0xc0 0x00 = Hue Dark   Yellow
+rgb2Colour 0xc0 0xff 0xc0 = Hue Light  Green
+rgb2Colour 0x00 0xff 0x00 = Hue Normal Green
+rgb2Colour 0x00 0xc0 0x00 = Hue Dark   Green
+rgb2Colour 0xc0 0xff 0xff = Hue Light  Cyan
+rgb2Colour 0x00 0xff 0xff = Hue Normal Cyan
+rgb2Colour 0x00 0xc0 0xc0 = Hue Dark   Cyan
+rgb2Colour 0xc0 0xc0 0xff = Hue Light  Blue
+rgb2Colour 0x00 0x00 0xff = Hue Normal Blue
+rgb2Colour 0x00 0x00 0xc0 = Hue Dark   Blue
+rgb2Colour 0xff 0xc0 0xff = Hue Light  Magenta
+rgb2Colour 0xff 0x00 0xff = Hue Normal Magenta
+rgb2Colour 0xc0 0x00 0xc0 = Hue Dark   Magenta
+rgb2Colour _    _    _    = White
+
+-- | Piet colours in the hue cycle.
+data HueColour
+	= Red
+	| Yellow
+	| Green
+	| Cyan
+	| Blue
+	| Magenta
+	deriving (Show, Read, Eq, Ord, Enum)
+
+-- | Hue difference between two 'HueColour's. 'Red' means no change,
+-- 'Yellow' one step and so forth.
+hueChange :: HueColour -> HueColour -> HueColour
+hueChange c1 c2 = toEnum $ (fromEnum c2 - fromEnum c1) `mod` 6
+
+-- | Hue lightness values supported by Piet.
+data Lightness
+	= Light
+	| Normal
+	| Dark
+	deriving (Show, Read, Eq, Ord, Enum)
+
+-- | Lightness difference between Piet lightness values. 'Light'
+-- represents no change, 'Normal' one step darker and 'Dark'
+-- two steps darker.
+lightnessChange :: Lightness -> Lightness -> Lightness
+lightnessChange l1 l2 = toEnum $ (fromEnum l2 - fromEnum l1) `mod` 3
+
+-- | An image. Its coordinates will be @(0, 0) .. (width-1, height-1)@
+data Image a = Image
+	{ imgWidth	:: {-# UNPACK #-} !Int		-- ^ Width of an 'Image' in pixels.
+	, imgHeight	:: {-# UNPACK #-} !Int		-- ^ Height of an 'Image' in pixels.
+	, imgPixels	:: !(Array (Int, Int) a)	-- ^ An 'Array' storing the pixels of an 'Image'.
+	}
+#ifndef __HADDOCK__
+	deriving (Show, Eq, Ord)
+#else
+instance (Show a) => Show (Image a)
+instance (Eq a) => Eq (Image a)
+instance (Ord a) => Ord (Image a)
+#endif
+
+instance Functor Image where
+	fmap f img = img { imgPixels = amap f (imgPixels img) }
+
+-- | Build a new image.
+imgNew :: Int			-- ^ Width
+	-> Int			-- ^ Height
+	-> [((Int, Int), a)]	-- ^ Coordinate-value list
+	-> Image a
+imgNew width height entries = Image
+	{ imgWidth	= width
+	, imgHeight	= height
+	, imgPixels	= array ((0, 0), (width - 1, height - 1)) entries
+	}
+
+-- | Find out, if the given coordinates are within the 'Image'
+-- borders (which are @ (0, 0) .. (width-1, height-1)@).
+imgInRange :: Int	-- ^ x-coordinate
+	-> Int		-- ^ y-coordinate
+	-> Image a	-- ^ An 'Image'
+	-> Bool		-- ^ If @(x, y)@ is within the 'Image'
+imgInRange x y img = 0 <= x && x < imgWidth img && 0 <= y && y < imgHeight img
+
+-- | Access a pixel at given x/y-coordinates.
+imgPixel :: Int	-- ^ x-coordinate
+	-> Int	-- ^ y-coordinate
+	-> Image a -> a
+imgPixel x y img = (imgPixels img) ! (x, y)
+
+-- | Set a pixel at given x/y-coordinates.
+imgSetPixel :: Int -> Int -> a -> Image a -> Image a
+imgSetPixel x y pixel img = img { imgPixels = (imgPixels img) // [((x, y), pixel)] }
+
+-- | We'll just use 'Int's to identifiy labels.
+type LabelKey = Int
+
+-- | Stores compiler-relevant information about a label. This type
+-- implements an instance of 'Monoid' to merge labels.
+data LabelInfo
+	= EmptyInfo	-- ^ The empty label
+	| LabelInfo
+		{ _labelSize	:: {-# UNPACK #-} !Int		-- ^ Number of pixels
+		, labelTop	:: {-# UNPACK #-} !LabelBorder	-- ^ Top border
+		, labelLeft	:: {-# UNPACK #-} !LabelBorder	-- ^ left border
+		, labelBottom	:: {-# UNPACK #-} !LabelBorder	-- ^ Bottom border
+		, labelRight	:: {-# UNPACK #-} !LabelBorder	-- ^ Right border
+		}	-- ^ Label with a size and four borders
+	deriving (Show, Eq, Ord)
+
+-- | Number of pixels in a label. This function is defined for all
+-- constructors of 'LabelInfo' so, in contrast to '_labelSize', it
+-- won't fail on 'EmptyInfo' .
+labelSize :: LabelInfo -> Int
+labelSize EmptyInfo		= 0
+labelSize _info@(LabelInfo { })	= _labelSize _info
+
+instance Monoid LabelInfo where
+	mempty = EmptyInfo
+
+	mappend EmptyInfo i = i
+	mappend i EmptyInfo = i
+	mappend i1 i2 = LabelInfo
+		{ _labelSize	= labelSize i1 + labelSize i2
+		, labelTop	= mergeMin (labelTop i1) (labelTop i2)
+		, labelLeft	= mergeMin (labelLeft i1) (labelLeft i2)
+		, labelBottom	= mergeMax (labelBottom i1) (labelBottom i2)
+		, labelRight	= mergeMax (labelRight i1) (labelRight i2)
+		}
+
+-- | Holds information of a label (coloured area) relevant for the Piet
+-- language, i. e. information about where the program flow will be
+-- directed regarding a Direction Pointer.
+--
+-- Holds a border position (e. g. an x-coordinate) and the minimum
+-- or maximum associated \"other\" coordinates (e. g. y-coordinates).
+data LabelBorder = LabelBorder
+	{ borderCoord	:: {-# UNPACK #-} !Int	-- ^ Where the border is located
+	, borderMin	:: {-# UNPACK #-} !Int	-- ^ Minimum \"other\" coordinate of the border
+	, borderMax	:: {-# UNPACK #-} !Int	-- ^ Maximum \"other\" coordinate of the border
+	} deriving (Show, Eq, Ord)
+
+-- | Merge two 'LabelBorder's holding a /maximum/ coordinate.
+mergeMin :: LabelBorder -> LabelBorder -> LabelBorder
+mergeMin = merge (comparing borderCoord)
+
+-- | Merge two 'LabelBorder's holding a /minimum/ coordinate.
+mergeMax :: LabelBorder -> LabelBorder -> LabelBorder
+mergeMax = merge (comparing (negate . borderCoord))
+
+-- | General merge, see 'mergeMin' and 'mergeMax'
+merge :: (LabelBorder -> LabelBorder -> Ordering) -> LabelBorder -> LabelBorder -> LabelBorder
+merge comp b1 b2 = case comp b1 b2 of
+	EQ -> b1
+		{ borderMin	= min (borderMin b1) (borderMin b2)
+		, borderMax	= max (borderMax b1) (borderMax b2)
+		}
+	LT -> b1
+	GT -> b2
+
+-- | Add a pixel to a 'LabelInfo'.
+addPixel :: Int -> Int -> LabelInfo -> LabelInfo
+addPixel x y EmptyInfo = LabelInfo
+	{ _labelSize	= 1
+	, labelTop	= LabelBorder y x x
+	, labelLeft	= LabelBorder x y y
+	, labelBottom	= LabelBorder y x x
+	, labelRight	= LabelBorder x y y
+	}
+addPixel x y nonEmpty = nonEmpty
+	{ _labelSize	= 1 + labelSize nonEmpty
+	, labelTop	= mergeMin (labelTop nonEmpty) (LabelBorder y x x)
+	, labelLeft	= mergeMin (labelLeft nonEmpty) (LabelBorder x y y)
+	, labelBottom	= mergeMax (labelBottom nonEmpty) (LabelBorder y x x)
+	, labelRight	= mergeMax (labelRight nonEmpty) (LabelBorder x y y)
+	}
+
diff --git a/sources/Main.hs b/sources/Main.hs
new file mode 100644
--- /dev/null
+++ b/sources/Main.hs
@@ -0,0 +1,158 @@
+module Main
+	( main
+	) where
+
+import Control.Monad.Error
+import Data.List
+import Data.Version (showVersion)
+import Language.Piet
+import qualified Paths_piet as Paths (version)
+import System.Console.GetOpt
+import System.Environment
+import System.Exit
+import System.IO
+
+-- | Main function.
+main :: IO ()
+main = do
+	args	<- getArgs
+	case parseArguments args of
+		Left err	-> do
+			putStrLn err
+			printUsage
+			exitWith $ ExitFailure 1
+		Right opts	-> do
+			actualMain opts
+			exitWith ExitSuccess
+
+-- | Main function without the option-parsing part.
+actualMain :: Options -> IO ()
+actualMain Help		= printUsage
+actualMain Version	= printVersion
+actualMain opts@Run { }	= case program opts of
+	Nothing		-> do
+		putStrLn "No program given"
+		printUsage
+	Just file	-> do
+		loadresult	<- imgFromFile (codelSize opts) file
+		case loadresult of
+			Left err	-> do
+				putStr "Unable to load image, imlib2 issued this error: "
+				print err
+				exitWith $ ExitFailure 2
+			Right img	-> do
+				let prog	= compile img
+
+				hSetBuffering stdin  NoBuffering
+				hSetBuffering stdout NoBuffering
+				hFlush stdout
+				
+				response	<- runPietMonad readCallback
+					printCallback
+					(logCallback (verbosity opts))
+					(interpret prog)
+
+				case response of
+					Left err	-> do
+						putStrLn err
+						exitWith $ ExitFailure 3
+					Right _		-> return ()
+
+-- | Print program usage to STDOUT.
+printUsage :: IO ()
+printUsage = getProgName >>= putStrLn . ((flip usageInfo) options) . versionise
+
+-- | Print program name and version to STDOUT.
+printVersion :: IO ()
+printVersion = getProgName >>= putStrLn . versionise
+
+-- | Append /-version/ to a program name, where /version/ is
+-- the actual version of this cabal package.
+versionise :: String -> String
+versionise = (++ "-" ++ showVersion Paths.version)
+
+-- | Callback function to read a 'PietNumber' (i. e. a parsed line) or a
+-- 'PietChar' from STDIN.
+readCallback :: PietType -> IO Int
+readCallback PietNumber = getLine >>= maybe (readCallback PietNumber) return . readMaybe
+readCallback PietChar   = fromEnum `liftM` getChar
+
+-- | Callback to print a 'PietType'.
+printCallback :: PietType -> Int -> IO ()
+printCallback PietNumber = putStr . show
+printCallback PietChar   = putChar . toEnum
+
+-- | Callback to manage log messages.
+logCallback :: LogLevel -> LogLevel -> String -> IO ()
+logCallback threshold level msg = when (level >= threshold) $ do
+	let prefixedMsg = show level ++ ' ' : msg
+	putStrLn prefixedMsg
+
+-- | Build 'Options' and - if specified - a program file to execute
+-- from a list of 'String's (the arguments).
+parseArguments :: [String] -> Either String Options
+parseArguments args = do
+	let (optCBs, remaining, errors)	= getOpt Permute options args
+
+	unless (null errors) $ fail (unlines errors)
+	opts	<- foldM (flip ($)) defaultOptions optCBs
+	
+	case remaining of
+		[]	-> return opts
+		[prog]	-> case opts of
+			Run { }	-> return (opts { program = Just prog } )
+			_	-> return opts
+		_	-> fail "please specify exactly one program"
+
+-- | Type bundling command line options.
+data Options
+	= Help		-- ^ Don't run anything, just print a help text
+	| Version	-- ^ Don't run anything, print program name and version
+	| Run
+		{ program	:: Maybe FilePath	-- ^ Program to run
+		, codelSize	:: Maybe Int		-- ^ Explicitly specify codel size
+		, verbosity	:: LogLevel
+		}	-- ^ Run a given program
+	deriving (Show, Eq, Ord)
+
+-- | The default 'Options'.
+defaultOptions :: Options
+defaultOptions = Run
+	{ program	= Nothing
+	, codelSize	= Nothing
+	, verbosity	= Info
+	}
+
+-- | List of command line options accepted by this interpreter.
+options :: [OptDescr (Options -> (Either String Options))]
+options =
+	[ Option ['h', '?'] ["help"]
+		(NoArg (const (Right Help)))
+		"print usage information and exit"
+	, Option [] ["version"]
+		(NoArg (const (Right Version)))
+		"print version information and exit"
+	, Option ['c'] ["codels"]
+		(ReqArg (\arg opt -> maybe
+			(Left "codel size must be a number")
+			(\x -> case opt of
+				Run { }	-> Right (opt { codelSize = Just x })
+				_	-> Right opt)
+			(readMaybe arg)) "LENGTH")
+		"codel length (the codel size will be LENGTH^2)"
+	, Option ['v'] ["verbose"]
+		(NoArg (\opt -> case opt of
+			Run { }	-> Right (opt { verbosity = Verbosed } )
+			_	-> Right opt))
+		"give verbosed output"
+	, Option ['q'] ["quiet"]
+		(NoArg (\opt -> case opt of
+			Run { }	-> Right (opt { verbosity = Error } )
+			_	-> Right opt))
+		"suppress all but error messages"
+	]
+
+-- | Like 'read', but returns 'Nothing' instead of raising an 'error' on failure.
+readMaybe :: Read a => String -> Maybe a
+readMaybe str = find ((== "") . snd) (reads str) >>= return . fst
+