home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Luc / hanoi3.gs < prev    next >
Text File  |  1994-06-23  |  5KB  |  150 lines
  1. -- Graphical Towers-Of-Hanoi program : -----------------------------------------
  2. --
  3. --
  4. -- author : Luc Duponcheel
  5. --
  6. -- the program is partly based on an earlier program which is 
  7. -- originally written in Miranda* by Johan Vanslembrouck.
  8. --
  9. -- *Miranda is a trademark of Software Research Limited.
  10. --
  11.  
  12. --
  13. -- The program makes use of screen-oriented functions. 
  14. -- It is possible that you'll have to redefine them if 
  15. -- you do not work with an ANSI-compliant terminal.
  16. --
  17.                                               
  18. --------------------------------------------------------------------------------
  19.  
  20.  
  21. -- general purpose function `comp' composes a list of functions
  22.  
  23. comp       :: [a -> a] -> a -> a
  24. comp []     = id
  25. comp (f:fs) = f . comp fs 
  26.  
  27.  
  28. -- screen oriented functions
  29.  
  30. escape = showChar '\ESC' . showChar '['
  31.  
  32. inverse = escape . showString "7m"
  33. normal  = escape . showString "m"
  34.  
  35. goto x y = escape . shows y . showChar ';' . shows x . showChar 'H'
  36.  
  37. clearscreen = showString "\ESC[2J"  -- ANSI version
  38. clearscreen = showChar '\^L'        -- Sun window
  39.  
  40. start  = clearscreen 
  41. stop   = normal 
  42.  
  43.  
  44. -- how to put and get a disk
  45.  
  46. showSpace = showString . space 
  47.  
  48. putDisk n x y = inverse . goto (n-x) y . showSpace (2*x)  
  49. getDisk n x y = normal  . goto (n-x) y . showSpace (2*x)  
  50.  
  51. -- next configuartion
  52.  
  53. next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs)
  54. next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs))
  55. next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs)
  56. next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs))
  57. next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs)
  58. next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs)
  59.  
  60. -- action to be performed
  61.  
  62. action n ((a:as),bs,cs) (0,1) 
  63.  = let la = length as ; lb = length bs in 
  64.    getDisk (2*n) a (2*n-la) . 
  65.    comp [ putDisk (2*n) 1 (2*n-la-i) . getDisk (2*n) 1 (2*n-la-i)  
  66.                                                         | i <- [1..n-la+1] ] .
  67.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [3,4] ] .
  68.    comp [ putDisk (5*n) 1 (n+i-2) . getDisk (5*n) 1 (n+i-2)        
  69.                                                         | i <- [1..n-lb+1] ] .
  70.    putDisk (5*n) a (2*n - lb)
  71. action n ((a:as),bs,cs) (0,2) 
  72.  = let la = length as ; lc = length cs in
  73.    getDisk (2*n) a (2*n - la) . 
  74.    comp [ putDisk (2*n) 1 (2*n-la-i) . getDisk (2*n) 1 (2*n-la-i) 
  75.                                                         | i <- [1..n-la+1] ] .
  76.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [3,4,5,6,7] ] .
  77.    comp [ putDisk (8*n) 1 (n+i-2) . getDisk (8*n) 1 (n+i-2)        
  78.                                                         | i <- [1..n-lc+1] ] .
  79.    putDisk (8*n) a (2*n - lc)
  80. action n (as,(b:bs),cs) (1,0) 
  81.  = let lb = length bs ; la = length as in
  82.    getDisk (5*n) b (2*n - lb) . 
  83.    comp [ putDisk (5*n) 1 (2*n-lb-i) . getDisk (5*n) 1 (2*n-lb-i)  
  84.                                                         | i <- [1..n-lb+1] ] .
  85.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [4,3] ] .
  86.    comp [ putDisk (2*n) 1 (n+i-2) . getDisk (2*n) 1 (n+i-2)        
  87.                                                         | i <- [1..n-la+1] ] .
  88.    putDisk (2*n) b (2*n - la) 
  89. action n (as,(b:bs),cs) (1,2) 
  90.  = let lb = length bs ; lc = length cs in
  91.    getDisk (5*n) b (2*n - lb) . 
  92.    comp [ putDisk (5*n) 1 (2*n-lb-i) . getDisk (5*n) 1 (2*n-lb-i)  
  93.                                                         | i <- [1..n-lb+1] ] .
  94.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [6,7] ] .
  95.    comp [ putDisk (8*n) 1 (n+i-2) . getDisk (8*n) 1 (n+i-2)        
  96.                                                         | i <- [1..n-lc+1] ] .
  97.   putDisk (8*n) b (2*n - lc)
  98. action n (as,bs,(c:cs)) (2,0) 
  99.  = let lc = length cs ; la = length as in
  100.    getDisk (8*n) c (2*n - lc) . 
  101.    comp [ putDisk (8*n) 1 (2*n-lc-i) . getDisk (8*n) 1 (2*n-lc-i)  
  102.                                                         | i <- [1..n-lc+1] ] .
  103.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [7,6,5,4,3] ] .
  104.    comp [ putDisk (2*n) 1 (n+i-2) . getDisk (2*n) 1 (n+i-2)        
  105.                                                         | i <- [1..n-la+1] ] .
  106.    putDisk (2*n) c (2*n - la)
  107. action n (as,bs,(c:cs)) (2,1) 
  108.  = let lc = length cs ; lb = length bs in
  109.    getDisk (8*n) c (2*n - lc) . 
  110.    comp [ putDisk (8*n) 1 (2*n-lc-i) . getDisk (8*n) 1 (2*n-lc-i)  
  111.                                                         | i <- [1..n-lc+1] ] .
  112.    comp [ putDisk (i*n) 1 (n-1) . getDisk (i*n) 1 (n-1) | i <- [7,6] ] .
  113.    comp [ putDisk (5*n) 1 (n+i-2) . getDisk (5*n) 1 (n+i-2)        
  114.                                                         | i <- [1..n-lb+1] ] .
  115.    putDisk (5*n) c (2*n - lb)
  116.  
  117.  
  118. -- how to show the initial configuration
  119.  
  120. showInit n = comp [ putDisk (2*n) x (y+n) | (x,y) <- zip [1..n] [1..n] ] 
  121.  
  122.  
  123. -- the actual moves
  124.  
  125. moves n cnfg []     =  [] 
  126. moves n cnfg (x:xs) = move : moves n nextcnfg xs
  127.                      where 
  128.                       nextcnfg = next cnfg x 
  129.                       move = action n cnfg x 
  130.  
  131.  
  132. -- how to show the moves
  133.  
  134. showMoves n = comp (moves n ([1..n],[],[]) (hanoi n [0,2,1]))
  135.      
  136.  
  137. -- main code (simple!)
  138.                              
  139. hanoi 0 [a,b,c] = [] 
  140. hanoi n [a,b,c] = hanoi (n-1) [a,c,b] ++ [(a,b)] ++ hanoi (n-1) [c,b,a]
  141.  
  142.  
  143. -- how to show it all
  144.  
  145. showHanoi n = start . showInit n .  showMoves n . stop 
  146.  
  147.  
  148. --------------------------------------------------------------------------------
  149.  
  150.