home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / gofer230.zip / Progs / Gofer / Demos / Luc / hanoi1.gs next >
Text File  |  1994-06-23  |  3KB  |  104 lines
  1. -- Graphical Hanoi program : ---------------------------------------------------
  2. --
  3. --
  4. -- author : Luc Duponcheel
  5. --
  6.  
  7. --
  8. -- when typing
  9. --
  10. -- ? hanoi n  (n is any natural number)
  11. --
  12. -- the program should produce a list of tower configurations.
  13. --
  14.  
  15.  
  16. --
  17. -- On a Sun SPARC the program has to run in a shell tool 
  18. -- (I assume that any ANSI-compliant terminal is OK)
  19. --    
  20.  
  21. --
  22. -- PS:
  23. --
  24. -- if you want to avoid that your boss can see that you are
  25. -- playing silly games at work, then you can always type in
  26. --
  27. -- ? clearscreen "" 
  28. --
  29.  
  30. --------------------------------------------------------------------------------
  31.  
  32. -- general purpose function `comp' composes a list of functions 
  33.  
  34. comp       :: [a -> a] -> a -> a
  35. comp []     = id
  36. comp (f:fs) = f . comp fs 
  37.  
  38. -- some screen oriented functions 
  39.  
  40. escape = showChar '\ESC' . showChar '['
  41.  
  42. inverse = escape . showString "7m"
  43. normal  = escape . showString "m"
  44.  
  45. clearscreen = showString "\ESC[2J"  -- ANSI version
  46. clearscreen = showChar '\^L'        -- Sun window
  47.  
  48. -- how to show one disk
  49.  
  50. showSpace = showString . space 
  51.  
  52. showDisk x = showSpace (10-x) 
  53.             . inverse . showSpace (2*x)  -- shows the disk in black
  54.             . normal . showSpace (10-x)
  55.  
  56. -- how to show one horizontal level (3, possibly dummy, disks)
  57.  
  58. newlevel  = showChar '\n'
  59.  
  60. showLevel (0,0,0) = newlevel
  61. showLevel (x,0,0) = showDisk x . newlevel
  62. showLevel (x,y,0) = showDisk x . showDisk y . newlevel
  63. showLevel (x,y,z) = showDisk x . showDisk y . showDisk z . newlevel
  64.  
  65. -- padding the towers vertically with dummy disks
  66.  
  67. pad xs len = [ 0 | x <- [0..(len - length xs)] ] ++ xs
  68.  
  69. -- actual moves
  70.  
  71. next ((a:as),bs,cs) (0,1) = (as,(a:bs),cs)
  72. next ((a:as),bs,cs) (0,2) = (as,bs,(a:cs))
  73. next (as,(b:bs),cs) (1,0) = ((b:as),bs,cs)
  74. next (as,(b:bs),cs) (1,2) = (as,bs,(b:cs))
  75. next (as,bs,(c:cs)) (2,0) = ((c:as),bs,cs)
  76. next (as,bs,(c:cs)) (2,1) = (as,(c:bs),cs)
  77.  
  78. -- how to show one tower configuration
  79.  
  80. showConfiguration n (as,bs,cs) = 
  81.      comp [ showLevel ts | ts <- zip3 (pad as n) (pad bs n) (pad cs n) ]
  82.  
  83. -- how to show all tower configurations
  84.  
  85. showConfigurations n cnf []     =  showConfiguration  n cnf
  86. showConfigurations n cnf (x:xs) =  showConfiguration  n cnf
  87.                                  . showConfigurations n (next cnf x) xs
  88.  
  89. -- how to start
  90.  
  91. startconf n = ([1..n],[],[])
  92.  
  93. -- how to continue (main code : is surprisingly simple)
  94.  
  95. cont 0 [a,b,c] = [] 
  96. cont n [a,b,c] = cont (n-1) [a,c,b] ++ [(a,b)] ++ cont (n-1) [c,b,a]
  97.  
  98. -- hanoi
  99.  
  100. hanoi n = showConfigurations n (startconf n) (cont n [0,2,1]) ""
  101.  
  102. --------------------------------------------------------------------------------
  103.  
  104.