gistfile1.hs

data Bt a = Et | Ct a (Bt a) (Bt a)

instance Show a => Show (Bt a) where
	show t = showTree 3 1 t

showTree :: (Show a) => Int -> Int -> Bt a -> String
showTree dx dy Et                   = ""
showTree dx dy (Ct root Et Et)      = show root
showTree dx dy (Ct root left right) = centerRoot ++ "\n" ++ emptyLines dy ++ unlines subtreeLines

	where
		rootStr = show root
		rootLen = length rootStr
		dist    = max rootLen dx

		leftTreeLines  = lines $ showTree dx dy left
		rightTreeLines = lines $ showTree dx dy right

		leftW  = maxLineWidth leftTreeLines
		rightW = maxLineWidth rightTreeLines
		totalW = leftW + dist + rightW

		centerRoot = whitespace distL ++ rootStr ++ whitespace distR
			where
				distL = (totalW - rootLen) `div` 2
				distR = totalW - distL - rootLen

		subtreeLines = zipWithPad (whitespace (leftW + dist)) "" (++) (map (++ whitespace dist) leftTreeLines) rightTreeLines

		emptyLines :: Int -> String
		emptyLines dy = replicate dy '\n'

		maxLineWidth :: [String] -> Int
		maxLineWidth = foldr max 0 . map length

		whitespace :: Int -> String
		whitespace dx = replicate dx ' '

		zipWithPad :: a -> b -> (a -> b -> c) -> [a] -> [b] -> [c]
		zipWithPad _    _    _ []     []     = []
		zipWithPad pad1 pad2 f []     (b:bs) = f pad1 b    : zipWithPad pad1 pad2 f [] bs
		zipWithPad pad1 pad2 f (a:as) []     = f a    pad2 : zipWithPad pad1 pad2 f as []
		zipWithPad pad1 pad2 f (a:as) (b:bs) = f a    b    : zipWithPad pad1 pad2 f as bs


main = do
	putStrLn $ showTree 3 1 $ Ct 0 (
			Ct 111 (Ct 3 Et Et) (Ct 33 Et Et)
		) (
			Ct 2 (Ct 4 Et Et) (Ct 5 (Ct 6 Et Et) (Ct 7 Et Et))
		)

	putStrLn "------------------------------"

	putStrLn $ showTree 5 2 $ Ct 0 (
			Ct 111 (Ct 3 Et Et) (Ct 33 Et Et)
		) (
			Ct 2 (Ct 4 Et Et) (Ct 5 (Ct 6 Et Et) (Ct 7 Et Et))
		)

	putStrLn "------------------------------"

	putStrLn $ showTree 10 3 $ Ct 0 (
			Ct 111 (Ct 3 Et Et) (Ct 33 Et Et)
		) (
			Ct 2 (Ct 4 Et Et) (Ct 5 (Ct 6 Et Et) (Ct 7 Et Et))
		)

	putStrLn "------------------------------"

	putStrLn $ showTree 3 1 $ Ct 1 Et (Ct 3 Et Et)

	putStrLn "------------------------------"

	putStrLn $ showTree 3 1 $ Ct 0 (
			Ct 1 (Ct 3 Et Et) (Ct 4 Et Et)
		) (
			Ct 2 (Ct 5 Et Et) (Ct 6 Et Et)
		)

	putStrLn "------------------------------"

	putStrLn $ showTree 3 1 $ Ct 2 (Ct 4 Et Et) (Ct 5 (Ct 6 Et Et) Et)

	putStrLn "------------------------------"

	putStrLn $ showTree 3 1 $ Ct 1 (Ct 3 Et Et) (Ct 4 Et Et)