TweetFollow Us on Twitter

Animated Towers
Volume Number:5
Issue Number:6
Column Tag:Lisp Listener

Animated Towers of Hanoi

By Jean Pascal J. Lange, Uebersyren, Luxembourg

Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.

More traditional programming in Allegro Common Lisp

In a preceding article, I promised an animated version of the towers of Hanoï using a (more) traditional approach. Here it is. Structures were used in place of objects, wherever possible, as Allegro Common Lisp enforces object-oriented programming to manage windows. Although structures feature some limited inheritance mechanism, it appears quite immediately how much object-oriented programming can ease programs writing.

What is a structure?

A Common Lisp structure is comparable to a PL/1 one or to a Pascal record type. It allows the user to create and use aggregate data types with named elements (from Guy L. Steele Jr.: “Common Lisp”, Digital Press 1984). Defining a new structure automatically creates a constructor function (by default, its name will be make-structureName), which will be used to create and initialize a new structure instance and an access function (structureName-slotName structureInstance) for every slot (i.e. structure named element); to any slot a default value may be given, a data type can be assigned as well as a read-only feature, giving the possibility to create some sort of constant slot (after it has been initialized when creating a new structure instance). In addition, one can give the whole structure some additional characteristics (for more details see Steele or Deborah G. Tatar: “a programmer’s guide to Common Lisp”, Digital Press 1987), the most interesting for us being :include, in order to “inherit” the slots of a previously defined structure.

A dumb version

Listing 1 shows a first version of the game, without any drawing capability. It is the “structured” counterpart of towerOfHanoi class; please note how codes are very similar: the structure and object definitions are almost identical. The “structured” version does not require an explicitly coded function to know how to create a new “object” as the object-oriented programming does with the mandatory method exist. However, the defStruct call combines the aspects offered by the call of defObject and the exist method. The functions definitions and calls include and use an argument for the structure on which they will work (semantic request) where a method definition included the class name (syntactic constraint as well) and passing a message to the current object did not require at all to use its class name (although sending a message to an object defined in another class does), a reference to a slot is somehow more complicated in its wording than the corresponding access to one of the object variables (see, for example, the respective uses of stacks). The functions addFirst and getAndRemoveFirst were left unchanged. Listing 2 exhibits a run of the program just described.

A rectangle manager

In order to eliminate as much as possible any use of object-oriented programming, the rectangle class has been replaced by a set of equivalent functions (see listing 3), with very few modifications, as the underlying record facility has been kept. Note how similar are the newRectangle function and the rectangle class exist method; however, a significant syntactic difference can be found in the way the rectangle coordinates are given: with keyword arguments (the keys starting with colons) instead of an init-list with alternated indicators (starting with quotes) and values, as for a property list. Another change: the name of the class does not have any equivalent when calling a creating function such as leftRightTopBottom.: no parameter has to be passed to indicate which rectangle is concerned, as a new one is requested. A last modification, the origin method changed name and became originRect when converted into function, in order to avoid a conflict with the Window origin method, due to an already mentioned Allegro Common Lisp restriction (see previous article), forbidding the use of the same name for a (global) function and an object method.

Animated towers of Hanoï

The “inheritance” mechanism of a structure is applied for the first time in listing 4, when defining the animatedTowerOfHanoi structure as a towerOfHanoi child (the actual object-oriented counterpart is animatedTowerOfHanoi+, in order not to repeat the previously mentioned problem of drawing in the Listener window; the same holds, for the same reason, for HanoiDisk structure and HanoiDisk+ class -see next paragraph-). Note that the multiple inheritance is not allowed to the structures, so the second way HanoiDiskRules+ was defined using object-oriented programming is no more valid. Here again, the functions require the actual structure to be passed as an argument where the object-oriented version used the message passing mechanism. Another main difference is the absence of equivalent for class variables (here TheTowers, Thickness and DiskGap): the solution applied here resides in using global variables (*TheTowers*, *Thickness* and *DiskGap*) which are unbound (with calls to makUnbound) at the end of the game. Note that when evaluating these functions, a warning message will appear telling that the function moveDisk is redefined, so the previous definition which applied to the towerOfHanoi structures is no more valid nor usable; using another name would imply not using any more the previously defined moveTower function or redefining it, with the same name or a different one. If one wants to run again the Hanoi function, the original definition of the moveDisk function has to be evaluated again. For the same reason, the Hanoi function became animatedHanoi, avoiding a redefinition. All these renamings are due to the inheritance mechanism available for the structures which does not include the encapsulation of the functions designed for a given structure, as there is no means to tell Common Lisp for which entity a given function is defined. Note in setUpDisks that the problem of lexical binding of the calling object -(self)- disappeared: this is one of the very few simplifications (if not the only one) gained in abandoning object-oriented programming.

Listing 5 shows how the structure HanoiDisk and its “related” functions have been defined. Note the three various special declarations (function declare), in functions whichTowers, widthPole and moveUpon, of the global variables *TheTowers*, *Thickness* and *DiskGap*, could be replaced by a unique proclamation (function proclaim) put at the beginning of this file, or, eventually, of the file containing animatedTowerOfHanoi provided this one is loaded first. The counterpart of the center method is now the function centerDisk, in order to keep access to the center function defined for the rectangle manager (listing 3).

Tower by rules: the heuristic version

The remarks made for animatedTowerOfHanoi and HanoiDisk apply also to towerByRules (listing 6) and HanoiDiskRules (listing 7). Here too, some functions, Hanoi, setUpDisks,widthPole and moveUpon, had to be renamed, HanoiRules, setUpDisksRules, widthPoleRules and moveUponRules respectively. In addition, changing widthPole and moveUpon name into widthPoleRules and moveUponRules allowed to call the original functions obviating the lack of functional inheritance.

Some conclusions

Even for a simple example as this set of games, some major assets of object-oriented programming appear neatly: data and code are strictly structured (tremendous modularity), with the risk of some side effect limited to the global variables, if any, the reusability of the already written code is vast and the code length somehow shorter (the actual code for structures is roughly 8% longer than with object-oriented programming), which too reduces the risk of errors (somehow proportional to code length according to Frederick P. Brooks Jr.’s book “The mythical man-month”, Addison-Wesley, 1975-1982).

Interested readers can write me: Jean-Pascal J. Lange, am Pratel, 14, L-5378 Uebersyren, Grand-Duché de Luxembourg.

Listing 1:

; © Copyright 1988 Jean-Pascal J. LANGE.

; towerOfHanoi, first pole is 0

(defStruct HanoiTower (stacks nil))

(deFun Hanoi (tower)
; tower of Hanoï program. Asks user for height of stack of disks.
; stacks is an array of stacks. Each stack is a list.
; The “objects” we put on the stacks are characters.
; A is the smallest disk, B is larger, etc...
  (let ((height nil))
    (do ()
        ((integerP height))
      (format t “~&Please type the number of disks in the tower: “)
      (setq height (read)) )
    (format t “~&tower of Hanoï for ~D disk~:P.” height)
    (setf (HanoiTower-stacks tower)
          (make-array 3 :initial-element nil) )
    
    (do ((each height (1- each)))
        ((zerop each))
      (addFirst (HanoiTower-stacks tower) 0
                (code-char (+ (char-code #\A) (1- each))) ) )
    (moveTower tower height 1 3 2) ) )

(deFun moveTower (tower nDisks fromPin toPin usingPin)
  (cond ((> nDisks 0)
         (moveTower tower (1- nDisks) fromPin usingPin toPin)
         (moveDisk tower fromPin toPin)
         (moveTower tower (1- nDisks) usingPin toPin fromPin) ) ) )

(deFun moveDisk (tower fromPin toPin)
; moves disk from a pin to another pin. Print the results in the
; listener window.
  (let ((disk (getAndRemoveFirst (HanoiTower-stacks tower)
                                 (1- fromPin) )))
    (addFirst (HanoiTower-stacks tower) (1- toPin) disk)
    (format t “~&~D -> ~D ~A” fromPin toPin disk) ) )

(deFun addFirst (array index item)
; addFirst is the procedure for push.
  (setf (aref array index)
        (cons item (aref array index)) ) )

(deFun getAndRemoveFirst (array index)
; getAndRemoveFirst is the procedure for pop.
  (let ((first (car (aref array index))))
    (setf (aref array index)
          (cdr (aref array index))  )
    first ) )
Listing 2:

Welcome to Allegro CL Version 1.1!
? 
HANOITOWER
HANOI
MOVETOWER
MOVEDISK
ADDFIRST
GETANDREMOVEFIRST
? (setf HanoiTower (make-HanoiTower))
#S(HANOITOWER STACKS NIL)
? (Hanoi HanoiTower)
Please type the number of disks in the tower: 3
tower of Hanoï for 3 disks.
1 -> 3 A
1 -> 2 B
3 -> 2 A
1 -> 3 C
2 -> 1 A
2 -> 3 B
1 -> 3 A
NIL
? 
Listing 3:

; rectangle manager
; Adele Goldberg & David Robson:
; Smalltalk-80, the language and its implementation,
; Addison-Wesley, pp. 344-349
; implemented in Allegro Common Lisp by J-P J. LANGE.
; © Copyright 1988 Jean-Pascal J. LANGE.

(eval-when
  (compile eval load)
  (require ‘quickDraw)
  (require ‘records) )

(proclaim ‘(object-variable wptr)) ; from *window* class

(deFun newRectangle
       (&key
        (top nil)
        (left nil)
        (topLeft nil)
        (bottom nil)
        (right nil)
        (bottomRight nil) )
  (let ((rectangle (make-record ‘rect)))
    (if topLeft
      (cond (top
             (error “Conflicting coordinates: ~
                     top (~A) and topLeft (~A)”
                    top (point-string topLeft) ) )
            (left
             (error “Conflicting coordinates: ~
                     left (~A) and topLeft (~A)”
                    left (point-string topLeft) ) )
            (t (rSet rectangle rect.topLeft topLeft)) )
      (progn
        (if top (rSet rectangle rect.top top))
        (if left (rSet rectangle rect.left left)) ) )
    (if bottomRight
      (cond (bottom
             (error “Conflicting coordinates: ~
                     bottom (~A) and bottomRight (~A)”
                    bottom (point-string bottomRight) ) )
            (right
             (error “Conflicting coordinates: ~
                     right (~A) and bottomRight (~A)”
                    right (point-string bottomRight) ) )
            (t (rSet rectangle rect.bottomRight bottomRight)) )
      (progn
        (if bottom (rSet rectangle rect.bottom bottom))
        (if right (rSet rectangle rect.right right)) ) )
    rectangle ) )

(deFun leftRightTopBottom (left right top bottom)
  (newRectangle :top top :left left :bottom bottom :right right) )

(deFun originCorner (origin corner)
  (newRectangle :topLeft origin :bottomRight corner) )

(deFun originExtent (origin extent)
  (newRectangle :topLeft origin
                :bottomRight (add-points origin extent) ) )

(deFun originRect (rectangle)
  (rRef rectangle rect.topLeft) )

(deFun corner (rectangle)
  (rRef rectangle rect.bottomRight) )

(deFun center (rectangle)
  (let ((extent (extent rectangle)))
    (add-points (originRect rectangle)
                (make-point (round (point-h extent) 2.0)
                            (round (point-v extent) 2.0) ) ) ) )

(deFun extent (rectangle)
  (subtract-points (corner rectangle) (originRect rectangle)) )

(deFun setOrigin (rectangle origin)
  (rSet rectangle rect.topLeft origin) )

(deFun setCorner (rectangle corner)
  (rSet rectangle rect.bottomRight corner) )

(deFun setCenter (rectangle aPoint)
  ; move the rectangle so it is centered on the point,
  ; but keep the width and height unchanged
  (let ((extent (extent rectangle)))
    (setOrigin rectangle
               (add-points (originRect rectangle)
                           (subtract-points aPoint
                                            (center rectangle) ) ) )
    (setCorner rectangle
               (add-points (originRect rectangle) extent) ) ) )

(deFun border (rectangle width &optional (window (front-window)))
  (let* ((oldPenState (ask window (pen-state))))
    (with-port (ask window wptr)
      (ask window (pen-normal)
           (set-pen-size (make-point width width))
           (frame-rect rectangle)
           (set-pen-state oldPenState) ) )
    (dispose-record oldPenState) ) )

(deFun erase (rectangle &optional (window (front-window)))
  (ask window (erase-rect rectangle)) )

(deFun invertRect (rectangle &optional (window
 (front-window) ))
  (ask window (invert-rect rectangle)) )
Listing 4:

; Ted Kaehler and Dave Patterson: a taste of SmallTalk
; W. W. Norton ed., chapter 5, pp. 65 ff.
; translated in Allegro Common Lisp by J-P J. LANGE.
; © Copyright 1988 Jean-Pascal J. LANGE.

(defStruct
        (animatedTowerOfHanoi (:include HanoiTower))
#| This structure represents the game. It inherits the
     variable stacks from structure HanoiTower.
   The variables are:
     howMany: the number of disks,
     mockDisks: an array of fake disks (when a disk asks
                    what disk it can move on top of, and the
                     pole is empty, we return a mock disk; it
                            has nearly infinite width). |#
  (howMany nil)
  (mockDisks nil) )

; the game

(deFun animatedHanoi (animatedTower)
  ; asks the user how many disks, set up the game and
  ; move disks until we are done.
  (declare
 (special *TheTowers* *Thickness* *DiskGap*))
  (do ()
      ((integerp (howMany animatedTower)))
    (format t
          “~&Please type the number of disks in the tower: “)
    (setf (animatedTowerOfHanoi-howMany
 animatedTower ) (read) ) )
  (oneOf *window*
         :window-title “animated towers of Hanoï”
         :window-position #@(20 100)
         :window-size #@(360 220)
         :window-type :single-edge-box )
  (setUpDisks animatedTower) ; create disks & stacks
  (moveTower animatedTower
             (howMany animatedTower) 1 3 2 )
  (setf
   (animatedTowerOfHanoi-howMany animatedTower) nil)
  (makUnbound ‘*TheTowers*)
  (makUnbound ‘*Thickness*)
  (makUnbound ‘*DiskGap*)
  nil ) ; animatedHanoi

(deFun setUpDisks (animatedTower)
  ; Creates the disks and set up the poles. Tells all disks
  ; what game they are in and set disk thickness and
  ; gap.
  (whichTowers animatedTower)
  (let ((displayBox (originCorner #@(0 0)
                                  (ask (front-window) (window-size)) 
) ) )
    (erase displayBox)
    (border displayBox 2) )
  ; the poles are an array of three stacks. Each stack is
  ; a list.
  (setf (animatedTowerOfHanoi-stacks animatedTower)
        (make-array 3 :initial-element nil) )
  (let ((disk)
        (size (howMany animatedTower)) )
    (doTimes (i (howMany animatedTower))
      (setq disk (make-HanoiDisk))        ; create a disk
      (widthPole disk size 1)
      ; don’t forget: 1st element of an array is at index 0 !!!
      (addFirst
         (animatedTowerOfHanoi-stacks animatedTower)
      0 disk)             ; push it onto a stack
      (invert disk)                  ; show on the screen
      (setq size (1- size)) ) )
  
  ; When a pole has no disk on it, one of these mock
  ; disks acts as a bottom disk. A moving disk will ask a
  ; mock disk its width and pole number.
  (setf
       (animatedTowerOfHanoi-mockDisks animatedTower)
       (make-array 3 :initial-element nil) )
  (let ((disk))
    (doTimes (index 3)
      (setq disk (make-HanoiDisk))
      ; don’t forget: a doTimes-loop index starts at 0 !!!
      (widthPole disk 1000 (1+ index))
      ; don’t forget: 1st element of an array is at index 0 !!!
      (setf
       (aRef
       (animatedTowerOfHanoi-mockDisks animatedTower)
 index )
       disk ) ) ) )

(deFun moveDisk (animatedTower fromPin toPin)
  ; move disk from a pin to another pin.
  ; Print the results in the listener window.
  (let ((supportDisk  
         ; don’t forget: 1st element of an array is at index 0 !
         (if (aRef
               (animatedTowerOfHanoi-stacks animatedTower)
                   (1- toPin) )
           (car
              (aRef
               (animatedTowerOfHanoi-stacks animatedTower)
                      (1- toPin) ) )
           (aRef
              (animatedTowerOfHanoi-mockDisks
                animatedTower)
                 (1- toPin) ) ) )
        (disk (getAndRemoveFirst
               (animatedTowerOfHanoi-stacks animatedTower)
               (1- fromPin) )) )
    (addFirst
           (animatedTowerOfHanoi-stacks animatedTower)
              (1- toPin) disk)
    ; inform the disk and show move
    (moveUpon disk supportDisk)
    #|(format t
 “~&~D -> ~D: ~A” fromPin toPin (name disk))|# )
  #|(sleep 0.3)|# ) ; moveDisk

(deFun howMany (animatedTower)
  ; returns the number of disks
  (animatedTowerOfHanoi-howMany animatedTower) )
Listing 5:

; Ted Kaehler and Dave Patterson: a taste of SmallTalk
; W. W. Norton ed., chapter 5, pp. 65 ff.
; translated in Allegro Common Lisp by J-P J. LANGE.
; © Copyright 1988 Jean-Pascal J. LANGE.

(defStruct HanoiDisk
; Each disk in the game is represented by an object of
; structure HanoiDisk. It has
;   name: name of this disk (a character),
;   width: size of the disk (1 is the smallest disk width),
;   pole: number telling which pole the disk is on,
;   diskRectangle: a rectangle on the screen that the
;                                  disk occupies.
  (name nil)
  (width nil)
  (pole nil)
  (diskRectangle nil) )

; access

(deFun pole (thisDisk) ; return which pole this disk is on
  (HanoiDisk-pole thisDisk) )

(deFun name (thisDisk) ; return the name of this disk
  (HanoiDisk-name thisDisk) )

(deFun whichTowers (aTowerOfHanoi)
; There are three global variables shared across the
; whole game:
;    *TheTowers*: the structure that represents the whole
;                                game and holds the stacks of disks,
;    *Thickness*: the thickness of a disk in screen dots,
;    *DiskGap*: the number of screen dots between disks
;                            in a stack.
  (declare
 (special *TheTowers* *Thickness* *DiskGap*))
  ; install the structure representing the towers
  (setq *TheTowers* aTowerOfHanoi)
  ; thickness of a disk in screen dots
  (setq *Thickness* 14)
  (setq *DiskGap* 2) )  ; distance between disks

(deFun widthPole (thisDisk size whichPole)
  (declare
 (special *TheTowers* *Thickness* *DiskGap*))
  ; set the values for this disk
  (setf (HanoiDisk-width thisDisk) size)
  (setf (HanoiDisk-pole thisDisk) whichPole)
  ; compute the center of the disk on the screen
  (let* ((where)
         (window-size (ask (front-window) (window-size)))
         (window-height (point-v window-size))
         (window-width (point-h window-size))
         (x0 (floor window-width 6))
         (y0 (- window-height 11))
         (h-distance (floor window-width 3)) )
    (cond ((not (>= size 1000))
           ; a normal disk
           (setf (HanoiDisk-name thisDisk)
                 (code-char (+ (char-code #\A) (1- size))) )
           (let ((y (- y0 (* (- (howMany *TheTowers*) size)
                             (+ *Thickness* *DiskGap*) ))))
             (setq where (make-point x0 y)) ) )
          (t (setf (HanoiDisk-name thisDisk) ‘m) ; a mock disk
             (setq where
                   (make-point (- (* h-distance whichPole) x0)
                               (+ y0 *Thickness* *DiskGap*) ) ) ) )
    ; create rectangle, specify size and locate center 
    (let ((extent (make-point (* size 14) *Thickness*)))
      (setf (HanoiDisk-diskRectangle thisDisk)
            (originExtent #@(0 0) extent)) )
    ; locate the rectangle center
    (setCenter
 (HanoiDisk-diskRectangle thisDisk) where)) )

(deFun centerDisk (thisDisk)
; returns a point that is the current center of this disk
  (center (HanoiDisk-diskRectangle thisDisk)) )

(deFun moveUpon (thisDisk destination)
; this disk just moved. Record new pole and tell the user.
  (declare (special *Thickness* *DiskGap*))
  (setf (HanoiDisk-pole thisDisk) (pole destination))
  ; remove the old image
  (invert thisDisk)
  ; reposition
  (let ((point (make-point 0 (+ *Thickness* *DiskGap*))))
    (setCenter (HanoiDisk-diskRectangle thisDisk)
             (subtract-points (centerDisk destination) point )) )
  ; display the new one
  (invert thisDisk) )

(deFun invert (thisDisk)
; shows a disk on the screen by turning white to black
; in a rectangular region
  (invertRect (HanoiDisk-diskRectangle thisDisk)) )
Listing 6:

; Ted Kaehler and Dave Patterson a taste of SmallTalk
; W. W. Norton ed., chapter 6, pp. 83 ff.
; translated in Allegro Common Lisp by J-P J. LANGE.
; © Copyright 1988 Jean-Pascal J. LANGE.

(defStruct
         (towerByRules (:include animatedTowerOfHanoi))
#| An object of this class represents the game. It holds
    an array of stacks that hold disks. It also keeps track
    of which disk just moved and which disk should move
     next.
   The new instance variables are
       oldDisk the disk that was moved last time,
       currentDisk we are considering moving this disk,
       destinationDisk and putting it on top of this disk.|#
  (oldDisk nil)
  (currentDisk nil)
  (destinationDisk nil) )

; initialize

(deFun HanoiRules (thisTower)
; asks the user how many disks, set up the game and
; move disks until we are done
  (declare
 (special *TheTowers* *Thickness* *DiskGap*))
  (do ()
      ((integerp (howMany thisTower)))
    (format t
           “~&Please type the number of disks in the tower: “)
    (setf (towerByRules-howMany thisTower) (read)) )
  (oneOf *window*
         :window-title “heuristic animated towers of Hanoï”
         :window-position #@(20 100)
         :window-size #@(360 220)
         :window-type :single-edge-box )
  
  (setUpDisksRules thisTower)  ; create disks & stacks
  
  (loop ; iterate until all disks are on one tower again.
    (let* ((currentDisk (decide thisTower))
           ; decide which to move and also set
           ; destinationDisk
           (currentPole (pole currentDisk))
           (destinationPole
            (pole (towerByRules-destinationDisk thisTower))))
      (removeFirst (towerByRules-stacks thisTower)
                   (1- currentPole) )
      (addFirst (towerByRules-stacks thisTower)
                (1- destinationPole) currentDisk )
      #|(format t “~&~D -> ~D : ~A”
              currentPole destinationPole (name currentDisk)
              )|#
      ; tell the disk where it is now
      (moveUponRules currentDisk
 (towerByRules-destinationDisk thisTower) )
      ; get ready for the next move
      (setf (towerByRules-oldDisk thisTower) currentDisk))
     ; test if done
    (when (allOnOneTower thisTower) (return)) )
  ; so on next run, howMany will be re-initialized
  (setf (towerByRules-howMany thisTower) nil)
  (makUnbound ‘*TheTowers*)
  (makUnbound ‘*Thickness*)
  (makUnbound ‘*DiskGap*)
  nil ) ; HanoiRules

(deFun setUpDisksRules (thisTower)
; Creates the disks and set up the poles. Tells all disks
; what game they are in and set disk thickness and gap.
  (whichTowers thisTower)
  (let ((displayBox
         (originCorner #@(0 0)
                  (ask (front-window) (window-size)) ) ))
    (erase displayBox)
    (border displayBox 2) )
  ; the poles are an array of three stacks.
  ; Each stack is a list.
  (setf (towerByRules-stacks thisTower)
        (make-array 3 :initial-element nil) )
  (let ((disk)
        (size (howMany thisTower)) )
    (doTimes (i (howMany thisTower))
      (setq disk (make-HanoiDiskRules))        ; create a disk
      (widthPoleRules disk size 1)
      ; don’t forget: 1st element of an array is index 0 !!!
      ; push it onto a stack
      (addFirst (towerByRules-stacks thisTower) 0 disk)
      (invert disk)                  ; show on the screen
      (setq size (1- size)) ) )
  
  ; When a pole has no disk on it, one of these mock
  ; disks acts as a bottom disk. A moving disk will ask a
  ; mock disk its width and pole number.
  (setf (towerByRules-mockDisks thisTower)
        (make-array 3 :initial-element nil) )
  (let ((disk))
    (doTimes (index 3)
      (setq disk (make-HanoiDiskRules))
      ; don’t forget: a doTimes-loop index starts at 0 !!!
      (widthPoleRules disk 1000 (1+ index))
      (setf
         (aRef (towerByRules-mockDisks thisTower) index)
            disk ) ) )
  ; on first move, look for another disk (a real one) to move
  ; don’t forget: 1st element of an array is at index 0 !!!
  (setf (towerByRules-oldDisk thisTower)
        (aRef (towerByRules-mockDisks thisTower) 2)) )

; moves

(deFun allOnOneTower (thisTower)
; return true if all of the disks are on one tower
  (doTimes
          (index (length (towerByRules-stacks thisTower))
           nil)
    (if (= (length (aRef (towerByRules-stacks thisTower)
               index))
           (howMany thisTower) )
      (return t) ) ) ) ; allOnOneTower

(deFun decide (thisTower)
; use the last disk moved (oldDisk) to find a new disk to
; move (currentDisk) and a disk to put it on top of
; (destinationDisk).
  (topsOtherThan
   thisTower
   (towerByRules-oldDisk thisTower)
   #’(lambda (movingDisk)
       (cond ((hasLegalMove movingDisk)
              ; remember the disk upon which to move
              (setf (towerByRules-destinationDisk thisTower)
                    (bestMove movingDisk) )
              ; return the disk that moves
              movingDisk ) ) ) ) ) ; decide

(deFun polesOtherThan (thisTower thisDisk aBlock)
; evaluate the block of code using the top disk on each
; of the other two poles. If a pole is empty, use the mock
; disk for that pole.
  (doTimes (aPole 3)
    ; Want a pole other than the pole of thisDisk
    ; don’t forget: a doTimes-loop index starts at 0 !!!
    (if (not (= (1+ aPole) (pole thisDisk)))
      (let
        ((result
          (if (null
                (aRef (towerByRules-stacks thisTower) aPole))
            ; if the pole is empty, use a mock disk 
            (funCall aBlock
                     (aRef (towerByRules-mockDisks thisTower)
                           aPole ) ) ; execute the block
            ;  else use the top disk
            (funCall aBlock ; execute the block
                     (first (aRef (towerByRules-stacks thisTower)
                                  aPole )) ) ) ))
        (when result (return result)) ) ) ) ) ; polesOtherThan

(deFun topsOtherThan (thisTower thisDisk aBlock)
; evaluate the block of code using the top disk on each
; of the other two poles. If a pole is empty, ignore it. This
; is for actual disks.
  (doTimes (aPole 3)
    ; If the pole does not have thisDisk and is not empty,
    ; then execute aBlock (doTimes index starts at 0!!!)
    (if (and (not (= (1+ aPole) (pole thisDisk)))
             (not (null (aRef (towerByRules-stacks thisTower)
                              aPole ))) )
      (let ((result
             (funcall aBlock ; execute the block
                      (first (aRef (towerByRules-stacks thisTower)
                                   aPole )) ) ))
        (when result (return result)) ) ) ) ) ; topsOtherThan

(deFun removeFirst (array index)
; removeFirst is the procedure for pop.
  (setf (aRef array index) (cdr (aRef array index))) )
Listing 7:

; Ted Kaehler and Dave Patterson a taste of SmallTalk
; W. W. Norton ed., chapter 6, pp. 83 ff.
; translated in Allegro Common Lisp by J-P J. LANGE.
; © Copyright 1988 Jean-Pascal J. LANGE.

(defStruct (HanoiDiskRules (:include HanoiDisk))
  ; previousPole : number of pole this disk was on previously.
  (previousPole nil) )

; access

(deFun width (thisDisk)
; return the size of this disk
  (HanoiDiskRules-width thisDisk) ) ; width

(deFun widthPoleRules (thisDisk size whichPole)
  ; invoke widthPole for HanoiDisk structure
  (widthPole thisDisk size whichPole)
  (setf (HanoiDiskRules-previousPole thisDisk) 1) )

; moving

(deFun bestMove (thisDisk)
; If thisDisk can move two places, which is the best?
; Return the top disk of the pole that this disk has not
; been on recently.
  (declare (special *TheTowers*))
  (let ((secondBest))
    (cond
     ((polesOtherThan
       *TheTowers*
       thisDisk
       #’(lambda (targetDisk)
           (cond ((< (width thisDisk)
                     (width targetDisk) )
                  (setq secondBest targetDisk)
                  (if (not
                       (= (pole targetDisk)
                          (HanoiDiskRules-previousPole thisDisk) ) )
                    targetDisk ) )) ) ) )
     ; as a last resort, return a pole it was on recently
     (t secondBest) ) ) ) ; bestMove

(deFun hasLegalMove (thisDisk)
; do either of the other two poles have a top disk large
; enough for this disk to rest on?
  (declare (special *TheTowers*))
  (polesOtherThan *TheTowers*
                  thisDisk
                  ; when a pole has no disk,targetDisk
                  ;  is mock disk with infinite width
                  #’(lambda (targetDisk)
                      (< (width thisDisk)
                         (width targetDisk) ) ) ) ) ; hasLegalMove

(deFun moveUponRules (thisDisk destination)
; this disk just moved. Record the new pole and tell the user
  (setf (HanoiDiskRules-previousPole thisDisk)
            (pole thisDisk) )
  ; run moveUpon defined for structure HanoiDisk
  (moveUpon thisDisk destination) ) ; moveUponRules

 
AAPL
$100.57
Apple Inc.
+0.04
MSFT
$44.95
Microsoft Corpora
-0.38
GOOG
$584.49
Google Inc.
-2.37

MacTech Search:
Community Search:

Software Updates via MacUpdate

Picasa 3.9.138 - Organize, edit, and sha...
Picasa and Picasa Web Albums allows you to organize, edit, and upload your photos to the Web from your computer in quick, simple steps. Arrange your photos into folders and albums and erase their... Read more
Tidy Up 3.0.15.0 - Find duplicate files...
Tidy Up is a complete duplicate finder and disk-tidiness utility. With Tidy Up you can search for duplicate files and packages by the owner application, content, type, creator, extension, time... Read more
Parallels Desktop 10.0 - Run Windows app...
Parallels Desktop is simply the world's bestselling, top-rated, and most trusted solution for running Windows applications on your Mac. With Parallels Desktop for Mac, you can seamlessly run both... Read more
Apple Final Cut Pro X 10.1.3 - Professio...
Apple Final Cut Pro X is a professional video editing solution.Completely redesigned from the ground up, Final Cut Pro adds extraordinary speed, quality, and flexibility to every part of the post-... Read more
Apple Compressor 4.1.3 - Adds power and...
Compressor adds power and flexibility to Final Cut Pro X export. Customize output settings, work faster with distributed encoding, and tap into a comprehensive set of delivery features. Powerful... Read more
Chromium 36.0.1985.143 - Fast and stable...
Chromium is an open-source browser project that aims to build a safer, faster, and more stable way for all Internet users to experience the web. FreeSMUG-Free OpenSource Mac User Group build is... Read more
Macgo Blu-ray Player 2.10.6.1691 - Blu-r...
Macgo Mac Blu-ray Player can bring you the most unforgettable Blu-ray experience on your Mac. Overview Macgo Mac Blu-ray Player can satisfy just about every need you could possibly have in a Blu-ray... Read more
Apple Motion 5.1.2 - Create and customiz...
Apple Motion is designed for video editors, Motion 5 lets you customize Final Cut Pro titles, transitions, and effects. Or create your own dazzling animations in 2D or 3D space, with real-time... Read more
A Better Finder Rename 9.39 - File, phot...
A Better Finder Rename is the most complete renaming solution available on the market today. That's why, since 1996, tens of thousands of hobbyists, professionals and businesses depend on A Better... Read more
PopChar X 6.6 - Floating window shows av...
PopChar X helps you get the most out of your font collection. With its crystal-clear interface, PopChar X provides a frustration-free way to access any font's special characters. Expanded... Read more

Latest Forum Discussions

See All

Cubic Castles Review
Cubic Castles Review By Rob Thomas on August 20th, 2014 Our Rating: :: CASTLE CRAFTINGiPad Only App - Designed for the iPad Some ridiculously frustrating camera issues aside, Cubic Castles is a pretty neat, voxel-based crafting... | Read more »
Space Colors – Tips, Tricks, Strategies,...
Hello Cadets: Want to know what we thought about this hectic space combat/roguelike? Check out our Space Colors review! Space Colors is a cool shooter/roguelike from Team Chaos. You travel from planet to planet across a huge galaxy and complete a... | Read more »
Tap Sports Baseball – Tips, Tricks, and...
Tap Sports Baseball is a pretty simple game to learn, but that doesn’t mean it’s an easy game to master, by any means. To start your batting career off well, we thought we’d give you the heads up on some handy tips and tricks. Hey Batter-Batter:... | Read more »
Tap Sports Baseball Review
Tap Sports Baseball Review By Jennifer Allen on August 20th, 2014 Our Rating: :: LET'S PLAY BALLUniversal App - Designed for iPhone and iPad Tap Sports Baseball is briefly fun but lacks some important features.   | Read more »
Earn to Die 2 Set to Drive in to the App...
Earn to Die 2 Set to Drive in to the App Store Later This Year Posted by Ellis Spice on August 20th, 2014 [ permalink ] Not Doppler has announced that Earn to Die 2, a sequel to their successful game | Read more »
Frontier Heroes Review
Frontier Heroes Review By Andrew Fisher on August 20th, 2014 Our Rating: :: BLAZES NO TRAILSUniversal App - Designed for iPhone and iPad Despite awesome visuals and great music, Frontier Heroes just doesn’t quite deliver enough fun... | Read more »
Echo Prime is Now on Sale for $0.99
Echo Prime is Now on Sale for $0.99 Posted by Jessica Fisher on August 20th, 2014 [ permalink ] Universal App - Designed for iPhone and iPad | Read more »
Star Realms Review
Star Realms Review By Andrew Fisher on August 20th, 2014 Our Rating: :: A STAR IS BORNUniversal App - Designed for iPhone and iPad Star Realms is an excellent adaptation of an outstanding deck-builder. With great visuals and an... | Read more »
This. Is. SPRINGFIELD! War comes to The...
This. Is. SPRINGFIELD! | Read more »
One Tap RPG Review
One Tap RPG Review By Campbell Bird on August 20th, 2014 Our Rating: :: DUNGEON SLIDERUniversal App - Designed for iPhone and iPad This casual arcade game introduces some very light rpg elements into its fantasy-themed pachinko... | Read more »

Price Scanner via MacPrices.net

Apple now offering certified refurbished 2014...
 The Apple Store is now offering Apple Certified Refurbished 2014 MacBook Airs for up to $180 off the cost of new models. An Apple one-year warranty is included with each MacBook, and shipping is... Read more
Best Buy’s College Student Deals: $100 off Ma...
Take an additional $100 off all MacBooks and iMacs, $50 off iPad Airs and iPad minis, at Best Buy Online with their College Students Deals Savings, valid through September 6th. Anyone with a valid .... Read more
MacBook Airs on sale for $100 off MSRP, free...
B&H Photo has three 2014 MacBook Airs on sale for $100 off MSRP. Shipping is free, and B&H charges NY sales tax only. They also include free copies of Parallels Desktop and LoJack for Laptops... Read more
Razer Taipan Mouse For Gamers And Non-Gamers...
If you’re a serious gamer on either Mac or Windows PCs, a serious gaming mouse is a necessity for first-tier performance. However, even if like me you’re not much of a gamer, there’s still a strong... Read more
15-inch 2.2GHz MacBook Pro on sale for $1899,...
Adorama has the new 15″ 2.2GHz Retina MacBook Pro on sale for $1899 including free shipping plus NY & NJ sales tax only. Their price is $100 off MSRP, and it’s the lowest price available for this... Read more
Mid-Size Tablet Shootout Posted: iPad mini wi...
I ‘m curious about how many iPads Apple is actually selling these days. It’s been widely rumored and anticipated that new models with A8 SoCs, 2 GB of RAM, 8 megapixel cameras, and fingerprint... Read more
The 15 Biggest iPad Air Problems And How To A...
What’s this? Fifteen “biggest” problems with the iPad Air? Does that mean there are a lot of smaller problems as well? Say it isn’t so! My old iPad 2 has manifested no hardware problems in three... Read more
TYLT Syncable-Duo, 2-in-1 USB Cable With Appl...
TYLT has introduced the Syncable-Duo, a universal cable solution for charging and syncing data to smartphones and tablets. The Syncable-Duo eliminates the need for multiple cables by incorporating... Read more
Save up to $140 off MSRP with Apple refurbish...
Apple is offering Certified Refurbished iPad Airs for up to $140 off MSRP. Apple’s one-year warranty is included with each model, and shipping is free. Stock tends to come and go with some of these... Read more
2.5GHz Mac mini on sale for $549, save $50
B&H Photo has the 2.5GHz Mac mini on sale for $549.99 including free shipping. That’s $50 off MSRP, and B&H will also include a free copy of Parallels Desktop software. NY sales tax only. Read more

Jobs Board

*Apple* Retail - Multiple Positions (US) - A...
Sales Specialist - Retail Customer Service and Sales Transform Apple Store visitors into loyal Apple customers. When customers enter the store, you're also the Read more
Senior Event Manager, *Apple* Retail Market...
…This senior level position is responsible for leading and imagining the Apple Retail Team's global event strategy. Delivering an overarching brand story; in-store, Read more
*Apple* Solutions Consultant - Apple (United...
**Job Summary** The ASC is an Apple employee who serves as an Apple brand ambassador and influencer in a Reseller's store. The ASC's role is to grow Apple Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** Being a Business Manager at an Apple Store means you're the catalyst for businesses to discover and leverage the power, ease, and flexibility of Apple Read more
Position Opening at *Apple* - Apple (United...
**Job Summary** At the Apple Store, you connect business professionals and entrepreneurs with the tools they need in order to put Apple solutions to work in their Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.