Tower of Hanoi

fun3d.fsx

let countOfDisks = 10
 
let initialState = [for x in 1..countOfDisks do yield x], List.empty, List.empty 
 
let bottDiskSize = 4.
let cylHeight = 4.0
let diskSize size = size * bottDiskSize / float(countOfDisks)
let diskHeight = cylHeight / float(countOfDisks)
let diskPosition pos = pos * diskHeight
let cyl = 
    Fun.cylinder
    |> Fun.scale (0.2, cylHeight, 0.2)
    |> Fun.move (0.0, cylHeight / 2., 0.0 ) 
    |> Fun.color 0xffff00
 
let bottDisk = 
//    Fun.empty
    Fun.cylinder
    |> Fun.scale (bottDiskSize, 0.1, bottDiskSize)
    |> Fun.move (0.0, -0.05, 0.0) 
    |> Fun.color 0xff00ff
 
let disk pos size = 
    let size = float(size)
    Fun.cylinder
    |> Fun.scale (diskSize size, diskHeight, diskSize size)
    |> Fun.move (0.0, diskPosition pos + (diskHeight/2.), 0.0) 
 
let tower towerState position =  
    towerState
    |> List.rev
    |> List.mapi (fun i v -> float(i),v)
    |> List.fold (fun s (pos,size) -> s $ disk pos size ) (bottDisk $ cyl) 
    |> Fun.move (position, 0.0, 0.0)
 
let  renderState state =
     let tower1,tower2, tower3 = state
     let towers = tower tower1 (-bottDiskSize - 0.1) $
                  tower tower2 0. $
                  tower tower3 (bottDiskSize + 0.1)
     towers |> Fun.move (0.0, -cylHeight/2., 0.0)
 
renderState initialState 

hanoi.fsx

// Reference OpenTK library & functional DSL
#r "OpenTK.dll"
#r "OpenTK.GLControl.dll"
#load "functional3d.fs"
open System
open System.Drawing
open Functional3D

let countOfDisks = 10
type Disk = int
type Tower = Disk list
type State = Tower * Tower * Tower

let initialState : State = [for x in 1..countOfDisks do yield x], List.empty, List.empty 

let bottDiskSize = 4.
let cylHeight = 4.0
let diskSize size = size * bottDiskSize / float(countOfDisks)
let diskHeight = cylHeight / float(countOfDisks)
let diskPosition pos = pos * diskHeight
let cyl = 
    Fun.cylinder
    |> Fun.scale (0.2, 0.2, cylHeight)
    |> Fun.translate (0.0, 0.0, cylHeight / 2.) 
    |> Fun.color Color.Black

let bottDisk = 
//    Fun.empty
    Fun.cylinder
    |> Fun.scale (bottDiskSize, bottDiskSize, 0.1)
    |> Fun.translate (0.0, 0.0, - 0.05) 
    |> Fun.color Color.Red

let disk pos (size:Disk) = 
    let size = float(size)
    Fun.cylinder
    |> Fun.scale (diskSize size, diskSize size, diskHeight)
    |> Fun.translate (0.0, 0.0, diskPosition pos + (diskHeight/2.)) 

let tower (towerState:Tower) position =  
    towerState
    |> List.rev
    |> List.mapi (fun i v -> float(i),v)
    |> List.fold (fun s (pos,size) -> s $ disk pos size ) (bottDisk $ cyl) 
    |> Fun.translate (position, 0.0, 0.0)

let  renderState (state:State) =
     let tower1,tower2, tower3 = state
     let towers = tower tower1 (-bottDiskSize - 0.1) $
                  tower tower2 0. $
                  tower tower3 (bottDiskSize + 0.1)
     towers |> Fun.rotate (-90.0,0.0,0.0)
            |> Fun.translate (0.0, -cylHeight/2., 0.0)

//renderState initialState 

let rec move state fromT toT count = async{
        Fun.show (renderState state)
        do! Async.Sleep(1)
        let tower1,tower2, tower3 = state
        let towers = [|tower1; tower2; tower3|]
        if count = 0 then return state
        elif count = 1 then let h::t = towers.[fromT]
                            towers.[fromT] <- t
                            towers.[toT] <- h::towers.[toT] 
                            return! move (towers.[0],towers.[1],towers.[2]) 0 0 0
        else let transitT = if min fromT toT = 1 then 0
                            elif max fromT toT = 1 then 2
                            else 1
             let! state = move state fromT transitT (count - 1)
             let! state = move state fromT toT 1
             return! move state transitT toT (count - 1)
    }
async{
    do! Async.Sleep 20000
    let! _ = move initialState 0 2 countOfDisks
    return ()
} |> Async.StartImmediate