wadParser.fs

module WadParser

open System
open System.IO
open System.Text
open System.Text.RegularExpressions
open FParsec

[<AutoOpen>]
module FParsec =
    let anyByte : Parser<byte, unit> = anyChar |>> byte

    let anyBytes n : Parser<byte array, unit> = 
        anyString n |>> (fun x -> Array.map byte <| x.ToCharArray())

    let anyInt16 : Parser<int16, unit> =
        anyBytes 2
        |>> (fun x -> BitConverter.ToInt16 (x, 0))

    let anyInt32 : Parser<int, unit> =
        anyBytes 4
        |>> (fun x -> BitConverter.ToInt32 (x, 0))

    let skipAnyByte = skipAnyChar
    let skipAnyBytes n = skipAnyString n |>> ignore
        
//
//
//
type WadType =
    | IWad = 0
    | PWad = 1

type WadHeader = { Type: WadType; LumpCount: int; DirectoryOffset: int }

[<Flags>]
type ThingFlags =
    | SkillLevelOneAndTwo = 0x001
    | SkillLevelThree = 0x002
    | SkillLevelFourAndFive = 0x004
    | Deaf = 0x008
    | NotInSinglePlayer = 0x0010

type Thing = { X: int16; Y: int16; Angle: int16; Type: int16; Flags: ThingFlags }

type Lump =
    | Map of string * Thing list
    | Misc of string * byte array

type WadLump = { Name: string }

type Wad = { Header: WadHeader; Lumps: Lump [] }

let pheaderIdentification =
    attempt <| pstring "IWAD" <|> pstring "PWAD"
    |>> (fun x ->
        match x with
        | "IWAD" -> WadType.IWad
        | _ ->      WadType.PWad)

[<Literal>]
let HeaderSize = 12
let pheader =
    pipe3 pheaderIdentification anyInt32 anyInt32
        (fun x y z -> { Type = x; LumpCount = y; DirectoryOffset = z })

[<Literal>]
let ThingLumpSize = 10
let plumpThing =
    pipe5 anyInt16 anyInt16 anyInt16 anyInt16 anyInt16
        (fun x y angle typ flags ->
            { X = x; Y = y; Angle = angle; Type = typ; Flags = enum<ThingFlags>(int32 flags) })
    
let plumpMap =
    plumpThing

[<Literal>]
let DirectorySize = 16
let plump =
    pipe3 anyInt32 anyInt32 (anyString 8)
        (fun _ size name ->
            match name with
            | _ when Regex.IsMatch (name, "^E.M.") ->
                Lump.Map (name, [])
            | _ ->
                Lump.Misc (name, [||]))

[<EntryPoint>]
let main args = 
    let data = 
        File.ReadAllBytes ("DOOM.WAD")
        |> Array.map char

    let dataString = String data

    let header = 
        // end of data
        let eod = HeaderSize - 1
        match run pheader dataString.[..eod] with
        | Success(result, _, _)   -> result
        | Failure(errorMsg, e, s) -> failwith errorMsg

    let lumps = Array.init header.LumpCount (fun i ->
        let offset = header.DirectoryOffset + (i * DirectorySize)
        let eod = offset + DirectorySize - 1
        match run plump dataString.[offset..eod] with
        | Success(result, _, _) -> result
        | Failure(errorMsg, e, s) -> failwith errorMsg)

    lumps
    |> Array.iter (fun x -> printfn "%A" x)
    0