mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 06:43:37 +00:00
switch to using eigen instead of hmatrix
This commit is contained in:
parent
4e15380c7e
commit
c80fdac30a
|
@ -32,7 +32,7 @@ common common
|
|||
|
||||
build-depends:
|
||||
base
|
||||
>= 4.13 && < 4.17
|
||||
>= 4.16 && < 4.20
|
||||
, acts
|
||||
^>= 0.3.1.0
|
||||
, containers
|
||||
|
@ -143,8 +143,8 @@ library splines
|
|||
build-depends:
|
||||
bifunctors
|
||||
>= 5.5.4 && < 5.6
|
||||
, hmatrix
|
||||
^>= 0.20.0.0
|
||||
, eigen
|
||||
^>= 3.3.7.0
|
||||
, parallel
|
||||
^>= 3.2.2.0
|
||||
, prim-instances
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
|
|
|
@ -19,6 +19,12 @@ source-repository-package
|
|||
tag: e9268cd5ea31322220c0847f2fdce968789693b4
|
||||
subdir: packages/base
|
||||
|
||||
-- GHC compat fixes for records-sop
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/kosmikus/records-sop
|
||||
tag: abab99b4b870fce55e81dd03d4e41fb50502ca4e
|
||||
|
||||
package hmatrix
|
||||
ghc-options: "-w"
|
||||
flags: +openblas
|
||||
|
@ -29,3 +35,6 @@ source-repository-package
|
|||
subdir: large-generics
|
||||
large-anon
|
||||
tag: acb837a9a4c22cea1abf552b47f9d3bf5af2fbdf
|
||||
|
||||
package *
|
||||
ghc-options: "-finfo-table-map" "-fdistinct-constructor-tables"
|
||||
|
|
30
shell.nix
Normal file
30
shell.nix
Normal file
|
@ -0,0 +1,30 @@
|
|||
let np = import <nixpkgs> {};
|
||||
in with np; np.mkShell { packages =
|
||||
[ cabal-install
|
||||
zlib
|
||||
pkg-config
|
||||
gobject-introspection
|
||||
gtk4
|
||||
pcre
|
||||
cairo
|
||||
glib
|
||||
atk
|
||||
util-linux
|
||||
libselinux
|
||||
libsepol
|
||||
xorg.libXdmcp
|
||||
libthai
|
||||
libdatrie
|
||||
epoxy
|
||||
fribidi
|
||||
xorg.libXi
|
||||
xorg.libXrandr
|
||||
xorg.libXcursor
|
||||
xorg.libXdamage
|
||||
xorg.libXinerama
|
||||
libxkbcommon ];
|
||||
shellHook = ''
|
||||
export LC_ALL=C.UTF-8
|
||||
export XDG_DATA_DIRS=${gsettings-desktop-schemas}/share/gsettings-schemas/${gsettings-desktop-schemas.name}:${gtk4}/share/gsettings-schemas/${gtk4.name}:$XDG_DATA_DIRS
|
||||
'';
|
||||
}
|
|
@ -267,22 +267,23 @@ instance HandleAction OpenFolder where
|
|||
GTK.nativeDialogShow fileChooser
|
||||
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
|
||||
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
|
||||
folder <- GTK.fileChooserGetFile fileChooser
|
||||
mbFolderPath <- GIO.fileGetPath folder
|
||||
for_ mbFolderPath \ folderPath -> do
|
||||
exists <- doesDirectoryExist folderPath
|
||||
when exists do
|
||||
filePaths <- listDirectory folderPath
|
||||
for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
|
||||
mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
|
||||
case mbDoc of
|
||||
Left errMessage -> warningDialog window filePath errMessage
|
||||
Right doc -> do
|
||||
let
|
||||
newDocHist :: DocumentHistory
|
||||
newDocHist = newHistory doc
|
||||
newFileTab uiElts vars ( Just newDocHist ) tabLoc
|
||||
updateHistoryState uiElts ( Just newDocHist )
|
||||
mbFolder <- GTK.fileChooserGetFile fileChooser
|
||||
for_ mbFolder \ folder -> do
|
||||
mbFolderPath <- GIO.fileGetPath folder
|
||||
for_ mbFolderPath \ folderPath -> do
|
||||
exists <- doesDirectoryExist folderPath
|
||||
when exists do
|
||||
filePaths <- listDirectory folderPath
|
||||
for_ filePaths \ filePath -> when ( takeExtension filePath == ".mb" ) do
|
||||
mbDoc <- loadDocument uniqueSupply ( folderPath </> filePath )
|
||||
case mbDoc of
|
||||
Left errMessage -> warningDialog window filePath errMessage
|
||||
Right doc -> do
|
||||
let
|
||||
newDocHist :: DocumentHistory
|
||||
newDocHist = newHistory doc
|
||||
newFileTab uiElts vars ( Just newDocHist ) tabLoc
|
||||
updateHistoryState uiElts ( Just newDocHist )
|
||||
|
||||
--------------------
|
||||
-- Save & Save as --
|
||||
|
@ -342,9 +343,10 @@ withSavePath ( UIElements {..} ) action = do
|
|||
GTK.nativeDialogShow fileChooser
|
||||
void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
|
||||
when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
|
||||
saveFile <- GTK.fileChooserGetFile fileChooser
|
||||
mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
|
||||
for_ mbSavePath action
|
||||
mbSaveFile <- GTK.fileChooserGetFile fileChooser
|
||||
for_ mbSaveFile \ saveFile -> do
|
||||
mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
|
||||
for_ mbSavePath action
|
||||
where
|
||||
fullFilePath :: FilePath -> FilePath
|
||||
fullFilePath fp
|
||||
|
|
|
@ -75,10 +75,6 @@ import qualified Control.Concurrent.STM as STM
|
|||
import qualified Control.Concurrent.STM.TVar as STM
|
||||
( newTVarIO, readTVar, writeTVar )
|
||||
|
||||
-- text
|
||||
import qualified Data.Text as Text
|
||||
( pack )
|
||||
|
||||
-- transformers
|
||||
import Control.Monad.Trans.Reader
|
||||
( runReaderT )
|
||||
|
@ -229,7 +225,7 @@ runApplication application = do
|
|||
display <- GTK.rootGetDisplay window
|
||||
|
||||
dataPath <- Directory.canonicalizePath =<< Cabal.getDataDir
|
||||
themePath <- Text.pack <$> ( Directory.canonicalizePath =<< Cabal.getDataFileName "theme.css" )
|
||||
themePath <- ( Directory.canonicalizePath =<< Cabal.getDataFileName "theme.css" )
|
||||
cssProvider <- GTK.cssProviderNew
|
||||
GTK.cssProviderLoadFromPath cssProvider themePath
|
||||
GTK.styleContextAddProviderForDisplay display cssProvider 1000
|
||||
|
@ -268,8 +264,8 @@ runApplication application = do
|
|||
|
||||
mainView <- GTK.boxNew GTK.OrientationVertical 0
|
||||
|
||||
GTK.panedSetStartChild mainPane mainView
|
||||
GTK.panedSetEndChild mainPane panelBox
|
||||
GTK.panedSetStartChild mainPane ( Just mainView )
|
||||
GTK.panedSetEndChild mainPane ( Just panelBox )
|
||||
|
||||
viewportGrid <- GTK.gridNew
|
||||
|
||||
|
|
|
@ -36,8 +36,8 @@ createPanelBar panelBox = do
|
|||
GTK.notebookSetGroupName panels1 ( Just "Panel" )
|
||||
GTK.notebookSetGroupName panels2 ( Just "Panel" )
|
||||
|
||||
GTK.panedSetStartChild pane1 panels1
|
||||
GTK.panedSetEndChild pane1 panels2
|
||||
GTK.panedSetStartChild pane1 ( Just panels1 )
|
||||
GTK.panedSetEndChild pane1 ( Just panels2 )
|
||||
|
||||
strokesPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
brushesPanel <- GTK.boxNew GTK.OrientationVertical 0
|
||||
|
|
|
@ -242,8 +242,8 @@ fitPiece dist_tol t_tol maxIters p tp qs r tr =
|
|||
b2' = b2 + ( q' ^.^ f1i )
|
||||
hermiteParameters ( Mat22 a11' a12' a21' a22' ) ( Vector2D b1' b2' ) ( i + 1 ) rest
|
||||
hermiteParameters a b _ [] = pure ( linearSolve a b )
|
||||
|
||||
Vector2D s1 s2 <- hermiteParameters ( Mat22 0 0 0 0 ) ( Vector2D 0 0 ) 0 qs
|
||||
|
||||
~(Vector2D s1 s2) <- hermiteParameters ( Mat22 0 0 0 0 ) ( Vector2D 0 0 ) 0 qs
|
||||
|
||||
let
|
||||
-- Convert from Hermite form to Bézier form.
|
||||
|
|
|
@ -1,12 +1,18 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
|
||||
module Math.Linear.Solve
|
||||
( linearSolve )
|
||||
where
|
||||
|
||||
-- hmatrix
|
||||
import qualified Numeric.LinearAlgebra as LAPACK
|
||||
( linearSolveSVD )
|
||||
import qualified Numeric.LinearAlgebra.Data as HMatrix
|
||||
( Matrix, col, matrix, atIndex )
|
||||
-- base
|
||||
import Data.Maybe
|
||||
( fromJust )
|
||||
|
||||
-- eigen
|
||||
import qualified Eigen.Matrix as Eigen
|
||||
( Matrix, toList, fromList )
|
||||
import qualified Eigen.Solver.LA as Eigen
|
||||
( Decomposition(..), solve )
|
||||
|
||||
-- MetaBrush
|
||||
import Math.Vector2D
|
||||
|
@ -15,7 +21,11 @@ import Math.Vector2D
|
|||
--------------------------------------------------------------------------------
|
||||
|
||||
linearSolve :: Mat22 Double -> Vector2D Double -> Vector2D Double
|
||||
linearSolve ( Mat22 a b c d ) ( Vector2D p q ) = Vector2D ( sol `HMatrix.atIndex` (0,0) ) ( sol `HMatrix.atIndex` (1,0) )
|
||||
linearSolve ( Mat22 a b c d ) ( Vector2D p q ) = Vector2D u v
|
||||
where
|
||||
sol :: HMatrix.Matrix Double
|
||||
sol = LAPACK.linearSolveSVD ( HMatrix.matrix 2 [a,b,c,d] ) ( HMatrix.col [p,q] )
|
||||
[[u],[v]] = Eigen.toList
|
||||
$ Eigen.solve Eigen.JacobiSVD
|
||||
( fromJust ( Eigen.fromList [[a,b],[c,d]] )
|
||||
:: Eigen.Matrix 2 2 Double )
|
||||
( fromJust ( Eigen.fromList [[p],[q]] )
|
||||
:: Eigen.Matrix 2 1 Double )
|
||||
|
|
|
@ -2,10 +2,15 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MonoLocalBinds #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Math.Vector2D
|
||||
( Point2D(..), Vector2D(.., Vector2D), Mat22(..)
|
||||
|
@ -17,7 +22,7 @@ module Math.Vector2D
|
|||
import Data.Monoid
|
||||
( Sum(..) )
|
||||
import GHC.Generics
|
||||
( Generic, Generic1, Generically(..), Generically1(..) )
|
||||
|
||||
|
||||
-- acts
|
||||
import Data.Act
|
||||
|
@ -29,7 +34,7 @@ import Control.DeepSeq
|
|||
|
||||
-- groups
|
||||
import Data.Group
|
||||
( Group )
|
||||
( Group(..) )
|
||||
|
||||
-- groups-generic
|
||||
import Data.Group.Generics
|
||||
|
@ -73,3 +78,20 @@ data Segment p =
|
|||
deriving Applicative
|
||||
via Generically1 Segment
|
||||
deriving anyclass ( NFData, NFData1 )
|
||||
|
||||
|
||||
-- TODO: move the following to the groups or groups-generic package.
|
||||
ginvert :: forall g. ( Generic g, Group ( Rep g () ) ) => g -> g
|
||||
ginvert = to . invert @( Rep g () ) . from
|
||||
|
||||
gpow :: forall n g. ( Integral n, Generic g, Group ( Rep g () ) ) => g -> n -> g
|
||||
gpow x n = to ( pow @( Rep g () ) ( from x ) n )
|
||||
|
||||
instance
|
||||
( Generic g
|
||||
, Monoid ( Generically g )
|
||||
, Group ( Rep g () )
|
||||
)
|
||||
=> Group ( Generically g ) where
|
||||
invert (Generically x) = Generically (ginvert x)
|
||||
pow (Generically x) n = Generically (gpow x n)
|
||||
|
|
Loading…
Reference in a new issue