{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
--------------------------------------------------------------------------
-- |
-- Module:      Game.Waddle.ExportJS
-- 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.ExportJS
       (exportJS) where

import Game.Waddle.Types

import System.IO
import Data.List
import Text.Printf
import Data.Bits
import Data.Word
import Data.CaseInsensitive(CI)
import Data.Map(Map)
import qualified Data.Map as Map
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

exportJS :: Wad -> FilePath -> IO ()
exportJS Wad{..} dir = do

  printf "levels: %d\n" (Map.size wadLevels)
  forM_ (Map.elems wadLevels) $ \ Level{..} -> do
    printf "Level %s:\n" (BS8.unpack levelName)
    printf "  vertices: %d\n" (length levelVertices)
    printf "  sideDefs: %d\n" (length levelSideDefs)
    printf "  lineDefs: %d\n" (length levelLineDefs)
    printf "  sectors: %d\n" (length levelSectors)
    printf "  reject: %d\n" (maybe 0 (BS.length . rejectBytes) levelReject)
    printf "  blockmap: %d\n"
      (case levelBlockmap of
          Just Blockmap{..} -> (blockmapColumns * blockmapRows)
          Nothing -> 0)
    printf "  things: %d\n" (length levelThings)
  printf "flats: %d\n" (Map.size wadFlats)
  printf "sprites: %d\n" (Map.size wadSprites)
  printf "textures: %d\n" (Map.size wadTextures)
  printf "patches: %d\n" (Map.size wadPatches)
  printf "pnames: %d\n" (Map.size wadPNames)
  
  forM_ (Map.elems wadLevels) $ \ level@Level{..} -> do
    withFile (printf "%s/level-%s.js" dir (BS8.unpack levelName)) WriteMode $ \ h ->
      exportLevel h level
  withFile (printf "%s/levels.js" dir) WriteMode $ \ h ->
      exportLevels h wadLevels
  withFile (printf "%s/sprites.js" dir) WriteMode $ \ h ->
    exportSprites h wadSprites
  withFile (printf "%s/patches.js" dir) WriteMode $ \ h ->
    exportPatches h wadPatches
  withFile (printf "%s/textures.js" dir) WriteMode $ \ h ->
    exportTextures h wadTextures
  withFile (printf "%s/pnames.js" dir) WriteMode $ \ h ->
    exportPNames h wadPNames
  withFile (printf "%s/flats.js" dir) WriteMode $ \ h ->
    exportFlats h wadFlats
  withFile (printf "%s/colormap.js" dir) WriteMode $ \ h ->
    exportColormap h wadColormap
  withFile (printf "%s/palettes.js" dir) WriteMode $ \ h ->
    exportPalettes h wadPalettes
  return ()
                         
exportThing :: Handle -> (String, Thing) -> IO ()
exportThing h (comma, Thing{..}) = do
  hPrintf h "    %s{x:%d,y:%d,angle:%d,type:\"%s\",flags:%d}\n" comma
    thingX thingY thingAngle (show thingType) thingFlags
    
exportVertex :: Handle -> (String, Vertex) -> IO ()
exportVertex h (comma, Vertex{..}) = do
  hPrintf h "    %s{x:%d,y:%d}\n" comma
    vertexX vertexY

exportLineDef :: Handle -> (String, LineDef) -> IO ()
exportLineDef h (comma, LineDef{..}) = do
  hPrintf h "    %s{start:%d,end:%d,flags:%d,effect:%d,tag:%d,right:%d,left:%s}\n" comma
    lineDefStartVertex lineDefEndVertex lineDefFlags lineDefEffect lineDefTag
    lineDefRightSideDef (maybe "null" show lineDefLeftSideDef)

exportSideDef :: Handle -> (String, SideDef) -> IO ()
exportSideDef h (comma, SideDef{..}) = do
  hPrintf h "    %s{xofs:%d,yofs:%d,upperTexture:%s,lowerTexture:%s,middleTexture:%s,sector:%d}\n" comma
    sideDefXOffset sideDefYOffset (show sideDefUpperTextureName)
    (show sideDefLowerTextureName) (show sideDefMiddleTextureName)
    sideDefSector
    

exportNode :: Handle -> (String, Node) -> IO ()
exportNode h (comma, Node{..}) = do
  hPrintf h "    %s{x:%d,y:%d,dx:%d,dy:%d,rbbuy:%d,rbbly:%d,rbblx:%d,rbbux:%d,lbbuy:%d,lbbly:%d,lbblx:%d,lbbux:%d,rightNodeOrSSector:%d,leftNodeOrSSector:%d}\n" comma
    nodeX nodeY nodeDX nodeDY
    nodeRightBBUY nodeRightBBLY nodeRightBBLX nodeRightBBUX
    nodeLeftBBUY nodeLeftBBLY nodeLeftBBLX nodeLeftBBUX
    ((either fromIntegral ((.|. 0x8000) . fromIntegral) nodeRightNodeOrSSector) :: Word16)
    ((either fromIntegral ((.|. 0x8000) . fromIntegral) nodeLeftNodeOrSSector) :: Word16)

exportSector :: Handle -> (String, Sector) -> IO ()
exportSector h (comma, Sector{..}) = do
  hPrintf h "    %s{floorHeight:%d,ceilingHeight:%d,floorFlat:%s,ceilingFlat:%s,lightLevel:%d,special:%d,tag:%d}\n" comma
    sectorFloorHeight sectorCeilingHeight (show sectorFloorFlat) (show sectorCeilingFlat)
    sectorLightLevel sectorSpecial sectorTag

exportSeg :: Handle -> (String, Seg) -> IO ()
exportSeg h (comma, Seg{..}) = do
  hPrintf h "    %s{start:%d,end:%d,angle:%d,lineDef:%d,direction:%d,offset:%d}\n" comma
    segStartVertex segEndVertex segAngle segLineDef segDirection segOffset

exportSSector :: Handle -> (String, SSector) -> IO ()
exportSSector h (comma, SSector{..}) = do
  hPrintf h "    %s{segCount:%d,segStart:%d}\n" comma
    ssectorSegCount ssectorSegStart

exportBlockmap :: Handle -> Maybe Blockmap -> IO ()
exportBlockmap h Nothing = hPrintf h "null"
exportBlockmap h (Just Blockmap{..}) = do
  hPrintf h "    {originX:%d,originY:%d,columns:%d,rows:%d,\n"
    blockmapOriginX blockmapOriginY blockmapColumns blockmapRows
  hPrintf h "    offsets:%s,\n    lists:%s}"
    (show blockmapOffsets) (show blockmapBlocklists)

exportLevel :: Handle -> Level -> IO ()
exportLevel h Level{..} = do
  hPrintf h "var level_%s = {\n" (BS8.unpack levelName)
  hPrintf h "  things: [\n"
  mapM_ (exportThing h) (zip (" ":repeat ",") levelThings)
  hPrintf h "  ],\n"
  hPrintf h "  vertices: [\n"
  mapM_ (exportVertex h) (zip (" ":repeat ",") levelVertices)
  hPrintf h "  ],\n"
  hPrintf h "  linedefs: [\n"
  mapM_ (exportLineDef h) (zip (" ":repeat ",") levelLineDefs)
  hPrintf h "  ],\n"
  hPrintf h "  sidedefs: [\n"
  mapM_ (exportSideDef h) (zip (" ":repeat ",") levelSideDefs)
  hPrintf h "  ],\n"
  hPrintf h "  segs: [\n"
  mapM_ (exportSeg h) (zip (" ":repeat ",") levelSegs)
  hPrintf h "  ],\n"
  hPrintf h "  ssectors: [\n"
  mapM_ (exportSSector h) (zip (" ":repeat ",") levelSSectors)
  hPrintf h "  ],\n"
  hPrintf h "  sectors: [\n"
  mapM_ (exportSector h) (zip (" ":repeat ",") levelSectors)
  hPrintf h "  ],\n"
  hPrintf h "  nodes: [\n"
  mapM_ (exportNode h) (zip (" ":repeat ",") levelNodes)
  hPrintf h "  ],\n"
  hPrintf h "  reject: %s,\n" (maybe "[]"  (show . BS.unpack . rejectBytes) levelReject)
  hPrintf h "  blockmap: \n"
  exportBlockmap h levelBlockmap
  hPrintf h "\n"
  hPrintf h "};\n"

exportLevels :: Handle -> Map (CI LumpName) Level -> IO ()
exportLevels h mp = do
  hPrintf h "var levels = {%s};\n"
    (intercalate (","::String) $ (map (\ (_, Level{..}) ->
           printf "%s: level_%s" (show levelName) (BS8.unpack levelName))
     (zip ((" "::String):repeat",") $ Map.elems mp)))
    
exportPicture :: Handle -> Picture -> IO ()
exportPicture h Picture{..} = do
  hPrintf h "  width:%d,height:%d,leftOffset:%d,topOffset:%d,columns:[\n" pictureWidth pictureHeight pictureLeftOffset pictureTopOffset
  forM_ (zip (" ":repeat ",") picturePosts) $ \ (comma1, plist) -> do
    hPrintf h "    %s[" (comma1 :: String)
    forM_ (zip (" ":repeat ",") plist) $ \ (comma, Post{..}) -> do
      hPrintf h "%s{top:%d,pixels:%s}" (comma::String) postTop (show (BS.unpack postPixels))
    hPrintf h "]\n"
  hPrintf h "  ]"
                                                                   
exportSprite :: Handle -> (String, (CI LumpName, Sprite)) -> IO ()
exportSprite h (comma1, (_, Sprite{..})) = do
  hPrintf h "  %s%s: {name: %s,\n" comma1 (show spriteName) (show spriteName)
  exportPicture h spritePicture
  hPrintf h "\n  }\n"
  
exportSprites :: Handle -> Map (CI LumpName) Sprite -> IO ()
exportSprites h mp = do
  hPrintf h "var sprites = {\n"
  forM_ (zip (" ":repeat ",") $ Map.toList mp) (exportSprite h)
  hPrintf h "  };\n"


exportPatch :: Handle -> (String, (CI LumpName, Patch)) -> IO ()
exportPatch h (comma1, (_, Patch{..})) = do
  hPrintf h "  %s%s: {name: %s,\n" comma1 (show patchName) (show patchName)
  exportPicture h patchPicture
  hPrintf h "\n  }\n"
  
exportPatches :: Handle -> Map (CI LumpName) Patch -> IO ()
exportPatches h mp = do
  hPrintf h "var patches = {\n"
  forM_ (zip (" ":repeat ",") $ Map.toList mp) (exportPatch h)
  hPrintf h "};\n"


exportTexture :: Handle -> (String, (CI LumpName, Texture)) -> IO ()
exportTexture h (comma1, (_, Texture{..})) = do
  hPrintf h "  %s%s: {name:%s,width:%d,height:%d,patches:[\n" comma1 (show textureName) (show textureName) textureWidth textureHeight
  forM_ (zip (" ":repeat ",") texturePatchDescriptors) $ \ (comma, PatchDescriptor{..}) ->
    hPrintf h "  %s{xoffset:%d,yoffset:%d,pname:%d,stepdir:%d,colormap:%d}\n" (comma :: String)
      patchDescriptorXOffset patchDescriptorYOffset patchDescriptorPNameIndex patchDescriptorStepDir patchDescriptorColorMap
  hPrintf h "  ]}\n"

exportTextures :: Handle -> Map (CI LumpName) Texture -> IO ()
exportTextures h mp = do
  hPrintf h "var textures = {\n"
  forM_ (zip (" ":repeat ",") $ Map.toList mp) (exportTexture h)
  hPrintf h "};\n"

exportPNames :: Handle -> Map Int LumpName -> IO ()
exportPNames h mp = do
  hPrintf h "var pnames = [\n"
  forM_ (zip (" " : repeat ",") $ Map.elems mp) $ \ (comma, ln) -> do
    hPrintf h "%s%s" (comma :: String) (show ln)
  hPrintf h "  ];\n"  

exportFlats :: Handle -> Map (CI LumpName) Flat -> IO ()
exportFlats h mp = do
  hPrintf h "var flats = {\n"
  forM_ (zip (" ":repeat ",") (Map.elems mp)) $ \ (comma, Flat{..}) -> do
    hPrintf h "  %s%s:{name:%s,data:%s}\n" (comma :: String)
      (show flatName) (show flatName) (show (BS.unpack flatData))
  hPrintf h "  }\n"

exportColormap :: Handle -> Maybe Colormap -> IO ()
exportColormap _ Nothing = return ()
exportColormap h (Just (Colormap bs)) = do
  hPrintf h "var colormap = \n"
  hPrintf h "  %s\n" (show (map BS.unpack bs))
  hPrintf h "  ;\n"

exportPalettes :: Handle -> Maybe Palettes -> IO ()
exportPalettes _ Nothing = return ()
exportPalettes h (Just (Palettes pals)) = do
  hPrintf h "var palettes = [\n"
  forM_ (zip (" ":repeat ",") pals) $ \ (comma, pal) -> do
    hPrintf h "  %s[" (comma :: String)
    forM_ (zip (" ":repeat ",") pal) $ \ (comma', (r,g,b)) -> do
      hPrintf h "%s[%d,%d,%d]" (comma' :: String) r g b
    hPrintf h "]\n"
  hPrintf h "  ];\n"