type Order = Int type Direction = (Int,Int) space = showString " " newline = showString "\n" left, right :: Direction -> Direction left (dx,dy) = (-dy,dx) right (dx,dy) = (dy,-dx) f :: Direction -> ShowS f (dx,dy) = shows dx . space . shows dy . space . showString "rlineto" . newline {- -- IO モナドではなく ShowS を使い,バインド(>>)ではなく,関数合成(.)で繋ぐ x 0 _ = id x (n+1) (x0,y0) = y n (x1,y1) . f (x1,y1) . x n (x0,y0) . f (x0,y0) . x n (x0,y0) . f (x3,y3) . y n (x3,y3) where (x1,y1) = left (x0,y0); (x3,y3) = right (x0,y0) -- これを List 上のたたみこみに変形して x (n+1) (x0,y0) = foldr (.) id [ x n (x3,y3) , f (x3,y3) , y n (x0,y0) , f (x0,y0) , y n (x0,y0) , f (x1,y1) , x n (x1,y1) ] where (x1,y1) = left (x0,y0); (x3,y3) = right (x0,y0) -- さらに where 節やめて本体に展開すると x (n+1) (x0,y0) = foldr (.) id [ x n (right (x0,y0)), f (right (x0,y0)), y n (x0,y0), f (x0,y0) , y n (x0,y0) , f (left (x0,y0)) , x n (left (x0,y0)) ] -- こうしておいて,(x0,y0) を map で括りだすと x (n+1) (x0,y0) = foldr (.) id (map ($ (x0,y0)) [ x n . right, f . right , y n, f, y n , f . left, x n . left ]) y 0 _ = id y (n+1) (x0,y0) = x n (x3,y3) . f (x3,y3) . y n (x0,y0) . f (x0,y0) . y n (x0,y0) . f (x1,y1) . x n (x1,y1) where (x1,y1) = left (x0,y0); (x3,y3) = right (x0,y0) -} interp v = foldr (.) id . map ($ v) x,y :: Order -> Direction -> ShowS x 0 _ = id x (n+1) d = interp d [ y n . left , f . left , x n , f , x n , f . right , y n . right ] y 0 _ = id y (n+1) d = interp d [ x n . right , f . right , y n , f , y n , f . left , x n . left ] hilbert :: Int -> Int -> ShowS hilbert size n = shows o . space . shows o . space . showString "moveto" . newline . x n (x0,y0) . showString "stroke" where x0 = size `div` (2 ^ n) y0 = 0 o = x0 `div` 2 main = putStrLn $ hilbert 256 5 ""