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

 

Community Search:
MacTech Search:

Software Updates via MacUpdate

jAlbum 19.2 - Create custom photo galler...
With jAlbum, you can create gorgeous custom photo galleries for the Web without writing a line of code! Beginner-friendly, with pro results - Simply drag and drop photos into groups, choose a design... Read more
BlueStacks 4.140.13 - Run Android applic...
BlueStacks App Player lets you run your Android apps fast and fullscreen on your Mac. Feature comparison chart Version 4.140.13: Highlights/Bug Fixes: Feel free to use BlueStacks as your go to... Read more
Adobe Premiere Pro CC 2020 14.0.1 - Digi...
Premiere Pro CC 2020 is available as part of Adobe Creative Cloud for as little as $52.99/month. The price on display is a price for annual by-monthly plan for Adobe Premiere Pro only Adobe Premiere... Read more
VirtualBox 6.1.2 - x86 virtualization so...
VirtualBox is a family of powerful x86 virtualization products for enterprise as well as home use. Not only is VirtualBox an extremely feature rich, high performance product for enterprise customers... Read more
RoboForm 8.6.8 - Password manager; syncs...
RoboForm is a password manager that offers one-click login, mobile syncing, easy form filling, and reliable security. Password Manager. RoboForm remembers your passwords so you don't have to! Just... Read more
Postbox 7.0.11 - Powerful and flexible e...
Postbox is a new email application that helps you organize your work life and get stuff done. It has all the elegance and simplicity of Apple Mail, but with more power and flexibility to manage even... Read more
calibre 4.9.0 - Complete e-book library...
Calibre is a complete e-book library manager. Organize your collection, convert your books to multiple formats, and sync with all of your devices. Let Calibre be your multi-tasking digital librarian... Read more
Notability 4.2 - Note-taking and annotat...
Notability is a powerful note-taker to annotate documents, sketch ideas, record lectures, take notes and more. It combines, typing, handwriting, audio recording, and photos so you can create notes... Read more
FoldersSynchronizer 5.0.1 - Synchronize...
FoldersSynchronizer is a popular and useful utility that synchronizes and backs-up files, folders, disks and boot disks. On each session you can apply special options like Timers, Multiple Folders,... Read more
Sketch 62 - Design app for UX/UI for iOS...
Sketch is an innovative and fresh look at vector drawing. Its intentionally minimalist design is based upon a drawing space of unlimited size and layers, free of palettes, panels, menus, windows, and... Read more

Latest Forum Discussions

See All

The Alliance update to Out There: Omega...
Out There is an old go-to recommendation for a lot of mobile stalwarts, but I could never really get into it. This sci-fi survival game that blended elements of interactive fiction and roguelike mechanics just felt a little off-balance and a little... | Read more »
Animal Fury Destination is an action-adv...
Animal Fury Destination is an action-adventure game from independent, Colombian developer Ignicion Games. It's a 3D action game where you'll play as various different characters as you embark on a quest to stop an evil crow sorcerer. [Read more] | Read more »
Shadowgun War Games Closed Beta Impressi...
Shadowgun: War Games is an upcoming free-to-play multiplayer shooter that’s essentially just an Overwatch knock-off. There are hero characters with special abilities, and you compete in 5-v-5 game modes where the goal is to use superior team... | Read more »
Slingsters is a physics-based puzzler fo...
Slingsters is a physics-based puzzle game where the aim is to collect various different monsters by flinging them from one side of a level to the other and into a box. It's also the first game from Nappy Cat and is available now for iOS and... | Read more »
Spiritwish's latest update sees the...
A sizeable update has hit Nexon's MMORPG Spiritwish today. It brings a new game mode, characters and there will also be a special event to celebrate the update with a firework display. [Read more] | Read more »
Maze Machina, a turn-based puzzler from...
The latest game from Arnold Rauers also known as Tiny Touch Tales is now available. You may be familiar with one of his many excellent titles such as Card Crawl, Enyo and Card Thief. His latest endeavour is called Maze Machina and you can grab it... | Read more »
Mario Kart Tour's Ice Tour races to...
Can you believe Mario Kart Tour is already on its 9th tour? The game only launched back in September, and since then it's become increasingly tricky to keep on top of the amount of new content Nintendo is pumping out. [Read more] | Read more »
Apple Arcade: Ranked - Top 50 [Updated 1...
In case you missed it, I am on a quest to rank every Apple Arcade game there is. [Read more] | Read more »
Marvel Future Fight's latest update...
Marvel Future Fight's latest update has added an all-new team of heroes to recruit and do battle with. The 'Warriors of the Sky' include Blue Dragon, War Tiger, Sun Bird, and Shadow Shell. As is the norm, each character comes with their own unique... | Read more »
Klee: Spacetime Cleaners is a fast-paced...
Klee: Spacetime Cleaners is a fast-paced auto-shooter that sports a cute retro aesthetic thathad racked up an impressive 100,000 pre-registers prior to its release. It's available now for both iOS and Android. [Read more] | Read more »

Price Scanner via MacPrices.net

Just in! Apple iMacs on sale for $100-$150 of...
B&H Photo has new 2019 21″ and 27″ 5K iMacs on stock today and on sale for up to $150 off Apple’s MSRP, with prices starting at only $999. These are the same iMacs sold by Apple in their retail... Read more
Save $100 on the 13″ 1.4GHz MacBook Pro at th...
Apple resellers have 13″ 1.4GHz MacBook Pros on sale today for $100 off Apple’s MSRP, and some are including free overnight delivery: (1) Amazon has new 2019 13″ 1.4GHz MacBook Pros on sale for $100... Read more
AT&T offers free 64GB Apple iPhone XS wit...
Open a new line of service with AT&T, and they will include a free 64GB iPhone XS. Credit for the phone is applied monthly over a 30 month lease. The fine print: “Limited Time Requires new line... Read more
New Verizon deal: Apple iPhone XR for $300 of...
Switch to Verizon and sign up with one of their Unlimited plans, and Verizon will take $300 off the price of an Apple iPhone XR (regularly $749), plus get a free $200 prepaid Mastercard. This is an... Read more
Amazon’s popular AirPods sale is back with mo...
Amazon has new 2019 Apple AirPods on sale today ranging up to $40 off MSRP, starting at $129, as part of their popular Apple AirPods sale. Shipping is free: – AirPods Pro: $234.98 $15 off MSRP –... Read more
Apple’s top of the line 10.5″ 256GB WiFi + Ce...
B&H Photo has the top of the line 10.5″ 256GB WiFi + Cellular iPad Air on sale for $599 shipped. That’s $180 off Apple’s MSRP for this model and the cheapest price available. Overnight shipping... Read more
Apple’s refurbished iPad Pros are the cheapes...
Apple has Certified Refurbished 11″ iPad Pros available on their online store for up to $220 off the cost of new models. Prices start at $679. Each iPad comes with a standard Apple one-year warranty... Read more
Just in: Take $100 off the price of the 3.0GH...
Apple resellers are offering new 2018 6-Core Mac minis for $100 off Apple’s MSRP today, only $999. B&H Photo has 6-Core Mac minis on sale for $100 off Apple’s standard MSRP. Overnight shipping is... Read more
Apple has 4-core and 6-core 2018 Mac minis av...
Apple has Certified Refurbished 2018 Mac minis available on their online store for $120-$170 off the cost of new models. Each mini comes with a new outer case plus a standard Apple one-year warranty... Read more
Amazon offers $200 discount on 13″ MacBook Ai...
Amazon has new 2019 13″ MacBook Airs with 256GB SSDs on sale for $200 off Apple’s MSRP, now only $1099, each including free shipping. Be sure to select Amazon as the seller during checkout, rather... Read more

Jobs Board

*Apple* Mobility Pro - Best Buy (United Stat...
**744429BR** **Job Title:** Apple Mobility Pro **Job Category:** Store Associates **Store NUmber or Department:** 000574-Garner-Store **Job Description:** At Best Read more
Geek Squad *Apple* Consultation Professiona...
**757963BR** **Job Title:** Geek Squad Apple Consultation Professional **Job Category:** Store Associates **Store NUmber or Department:** 000433-Henrietta-Store Read more
*Apple* Computing Professional - Best Buy (U...
**754611BR** **Job Title:** Apple Computing Professional **Job Category:** Store Associates **Store NUmber or Department:** 000142-Milpitas-Store **Job Read more
Best Buy *Apple* Computing Master - Best Bu...
**745058BR** **Job Title:** Best Buy Apple Computing Master **Job Category:** Store Associates **Store NUmber or Department:** 001080-Lake Charles-Store **Job Read more
Geek Squad *Apple* Consultation Professiona...
**756640BR** **Job Title:** Geek Squad Apple Consultation Professional **Job Category:** Store Associates **Store NUmber or Department:** 000484-Manchester-Store Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.