REBOL [
    Title: "View-Hanoi"
    Date: 4-Oct-2001
    Version: 1.0.0
    File: %view-hanoi.r
    Author: "Gregg Irwin"
    Purpose: {Towers of Hanoi with Visualization. A learning excercise for me. Hopefully it will improve over time.}
    Comment: {
        The core logic is modeled on an example in an old LISP book I have
        (Understanding LISP) by Paul Gloess. I get the blame for the
        visualization.

        You can change the number of disks!

        A long time ago I wanted to write a series of "Animated Algorithms"
        to help people visualize how they work. I guess I was just waiting
        for REBOL. :)
    }
    History: {
        * Added visualization
        * Changed _do-towers parameters to integers to ease animation calls.
    }
    Email: greggirwin@acm.org
    e-mail: greggirwin@acm.org
    TBD: {
        * Make code less fragile to changes
        * Get a better grip on dynamic layout and finding disk face to move
        * Speed control
        * Colored disks
        * Interactive version for humans to play
        * Clean up animation code. Simplify. Use move-offset?
        * Decide if I like the leading underscore convention.
        * Gack! Look at all the magic numbers!
        * Add reset button and number of disks to UI.
    }
    library: [
        level: 'intermediate 
        platform: none 
        type: [Demo Game] 
        domain: 'GUI 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]


hanoi: context [
    num-disks: 3    ; << Have to set this here for now, until it gets into the UI.
    disk-height: 15
    disk-cell-width: 20
    move-dist: 1    ; Move more than 1 pixel at a time? May throw disk centering off.
    wait-time: 0    ; .05 *Really* slow. Anything more would be painful.
                    ; You can also uncomment the print statements in the animcation
                    ; functions to slow things down.
    tower-height: disk-height * (num-disks + 2)
    tower-top: 50
    towers: num-moves: none

    move-offset: [
        up     0x-1
        down   0x1
        left  -1x0
        right  1x0
    ]
    ; To move faster, we can multiply our offsets.

    start: func [
        num-disks[integer!] "Number of disks to play with"
    ][
        tower-height: disk-height * (num-disks + 1)
        num-moves: 0
        towers: reduce [_make-disks num-disks copy [] copy []]
        print mold towers
        _do-towers num-disks 1 2 3
        print ["Number of moves required: " num-moves]
    ]

    _do-towers: func [
        num-disks[integer!] "Number of disks to move"
        source[integer!]    "Source tower"
        temp[integer!]      "Temporary holding tower"
        dest[integer!]      "Destination tower"
    ][
        if num-disks > 0 [
            _do-towers (num-disks - 1) source dest temp
            ; If you don't want to see the disks move, comment out the next line.
            _animate-disk-move source dest
            _move-disk towers/:source towers/:dest
            _do-towers (num-disks - 1) temp source dest
        ]
    ]

    _move-disk: func [
        source[any-block!]  "Source tower"
        dest[any-block!]    "Destination tower"
    ][
        num-moves: add num-moves 1
        append dest last source
        clear back tail source
        ;print mold towers
    ]

    _make-disks: func [
        num-disks [integer!] "Number of disks to put in a block"
        /local i result
    ][
        result: make block! num-disks
        for i num-disks 1 -1 [
            append result i
        ]
        return result
    ]

    _animate-disk-move: func [source dest /local disk-face face ct] [
        disk-face: none
        ct: 0
        ; There must be a better way, but I couldn't get it to dynamically
        ; look up the face by ID (e.g. D1, D2, etc.). This makes the code
        ; pretty fragile because it is dependent on the disk faces being
        ; in order.
        foreach face l/pane [
            if face/style = 'disk [
                ct: add ct 1
                if ct = last towers/:source [
                    disk-face: :face
                    break
                ]
            ]
        ]
        if object? disk-face [
            _animate-disk-up   disk-face
            _animate-disk-over disk-face source dest
            _animate-disk-down disk-face dest
        ]
    ]

    _animate-disk-up: func [disk-face] [
        while [(disk-face/offset/y + disk-face/size/y) >= tower-top] [
            ;print disk-face/offset/y
            disk-face/offset/y: subtract disk-face/offset/y move-dist
            show disk-face
            wait wait-time
        ]
    ]

    _animate-disk-down: func [disk-face dest /local dest-y] [
        dest-y: (tower-top + tower-height) - (((length? towers/:dest) - 1) * disk-height)
        while [(disk-face/offset/y + disk-face/size/y) < dest-y] [
            ;print disk-face/offset/y
            disk-face/offset/y: add disk-face/offset/y move-dist
            show disk-face
            wait wait-time
        ]
    ]

    _animate-disk-over: func [disk-face source dest /local dest-x comp op] [
        ; + 5 accounts for 1/2 tower width
        dest-x: (_tower-x-pos dest) + 5
        either source < dest [
            comp: :lesser?
            op:   :add
        ][
            comp: :greater?
            op:   :subtract
        ]
        while [comp (disk-face/offset/x + (disk-face/size/x / 2)) dest-x] [
            ;print disk-face/offset/x
            disk-face/offset/x: op disk-face/offset/x move-dist
            show disk-face
            wait wait-time
        ]
;         either source < dest [
;             while [(disk-face/offset/x + (disk-face/size/x / 2)) < dest-x] [
;                 ;print disk-face/offset/x
;                 disk-face/offset/x: add disk-face/offset/x move-dist
;                 show disk-face
;                 wait wait-time
;             ]
;         ][
;             while [(disk-face/offset/x + (disk-face/size/x / 2)) > dest-x] [
;                 ;print disk-face/offset/x
;                 disk-face/offset/x: subtract disk-face/offset/x move-dist
;                 show disk-face
;                 wait wait-time
;             ]
;         ]
    ]

    _tower-x-pos: func [index] [
        50 + (disk-cell-width * (num-disks + 1) * (index - 1)) + ((disk-cell-width * num-disks) / 2)
    ]

    _initial-disk-x-pos: func [index] [
        ; + 5 accounts for 1/2 tower width
        return ((_tower-x-pos 1) + 5) - ((disk-cell-width * index) / 2)
    ]

    _make-disk: func [num-cells /local color] [
        ; Gray disks
        reduce ['disk to-pair reduce compose [(disk-cell-width * num-cells) disk-height] 'effect [gradient 0x1 255.255.255 0.0.0]]
        ; Random color disks
        ;color: random 255.255.255
        ;reduce ['disk to-pair reduce compose [(disk-cell-width * num-cells) disk-height] 'effect compose [gradient 0x1 (color) (color - 100)]]
    ]

    lay: [
        size to-pair reduce compose [(disk-cell-width * (num-disks + 1) * 3 + 100) (tower-height + 100)]
        style tower box to-pair reduce [10 tower-height] effect [gradient 1x0 255.255.255 0.0.0]
        style disk  box
        across
        ; Towers and disks are added below.
    ]
    ; Add Towers
    repeat i 3 [
        ; Can't get this to work as a one-liner. I'm a dope.
        ;append lay [at reduce [to-pair reduce [tower-x-pos i 50]] tower]
        append lay [at]
        append lay reduce [to-pair reduce [_tower-x-pos i tower-top]]
        append lay [tower]
    ]
    ; Add Disks
    repeat i num-disks [
        append lay [at]
        append lay reduce compose [to-pair reduce [_initial-disk-x-pos i (tower-top + ((i + 1) * disk-height))]]
        append lay to-set-word join "D" i
        append lay (_make-disk i)
    ]
    ; Add buttons
    append lay [
        return
        button "go" [start num-disks]
        button "close" [quit]
    ]

    print ""
    view/options l: layout lay [resize]

]