Add files

src/Dodge/Config.hs

@@ -0,0 +1,61 @@
+{- |
+IO actions that apply config side effects and save configuration settings to disk.
+-}
+module Dodge.Config (
+    saveConfig,
+    applyWorldConfig,
+    setVol,
+    loadDodgeConfig,
+) where
+
+import Data.Aeson
+import qualified Data.Aeson.Encode.Pretty as AEP
+import qualified Data.ByteString.Lazy as BS
+import Data.Preload
+import Dodge.Data.Config
+import Preload.Update
+import Sound
+import System.Directory
+
+{- |
+Write the current world configuration to disk as a json file.
+-}
+saveConfig :: Config -> (a -> IO a) -> a -> IO a
+saveConfig cfig f x = do
+    createDirectoryIfMissing True "generated"
+    BS.writeFile "generated/config.json" $
+        AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
+    f x
+
+loadDodgeConfig :: IO Config
+loadDodgeConfig = do
+    fExists <- doesFileExist "generated/config.json"
+    if fExists
+        then do
+            mconfig <- decodeFileStrict "generated/config.json"
+            maybe
+                (failstr "invalid generate/config.json, loading defaults")
+                return
+                mconfig
+        else failstr "No generated/config.json found, loading defaults"
+  where
+    failstr s = putStrLn s >> return defaultConfig
+
+{- |
+Apply the volume settings from the world configuration to the running game.
+-}
+setVol :: Config -> IO ()
+setVol cfig = do
+    setSoundVolume (_volume_master cfig * _volume_sound cfig)
+    setMusicVolume (_volume_master cfig * _volume_music cfig)
+
+{- |
+Apply /all/ of the values in the world configuration to the running game.
+-}
+applyWorldConfig ::
+    Config ->
+    PreloadData ->
+    IO PreloadData
+applyWorldConfig cfig pdata = do
+    setVol cfig
+    renderData (renderDataResizeUpdate cfig) pdata

src/Dodge/Item/Draw/SPicTree.hs

@@ -0,0 +1,21 @@
+module Dodge.Item.Draw.SPicTree (itemTreeSPic) where
+
+import Dodge.Item.Draw.SPic
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
+import Dodge.Data.Item
+import Dodge.Item.Orientation
+import LensHelp
+import qualified Linear.Quaternion as Q
+--import qualified Linear.Quaternion as Q
+import ShapePicture
+
+itemTreeSPic :: DTree CItem -> SPic
+itemTreeSPic (DT (itm, _) l r) = itemSPic itm <> foldMap (itemRotTreeSPic itm) (l <> r)
+
+itemRotTreeSPic :: Item -> DTree CItem -> SPic
+itemRotTreeSPic par t = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
+  where
+    (p, q) = orientAttachment par itm
+    itm = t ^. dtValue
+