とりあえずGIFの情報をダンプするだけ。 情報の整合性はチェックしてません。 Extensionsは最低限しか実装してないからまだ不足がある。

GifDumper.fs

open System
open System.IO

let dumpGif (bytes : byte[]) =
    let i = ref 0
    let byte () =
        let byte = bytes.[!i]
        incr i
        int byte
    let uint16 () =
        let uint16 = BitConverter.ToUInt16(bytes, !i)
        i := !i + 2
        int uint16
    let string n =
        let string = Array.map char bytes.[!i + 0 .. !i + n - 1]
        i := !i + n
        String string
    let skipColorTable size =
        let colors = 1 <<< size + 1
        printfn "  Color Table, colors: %d" colors
        (* for j in 0 .. colors - 1 do
            printfn "R %02X, G %02X, B %02X" bytes.[i + 3 * j + 0] bytes.[i + 3 * j + 1] bytes.[i + 3 * j + 2] *)
        i := !i + 3 * colors

    let extensions () =
        let label = byte ()
        let size = byte ()
        match label with
        | 0xF9 -> printfn "Graphic Control Extension"
                  if size <> 4 then
                      printfn "  size miss-match: %d, skip it." size
                      i := !i + size
                  else
                      let packedFields = byte ()
                      let disposalMethod = packedFields >>> 2
                      let userInput = packedFields &&& 0x02 <> 0
                      let transparentColor = packedFields &&& 0x01 <> 0
                      let delayTime = uint16 () * 10
                      let transparentColorIndex = byte ()
                      printfn "  Disposal Method: %d, User Input: %b, Transparent Color: %b" disposalMethod userInput transparentColor
                      printfn "  Delay Time: %dms, Transparent Color Index: %d" delayTime transparentColorIndex
        | 0xFF -> printfn "Application Extension"
                  if size <> 11 then
                      printfn "  size miss-match: %d, skip it." size
                      i := !i + size
                      let size = byte ()
                      printfn "  Application Data: size: %d" size
                      i := !i + size
                  else
                      let applicationIdentifier = string 8
                      let authenticationCode = [| byte (); byte (); byte () |]
                      printfn "  Application Identifier: %s, Authentication Code: %02X-%02X-%02X" applicationIdentifier
                          authenticationCode.[0] authenticationCode.[1] authenticationCode.[2]
                      let size = byte ()
                      match applicationIdentifier, authenticationCode, size with
                      | "NETSCAPE", [| 0x32; 0x2E; 0x30 |], 3 ->
                          let id = byte ()
                          let loopCount = uint16 ()
                          printfn "  Sub-block ID: %d, Loop Count: %d" id loopCount
                      | _, _, _ ->
                          printfn "  Application Data: size: %d" size
                          i := !i + size
        | _    -> printfn "Unknown Block, size %d, skip it" size
                  i := !i + size
        if byte () <> 0 then failwith "Block Terminator not zero."
    let image () =
        printfn "Image Descriptor"
        let left = uint16 ()
        let top = uint16 ()
        let width = uint16 ()
        let height = uint16 ()
        let packedFields = byte ()
        let localColorTable = packedFields &&& 0x80 <> 0
        let interlace = packedFields &&& 0x40 <> 0
        let sort = packedFields &&& 0x20 <> 0
        let sizeOfLocalColorTable = packedFields &&& 0x07
        printfn "  Left: %d, Top: %d, Width: %d, Height: %d, Local Color Table: %b" left top width height localColorTable
        printfn "  Interlace: %b, Sort: %b, Size of Local Color Table: %d"  interlace sort sizeOfLocalColorTable
        if localColorTable then
            skipColorTable sizeOfLocalColorTable
        let lzwMinimumCodeSize = byte ()
        printfn "  LZW Minimum Code Size: %d" lzwMinimumCodeSize
        let rec loop (count, size) =
            let b = byte ()
            if b = 0 then count, size else
            i := !i + b
            loop (count+1, size+b)
        let count, size = loop (0, 0)
        printfn "  block count: %d, size: %d" count size

    printfn "Header"
    match string 3 with
    | "GIF" -> printf "  GIF"
    | _ -> failwith "Signature"
    match string 3 with
    | "87a" -> printfn " 87a"
    | "89a" -> printfn " 89a"
    | _ -> failwith "Version"

    printfn "Logical Screen Descriptor"
    let logicalScreenWidth = uint16 ()
    let logicalScreenHeight = uint16 ()
    let packedFields = byte ()
    let globalColorTable = packedFields &&& 0x80 <> 0
    let colorResolution = packedFields >>> 4 &&& 0x07
    let sort = packedFields &&& 0x08 <> 0
    let sizeOfGlobalColorTable = packedFields &&& 0x07
    let backgroundColorIndex = byte ()
    let pixelAspectRatio = byte ()
    printfn "  Logical Screen Width: %d, Height: %d, Global Color Table: %b" logicalScreenWidth logicalScreenHeight globalColorTable
    printfn "  Color Resolution: %d, Sort: %b, Size of Global Color Table: %d"  colorResolution sort sizeOfGlobalColorTable
    printfn "  Background Color Index: %d, Pixel Aspect Ratio: %d" backgroundColorIndex pixelAspectRatio
    if globalColorTable then
        skipColorTable sizeOfGlobalColorTable

    while !i < Array.length bytes do
        match byte () with
        | 0x21 -> extensions ()
        | 0x2C -> image ()
        | 0x3B -> printfn "Trailer"
        | l    -> failwithf "offset %08X: %02X" (!i - 1) l

[<EntryPoint>]
let main argv = 
    let bytes = File.ReadAllBytes argv.[0]
    dumpGif bytes
    0