;
; 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

(defun move-to (col row)
  (patom "\033[" row ";" col "H" nil)
  )

(defun clear ()
  (patom "\033[2J" nil)
  )

(defun display-string (x y str)
  (move-to x y)
  (patom str)
  )

; Here's the pieces to display

(setq stack '("*" "**" "***" "****" "*****" "******" "*******"))

(setq top (+ (length stack) 3))

;
; Here's all of the stacks of pieces
; This is generated when the program is run
;
(setq stacks nil)

; Display one stack, clearing any
; space above it

(defun display-stack (x y clear stack)
  (cond ((= 0 clear)
	 (cond (stack (progn
			(display-string x y (car stack))
			(display-stack x (1+ y) 0 (cdr stack))
			)
		      )
	       )
	 )
	(t (progn
	     (display-string x y "          ")
	     (display-stack x (1+ y) (1- clear) stack)
	     )
	   )
	)
  )

; This should probably be included in the rom image...

(defun length (list)
  (cond (list (1+ (length (cdr list))))
	(0)
	)
  )

; Position of the top of the stack on the screen
; Shorter stacks start further down the screen

(defun stack-pos (y stack)
  (- y (length stack))
  )

; Display all of the stacks, spaced 20 columns apart

(defun display-stacks (x y stacks)
  (cond (stacks (progn
		  (display-stack x 0 (stack-pos y (car stacks)) (car stacks))
		  (display-stacks (+ x 20) y (cdr stacks)))
		)
	)
  )

; Display all of the stacks, then move the cursor
; out of the way and flush the output

(defun display ()
  (display-stacks 0 top stacks)
  (move-to 1 21)
  (flush)
  )

; Reset stacks to the starting state, with
; all of the pieces in the first stack and the
; other two empty

(defun reset-stacks ()
  (setq stacks (list stack nil nil))
  (length stack)
  )

; more functions which could usefully
; be in the rom image

(defun min (a b)
  (cond ((< a b) a)
	(b)
	)
  )

(defun nth (list n)
  (cond ((= n 0) (car list))
	((nth (cdr list) (1- n)))
	)
  )

; Replace a stack in the list of stacks
; with a new value

(defun replace (list pos member)
  (cond ((= pos 0) (cons member (cdr list)))
	((cons (car list) (replace (cdr list) (1- pos) member)))
	)
  )

; Move a piece from the top of one stack
; to the top of another

(defun move-piece (from to)
  (let ((from-stack (nth stacks from))
	(to-stack (nth stacks to))
	(piece (car from-stack)))
    (setq from-stack (cdr from-stack))
    (setq to-stack (cons piece to-stack))
    (setq stacks (replace stacks from from-stack))
    (setq stacks (replace stacks to to-stack))
    (display)
    (delay 100)
    )
  )

; The implementation of the game

(defun _hanoi (n from to use)
  (cond ((= 1 n)
	 (progn
	  (move-piece from to)
	  nil)
	 )
	(t
	 (progn
	  (_hanoi (1- n) from use to)
	  (_hanoi 1 from to use)
	  (_hanoi (1- n) use to from)
	  )
	 )
	)
  )

; A pretty interface which
; resets the state of the game,
; clears the screen and runs
; the program

(defun hanoi ()
  (setq len (reset-stacks))
  (clear)
  (_hanoi len 0 1 2)
  )