Use System.Hclip instead of System.Clipboard

src/Dodge/Data/Universe.hs

@@ -25,7 +25,6 @@ import Dodge.Data.Config
 import Dodge.Data.World
 import Loop.Data
 import Picture.Data
-import Linear
 --import SDL (Scancode)
 
 data Universe = Universe
@@ -50,16 +49,9 @@ data Universe = Universe
 
 data DebugItem = DebugItem
     { _debugMessage :: String
-    , _debugFunction :: String -> Universe -> Universe
+    , _debugFunction :: Universe -> Universe
     }
 
-data DebugInfo
-    = NoDebugInfo
-    | DebugV3 { _debugV3 :: V3 Float}
-    | DebugV2 { _debugV2 :: V2 Float}
-    | DebugMInt { _debugMInt :: Maybe Int}
-    | DebugIntMInt {_debugInt :: Int, _debugMInt :: Maybe Int}
-
 data SideEffect
     = NewSideEffect
         { _ceSideEffect :: IO (Universe -> Maybe Universe)
@@ -115,4 +107,3 @@ makeLenses ''MenuOptionDisplay
 makeLenses ''MenuOption
 makeLenses ''ExtraMenuOption
 makeLenses ''DebugItem
-makeLenses ''DebugInfo

src/Dodge/Debug.hs

@@ -2,6 +2,8 @@
 
 module Dodge.Debug (debugEvents,drawDebug) where
 
+import qualified SDL
+import System.Hclip
 import Control.Lens
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -27,8 +29,8 @@ debugEvents u = case dbools ^. at Display_debug of
 overDebugEvent :: Universe -> Universe
 overDebugEvent u = fromMaybe u $ do
     OverDebug db i <- u ^? uvWorld . input . mouseContext
-    DebugItem s f <- u ^? uvDebug . ix db . ix i
-    return $ f s u
+    f <- u ^? uvDebug . ix db . ix i . debugFunction
+    return $ f u
 
 debugEvent :: DebugBool -> Universe -> Universe
 debugEvent db u = u & uvDebug . at db .~ debugItem db u
@@ -72,12 +74,14 @@ drawCrInfo :: Universe -> [DebugItem]
 drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
   where
     w = u ^. uvWorld
-    g h str = fmap $ ((rightPad 7 '.' str ++ "...") ++) . h
+    g h ls x = do
+        rs <- h <$> x
+        return $ DebugItem ((rightPad 7 '.' ls ++ "...") ++ rs) (setclip rs)
     f cr = fromMaybe [] $ do
         guard $
             pointIsOnScreen (u ^. uvConfig) (w ^. wCam) (cr ^. crPos . _xy)
                 && cr ^. crID /= 0
-        Just $ (\x -> DebugItem x (const id)) <$> catMaybes
+        Just $ catMaybes
                     [ g show "crID" $ cr ^? crID
                     , g show "crHP" $ cr ^? crHP . _HP
                     , g show "crStrategy" $ cr ^? crActionPlan . apStrategy
@@ -86,6 +90,9 @@ drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
                     , g show "crAction" $ cr ^? crActionPlan . apAction
                     , g show "crImpulse" $ cr ^? crActionPlan . apImpulse
                     ]
+    setclip s u'' = fromMaybe u'' $ do
+        guard (SDL.ButtonLeft `M.member` (u'' ^. uvWorld . input . mouseButtons))
+        return $ u'' & uvIOEffects %~ (\m u' -> setClipboard s >> m u')
 
 --closestCreatureID :: Universe -> Maybe Int
 --closestCreatureID u =

src/Dodge/Menu.hs

@@ -26,7 +26,7 @@ import MaybeHelp
 import Padding
 import Preload.Update
 import qualified SDL
-import System.Clipboard
+import System.Hclip
 import System.Directory
 import Text.Read
 
@@ -95,8 +95,8 @@ seedStartOptions =
 
 trySeedFromClipboard :: Universe -> IO Universe
 trySeedFromClipboard u = do
-    mcstr <- getClipboardString
-    return $ case mcstr >>= readMaybe of
+    str <- getClipboard
+    return $ case readMaybe str of
         Nothing ->
             pushScreen
                 (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")

src/Dodge/Update/Input/DebugTest.hs

@@ -10,7 +10,7 @@ module Dodge.Update.Input.DebugTest (
 ) where
 
 import Text.Read
-import System.Clipboard
+import System.Hclip
 import Data.Aeson
 import AesonHelp
 import Control.Lens
@@ -71,8 +71,8 @@ doDebugTestF10 = uvIOEffects %~ \f u -> do
     f u
 doDebugTestF11 :: Universe -> Universe
 doDebugTestF11 = uvIOEffects %~ \f u -> do
-    x <- getClipboardString
-    case x >>= readMaybe of
+    x <- getClipboard
+    case readMaybe x of
         Nothing -> do
             putStrLn "read fail"
             f u