diff --git a/app/Main.hs b/app/Main.hs
deleted file mode 100644
--- a/app/Main.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Main (main) where
-
-import Control.Monad
-import System.Environment
-
-import Text.XML.Light.Input (parseXML)
-
-import Folgerhs.Stage
-
-
-main :: IO ()
-main = do args <- getArgs
-          guard (length args == 1)
-          source <- readFile $ head args
-          let contents = parseXML source
-              results = states (corpus contents) beginning
-          mapM_ print results
-          return ()
diff --git a/app/Protagonism/Main.hs b/app/Protagonism/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Protagonism/Main.hs
@@ -0,0 +1,34 @@
+module Main (main) where
+
+import Control.Monad
+import System.Environment
+import Data.Function (on)
+import Data.List
+
+import Text.XML.Light.Input (parseXML)
+import Text.Printf (printf)
+
+import Folgerhs.Stage
+
+speaker :: State -> String
+speaker (_, s, _) = s
+
+count :: Eq a => a -> [a] -> Int
+count e = length . filter (e ==)
+
+protagonism :: [String] -> [(String, Float)]
+protagonism ss = sortBy (flip $ on compare snd) $ map (`charProt` ss) (nub ss)
+    where charProt c ss = (c, fromIntegral (count c ss) / fromIntegral (length ss))
+
+reprProt :: (String, Float) -> String
+reprProt (c, r) = printf "%.2f%% \t %s" (r*100) c
+
+main :: IO ()
+main = do args <- getArgs
+          if length args /= 1
+             then error "Expecting filename."
+             else do source <- readFile $ head args
+                     let contents = parseXML source
+                         speakers = map speaker $ states (corpus contents) beginning
+                     mapM_ (putStrLn . reprProt) (protagonism speakers)
+                     return ()
diff --git a/app/Stage/Main.hs b/app/Stage/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Stage/Main.hs
@@ -0,0 +1,49 @@
+module Main (main) where
+
+import Control.Monad
+import System.Environment
+import Data.List
+import Data.Bool
+import Data.Maybe
+
+import Text.XML.Light.Input (parseXML)
+
+import Folgerhs.Stage
+
+
+displayState :: [Character] -> State -> String
+displayState gcs (l, s, cs) = l ++ "," ++ s ++ "," ++ displayStageChar gcs cs
+    where displayStageChar gcs cs = intercalate "," $ map (bool "0" "1" . (`elem` cs)) gcs
+
+displayStage :: Character -> [Character] -> Character -> String
+displayStage s cs c = if s == c
+                         then "Speaker"
+                         else bool "Absent" "Present" (elem c cs)
+
+displayRow :: [Character] -> State -> String
+displayRow gcs (l, s, cs) = l ++ "," ++ intercalate "," (map (displayStage s cs) gcs)
+
+displayCharacter :: Character -> String
+displayCharacter c = let n = fromMaybe c (stripPrefix "#" c)
+                      in case span (/= '_') $ reverse n of
+                           ("", p) -> p
+                           (s, "") -> s
+                           (s, p) -> reverse $ tail p
+
+displayHeader :: [Character] -> String
+displayHeader gcs = "Act.Scene.Line," ++ intercalate "," (map displayCharacter gcs)
+
+characters :: [State] -> [Character]
+characters = nub . concatMap (\(_, _, cs) -> cs)
+
+main :: IO ()
+main = do args <- getArgs
+          if length args /= 1
+             then error "Expecting filename."
+             else do source <- readFile $ head args
+                     let contents = parseXML source
+                         results = states (corpus contents) beginning
+                         gcs = characters results
+                     putStrLn $ displayHeader gcs
+                     mapM_ (putStrLn . displayRow gcs) results
+                     return ()
diff --git a/folgerhs.cabal b/folgerhs.cabal
--- a/folgerhs.cabal
+++ b/folgerhs.cabal
@@ -1,5 +1,5 @@
 name:                folgerhs
-version:             0.1.0.0
+version:             0.1.0.1
 synopsis:            Toolset for Folger Shakespeare Library's XML annotated plays
 description:         Toolset for Folger Shakespeare Library's XML annotated plays
 homepage:            https://github.com/SU-LOSP/tools#readme
@@ -22,7 +22,16 @@
 
 executable folger-stage
   hs-source-dirs:      app
-  main-is:             Main.hs
+  main-is:             Stage/Main.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , folgerhs
+                     , xml >= 1.3.14 && < 1.3.15
+  default-language:    Haskell2010
+
+executable folger-protagonism
+  hs-source-dirs:      app
+  main-is:             Protagonism/Main.hs
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base
                      , folgerhs
diff --git a/src/Folgerhs/Stage.hs b/src/Folgerhs/Stage.hs
--- a/src/Folgerhs/Stage.hs
+++ b/src/Folgerhs/Stage.hs
@@ -1,7 +1,10 @@
-module Folgerhs.Stage ( corpus
-                    , beginning
-                    , states
-                    ) where
+module Folgerhs.Stage ( State
+                      , Character
+                      , Line
+                      , corpus
+                      , beginning
+                      , states
+                      ) where
 
 import Data.List
 import Control.Monad
