From b3b5bd2c14cfcde6c551a87ee6da08a53f1e4bc6 Mon Sep 17 00:00:00 2001 From: Keith Packard Date: Mon, 14 Nov 2016 23:04:05 -0800 Subject: [PATCH] altos/lisp: Add license to hanoi demo Signed-off-by: Keith Packard --- src/test/hanoi.lisp | 68 ++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 61 insertions(+), 7 deletions(-) diff --git a/src/test/hanoi.lisp b/src/test/hanoi.lisp index 0c4bfca5..b84b8174 100644 --- a/src/test/hanoi.lisp +++ b/src/test/hanoi.lisp @@ -1,3 +1,22 @@ +; +; Towers of Hanoi +; +; Copyright © 2016 Keith Packard +; +; 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) ) @@ -6,16 +25,25 @@ (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) -(defun display-string (x y str) - (move-to x y) - (patom str) - ) +; Display one stack, clearing any +; space above it (defun display-stack (x y clear stack) (cond ((= 0 clear) @@ -34,16 +62,23 @@ ) ) +; 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)) @@ -52,21 +87,27 @@ ) ) +; 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) ) -(defun length (l) - (cond (l (1+ (length (cdr l)))) (0)) - ) +; 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) @@ -79,12 +120,18 @@ ) ) +; 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)) @@ -98,6 +145,8 @@ ) ) +; The implementation of the game + (defun _hanoi (n from to use) (cond ((= 1 n) (progn @@ -114,6 +163,11 @@ ) ) +; A pretty interface which +; resets the state of the game, +; clears the screen and runs +; the program + (defun hanoi () (setq len (reset-stacks)) (clear) -- 2.30.2