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

Apple Pro Video Formats 2.0.1 - Updates...
Apple Pro Video Formats brings updates to Apple's professional-level codes for Final Cut Pro X, Motion 5, and Compressor 4. Version 2.0.1: Support for the following professional video codecs Apple... Read more
Maya 2015 - Professional 3D modeling and...
Maya is an award-winning software and powerful, integrated 3D modeling, animation, visual effects, and rendering solution. Because Maya is based on an open architecture, all your work can be scripted... Read more
EtreCheck 2.2 - For troubleshooting your...
EtreCheck is a simple little app to display the important details of your system configuration and allow you to copy that information to the Clipboard. It is meant to be used with Apple Support... Read more
OmniOutliner Pro 4.2 - Pro version of th...
OmniOutliner Pro is a flexible program for creating, collecting, and organizing information. Give your creativity a kick start by using an application that's actually designed to help you think. It's... Read more
VLC Media Player 2.2.1 - Popular multime...
VLC Media Player is a highly portable multimedia player for various audio and video formats (MPEG-1, MPEG-2, MPEG-4, DivX, MP3, OGG, ...) as well as DVDs, VCDs, and various streaming protocols. It... Read more
Nisus Writer Pro 2.1.1 - Multilingual wo...
Nisus Writer Pro is a powerful multilingual word processor, similar to its entry level products, but brings new features such as table of contents, indexing, bookmarks, widow and orphan control,... Read more
Tinderbox 6.2.0 - Store and organize you...
Tinderbox is a personal content management assistant. It stores your notes, ideas, and plans. It can help you organize and understand them. And Tinderbox helps you share ideas through Web journals... Read more
OmniOutliner 4.2 - Organize your ideas,...
OmniOutliner is a flexible program for creating, collecting, and organizing information. Give your creativity a kick start by using an application that's actually designed to help you think. It's... Read more
calibre 2.25.0 - Complete e-library mana...
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
Things 2.5.4 - Elegant personal task man...
Things is a task management solution that helps to organize your tasks in an elegant and intuitive way. Things combines powerful features with simplicity through the use of tags and its intelligent... Read more

Lifeline... (Games)
Lifeline... 1.1 Device: iOS Universal Category: Games Price: $2.99, Version: 1.1 (iTunes) Description: Lifeline is a playable, branching story of survival against all odds. Using your iPhone, iPad, or Apple Watch, you will help... | Read more »
Pandemic: The Board Game Has Gone Univer...
Don't let the virus win! Now you can download Pandemic: The Board Game, by F2Z Digital Media, for all of your iOS devices. The app is based on the fantastic board game by Z-man games. As employees of the CDC, you and your friends will have to work... | Read more »
Get Ready to Read Bloomberg Business on...
Fans of Bloomberg Business will soon be able to get all their news on the Apple Watch. The app lets you get the top headlines on your main screen and bookmark stories to read later. Using the motion detection in the Apple Watch, the headlines are... | Read more »
Watch This Homerun is Batting for the Ap...
Eyes Wide Games' Watch This Homerun is purportedly the first sports game coming to the Apple Watch, where you'll be up to bat as the pitcher tries to out-manuever you with fastballs, curveballs, and changeups. Using one-touch controls you can try to... | Read more »
Field Trip Can Take You on a Guided Tour...
Field Trip, by Google’s Niantic Labs, is an exploration app that gives you details about the awesome places you can discover wherever you find yourself. The app can show you local history, delicious restraunts, the best places to shop, and places to... | Read more »
Watch Your Six - SPY_WATCH is Infiltrati...
SPY_WATCH, by Bossa Studios, is a new game designed for the Apple Watch. Runmor has it your spy agency has fallen out of favor. To save it, you'll need to train-up a spy and send them on missions to earn you a stunningly suspicious reputation and... | Read more »
Both Halo: Spartan Assault and Halo: Spa...
Halo: Spartan Assault and Halo: Spartan Strike, by Microsoft, have officially landed on the App Store. Spartan Assault pits you against the Covenant with missions geared to tell the story of the origin of Spartan Ops. In Spartan Strike you'll delve... | Read more »
The Apple Watch Could Revolutionize the...
It’s not here yet but there’s that developing sneaky feeling that the Apple Watch, despite its price tag and low battery life, might yet change quite a lot about how we conduct our lives. While I don’t think it’s going to be an overnight... | Read more »
Mad Skills Motocross 2 Version 2.0 is He...
Mad Skills Motocross 2 fans got some good news this week as Turborilla has given the game its biggest update yet. Now you'll have access to Versus mode where you can compete against your friends in timed challenges. Turborilla has implemented a... | Read more »
Kids Can Practice Healthy Living With Gr...
Bobaka is releasing a new interactive book called Green Riding Hood  in May. The app teaches kids about yoga and organic style of life through mini-games and a fun take on the classic Little Red Riding Hood fairy tale. | Read more »

Price Scanner via MacPrices.net

Sale! 15-inch Retina MacBook Pros for up to $...
 MacMall has 15″ Retina MacBook Pros on sale for up to $255 off MSRP. Shipping is free: - 15″ 2.2GHz Retina MacBook Pro: $1794.99 save $205 - 15″ 2.5GHz Retina MacBook Pro: $2244.99 save $255 Adorama... Read more
New 2015 MacBook Airs on sale for up to $75 o...
Save up to $75 on the purchase of a new 2015 13″ or 11″ 1.6GHz MacBook Air at the following resellers. Shipping is free with each model: 11" 128GB MSRP $899 11" 256GB... Read more
Clearance 13-inch Retina MacBook Pros availab...
B&H Photo has leftover 2014 13″ Retina MacBook Pros on sale for up to $250 off original MSRP. Shipping is free, and B&H charges NY sales tax only: - 13″ 2.6GHz/128GB Retina MacBook Pro: $1129... Read more
Clearance 2014 MacBook Airs available startin...
B&H Photo has clearance 2014 MacBook Airs available for up to $200 off original MSRP. Shipping is free, and B&H charges NY sales tax only: - 11″ 128GB MacBook Air: $729 $170 off original MSRP... Read more
16GB iPad mini 3 on sale for $349, save $50
B&H Photo has the 16GB iPad mini 3 WiFi on sale for $349 including free shipping plus NY sales tax only. Their price is $50 off MSRP, and it’s the lowest price available for this model. Read more
Mac minis on sale for up to $75 off, starting...
MacMall has Mac minis on sale for up to $75 off MSRP including free shipping. Their prices are the lowest available for these models from any reseller: - 1.4GHz Mac mini: $459.99 $40 off - 2.6GHz Mac... Read more
Taichi Temple First Tai Chi Motion Sensor App...
Zhen Wu LLC has announced the official launch of Taichi Temple 1.0, the first motion sensor app for Tai Chi, offering a revolutionary new way to de-compress, relax and exercise all at the same time.... Read more
CleanExit – Erase your Hard Drive Quickly, Se...
CleanExit works on both Macs and PCs, securely and permanently deleting all files from any type of hard drive, flash-based drive or camera media card making the files permanently unrecoverable.... Read more
250 iPhone 6 Tips eBook Released for $1.99
Bournemouth, UK based iOS Guides has released 250 iPhone 6 Tips, a new eBook available in the iBookstore that reveals a wealth of tips and tutorials for iPhone 6 and iPhone 6 Plus. Priced at $1.99,... Read more
TigerText Introduces First Secure Enterprise...
TigerText, a provider of secure, real-time messaging for the enterprise, has announced the launch of TigerText for the Apple Watch. TigerText for the Apple Watch enables users to securely send and... Read more

Jobs Board

*Apple* Solutions Consultant - Retail Sales...
**Job Summary** As an Apple Solutions Consultant (ASC) you are the link between our customers and our products. Your role is to drive the Apple business in a retail Read more
*Apple* Solutions Consultant - Retail Sales...
**Job Summary** As an Apple Solutions Consultant (ASC) you are the link between our customers and our products. Your role is to drive the Apple business in a retail Read more
DevOps Software Engineer - *Apple* Pay, iOS...
**Job Summary** Imagine what you could do here. At Apple , great ideas have a way of becoming great products, services, and customer experiences very quickly. Bring Read more
*Apple* Pay - Site Reliability Engineer - Ap...
**Job Summary** Imagine what you could do here. At Apple , great ideas have a way of becoming great products, services, and customer experiences very quickly. Bring Read more
Sr. Technical Services Consultant, *Apple*...
**Job Summary** Apple Professional Services (APS) has an opening for a senior technical position that contributes to Apple 's efforts for strategic and transactional Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.