git.gag.com Git - fw/altos/blob - src/scheme/test/hanoi.scheme

   1 ;
   2 ; Towers of Hanoi
   3 ;
   4 ; Copyright © 2016 Keith Packard <keithp@keithp.com>
   5 ;
   6 ; This program is free software; you can redistribute it and/or modify
   7 ; it under the terms of the GNU General Public License as published by
   8 ; the Free Software Foundation, either version 2 of the License, or
   9 ; (at your option) any later version.
  10 ;
  11 ; This program is distributed in the hope that it will be useful, but
  12 ; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ; General Public License for more details.
  15 ;
  16
  17                                         ; ANSI control sequences
  18
  19 (define (move-to col row)
  20   (for-each display (list "\033[" row ";" col "H"))
  21   )
  22
  23 (define (clear)
  24   (display "\033[2J")
  25   )
  26
  27 (define (display-string x y str)
  28   (move-to x y)
  29   (display str)
  30   )
  31
  32 (define (make-piece num max)
  33                                         ; A piece for position 'num'
  34                                         ; is num + 1 + num stars
  35                                         ; centered in a field of max *
  36                                         ; 2 + 1 characters with spaces
  37                                         ; on either side. This way,
  38                                         ; every piece is the same
  39                                         ; number of characters
  40
  41   (define (chars n c)
  42     (if (zero? n) ""
  43       (+ c (chars (- n 1) c))
  44       )
  45     )
  46   (+ (chars (- max num 1) " ")
  47      (chars (+ (* num 2) 1) "*")
  48      (chars (- max num 1) " ")
  49      )
  50   )
  51
  52 (define (make-pieces max)
  53                                         ; Make a list of numbers from 0 to max-1
  54   (define (nums cur max)
  55     (if (= cur max) ()
  56       (cons cur (nums (+ cur 1) max))
  57       )
  58     )
  59                                         ; Create a list of pieces
  60
  61   (map (lambda (x) (make-piece x max)) (nums 0 max))
  62   )
  63
  64                                         ; Here's all of the towers of pieces
  65                                         ; This is generated when the program is run
  66
  67 (define towers ())
  68
  69                                         ; position of the bottom of
  70                                         ; the stacks set at runtime
  71 (define bottom-y 0)
  72 (define left-x 0)
  73
  74 (define move-delay 25)
  75
  76                                         ; Display one tower, clearing any
  77                                         ; space above it
  78
  79 (define (display-tower x y clear tower)
  80   (cond ((= 0 clear)
  81          (cond ((not (null? tower))
  82                 (display-string x y (car tower))
  83                 (display-tower x (+ y 1) 0 (cdr tower))
  84                 )
  85                )
  86          )
  87         (else
  88          (display-string x y "                    ")
  89          (display-tower x (+ y 1) (- clear 1) tower)
  90          )
  91         )
  92   )
  93
  94                                         ; Position of the top of the tower on the screen
  95                                         ; Shorter towers start further down the screen
  96
  97 (define (tower-pos tower)
  98   (- bottom-y (length tower))
  99   )
 100
 101                                         ; Display all of the towers, spaced 20 columns apart
 102
 103 (define (display-towers x towers)
 104   (cond ((not (null? towers))
 105          (display-tower x 0 (tower-pos (car towers)) (car towers))
 106          (display-towers (+ x 20) (cdr towers)))
 107         )
 108   )
 109
 110                                         ; Display all of the towers, then move the cursor
 111                                         ; out of the way and flush the output
 112
 113 (define (display-hanoi)
 114   (display-towers left-x towers)
 115   (move-to 1 23)
 116   (flush-output)
 117   (delay move-delay)
 118   )
 119
 120                                         ; Reset towers to the starting state, with
 121                                         ; all of the pieces in the first tower and the
 122                                         ; other two empty
 123
 124 (define (reset-towers len)
 125   (set! towers (list (make-pieces len) () ()))
 126   (set! bottom-y (+ len 3))
 127   )
 128
 129                                         ; Move a piece from the top of one tower
 130                                         ; to the top of another
 131
 132 (define (move-piece from to)
 133
 134                                         ; references to the cons holding the two towers
 135
 136   (define from-tower (list-tail towers from))
 137   (define to-tower (list-tail towers to))
 138
 139                                         ; stick the car of from-tower onto to-tower
 140
 141   (set-car! to-tower (cons (caar from-tower) (car to-tower)))
 142
 143                                         ; remove the car of from-tower
 144
 145   (set-car! from-tower (cdar from-tower))
 146   )
 147
 148                                         ; The implementation of the game
 149
 150 (define (_hanoi n from to use)
 151   (cond ((= 1 n)
 152          (move-piece from to)
 153          (display-hanoi)
 154          )
 155         (else
 156          (_hanoi (- n 1) from use to)
 157          (_hanoi 1 from to use)
 158          (_hanoi (- n 1) use to from)
 159          )
 160         )
 161   )
 162
 163                                         ; A pretty interface which
 164                                         ; resets the state of the game,
 165                                         ; clears the screen and runs
 166                                         ; the program
 167
 168 (define (hanoi len)
 169   (reset-towers len)
 170   (clear)
 171   (display-hanoi)
 172   (_hanoi len 0 1 2)
 173   #t
 174   )