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

Shadow Blade: Reload guide - How to hack...
Shadow Blade: Reload is the kind of action-platformer that would have happily sucked up hours of your time on a console a few years back.Now, you can take it with you wherever you go, and its mobile conversion is not too shabby at all. To help you... | Read more »
Tomb of the Mask guide - How to increase...
Tomb of the Mask is a great endless arcade game from Happymagenta in which quick reflexes and a persistent attitude can go a long way toward earning a top score. Check out these tips to see if you can give yourself an edge on the leaderboards. [... | Read more »
Smooth Operator! (Games)
Smooth Operator! 1.0 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0 (iTunes) Description: Smooth Operator is a weird, weird two-player kissing game. Squeeze in for 2 player fun on a single iPad, creating awkward... | Read more »
Sinless: Remastered (Games)
Sinless: Remastered 1.0 Device: iOS Universal Category: Games Price: $1.99, Version: 1.0 (iTunes) Description: | Read more »
_PRISM Guide - How to solve those puzzle...
_PRISM is a rather delightful puzzle game that’s been tailor made for touch screens. While part of the fun is figuring things out as you go along, we thought we’d offer you a helping hand at getting in the right mindset. Don’t worry about messing... | Read more »
Fractal Space (Games)
Fractal Space 1.3.1 Device: iOS Universal Category: Games Price: $.99, Version: 1.3.1 (iTunes) Description: Live the memorable experience of Fractal Space, a unique first person adventure & puzzle game by Haze Games! Will you... | Read more »
Set off on an adventure through the Cand...
Like match three puzzlers? If so, Jelly Blast, the innovative iOS and Android game which launched last year, is worth a look. Jelly Blast sees you head off on an epic adventure through the Candy Kingdom with your friends Lily, Mr. Hare, and Mr.... | Read more »
Ellipsis - Touch. Explore. Survive. (...
Ellipsis - Touch. Explore. Survive. 1.0 Device: iOS Universal Category: Games Price: $2.99, Version: 1.0 (iTunes) Description: | Read more »
Abzorb (Games)
Abzorb 1 Device: iOS Universal Category: Games Price: $2.99, Version: 1 (iTunes) Description: Abzorb is a tilt game about consuming orbs by getting as close as you can to them without touching. By tilting your mobile device, collect... | Read more »
A Short Tale (Games)
A Short Tale 1.0 Device: iOS Universal Category: Games Price: $3.99, Version: 1.0 (iTunes) Description: It’s been years since I lost Ben, so long yet it doesn’t seem long enough. I never thought I’d return here, to where everything... | Read more »

Price Scanner via MacPrices.net

cb Hardcase – Handmade and Premium Protective...
Baden-Baden, Germany based company cb innovations has introduced the new cb Hardcase for iPhone. Featuring fine Italian Premium leather that makes for a unique look and feel, the cb Hardcase... Read more
Sale! B&H Photo offers 12-inch Retina Mac...
B&H Photo has 12″ Retina MacBooks on sale for $300 off MSRP for a limited time. Shipping is free, and B&H charges NY tax only: - 12″ 1.1GHz Gray Retina MacBook: $999 $300 off MSRP - 12″ 1.... Read more
App Annie Reveals Future of the App Economy:...
App Annie, a San Francisco based mobile app data and insights platform, has launched its first comprehensive app economy forecast. This new offering will provide brands, agencies, investors and app... Read more
Apple restocks Certified Refurbished Mac mini...
Apple has restocked Certified Refurbished 2014 Mac minis, with models available starting at $419. Apple’s one-year warranty is included with each mini, and shipping is free: - 1.4GHz Mac mini: $419 $... Read more
What iPad Pro Still Needs To Make It Truly Pr...
I love my iPad Air 2. So much that I’m grudgingly willing to put up with its compromises and limitations as a production tool in order to take advantage of its virtues. However, since a computer for... Read more
21-inch 3.1GHz 4K on sale for $1399, $100 off...
B&H Photo has the 21″ 3.1GHz 4K iMac on sale $1399 for a limited time. Shipping is free, and B&H charges NY sales tax only. Their price is $100 off MSRP: - 21″ 3.1GHz 4K iMac (MK452LL/A): $... Read more
Apple price trackers, updated continuously
Scan our Apple Price Trackers for the latest information on sales, bundles, and availability on systems from Apple’s authorized internet/catalog resellers. We update the trackers continuously: - 15″... Read more
Save up to $240 with Apple Certified Refurbis...
Apple is now offering Certified Refurbished 12″ Retina MacBooks for up to $240 off the cost of new models. Apple will include a standard one-year warranty with each MacBook, and shipping is free. The... Read more
Apple refurbished 13-inch Retina MacBook Pros...
Apple has Certified Refurbished 13″ Retina MacBook Pros available for up to $270 off the cost of new models. An Apple one-year warranty is included with each model, and shipping is free: - 13″ 2.7GHz... Read more
Apple refurbished Time Capsules available for...
Apple has certified refurbished Time Capsules available for $120 off MSRP. Apple’s one-year warranty is included with each Time Capsule, and shipping is free: - 2TB Time Capsule: $179, $120 off - 3TB... Read more

Jobs Board

Lead Engineer *Apple* OSX & Hardware -...
Lead Engineer Apple OSX & Hardware **Job ID:** 3125919 **Full/Part\-Time:** Full\-time **Regular/Temporary:** Regular **Listed:** 2016\-02\-10 **Location:** Cary, Read more
*Apple* Mobile Master - Best Buy (United Sta...
Job Title Apple Mobile Master **Brand** Best Buy **Job Description** **What does a Best Buy Apple Mobile Master do?** At Best Buy, our mission is to leverage the Read more
Infrastructure Engineer - *Apple* /Mac - Rem...
…part of a team Requires proven problem solving skills Preferred Additional: Apple Certified System Administrator (ACSA) Apple Certified Technical Coordinator (ACTC) Read more
Lead Engineer - *Apple* OSX & Hardware...
Lead Engineer - Apple OSX & Hardware **Job ID:** 3125919 **Full/Part\-Time:** Full\-time **Regular/Temporary:** Regular **Listed:** 2016\-02\-10 **Location:** Cary, Read more
Simply Mac *Apple* Specialist- Service Repa...
Simply Mac is the largest premier retailer of Apple products in the nation. In order to support our growing customer base, we are currently looking for a driven Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.