--7seg.hs
import HTurtle
import THTurtle
import Control.Monad

data Seg = A | B | C | D | E | F | G deriving (Show, Enum)
getGif :: Seg -> FilePath
getGif A = "y.gif"
getGif D = "y.gif"
getGif G = "y.gif"
getGif _ = "t.gif"
getPos :: Seg -> (Double,Double)
getPos A = (10,40)
getPos B = (20,30)
getPos C = (20,10)
getPos D = (10,0)
getPos E = (0,10)
getPos F = (0,30)
getPos G = (10,20)
onSeg,offSeg :: String -> IO ()
offSeg seg = do
    putStr seg
    putStrLn ".ht()"
onSeg seg = do
    putStr seg
    putStrLn ".st()"
mkSeg :: String -> Seg -> Double -> IO ()
mkSeg name seg offset = do
    let gif = getGif seg
    tShape name gif
    let (a,b) = getPos seg
    tMove name (a + offset, b)
setNum :: [String] -> Int -> IO [()]
setNum names n = do
    zipWithM (\x y -> if y == 1 then onSeg x else offSeg x) names (table !! n) 
table = 
    [[1,1,1,1,1,1,0],
    [0,1,1,0,0,0,0],
    [1,1,0,1,1,0,1],
    [1,1,1,1,0,0,1],
    [9,1,1,0,0,1,1],
    [1,0,1,1,0,1,1],
    [1,0,1,1,1,1,1],
    [1,1,1,0,0,0,0],
    [1,1,1,1,1,1,1],
    [1,1,1,0,0,1,1]]
main = go
go = do
    start
    s0 <- -="" mapm="" x=""> tCons ("s0" ++ show x))  [0 .. 6]
    s1 <- -="" mapm="" x=""> tCons ("s1" ++ show x))  [0 .. 6]
    mapM_ tPenup s0
    mapM_ tPenup s1
    putStrLn "s=getscreen()"
    mapM_ tReg ["t.gif","y.gif"]
    zipWithM (\x y ->mkSeg x y 0) s0 [A .. G]
    zipWithM (\x y ->mkSeg x y 30) s1 [A .. G]
    mapM_ (setNum s0) [0..9]
    end
#7seg.py

from turtle import *
import datetime
table = [[1,1,1,1,1,1,0], [0,1,1,0,0,0,0], [1,1,0,1,1,0,1], [1,1,1,1,0,0,1], [0,1,1,0,0,1,1], [1,0,1,1,0,1,1], [1,0,1,1,1,1,1], [1,1,1,0,0,0,0], [1,1,1,1,1,1,1], [1,1,1,0,0,1,1]]
s00=Turtle()
s01=Turtle()
s02=Turtle()
s03=Turtle()
s04=Turtle()
s05=Turtle()
s06=Turtle()
d0 = [s00,s01,s02,s03,s04,s05,s06]
for x in d0:
    x.penup()
s10=Turtle()
s11=Turtle()
s12=Turtle()
s13=Turtle()
s14=Turtle()
s15=Turtle()
s16=Turtle()
d1 = [s10,s11,s12,s13,s14,s15,s16]
for x in d1:
    x.penup()
s=getscreen()
s.register_shape("t.gif")
s.register_shape("y.gif")
s00.shape("y.gif")
s00.setpos(10.0,40.0)
s01.shape("t.gif")
s01.setpos(20.0,30.0)
s02.shape("t.gif")
s02.setpos(20.0,10.0)
s03.shape("y.gif")
s03.setpos(10.0,0.0)
s04.shape("t.gif")
s04.setpos(0.0,10.0)
s05.shape("t.gif")
s05.setpos(0.0,30.0)
s06.shape("y.gif")
s06.setpos(10.0,20.0)
s10.shape("y.gif")
s10.setpos(40.0,40.0)
s11.shape("t.gif")
s11.setpos(50.0,30.0)
s12.shape("t.gif")
s12.setpos(50.0,10.0)
s13.shape("y.gif")
s13.setpos(40.0,0.0)
s14.shape("t.gif")
s14.setpos(30.0,10.0)
s15.shape("t.gif")
s15.setpos(30.0,30.0)
s16.shape("y.gif")
s16.setpos(40.0,20.0)
def setNum (d,n):
    t = table [n]
    print (t)
    for x in range (7):
        if t[x] == 0: 
            d[x].ht() 
        else:
            d[x].st()
dt_now = datetime.datetime.now()
print (dt_now)
s = dt_now.second
print (s)
while True:
    dt_now = datetime.datetime.now()
    if dt_now.second == s:
        continue   
    else:
        s = dt_now.second
        q, r = divmod(s, 10)
        setNum (d0,q)
        setNum (d1,r)
done()

Haskell＋Python.Turtleでハノイの塔をグラフィカルに解きます。

-- pbm.hs
import System.IO 
import System.Environment
getI :: IO Int 
getI = getArgs >>= (\(x:_) -> (return . read) x)
main = do
    n <- getI 
    mapM_ mkpbm [1..n]
mkpbm n = do
    h <- openFile ((show n) ++ ".pbm") WriteMode
    pbm h n
    hClose h
pbm h n = do
    hPutStrLn h "P1"
    hPutStrLn h $ show (10 * n)
    hPutStrLn h "10 "
    mapM_ (\x -> hPutStrLn h (line n)) [0..9]
    where line n = take (n*10) $ ['1','1' ..]

    
-- conv.hs
import System.Process
import System.FilePath
import System.Directory
main = do
    fs <- getCurrentDirectory >>= listDirectory 
    let fss = filter (\x -> "pbm" `isExtensionOf` x) fs
    print fs
    print fss
    mapM_ conv fss
--  % convert -fill 新しい色 -opaque 古い色 orig.png new.gif
conv i = do
    let o = nf
    createProcess (proc "convert" ["-fill","brown","-opaque","black", i ,o])
    where nf = replaceExtension i "gif" 

    
-- tHanoi.hs
import HTurtle
import Control.Monad
import Control.Monad.State
import Control.Exception
import System.IO.Error
main = do
    start
    line [(0,0),(0,100)]
    line [(100,0),(100,100)]
    line [(200,0),(200,100)]
    ts <- mapM tCons [1 .. 9]
    mapM_ (flip tSpeed 10) ts
    mapM_ tPenup ts
    putStrLn "s=getscreen()"
    mapM_ tReg gs
    zipWithM  tShape  ts gs
    zipWithM tMove ts p
    runStateT  loop (9,0,0)
    end
    where   p = [(0,x*10 - 10)|x <- [9,8..1]]
            gs = [show x++".gif"|x <- [1..9]]
tSpeed :: String -> Double -> IO()
tSpeed tn sn = do
    putStr tn
    putStr "."
    speed sn
tPenup :: String -> IO ()
tPenup tn = do
    putStr tn
    putStr "."
    penup
tCons :: Int -> IO String
tCons n = do
    putStr "t"
    putStr $ show n
    putStr "="
    putStrLn "Turtle()" 
    return $ 't':show n
tShape :: String -> String -> IO ()
tShape tname gifName = do
    putStr tname 
    putStr "."
    shape gifName
tReg :: String -> IO ()
tReg gn = do
    putStr "s"
    putStr "."
    putStr "register_shape"
    putStr "("
    putStr $ show gn
    putStrLn ")" 
tMove :: String -> Point -> IO()
tMove tn p = do
    putStr tn 
    putStr "." 　　
    setPos p
loop = do 
    [a,b,c] <- liftIO $ catchIOError getLine (\_ -> return "000")
    if a == '0' 
    then return ()
    else do
        let disc = "t" ++ [a]
        let tower = getTower c
        y <- update [b,c] 
        liftIO $ tMove disc (tower,fromIntegral (y*10))
        loop
getTower 'A' = 0
getTower 'B' = 100
getTower 'C' = 200
getTower _  = 0
update "AB" = do{(a,b,c) <- get;put(a-1,b+1,c);return b}
update "AC" = do{(a,b,c) <- get;put(a-1,b,c+1);return c}
update "BA" = do{(a,b,c) <- get;put(a+1,b-1,c);return a}
update "BC" = do{(a,b,c) <- get;put(a,b-1,c+1);return c}
update "CA" = do{(a,b,c) <- get;put(a+1,b,c-1);return a}
update "CB" = do{(a,b,c) <- get;put(a,b+1,c-1);return b}
update _ = return 0
 -- HTurtle.hs

module HTurtle where
type Point = (Double,Double)

f0 :: String -> IO()
f0 s = putStrLn s
f1 :: String -> IO()
f1 s = do
    putStr s
    putStrLn "()"
f2 :: String -> Double -> IO()
f2 s n = do
    putStr s
    putStr "("
    putStr $ show n
    putStrLn ")"
f2' :: String -> Point -> IO()
f2' s p = do
    putStr s
    putStrLn $ show p
f3 :: String -> String -> IO()
f3 s s1 = do
    putStr s
    putStr "("
    putStr "\""
    putStr s1
    putStr "\""
    putStrLn ")"
dig x = x / (pi / 180)
start = f0 "from turtle import *"
end = f1 "done"
getHeading = print "a = heading()"

pensize = f2 "pensize" 
screensize p = f2' "screensize" p
polygon :: [Point] -> String -> Bool -> IO ()
polygon pp@(p:ps) color True = do
    fillColor color
    beginFill
    penup
    setPos p
    pendown
    mapM_ setPos (ps ++ [p])
    endFill
line [a,b] = penup >> setPos a >> color "black" >> pendown >> setPos b  
erase [a,b] = penup >> setPos a >> color "white" >> pendown >> setPos b >> color "black" >> penup
dot p = penup >> setPos p >> pendown >> f1 "dot" >> pendown
penup = f1 "penup"
pendown = f1 "pendown"
triangle = polygon 
circle (a,b) x = penup >> setPos (a,b-x) >> pendown >> f2 "circle" x 
speed = f2 "speed" 
shape = f3 "shape" 
color = f3 "color" 
fillColor = f3 "fillcolor" 
beginFill = f1 "begin_fill"
endFill = f1 "end_fill"
setPos = f2' "setpos" 
setx = f2 "setx"
sety = f2 "sety" 
setH x = f2 "seth" (dig x)
foward x = pendown >> f2 "fd" x 
right = f2 "right" 
left = f2 "left" 
-- end of HTurtle.hs