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
  18 ; ANSI control sequences
  19
  20 (defun move-to (col row)
  21   (patom "\033[" row ";" col "H" nil)
  22   )
  23
  24 (defun clear ()
  25   (patom "\033[2J" nil)
  26   )
  27
  28 (defun display-string (x y str)
  29   (move-to x y)
  30   (patom str)
  31   )
  32
  33 ; Here's the pieces to display
  34
  35 (setq stack '("     *     " "    ***    " "   *****   " "  *******  " " ********* " "***********"))
  36
  37 ;
  38 ; Here's all of the stacks of pieces
  39 ; This is generated when the program is run
  40 ;
  41 (setq stacks nil)
  42
  43 ; Display one stack, clearing any
  44 ; space above it
  45
  46 (defun display-stack (x y clear stack)
  47   (cond ((= 0 clear)
  48          (cond (stack (progn
  49                         (display-string x y (car stack))
  50                         (display-stack x (1+ y) 0 (cdr stack))
  51                         )
  52                       )
  53                )
  54          )
  55         (t (progn
  56              (display-string x y "                    ")
  57              (display-stack x (1+ y) (1- clear) stack)
  58              )
  59            )
  60         )
  61   )
  62
  63 ; Position of the top of the stack on the screen
  64 ; Shorter stacks start further down the screen
  65
  66 (defun stack-pos (y stack)
  67   (- y (length stack))
  68   )
  69
  70 ; Display all of the stacks, spaced 20 columns apart
  71
  72 (defun display-stacks (x y stacks)
  73   (cond (stacks (progn
  74                   (display-stack x 0 (stack-pos y (car stacks)) (car stacks))
  75                   (display-stacks (+ x 20) y (cdr stacks)))
  76                 )
  77         )
  78   )
  79
  80 ; Display all of the stacks, then move the cursor
  81 ; out of the way and flush the output
  82
  83 (defun display ()
  84   (display-stacks 0 top stacks)
  85   (move-to 1 21)
  86   (flush)
  87   )
  88
  89 ; Reset stacks to the starting state, with
  90 ; all of the pieces in the first stack and the
  91 ; other two empty
  92
  93 (defun reset-stacks ()
  94   (setq stacks (list stack nil nil))
  95   (setq top (+ (length stack) 3))
  96   (length stack)
  97   )
  98
  99 ; more functions which could usefully
 100 ; be in the rom image
 101
 102 (defun min (a b)
 103   (cond ((< a b) a)
 104         (b)
 105         )
 106   )
 107
 108 ; Replace a stack in the list of stacks
 109 ; with a new value
 110
 111 (defun replace (list pos member)
 112   (cond ((= pos 0) (cons member (cdr list)))
 113         ((cons (car list) (replace (cdr list) (1- pos) member)))
 114         )
 115   )
 116
 117 ; Move a piece from the top of one stack
 118 ; to the top of another
 119
 120 (defun move-piece (from to)
 121   (let ((from-stack (nth stacks from))
 122         (to-stack (nth stacks to))
 123         (piece (car from-stack)))
 124     (setq from-stack (cdr from-stack))
 125     (setq to-stack (cons piece to-stack))
 126     (setq stacks (replace stacks from from-stack))
 127     (setq stacks (replace stacks to to-stack))
 128     (display)
 129     (delay 100)
 130     )
 131   )
 132
 133 ; The implementation of the game
 134
 135 (defun _hanoi (n from to use)
 136   (cond ((= 1 n)
 137          (progn
 138           (move-piece from to)
 139           nil)
 140          )
 141         (t
 142          (progn
 143           (_hanoi (1- n) from use to)
 144           (_hanoi 1 from to use)
 145           (_hanoi (1- n) use to from)
 146           )
 147          )
 148         )
 149   )
 150
 151 ; A pretty interface which
 152 ; resets the state of the game,
 153 ; clears the screen and runs
 154 ; the program
 155
 156 (defun hanoi ()
 157   (setq len (reset-stacks))
 158   (clear)
 159   (_hanoi len 0 1 2)
 160   )