{-# LANGUAGE DeriveDataTypeable #-}
--------------------------------------------------------------------------
-- |
-- Module:      Game.Waddle.Types
-- Copyright:   (c) 2015 Martin Grabmueller
-- License:     BSD3
-- 
-- Maintainer:  martin@grabmueller.de
-- Stability:   provisional
-- Portability: portable
--
-- Waddle is a library of WAD file utilities.
--
-- This is a convenience module which re-exports the modules which are
-- essential for using Waddle.
----------------------------------------------------------------------------
module Game.Waddle.Types
       (WadException(..),
        LumpName,
        WadHeader(..),
        WadEntry(..),
        Sprite(..),
        Level(..),
        Picture(..),
        Post(..),
        Wad(..),
        Blockmap(..),
        Colormap(..),
        Palettes(..),
        Thing(..),
        ThingType(..),
        thingTypeFromNumber,
        Texture(..),
        Patch(..),
        PatchDescriptor(..),
        Flat(..),
        Reject(..),
        Blocklist,
        Vertex(..),
        SideDef(..),
        LineDef(..),
        Node(..),
        Sector(..),
        SSector(..),
        Seg(..)) where

import Control.Exception
import Data.Typeable

import Data.Int
import Data.Word
import Data.ByteString(ByteString)
import Data.CaseInsensitive(CI)
import Data.Map(Map)

data WadException
  = WadExceptionFormatError String String
  | WadExceptionDecodeError String String
 deriving (Eq, Show, Typeable)

instance Exception WadException

data WadHeader = WadHeader {
  wadHeaderIdentifier :: ByteString,
  -- ^ Normally "IWAD" or "PWAD", always of length 4.
  wadHeaderLumpCount :: Int32,
  -- ^ Number of lumps in the file.
  wadHeaderDirectoryOffset :: Int32
  -- ^ Byte offset (relative to beginning of the file) of the WAD
  -- directory.
  }

data WadEntry = WadEntry {
  wadEntryOffset :: Int32,
  -- ^ Offset of the lump data in the file.
  wadEntrySize :: Int32,
  -- ^ Size (in bytes) of the lump data.
  wadEntryName :: ByteString
  -- ^ Name of the lump. Note that trailing NULs are stripped when the
  -- name is read in.
  }

type LumpName = ByteString

data Wad = Wad {
  wadHeader     :: WadHeader,
  -- ^ WAD header.
  wadDirectory  :: [WadEntry],
  -- ^ All WAD directory entries, in the same order as in the file.
  wadLumps :: [ByteString],
  -- ^ All WAD lumps, each entry matching the corresponding entry in wadDirectory.
  wadLumpLookup :: Map (CI LumpName) ByteString,
  -- ^ Mapping from lump names to lump content.
  wadFlats :: Map (CI LumpName) Flat,
  -- ^ Mapping from lump names to flats (floors and ceilings).
  wadSprites :: Map (CI LumpName) Sprite,
  -- ^ Mapping from lump names to sprites (monsters and things).
  wadPatches :: Map (CI LumpName) Patch,
  -- ^ Mapping from lump names to patches (parts of wall textures).
  wadTextures :: Map (CI LumpName) Texture,
  -- ^ Mapping from lump names to wall textures.
  wadLevels :: Map (CI LumpName) Level,
  -- ^ Mapping from lump names to levels.
  wadPNames :: Map Int LumpName,
  -- ^ Mapping from patch indices to patch names.
  wadColormap :: Maybe Colormap,
  -- ^ WAD colormap for mapping palette entries according to light
  -- levels.
  wadPalettes :: Maybe Palettes
  -- ^ Palettes for mapping color indices to RGB tuples.
  }

data Level = Level {
  levelName :: LumpName,
  levelThings :: [Thing],
  levelVertices :: [Vertex],
  levelLineDefs :: [LineDef],
  levelSideDefs :: [SideDef],
  levelSegs :: [Seg],
  levelSSectors :: [SSector],
  levelSectors :: [Sector],
  levelNodes :: [Node],
  levelReject :: Maybe Reject,
  levelBlockmap :: Maybe Blockmap
  }

data Picture = Picture {
  pictureWidth      :: Int,
  pictureHeight     :: Int,
  pictureLeftOffset :: Int,
  pictureTopOffset  :: Int,
  picturePosts      :: [[Post]]
  }

data Post
  = Post {
    postTop    :: Word8,
    postPixels :: ByteString
    }
  deriving (Show)


data Sprite = Sprite {
  spriteName    :: LumpName,
  spritePicture :: Picture
  }

data Flat = Flat {
  flatName :: LumpName,
  -- ^ Name of this flat.
  flatData :: ByteString
  -- ^ Alrays 64 x 64 =  4096 bytes.
  }

data Patch = Patch {
  patchName :: LumpName,
  patchPicture :: Picture
  }

data Thing = Thing {
  thingX     :: Int16,
  thingY     :: Int16,
  thingAngle :: Int16,
  thingType  :: ThingType,
  thingFlags :: Int16
  }
             
data Vertex = Vertex {
  vertexX :: Int16,
  vertexY :: Int16
  }

data LineDef = LineDef {
  lineDefStartVertex  :: Int16,
  lineDefEndVertex    :: Int16,
  lineDefFlags        :: Int16,
  lineDefEffect       :: Int16,
  lineDefTag          :: Int16,
  lineDefRightSideDef :: Int16,
  lineDefLeftSideDef  :: Maybe Int16
  }

data SideDef = SideDef {
  sideDefXOffset           :: Int16,
  sideDefYOffset           :: Int16,
  sideDefUpperTextureName  :: ByteString,
  sideDefLowerTextureName  :: ByteString,
  sideDefMiddleTextureName :: ByteString,
  sideDefSector            :: Int16
  }

data Seg = Seg {
  segStartVertex :: Int16,
  segEndVertex :: Int16,
  segAngle :: Int16,
  segLineDef :: Int16,
  segDirection :: Int16,
  segOffset :: Int16
  }

data SSector = SSector {
  ssectorSegCount :: Int16,
  ssectorSegStart :: Int16
  }

data Sector = Sector {
  sectorFloorHeight   :: Int16,
  sectorCeilingHeight :: Int16,
  sectorFloorFlat     :: ByteString,
  sectorCeilingFlat   :: ByteString,
  sectorLightLevel    :: Int16,
  sectorSpecial       :: Int16,
  sectorTag           :: Int16
}

data Node = Node {
  nodeX :: Int16,
  nodeY :: Int16,
  nodeDX :: Int16,
  nodeDY :: Int16,
  nodeRightBBUY :: Int16,
  nodeRightBBLY :: Int16,
  nodeRightBBLX :: Int16,
  nodeRightBBUX :: Int16,
  nodeLeftBBUY :: Int16,
  nodeLeftBBLY :: Int16,
  nodeLeftBBLX :: Int16,
  nodeLeftBBUX :: Int16,
  nodeRightNodeOrSSector :: Either Int16 Int16,
  nodeLeftNodeOrSSector :: Either Int16 Int16
  }

data Reject = Reject {
  rejectBytes :: ByteString
  }

type Blocklist = [Int16]

data Blockmap = Blockmap {
  blockmapOriginX :: Int16,
  blockmapOriginY :: Int16,
  blockmapColumns :: Int16,
  blockmapRows :: Int16,
  blockmapOffsets :: [Word16],
  blockmapBlocklists :: [Blocklist]
  }

data Palettes = Palettes [[(Word8, Word8, Word8)]]

data Colormap = Colormap [ByteString] -- 34 maps, 256 bytes each

data PatchDescriptor = PatchDescriptor {
  patchDescriptorXOffset :: Int16,
  patchDescriptorYOffset :: Int16,
  patchDescriptorPNameIndex :: Int16,
  patchDescriptorStepDir :: Int16,
  patchDescriptorColorMap :: Int16
  }

data Texture = Texture {
  textureName :: LumpName,
  textureWidth :: Int16,
  textureHeight :: Int16,
  texturePatchDescriptors :: [PatchDescriptor]
  }

data ThingType
  = ZeroThing -- Appears in PLUTONIA.WAD
  | Player1StartPos
  | Player2StartPos
  | Player3StartPos
  | Player4StartPos
  | DeathMatchStartPos
  | FormerHuman
  | WolfensteinOfficer
  | FormerHumanSergeant
  | FormerHumanCommando
  | Imp
  | Demon
  | Spectre
  | LostSoul
  | Cacodemon
  | HellKnight
  | BaronOfHell
  | Arachnotron
  | PainElemental
  | Revenant
  | Mancubus
  | ArchVile
  | Spiderdemon
  | Cyberdemon
  | BossBrain

  | TeleportLanding
  | BossShooter
  | SpawnSpot

  | Chainsaw
  | Shotgun
  | SuperShotgun
  | Chaingun
  | RocketLauncher
  | Plasmagun
  | BFG9000

  | AmmoClip
  | ShotgunShells
  | Rocket
  | CellCharge
  | BoxOfAmmo
  | BoxOfShells
  | BoxOfRockets
  | CellChargePack
  | Backpack

  | StimPack
  | Medikit
  | HealthPotion
  | SpiritArmor
  | SecurityArmor
  | CombatArmor
  | MegaSphere
  | SoulSphere
  | Invulnerability
  | BerserkPack
  | Invisibility
  | RadiationSuit
  | ComputerMap
  | LightAmplificationGoggles

  | BlueKeyCard
  | RedKeyCard
  | YellowKeyCard
  | BlueSkullKey
  | RedSkullKey
  | YellowSkullKey

  | Barrel
  | BurningBarrel
  | Candle
  | Candelabra
  | TallTechnocolumn
  | TallGreenPillar
  | TallRedPillar
  | ShortGreenPillar
  | ShortGreenPillarWithHeart
  | ShortGreenPillarWithBeatingHeart
  | ShortRedPillar
  | ShortRedPillarWithSkull
  | Stalagmite
  | BurntGrayTree
  | LargeBrownTree
  | TallBlueFirestick
  | TallGreenFirestick
  | TallRedFirestick
  | ShortBlueFirestick
  | ShortGreenFirestick
  | ShortRedFirestick
  | FloorLamp
  | TallTechnoLamp
  | ShortTechnoLamp
  | EvilEyeSymbol
  | FlamingSkullRock
  | ImpaledHuman
  | TwitchingImpaledHuman
  | SkullOnPole
  | FiveSkullShishKebap
  | PileOfSkullsAndCandles
  | HangingVictim
  | HangingVictimTwitching
  | HangingPairOfLegs
  | HangingVictim1Leg
  | HangingLeg
  | HangingVictimNoGuts
  | HangingVictimNoGutsBrain
  | HangingTorsoLookingDown
  | HangingTorsoOpenSkull
  | HangingTorsoLookingUp
  | HangingTorsoNoBrain
  | HangingBilly

  | DeadPlayer
  | DeadFormerHuman
  | DeadFormerSergeant
  | DeadImp
  | DeadDemon
  | DeadCacodemon
  | DeadLostSoulInvisible
  | BloodyMessExplodedPlayer
  | BloodyMessAsAbove
  | PoolOfBlood
  | PoolOfGuts
  | SmallPoolOfGuts
  | PoolOfBrains
  | HangingVictimTwitching2
  | HangingVictimArmsSpread
  | HangingVictim1Legged
  | HangingPairOfLegs2
  | HangingLeg2
  | ThingTypeOther Int
    deriving (Show)


-- Mostly taken from: UDS in the version at
-- http://web.archive.org/web/20100906191901/http://the-stable.lancs.ac.uk/~esasb1/doom/uds/things.html
--
thingTypeFromNumber :: Integral a => a -> ThingType
thingTypeFromNumber n = case n of
  0 -> ZeroThing -- Appears in PLUTONIA.WAD
  1 -> Player1StartPos
  2 -> Player2StartPos
  3 -> Player3StartPos
  4 -> Player4StartPos
  11 -> DeathMatchStartPos

  3004 -> FormerHuman
  84 -> WolfensteinOfficer
  9 -> FormerHumanSergeant
  65 -> FormerHumanCommando
  3001 -> Imp
  3002 -> Demon
  58 -> Spectre
  3006 -> LostSoul
  3005 -> Cacodemon
  69 -> HellKnight
  3003 -> BaronOfHell
  68 -> Arachnotron
  71 -> PainElemental
  66 -> Revenant
  67 -> Mancubus
  64 -> ArchVile
  7 -> Spiderdemon
  16 -> Cyberdemon
  88 -> BossBrain

  14 -> TeleportLanding
  89 -> BossShooter
  87 -> SpawnSpot

  2005 -> Chainsaw
  2001 -> Shotgun
  82 -> SuperShotgun
  2002 -> Chaingun
  2003 -> RocketLauncher
  2004 -> Plasmagun
  2006 -> BFG9000

  2007 -> AmmoClip
  2008 -> ShotgunShells
  2010 -> Rocket
  2047 -> CellCharge
  2048 -> BoxOfAmmo
  2049 -> BoxOfShells
  2046 -> BoxOfRockets
  17 -> CellChargePack
  8 -> Backpack

  2011 -> StimPack
  2012 -> Medikit
  2014 -> HealthPotion
  2015 -> SpiritArmor
  2018 -> SecurityArmor
  2019 -> CombatArmor
  83 -> MegaSphere
  2013 -> SoulSphere
  2022 -> Invulnerability
  2023 -> BerserkPack
  2024 -> Invisibility
  2025 -> RadiationSuit
  2026 -> ComputerMap
  2045 -> LightAmplificationGoggles

  5 -> BlueKeyCard
  13 -> RedKeyCard
  6 -> YellowKeyCard
  40 -> BlueSkullKey
  38 -> RedSkullKey
  39 -> YellowSkullKey

  2035 -> Barrel
  70 -> BurningBarrel
  34 -> Candle
  35 -> Candelabra
  48 -> TallTechnocolumn
  30 -> TallGreenPillar
  32 -> TallRedPillar
  31 -> ShortGreenPillar
  24 -> ShortGreenPillarWithHeart
  36 -> ShortGreenPillarWithBeatingHeart -- According to http://doom.wikia.com/wiki/Thing_types
  33 -> ShortRedPillar
  37 -> ShortRedPillarWithSkull
  47 -> Stalagmite
  43 -> BurntGrayTree
  54 -> LargeBrownTree
  44 -> TallBlueFirestick
  45 -> TallGreenFirestick
  46 -> TallRedFirestick
  55 -> ShortBlueFirestick
  56 -> ShortGreenFirestick
  57 -> ShortRedFirestick
  2028 -> FloorLamp
  85 -> TallTechnoLamp
  86 -> ShortTechnoLamp
  41 -> EvilEyeSymbol
  42 -> FlamingSkullRock
  25 -> ImpaledHuman
  26 -> TwitchingImpaledHuman
  27 -> SkullOnPole
  28 -> FiveSkullShishKebap
  29 -> PileOfSkullsAndCandles
  50 -> HangingVictim
  49 -> HangingVictimTwitching
  52 -> HangingPairOfLegs
  51 -> HangingVictim1Leg
  53 -> HangingLeg
  73 -> HangingVictimNoGuts
  74 -> HangingVictimNoGutsBrain
  75 -> HangingTorsoLookingDown
  76 -> HangingTorsoOpenSkull
  77 -> HangingTorsoLookingUp
  78 -> HangingTorsoNoBrain
  72 -> HangingBilly

  15 -> DeadPlayer
  18 -> DeadFormerHuman
  19 -> DeadFormerSergeant
  20 -> DeadImp
  21 -> DeadDemon
  22 -> DeadCacodemon
  23 -> DeadLostSoulInvisible
  10 -> BloodyMessExplodedPlayer
  12 -> BloodyMessAsAbove
--  24 -> PoolOfBlood  -- Duplicate with ShortGreenPillarWithHeart above
  79 -> PoolOfGuts
  80 -> SmallPoolOfGuts
  81 -> PoolOfBrains
  63 -> HangingVictimTwitching
  59 -> HangingVictimArmsSpread
  61 -> HangingVictim1Legged
  60 -> HangingPairOfLegs
  62 -> HangingLeg
  _ -> ThingTypeOther (fromIntegral n)