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