craig.oates
/
smouldering-beach-ball
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
Browse Source

seperate into public and private modules and namespaces.

master
Craig Oates 6 years ago
parent
74c30f216d
commit
9fc1d6c46a
6 changed files with 115 additions and 96 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 21
      SmoulderingBeachBall/DomainTypes.fs
  2. 92
      SmoulderingBeachBall/ImageMaker.fs
  3. 64
      SmoulderingBeachBall/InternalServices.fs
  4. 22
      SmoulderingBeachBall/PublicServices.fs
  5. 8
      SmoulderingBeachBall/ScratchPad.fsx
  6. 4
      SmoulderingBeachBall/SmoulderingBeachBall.fsproj

21
SmoulderingBeachBall/DomainTypes.fs
Unescape View File

@ -0,0 +1,21 @@
namespace SmoulderingBeachBall
[<AutoOpen>]
module DomainTypes =
open System.Drawing
type OverlayType =
| Border
| Full
type OverlaySpec =
{ colour: Brush;
overlayType: OverlayType }
type ImageSpec =
{ width: int;
height: int;
colour: Brush;
filePath: string;
overlay: OverlaySpec option }

92
SmoulderingBeachBall/ImageMaker.fs
Unescape View File

@ -1,92 +0,0 @@
namespace SmoulderingBeachBall
module ImageMaker =
open System
open System.IO
open System.Drawing
type OverlayType =
| Border
| Full
type OverlaySpec =
{ colour: Brush;
overlayType: OverlayType }
type ImageSpec =
{ width: int;
height: int;
colour: Brush;
filePath: string;
overlay: OverlaySpec option }
let private validateDimension dimension =
match dimension with
| dimension when dimension <= 0 -> invalidArg "dimension" "The width and height must be greater than 0."
| _ -> ()
let private validateDirectory filePath =
let path = Path.GetDirectoryName filePath
match (Directory.Exists path) with
| false -> invalidArg "filePath" "Unable to save to the specified location because it does not exist."
| true -> ()
let private penOffset penWidth = int (penWidth / (float32 2))
let private createBorderPath penWidth spec =
let offset = penOffset penWidth
[|Point (0, offset); // Essentially (0, 0)
Point ((spec.width - offset), offset);
Point ((spec.width - offset), (spec.height - offset));
Point (offset, (spec.height - offset));
Point (offset, 0)|]
let private drawBorder (graphics: Graphics) (pen: Pen) spec =
printfn "[INFO.] Adding border to image..."
let penPath = createBorderPath pen.Width spec
graphics.DrawLines (pen, penPath)
let private drawFullOverlay (graphics: Graphics) (pen: Pen) spec =
drawBorder graphics pen spec
printfn "[INFO.] Adding full overlay to image..."
let offset = penOffset pen.Width
// Draws line from top-left to bottom-right of square.
graphics.DrawLine (pen, offset, offset, (spec.width - offset), (spec.height - offset))
// Draws line from top-right to bottom-left of square.
graphics.DrawLine (pen, (spec.width - offset), offset, offset, (spec.height - offset))
let private addOverlayToImage graphics spec =
let overlay = spec.overlay.Value
let pen = new Pen (overlay.colour, Width = 10.0f)
match overlay.overlayType with
| Border -> drawBorder graphics pen spec
| Full -> drawFullOverlay graphics pen spec
let private drawImage spec =
let bitmap = new Bitmap (spec.width, spec.height)
let graphics = Graphics.FromImage (bitmap)
let rectangle = Rectangle (0, 0, spec.width, spec.height)
graphics.FillRectangle (spec.colour, rectangle)
match spec.overlay.IsSome with
| true -> addOverlayToImage graphics spec
| false -> printfn "[INFO.] No overlay specified. Creating image without one."
bitmap.Save (spec.filePath)
bitmap.Dispose()
graphics.Dispose()
let makeImage spec =
async {
try
printfn "[INFO.] Attempting to make image..."
validateDimension spec.width
validateDimension spec.height
validateDirectory spec.filePath
drawImage spec
printfn "[SUCCESS] Image creation attempt complete."
return ()
with
| :? ArgumentException as ex -> printfn "%s" ex.Message
| _ as ex -> printfn "%s" ex.Message
}

64
SmoulderingBeachBall/InternalServices.fs
Unescape View File

@ -0,0 +1,64 @@
module internal InternalServices
open System.IO
open System.Drawing
open SmoulderingBeachBall
module Validation =
let validateDimension dimension =
match dimension with
| dimension when dimension <= 0 -> invalidArg "dimension" "The width and height must be greater than 0."
| _ -> ()
let validateDirectory filePath =
let path = Path.GetDirectoryName filePath
match (Directory.Exists path) with
| false -> invalidArg "filePath" "Unable to save to the specified location because it does not exist."
| true -> ()
module Drawing =
let penOffset penWidth = int (penWidth / (float32 2))
let createBorderPath penWidth spec =
let offset = penOffset penWidth
[|Point (0, offset); // Essentially (0, 0)
Point ((spec.width - offset), offset);
Point ((spec.width - offset), (spec.height - offset));
Point (offset, (spec.height - offset));
Point (offset, 0)|]
let drawBorder (graphics: Graphics) (pen: Pen) spec =
printfn "[INFO.] Adding border to image..."
let penPath = createBorderPath pen.Width spec
graphics.DrawLines (pen, penPath)
let drawFullOverlay (graphics: Graphics) (pen: Pen) spec =
drawBorder graphics pen spec
printfn "[INFO.] Adding full overlay to image..."
let offset = penOffset pen.Width
// Draws line from top-left to bottom-right of square.
graphics.DrawLine (pen, offset, offset, (spec.width - offset), (spec.height - offset))
// Draws line from top-right to bottom-left of square.
graphics.DrawLine (pen, (spec.width - offset), offset, offset, (spec.height - offset))
let addOverlayToImage graphics spec =
let overlay = spec.overlay.Value
let pen = new Pen (overlay.colour, Width = 10.0f)
match overlay.overlayType with
| Border -> drawBorder graphics pen spec
| Full -> drawFullOverlay graphics pen spec
let drawImage spec =
let bitmap = new Bitmap (spec.width, spec.height)
let graphics = Graphics.FromImage (bitmap)
let rectangle = Rectangle (0, 0, spec.width, spec.height)
graphics.FillRectangle (spec.colour, rectangle)
match spec.overlay.IsSome with
| true -> addOverlayToImage graphics spec
| false -> printfn "[INFO.] No overlay specified. Creating image without one."
bitmap.Save (spec.filePath)
bitmap.Dispose()
graphics.Dispose()

22
SmoulderingBeachBall/PublicServices.fs
Unescape View File

@ -0,0 +1,22 @@
namespace SmoulderingBeachBall
module ImageMaker =
open System
open InternalServices.Validation
open InternalServices.Drawing
let makeImage (spec: ImageSpec) =
async {
try
printfn "[INFO.] Attempting to make image..."
validateDimension spec.width
validateDimension spec.height
validateDirectory spec.filePath
drawImage spec
printfn "[SUCCESS] Image creation attempt complete."
return ()
with
| :? ArgumentException as ex -> printfn "%s" ex.Message
| _ as ex -> printfn "%s" ex.Message
}

8
SmoulderingBeachBall/ScratchPad.fsx
Unescape View File

@ -1,9 +1,11 @@
#load "ImageMaker.fs"
#load "DomainTypes.fs"
#load "InternalServices.fs"
#load "PublicServices.fs"
open System.Drawing
open System.Drawing.Imaging
open SmoulderingBeachBall
open SmoulderingBeachBall.ImageMaker
open Domain
// INITIAL IDEA =======================================================================================================
@ -35,4 +37,4 @@ let imageSpec =
filePath = "C:/users/craig/desktop/test.png";
overlay = Some fullOverlay } // Change this to quickly change between border/full overlay or None.
ImageMaker.makeImage imageSpec |> Async.RunSynchronously
makeImage imageSpec |> Async.RunSynchronously

4
SmoulderingBeachBall/SmoulderingBeachBall.fsproj
Unescape View File

@ -5,7 +5,9 @@
</PropertyGroup>
<ItemGroup>
<Compile Include="ImageMaker.fs" />
<Compile Include="DomainTypes.fs" />
<Compile Include="InternalServices.fs" />
<Compile Include="PublicServices.fs" />
<None Include="ScratchPad.fsx" />
</ItemGroup>

Write Preview
Loading…
Cancel
Save