%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
module TexEditor.Utils
    ( putTexture , getTexture, getCurrentTreeNode, modelRowToChannel
    , fixSubTree )
        where
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
import Graphics.UI.Gtk( binGetChild )
import Graphics.UI.Gtk.Display.Image( Image, imageSetFromPixbuf )
import Graphics.UI.Gtk.Gdk.Pixbuf
    ( PixbufData, Colorspace(..), InterpType(..)
    , pixbufNew, pixbufGetPixels, pixbufScaleSimple )
import Graphics.UI.Gtk.ModelView
    ( TreePath, castToTreeView, treeViewGetCursor, treeStoreLookup
    , treeStoreRemove, treeStoreInsert )
import Graphics.UI.Gtk.Layout.Notebook
    ( Notebook, notebookGetCurrentPage, notebookGetNthPage )
import Graphics.UI.Gtk.Scrolling.ScrolledWindow( castToScrolledWindow )
import Graphics.UI.Gtk.Abstract.Widget( widgetGetSizeRequest )
import Graphics.HDemo.TexGen
    ( TextureTree(..), ChannelTree(..), generateTexture )
import Graphics.HDemo.Texture( Texture(..), pixelData, size )
import Graphics.HDemo.Utils( fractionToWord16 )
import Data.Array.MArray( writeArray )
import Data.Word( Word8 )
import Data.Tree( Tree(..) )
import Control.Monad( forM_ )
import TexEditor.Data
    ( EdChannelTree, EdTextureNode(..), TreeModelRow(..), EdNodeType(..)
    , defaultTextureTreeNode )
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
putTexture :: Image -> Texture -> IO()
putTexture preview tex = do
  pixbuf <- pixbufNew ColorspaceRgb False 8 w h
  buff <- (pixbufGetPixels pixbuf :: IO (PixbufData Int Word8))
  mapM_ (uncurry $ writeArray buff) $ zip [0..] $ pixelData tex
  (iw,ih) <- widgetGetSizeRequest preview
  scaled <- pixbufScaleSimple pixbuf iw ih InterpBilinear
  imageSetFromPixbuf preview scaled
      where (w,h) = size tex
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
getTexture :: EdChannelTree -> EdChannelTree -> EdChannelTree -> IO Texture
getTexture storeRed storeGreen storeBlue = do
  red <- treeStoreLookup storeRed [0]
  green <- treeStoreLookup storeGreen [0]
  blue <- treeStoreLookup storeBlue [0]
  return $ generateTexture 
             (TexTree 256 256 []
              (maybe (COLOR 0) (treeToChannel . removeDisable) red)
              (maybe (COLOR 0) (treeToChannel . removeDisable) green)
              (maybe (COLOR 0) (treeToChannel . removeDisable) blue)
             )
\end{code}

\begin{code}
removeDisable :: Tree TreeModelRow -> Tree EdTextureNode
removeDisable (Node n xs)
    | tmEnabled n = Node (tmNode n) (map removeDisable xs)
    | otherwise = Node (EN_BASIC (COLOR 0)) []
\end{code}

\begin{code}
treeToChannel :: Tree EdTextureNode -> ChannelTree
treeToChannel (Node (EN_BASIC ct) []) = ct
treeToChannel (Node (EN_BASIC _) _) = error "invalid Texture Node"
treeToChannel (Node (EN_SINEDIST nx ny) (x:[])) = SINEDIST nx ny
                                              (treeToChannel x)
treeToChannel (Node (EN_SINEDIST _ _) _) = error "invalid Texture Node"
treeToChannel (Node (EN_COMP op) (x:y:[])) = COMP op 
                                             (treeToChannel x)
                                             (treeToChannel y)
treeToChannel (Node (EN_COMP _) _) = error "invalid Texture Node"
treeToChannel (Node (EN_MIXF op v) (x:y:[])) = MIXF op (fractionToWord16 v)
                                             (treeToChannel x)
                                             (treeToChannel y)
treeToChannel (Node (EN_MIXF _ _) _) = error "invalid Texture Node"
treeToChannel (Node (EN_FILTER) (x:[])) = FILTER (treeToChannel x)
treeToChannel (Node (EN_FILTER) _) = error "invalid Texture Node"
\end{code}

\begin{code}
modelRowToChannel :: Tree TreeModelRow -> ChannelTree
modelRowToChannel = treeToChannel . removeDisable
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
getCurrentTreeNode :: Notebook -> IO (Int, TreePath)
getCurrentTreeNode notebook = do
  pg <- notebookGetCurrentPage notebook
  Just page <- notebookGetNthPage notebook pg
  Just tree <- binGetChild $ castToScrolledWindow page
  cursor <- treeViewGetCursor $ castToTreeView tree
  return (pg, fst cursor)
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{code}
fixSubTree :: EdChannelTree -> TreePath -> Int -> Int -> IO ()
fixSubTree store path new old 
    | new == old = return ()
    | new < old = forM_ (replicate (old - new) [0]) 
                  $ treeStoreRemove store . (path ++)
    | otherwise = forM_ [0..(new - old - 1)]
                  (\i -> 
                   treeStoreInsert store path i 
                  $ defaultTextureTreeNode ENT_COLOR )
\end{code}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%