Created
September 17, 2019 01:23
-
-
Save jdh30/2a6a958fc1d01531c92c55e1641fe51d to your computer and use it in GitHub Desktop.
F#+WPF solution to the Draggable Rectangles challenge by Panicz Godek
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 | |
[<System.STAThread; EntryPoint>] | |
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
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:
Limitations of this solution: