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

Latest Forum Discussions

See All

Top Mobile Game Discounts
Every day, we pick out a curated list of the best mobile discounts on the App Store and post them here. This list won't be comprehensive, but it every game on it is recommended. Feel free to check out the coverage we did on them in the links... | Read more »
Blue Archive heads for nature in New Yea...
Continuing the Blue Archive trend of releasing seasonal events to the Western version of the game nowhere near when they actually happened, the Cyber New Year March update has arrived. It brings with it a story centring around New Year, which it... | Read more »
Once Human conquers maths to be one hotl...
It feels like Once Human has been in development for about ten years at this point, but that has clearly not blunted the excitement for NetEases’ upcoming open-world survival game. As a matter of fact, it seems things have never been better, as... | Read more »
Watcher of Realms celebrates its first a...
It has been one year since Moonton Games kicked off the fantasy RPG Watcher of Realms, and there are a lot of celebrations to mark the occasion. You could take part in a brand-new mode, earn some skins, and recruit some of the strongest characters... | Read more »
Tarisland finally launches and celebrate...
It has felt like a lifetime, as it always does when it comes to waiting, but now Level Infinites’ anticipated MMORPG Tarisland is available across mobiles and Windows. It is time to pick your favourite of the nine classes, customise them to your... | Read more »
Reverse: 1999 offer Reality teams a mout...
Bluepoch Games has confirmed that Phase 2 of Reverse:1999s Version 1.6 has launched, and brings with it a lot to get your teeth into. Along with some sign-in rewards and a bunch of stories to enjoy, as well as a new 6-star character who just might... | Read more »
Uncharted Waters Origin unveils its late...
LINE Games, Motif, and KOEI Tecmo have announced the latest raft of updates for their seafaring adventure title Uncharted Waters Origin, and if you've played for a while you know what to expect. A new Admiral, new mates, and some new story, the... | Read more »
Wrecking Golf is a casual physics-based...
In case you missed it, Dusan Popovic has officially launched Wrecking Golf on iOS and Android, the indie developer's casual golf game on mobile presented with charming pixel-art visuals. Featuring physics-based mechanics and simple controls, the... | Read more »
Blue Archive is striking out to Anime Ex...
At this point in my writing career, I have seen quite a few press releases come about, and it feels like one of the most frequently updated games there is Blue Archive. It is, of course, great to see a game have a life like this, and now Nexon is... | Read more »
Grab a Grammy-inspired Backbone One with...
There are so many mobile controllers on the market that it could be a little difficult to know which to go for. If you are someone who goes for a good old celebrity endorsement, however, then the new Backbone One might be for you, created as it... | Read more »

Price Scanner via MacPrices.net

Walmart continues to sell clearance 13-inch M...
Walmart continues to offer clearance, but new, Apple 13″ M1 MacBook Airs (8GB RAM, 256GB SSD) online for $699, $300 off original MSRP, in Space Gray, Silver, and Gold colors. These are new MacBooks... Read more
Apple is offering steep discounts, up to $600...
Apple has standard-configuration 16″ M3 Max MacBook Pros available, Certified Refurbished, starting at $2969 and ranging up to $600 off MSRP. Each model features a new outer case, shipping is free,... Read more
Save up to $480 with these 14-inch M3 Pro/M3...
Apple has 14″ M3 Pro and M3 Max MacBook Pros in stock today and available, Certified Refurbished, starting at $1699 and ranging up to $480 off MSRP. Each model features a new outer case, shipping is... Read more
Amazon has clearance 9th-generation WiFi iPad...
Amazon has Apple’s 9th generation 10.2″ WiFi iPads on sale for $80-$100 off MSRP, starting only $249. Their prices are the lowest available for new iPads anywhere: – 10″ 64GB WiFi iPad (Space Gray or... Read more
Apple is offering a $50 discount on 2nd-gener...
Apple has Certified Refurbished White and Midnight HomePods available for $249, Certified Refurbished. That’s $50 off MSRP and the lowest price currently available for a full-size Apple HomePod today... Read more
The latest MacBook Pro sale at Amazon: 16-inc...
Amazon is offering instant discounts on 16″ M3 Pro and 16″ M3 Max MacBook Pros ranging up to $400 off MSRP as part of their early July 4th sale. Shipping is free. These are the lowest prices... Read more
14-inch M3 Pro MacBook Pros with 36GB of RAM...
B&H Photo has 14″ M3 Pro MacBook Pros with 36GB of RAM and 512GB or 1TB SSDs in stock today and on sale for $200 off Apple’s MSRP, each including free 1-2 day shipping: – 14″ M3 Pro MacBook Pro (... Read more
14-inch M3 MacBook Pros with 16GB of RAM on s...
B&H Photo has 14″ M3 MacBook Pros with 16GB of RAM and 512GB or 1TB SSDs in stock today and on sale for $150-$200 off Apple’s MSRP, each including free 1-2 day shipping: – 14″ M3 MacBook Pro (... Read more
Amazon is offering $170-$200 discounts on new...
Amazon is offering a $170-$200 discount on every configuration and color of Apple’s M3-powered 15″ MacBook Airs. Prices start at $1129 for models with 8GB of RAM and 256GB of storage: – 15″ M3... Read more
Amazon is offering a $200 discount on 14″ M3...
Amazon has 14-inch M3 MacBook Pros in stock and on sale for $150-$200 off MSRP. Shipping is free. Note that Amazon’s stock tends to come and go, so be sure to check their site often if the model you... Read more

Jobs Board

Solutions Engineer - *Apple* - SHI (United...
**Job Summary** An Apple Solution Engineer's primary role is tosupport SHI customers in their efforts to select, deploy, and manage Apple operating systems and Read more
*Apple* / Mac Administrator - JAMF Pro - Ame...
Amentum is seeking an ** Apple / Mac Administrator - JAMF Pro** to provide support with the Apple Ecosystem to include hardware and software to join our team and Read more
Operations Associate - *Apple* Blossom Mall...
Operations Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Read more
Cashier - *Apple* Blossom Mall - JCPenney (...
Cashier - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Blossom Mall Read more
Omnichannel Associate - *Apple* Blossom Mal...
Omnichannel Associate - Apple Blossom Mall Location:Winchester, VA, United States (https://jobs.jcp.com/jobs/location/191170/winchester-va-united-states) - Apple Read more
All contents are Copyright 1984-2011 by Xplain Corporation. All rights reserved. Theme designed by Icreon.