mightybyte / Partitions.hs

Created April 20, 2011


    
    View Partitions.hs 
  
  
      Partitions.hs
    
    
        Raw
      
    
    File suppressed. Click to show.
  
  
            1
            2
            3
            4
            5
            6
            7
            8
            9
            10
            11
            12
            13
            14
            15
            16
            17
            18
            19
            20
            21
            22
            23
            24
            25
            26
            27
            28
            29
            30
            31
            32
            33
            34
            35
            36
            37
            38
            39
            40
            41
            42
            43
            44
            45
            46
            47
            48
            49
            50
            51
            52
            53
            54
            55
            56
            57
            58
            59
            60
            61
            62
            63
            64
            65
            66
            67
            68
            69
            70
            71
            72
            73
            74
            75
          
          
            {-# LANGUAGE OverloadedStrings #-}
module Main where
 
import Numeric
import Data.Bits
import Data.List
import Text.Blaze
import Text.Blaze.Html5 hiding (map)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Renderer.String
 
inds :: [[Int]]
inds =
    [[52,4,12,20,22,14,6,54]
    ,[5,53,28,36,38,30,55,7]
    ,[13,29,60,44,46,62,31,15]
    ,[21,37,45,61,63,47,39,23]
    ,[17,33,41,57,59,43,35,19]
    ,[9,25,56,40,42,58,27,11]
    ,[1,49,24,32,34,26,51,3]
    ,[48,0,8,16,18,10,2,50]
    ]
 
inds2 :: [[Int]]
inds2 =
    [[56..63]
    ,[48..55]
    ,[40..47]
    ,[32..39]
    ,[24..31]
    ,[16..23]
    ,[8..15]
    ,[0..7]
    ]
 
colors :: [String]
colors =
    ["#1f77b4", "#aec7e8", "#ff7f0e", "#ffbb78", "#2ca02c"
    ,"#98df8a", "#d62728", "#ff9896", "#9467bd", "#c5b0d5"
    ,"#8c564b", "#c49c94", "#e377c2", "#f7b6d2", "#7f7f7f"
    ,"#c7c7c7", "#bcbd22", "#dbdb8d", "#17becf", "#9edae5"
    ]
 
pad n c s
  | length s < n = replicate (n - length s) c ++ s
  | otherwise    = s
 
myOct n = pad 2 '0' $ showOct n ""
 
mkCell :: (Integral a) => (a -> Int) -> a -> Html
mkCell colorFunc n = do
    H.td ! A.style (stringValue $ "background-color: "++(colors!!(colorFunc n))) $ string $ myOct n
 
mkRow :: (Integral a) => (a -> Int) -> [a] -> Html
mkRow colorFunc row = H.tr $ mapM_ (mkCell colorFunc) row
 
mkTable :: (Integral a) => (a -> Int) -> [[a]] -> Html
mkTable colorFunc t = H.table $ mapM_ (mkRow colorFunc) t
 
firstDigit :: (Bits a) => a -> a
firstDigit n = shiftR n 3
secondDigit n = 7 .&. n
oneBit bit n = shiftR (n .&. (shiftL 1 bit)) bit
 
vis1 is = mkTable firstDigit is
vis2 is = mkTable secondDigit is
visBit n is = mkTable (oneBit n) is
 
vizs = vis1:vis2:map visBit [0..5]
 
write vs = do
    let s = intercalate "\n<br/><br/><br/>\n" $
            map (\f -> renderHtml $ f inds) vs
    writeFile "test.html" s