+++ /dev/null
-;
-; Towers of Hanoi
-;
-; Copyright © 2016 Keith Packard <keithp@keithp.com>
-;
-; This program is free software; you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation, either version 2 of the License, or
-; (at your option) any later version.
-;
-; This program is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-; General Public License for more details.
-;
-
- ; ANSI control sequences
-
-(define (move-to col row)
- (for-each display (list "\033[" row ";" col "H"))
- )
-
-(define (clear)
- (display "\033[2J")
- )
-
-(define (display-string x y str)
- (move-to x y)
- (display str)
- )
-
-(define (make-piece num max)
- ; A piece for position 'num'
- ; is num + 1 + num stars
- ; centered in a field of max *
- ; 2 + 1 characters with spaces
- ; on either side. This way,
- ; every piece is the same
- ; number of characters
-
- (define (chars n c)
- (if (zero? n) ""
- (+ c (chars (- n 1) c))
- )
- )
- (+ (chars (- max num 1) " ")
- (chars (+ (* num 2) 1) "*")
- (chars (- max num 1) " ")
- )
- )
-
-(define (make-pieces max)
- ; Make a list of numbers from 0 to max-1
- (define (nums cur max)
- (if (= cur max) ()
- (cons cur (nums (+ cur 1) max))
- )
- )
- ; Create a list of pieces
-
- (map (lambda (x) (make-piece x max)) (nums 0 max))
- )
-
- ; Here's all of the towers of pieces
- ; This is generated when the program is run
-
-(define towers ())
-
- ; position of the bottom of
- ; the stacks set at runtime
-(define bottom-y 0)
-(define left-x 0)
-
-(define move-delay 25)
-
- ; Display one tower, clearing any
- ; space above it
-
-(define (display-tower x y clear tower)
- (cond ((= 0 clear)
- (cond ((not (null? tower))
- (display-string x y (car tower))
- (display-tower x (+ y 1) 0 (cdr tower))
- )
- )
- )
- (else
- (display-string x y " ")
- (display-tower x (+ y 1) (- clear 1) tower)
- )
- )
- )
-
- ; Position of the top of the tower on the screen
- ; Shorter towers start further down the screen
-
-(define (tower-pos tower)
- (- bottom-y (length tower))
- )
-
- ; Display all of the towers, spaced 20 columns apart
-
-(define (display-towers x towers)
- (cond ((not (null? towers))
- (display-tower x 0 (tower-pos (car towers)) (car towers))
- (display-towers (+ x 20) (cdr towers)))
- )
- )
-
- ; Display all of the towers, then move the cursor
- ; out of the way and flush the output
-
-(define (display-hanoi)
- (display-towers left-x towers)
- (move-to 1 23)
- (flush-output)
- (delay move-delay)
- )
-
- ; Reset towers to the starting state, with
- ; all of the pieces in the first tower and the
- ; other two empty
-
-(define (reset-towers len)
- (set! towers (list (make-pieces len) () ()))
- (set! bottom-y (+ len 3))
- )
-
- ; Move a piece from the top of one tower
- ; to the top of another
-
-(define (move-piece from to)
-
- ; references to the cons holding the two towers
-
- (define from-tower (list-tail towers from))
- (define to-tower (list-tail towers to))
-
- ; stick the car of from-tower onto to-tower
-
- (set-car! to-tower (cons (caar from-tower) (car to-tower)))
-
- ; remove the car of from-tower
-
- (set-car! from-tower (cdar from-tower))
- )
-
- ; The implementation of the game
-
-(define (_hanoi n from to use)
- (cond ((= 1 n)
- (move-piece from to)
- (display-hanoi)
- )
- (else
- (_hanoi (- n 1) from use to)
- (_hanoi 1 from to use)
- (_hanoi (- n 1) use to from)
- )
- )
- )
-
- ; A pretty interface which
- ; resets the state of the game,
- ; clears the screen and runs
- ; the program
-
-(define (hanoi len)
- (reset-towers len)
- (clear)
- (display-hanoi)
- (_hanoi len 0 1 2)
- #t
- )
projects / fw / altos / blobdiff