home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Luc / hanoi2.gs < prev    next >
Text File  |  1994-06-23  |  3KB  |  105 lines
  1. -- Graphical Towers-Of-Hanoi program : -----------------------------------------
  2. --
  3. --
  4. -- author : Luc Duponcheel
  5. --
  6.  
  7. --
  8. -- The program makes use of screen-oriented functions. 
  9. -- It is possible that you'll have to redefine them if 
  10. -- you do not work with an ANSI-compliant terminal.
  11. --
  12.                                               
  13. --------------------------------------------------------------------------------
  14.  
  15.  
  16. -- general purpose function `comp' composes a list of functions
  17.  
  18. comp       :: [a -> a] -> a -> a
  19. comp []     = id
  20. comp (f:fs) = f . comp fs 
  21.  
  22.  
  23. -- screen oriented functions
  24.  
  25. escape = showChar '\ESC' . showChar '['
  26.  
  27. inverse = escape . showString "7m"
  28. normal  = escape . showString "m"
  29.  
  30. goto x y = escape . shows y . showChar ';' . shows x . showChar 'H'
  31.  
  32. clearscreen = showString "\ESC[2J"  -- ANSI version
  33. clearscreen = showChar '\^L'        -- Sun window
  34.  
  35. start  = clearscreen 
  36. stop   = normal 
  37.  
  38.  
  39. -- how to put and get a disk
  40.  
  41. showSpace = showString . space 
  42.  
  43. putDisk n x y = inverse . goto (n-x) y . showSpace (2*x)  
  44. getDisk n x y = normal  . goto (n-x) y . showSpace (2*x)  
  45.  
  46.  
  47. -- next configuartion
  48.  
  49. next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs)
  50. next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs))
  51. next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs)
  52. next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs))
  53. next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs)
  54. next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs)
  55.  
  56.  
  57. -- action to be performed
  58.  
  59. action n ((a:as),bs,cs) (0,1) 
  60.  = getDisk (2*n) a (2*n - length as) . putDisk (5*n) a (2*n - length bs)
  61. action n ((a:as),bs,cs) (0,2) 
  62.  = getDisk (2*n) a (2*n - length as) . putDisk (8*n) a (2*n - length cs)
  63. action n (as,(b:bs),cs) (1,0) 
  64.  = getDisk (5*n) b (2*n - length bs) . putDisk (2*n) b (2*n - length as)
  65. action n (as,(b:bs),cs) (1,2) 
  66.  = getDisk (5*n) b (2*n - length bs) . putDisk (8*n) b (2*n - length cs)
  67. action n (as,bs,(c:cs)) (2,0) 
  68.  = getDisk (8*n) c (2*n - length cs) . putDisk (2*n) c (2*n - length as)
  69. action n (as,bs,(c:cs)) (2,1) 
  70.  = getDisk (8*n) c (2*n - length cs) . putDisk (5*n) c (2*n - length bs)
  71.  
  72.  
  73. -- how to show the initial configuration
  74.  
  75. showInit n = comp [ putDisk (2*n) x (y+n) | (x,y) <- zip [1..n] [1..n] ] 
  76.  
  77.  
  78. -- the actual moves
  79.  
  80. moves n cnfg []     =  [] 
  81. moves n cnfg (x:xs) = move : moves n nextcnfg xs
  82.                      where 
  83.                       nextcnfg = next cnfg x 
  84.                       move = action n cnfg x 
  85.  
  86.  
  87. -- how to show the moves
  88.  
  89. showMoves n = comp (moves n ([1..n],[],[]) (hanoi n [0,2,1]))
  90.      
  91.  
  92. -- main code (simple!)
  93.                              
  94. hanoi 0 [a,b,c] = [] 
  95. hanoi n [a,b,c] = hanoi (n-1) [a,c,b] ++ [(a,b)] ++ hanoi (n-1) [c,b,a]
  96.  
  97.  
  98. -- how to show it all
  99.  
  100. showHanoi n = start . showInit n .  showMoves n . stop 
  101.  
  102.  
  103. --------------------------------------------------------------------------------
  104.  
  105.