Binary numbers toy in Haskell SOE graphics

I've been browsing Mr. Paul R. Potts's blog when I stumbled across a simple, yet neat idea. I was not quite satisfied with the lengthy solution given, so I decided to construct something similar looking from scratch. I'm using the Hugs and GHC built-in HGL/Graphics.SOE package. See the result below. Expect to see more later.



All code, text and the 5 images in this post are Copyright (c) bkil.hu [also known as bkil], 2009. I place the images in the public domain. The code and text are licensed under the GNU GPL v2. Refer to the standard license texts from June 1991 for exact conditions. Here is an example link: http://www.gnu.org/licenses/gpl-2.0.html

---

Here's the core (Simbins.hs):

module Simbins where
import Data.List(transpose)

-- Radix conversion with LSB output.
radix _ 0 _ = []
radix r w n = (n `mod` r : radix r (w-1) (n `div` r))

-- 'binaries' is a solution to Paul R. Potts's idea.
-- Prepend `reverse . ` to get MSB.
binaries w = transpose . map (radix 2 w)

simbins w = reverse dbl ++ dbl where
    dbl   = map (\s -> s ++ reverse s) cols
    cols  = binaries w [0..2^w - 1]

---

Standard output text interface (textbin.hs):

import Simbins

toChar 0 = ' '
toChar _ = '@'

textOut = putStr . unlines . map (map toChar)

main = textOut $ simbins 5

---

Graphics interface (graphbin.hs):

import Maybe
import Graphics.SOE
import Simbins

put w h (x,y) = polygon p where
    p  = [ (x0,y0), (x1,y0), (x1,y1), (x0,y1) ]
    x0 = w*x;  x1 = w*(x+1)
    y0 = h*y;  y1 = h*(y+1)

visDots table  = catMaybes . concat $ dots where
    dots       = zipWith (rows)   [0..] table
    rows y col = zipWith (elem y) [0..] col
    elem y x 0 = Nothing
    elem y x _ = Just (x,y)

graphOut dw dh table@(h:t) =
  let
    winSize   = (dw*length h, dh*length table)
    visShapes = map (put dw dh) $ visDots table in
  runGraphics $
    do win <- openWindow "Simbins" winSize
       mapM (drawInWindow win) visShapes
       getKey win
       closeWindow win

main = graphOut 2 4 $ simbins 6

---

Sample output:

                @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
        @@@@@@@@        @@@@@@@@@@@@@@@@        @@@@@@@@
    @@@@    @@@@    @@@@    @@@@@@@@    @@@@    @@@@    @@@@
  @@  @@  @@  @@  @@  @@  @@  @@@@  @@  @@  @@  @@  @@  @@  @@
 @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @
 @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @
  @@  @@  @@  @@  @@  @@  @@  @@@@  @@  @@  @@  @@  @@  @@  @@
    @@@@    @@@@    @@@@    @@@@@@@@    @@@@    @@@@    @@@@
        @@@@@@@@        @@@@@@@@@@@@@@@@        @@@@@@@@
                @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@