7 people like it.

Generates punched card image

This snippet generates a punched card image from a text. It punches holes in the places where a letter would be written and you can use it to generate jokes such as this one: http://bit.ly/M2oqOw

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
open System.Net
open System.Windows.Forms
open System.Drawing

/// Download a picture of an unpunched punched card from the internet
let punchCard = 
  let wc = new WebClient()
  use sr = wc.OpenRead("http://www.columbia.edu/cu/computinghistory/card05.gif")
  Bitmap.FromStream(sr)

/// Display an image in a newly opened windows form
let show (bmp:Image) =
  new Form(BackgroundImage=bmp, Visible=true, 
           ClientSize=Size(bmp.Width, bmp.Height))

// Specifies where the places to punch are on the punched card
let offsX, offsY = 0.0f, 12.0f
let spaceX, spaceY = 7.15f, 20.4f
let widthX, widthY = 3.2f, 8.0f

/// Create a punched card showing the specified text
let punch text = 
  /// Generate a bitmap that contains the text in a big font
  let textLayer = 
    let bmp = new Bitmap(punchCard.Width, punchCard.Height)
    use gr = Graphics.FromImage(bmp)
    gr.DrawString(text, new Font("Consolas", 160.0f), 
                  Brushes.Black, PointF(-40.0f, 30.0f))
    bmp

  /// Calculate if the specified rectangle contains some part
  /// of the text (in the 'textLayer' bitmap)
  let mostlyBlack (rect:RectangleF) = 
    let l = int rect.X
    let t = int rect.Y
    // Average the 'A' component over the given rectangle
    let avg =
      seq { for x in 0 .. int rect.Width do
              for y in 0 .. int rect.Height do
                let rx a = max 0 (min (textLayer.Width - 1) a)
                let ry a = max 0 (min (textLayer.Height - 1) a)
                let pix = textLayer.GetPixel(rx (l + x), ry (t + y))
                yield (float pix.A) / 255.0 }
      |> Seq.average
    avg > 0.1

  /// Create a new layer to represent punches in the card
  let punchLayer = new Bitmap(punchCard.Width, punchCard.Height)
  use gr = Graphics.FromImage(punchLayer)

  /// Iterate over the possible holes in the punched card
  for x in 0 .. punchCard.Width / int spaceX do
    for y in 0 .. punchCard.Height / int spaceY do
      // A rectangle representing the hole location
      let rect = 
        RectangleF
          (offsX + (float32 x) * spaceX, 
           offsY + (float32 y) * spaceY, widthX, widthY)

      // If the rectangle overlaps with text, then punch it!
      if mostlyBlack rect then
        rect.Inflate(0.3f, 2.0f)
        gr.FillRectangle(Brushes.Black, rect)

  // Generate composed bitmap and return it
  let img = new Bitmap(punchCard.Width, punchCard.Height)
  use gr = Graphics.FromImage(img)
  gr.DrawImage(punchCard, Point(0, 0))
  gr.DrawImage(punchLayer, Point(0, 0))
  img

// Enterprise punched card
show (punch "<?xml")
namespace System
namespace System.Net
namespace System.Windows
namespace System.Windows.Forms
namespace System.Drawing
val punchCard : Image

Full name: Script.punchCard


 Download a picture of an unpunched punched card from the internet
val wc : WebClient
Multiple items
type WebClient =
  inherit Component
  new : unit -> WebClient
  member BaseAddress : string with get, set
  member CachePolicy : RequestCachePolicy with get, set
  member CancelAsync : unit -> unit
  member Credentials : ICredentials with get, set
  member DownloadData : address:string -> byte[] + 1 overload
  member DownloadDataAsync : address:Uri -> unit + 1 overload
  member DownloadFile : address:string * fileName:string -> unit + 1 overload
  member DownloadFileAsync : address:Uri * fileName:string -> unit + 1 overload
  member DownloadString : address:string -> string + 1 overload
  ...

Full name: System.Net.WebClient

--------------------
WebClient() : unit
val sr : System.IO.Stream
WebClient.OpenRead(address: System.Uri) : System.IO.Stream
WebClient.OpenRead(address: string) : System.IO.Stream
Multiple items
type Bitmap =
  inherit Image
  new : filename:string -> Bitmap + 11 overloads
  member Clone : rect:Rectangle * format:PixelFormat -> Bitmap + 1 overload
  member GetHbitmap : unit -> nativeint + 1 overload
  member GetHicon : unit -> nativeint
  member GetPixel : x:int * y:int -> Color
  member LockBits : rect:Rectangle * flags:ImageLockMode * format:PixelFormat -> BitmapData + 1 overload
  member MakeTransparent : unit -> unit + 1 overload
  member SetPixel : x:int * y:int * color:Color -> unit
  member SetResolution : xDpi:float32 * yDpi:float32 -> unit
  member UnlockBits : bitmapdata:BitmapData -> unit
  ...

Full name: System.Drawing.Bitmap

--------------------
Bitmap(filename: string) : unit
   (+0 other overloads)
Bitmap(stream: System.IO.Stream) : unit
   (+0 other overloads)
Bitmap(original: Image) : unit
   (+0 other overloads)
Bitmap(filename: string, useIcm: bool) : unit
   (+0 other overloads)
Bitmap(type: System.Type, resource: string) : unit
   (+0 other overloads)
Bitmap(stream: System.IO.Stream, useIcm: bool) : unit
   (+0 other overloads)
Bitmap(width: int, height: int) : unit
   (+0 other overloads)
Bitmap(original: Image, newSize: Size) : unit
   (+0 other overloads)
Bitmap(width: int, height: int, format: Imaging.PixelFormat) : unit
   (+0 other overloads)
Bitmap(width: int, height: int, g: Graphics) : unit
   (+0 other overloads)
Image.FromStream(stream: System.IO.Stream) : Image
Image.FromStream(stream: System.IO.Stream, useEmbeddedColorManagement: bool) : Image
Image.FromStream(stream: System.IO.Stream, useEmbeddedColorManagement: bool, validateImageData: bool) : Image
val show : bmp:Image -> Form

Full name: Script.show


 Display an image in a newly opened windows form
val bmp : Image
type Image =
  inherit MarshalByRefObject
  member Clone : unit -> obj
  member Dispose : unit -> unit
  member Flags : int
  member FrameDimensionsList : Guid[]
  member GetBounds : pageUnit:GraphicsUnit -> RectangleF
  member GetEncoderParameterList : encoder:Guid -> EncoderParameters
  member GetFrameCount : dimension:FrameDimension -> int
  member GetPropertyItem : propid:int -> PropertyItem
  member GetThumbnailImage : thumbWidth:int * thumbHeight:int * callback:GetThumbnailImageAbort * callbackData:nativeint -> Image
  member Height : int
  ...
  nested type GetThumbnailImageAbort

Full name: System.Drawing.Image
Multiple items
type Form =
  inherit ContainerControl
  new : unit -> Form
  member AcceptButton : IButtonControl with get, set
  member Activate : unit -> unit
  member ActiveMdiChild : Form
  member AddOwnedForm : ownedForm:Form -> unit
  member AllowTransparency : bool with get, set
  member AutoScale : bool with get, set
  member AutoScaleBaseSize : Size with get, set
  member AutoScroll : bool with get, set
  member AutoSize : bool with get, set
  ...
  nested type ControlCollection

Full name: System.Windows.Forms.Form

--------------------
Form() : unit
Multiple items
type Size =
  struct
    new : pt:Point -> Size + 1 overload
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member Height : int with get, set
    member IsEmpty : bool
    member ToString : unit -> string
    member Width : int with get, set
    static val Empty : Size
    static member Add : sz1:Size * sz2:Size -> Size
    static member Ceiling : value:SizeF -> Size
    ...
  end

Full name: System.Drawing.Size

--------------------
Size()
Size(pt: Point) : unit
Size(width: int, height: int) : unit
property Image.Width: int
property Image.Height: int
val offsX : float32

Full name: Script.offsX
val offsY : float32

Full name: Script.offsY
val spaceX : float32

Full name: Script.spaceX
val spaceY : float32

Full name: Script.spaceY
val widthX : float32

Full name: Script.widthX
val widthY : float32

Full name: Script.widthY
val punch : text:string -> Bitmap

Full name: Script.punch


 Create a punched card showing the specified text
val text : string
val textLayer : Bitmap


 Generate a bitmap that contains the text in a big font
val bmp : Bitmap
val gr : Graphics
type Graphics =
  inherit MarshalByRefObject
  member AddMetafileComment : data:byte[] -> unit
  member BeginContainer : unit -> GraphicsContainer + 2 overloads
  member Clear : color:Color -> unit
  member Clip : Region with get, set
  member ClipBounds : RectangleF
  member CompositingMode : CompositingMode with get, set
  member CompositingQuality : CompositingQuality with get, set
  member CopyFromScreen : upperLeftSource:Point * upperLeftDestination:Point * blockRegionSize:Size -> unit + 3 overloads
  member Dispose : unit -> unit
  member DpiX : float32
  ...
  nested type DrawImageAbort
  nested type EnumerateMetafileProc

Full name: System.Drawing.Graphics
Graphics.FromImage(image: Image) : Graphics
Graphics.DrawString(s: string, font: Font, brush: Brush, layoutRectangle: RectangleF) : unit
Graphics.DrawString(s: string, font: Font, brush: Brush, point: PointF) : unit
Graphics.DrawString(s: string, font: Font, brush: Brush, layoutRectangle: RectangleF, format: StringFormat) : unit
Graphics.DrawString(s: string, font: Font, brush: Brush, point: PointF, format: StringFormat) : unit
Graphics.DrawString(s: string, font: Font, brush: Brush, x: float32, y: float32) : unit
Graphics.DrawString(s: string, font: Font, brush: Brush, x: float32, y: float32, format: StringFormat) : unit
Multiple items
type Font =
  inherit MarshalByRefObject
  new : prototype:Font * newStyle:FontStyle -> Font + 12 overloads
  member Bold : bool
  member Clone : unit -> obj
  member Dispose : unit -> unit
  member Equals : obj:obj -> bool
  member FontFamily : FontFamily
  member GdiCharSet : byte
  member GdiVerticalFont : bool
  member GetHashCode : unit -> int
  member GetHeight : unit -> float32 + 2 overloads
  ...

Full name: System.Drawing.Font

--------------------
Font(prototype: Font, newStyle: FontStyle) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, style: FontStyle) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, style: FontStyle, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle, unit: GraphicsUnit, gdiCharSet: byte) : unit
   (+0 other overloads)
type Brushes =
  static member AliceBlue : Brush
  static member AntiqueWhite : Brush
  static member Aqua : Brush
  static member Aquamarine : Brush
  static member Azure : Brush
  static member Beige : Brush
  static member Bisque : Brush
  static member Black : Brush
  static member BlanchedAlmond : Brush
  static member Blue : Brush
  ...

Full name: System.Drawing.Brushes
property Brushes.Black: Brush
Multiple items
type PointF =
  struct
    new : x:float32 * y:float32 -> PointF
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member IsEmpty : bool
    member ToString : unit -> string
    member X : float32 with get, set
    member Y : float32 with get, set
    static val Empty : PointF
    static member Add : pt:PointF * sz:Size -> PointF + 1 overload
    static member Subtract : pt:PointF * sz:Size -> PointF + 1 overload
  end

Full name: System.Drawing.PointF

--------------------
PointF()
PointF(x: float32, y: float32) : unit
val mostlyBlack : (RectangleF -> bool)


 Calculate if the specified rectangle contains some part
 of the text (in the 'textLayer' bitmap)
val rect : RectangleF
Multiple items
type RectangleF =
  struct
    new : location:PointF * size:SizeF -> RectangleF + 1 overload
    member Bottom : float32
    member Contains : pt:PointF -> bool + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member Height : float32 with get, set
    member Inflate : size:SizeF -> unit + 1 overload
    member Intersect : rect:RectangleF -> unit
    member IntersectsWith : rect:RectangleF -> bool
    member IsEmpty : bool
    ...
  end

Full name: System.Drawing.RectangleF

--------------------
RectangleF()
RectangleF(location: PointF, size: SizeF) : unit
RectangleF(x: float32, y: float32, width: float32, height: float32) : unit
val l : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
property RectangleF.X: float32
val t : int
property RectangleF.Y: float32
val avg : float
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val x : int
property RectangleF.Width: float32
val y : int
property RectangleF.Height: float32
val rx : (int -> int)
val a : int
val max : e1:'T -> e2:'T -> 'T (requires comparison)

Full name: Microsoft.FSharp.Core.Operators.max
val min : e1:'T -> e2:'T -> 'T (requires comparison)

Full name: Microsoft.FSharp.Core.Operators.min
val ry : (int -> int)
val pix : Color
Bitmap.GetPixel(x: int, y: int) : Color
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
property Color.A: byte
module Seq

from Microsoft.FSharp.Collections
val average : source:seq<'T> -> 'T (requires member ( + ) and member DivideByInt and member get_Zero)

Full name: Microsoft.FSharp.Collections.Seq.average
val punchLayer : Bitmap


 Create a new layer to represent punches in the card
val x : int32
val y : int32
val rect : RectangleF


 Iterate over the possible holes in the punched card
Multiple items
val float32 : value:'T -> float32 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float32

--------------------
type float32 = System.Single

Full name: Microsoft.FSharp.Core.float32

--------------------
type float32<'Measure> = float32

Full name: Microsoft.FSharp.Core.float32<_>
RectangleF.Inflate(size: SizeF) : unit
RectangleF.Inflate(x: float32, y: float32) : unit
Graphics.FillRectangle(brush: Brush, rect: Rectangle) : unit
Graphics.FillRectangle(brush: Brush, rect: RectangleF) : unit
Graphics.FillRectangle(brush: Brush, x: int, y: int, width: int, height: int) : unit
Graphics.FillRectangle(brush: Brush, x: float32, y: float32, width: float32, height: float32) : unit
val img : Bitmap
Graphics.DrawImage(image: Image, destPoints: Point []) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, destPoints: PointF []) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, rect: Rectangle) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, point: Point) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, rect: RectangleF) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, point: PointF) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, x: int, y: int) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, x: float32, y: float32) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, destPoints: Point [], srcRect: Rectangle, srcUnit: GraphicsUnit) : unit
   (+0 other overloads)
Graphics.DrawImage(image: Image, destPoints: PointF [], srcRect: RectangleF, srcUnit: GraphicsUnit) : unit
   (+0 other overloads)
Multiple items
type Point =
  struct
    new : sz:Size -> Point + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member IsEmpty : bool
    member Offset : p:Point -> unit + 1 overload
    member ToString : unit -> string
    member X : int with get, set
    member Y : int with get, set
    static val Empty : Point
    static member Add : pt:Point * sz:Size -> Point
    ...
  end

Full name: System.Drawing.Point

--------------------
Point()
Point(sz: Size) : unit
Point(dw: int) : unit
Point(x: int, y: int) : unit
Raw view Test code New version

More information

Link:http://fssnip.net/cJ
Posted:11 years ago
Author:Tomas Petricek
Tags: bitmap , drawing , fun , learning