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

   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                                         ; Here's the pieces to display
  33
  34 (define tower '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
  35
  36                                         ; Here's all of the towers of pieces
  37                                         ; This is generated when the program is run
  38
  39 (define towers ())
  40
  41 (define (one- x) (- x 1))
  42 (define (one+ x) (+ x 1))
  43                                         ; Display one tower, clearing any
  44                                         ; space above it
  45
  46 (define (display-tower x y clear tower)
  47   (cond ((= 0 clear)
  48          (cond ((not (null? tower))
  49                 (display-string x y (car tower))
  50                 (display-tower x (one+ y) 0 (cdr tower))
  51                 )
  52                )
  53          )
  54         (else
  55          (display-string x y "                   ")
  56          (display-tower x (one+ y) (one- clear) tower)
  57          )
  58         )
  59   )
  60
  61                                         ; Position of the top of the tower on the screen
  62                                         ; Shorter towers start further down the screen
  63
  64 (define (tower-pos y tower)
  65   (- y (length tower))
  66   )
  67
  68                                         ; Display all of the towers, spaced 20 columns apart
  69
  70 (define (display-towers x y towers)
  71   (cond ((not (null? towers))
  72          (display-tower x 0 (tower-pos y (car towers)) (car towers))
  73          (display-towers (+ x 20) y (cdr towers)))
  74         )
  75   )
  76
  77 (define top 0)
  78                                         ; Display all of the towers, then move the cursor
  79                                         ; out of the way and flush the output
  80
  81 (define (display-hanoi)
  82   (display-towers 0 top towers)
  83   (move-to 1 21)
  84   (flush-output)
  85   )
  86
  87                                         ; Reset towers to the starting state, with
  88                                         ; all of the pieces in the first tower and the
  89                                         ; other two empty
  90
  91 (define (reset-towers)
  92   (set! towers (list tower () ()))
  93   (set! top (+ (length tower) 3))
  94   (length tower)
  95   )
  96
  97                                         ; Replace a tower in the list of towers
  98                                         ; with a new value
  99
 100 (define (replace list pos member)
 101   (cond ((= pos 0) (cons member (cdr list)))
 102         (else (cons (car list) (replace (cdr list) (one- pos) member)))
 103         )
 104   )
 105
 106                                         ; Move a piece from the top of one tower
 107                                         ; to the top of another
 108
 109 (define move-delay 10)
 110
 111 (define (move-piece from to)
 112   (let* ((from-tower (list-ref towers from))
 113          (to-tower (list-ref towers to))
 114          (piece (car from-tower)))
 115     (set! from-tower (cdr from-tower))
 116     (set! to-tower (cons piece to-tower))
 117     (set! towers (replace towers from from-tower))
 118     (set! towers (replace towers to to-tower))
 119     (display-hanoi)
 120     (delay move-delay)
 121     )
 122   )
 123
 124 ; The implementation of the game
 125
 126 (define (_hanoi n from to use)
 127   (cond ((= 1 n)
 128          (move-piece from to)
 129          )
 130         (else
 131          (_hanoi (one- n) from use to)
 132          (_hanoi 1 from to use)
 133          (_hanoi (one- n) use to from)
 134          )
 135         )
 136   )
 137
 138                                         ; A pretty interface which
 139                                         ; resets the state of the game,
 140                                         ; clears the screen and runs
 141                                         ; the program
 142
 143 (define (hanoi)
 144   (let ((len (reset-towers)))
 145     (clear)
 146     (_hanoi len 0 1 2)
 147     (move-to 0 23)
 148     #t
 149     )
 150   )
 151   )