{{ message }}

Instantly share code, notes, and snippets.

# jdh30/DraggableRectangles.fs

Created Sep 17, 2019
F#+WPF solution to the Draggable Rectangles challenge by Panicz Godek
 open System.Windows let goldenRatio = (1.0 + sqrt 5.0) / 2.0 let newBrush = let mutable hue = 0.0 fun () -> hue <- hue + System.Math.PI / goldenRatio let s x = byte(255.0 * x) let c x = 0.5 * (cos x + 1.0) let r = c hue / 1.5 let g = c(hue + 4.0 / 3.0 * System.Math.PI) / 2.0 let b = c(hue + 8.0 / 3.0 * System.Math.PI) let color = Media.Color.FromRgb(s r, s g, s b) Media.SolidColorBrush(Color=color) let mutable nextBrush = newBrush() type Rectangle = { Brush: Media.Brush Corner: Vector Size: float } type Scene = Rectangle of Rectangle * Scene list let mutable scene : Scene list = [] let mutable drag : Vector option = None /// Is x0 <= x <= x1? let between x0 x x1 = x0 <= x && x <= x1 /// Is the given point inside the given rectangle? let isPointInRectangle (point: Vector) rect = between rect.Corner.X point.X (rect.Corner.X + rect.Size) && between rect.Corner.Y point.Y (rect.Corner.Y + rect.Size) /// Try to remove the rectangle at the given point, returning the rectangle and remaining scene. let rec tryRemove point scene = match scene with | [] -> None | Rectangle(rect, children)::scene -> if isPointInRectangle point rect then match tryRemove point children with | None -> Some(Rectangle(rect, children), scene) | Some(child, children) -> Some(child, Rectangle(rect, children)::scene) else match tryRemove point scene with | None -> None | Some(child, scene) -> Some(child, Rectangle(rect, children)::scene) /// Insert the given child rectangle at the given point. let rec add point child scene = match scene with | [] -> [child] | Rectangle(rect, children)::scene -> if isPointInRectangle point rect then Rectangle(rect, add point child children)::scene else Rectangle(rect, children)::add point child scene /// Apply the given function "f" to this rectangle and all of its children recursively. let rec map f (Rectangle(rect, children)) = Rectangle(f rect, List.map (map f) children) /// Scale a rectangle and all of its children. let scale factor = map (fun r -> { r with Size = r.Size * factor }) /// Scale the rectangle at the given point. let rec scaleAt s point scene = let f r = { r with Size = s * r.Size } match scene with | [] -> None | Rectangle(rect, children)::scene -> if isPointInRectangle point rect then let rect = match scaleAt s point children with | None -> Rectangle(f rect, children) | Some children -> Rectangle(rect, children) Some(rect::scene) else scaleAt s point scene |> Option.map (fun scene -> Rectangle(rect, children)::scene) /// Translate a rectangle and all of its children. let translate vector = map (fun r -> { r with Corner = r.Corner + vector }) /// Remove the rectangle (if any) from the given point and insert it at the new point. let move oldPoint newPoint scene = match tryRemove oldPoint scene with | None -> Rectangle({Brush=nextBrush; Corner=newPoint; Size=100.0}, [])::scene | Some(child, scene) -> add newPoint (translate (newPoint - oldPoint) child) scene let canvas = Controls.Canvas() let rec drawScene scene = for Rectangle(rect, children) in List.rev scene do let shape = Shapes.Rectangle() shape.Fill <- rect.Brush Controls.Canvas.SetLeft(shape, rect.Corner.X) Controls.Canvas.SetTop(shape, rect.Corner.Y) shape.Width <- rect.Size shape.Height <- rect.Size let _ = canvas.Children.Add shape drawScene children let draw scene = canvas.Children.Clear() drawScene scene let startDrag point = drag <- Some point let stopDrag oldPoint newPoint = scene <- move oldPoint newPoint scene drag <- None nextBrush <- newBrush() draw scene [] let main _ = canvas.Background <- Media.Brushes.Black let vectorOf f : Vector = Point.op_Explicit(f canvas) canvas.MouseDown.Add(fun e -> startDrag (vectorOf e.GetPosition)) canvas.MouseMove.Add(fun e -> let newPoint = vectorOf e.GetPosition match drag, e.LeftButton = Input.MouseButtonState.Pressed with | None, false -> () | None, true -> startDrag newPoint | Some oldPoint, false -> stopDrag oldPoint newPoint | Some oldPoint, true -> draw(move oldPoint newPoint scene)) canvas.MouseUp.Add(fun e -> match drag with | None -> () | Some oldPoint -> stopDrag oldPoint (vectorOf e.GetPosition)) canvas.MouseWheel.Add(fun e -> scaleAt (1.0 + float e.Delta / 1000.0) (vectorOf e.GetPosition) scene |> Option.iter (fun s -> scene <- s) draw scene) draw scene Window(Title="Draggable rectangles", Content=canvas) |> Application().Run

### jdh30 commented Sep 17, 2019

 This is a WPF-based GUI app that lets you create rectangles, scale them and nest them inside each other. Click on the black background to create a new rectangle. Use the mouse wheel to scale the rectangle under the pointer. Drag the rectangles around and drop them inside each other to create a tree of nested rectangles. Some notable points: This is a pragmatic solution designed to be simple and not designed to be a pedagogical example for any paradigm (functional or OOP). I haven't used any objects or (IMO) object orientation beyond the fact that the underlying library (WPF) is OOP but I have used recursive types and functions over them. The tree of rectangles is represented as a classical ML tree via an algebraic data type rather than the dictionary-based representation used by Christer. IMO, this code would be even shorter and simpler if it used a better graphics library than WPF. Would be interesting to port this to the Raspberry Pi using .NET Core and GTK#. Limitations of this solution: The rectangles are all squares. Nested rectangles are not clipped to their parents so they can overhang.