diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..771cc57 --- /dev/null +++ b/.gitignore @@ -0,0 +1,113 @@ +# Build Folders (you can keep bin if you'd like, to store dlls and pdbs) +[Bb]in/ +[Oo]bj/ + +# mstest test results +TestResults + +## Ignore Visual Studio temporary files, build results, and +## files generated by popular Visual Studio add-ons. + +# User-specific files +*.suo +*.user +*.sln.docstates + +# Build results +[Dd]ebug/ +[Rr]elease/ +x64/ +*_i.c +*_p.c +*.ilk +*.meta +*.obj +*.pch +*.pdb +*.pgc +*.pgd +*.rsp +*.sbr +*.tlb +*.tli +*.tlh +*.tmp +*.log +*.vspscc +*.vssscc +*.dll +.builds + +# Visual C++ cache files +ipch/ +*.aps +*.ncb +*.opensdf +*.sdf + +# Visual Studio profiler +*.psess +*.vsp +*.vspx + +# Guidance Automation Toolkit +*.gpState + +# ReSharper is a .NET coding add-in +_ReSharper* + +# NCrunch +*.ncrunch* +.*crunch*.local.xml + +# Installshield output folder +[Ee]xpress + +# DocProject is a documentation generator add-in +DocProject/buildhelp/ +DocProject/Help/*.HxT +DocProject/Help/*.HxC +DocProject/Help/*.hhc +DocProject/Help/*.hhk +DocProject/Help/*.hhp +DocProject/Help/Html2 +DocProject/Help/html + +# Click-Once directory +publish + +# Publish Web Output +*.Publish.xml + +# NuGet Packages Directory +packages + +# Windows Azure Build Output +csx +*.build.csdef + +# Windows Store app package directory +AppPackages/ + +# Others +[Bb]in +[Oo]bj +sql +TestResults +[Tt]est[Rr]esult* +*.Cache +ClientBin +[Ss]tyle[Cc]op.* +~$* +*.dbmdl +Generated_Code #added for RIA/Silverlight projects + +# Backup & report files from converting an old project file to a newer +# Visual Studio version. Backup files are not needed, because we have git ;-) +_UpgradeReport_Files/ +Backup*/ +UpgradeLog*.XML +Samples/References/FMath.Excel.XML +Samples/References/Microsoft.Office.Interop.Excel.xml +Samples/References/office.xml +Samples/Samples.v2.zip diff --git a/Excel/README.md b/Excel/README.md deleted file mode 100644 index 04e3b6c..0000000 --- a/Excel/README.md +++ /dev/null @@ -1,30 +0,0 @@ -## Excel Examples - -####Prerequisites -VSTO Runtime for Excel - -`e.g. VSTO 2010 http://www.microsoft.com/en-gb/download/details.aspx?id=35594` - -####To install Tsunami for Excel - -Load the VSTO file at `C:\Program Files (x86)\Tsunami\ExcelFSharp.vsto` - - -####To execute - -Ribbon -> View -> F# -> Tsunami - -####Note - -Currently Tsunami is loads when Excel loads and adds a noticeable lag to opening Excel. In the future this lag will be delayed to the first time Tsunami is invoked within Excel. - -##Excel Charting - -##Excel F# UDFs -####Prerequisite -[F# PowerPack](http://fsharppowerpack.codeplex.com/) - -####Scripts -The script `StringToUdf.fsx` demonstrates the process for creating UDFs using inline strings. - -The script `ShellToUdf.fsx` demonstrates the process for creating UDFs using the in memory Shell.fsx and the Ribbon to invoke compilation and reload. \ No newline at end of file diff --git a/Excel/ShellToUdf.fsx b/Excel/ShellToUdf.fsx deleted file mode 100644 index 6f01302..0000000 --- a/Excel/ShellToUdf.fsx +++ /dev/null @@ -1,97 +0,0 @@ -(* - INSTRUCTIONS - - Run this script in Tsunami embedded in Excel - Clear the script and add the UDF code, e.g. - - """namespace FCellDemo - module MyUDF = - let fAdd2 x y = x + y + 2.""" - - Compile by clicking on Ribbon -> Excel -> Common -> Compile button - - Run the UDF function in an Excel cell, e.g. "=fadd2(1,2)" - -*) - -#r "Tsunami.IDEDesktop.exe" -#r "WindowsBase.dll" -#r "PresentationFramework.dll" -#r "PresentationCore.dll" -#r "Telerik.Windows.Controls.dll" -#r "Telerik.Windows.Controls.Navigation.dll" -#r "Telerik.Windows.Controls.Docking.dll" -#r "Telerik.Windows.Controls.RibbonView.dll" -#r "ActiproSoftware.SyntaxEditor.Wpf.dll" -#r "System.Xaml.dll" -#r "ActiproSoftware.Shared.Wpf.dll" -#r "ActiproSoftware.Text.Wpf.dll" -#r "ActiproUtilities.dll" -#r "FSharp.Compiler.dll" - -#r @"C:\Program Files (x86)\FSharpPowerPack-4.0.0.0\bin\FSharp.Compiler.CodeDom.dll" -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Microsoft.Office.Interop.Excel.dll" -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Office.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.Rtd.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\log4net.dll" - - -open Tsunami.IDE -open Tsunami.Utilities -open System -open System.Windows -open System.Windows.Controls -open ActiproSoftware.Windows.Controls -open Telerik.Windows.Controls -open Telerik.Windows.Controls.RibbonView -open Tsunami.CC.SourceServices -open Tsunami.FS.FileSystem -open Microsoft.Office.Interop.Excel -open System.Runtime.InteropServices -open System.CodeDom.Compiler -open Microsoft.FSharp.Compiler.CodeDom -open Microsoft.FSharp.Control - - -let ui = Threading.DispatcherSynchronizationContext(Tsunami.IDE.UI.Instances.ApplicationMenu.Dispatcher) - -let compile() = - let ui = Threading.DispatcherSynchronizationContext(Tsunami.IDE.UI.Instances.ApplicationMenu.Dispatcher) - let reloadFcell() = - let xllPath = @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.xll" - let app = Marshal.GetActiveObject("Excel.Application"):?> Microsoft.Office.Interop.Excel.Application - app.RegisterXLL(xllPath) |> ignore - - async { - do! Async.SwitchToContext ui - let rawCode = Tsunami.FS.FileSystem.fileSystem.ReadAllText("ms:Shell.fsx") - let codeArr = rawCode.Split([|"\n"|], StringSplitOptions.RemoveEmptyEntries) - |> Array.filter (fun s -> not (s.Contains("#r"))) - let code = String.Join("\r\n", codeArr) - let provider = new FSharpCodeProvider() - let output = @"C:\Program Files (x86)\Statfactory\FCell 1.0\FSharpUdfs.dll" - let opt = new CompilerParameters([|"System.dll";@"C:\Program Files (x86)\Statfactory\FCell 1.0\log4net.dll";@"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.dll";@"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.Rtd.dll";@"C:\Program Files (x86)\Reference Assemblies\Microsoft\FSharp\3.0\Runtime\v4.0\FSharp.Core.dll"|], output) - let res = provider.CompileAssemblyFromSource(opt, code) - if res.Errors.Count = 0 then - try - reloadFcell() - with - | e -> MessageBox.Show(e.Message) |> ignore - else - MessageBox.Show(res.Errors.Item(0).ErrorText) |> ignore - - } |> Async.Start - -async { - do! Async.SwitchToContext ui - let button = RadRibbonButton(Text = "Compile", Size = ButtonSize.Large) - button.Click.Add(fun _ -> compile()) - let excelTab = - [| - [| button |] - |> addItems (RadRibbonGroup(Header = "Common")) - |] |> addItems (RadRibbonTab(Header = "Excel")) - Tsunami.IDE.UI.Instances.RibbonView.Items.Add(excelTab) |> ignore - -} |> Async.RunSynchronously \ No newline at end of file diff --git a/Excel/StringToUdf.fsx b/Excel/StringToUdf.fsx deleted file mode 100644 index 863d089..0000000 --- a/Excel/StringToUdf.fsx +++ /dev/null @@ -1,46 +0,0 @@ -#r @"C:\Program Files (x86)\FSharpPowerPack-4.0.0.0\bin\FSharp.Compiler.CodeDom.dll" -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Microsoft.Office.Interop.Excel.dll" -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Office.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.Rtd.dll" -#r @"C:\Program Files (x86)\Statfactory\FCell 1.0\log4net.dll" - -open System -open System.Windows -open Microsoft.Office.Interop.Excel -open System.Runtime.InteropServices -open System.CodeDom.Compiler -open Microsoft.FSharp.Compiler.CodeDom -open Microsoft.FSharp.Control - -let rawCode = """namespace FCellDemo -module MyUDF = - let fAdd2 x y = x + y + 2. -""" - -let code = String.Join("\r\n", rawCode.Split([|"\n"|], StringSplitOptions.RemoveEmptyEntries)) -let provider = new FSharpCodeProvider() -let output = @"C:\Program Files (x86)\Statfactory\FCell 1.0\FSharpUdfs.dll" - -let opt = new CompilerParameters( - [| - "System.dll"; - @"C:\Program Files (x86)\Statfactory\FCell 1.0\log4net.dll"; - @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.dll"; - @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.ManagedXll.Rtd.dll"; - @"C:\Program Files (x86)\Statfactory\FCell 1.0\FSharp.Core.dll"|], output) - -let res = provider.CompileAssemblyFromSource(opt, code) - -if res.Errors.Count = 0 then - try - let xllPath = @"C:\Program Files (x86)\Statfactory\FCell 1.0\FCell.xll" - let app = Marshal.GetActiveObject("Excel.Application"):?> Microsoft.Office.Interop.Excel.Application - app.RegisterXLL(xllPath) |> ignore - with - | e -> printfn "%s" e.Message -else - printfn "%s" (res.Errors.Item(0).ErrorText) - - - \ No newline at end of file diff --git a/General/Charts.fsx b/General/Charts.fsx deleted file mode 100644 index f86ada6..0000000 --- a/General/Charts.fsx +++ /dev/null @@ -1,99 +0,0 @@ -#I @"C:\Program Files\Tsunami\" -#r "WindowsBase.dll" -#r "PresentationFramework.dll" -#r "PresentationCore.dll" -#r "System.Xaml.dll" -#r "Telerik.Windows.Data.dll" -#r "Telerik.Windows.Controls.dll" -#r "Telerik.Windows.Controls.Charting.dll" -#r "ActiproSoftware.SyntaxEditor.Wpf.dll" -#r "ActiproSoftware.Shared.Wpf.dll" -#r "ActiproSoftware.Docking.Wpf.dll" -#r "ActiproSoftware.Ribbon.Wpf.dll" -#r "ActiproSoftware.DataGrid.Contrib.Wpf.dll" -#r "Tsunami.IDEDesktop.exe" - -open System -open System.Windows -open Telerik.Windows.Controls -open Telerik.Windows.Controls.Charting -open Tsunami.IDE - -let ui = Threading.DispatcherSynchronizationContext UI.Instances.ApplicationMenu.Dispatcher - -let chart = - async { - do! Async.SwitchToContext ui - let chart = RadChart() - UI.Instances.VisualizationPane.Dock() - UI.Instances.VisualizationPane.Content <- chart - return chart - } |> Async.RunSynchronously - -type Candle = - struct - val date : DateTime - val high : float - val low : float - val ``open`` : float - val ``close`` : float - new(d: DateTime, h: float, l: float, o: float, c: float) = - { - date = d - high = h - low = l - ``open`` = o - ``close`` = c - } - end - -module Chart = - let lines (xss:(string*float[])[]) = - async { - do! Async.SwitchToContext ui - for (name,data) in xss do - let lineSeries = DataSeries(LegendLabel = name, Definition = new LineSeriesDefinition()) - lineSeries.Definition.Appearance.PointMark.Fill <- System.Windows.Media.Brushes.Transparent - lineSeries.Definition.Appearance.PointMark.Stroke <- System.Windows.Media.Brushes.Transparent - lineSeries.Definition.ShowItemLabels <- false - for x in data do - lineSeries.Add(DataPoint(x)) - chart.DefaultView.ChartArea.DataSeries.Add(lineSeries) - } |> Async.RunSynchronously - - let clear() = - async { - do! Async.SwitchToContext ui - chart.DefaultView.ChartArea.DataSeries.Clear() - } |> Async.RunSynchronously - - let candleStick (name:string, xs:Candle[]) = - async { - do! Async.SwitchToContext ui - chart.DefaultView.ChartArea.AxisX.IsDateTime <- true - chart.DefaultView.ChartArea.AxisX.LayoutMode <- AxisLayoutMode.Inside - chart.DefaultView.ChartArea.AxisX.LabelRotationAngle <- 45. - chart.DefaultView.ChartArea.AxisX.DefaultLabelFormat <- "dd-MMM" - - let candleStickSeries = DataSeries(LegendLabel = name, Definition = new CandleStickSeriesDefinition()) - candleStickSeries.AddRange(xs |> Array.map (fun x -> DataPoint(High = x.high, Low = x.low, Open = x.``open``, Close = x.close, XValue = x.date.ToOADate()))) - chart.DefaultView.ChartArea.DataSeries.Add(candleStickSeries) - } |> Async.RunSynchronously - -let random = new System.Random() -let randomWalk() = [|0..20|] |> Array.scan (fun state _ -> state + random.NextDouble() * 2. - 1.) 0. -let randomWalks = [| for i in 0..5 -> ("Random Walk " + string i, randomWalk()) |] - -Chart.lines randomWalks - -Chart.clear() - -[| - let now = DateTime.Now - for i in 0..20 -> - let o = random.NextDouble() - let c = random.NextDouble() - let h = (max o c) + random.NextDouble() / 4. - let l = (min o c) - random.NextDouble() / 4. - Candle(now.AddDays(float i),h,l,o,c) -|] |> fun xs -> Chart.candleStick("ASX200",xs) \ No newline at end of file diff --git a/General/EditRibbon.fsx b/General/EditRibbon.fsx deleted file mode 100644 index c5d2a6a..0000000 --- a/General/EditRibbon.fsx +++ /dev/null @@ -1,30 +0,0 @@ -#r "Tsunami.IDEDesktop.exe" -#r "WindowsBase.dll" -#r "PresentationFramework.dll" -#r "PresentationCore.dll" -#r "Telerik.Windows.Controls.dll" -#r "ActiproSoftware.Shared.Wpf.dll" -#r "ActiproSoftware.SyntaxEditor.Wpf.dll" -#r "ActiproSoftware.Docking.Wpf.dll" -#r "ActiproSoftware.Ribbon.Wpf.dll" -#r "ActiproSoftware.DataGrid.Contrib.Wpf.dll" -#r "System.Xaml.dll" - -open System.Windows -open System.Windows.Controls -open ActiproSoftware.Windows.Controls.Ribbon -open Tsunami.IDE - -let ui = Threading.DispatcherSynchronizationContext(UI.Instances.ApplicationMenu.Dispatcher) - -async { - do! Async.SwitchToContext ui - let button = Button(Width = 70.) - button.Content <- "Run" - button.Click.Add(fun _ -> MessageBox.Show("Hello world") |> ignore) - let tab = Controls.Tab(Label = "Tab") - let group = Controls.Group(Label = "Group") - group.ItemsSource <- [|button|] - tab.Items.Add group - UI.Instances.RibbonView.Tabs.Add tab -} |> Async.RunSynchronously \ No newline at end of file diff --git a/Licence.txt b/Licence.txt deleted file mode 100644 index 497413b..0000000 --- a/Licence.txt +++ /dev/null @@ -1,24 +0,0 @@ -Copyright (c) 2013, Earthquake Enterprises -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - * Neither the name of the nor the - names of its contributors may be used to endorse or promote products - derived from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL Earthquake Enterprises BE LIABLE FOR ANY -DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/README.md b/README.md index 63c2a5d..4378770 100644 --- a/README.md +++ b/README.md @@ -1,9 +1,2 @@ -#Welcome to Tsunami’s public repo. -###We’re using GitHub and StackOverflow to engage directly with developers. -####Questions / Issue Tracking: -* Public Q&A [StackOverflow](http://stackoverflow.com/questions/tagged/tsunami) -* Public enquiries to us [GitHub](https://github.com/Tsunami-ide/public/issues) -* Private enquiries to us at cases@tsunami.fogbugz.com - -###Example Code / SDK: -We provide code here to help users make the most out their experience using Tsunami. The licence for the code in this repository is *3-clase BSD* so you are free to use it in your own work. +Samples +======= diff --git a/Samples/3D/geometry.fsx b/Samples/3D/geometry.fsx new file mode 100644 index 0000000..0dfe61e --- /dev/null +++ b/Samples/3D/geometry.fsx @@ -0,0 +1,493 @@ +(* NOTE: Run in a seperate FSI Shell *) +#load "shared.fsx" +#r "WindowsBase" +#r "PresentationCore" +#r "PresentationFramework" +#r "System.Windows.Presentation" +#r "System.Xaml" + +open Shared +open System +open System.Collections.Generic +open System.IO +open System.Text +open System.Windows +open System.Windows.Shapes +open System.Windows.Controls +open System.Windows.Markup +open System.Windows.Input +open System.Windows.Media +open System.Windows.Media.Media3D +open System.Windows.Media.Imaging +open System.Windows.Threading +open System.Xml +open System.Diagnostics +open System.Threading +open System.Xaml +open Vector3D +open Matrix3D + +(* Helper functions *) +module Random = + let rand = new System.Random() + let int n = rand.Next(n) + let float x = x * rand.NextDouble() + + +(* 3D Primatives *) +module Shapes3D = + + /// Creats a two dimentional mesh from 2 parametric functions and 2 counters + let one_d ps f1 count1 = [|for i in 0 .. count1 -> f1 i ps |] + let two_d f1 count1 f2 count2 = [|for i in 0 .. count2 -> f2 i [|for j in 0 .. count1 -> f1 j |] |] + + /// Mesh3D Matrix Transform + let mesh3DTransform (m:Matrix3D) (m3d:MeshGeometry3D) = + let points = Point3DCollection() + for i in 0 .. m3d.Positions.Count - 1 do + points.Add(m.Transform(m3d.Positions.[i])) + let normals = Vector3DCollection() + for i in 0 .. m3d.Normals.Count - 1 do + normals.Add(m.Transform(m3d.Normals.[i])) + m3d.Positions <- points + m3d.Normals <- normals + m3d + + /// Builds a mesh out of a 2d point retangular array + let createHardMesh (mesh:Point3D array array) l w = + let length = l + 1 + let width = w + 1 + let positions, triangles = Point3DCollection(), Int32Collection() + + let addTriangle a b c = + let p = positions.Count + positions.Add(a) + triangles.Add(p + 2) + positions.Add(b) + triangles.Add(p+1) + positions.Add(c) + triangles.Add(p) + + let addSquare a b c d = + addTriangle a b c + addTriangle c d a + + for i in 0 .. width - 2 do + for j in 0 .. length - 2 do + addSquare mesh.[i].[j] mesh.[i].[j+1] mesh.[i+1].[j+1] mesh.[i+1].[j] + + MeshGeometry3D(Positions = positions, TriangleIndices = triangles) + + // Shared normals -> softer + let createSoftMesh (mesh:Point3D array array) l w = + let length = l + 1 + let width = w + 1 + let points = Point3DCollection() + for i in 0 .. width - 1 do + for j in 0 .. length - 1 do + points.Add(mesh.[i].[j]) + + // TextureCoords - equal distribution + let textureCoords = PointCollection() + for i in 0 .. width - 1 do + for j in 0 .. length - 1 do + textureCoords.Add(Point(float i/ float (width - 1), float j / float (length - 1))) + + // TriangleIndices + let indices = Media.Int32Collection() // add 3 times for each triangle + for i in 0 .. width - 2 do + for j in 0 .. length - 2 do + let a = i * length + j + let b = i * length + j + 1 + let c = (i + 1) * length + j + 1 + let d = (i + 1) * length + j + // add first triangle + indices.Add(a) + indices.Add(b) + indices.Add(c) + // add second triangle + indices.Add(a) + indices.Add(c) + indices.Add(d) + // Return a new mesh geometry + MeshGeometry3D(Positions = points, TextureCoordinates = textureCoords, TriangleIndices = indices) + + /// cone, horizontal count, rotational count + let cylinder h r = + let f1 = fun i -> + let x = float i / float h + Point3D(x,0.5,0.) // straight line + let f2 = fun i ps -> + let m = rotate (Quaternion(XAxis, ((float i / float r) * 360.))) + ps |> Array.map (fun (p:Point3D) -> m.Transform(p)) + let mesh = createSoftMesh (two_d f1 h f2 r) h r + let normals = Vector3DCollection() + for p in mesh.Positions do + normals.Add(Point3D(p.X,0.,0.) - p) + mesh.Normals <- normals + mesh + + let cone h r = + let f1 = fun i -> + let x = float i / float h + Point3D(x,1.0 - x,0.) // decending line + let f2 = fun i ps -> + let m = rotate (Quaternion(XAxis, ((float i / float r) * 360.))) + ps |> Array.map (fun (p:Point3D) -> m.Transform(p)) + createSoftMesh (two_d f1 h f2 r) h r + + + let circle h r = + let f1 = fun i -> + let x = float i / float h + Point3D(x,0.,0.) // straight line + let f2 = fun i ps -> + let m = rotate (Quaternion(YAxis, ((float i / float r) * 360.))) + ps |> Array.map (fun (p:Point3D) -> m.Transform(p)) + createSoftMesh (two_d f1 h f2 r) h r + + + /// helix + let helix coils height tes = + let f1 = fun i -> + let t = float i / float tes + Point3D(cos(2.*Math.PI* coils * t),sin(2.*Math.PI* coils * t),t * height) // straight line + let f2 = fun i ps -> + if i = 0 then + ps + else + ps |> Array.map (fun (p:Point3D) -> Point3D(0.,0.,p.Z)) + createSoftMesh (two_d f1 tes f2 2) tes 2 + + + /// Square with one texture for all 6 sides + let sphere t = + // rotate a semicircle around the x axis + let f1 = fun i -> + let x = float i / float t - 0.5 + let theta = x * Math.PI + Point3D(sin(theta), cos(theta),0.0) + + let f2 = fun i ps -> + let m = rotate (Quaternion(XAxis,((float i / float t) * 360.))) + ps |> Array.map (fun (p:Point3D) -> m.Transform(p)) + let mesh = createSoftMesh (two_d f1 t f2 t) t t + // manually specify normals + let normals = Vector3DCollection() + let c = Point3D(0.,0.,0.) + for p in mesh.Positions do + normals.Add(p - c) + mesh.Normals <- normals + mesh + + let inverse_sphere() t = + // rotate a semicircle around the x axis + let f1 = fun i -> + let x = float i / float t - 0.5 + let theta = x * Math.PI + Point3D(sin(theta), cos(theta),0.0) + + let f2 = fun i ps -> + let m = rotate (Quaternion(XAxis,((float i / float t) * 360. * -1.))) + ps |> Array.map (fun (p:Point3D) -> m.Transform(p)) + + let mesh = createSoftMesh (two_d f1 t f2 t) t t + // manually specify normals + let normals = Vector3DCollection() + let c = Point3D(0.,0.,0.) + for p in mesh.Positions do + normals.Add(c - p) + mesh.Normals <- normals + mesh + +module Geometry3D = + /// merge geometries + let private mergeGeom (g1:MeshGeometry3D) (g2:MeshGeometry3D) = + // create a new geometry with all the triangles/positions + let positions, textures, triangles, normals = Point3DCollection(), PointCollection(), Int32Collection(), Vector3DCollection() + // add g1 + for p in g1.Positions do positions.Add(p) + for t in g1.TextureCoordinates do textures.Add(t) + for t in g1.TriangleIndices do triangles.Add(t) + for n in g1.Normals do normals.Add(n) + // add g2 + for p in g2.Positions do positions.Add(p) + for t in g2.TextureCoordinates do textures.Add(t) + for t in g2.TriangleIndices do triangles.Add(t + g1.Positions.Count) + for n in g2.Normals do normals.Add(n) + // should eliminate non visible triangles + MeshGeometry3D(Positions = positions, TextureCoordinates = textures, TriangleIndices = triangles, Normals = normals) + + /// concave fill - clockwise (asumption) points depicting a shape + let private convexFill (ps:Point3D array) = + // setup positions, triangles, normals + let positions, triangles = Point3DCollection(), Int32Collection() + // Add the points to the array + ps |> Array.iter (fun p -> + positions.Add(p) + ) + // Add the triangles + for i in 0 .. ps.Length - 1 do + triangles.Add(0) + triangles.Add(i) + triangles.Add(i + 1) + MeshGeometry3D(Positions = positions, TriangleIndices = triangles) + + /// convert the convex array of points into an array of concave points + let private concaveFill(psa:Point3D array) = + let ps = Array.toList psa + let positions, triangles = Point3DCollection(), Int32Collection() + // function for finding out the direction of the turn + let turnRight a b c = (Vector3D.CrossProduct(b - a, c - a)).Z < 0. + // function for finding out if a point is in the triangle abc + let dinabc (a:Point3D) (b:Point3D) (c:Point3D) (d:Point3D) = // false + let dot a b c = Vector3D.DotProduct(b-a,c-a) + let acute a b c = (dot a b c) < 0. + // point maps to inside the triangle if + (acute a b d) && (acute b c d) && (acute c a d) && (acute a c d) && (acute c b d) && (acute b a d) + + let right_left = ref 0 + for i in 0 .. psa.Length - 3 do + let a,b,c = psa.[i],psa.[i+1],psa.[i+2] + if turnRight a b c then + right_left := !right_left + 1 + else + right_left := !right_left - 1 + + let turnCorrect a b c = + if !right_left > 0 + then turnRight a b c + else turnRight a b c |> not + + let tc = ref 0 // traingle counter + let skipCount = ref 0// the number of triangles skipped, if skipCount = list.Count then reverse list and try again + let rec getTriangles (ps:Point3D list) = + match ps with + | [a;b;c] -> // Add the triangle + positions.Add(a) + triangles.Add(!tc*3) + positions.Add(b) + triangles.Add(!tc*3 + 1) + positions.Add(c) + triangles.Add(!tc*3 + 2) + tc := !tc + 1 + | a::b::c::tail -> + if turnCorrect a b c then + if List.exists (fun d -> dinabc a b c d) tail then + // there exists a point in this triangle, don't remove, move on + getTriangles (b::c::tail@[a]) + //printf "%A" ps + else + // found a triangle to remove + getTriangles [a;b;c] + // continune without b + getTriangles (a::c::tail) + else + // move on + if !skipCount = tail.Length + 3 then + List.rev (b::c::tail@[a]) |> getTriangles + else + skipCount := !skipCount + 1 + getTriangles (b::c::tail@[a]) + | [] -> () + | [_] -> () + | [_;_] -> () + + getTriangles ps + MeshGeometry3D(Positions = positions, TriangleIndices = triangles) + + type Primitive3D = + | Point of Point3D + | Line of Point3D * Point3D + | Shape of Point3D array + | Geometry of MeshGeometry3D + with + member this.Reverse() = + match this with + | Point _ -> this + | Line (p1,p2) -> (p2,p1) |> Line + | Shape ps -> Array.rev ps |> Shape + | Geometry g -> + // reverse the triangle indicies + let triangles = Int32Collection() + for i in 0 .. 3 .. g.TriangleIndices.Count do + triangles.Add(g.TriangleIndices.[i + 2]) + triangles.Add(g.TriangleIndices.[i + 1]) + triangles.Add(g.TriangleIndices.[i]) + g.TriangleIndices <- triangles + g |> Geometry + + member this.Points() = + match this with + | Point p -> [|p|] + | Line (p1,p2) -> [|p1;p2|] + | Shape ps -> ps + | Geometry g -> [| for i in 0 .. (g.Positions.Count - 1) -> g.Positions.[i] |] + + member this.Transform(m:Matrix3D) = + match this with + | Point p -> Point(m.Transform(p)) + | Line (p1,p2) -> Line(m.Transform(p1),m.Transform(p2)) + | Shape ps -> Array.map (fun (p:Point3D) -> m.Transform(p)) ps |> Shape + | Geometry g -> + let positions = Point3DCollection() + for i in 0.. g.Positions.Count - 1 do + positions.Add(m.Transform(g.Positions.[i])) + g.Positions <- positions + Geometry(g) + + member this.AsGeomteryMesh() = + /// upgrade to a geometric object + let rec getMesh p = + // width + let width = 0.05 // 1/20 + match p with + | Point p -> + Shapes3D.sphere 30 + |> Shapes3D.mesh3DTransform ( (Matrix3D.translate(Vector3D(p.X,p.Y,p.Z)) * (Matrix3D.scale (Vector3D(width,width,width))) )) + | Line (p1,p2) -> + let v = p2 - p1 + let v1 = + v.Normalize() + let mutable tmp = Vector3D.CrossProduct(Vector3D(1.,0.,0.), v) + if tmp.LengthSquared < 0.01 then + tmp <- Vector3D.CrossProduct(Vector3D(0.,1.,0.), v) + if tmp.LengthSquared < 0.01 then + tmp <- Vector3D.CrossProduct(Vector3D(0.,0.,1.), v) + tmp.Normalize() + tmp * width + let v2 = + let tmp = Vector3D.CrossProduct(v,v1) + tmp.Normalize() + tmp * width + let vc = -(v1 + v2) / 2. + // get the sphere at the first end + //let sph = Shapes3D.sphere() 15 + //sph |> Shapes3D.mesh3DTransform ( (Math3D.tran_point p1.X p1.Y p1.Z) * (Math3D.scale_point width width width) |> Math3D.Matrix3D) + //sph |> mergeGeom + + Line(p1,p2) + .Transform(translate vc) + .Extrude(v2) + .Extrude(v1) + .AsGeomteryMesh() + | Shape ps -> concaveFill ps + | Geometry g -> g + getMesh this + member this.AsModelVisual(material:Material) = ModelVisual3D(Content = GeometryModel3D(Geometry = this.AsGeomteryMesh(), BackMaterial = material, Material = material)) + member this.AsPoints() = + match this with + | Point p -> [|Point(p)|] + | Line (p1,p2) -> [|Point(p1);Point(p2)|] + | Shape ps -> Array.map (fun p -> Point(p)) ps + | Geometry g -> [| for i in 0 .. (g.Positions.Count - 1) -> Point(g.Positions.[i]) |] + + member this.AsLines() = + match this with + | Point p -> [||] + | Line (p1,p2) -> [|Line(p1,p2)|] + | Shape ps -> Array.append [| for i in 0 .. ps.Length - 2 -> Line(ps.[i], ps.[i+1]) |] [|Line(ps.[ps.Length-1],ps.[0])|] + | Geometry g -> + [| for i in 0 .. g.TriangleIndices.Count - 2 -> + Line(g.Positions.[g.TriangleIndices.[i]],g.Positions.[g.TriangleIndices.[i+1]]) + |] + + member this.AsShapes() = + match this with + | Point p -> [||] + | Line (p1,p2) -> [||] + | Shape ps -> [| Shape(ps) |] + | Geometry g -> + [| for i in 0 .. 3 .. g.TriangleIndices.Count - 1 -> + Shape([|g.Positions.[g.TriangleIndices.[i+1]];g.Positions.[g.TriangleIndices.[i+2]];g.Positions.[g.TriangleIndices.[i]]|]) + |] + + member this.Extrude(v:Vector3D) : Primitive3D = + match this with + | Point p -> Line(p, (Matrix3D.translate(v).Transform(p))) + | Line (p1,p2) -> + let m = Matrix3D.translate(v) + Shape([| p1; p2; m.Transform(p2); m.Transform(p1) |]) + | Shape ps -> + let m = Matrix3D.translate(v) + // Add the first point onto the end + let ps1 = Array.append ps [|ps.[0]|] + let pss = Shapes3D.one_d ps1 (fun i ps1 -> if i = 0 then ps1 else ps1 |> Array.map (fun p -> m.Transform(p))) 1 + let sides = Shapes3D.createHardMesh pss (ps1.Length - 1) 1 + let front = ps1 |> concaveFill + let back = Array.rev (Array.map (fun (p:Point3D) -> m.Transform(p)) ps1 ) |> concaveFill + mergeGeom front back |> mergeGeom sides |> Geometry + | Geometry g -> Geometry(g) + + member this.Revolve(axis:Vector3D, angle:float, tes:int) = + let rev_p (p:Point3D) = [|for i in 0 .. tes -> (Matrix3D.rotate(Quaternion(axis, angle * (float i / float tes)))).Transform(p)|] + match this with + | Point p -> rev_p p |> Shape + | Line (p1,p2) -> + let top = rev_p p1 + let bottom = rev_p p2 + (Array.append top (Array.rev bottom)) |> Shape + | Shape ps -> + // Add the first point on to the end + let pss = Shapes3D.one_d (ps |> Array.append [|ps.[0]|]) (fun i ps -> ps |> Array.map (fun p -> (rotate(Quaternion(axis, -angle * (float i / float tes)))).Transform(p))) tes + let g = Shapes3D.createHardMesh pss (ps.Length - 1) tes + let top = convexFill(ps) + let bottom = convexFill(ps |> Array.map (fun p -> ((rotate(Quaternion(axis,-angle))).Transform(p)))) + top + |> mergeGeom bottom + |> mergeGeom g + |> Geometry + | Geometry g -> Geometry(g) + + +open Geometry3D + +let window = Viewer(Topmost = true) +window.Show() + +let add mv3d = window.Viewport.Children.Add(mv3d); mv3d +let remove mv3d = window.Viewport.Children.Remove(mv3d) |> ignore + +module Materials = + let Goldenrod = DiffuseMaterial(Brushes.Goldenrod) + +let point = Point(Point3D(0.,0.,0.)) +let line = point.Extrude(Vector3D(1.,0.,0.)) +let square = line.Extrude(Vector3D(0.,1.,0.)) +let cube = square.Extrude(Vector3D(0.,0.,1.)) + +(* This functionality is not finished yet *) +//let circle = line.Revolve(ZAxis,360.,10) +//let sphere = circle.Revolve(YAxis,180.,5) +//let cubeAsPoints = cube.AsPoints() +//let sphereAsPoints = sphere.AsPoints() + +open Shapes3D + +let toModelVisual (material:Material) (mesh:MeshGeometry3D) = + ModelVisual3D(Content = GeometryModel3D(Geometry = mesh, BackMaterial = material, Material = material)) + +let goldVisual = toModelVisual Materials.Goldenrod + + +let visuals = + [| + yield! + [|point; line; square; cube|] + |> Array.mapi (fun i shape -> shape.Transform(translate(Vector3D(float i,0.,0.))).AsModelVisual(Materials.Goldenrod) |> add) + yield! + [| + cylinder 5 30, (0.,2.) + cone 5 20, (2.,2.) + circle 10 30, (4.,2.) + helix 3. 3. 50, (6.,2.) + |] + |> Array.map ( + fun (mesh,pos) -> + let visual = goldVisual mesh + visual.Transform <- MatrixTransform3D(Matrix3D.translate(Vector3D(fst pos,snd pos,0.))) + visual |> add + ) + |] + +//window.Reset() \ No newline at end of file diff --git a/Samples/3D/scene.fsx b/Samples/3D/scene.fsx new file mode 100644 index 0000000..ab9e144 --- /dev/null +++ b/Samples/3D/scene.fsx @@ -0,0 +1,80 @@ +(* NOTE: Run in a seperate FSI Shell *) +#load "shared.fsx" +#load "..\Utilities\WebData.fsx" +open Tsunami.Public +#r "PresentationCore" +#r "PresentationFramework" +#r "WindowsBase" +#r "System.Xaml" +#r "UIAutomationTypes" +open System +open System.Collections.Generic +open System.IO +open System.Net +open System.Text +open System.Windows +open System.Windows.Shapes +open System.Windows.Controls +open System.Windows.Markup +open System.Windows.Input +open System.Windows.Media +open System.Windows.Media.Media3D +open System.Windows.Media.Imaging +open System.Windows.Threading +open System.Xml +open System.Diagnostics +open System.Threading +open System.Xaml +open Shared + +let window = Viewer(Topmost = true) +window.Show() + +let add mv3d = window.Viewport.Children.Add(mv3d); mv3d +let remove mv3d = window.Viewport.Children.Remove(mv3d) |> ignore + +let applyMatrix matrix (mv3D:Visual3D) = mv3D.Transform <- MatrixTransform3D(matrix); mv3D + +let updateMatrix (f:Matrix3D -> Matrix3D) (mv3D:Visual3D) = + match mv3D.Transform with + | :? MatrixTransform3D as mx -> mv3D.Transform <- MatrixTransform3D(f(mx.Matrix)) + | _ -> mv3D.Transform <- MatrixTransform3D(f(Matrix3D.Identity)) + mv3D + +let addMatrix (m:Matrix3D) mv3D = updateMatrix (fun x -> x * m) mv3D + +open Vector3D +open Matrix3D + +let translate x y z (mv3D:Visual3D) = addMatrix ((translate(Vector3D(x,y,z)))) mv3D +let scale x y z (mv3D:Visual3D) = addMatrix (scale(Vector3D(x,y,z))) mv3D +let reset (mv3D:Visual3D) = applyMatrix unitM mv3D +let rotate q = addMatrix(Matrix3D.rotate q) + +let imageModel url model = + let bi = BitmapImage() + bi.BeginInit() + bi.StreamSource <- new MemoryStream(WebData.ReadAllData(@"http://tsunami.io/assets/skypic_small.jpg")) + bi.EndInit() + let material = DiffuseMaterial(ImageBrush(bi)) + ModelVisual3D(Content = GeometryModel3D(Geometry = (model), Material = material, BackMaterial = material)) + +let brushModel brush model = ModelVisual3D(Content = GeometryModel3D(Geometry = (model), BackMaterial = (DiffuseMaterial(brush)), Material = (DiffuseMaterial(Brushes.Goldenrod)))) + + + +let terrain = + square() + |> imageModel @"http://tsunami.io/assets/skypic_small.jpg" + |> scale 200. 200. 200. + |> rotate (Quaternion(XAxis,90.)) + |> translate 1. -1. 1. + |> add + + +let walkerXaml = WebData.ReadAllText(@"http://tsunami.io/assets/walker.xaml") +let makeWalker() = walkerXaml |> parseXAML :?> ModelVisual3D + + +let walker = makeWalker() |> add +let cube = cube() |> brushModel Brushes.Goldenrod |> add diff --git a/Samples/3D/shared.fsx b/Samples/3D/shared.fsx new file mode 100644 index 0000000..968c12a --- /dev/null +++ b/Samples/3D/shared.fsx @@ -0,0 +1,250 @@ +(* NOTE: Run in a seperate FSI Shell *) +#r "PresentationCore" +#r "PresentationFramework" +#r "WindowsBase" +#r "System.Xaml" +#r "UIAutomationTypes" + +open System +open System.Collections.Generic +open System.IO +open System.Net +open System.Text +open System.Windows +open System.Windows.Shapes +open System.Windows.Controls +open System.Windows.Markup +open System.Windows.Input +open System.Windows.Media +open System.Windows.Media.Media3D +open System.Windows.Media.Imaging +open System.Windows.Threading +open System.Xml +open System.Diagnostics +open System.Threading +open System.Xaml + + +module Vector3D = + let cross (v1 : Vector3D) (v2 : Vector3D) = Vector3D.CrossProduct(v1,v2) + let dot (v1 : Vector3D) (v2 : Vector3D) = Vector3D.DotProduct(v1,v2) + let length (v : Vector3D) = v.Length + let lengthSquared (v : Vector3D) = v.LengthSquared + let angle_between (v1 : Vector3D) (v2 : Vector3D) = acos ((dot v1 v2) / ((v1 |> length) * (v2 |> length))) + let unitV = Vector3D(1.,1.,1.) + let XAxis = Vector3D(1.,0.,0.) + let YAxis = Vector3D(0.,1.,0.) + let ZAxis = Vector3D(0.,0.,1.) + +module Matrix3D = + open Vector3D + let unitM = Matrix3D.Identity + let scale(v:Vector3D) = + let mutable m = Matrix3D.Identity + m.Scale(Vector3D(v.X,v.Y,v.Z)) + m + + let translate(v:Vector3D) = + let mutable m = Matrix3D.Identity + m.Translate(Vector3D(v.X,v.Y,v.Z)) + m + + let rotate(x:Quaternion) = + let mutable m = Matrix3D.Identity + m.Rotate(x) + m + +(* Helper functions *) +let parseXAML (xaml : string) = + use ms = new MemoryStream(Encoding.ASCII.GetBytes(xaml)) + ms.Position <- int64 0 + XamlReader.Load(ms) + +let getUrlAsTxt (url:string) = + use sr = new StreamReader(WebRequest.Create(url).GetResponse().GetResponseStream()) + sr.ReadToEnd() + + +let square() = + let mg = MeshGeometry3D() + [|-1.,1.,0.;1.,1.,0.;-1.,-1.,0.;1.,-1.,0.|] + |> Array.iter (fun (x,y,z) -> mg.Positions.Add(Point3D(x,y,z))) + [|0.,0.,1.;0.,0.,1.;0.,0.,1.;0.,0.,1.|] + |> Array.iter (fun (x,y,z) -> mg.Normals.Add(Vector3D(x,y,z))) + [|0.,0.;1.,0.;0.,1.;1.,1.|] + |> Array.iter (fun (x,y) -> mg.TextureCoordinates.Add(Point(x,y))) + [|0;2;3;0;3;1|] |> Array.iter mg.TriangleIndices.Add + mg + +let cube() = + let mg = MeshGeometry3D() + [| + -0.5, 1.0, 0.5; 0.5, 1.0, 0.5 + -0.5, 0.0, 0.5; 0.5, 0.0, 0.5 + + 0.5 , 1.0,-0.5;-0.5, 1.0,-0.5 + 0.5 , 0.0,-0.5;-0.5, 0.0,-0.5 + + -0.5, 1.0,-0.5;-0.5, 1.0, 0.5 + -0.5, 0.0,-0.5;-0.5, 0.0, 0.5 + + 0.5 , 1.0, 0.5; 0.5, 1.0,-0.5 + 0.5 , 0.0, 0.5; 0.5, 0.0,-0.5 + + -0.5, 1.0,-0.5; 0.5, 1.0,-0.5 + -0.5, 1.0, 0.5; 0.5, 1.0, 0.5 + + 0.5 , 0.0,-0.5;-0.5, 0.0,-0.5 + 0.5 , 0.0, 0.5;-0.5, 0.0, 0.5 + |] |> Array.iter (fun (x,y,z) -> mg.Positions.Add(Point3D(x,y,z))) + + [| + 0 , 2, 1; 1, 2, 3 + 4 , 6, 5; 5, 6, 7 + 8 ,10, 9; 9,10,11 + 12,14,13;13,14,15 + 16,18,17;17,18,19 + 20,22,21;21,22,23 + |] + |> Array.collect (fun (a,b,c) -> [|a;b;c|]) + |> Array.iter mg.TriangleIndices.Add + + [|0., 0.; 1., 0.; 0., 1.; 1., 1.|] + |> Array.create 6 + |> Array.collect id + |> Array.iter (fun (x,y) -> mg.TextureCoordinates.Add(Point(x,y))) + mg + +type Viewer() as this = + inherit Window() + + let grid = Grid() + let viewport = Viewport3D() + let backPanel = Canvas(Background = Brushes.DarkBlue, IsHitTestVisible = true) + let frontPanel = Canvas(IsHitTestVisible = false) + + do + + + + grid.Children.Add(backPanel) |> ignore + grid.Children.Add(viewport) |> ignore + grid.Children.Add(frontPanel) |> ignore + this.Content <- grid + + // Add camera to viewport + let camera = PerspectiveCamera(Point3D(0.,0.,0.), Vector3D(0., 0., 1.), Vector3D(0., 1., 0.), 45.) + viewport.Camera <- camera + // Create the transforms + let zoom = TranslateTransform3D() + let tran = TranslateTransform3D() + let rotx = AxisAngleRotation3D(Vector3D(1.,0.,0.),0.) + let roty = AxisAngleRotation3D(Vector3D(0.,1.,0.),0.) + let rotz = AxisAngleRotation3D(Vector3D(0.,0.,1.),0.) + + zoom.OffsetZ <- -10. + roty.Angle <- 180. + + // Add the transform to the camera + let group = Transform3DGroup() + group.Children.Add(zoom) + group.Children.Add(RotateTransform3D(rotz)) + group.Children.Add(RotateTransform3D(rotx)) + group.Children.Add(RotateTransform3D(roty)) + group.Children.Add(tran) + camera.Transform <- group + + let addFront c = frontPanel.Children.Add(c) + + let removeFront c = frontPanel.Children.Remove(c) + + let getAspectRatio() = viewport.ActualWidth / viewport.ActualHeight + + let getProjMatrix (camera:PerspectiveCamera) aspectRatio = + let degToRad deg = deg * (Math.PI / 180.0) + let hFov = degToRad camera.FieldOfView + let zn = camera.NearPlaneDistance + let zf = camera.FarPlaneDistance + let xScale = 1.0 / tan(hFov / 2.0) + let yScale = aspectRatio * xScale + let m33 = + if zf = Double.PositiveInfinity then + -1. + else + zf / (zn - zf) + let m43 = zn * m33 + Matrix3D( + xScale, 0., 0., 0., + 0., yScale, 0., 0., + 0., 0., m33, -1., + 0., 0., m43, 0.) + + let getViewMatrix (camera:PerspectiveCamera) = + let zAxis = -camera.LookDirection + zAxis.Normalize() + let xAxis = Vector3D.CrossProduct(camera.UpDirection, zAxis) + xAxis.Normalize() + let yAxis = Vector3D.CrossProduct(zAxis,xAxis) + let position = Vector3D(X=camera.Position.X,Y=camera.Position.Y,Z=camera.Position.Z) + let offsetX = -Vector3D.DotProduct(xAxis,position) + let offsetY = -Vector3D.DotProduct(yAxis,position) + let offsetZ = -Vector3D.DotProduct(zAxis,position) + Matrix3D( + xAxis.X, yAxis.X, zAxis.X, 0., + xAxis.Y, yAxis.Y, zAxis.Y, 0., + xAxis.Z, yAxis.Z, zAxis.Z, 0., + offsetX, offsetY, offsetZ, 1.) + + + // Camrea Settings + let first = ref true // set to true when viewport3D focus is lost + let lastMouseMovePos = ref (Point()) + let lastMouseDownPos = ref (Point()) + + let mouse_move = fun (e:Input.MouseEventArgs) -> + let p = e.GetPosition(viewport) + if !first then + lastMouseMovePos := p + first := false + let d = !lastMouseMovePos - p + if e.RightButton = Input.MouseButtonState.Pressed then + if e.LeftButton = Input.MouseButtonState.Pressed then + // zoom + zoom.OffsetZ <- zoom.OffsetZ + zoom.OffsetZ * 10. * d.Y / viewport.ActualHeight + else + // rotation + rotx.Angle <- rotx.Angle + (d.Y / viewport.ActualHeight) * 180. // z is pitch + roty.Angle <- roty.Angle + (d.X / viewport.ActualWidth) * 180. + lastMouseMovePos := p + + backPanel.MouseMove.Add(mouse_move) + viewport.MouseMove.Add(mouse_move) + + backPanel.MouseWheel.Add(fun e -> if e.Delta < 0 then zoom.OffsetZ <- zoom.OffsetZ * 1.1 else zoom.OffsetZ <- zoom.OffsetZ / 1.1) + viewport.MouseWheel.Add(fun e -> if e.Delta < 0 then zoom.OffsetZ <- zoom.OffsetZ * 1.1 else zoom.OffsetZ <- zoom.OffsetZ / 1.1) + + backPanel.MouseUp.Add((fun _ -> first := true)) + viewport.MouseUp.Add((fun _ -> first := true)) + + backPanel.MouseLeave.Add(fun _ -> first := true) + viewport.MouseLeave.Add(fun _ -> first := true) + + let key_down = fun (e:KeyEventArgs) -> + if Keyboard.IsKeyDown(Key.A) then tran.OffsetX <- tran.OffsetX - 1. + if Keyboard.IsKeyDown(Key.D) then tran.OffsetX <- tran.OffsetX + 1. + if Keyboard.IsKeyDown(Key.W) then tran.OffsetZ <- tran.OffsetZ - 1. + if Keyboard.IsKeyDown(Key.S) then tran.OffsetZ <- tran.OffsetZ + 1. + if Keyboard.IsKeyDown(Key.Space) then tran.OffsetY <- tran.OffsetY + 1. + if Keyboard.IsKeyDown(Key.LeftCtrl) then tran.OffsetY <- tran.OffsetY - 1. + e.Handled <- false + this.KeyDown.Add(key_down) + this.Reset() + member this.Viewport = viewport + member this.Reset() = + viewport.Children.Clear() + let m3dgroup = Model3DGroup() + [| + AmbientLight(Color = Color.FromRgb(64uy,64uy,64uy)) :> Light + DirectionalLight(Color = Color.FromRgb(192uy,192uy,192uy), Direction = Vector3D(2.,-3.,-1.)) :> Light + |] |> Array.iter (fun light -> m3dgroup.Children.Add(light)) + viewport.Children.Add(ModelVisual3D(Content = m3dgroup)) \ No newline at end of file diff --git a/Samples/EventStore/EventStore.fsx b/Samples/EventStore/EventStore.fsx new file mode 100644 index 0000000..506f096 --- /dev/null +++ b/Samples/EventStore/EventStore.fsx @@ -0,0 +1,140 @@ +module Tsunami.EventStore +#r "Tsunami.IDEDesktop.exe" +#r "Newtonsoft.Json.dll" +#r "System.Reactive.Core.dll" +#r "System.Reactive.Linq.dll" +#r "System.Reactive.Interfaces.dll" +#r "WindowsBase.dll" +#r "PresentationCore.dll" +#r "PresentationFramework.dll" +#r "System.Xaml.dll" +#r "System.Core.dll" +#r "System.Xml.Linq.dll" +#r "UIAutomationTypes.dll" + +open System +open System.IO +open System.Net +open System.Text +open System.Collections.Generic +open Tsunami.Utilities +open Tsunami.SerDes.JS +open Newtonsoft.Json +open Newtonsoft.Json.Linq + +/// Should be private, ignore +type Wrapped<'a> = + { + wrapped: 'a + } + +/// Should be private, ignore +type Event<'a> = + { + eventId: string + eventType: string + data: Wrapped<'a> + } + +/// Should be private, ignore +let mkEvent (ty: string) (data: 'a) = + { + eventId = Guid.NewGuid().ToString() + eventType = ty + data = { wrapped = data } + } + +/// Adds element 'e' to the stream identified by 'url'. +/// It must be possible to serialize 'e' to JSON. +let postData (url: string) (e : 'T) = + let ev = mkEvent "null" e + let j = toJSON [|ev|] + let bs = Encoding.ASCII.GetBytes j + + let req = HttpWebRequest.Create(url) + req.Method <- WebRequestMethods.Http.Post + req.ContentType <- "application/json" + req.ContentLength <- bs.LongLength + let stream = req.GetRequestStream() + stream.Write(bs, 0, bs.Length) + stream.Close() + + try + req.GetResponse() + with + | :? System.Net.WebException as e -> e.Response + + +let private get (url: string) : string = + let req = HttpWebRequest.Create(url) :?> HttpWebRequest + req.Accept <- "application/json" + req.GetResponse().GetResponseStream().ToBytes() + |> Encoding.ASCII.GetString + +let private getUriByRelation (relation:string) (o: seq) : string = + Seq.pick (fun (o : JToken) -> if o.["relation"].ToString() = relation + then Some (o.["uri"].ToString()) else None) o + +let private eventUrls (j: JObject) = + j.["entries"].Children() + |> Seq.map (fun o -> (o.["updated"].Value(), o.["links"])) + |> Seq.map (fun (x,y) -> (x, y |> getUriByRelation "alternate")) + +/// Given a url of a stream, constructs a pair of objects, one being a +/// "hot" observable stream and the other being a disposable used to stop +/// polling of the underlying event store. +let observableOfStream<'T> (url: string) : IObservable * IDisposable = + + let cell = + Agent.Start (fun inbox -> + let observers = HashSet HashIdentity.Reference + + let rec loop url = + async { + let! command = inbox.TryReceive(250) + match command with + | Some (Choice1Of3 o) -> + observers.Add o |> ignore + return! loop url + | Some (Choice2Of3 o) -> + observers.Remove o |> ignore + return! loop url + | Some (Choice3Of3 o) -> () + + | None -> + let j = get url |> JObject.Parse + if j.["entries"].HasValues then + for (datetime,url) in eventUrls j |> Seq.toArray |> Array.rev do + let value = + let str = get url + //printfn "uri: %O\njson: \n%s" url str + str |> Tsunami.SerDes.JS.fromJSON> + for (o: IObserver) in observers do + o.OnNext(datetime,value.wrapped) + + return! loop (j.["links"].Children() |> getUriByRelation "previous") + else + return! loop url + } + loop url + ) + + cell.Error.Add(fun exn -> + printfn "Raised an exception: %A" exn) + + let o = + { new IObservable with + member __.Subscribe observer = + cell.Post(Choice1Of3 observer) + { new IDisposable with + member __.Dispose() = cell.Post(Choice2Of3 observer) + } + } + let d = + { + new IDisposable with + member __.Dispose() = cell.Post(Choice3Of3 ()) + } + + o,d + diff --git a/Samples/EventStore/EventStoreTest.fsx b/Samples/EventStore/EventStoreTest.fsx new file mode 100644 index 0000000..10e0b2c --- /dev/null +++ b/Samples/EventStore/EventStoreTest.fsx @@ -0,0 +1,139 @@ +// To run this sample you must run Tsunami as an administrator. +// Please download and install EventStore before you run this sample. +// You can find it here: http://geteventstore.com/ +// Make sure you update the value of the eventStoreDir binding to your install location. + +#r "Tsunami.IDEDesktop.exe" +#r "Newtonsoft.Json.dll" +#r "System.Reactive.Core.dll" +#r "System.Reactive.Linq.dll" +#r "System.Reactive.Interfaces.dll" +#r "WindowsBase.dll" +#r "PresentationCore.dll" +#r "PresentationFramework.dll" +#r "System.Xaml.dll" +#r "System.Core.dll" +#r "System.Xml.Linq.dll" +#r "UIAutomationTypes.dll" +#r "System.Drawing.dll" +#r "System.Windows.Forms.dll" +#r "WindowsFormsIntegration.dll" +#r "System.Windows.Forms.DataVisualization.dll" +#r "ActiproSoftware.Charts.Wpf.dll" +#r "ActiproSoftware.Shared.Wpf.dll" +#load "EventStore.fsx" + + +//let policyServer = Tsunami.Server.PolicyServer.server System.Net.IPAddress.Loopback 943 +let eventStoreDir = @"C:\bin\EventStore\eventstore-net-2.0.0" + +open Tsunami +open Tsunami.Utilities + +open System +open System.IO +open System.Net +open System.Text +open System.Collections.Generic +open Tsunami.Utilities +open Newtonsoft.Json +open Newtonsoft.Json.Linq +open System.Diagnostics +open ActiproSoftware.Windows.Controls.Charts +open System.Windows +open System.Windows.Controls +open System.Reactive.Linq + +let eventStoreExe = + let path = Path.Combine(eventStoreDir, "EventStore.SingleNode.exe") + if not (File.Exists path) then + failwith "Please install EventStore. See comment at top of page." + path + +let eventStore = Process.Start(eventStoreExe, "--http-port=4532") + +let stream = "http://127.0.0.1:4532/streams/floatstream" + +EventStore.postData stream 4.0 |> ignore + +let obs = EventStore.observableOfStream stream |> fst +let d = obs.Subscribe(fun (dt,v) -> printfn "Received %s %f" (dt.ToString()) v) + +d.Dispose() + +let chatStream = "http://127.0.0.1:4532/streams/chatstream" + +type Chat = { + sender : string + message : string +} + +EventStore.postData chatStream {sender = "Matt"; message = "Hello World"} |> ignore +let chatObs = EventStore.observableOfStream chatStream |> fst +let chatD = chatObs.Subscribe(fun (dt,v) -> printfn "%s: %s" v.sender v.message) +chatD.Dispose() + +type ViewModel private () = + let propertyChanged = Event() + let valueChanged = Event() + let notify obj s = propertyChanged.Trigger(obj, System.ComponentModel.PropertyChangedEventArgs(s)) + let mutable value = 0. + interface System.ComponentModel.INotifyPropertyChanged with + [] + member this.PropertyChanged = propertyChanged.Publish + + member this.Value with get() = value and set(x) = value <- x; notify this "Value"; valueChanged.Trigger(x) + member this.ValueChanged = valueChanged.Publish + member this.SilentUpdate(x) = value <- x; notify this "Value"; + static member val Instance = ViewModel() + +let trailing (timespan:TimeSpan) (obs:IObservable<'a>) = + obs.Timestamp() + |> Observable.scan (fun ys x -> + let now = DateTime.UtcNow + x :: (ys |> List.filter (fun x -> (now - x.Timestamp.UtcDateTime) < timespan))) [] + |> Observable.map (fun xs -> [| for x in xs -> (x.Timestamp.UtcDateTime,x.Value) |]) + + +Observable.Sample(ViewModel.Instance.ValueChanged, TimeSpan.FromSeconds(0.2)) +|> Observable.add (fun x -> EventStore.postData stream x |> ignore) + +(* Charting *) + +type DateValue = { + date : DateTime + value : float +} + +let f _ = + let dp = DockPanel() + let slider = Slider(Orientation = Orientation.Vertical, Minimum = 0., Maximum = 100.) + slider.DataContext <- ViewModel.Instance + slider.SetBinding(Slider.ValueProperty, Data.Binding("Value")) |> ignore + + + let chart = XYChart() + let xAxis = XYDateTimeAxis() + let yAxis = XYDoubleAxis(Minimum = 0., Maximum = 100.) + let lineSeries = LineSeries(LineKind = XYSeriesLineKind.Spline, + IsAggregationEnabled = false, + XPath = "date", XAxis = xAxis, YPath = "value", YAxis = yAxis) + chart.Series.Add(lineSeries) + chart.XAxes.Add(xAxis) + chart.YAxes.Add(yAxis) + + Observable.Interval(TimeSpan.FromSeconds(0.2)) + .CombineLatest(obs,fun _ x -> x) + .Sample(TimeSpan.FromSeconds(0.2)) + |> trailing (TimeSpan.FromMinutes(1.)) + |> Observable.add (fun xs -> Dispatcher.invoke(fun _ -> lineSeries.ItemsSource <- [|for x in xs -> { date = fst x; value = snd (snd x)}|])) + + DockPanel.SetDock(slider,Dock.Left) + DockPanel.SetDock(chart,Dock.Right) + dp.Children.Add(slider) |> ignore + dp.Children.Add(chart) |> ignore + dp :> UIElement + +Tsunami.IDE.SimpleUI.addControlToNewDocument("Event Stream", f) +Tsunami.IDE.SimpleUI.addControlToNewDocument("Event Stream", f) + diff --git a/Samples/EventStore/EventStoreTestSL.fsx b/Samples/EventStore/EventStoreTestSL.fsx new file mode 100644 index 0000000..e30dc0d --- /dev/null +++ b/Samples/EventStore/EventStoreTestSL.fsx @@ -0,0 +1,303 @@ +#r "System.Core.dll" +#r "System.dll" +#r "System.Net.dll" +#r "System.Runtime.Serialization.dll" +#r "System.ServiceModel.Web.dll" +#r "System.Windows.Browser.dll" +#r "System.Windows.dll" +#r "System.Xml.dll" +#r "System.Runtime.Serialization.Json.dll" +#r "System.Windows.Controls.dll" +#r "System.Windows.Data.dll" +#r "System.ComponentModel.DataAnnotations.dll" +#r "System.Xml.Linq.dll" +#r "ActiproSoftware.BarCode.Silverlight.dll" +#r "ActiproSoftware.Charts.Silverlight.dll" +#r "ActiproSoftware.MicroCharts.Silverlight.dll" +#r "ActiproSoftware.Shared.Silverlight.dll" +#r "ActiproSoftware.SyntaxEditor.Addons.DotNet.Silverlight.dll" +#r "ActiproSoftware.SyntaxEditor.Addons.Xml.Silverlight.dll" +#r "ActiproSoftware.SyntaxEditor.Silverlight.dll" +#r "ActiproSoftware.Text.Addons.DotNet.Silverlight.dll" +#r "ActiproSoftware.Text.Addons.Xml.Silverlight.dll" +#r "ActiproSoftware.Text.LLParser.Silverlight.dll" +#r "ActiproSoftware.Text.Silverlight.dll" +#r "ActiproSoftware.Themes.Office.Silverlight.dll" +#r "ActiproSoftware.Views.Silverlight.dll" +#r "ActiproSoftware.Wizard.Silverlight.dll" +#r "Telerik.Windows.Controls.Data.dll" +#r "Telerik.Windows.Controls.DataServices.dll" +#r "Telerik.Windows.Controls.Docking.dll" +#r "Telerik.Windows.Controls.Input.dll" +#r "Telerik.Windows.Controls.Navigation.dll" +#r "Telerik.Windows.Controls.RibbonView.dll" +#r "Telerik.Windows.Controls.dll" +#r "Telerik.Windows.Data.dll" +#r "ActiproUtilities.dll" +#r "Crystalbyte.Net.dll" +#r "FSharp.Compiler.Silverlight.dll" +#r "Ionic.Zip.dll" +#r "NewtonSoft.Json.dll" +#r "System.Reactive.Core.dll" +#r "System.Reactive.Interfaces.dll" +#r "System.Reactive.Linq.dll" +#r "System.Reactive.PlatformServices.dll" +//#r "System.Threading.Tasks.SL5.dll" +#r "Tsunami.IDESilverlight.dll" + + +open System +open System.IO +open System.Net +open System.Text +open System.Collections.Generic +open Tsunami.Utilities +open Tsunami.SerDes.JS +open Newtonsoft.Json +open Newtonsoft.Json.Linq + +module EventStore = + /// Should be private, ignore + type Wrapped<'a> = + { + wrapped: 'a + } + + /// Should be private, ignore + type Event<'a> = + { + eventId: string + eventType: string + data: Wrapped<'a> + } + + /// Should be private, ignore + let mkEvent (ty: string) (data: 'a) = + { + eventId = Guid.NewGuid().ToString() + eventType = ty + data = { wrapped = data } + } + + let private webClient = WebClient() + + /// Adds element 'e' to the stream identified by 'url'. + /// It must be possible to serialize 'e' to JSON. + let postData (url: string) (e : 'T) = + let ev = mkEvent "null" e + let j = toJSON [|ev|] + let bs = Encoding.UTF8.GetBytes j + + let req = HttpWebRequest.Create(url) + req.Method <-"POST" + req.ContentType <- "application/json" + req.ContentLength <- int64 bs.Length + let stream = Async.FromBeginEnd(req.BeginGetRequestStream, req.EndGetRequestStream) |> Async.RunSynchronously + stream.Write(bs, 0, bs.Length) + stream.Close() + + try + req.AsyncGetResponse() |> Async.RunSynchronously + with + | :? System.Net.WebException as e -> e.Response + + + let private get (hostUri:Uri) (url: string) : string = + let uri = UriBuilder(url) + uri.Port <- hostUri.Port + uri.Host <- hostUri.Host + let url2 = uri.Uri.ToString() + //printfn "url: %s" url2 + let req = HttpWebRequest.CreateHttp(url2) + req.Method <- "GET" + req.Accept <- "application/json" + //let stream = Async.FromBeginEnd(req.BeginGetRequestStream, req.EndGetRequestStream) |> Async.RunSynchronously + //stream.Close() + let resp = Async.FromBeginEnd(req.BeginGetResponse, req.EndGetResponse) |> Async.RunSynchronously + + //let resp = req.AsyncGetResponse() |> Async.RunSynchronously + let bytes = resp.GetResponseStream().ToBytes() + + let str = Encoding.UTF8.GetString(bytes,0,bytes.Length) + + //printfn "%O" uri.Uri + //let str = webClient.AsyncDownloadString(uri.Uri) |> Async.RunSynchronously + //printfn "%s" str + str + + + let private getUriByRelation (relation:string) (o: seq) : string = + Seq.pick (fun (o : JToken) -> if o.["relation"].ToString() = relation + then Some (o.["uri"].ToString()) else None) o + + let private eventUrls (j: JObject) = + j.["entries"].Children() + |> Seq.map (fun o -> (o.["updated"].Value(), o.["links"])) + |> Seq.map (fun (x,y) -> (x, y |> getUriByRelation "alternate")) + + /// Given a url of a stream, constructs a pair of objects, one being a + /// "hot" observable stream and the other being a disposable used to stop + /// polling of the underlying event store. + let observableOfStream<'T> (url: string) : IObservable * IDisposable = + let hostUri = Uri(url) + let cell = + Agent.Start (fun inbox -> + let observers = HashSet HashIdentity.Reference + + let rec loop url = + async { + let! command = inbox.TryReceive(250) + match command with + | Some (Choice1Of3 o) -> + observers.Add o |> ignore + return! loop url + | Some (Choice2Of3 o) -> + observers.Remove o |> ignore + return! loop url + | Some (Choice3Of3 o) -> () + + | None -> + let j = (get hostUri url) |> JObject.Parse + if j.["entries"].HasValues then + for (datetime,url) in eventUrls j |> Seq.toArray |> Array.rev do + let value = (get hostUri url) |> Tsunami.SerDes.JS.fromJSON> + for (o: IObserver) in observers do + o.OnNext(datetime,value.wrapped) + + return! loop (j.["links"].Children() |> getUriByRelation "previous") + else + return! loop url + } + loop url + ) + + cell.Error.Add(fun exn -> + printfn "Raised an exception: %A" exn) + + let o = + { new IObservable with + member __.Subscribe observer = + cell.Post(Choice1Of3 observer) + { new IDisposable with + member __.Dispose() = cell.Post(Choice2Of3 observer) + } + } + let d = + { + new IDisposable with + member __.Dispose() = cell.Post(Choice3Of3 ()) + } + + o,d + +open Tsunami +open Tsunami.Utilities + +open System +open System.IO +open System.Net +open System.Text +open System.Collections.Generic +open Tsunami.Utilities +open Newtonsoft.Json +open Newtonsoft.Json.Linq +open System.Diagnostics +open ActiproSoftware.Windows.Controls.Charts +open System.Windows +open System.Windows.Controls +open System.Reactive.Linq + +let stream = "http://127.0.0.1:4531/streams/floatstream" + +EventStore.postData stream 4.0 |> ignore + +let obs = EventStore.observableOfStream stream |> fst +let d = obs.Subscribe(fun (dt,v) -> printfn "Received %s %f" (dt.ToString()) v) +d.Dispose() + +let chatStream = "http://127.0.0.1:4531/streams/chatstream" + +type Chat = { + sender : string + message : string +} +let chatObs = EventStore.observableOfStream chatStream |> fst +let chatD = chatObs.Subscribe(fun (dt,v) -> printfn "%s: %s" v.sender v.message) +EventStore.postData chatStream {sender = "John"; message = "Hello Matt"} |> ignore +chatD.Dispose() + +let trailing (timespan:TimeSpan) (obs:IObservable<'a>) = + obs.Timestamp() + |> Observable.scan (fun ys x -> + let now = DateTime.UtcNow + x :: (ys |> List.filter (fun x -> (now - x.Timestamp.UtcDateTime) < timespan))) [] + |> Observable.map (fun xs -> [| for x in xs -> (x.Timestamp.UtcDateTime,x.Value) |]) + + + + +(* Charting *) +type DateValue = { + date : DateTime + value : float +} + +let mutable lastValue = 0. +let mutable newValue = 0. +async { + while true do + do! Async.Sleep(500) + if lastValue <> newValue then + EventStore.postData stream newValue |> ignore + lastValue <- newValue +} |> Async.StartImmediate + +let f _ = + let dp = Grid() + dp.ColumnDefinitions.Add(ColumnDefinition(Width = GridLength.Pixels 30)) + dp.ColumnDefinitions.Add(ColumnDefinition()) + let slider = Slider(Orientation = Orientation.Vertical, Minimum = 0., Maximum = 100.) + slider.ValueChanged.Add(fun x -> newValue <- x.NewValue) + + let chart = XYChart() + let xAxis = XYDateTimeAxis() + let yAxis = XYDoubleAxis(Minimum = 0., Maximum = 100.) + let lineSeries = LineSeries(LineKind = XYSeriesLineKind.Spline, + IsAggregationEnabled = false, + XPath = "date", XAxis = xAxis, YPath = "value", YAxis = yAxis) + chart.Series.Add(lineSeries) + chart.XAxes.Add(xAxis) + chart.YAxes.Add(yAxis) + + let xs = Observable.Interval(TimeSpan.FromSeconds(0.2)) + .CombineLatest(obs,fun _ x -> x) + .Sample(TimeSpan.FromSeconds(0.2)) + |> trailing (TimeSpan.FromMinutes(1.)) + + xs.Subscribe(fun xs -> Dispatcher.invoke(fun _ -> lineSeries.ItemsSource <- [|for x in xs -> { date = fst x; value = snd (snd x)}|])) |> ignore + + Grid.SetColumn(slider,0) + Grid.SetColumn(chart,1) + dp.Children.Add(slider) |> ignore + dp.Children.Add(chart) |> ignore + dp :> UIElement + + +open Telerik.Windows.Controls + +let addControlToNewDocument(name,f:unit -> UIElement) = + Dispatcher.invoke(fun () -> + // Find panes group + let window = Application.Current.RootVisual :?> Tsunami.IDESilverlight.MainWindow + let grid = window.Content :?> Grid + let docking = grid.Children |> Seq.pick (function :? RadDocking as x -> Some x | _ -> None) + let container = docking.Items |> Seq.pick (function :? RadSplitContainer as x -> Some x | _ -> None) + let group = container.Items |> Seq.pick (function :? RadPaneGroup as x -> Some x | _ -> None) + // Add pane + let pane = RadPane(Header=name) + pane.MakeFloatingDockable() + group.Items.Add(pane) + // Set content + pane.Content <- f()) + +addControlToNewDocument("Event Stream", f) diff --git a/Samples/Excel/ABTesting.fsx b/Samples/Excel/ABTesting.fsx new file mode 100644 index 0000000..57d0cb0 --- /dev/null +++ b/Samples/Excel/ABTesting.fsx @@ -0,0 +1,98 @@ +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.dll" +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.FSharp.dll" +#load "ExcelCharts.fsx" + +open System +open System.Net +open MathNet.Numerics.Random +open MathNet.Numerics.Distributions +open Microsoft.Office.Interop.Excel + +let now = System.DateTime.Now +let chart = ExcelCharts.NewChart().Value +let clear = ExcelCharts.clear + +chart.ChartType <- XlChartType.xlLine + +let monthOfYearAdjustment = + let adjustments = + [| + yield 1.3 // January + yield 0.8 // Feburary + yield 1.0 // March + yield 0.9 // April + yield 0.7 // May + yield 0.4 // June + yield 0.4 // July + yield 0.7 // August + yield 1.0 // September + yield 1.3 // October + yield 2.0 // November + yield 2.5 // December + |] + let average = (adjustments |> Array.sum) / float adjustments.Length + fun (time:System.DateTime) -> + + // TODO - find a better interpolation formulae + let current = adjustments.[time.Month - 1] / average + let previous = adjustments.[(time.Month - 2 + 12) % 12] / average + let numberOfDays = float (DateTime.DaysInMonth(time.Year,time.Month)) + let day = float time.Day + (previous * ((numberOfDays - day) / numberOfDays) + current * (day / numberOfDays)) / 2. + + + +let dayOfWeekAdjustment = + let adjustments = + [| + yield 1.5 // Sunday + yield 0.6 // Monday + yield 0.6 // Tuesday + yield 0.8 // Wednesday + yield 0.6 // Thursday + yield 0.8 // Friday + yield 2.0 // Saturday + |] + let average = (adjustments |> Array.sum) / float adjustments.Length + fun (time:System.DateTime) -> adjustments.[int time.DayOfWeek] / average + + +let normal = Normal.WithMeanVariance(0.0, 1.0) + +let weightedFunction(time:DateTime) = + monthOfYearAdjustment(time) * 10. + + dayOfWeekAdjustment(time) * 2. + + normal.Sample() * 0.4 + +let red = BitConverter.ToInt32([|255uy;0uy;0uy;0uy|],0) +let blue = BitConverter.ToInt32([|0uy;0uy;255uy;0uy|],0) +let green = BitConverter.ToInt32([|0uy;255uy;0uy;0uy|],0) + +let genData n = + let gen() = [| for x in 0..n -> now.AddDays(float -x) |] |> Array.map (weightedFunction) + let xs = + [| + // Controls + for i in 1..5 -> (gen(), red, sprintf "Cntrl%i" i) + // Experiments + for i in 1..4 -> (gen(), blue, sprintf "Exp%i" i) + // Successful Experiment + yield (gen() |> Array.map ((+) 2.), blue, "Exp5") + |] + [| + yield! xs + yield ([| for i in 0..n -> [| for j in 0..xs.Length-1 -> match xs.[j] with | (xs,color,name) -> xs.[i] |] |> Array.average |], green, "Average") + |] + +let plotData (chart:Chart) ys = + for (xs,color, name) in ys do + let seriesCollection = chart.SeriesCollection() :?> SeriesCollection + let series = seriesCollection.NewSeries() + series.Name <- name + series.Format.Line.ForeColor.RGB <- color + series.Values <- xs + +clear chart +genData 28 |> plotData chart +clear chart +genData 365 |> plotData chart diff --git a/Samples/Excel/BurndownChart.fsx b/Samples/Excel/BurndownChart.fsx new file mode 100644 index 0000000..a685fff --- /dev/null +++ b/Samples/Excel/BurndownChart.fsx @@ -0,0 +1,131 @@ +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.dll" +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.FSharp.dll" +#load "ExcelCharts.fsx" + +open System +open System.Net +open MathNet.Numerics.Random +open MathNet.Numerics.Distributions +open Microsoft.Office.Interop.Excel + +module Colors = + let red = BitConverter.ToInt32([|255uy;0uy;0uy;0uy|],0) + let blue = BitConverter.ToInt32([|0uy;0uy;255uy;0uy|],0) + let green = BitConverter.ToInt32([|0uy;255uy;0uy;0uy|],0) + +type BurnDownChart = { + title : string + xAxis : string + yAxis : string + days : int + storyPoints : int + remaining : int[] +} + +[] +module BurnDown = + let idealBurndown days storyPoints = Array.init (days + 1) (fun i -> max 0 (storyPoints - int (float i * float storyPoints / float days))) + + + let private genSinWave (width:float) (offset:float) = Seq.initInfinite (fun i -> sin (((float i + offset )/ width) * 2. * Math.PI)) + + /// slow, fast, slow + let private sfs days = genSinWave (float days * 2.) 0. |> Seq.map (fun x -> (x * 2.)) + // fast, slow, fast + let private fsf days = genSinWave (float days * 2.) (float days) |> Seq.map (fun x -> (x + 1.) * 2.) + // fast, slow, fast, slow + let private fsfs days = genSinWave (float days * 0.666) (float days * 0.2) |> Seq.map (fun x -> (x + 1.)) + + let private scurveBurndown days storyPoints (f:int -> float seq) (weight:float) = + [| + let avg = float storyPoints / float days + yield! + Normal.WithMeanVariance(avg, avg * 3.).Samples() + |> Seq.zip (f days) + |> Seq.map (fun (x,y) -> x * (max y 0.) * weight) + |> Seq.map int + |> Seq.map (max 4) + |> Seq.scan (fun state t -> state - t) storyPoints + |> Seq.takeWhile (fun x -> x > 0) + yield 0 + |] + + let slowFastSlow (chart:BurnDownChart) = {chart with remaining = scurveBurndown chart.days chart.storyPoints sfs 0.8} + let fastSlowFast (chart:BurnDownChart) = {chart with remaining = scurveBurndown chart.days chart.storyPoints fsf 1.3} + let fastSlowFastSlow (chart:BurnDownChart) = {chart with remaining = scurveBurndown chart.days chart.storyPoints fsfs 1.0} + let avereage (chart:BurnDownChart) = + {chart with + remaining = + [| + let avg = float chart.storyPoints / float chart.days + yield! + Normal.WithMeanVariance(avg, avg * 3.).Samples() + |> Seq.map int + |> Seq.map (max 4) + |> Seq.scan (fun state t -> state - t) chart.storyPoints + |> Seq.takeWhile (fun x -> x > 0) + yield 0 + |] + } + let mutable private excelChart = Option.None + let truncate (n:int) (chart:BurnDownChart) = {chart with remaining = chart.remaining |> Seq.truncate n |> Seq.toArray} + let display (chart:BurnDownChart) = + + let plotData (chart:Chart) ys = + for (xs,color, name) in ys do + let seriesCollection = chart.SeriesCollection() :?> SeriesCollection + let series = seriesCollection.NewSeries() + series.MarkerForegroundColor <- color + series.Name <- name + series.Format.Line.ForeColor.RGB <- color + series.Values <- xs + + let displayChart (bdc:BurnDownChart) (ec:Chart) = + ec.HasTitle <- true + ec.ChartTitle.Text <- bdc.title + let xAxis = ec.Axes(XlAxisType.xlCategory, XlAxisGroup.xlPrimary) :?> Axis + xAxis.HasTitle <- true + xAxis.AxisTitle.Text <- bdc.xAxis + let yAxis = ec.Axes(XlAxisType.xlValue, XlAxisGroup.xlPrimary) :?> Axis + yAxis.HasTitle <- true + yAxis.AxisTitle.Text <- bdc.yAxis + [| + idealBurndown bdc.days bdc.storyPoints, Colors.blue,"Ideal Burndown" + bdc.remaining, Colors.red,"Remaining" + |] + |> plotData ec + + match excelChart with + | Some(x) -> + ExcelCharts.clear x + displayChart chart x + | None -> + match ExcelCharts.NewChart() with + | Some(y) -> + excelChart <- Some(y) + y.ChartType <- XlChartType.xlLineMarkers + displayChart chart y + | None -> () // no-op + +module WidgetCo = + let moreHeadCountNeeded : BurnDownChart -> BurnDownChart = failwith "todo" + let everythingIsFine : BurnDownChart -> BurnDownChart = failwith "todo" + /// Demonstrate little and slowing progress + let thisWasNotMyIdea : BurnDownChart -> BurnDownChart = failwith "todo" + + + + +let Default = { + title = "Big Important Project Burn Down" + xAxis = "Iteration Timeline (days)" + yAxis = "Sum of Task Estimates (Story Points)" + days = 20 + storyPoints = 200 + remaining = [||] + } + +Default |> slowFastSlow |> display +Default |> fastSlowFast |> truncate 10 |> display +Default |> fastSlowFastSlow |> display +Default |> avereage |> display diff --git a/Excel/Charting/ExcelEnv.fsx b/Samples/Excel/ExcelCharts.fsx similarity index 89% rename from Excel/Charting/ExcelEnv.fsx rename to Samples/Excel/ExcelCharts.fsx index 835d18c..4381f8e 100644 --- a/Excel/Charting/ExcelEnv.fsx +++ b/Samples/Excel/ExcelCharts.fsx @@ -1,7 +1,7 @@ -module Excel +module ExcelCharts //Written by Mathias Brandewinder (Twitter: @brandewinder Blog: http://www.clear-lines.com/blog/) -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\office.dll" -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Microsoft.Office.Interop.Excel.dll" +#r "cache:http://tsunami.io/assemblies/office.dll" +#r "cache:http://tsunami.io/assemblies/Microsoft.Office.Interop.Excel.dll" open Microsoft.Office.Interop.Excel open System.Runtime.InteropServices @@ -202,4 +202,19 @@ let labeledplot<'a when 'a: equality> (data: (float * float * 'a * string ) seq) let point = series.Points(i) :?> Point point.DataLabel.Text <- ls.[i-1] chart.ChartType <- XlChartType.xlXYScatter - xl.ScreenUpdating <- true \ No newline at end of file + xl.ScreenUpdating <- true + +type SeriesData = {Name : string; XValues : obj[]; Values : obj[] } + +let appendSeries (chartType : XlChartType, seriesData : SeriesData) (chart : Chart) = + chart.ChartType <- chartType + let seriesCollection = chart.SeriesCollection() :?> SeriesCollection + let series = seriesCollection.NewSeries() + series.Name <- seriesData.Name + series.Values <- seriesData.Values + series.XValues <- seriesData.XValues + chart + +let clear (c:Chart) = + let sc = c.SeriesCollection() :?> Microsoft.Office.Interop.Excel.SeriesCollection + for i in [sc.Count .. -1 .. 1] do sc.Item(i).Delete() |> ignore \ No newline at end of file diff --git a/Excel/Charting/README.md b/Samples/Excel/README.md similarity index 100% rename from Excel/Charting/README.md rename to Samples/Excel/README.md diff --git a/Excel/Charting/ChartingDemo.fsx b/Samples/Excel/Stocks/Demo.fsx similarity index 62% rename from Excel/Charting/ChartingDemo.fsx rename to Samples/Excel/Stocks/Demo.fsx index 6c6fa19..40d766a 100644 --- a/Excel/Charting/ChartingDemo.fsx +++ b/Samples/Excel/Stocks/Demo.fsx @@ -1,5 +1,5 @@ -#load @"C:\ExcelEnv.fsx" -#load @"C:\StocksScript.fsx" +//#load @"ExcelEnv.fsx" +#load "StocksScript.fsx" open StockScript open System open System.Net @@ -17,5 +17,6 @@ chart |> addMovingAverages msft chart |> clear for stock in ["AAPL";"MSFT";"GOOG"] do - chart |> addStockHistory (read (stock, now.AddMonths(-6), now)) - chart |> addMovingAverages (read (stock, now.AddMonths(-6), now)) + let data = (read (stock, now.AddMonths(-6), now)) + chart |> addStockHistory data + chart |> addMovingAverages data diff --git a/Excel/Charting/StocksScript.fsx b/Samples/Excel/Stocks/StocksScript.fsx similarity index 84% rename from Excel/Charting/StocksScript.fsx rename to Samples/Excel/Stocks/StocksScript.fsx index 690dd25..98086dc 100644 --- a/Excel/Charting/StocksScript.fsx +++ b/Samples/Excel/Stocks/StocksScript.fsx @@ -1,9 +1,10 @@ module StockScript -/// A translation by Matthew Moloney of http://vstostocks.codeplex.com/ by Mathias Brandewinder (Twitter: @brandewinder Blog: http://www.clear-lines.com/blog/) -#r @"C:\Program Files (x86)\Microsoft Visual Studio 11.0\Visual Studio Tools for Office\PIA\Office14\Microsoft.Office.Interop.Excel.dll" +/// A translation of http://vstostocks.codeplex.com/ (Twitter: @brandewinder Blog: http://www.clear-lines.com/blog/) by Matthew Moloney +#load "..\ExcelCharts.fsx" open Microsoft.Office.Interop.Excel open System open System.Net +open ExcelCharts type TradingDaySummary = {Day : DateTime; Volume : int64; Open : float; Close : float; High : float; Low : float} @@ -44,20 +45,7 @@ let run (history : StockHistory, horizon : int, runs : int) = |> Async.Parallel |> Async.RunSynchronously - - - -type SeriesData = {Name : string; XValues : obj[]; Values : obj[] } - -let appendSeries (chartType : XlChartType, seriesData : SeriesData) (chart : Chart) = - chart.ChartType <- chartType - let seriesCollection = chart.SeriesCollection() :?> SeriesCollection - let series = seriesCollection.NewSeries() - series.Name <- seriesData.Name - series.Values <- seriesData.Values - series.XValues <- seriesData.XValues - chart - + let addStockHistory (history : StockHistory) (chart : Chart) = let dataPoints = history.History |> Array.sortBy (fun x -> x.Day) let xValues = dataPoints |> Array.map (fun x -> box x.Day); @@ -137,6 +125,3 @@ let writeHistory(history : StockHistory, worksheet : Worksheet) = range.Value2 <- dataArray range.NumberFormat <- formatArray -let clear (c:Chart) = - let sc = c.SeriesCollection() :?> Microsoft.Office.Interop.Excel.SeriesCollection - for i in [sc.Count .. -1 .. 1] do sc.Item(i).Delete() |> ignore \ No newline at end of file diff --git a/Samples/Excel/UDFs/CSharp.cs b/Samples/Excel/UDFs/CSharp.cs new file mode 100644 index 0000000..9428848 --- /dev/null +++ b/Samples/Excel/UDFs/CSharp.cs @@ -0,0 +1,14 @@ +using System; + +namespace ClassLibrary1 +{ + public static class Class1 + { + public static Double fAdd3(Double x, Double y) { return x + y + 3.0; } + + public static Double fMult3(Double x) { return x * 3.0; } + + public static Double fSquare(Double x) { return x * x; } + + } +} diff --git a/Samples/Excel/UDFs/Nasdaq100.xlsx b/Samples/Excel/UDFs/Nasdaq100.xlsx new file mode 100644 index 0000000..16476ea Binary files /dev/null and b/Samples/Excel/UDFs/Nasdaq100.xlsx differ diff --git a/Samples/Excel/UDFs/VisualBasic.vb b/Samples/Excel/UDFs/VisualBasic.vb new file mode 100644 index 0000000..19f2b27 --- /dev/null +++ b/Samples/Excel/UDFs/VisualBasic.vb @@ -0,0 +1,18 @@ +Namespace ClassLibrary1 + Public NotInheritable Class Class1 + Private Sub New() + End Sub + Public Shared Function fAdd3(x As [Double], y As [Double]) As [String] + Return x + y + 3.0 + End Function + + Public Shared Function fMult3(x As [Double]) As [Double] + Return x * 3.0 + End Function + + Public Shared Function fSquare(x As [Double]) As [Double] + Return x * x + End Function + + End Class +End Namespace \ No newline at end of file diff --git a/Samples/Excel/Widget/Widget.xlsx b/Samples/Excel/Widget/Widget.xlsx new file mode 100644 index 0000000..0fed1f2 Binary files /dev/null and b/Samples/Excel/Widget/Widget.xlsx differ diff --git a/Samples/Excel/Widget/WidgetDemo.fsx b/Samples/Excel/Widget/WidgetDemo.fsx new file mode 100644 index 0000000..109aeb8 --- /dev/null +++ b/Samples/Excel/Widget/WidgetDemo.fsx @@ -0,0 +1,84 @@ +#r "System.Data" +#r "System.Core" +#r "System.Data.Linq.dll" +#r "System.Data.Entity.dll" +#r "cache:http://tsunami.io/assemblies/Microsoft.Office.Interop.Excel.dll" +#r "cache:http://tsunami.io/assemblies/office.dll" +#r "cache:http://tsunami.io/assemblies/FSharp.Data.TypeProviders.dll" + +#r "cache:http://tsunami.io/assemblies/FCell.XlProvider.dll" +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.dll" +#r "cache:http://tsunami.io/assemblies/MathNet.Numerics.FSharp.dll" + +open System +open System.IO +open System.Data +open System.Data.Linq +open Microsoft.FSharp.Linq +open Microsoft.FSharp.Data.TypeProviders +open MathNet.Numerics.Random +open MathNet.Numerics.Distributions +open FCell.XlProvider +open FCell.TypeProviders.XlProvider +open Microsoft.Office.Interop.Excel + +type dbSchema = SqlEntityConnection<"Server=tcp:xxxx.database.windows.net,1433;Database=TsunamiAzure;User ID=xxxx@xxxxx;Password=xxxx;Trusted_Connection=False;Encrypt=True;Connection Timeout=30;"> +let dc = dbSchema.GetDataContext() + +let widgetReport = new XlWorkbook< "">() + +let clearSQLAzure() = + for x in dc.EUDoDLift do dc.EUDoDLift.DeleteObject(x) + for x in dc.EUMoMLift do dc.EUMoMLift.DeleteObject(x) + dc.DataContext.SaveChanges() + +let uploadExcelToAzure() = + clearSQLAzure() |> ignore + + widgetReport.EUMoM + |> Seq.iteri (fun i x -> dc.EUMoMLift.AddObject(dbSchema.ServiceTypes.EUMoMLift(ID = i, Lift = x))) + + widgetReport.EUDoD + |> Seq.iteri (fun i x -> dc.EUDoDLift.AddObject(dbSchema.ServiceTypes.EUDoDLift(ID = i, Lift = x))) + + widgetReport.USAMoM + |> Seq.iteri (fun i x -> dc.USAMoMLift.AddObject(dbSchema.ServiceTypes.USAMoMLift(ID = i, Lift = x))) + + widgetReport.USADoD + |> Seq.iteri (fun i x -> dc.USADoDLift.AddObject(dbSchema.ServiceTypes.USADoDLift(ID = i, Lift = x))) + + dc.DataContext.SaveChanges() + +let downloadAzureToExcel() = + widgetReport.EUDoD <- [| for x in dc.EUDoDLift -> x |] |> Array.sortBy (fun x -> x.ID) |> Array.map (fun x -> x.Lift) + widgetReport.EUMoM <- [| for x in dc.EUMoMLift -> x |] |> Array.sortBy (fun x -> x.ID) |> Array.map (fun x -> x.Lift) + widgetReport.USADoD <- [| for x in dc.USADoDLift -> x |] |> Array.sortBy (fun x -> x.ID) |> Array.map (fun x -> x.Lift) + widgetReport.USAMoM <- [| for x in dc.USAMoMLift -> x |] |> Array.sortBy (fun x -> x.ID) |> Array.map (fun x -> x.Lift) + +let clearExcel() = + widgetReport.EUDoD <- Array.create 7 0. + widgetReport.EUMoM <- Array.create 12 0. + widgetReport.USADoD <- Array.create 7 0. + widgetReport.USAMoM <- Array.create 12 0. + +let genSynthetic() = + widgetReport.EUDoD <- Normal.WithMeanVariance(0.02, 0.003).Samples() |> Seq.take 7 |> Seq.toArray + widgetReport.EUMoM <- Normal.WithMeanVariance(0.02, 0.001).Samples() |> Seq.take 12 |> Seq.toArray + widgetReport.USADoD <- Normal.WithMeanVariance(0.05, 0.003).Samples() |> Seq.take 7 |> Seq.toArray + widgetReport.USAMoM <- Normal.WithMeanVariance(0.05, 0.001).Samples() |> Seq.take 12 |> Seq.toArray + +let demo() = + async { + clearExcel() + genSynthetic() + uploadExcelToAzure() |> ignore + do! Async.Sleep 500 + clearExcel() + do! Async.Sleep 500 + downloadAzureToExcel() + do! Async.Sleep 500 + genSynthetic() + do! Async.Sleep 500 + downloadAzureToExcel() + clearExcel() + } |> Async.RunSynchronously \ No newline at end of file diff --git a/Samples/Excel/Zero Install/ExcelDemo.cs b/Samples/Excel/Zero Install/ExcelDemo.cs new file mode 100644 index 0000000..560a4c5 --- /dev/null +++ b/Samples/Excel/Zero Install/ExcelDemo.cs @@ -0,0 +1,5 @@ +public static class ExcelUdfs +{ + public static string CSHelloWorld() { return "Hello World from C#!";} +} + diff --git a/Samples/Excel/Zero Install/ExcelDemo.fs b/Samples/Excel/Zero Install/ExcelDemo.fs new file mode 100644 index 0000000..8f005c0 --- /dev/null +++ b/Samples/Excel/Zero Install/ExcelDemo.fs @@ -0,0 +1,12 @@ +module ExcelUdfs +open System +open System.Net + +let ``FS.HelloWorld``() = "Hello World from F#!" +let ``FS.getLastTrade``() : Async = + async { + use client = new WebClient() + let url = sprintf "http://download.finance.yahoo.com/d/quotes.csv?s=%s&f=l1&e=.csv" "MSFT" + let! res = client.AsyncDownloadString(Uri(url)) + return float res + } \ No newline at end of file diff --git a/Samples/Excel/Zero Install/ExcelDemo.vb b/Samples/Excel/Zero Install/ExcelDemo.vb new file mode 100644 index 0000000..ef32c74 --- /dev/null +++ b/Samples/Excel/Zero Install/ExcelDemo.vb @@ -0,0 +1,7 @@ +Public NotInheritable Class ExcelUdfs + Private Sub New() + End Sub + Public Shared Function VBHelloWorld() + Return "Hello World from VB!" + End Function +End Class \ No newline at end of file diff --git a/Samples/Excel/Zero Install/ExcelDemoSetup.fsx b/Samples/Excel/Zero Install/ExcelDemoSetup.fsx new file mode 100644 index 0000000..2b7697e --- /dev/null +++ b/Samples/Excel/Zero Install/ExcelDemoSetup.fsx @@ -0,0 +1,68 @@ +#r "Tsunami.IDEDesktop.exe" +open System +open System.IO +open Tsunami.IDE + +let demoDir = __SOURCE_DIRECTORY__ + +(* Zero Install Excel FCell components are not yet publically available *) +(* +#r @"NOT RELEASED YET\FCell.Packaging.dll" +open FCell.Packaging.Packager +let root = @"NOT RELEASED YET" +let generate ouput (dlls:string[]) = + File.Delete(output) + File.Copy(root + "Packaged.xlsm.bak", output) + + packageUDFs ([| + yield! + [| + "FCell.Bootstrap.xll" + "FCell.ManagedXll.dll" + "FCell.ManagedXll.Rtd.dll" + |] |> Array.map ((+) root) + yield! dlls |> Array.filter (fun x -> x <> demoDir + "VBExcelDemo.dll") + yield @"C:\Program Files (x86)\Reference Assemblies\Microsoft\FSharp\3.0\Runtime\v4.0\FSharp.Core.dll" + yield @"VBExcelDemo.dll" + |]) + output +*) + +#r @"C:\Program Files (x86)\Open XML SDK\V2.0\lib\DocumentFormat.OpenXml.dll" + +let output = demoDir + "Demo.xlsm" + +let buildCS = Build.csharpProject +let buildVB = Build.csharpProject + + + +let fsProject = { FSharpProject.DebugBuild with references = [| yield @"System.dll"; yield @"System.Net.dll"; yield! FSharpProject.DebugBuild.references |]; name = "Excel F#"; code = [| FS.File(demoDir + "ExcelDemo.fs") |]; out = Some(demoDir + "FSExcelDemo.dll") } +let cSharpProject = { CSharpProject.Empty with name = "Excel C#"; code = [| FS.File(demoDir + "ExcelDemo.cs") |]; out = Some(demoDir + "CSExcelDemo.dll") } +let vbProject = { VBProject.Empty with name = "Excel VB"; code = [| FS.File(demoDir + "ExcelDemo.vb") |]; out = Some(demoDir + "VBExcelDemo.dll") } + +(* Add projects to Project View *) +let addProjects() = + ProjectsViewModel.Instance.Add(fsProject) + [cSharpProject; vbProject] |> Seq.iter ProjectsViewModel.Instance.Add + +(* Build Projects *) +let buildAndDeploy() = + Build.fsharpProject(fsProject) + fsProject.build(fsProject) + buildCS(cSharpProject) + buildVB(vbProject) + + (* Embed into Excel Workbook *) + [| "FSExcelDemo.dll"; "CSExcelDemo.dll"; "VBExcelDemo.dll"|] + |> Array.map ((+) demoDir) + |> generate (demoDir + "Demo.xlsm") + + + + + + + + + diff --git a/Samples/FunScript/ChatClient.fsx b/Samples/FunScript/ChatClient.fsx new file mode 100644 index 0000000..3368df8 --- /dev/null +++ b/Samples/FunScript/ChatClient.fsx @@ -0,0 +1,372 @@ +#r "cache:http://tsunami.io/assemblies/FunScript.dll" +#r "cache:http://tsunami.io/assemblies/FunScript.TypeScript.dll" +#r "cache:http://tsunami.io/assemblies/FunScript.TypeScript.Interop.dll" +#load @"ChatServer.fsx" + +open System +open System.IO +open FunScript +open FunScript.TypeScript +open System.Threading + + + +[] +let ts = """http://tsunami.io/TypeScript/jquery.d.ts + http://tsunami.io/TypeScript/bootstrap.d.ts + """ + +type j = TypeScript.Api + +type Async = + static member AwaitJQueryEvent(f : ('T -> obj) -> j.JQuery) : Async<'T> = + Async.FromContinuations(fun (cont, econt, ccont) -> + let named = ref None + named := Some (f (fun v -> + (!named).Value.off() |> ignore + cont v + obj() ))) + +[] +module JQuery = + let prepend (x:j.JQuery) (y:j.JQuery) = y.prepend([|box x|]) + let append (xs:j.JQuery[]) (y:j.JQuery) = y.append([|for x in xs do yield box x|]) |> ignore; y + let nestedAppend (xs:j.JQuery[]) (y:j.JQuery) = + let nest (x:j.JQuery) (y:j.JQuery) = + y.append([|box x|]) |> ignore; x + xs |> Seq.fold (fun state x -> nest x state) y |> ignore + y + + let after (x:j.JQuery) (y:j.JQuery) = x.insertAfter(box y) |> ignore; y + let before (x:j.JQuery) (y:j.JQuery) = x.insertBefore(box y) |> ignore; y + + let addAttr (attr:string) (value:string) (x:j.JQuery) = x.attr(attr,value) |> ignore; x + let addClass (``class``:string) (x:j.JQuery) = x.addClass(``class``) |> ignore; x + let setId (id:string) (x:j.JQuery) = x.attr("id",id) |> ignore; x + let onClick (f:unit->unit) (x:j.JQuery) = + x.click(Func(fun _ -> f(); box null)) |> ignore + x + + let hide(x:j.JQuery) = x.hide() + let show(x:j.JQuery) = x.show() + + let onSubmit (f:unit->unit) (x:j.JQuery) = + x.submit(Func(fun _ -> f(); box null)) + + let html (s:string) (j:j.JQuery) = j.html s |> ignore; j + + let attrs (xs:(string*string)[]) (jobj:j.JQuery) = + xs |> Array.iter (fun (name,value) -> jobj.attr(name,value) |> ignore) + jobj + +[] +module Bootstrap = + let showModal (x:j.JQuery) = x.modal("show") + let hideModal (x:j.JQuery) = x.modal("hide") + +[] +module WebSocket = + type IWebSocket = + abstract send : string -> unit + abstract close : unit -> unit + + [] + let createImpl(host : string, onOpen : unit -> unit, onMessage : string -> unit, onClosed : unit -> unit) : IWebSocket = + failwith "never" + + let create(host, onMessage, onClosed) = + Async.FromContinuations (fun (callback, _, _) -> + let socket = ref Unchecked.defaultof<_> + socket := createImpl(host, (fun () -> callback !socket), onMessage, onClosed) + ) + +[] +[] +module Utilities = + [] + let field<'a> (y:string,x:obj) : 'a = failwith "never" + + let (?) (x:'a) (name:string) = field(name,x) + + +[] +module String = + [] + let IsNullOrWhiteSpace (s: string) : bool = failwith "never" + +[] +module TsunamiStateMachine = + let jQuery (command:string) = j.jQuery.Invoke(command) + let ignore _ = () + let (-->) (x:j.JQuery) (y:j.JQuery) = x.append([|box y|]) |> ignore; y + let (<--) (x:j.JQuery) (y:j.JQuery) = x.append([|box y|]) |> ignore; x + + type State = + | Login + | Messages of string * string // username, email + + type Message = + | LoginM of string * string // username, email + | LogoutM + + [] + let alert (s: string) : unit = failwith "never" + +// [] +// let animateScrollBottom(x:j.JQuery) : unit = failwith "never" + + [] + let scrollChatToBottom() : unit = failwith "never" + + type Model() = + + let loginLink = + jQuery("""
  • Login
    • """) + + let logoutLink = + jQuery("""
  • Logout
    • """) + |> JQuery.hide + + let email = jQuery("") |> JQuery.attrs [| "type", "text"; "placeholder", "Email" |] + + let username = jQuery("") |> JQuery.attrs [| "type", "text"; "placeholder", "Username" |] + + let login_button = jQuery("""Login""") + let close_login_button = jQuery("""Close """) + + let loginPanel = + jQuery("""