import System.Environment
import IO

main = do args <- getArgs
          mapM_ load args

newVar = BefungeVariables{
                          pc = (0, 0),
                          pcDelta = (1, 0),
                          stack = [],
                          flagString = False,
                          flagQuit = False
                         }
load fileName =
    do cs <- readFile fileName
       exec (Befunge((lines cs),  newVar))

exec::Befunge -> IO Befunge
exec befunge
    | isQuit befunge = return befunge
    | otherwise      = do newBef <- step befunge
--                          putStrLn $ show(x) ++ ", " ++ show(y) ++ "\t" ++ show(dx) ++ ", " ++ show(dy)
                          exec newBef
                              where
                                source = getBefungeSource befunge
                                vars = getBefungeVariables befunge
                                (x, y) = pc vars
                                (dx, dy) = pcDelta vars
    
--                 putStrLn $ [getCharAt source (0, 2)]

getCharAt :: [[Char]] -> (Int, Int) -> Char
getCharAt source (a, b) =
    case elementAt b source of
      Just line -> case elementAt a line of
                     Just c -> c
                     Nothing -> ' '
      Nothing -> ' '

elementAt :: Int -> [a] -> Maybe a
elementAt i xs
    | i < length xs = Just $ last $ take (i + 1) xs
    | otherwise     = Nothing

class Interpreter i where
    step::i -> IO i
    isQuit::i -> Bool

instance Interpreter Befunge where
    step = stepBefunge
    isQuit = isQuitBefunge

data Befunge = Befunge ([[Char]], BefungeVariables)

data BefungeVariables = BefungeVariables {
                                          pc::(Int, Int),
                                          pcDelta::(Int, Int),
                                          stack::[Int],
                                          flagString::Bool,
                                          flagQuit::Bool
} deriving Eq


getBefungeSource::Befunge -> [[Char]]
getBefungeSource (Befunge(s, v)) = s

getBefungeVariables::Befunge -> BefungeVariables
getBefungeVariables (Befunge(s, v)) = v

stepBefunge::Befunge -> IO Befunge
stepBefunge befunge =
    do
      interplet instruction befunge
    --befunge -- TODO
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      curPc = pc vars
--      curDelta = pcDelta vars
      instruction = getCharAt source curPc
                    
--      newVars = vars{
--                     pc = curPc,
--                     pcDelta = curDelta
--                    }

interplet::Char -> Befunge -> IO Befunge
interplet '"' befunge =
    return $ Befunge (source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      fString = flagString vars
      newVars = vars {
                      pc = stepPc befunge,
                      flagString = not fString
                     }

interplet c befunge
    | flagString (getBefungeVariables befunge) =
        return $ Befunge (source, newVars)
            where
              source = getBefungeSource befunge
              vars = getBefungeVariables befunge
              curStack = stack vars
              newStack = push curStack (fromEnum c)
              newVars = vars {
                              pc = stepPc befunge,
                              stack = newStack
                             }

interplet '<' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      pcDelta = (-1, 0)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta
                     }

interplet '>' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      pcDelta = (1, 0)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta
                     }

interplet '^' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      pcDelta = (0, -1)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta
                     }
interplet 'v' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      pcDelta = (0, 1)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta
                     }

interplet '@' befunge =
    return $ Befunge (source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      newVars = vars {
                      flagQuit = True
                     }

interplet '~' befunge =
    do
      newStack <- catch (do c <- getChar
                            return $ push curStack (fromEnum c))
--                            return $ push curStack 1)
                  (\ e -> if isEOFError e then
                              return $ push curStack (negate 1)
                          else
                              return $ push curStack (negate 1))--
      return (Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  }))
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      curStack = stack vars

interplet '.' befunge =
    do
      putStr $ show(c) ++ " "
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (newStack, c) = pop $ stack vars

interplet ',' befunge =
    do
      putChar $ toEnum c
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (newStack, c) = pop $ stack vars

interplet '#' befunge =
    do
      return $ Befunge(source, vars {
                                     pc = stepPcDt befunge dt
                                    })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (dx, dy) = pcDelta vars
      dt = (dx * 2, dy * 2)

interplet ':' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (curStack, c) = pop $ stack vars
      newStack = push (push curStack c) c
      newVars = vars {
                      pc = stepPc befunge,
                      stack = newStack
                     }

interplet '$' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (newStack, c) = pop $ stack vars

interplet '\\' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = push (push s2 i1) i2

interplet '!' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      newStack = if i1 == 0 then push s1 1 else push s1 0

interplet '`' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = if i1 < i2 then push s2 1 else push s2 0

interplet '_' befunge =
    return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (newStack, c) = pop $ stack vars
      pcDelta = if c == 0 then (1, 0) else (-1, 0)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta,
                      stack = newStack
                     }

interplet '|' befunge =
    do
--      putStrLn $ "| " ++ show(c) ++ ", " ++ show(pc vars) ++ " -> " ++ show(pcDelta) ++ ", " ++ show(pc newVars)
--      putStrLn $ "  >> " ++ show(nx) ++ ", " ++ show(ny) ++ " -> " ++ show(height) ++ ", " ++ show(width)
      return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (newStack, c) = pop $ stack vars
      pcDelta = if c == 0 then (0, 1) else (0, -1)
      newVars = vars {
                      pc = stepPcDt befunge pcDelta,
                      pcDelta = pcDelta,
                      stack = newStack
                     }
--    (normalize nx width, normalize ny height)
--    where
--      (x, y) = pc vars
--      (dx, dy) = pcDelta
--      nx = x + dx
--      ny = y + dy
--      height = length source
--      width = length $ getLineAt ny source

interplet '+' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = push s2 (i2 + i1)

interplet '-' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack =  push s2 (i2 - i1)

interplet '*' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = push s2 (i2 * i1)

interplet '/' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = push s2 (i2 `div` i1)

interplet '%' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, i1) = pop $ stack vars
      (s2, i2) = pop $ s1
      newStack = push s2 (i2 `mod` i1)

interplet 'g' befunge =
    do
      return $ Befunge(source, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, y) = pop $ stack vars
      (s2, x) = pop $ s1
      newStack = push s2 (fromEnum $ getCharAt source (x, y))

interplet 'p' befunge =
    do
{-
      putStrLn $ "p " ++ show(x) ++ ", " ++ show(y) ++ " = " ++ show(v)
      putChar $ toEnum v
      putStrLn $ "<<OK"
      putStrLn $ "pre <<" ++ show(l) ++ ">>"
      putStrLn $ "pst <<" ++ show(l0 ++ [(toEnum v)] ++ l1) ++ ">>"
-}
      return $ Befunge(newSource, vars {
                                   pc = stepPc befunge,
                                   stack = newStack
                                  })
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      (s1, y) = pop $ stack vars
      (s2, x) = pop $ s1
      (newStack, v) = pop $ s2
      src0 = (take y source)
      l = (head (drop y source))
      src1 = (drop (y+1) source)
      l0 = (take x l)
      l1 = (drop (x + 1) l)
      newSource = src0 ++ [l0 ++ [(toEnum v)] ++ l1] ++ src1

interplet n befunge
    | (n >= '0' && n <= '9') = do return (Befunge(source, vars {
                                                                pc = stepPc befunge,
                                                                stack = newStack
                                                               }))
                                      where
                                        source = getBefungeSource befunge
                                        vars = getBefungeVariables befunge
                                        curStack = stack vars
                                        newStack = push curStack (read [n])

interplet ' ' befunge = do
  return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      newVars = vars {
                      pc = stepPc befunge
                     }

interplet n befunge = do
  putStrLn $ "Unsupported instruction <" ++ show(n) ++ ">"
  return $ Befunge(source, newVars)
    where
      source = getBefungeSource befunge
      vars = getBefungeVariables befunge
      newVars = vars {
                      pc = stepPc befunge
                     }

stepPc :: Befunge -> (Int, Int)
stepPc (Befunge(source, vars)) =
    stepPcDt (Befunge(source, vars)) dt
    where
      dt = pcDelta vars

stepPcDt :: Befunge -> (Int, Int) -> (Int, Int)
stepPcDt (Befunge(source, vars)) (dx, dy) =
    (px, py)
    where
      (x, y) = pc vars
      nx = x + dx
      ny = y + dy
      height = length source
      py = normalize ny height
      width = case elementAt py source of
                Just line -> length line
                Nothing -> 1
      px = normalize nx width

normalize :: Int -> Int -> Int
normalize pos length
    | pos < 0 = length - 1
    | pos > length - 1 = 0
    | otherwise = pos

isQuitBefunge::Befunge -> Bool
isQuitBefunge (Befunge (source, vars)) =
    flagQuit vars

push::[Int] -> Int -> [Int]
push stack v =
    v : stack


pop::[Int] -> ([Int], Int)
pop [] = ([], 0)
pop (v : stack) =
    (stack, v)