mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
WIP
This commit is contained in:
sheaf
commit
c9e702e660
5
.gitignore
vendored
Normal file
5
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,5 @@
|
||||||
|
dist-newstyle/
|
||||||
|
assets/*.svg
|
||||||
|
assets/*/
|
||||||
|
*.txt
|
||||||
|
cabal.project.local
|
||||||
109
MetaBrush.cabal
Normal file
109
MetaBrush.cabal
Normal file
|
|
@ -0,0 +1,109 @@
|
||||||
|
cabal-version: 3.0
|
||||||
|
name: MetaBrush
|
||||||
|
version: 0.1.0.0
|
||||||
|
synopsis: GUI for brush calligraphy.
|
||||||
|
category: Calligraphy, Font, Geometry, Graphics, GUI
|
||||||
|
license: BSD-3-Clause
|
||||||
|
homepage: https://gitlab.com/sheaf/MetaBrush
|
||||||
|
build-type: Simple
|
||||||
|
data-files:
|
||||||
|
assets/theme.css
|
||||||
|
description:
|
||||||
|
|
||||||
|
MetaBrush is a GUI for brush calligraphy based on Bézier curves.
|
||||||
|
|
||||||
|
A brush stroke is defined by two components:
|
||||||
|
|
||||||
|
* the path of the brush, specified using quadratic Bézier curves,
|
||||||
|
|
||||||
|
* the shape of the brush, also specified with quadratic Bézier curves.
|
||||||
|
|
||||||
|
The shape of the brush is allowed to vary along the path.
|
||||||
|
|
||||||
|
common common
|
||||||
|
|
||||||
|
build-depends:
|
||||||
|
base
|
||||||
|
>= 4.13 && < 4.16
|
||||||
|
|
||||||
|
default-language:
|
||||||
|
Haskell2010
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
-O1
|
||||||
|
-fexpose-all-unfoldings
|
||||||
|
-fspecialise-aggressively
|
||||||
|
-Wall
|
||||||
|
-Wcompat
|
||||||
|
-fwarn-missing-local-signatures
|
||||||
|
-fwarn-incomplete-patterns
|
||||||
|
-fwarn-incomplete-uni-patterns
|
||||||
|
-fwarn-missing-deriving-strategies
|
||||||
|
|
||||||
|
library
|
||||||
|
|
||||||
|
import:
|
||||||
|
common
|
||||||
|
|
||||||
|
hs-source-dirs:
|
||||||
|
src/lib
|
||||||
|
|
||||||
|
exposed-modules:
|
||||||
|
Math.Bezier.Cubic
|
||||||
|
, Math.Bezier.Quadratic
|
||||||
|
, Math.Bezier.Stroke
|
||||||
|
, Math.Bezier.Subdivision
|
||||||
|
, Math.Module
|
||||||
|
, Math.Vector2D
|
||||||
|
|
||||||
|
build-depends:
|
||||||
|
acts
|
||||||
|
^>= 0.3.1.0
|
||||||
|
, generic-data
|
||||||
|
>= 0.8.0.0 && < 0.8.4.0
|
||||||
|
, groups
|
||||||
|
^>= 0.4.1.0
|
||||||
|
, groups-generic
|
||||||
|
^>= 0.1.0.0
|
||||||
|
|
||||||
|
executable MetaBrush
|
||||||
|
|
||||||
|
hs-source-dirs:
|
||||||
|
src/app
|
||||||
|
, app
|
||||||
|
|
||||||
|
main-is:
|
||||||
|
Main.hs
|
||||||
|
|
||||||
|
other-modules:
|
||||||
|
MetaBrush.Asset.Brush
|
||||||
|
, MetaBrush.Asset.Logo
|
||||||
|
, MetaBrush.Asset.Magnifier
|
||||||
|
, MetaBrush.Asset.Meta
|
||||||
|
, MetaBrush.Asset.TickBox
|
||||||
|
, MetaBrush.Asset.WindowIcons
|
||||||
|
, MetaBrush.Document
|
||||||
|
, MetaBrush.Render.Util
|
||||||
|
, MetaBrush.Stroke
|
||||||
|
, Paths_MetaBrush
|
||||||
|
|
||||||
|
autogen-modules:
|
||||||
|
Paths_MetaBrush
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
-threaded -rtsopts
|
||||||
|
|
||||||
|
build-depends:
|
||||||
|
MetaBrush
|
||||||
|
, gi-gdk
|
||||||
|
>= 3.0.22 && < 3.1
|
||||||
|
, gi-glib
|
||||||
|
>= 2.0.23 && < 2.1
|
||||||
|
, gi-gtk
|
||||||
|
>= 3.0.35 && < 3.1
|
||||||
|
, gi-cairo-render
|
||||||
|
^>= 0.0.1
|
||||||
|
, gi-cairo-connector
|
||||||
|
^>= 0.0.1
|
||||||
|
, text
|
||||||
|
^>= 1.2.3.1 && < 1.2.5
|
||||||
91
app/Main.hs
Normal file
91
app/Main.hs
Normal file
|
|
@ -0,0 +1,91 @@
|
||||||
|
module Main
|
||||||
|
( main )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-connector
|
||||||
|
import qualified GI.Cairo.Render.Connector as Cairo
|
||||||
|
( renderWithContext )
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- gi-gtk
|
||||||
|
import qualified GI.Gtk as GTK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import Paths_MetaBrush
|
||||||
|
( getDataFileName )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
|
||||||
|
---------------------------------------------------------
|
||||||
|
-- Initialise GTK
|
||||||
|
|
||||||
|
_ <- GTK.init Nothing
|
||||||
|
Just screen <- GDK.screenGetDefault
|
||||||
|
|
||||||
|
themePath <- getDataFileName "theme.css"
|
||||||
|
cssProvider <- GTK.cssProviderNew
|
||||||
|
GTK.cssProviderLoadFromPath cssProvider themePath
|
||||||
|
GTK.styleContextAddProviderForScreen screen cssProvider 1000
|
||||||
|
|
||||||
|
window <- GTK.windowNew GTK.WindowTypeToplevel
|
||||||
|
windowWidgetPath <- GTK.widgetGetPath window
|
||||||
|
widgetAddClass window "window"
|
||||||
|
GTK.setWindowResizable window True
|
||||||
|
GTK.setWindowDecorated window False
|
||||||
|
GTK.setWindowTitle window "MetaBrush"
|
||||||
|
GTK.windowSetDefaultSize window 800 600
|
||||||
|
|
||||||
|
let
|
||||||
|
baseMinWidth, baseMinHeight :: Int32
|
||||||
|
baseMinWidth = 320
|
||||||
|
baseMinHeight = 240
|
||||||
|
|
||||||
|
windowGeometry <- GDK.newZeroGeometry
|
||||||
|
GDK.setGeometryMinWidth windowGeometry baseMinWidth
|
||||||
|
GDK.setGeometryMinHeight windowGeometry baseMinHeight
|
||||||
|
GTK.windowSetGeometryHints window ( Nothing @GTK.Widget )
|
||||||
|
( Just windowGeometry )
|
||||||
|
[ GDK.WindowHintsMinSize ]
|
||||||
|
|
||||||
|
---------------------------------------------------------
|
||||||
|
-- Create base UI elements
|
||||||
|
|
||||||
|
baseOverlay <- GTK.overlayNew
|
||||||
|
GT.setContainerChild window baseOverlay
|
||||||
|
|
||||||
|
uiGrid <- GTK.gridNew
|
||||||
|
GTK.overlaySetChild baseOverlay uiGrid
|
||||||
|
|
||||||
|
logo <- GTK.boxNew GTK.OrientationVertical 0
|
||||||
|
titleBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
|
toolBar <- GTK.boxNew GTK.OrientationVertical 0
|
||||||
|
fileBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
|
mainView <- GTK.gridNew
|
||||||
|
panelGrid <- GTK.gridNew
|
||||||
|
infoBar <- GTK.boxNew GTK.OrientationHorizontal 0
|
||||||
|
|
||||||
|
GTK.gridAttach uiGrid logo 0 0 1 2
|
||||||
|
GTK.gridAttach uiGrid titleBar 1 0 3 1
|
||||||
|
GTK.gridAttach uiGrid toolBar 0 2 2 2
|
||||||
|
GTK.gridAttach uiGrid fileBar 2 1 1 1
|
||||||
|
GTK.gridAttach uiGrid mainView 2 2 1 1
|
||||||
|
GTK.gridAttach uiGrid panelGrid 3 2 1 2
|
||||||
|
GTK.gridAttach uiGrid infoBar 2 3 1 1
|
||||||
|
|
||||||
|
--------------------------------------
|
||||||
|
-- Actions
|
||||||
|
|
||||||
|
GTK.widgetAddEvents window [GDK.EventMaskKeyPressMask, GDK.EventMaskKeyReleaseMask]
|
||||||
|
_ <- GTK.onWidgetKeyPressEvent window ( handleKeyboardPressEvent )
|
||||||
|
_ <- GTK.onWidgetKeyReleaseEvent window ( handleKeyboardReleaseEvent )
|
||||||
|
|
||||||
|
_ <- GTK.onWidgetDestroy window ( quitAll actionTVar )
|
||||||
|
_ <- GTK.onButtonClicked quitIconButton ( quitAll actionTVar )
|
||||||
|
|
||||||
|
GTK.widgetShowAll window
|
||||||
|
GTK.main
|
||||||
88
assets/theme.css
Normal file
88
assets/theme.css
Normal file
|
|
@ -0,0 +1,88 @@
|
||||||
|
* {
|
||||||
|
all: unset;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Window background colour */
|
||||||
|
.bg {
|
||||||
|
color: #292828
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Viewport background colour */
|
||||||
|
.viewport_bg {
|
||||||
|
color: #ecdfd2
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Basic text colour */
|
||||||
|
.plain {
|
||||||
|
color: #d4be98
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Basic text font */
|
||||||
|
.text {
|
||||||
|
font-family: "Lato", "Roboto", "Helvetica", sans-serif
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Monospace font */
|
||||||
|
.monospace {
|
||||||
|
font-family: "Fira Code", "Inconsolata", "Courier", "Courier New", monospace
|
||||||
|
}
|
||||||
|
|
||||||
|
/* High-constrast text colour */
|
||||||
|
.contrast {
|
||||||
|
color: #f7f4ef
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Active (highlighting) colour */
|
||||||
|
.highlight {
|
||||||
|
color: #eadfcc
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Logo base colour */
|
||||||
|
.logo_base {
|
||||||
|
color: #f7f4ef
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Logo highlight colour */
|
||||||
|
.logo_highlight {
|
||||||
|
color: #f5881bff
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Viewport scrollbar colour */
|
||||||
|
.viewport_scrollbar {
|
||||||
|
color: #28272793
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Tab scrollbar colour */
|
||||||
|
.tab_scrollbar {
|
||||||
|
color: #302d2693
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Ruler colour */
|
||||||
|
.ruler {
|
||||||
|
color: #ede29a
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Magnifying glass base colour */
|
||||||
|
.magnifier {
|
||||||
|
color: #ecdfd2
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Magnifying glass glass colour */
|
||||||
|
.glass {
|
||||||
|
color: #9ce7ff72
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Cursor colour */
|
||||||
|
.cursor {
|
||||||
|
color: #f7f4ef
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Bézier path point colour */
|
||||||
|
.point {
|
||||||
|
color: #8183f1
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Bézier control point colour */
|
||||||
|
.control {
|
||||||
|
color: #a1dde9
|
||||||
|
}
|
||||||
10
cabal.project
Normal file
10
cabal.project
Normal file
|
|
@ -0,0 +1,10 @@
|
||||||
|
constraints:
|
||||||
|
acts -finitary
|
||||||
|
, haskell-gi >= 0.24
|
||||||
|
|
||||||
|
-- fixes gi-cairo-render to work with haskell-gi >= 0.24
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://github.com/thestr4ng3r/gi-cairo-render
|
||||||
|
tag: 8727c43cdf91aeedffc9cb4c5575f56660a86399
|
||||||
|
subdir: gi-cairo-render
|
||||||
5528
img/MetaBrush_ui_mockup.svg
Normal file
5528
img/MetaBrush_ui_mockup.svg
Normal file
File diff suppressed because it is too large
Load diff
|
After Width: | Height: | Size: 236 KiB |
BIN
img/logo.png
Normal file
BIN
img/logo.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 14 KiB |
60
src/app/MetaBrush/Asset/Brush.hs
Normal file
60
src/app/MetaBrush/Asset/Brush.hs
Normal file
|
|
@ -0,0 +1,60 @@
|
||||||
|
module MetaBrush.Asset.Brush
|
||||||
|
( drawBrush )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import MetaBrush.Render.Util
|
||||||
|
( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Calligraphy brush icon. Width = 29, height = 29.
|
||||||
|
drawBrush :: GDK.RGBA -> GDK.RGBA -> GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawBrush brushColour bodyColour loopColour = do
|
||||||
|
|
||||||
|
-- Loop
|
||||||
|
Cairo.setLineWidth 0.2
|
||||||
|
withRGBA loopColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 23.144531 6.199219
|
||||||
|
Cairo.curveTo 22.40625 6.890625 21.382813 5.953125 20.375 7.300781
|
||||||
|
Cairo.curveTo 21.109375 5.925781 19.828125 5.410156 20.398438 4.324219
|
||||||
|
Cairo.curveTo 20.894531 3.375 21.757813 2.621094 23.046875 3.636719
|
||||||
|
Cairo.curveTo 24.035156 4.414063 24.128906 5.273438 23.144531 6.199219
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.strokePreserve
|
||||||
|
|
||||||
|
-- Brush body
|
||||||
|
withRGBA bodyColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 20.605469 7.359375
|
||||||
|
Cairo.curveTo 20.988281 7.566406 21.476563 8.136719 21.195313 8.464844
|
||||||
|
Cairo.lineTo 15.539063 14.84375
|
||||||
|
Cairo.lineTo 14.90625 18.964844
|
||||||
|
Cairo.curveTo 14.074219 19.195313 11.992188 17.941406 11.246094 17.457031
|
||||||
|
Cairo.curveTo 10.5 16.976563 9.460938 15.597656 9.816406 15.351563
|
||||||
|
Cairo.lineTo 13.507813 13.835938
|
||||||
|
Cairo.lineTo 18.980469 6.996094
|
||||||
|
Cairo.curveTo 19.25 6.660156 19.671875 6.613281 20 6.894531
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
|
-- Brush tip
|
||||||
|
withRGBA brushColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 10.339844 19.335938
|
||||||
|
Cairo.curveTo 11.089844 19.847656 11.996094 20.34375 12.683594 20.507813
|
||||||
|
Cairo.curveTo 12.683594 20.507813 7.59375 24.476563 7.59375 24.476563
|
||||||
|
Cairo.curveTo 6.867188 25.160156 4.785156 26.105469 4.601563 25.941406
|
||||||
|
Cairo.curveTo 4.4375 25.792969 5.042969 24.261719 5.652344 23.140625
|
||||||
|
Cairo.curveTo 5.652344 23.140625 8.566406 17.773438 8.566406 17.773438
|
||||||
|
Cairo.curveTo 8.804688 18.136719 9.585938 18.820313 10.339844 19.335938
|
||||||
|
Cairo.curveTo 10.339844 19.335938 10.339844 19.335938 10.339844 19.335938
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
81
src/app/MetaBrush/Asset/Logo.hs
Normal file
81
src/app/MetaBrush/Asset/Logo.hs
Normal file
|
|
@ -0,0 +1,81 @@
|
||||||
|
module MetaBrush.Asset.Logo
|
||||||
|
( drawLogo )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import MetaBrush.Render.Util
|
||||||
|
( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | MetaBrush logo. Width = 29, height = 29.
|
||||||
|
drawLogo :: GDK.RGBA -> GDK.RGBA -> GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawLogo brushColour bodyColour loopColour = do
|
||||||
|
|
||||||
|
-- Loop
|
||||||
|
Cairo.setLineWidth 0.2
|
||||||
|
withRGBA loopColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 17.480469 7.847656
|
||||||
|
Cairo.curveTo 16.890625 8.402344 16.070313 7.648438 15.257813 8.730469
|
||||||
|
Cairo.curveTo 15.847656 7.625 14.820313 7.210938 15.277344 6.339844
|
||||||
|
Cairo.curveTo 15.675781 5.578125 16.371094 4.972656 17.40625 5.789063
|
||||||
|
Cairo.curveTo 18.199219 6.414063 18.273438 7.101563 17.480469 7.847656
|
||||||
|
Cairo.curveTo 17.480469 7.847656 17.480469 7.847656 17.480469 7.847656
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.strokePreserve
|
||||||
|
|
||||||
|
-- Body
|
||||||
|
withRGBA bodyColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 14.53125 8.257813
|
||||||
|
Cairo.curveTo 14.386719 8.273438 14.246094 8.351563 14.140625 8.484375
|
||||||
|
Cairo.curveTo 14.140625 8.484375 9.746094 13.976563 9.746094 13.976563
|
||||||
|
Cairo.curveTo 9.746094 13.976563 6.78125 15.195313 6.78125 15.195313
|
||||||
|
Cairo.curveTo 6.496094 15.390625 7.332031 16.5 7.929688 16.886719
|
||||||
|
Cairo.curveTo 8.53125 17.273438 10.199219 18.28125 10.867188 18.097656
|
||||||
|
Cairo.curveTo 10.867188 18.097656 11.375 14.789063 11.375 14.789063
|
||||||
|
Cairo.curveTo 11.375 14.789063 13.117188 12.824219 13.117188 12.824219
|
||||||
|
Cairo.curveTo 13.117188 12.824219 14.0625 11.660156 14.0625 11.660156
|
||||||
|
Cairo.curveTo 14.53125 12.59375 16.511719 16.417969 16.605469 16.535156
|
||||||
|
Cairo.curveTo 17.550781 16.058594 17.769531 15.773438 18.277344 15.167969
|
||||||
|
Cairo.curveTo 18.863281 14.359375 18.9375 14.257813 19.722656 13.226563
|
||||||
|
Cairo.curveTo 20.089844 13.980469 21.21875 15.222656 22.25 16.554688
|
||||||
|
Cairo.curveTo 22.636719 17.058594 24.300781 18.761719 24.785156 18.570313
|
||||||
|
Cairo.curveTo 25.046875 18.46875 25.972656 17.636719 26.136719 16.753906
|
||||||
|
Cairo.curveTo 26.171875 16.554688 26.265625 15.800781 26.097656 15.648438
|
||||||
|
Cairo.curveTo 25.976563 15.542969 24.988281 16.101563 24.679688 15.976563
|
||||||
|
Cairo.curveTo 24.144531 15.195313 23.488281 13.832031 22.921875 12.886719
|
||||||
|
Cairo.curveTo 22.023438 11.261719 21.320313 9.261719 20.597656 9.703125
|
||||||
|
Cairo.curveTo 20.09375 10.011719 19.808594 10.394531 19.699219 10.554688
|
||||||
|
Cairo.curveTo 19.195313 11.285156 18.960938 11.648438 18 12.988281
|
||||||
|
Cairo.curveTo 17.140625 11.703125 16.738281 10.175781 15.789063 9.058594
|
||||||
|
Cairo.curveTo 15.761719 9.03125 15.738281 9.011719 15.714844 8.992188
|
||||||
|
Cairo.curveTo 15.6875 8.960938 15.660156 8.9375 15.632813 8.914063
|
||||||
|
Cairo.curveTo 15.578125 8.871094 15.527344 8.832031 15.476563 8.800781
|
||||||
|
Cairo.curveTo 15.464844 8.792969 15.457031 8.78125 15.445313 8.777344
|
||||||
|
Cairo.curveTo 15.445313 8.777344 14.960938 8.40625 14.960938 8.40625
|
||||||
|
Cairo.curveTo 14.828125 8.292969 14.675781 8.246094 14.53125 8.257813
|
||||||
|
Cairo.curveTo 14.53125 8.257813 14.53125 8.257813 14.53125 8.257813
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
|
-- Brush tip
|
||||||
|
withRGBA brushColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 7.199219 18.394531
|
||||||
|
Cairo.curveTo 7.804688 18.804688 8.53125 19.203125 9.082031 19.335938
|
||||||
|
Cairo.curveTo 9.082031 19.335938 4.996094 22.519531 4.996094 22.519531
|
||||||
|
Cairo.curveTo 4.414063 23.074219 2.742188 23.832031 2.59375 23.699219
|
||||||
|
Cairo.curveTo 2.460938 23.582031 2.949219 22.351563 3.4375 21.449219
|
||||||
|
Cairo.curveTo 3.4375 21.449219 5.777344 17.140625 5.777344 17.140625
|
||||||
|
Cairo.curveTo 5.96875 17.429688 6.597656 17.980469 7.199219 18.394531
|
||||||
|
Cairo.curveTo 7.199219 18.394531 7.199219 18.394531 7.199219 18.394531
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
60
src/app/MetaBrush/Asset/Magnifier.hs
Normal file
60
src/app/MetaBrush/Asset/Magnifier.hs
Normal file
|
|
@ -0,0 +1,60 @@
|
||||||
|
module MetaBrush.Asset.Magnifier
|
||||||
|
( drawMagnifier )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import MetaBrush.Render.Util
|
||||||
|
( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Magnifying glass icon. Width = 19, height = 25.
|
||||||
|
drawMagnifier :: GDK.RGBA -> GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawMagnifier magnifierColour glassColour = do
|
||||||
|
|
||||||
|
-- Magnifying glass.
|
||||||
|
withRGBA glassColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 18.191406 6.144531
|
||||||
|
Cairo.curveTo 19.238281 10.191406 16.804688 14.324219 12.753906 15.371094
|
||||||
|
Cairo.curveTo 8.703125 16.417969 4.574219 13.984375 3.527344 9.933594
|
||||||
|
Cairo.curveTo 2.480469 5.882813 4.914063 1.753906 8.964844 0.707031
|
||||||
|
Cairo.curveTo 13.011719 -0.339844 17.144531 2.09375 18.191406 6.144531
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
|
-- Magnifier.
|
||||||
|
withRGBA magnifierColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 11.144531 0.00390625
|
||||||
|
Cairo.curveTo 8.296875 -0.09375 5.484375 1.332031 3.933594 3.960938
|
||||||
|
Cairo.curveTo 1.871094 7.464844 2.980469 12.0625 6.089844 14.515625
|
||||||
|
Cairo.curveTo 5.878906 14.90625 5.226563 16.132813 4.554688 15.75
|
||||||
|
Cairo.curveTo 4.300781 15.609375 3.878906 15.882813 3.605469 16.363281
|
||||||
|
Cairo.lineTo 0.128906 22.34375
|
||||||
|
Cairo.curveTo -0.140625 22.828125 0.0273438 23.4375 0.503906 23.707031
|
||||||
|
Cairo.lineTo 2.320313 24.738281
|
||||||
|
Cairo.curveTo 2.800781 25.011719 3.410156 24.839844 3.683594 24.363281
|
||||||
|
Cairo.lineTo 7.148438 18.210938
|
||||||
|
Cairo.curveTo 7.421875 17.730469 7.34375 17.394531 7.09375 17.246094
|
||||||
|
Cairo.curveTo 6.445313 16.855469 7.1875 15.789063 7.449219 15.332031
|
||||||
|
Cairo.curveTo 11.136719 16.988281 15.683594 15.683594 17.78125 12.117188
|
||||||
|
Cairo.curveTo 20.035156 8.292969 18.761719 3.367188 14.9375 1.113281
|
||||||
|
Cairo.curveTo 13.742188 0.410156 12.441406 0.0507813 11.144531 0.00390625
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.moveTo 10.855469 1.375
|
||||||
|
Cairo.curveTo 13.894531 1.371094 16.550781 3.429688 17.3125 6.371094
|
||||||
|
Cairo.curveTo 18.234375 9.9375 16.089844 13.570313 12.527344 14.492188
|
||||||
|
Cairo.curveTo 8.960938 15.414063 5.328125 13.269531 4.40625 9.707031
|
||||||
|
Cairo.curveTo 3.484375 6.144531 5.625 2.507813 9.191406 1.585938
|
||||||
|
Cairo.curveTo 9.734375 1.445313 10.292969 1.375 10.855469 1.375
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.setFillRule Cairo.FillRuleWinding
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
42
src/app/MetaBrush/Asset/Meta.hs
Normal file
42
src/app/MetaBrush/Asset/Meta.hs
Normal file
|
|
@ -0,0 +1,42 @@
|
||||||
|
module MetaBrush.Asset.Meta
|
||||||
|
( drawMeta )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import MetaBrush.Render.Util
|
||||||
|
( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | MetaParameter icon. Width = 29, height = 29.
|
||||||
|
drawMeta :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawMeta metaColour = do
|
||||||
|
withRGBA metaColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 16.140625 11.976563
|
||||||
|
Cairo.curveTo 15.042969 10.355469 13.957031 7.050781 13.257813 7.195313
|
||||||
|
Cairo.curveTo 12.878906 7.078125 5.332031 18.234375 4.664063 19.019531
|
||||||
|
Cairo.curveTo 3.90625 18.234375 2.886719 19.078125 2.800781 20.273438
|
||||||
|
Cairo.curveTo 2.800781 20.886719 4.28125 22.585938 5.566406 20.738281
|
||||||
|
Cairo.curveTo 5.6875 20.566406 11.421875 12.542969 11.957031 11.753906
|
||||||
|
Cairo.curveTo 12.421875 12.714844 14.351563 16.082031 14.46875 16.230469
|
||||||
|
Cairo.curveTo 15.605469 15.660156 15.863281 15.316406 16.476563 14.589844
|
||||||
|
Cairo.curveTo 17.171875 13.621094 17.265625 13.5 18.207031 12.261719
|
||||||
|
Cairo.curveTo 18.644531 13.164063 20 14.65625 21.238281 16.253906
|
||||||
|
Cairo.curveTo 21.703125 16.855469 23.695313 18.898438 24.28125 18.671875
|
||||||
|
Cairo.curveTo 24.589844 18.550781 25.699219 17.550781 25.894531 16.492188
|
||||||
|
Cairo.curveTo 25.941406 16.253906 26.050781 15.351563 25.847656 15.167969
|
||||||
|
Cairo.curveTo 25.707031 15.039063 24.519531 15.707031 24.148438 15.5625
|
||||||
|
Cairo.curveTo 23.507813 14.621094 22.722656 12.988281 22.042969 11.859375
|
||||||
|
Cairo.curveTo 20.964844 9.90625 20.125 7.507813 19.257813 8.039063
|
||||||
|
Cairo.curveTo 18.652344 8.410156 18.308594 8.867188 18.179688 9.058594
|
||||||
|
Cairo.curveTo 17.574219 9.9375 17.289063 10.367188 16.140625 11.976563
|
||||||
|
Cairo.curveTo 16.140625 11.976563 16.140625 11.976563 16.140625 11.976563
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
96
src/app/MetaBrush/Asset/TickBox.hs
Normal file
96
src/app/MetaBrush/Asset/TickBox.hs
Normal file
|
|
@ -0,0 +1,96 @@
|
||||||
|
module MetaBrush.Asset.TickBox
|
||||||
|
( drawBox, drawTickedBox )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import MetaBrush.Render.Util
|
||||||
|
( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Non-ticked box. Width = 14, height = 12.
|
||||||
|
drawBox :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawBox boxColour = do
|
||||||
|
withRGBA loopColour Cairo.setSourceRGBA
|
||||||
|
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 2.015625 0.769531
|
||||||
|
Cairo.curveTo 0.910156 0.769531 0 1.6875 0 2.789063
|
||||||
|
Cairo.lineTo 0 10
|
||||||
|
Cairo.curveTo 0 11.101563 0.910156 12.015625 2.015625 12.015625
|
||||||
|
Cairo.lineTo 9.226563 12.015625
|
||||||
|
Cairo.curveTo 10.328125 12.015625 11.246094 11.101563 11.246094 10
|
||||||
|
Cairo.lineTo 11.246094 2.789063
|
||||||
|
Cairo.curveTo 11.246094 1.6875 10.328125 0.769531 9.226563 0.769531
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.moveTo 2.015625 2.375
|
||||||
|
Cairo.lineTo 9.226563 2.375
|
||||||
|
Cairo.curveTo 9.46875 2.375 9.640625 2.546875 9.640625 2.789063
|
||||||
|
Cairo.lineTo 9.640625 10
|
||||||
|
Cairo.curveTo 9.640625 10.242188 9.46875 10.414063 9.226563 10.414063
|
||||||
|
Cairo.lineTo 2.015625 10.414063
|
||||||
|
Cairo.curveTo 1.769531 10.414063 1.597656 10.242188 1.597656 10
|
||||||
|
Cairo.lineTo 1.597656 2.789063
|
||||||
|
Cairo.curveTo 1.597656 2.546875 1.769531 2.375 2.015625 2.375
|
||||||
|
Cairo.closePath
|
||||||
|
|
||||||
|
Cairo.setFillRule Cairo.FillRuleWinding
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
|
-- | Ticked box. Width = 14, height = 12.
|
||||||
|
drawTickedBox :: GDK.RGBA -> GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawTickedBox boxColour tickColour = do
|
||||||
|
|
||||||
|
-- Box
|
||||||
|
withRGBA boxColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 2.015625 0.769531
|
||||||
|
Cairo.curveTo 0.910156 0.769531 0 1.679688 0 2.785156
|
||||||
|
Cairo.lineTo 0 9.996094
|
||||||
|
Cairo.curveTo 0 11.097656 0.910156 12.015625 2.015625 12.015625
|
||||||
|
Cairo.lineTo 9.226563 12.015625
|
||||||
|
Cairo.curveTo 10.328125 12.015625 11.246094 11.097656 11.246094 9.996094
|
||||||
|
Cairo.lineTo 11.246094 5.867188
|
||||||
|
Cairo.lineTo 9.640625 7.476563
|
||||||
|
Cairo.lineTo 9.640625 9.996094
|
||||||
|
Cairo.curveTo 9.640625 10.238281 9.46875 10.410156 9.226563 10.410156
|
||||||
|
Cairo.lineTo 2.015625 10.410156
|
||||||
|
Cairo.curveTo 1.769531 10.410156 1.597656 10.238281 1.597656 9.996094
|
||||||
|
Cairo.lineTo 1.597656 2.785156
|
||||||
|
Cairo.curveTo 1.597656 2.539063 1.769531 2.371094 2.015625 2.371094
|
||||||
|
Cairo.lineTo 9.226563 2.371094
|
||||||
|
Cairo.curveTo 9.277344 2.371094 9.324219 2.378906 9.367188 2.394531
|
||||||
|
Cairo.lineTo 10.511719 1.25
|
||||||
|
Cairo.curveTo 10.160156 0.957031 9.710938 0.769531 9.226563 0.769531
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
|
|
||||||
|
-- Tickmark
|
||||||
|
withRGBA tickColour Cairo.setSourceRGBA
|
||||||
|
Cairo.newPath
|
||||||
|
Cairo.moveTo 13.40625 0.0078125
|
||||||
|
Cairo.curveTo 13.191406 0.0390625 12.96875 0.144531 12.785156 0.328125
|
||||||
|
Cairo.lineTo 6.511719 6.605469
|
||||||
|
Cairo.lineTo 4.597656 4.691406
|
||||||
|
Cairo.curveTo 4.230469 4.328125 3.710938 4.257813 3.425781 4.542969
|
||||||
|
Cairo.lineTo 3.144531 4.820313
|
||||||
|
Cairo.curveTo 2.863281 5.105469 2.929688 5.628906 3.300781 5.992188
|
||||||
|
Cairo.lineTo 5.8125 8.5
|
||||||
|
Cairo.curveTo 5.925781 8.609375 6.046875 8.683594 6.175781 8.738281
|
||||||
|
Cairo.curveTo 6.261719 8.78125 6.332031 8.804688 6.417969 8.816406
|
||||||
|
Cairo.curveTo 6.425781 8.816406 6.429688 8.816406 6.445313 8.816406
|
||||||
|
Cairo.curveTo 6.53125 8.824219 6.605469 8.820313 6.6875 8.796875
|
||||||
|
Cairo.curveTo 6.71875 8.789063 6.746094 8.785156 6.773438 8.773438
|
||||||
|
Cairo.curveTo 6.929688 8.722656 7.085938 8.644531 7.21875 8.511719
|
||||||
|
Cairo.lineTo 14.097656 1.625
|
||||||
|
Cairo.curveTo 14.464844 1.261719 14.53125 0.738281 14.253906 0.453125
|
||||||
|
Cairo.lineTo 13.976563 0.179688
|
||||||
|
Cairo.curveTo 13.835938 0.0351563 13.632813 -0.0195313 13.421875 0.0078125
|
||||||
|
Cairo.closePath
|
||||||
|
Cairo.fillPreserve
|
||||||
31
src/app/MetaBrush/Asset/WindowIcons.hs
Normal file
31
src/app/MetaBrush/Asset/WindowIcons.hs
Normal file
|
|
@ -0,0 +1,31 @@
|
||||||
|
module MetaBrush.Asset.WindowIcons
|
||||||
|
( drawMinimise, drawRestoreDown, drawMaximise, drawClose )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- gi-cairo-render
|
||||||
|
import qualified GI.Cairo.Render as Cairo
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
--import MetaBrush.Render.Util
|
||||||
|
-- ( withRGBA )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Minimise window icon.
|
||||||
|
drawMinimise :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawMinimise iconColour = pure ()
|
||||||
|
|
||||||
|
-- | Restore down window icon.
|
||||||
|
drawRestoreDown :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawRestoreDown iconColour = pure ()
|
||||||
|
|
||||||
|
-- | Maximise window icon.
|
||||||
|
drawMaximise :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawMaximise iconColour = pure ()
|
||||||
|
|
||||||
|
-- | Close window icon.
|
||||||
|
drawClose :: GDK.RGBA -> Cairo.Render ()
|
||||||
|
drawClose iconColour = pure ()
|
||||||
12
src/app/MetaBrush/Document.hs
Normal file
12
src/app/MetaBrush/Document.hs
Normal file
|
|
@ -0,0 +1,12 @@
|
||||||
|
module MetaBrush.Document where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
data Document
|
||||||
|
= Document
|
||||||
|
{ displayName :: !Text
|
||||||
|
, filePath :: !(Maybe FilePath)
|
||||||
|
, unsavedChanges :: !Bool
|
||||||
|
, viewport :: !AABB
|
||||||
|
, strokes :: !(Set Stroke)
|
||||||
|
}
|
||||||
43
src/app/MetaBrush/Render/Util.hs
Normal file
43
src/app/MetaBrush/Render/Util.hs
Normal file
|
|
@ -0,0 +1,43 @@
|
||||||
|
module MetaBrush.Render.Util
|
||||||
|
( withRGBA, showRGBA
|
||||||
|
, widgetAddClasses, widgetAddClass )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import GHC.Stack
|
||||||
|
( HasCallStack )
|
||||||
|
|
||||||
|
-- gi-gdk
|
||||||
|
import qualified GI.Gdk as GDK
|
||||||
|
|
||||||
|
-- text
|
||||||
|
import Data.Text
|
||||||
|
( Text )
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
( pack )
|
||||||
|
|
||||||
|
-- transformers
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
( MonadIO(liftIO) )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
withRGBA :: MonadIO m => GDK.RGBA -> ( Double -> Double -> Double -> Double -> m b ) -> m b
|
||||||
|
withRGBA rgba f = do
|
||||||
|
r <- GDK.getRGBARed rgba
|
||||||
|
g <- GDK.getRGBAGreen rgba
|
||||||
|
b <- GDK.getRGBABlue rgba
|
||||||
|
a <- GDK.getRGBAAlpha rgba
|
||||||
|
f r g b a
|
||||||
|
|
||||||
|
showRGBA :: MonadIO m => GDK.RGBA -> m String
|
||||||
|
showRGBA rgba = withRGBA rgba \ r g b a ->
|
||||||
|
pure $ "rgba(" ++ show r ++ "," ++ show g ++ "," ++ show b ++ "," ++ show a ++ ")"
|
||||||
|
|
||||||
|
widgetAddClasses :: ( HasCallStack, GTK.IsWidget widget, MonadIO m ) => widget -> [Text] -> m ()
|
||||||
|
widgetAddClasses widget classNames = do
|
||||||
|
styleContext <- GTK.widgetGetStyleContext widget
|
||||||
|
for_ classNames ( GTK.styleContextAddClass styleContext )
|
||||||
|
|
||||||
|
widgetAddClass :: ( HasCallStack, GTK.IsWidget widget, MonadIO m ) => widget -> Text -> m ()
|
||||||
|
widgetAddClass widget className = GTK.widgetGetStyleContext widget >>= ( `GTK.styleContextAddClass` className )
|
||||||
11
src/app/MetaBrush/Stroke.hs
Normal file
11
src/app/MetaBrush/Stroke.hs
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
module MetaBrush.Stroke where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
data StrokePoint
|
||||||
|
= StrokePoint
|
||||||
|
{ center :: Point2D Double
|
||||||
|
,
|
||||||
|
|
||||||
|
newtype Stroke =
|
||||||
|
Stroke { strokePoints :: Seq (
|
||||||
68
src/lib/Math/Bezier/Cubic.hs
Normal file
68
src/lib/Math/Bezier/Cubic.hs
Normal file
|
|
@ -0,0 +1,68 @@
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
|
module Math.Bezier.Cubic
|
||||||
|
( Bezier(..)
|
||||||
|
, bezier, bezier'
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import GHC.Generics
|
||||||
|
( Generic )
|
||||||
|
|
||||||
|
-- acts
|
||||||
|
import Data.Act
|
||||||
|
( Act
|
||||||
|
( (•) )
|
||||||
|
, Torsor
|
||||||
|
( (-->) )
|
||||||
|
)
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import Math.Module
|
||||||
|
( Module (..)
|
||||||
|
, lerp
|
||||||
|
)
|
||||||
|
import qualified Math.Bezier.Quadratic as Quadratic
|
||||||
|
( Bezier(Bezier), bezier )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Points defining a cubic Bézier curve.
|
||||||
|
--
|
||||||
|
-- @ p0 @ and @ p3 @ are endpoints, whereas @ p1 @ and @ p2 @ are control points.
|
||||||
|
data Bezier p
|
||||||
|
= Bezier
|
||||||
|
{ p0 :: !p
|
||||||
|
, p1 :: !p
|
||||||
|
, p2 :: !p
|
||||||
|
, p3 :: !p
|
||||||
|
}
|
||||||
|
deriving stock ( Show, Generic, Functor, Foldable, Traversable )
|
||||||
|
|
||||||
|
instance Module r p => Module r ( Bezier p ) where
|
||||||
|
( Bezier p0 p1 p2 p3 ) ^+^ ( Bezier q0 q1 q2 q3 ) = Bezier ( p0 ^+^ q0 ) ( p1 ^+^ q1 ) ( p2 ^+^ q2 ) ( p3 ^+^ q3 )
|
||||||
|
r *^ bz = fmap ( r *^ ) bz
|
||||||
|
|
||||||
|
-- | Cubic Bézier curve.
|
||||||
|
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
||||||
|
bezier ( Bezier { .. } ) t =
|
||||||
|
lerp @v t
|
||||||
|
( Quadratic.bezier ( Quadratic.Bezier p0 p1 p2 ) t )
|
||||||
|
( Quadratic.bezier ( Quadratic.Bezier p1 p2 p3 ) t )
|
||||||
|
|
||||||
|
-- | Derivative of cubic Bézier curve.
|
||||||
|
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
||||||
|
bezier' ( Bezier { .. } ) t
|
||||||
|
= ( 3 *^ )
|
||||||
|
$ lerp @v t
|
||||||
|
( lerp @v t ( p0 --> p1 ) ( p1 --> p2 ) )
|
||||||
|
( lerp @v t ( p1 --> p2 ) ( p2 --> p3 ) )
|
||||||
58
src/lib/Math/Bezier/Quadratic.hs
Normal file
58
src/lib/Math/Bezier/Quadratic.hs
Normal file
|
|
@ -0,0 +1,58 @@
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
|
module Math.Bezier.Quadratic
|
||||||
|
( Bezier(..)
|
||||||
|
, bezier, bezier'
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import GHC.Generics
|
||||||
|
( Generic )
|
||||||
|
|
||||||
|
-- acts
|
||||||
|
import Data.Act
|
||||||
|
( Act
|
||||||
|
( (•) )
|
||||||
|
, Torsor
|
||||||
|
( (-->) )
|
||||||
|
)
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import Math.Module
|
||||||
|
( Module (..)
|
||||||
|
, lerp
|
||||||
|
)
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Points defining a quadratic Bézier curve.
|
||||||
|
--
|
||||||
|
-- @ p0 @ and @ p2 @ are endpoints, whereas @ p1 @ is a control point.
|
||||||
|
data Bezier p
|
||||||
|
= Bezier
|
||||||
|
{ p0 :: !p
|
||||||
|
, p1 :: !p
|
||||||
|
, p2 :: !p
|
||||||
|
}
|
||||||
|
deriving stock ( Show, Generic, Functor, Foldable, Traversable )
|
||||||
|
|
||||||
|
instance Module r p => Module r ( Bezier p ) where
|
||||||
|
( Bezier p0 p1 p2 ) ^+^ ( Bezier q0 q1 q2 ) = Bezier ( p0 ^+^ q0 ) ( p1 ^+^ q1 ) ( p2 ^+^ q2 )
|
||||||
|
r *^ bz = fmap ( r *^ ) bz
|
||||||
|
|
||||||
|
-- | Quadratic Bézier curve.
|
||||||
|
bezier :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> p
|
||||||
|
bezier ( Bezier { .. } ) t = lerp @v t ( lerp @v t p0 p1 ) ( lerp @v t p1 p2 )
|
||||||
|
|
||||||
|
-- | Derivative of quadratic Bézier curve.
|
||||||
|
bezier' :: forall v r p. ( Torsor v p, Module r v ) => Bezier p -> r -> v
|
||||||
|
bezier' ( Bezier { .. } ) t = 2 *^ lerp @v t ( p0 --> p1 ) ( p1 --> p2 )
|
||||||
3
src/lib/Math/Bezier/Stroke.hs
Normal file
3
src/lib/Math/Bezier/Stroke.hs
Normal file
|
|
@ -0,0 +1,3 @@
|
||||||
|
module Math.Bezier.Stroke where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
3
src/lib/Math/Bezier/Subdivision.hs
Normal file
3
src/lib/Math/Bezier/Subdivision.hs
Normal file
|
|
@ -0,0 +1,3 @@
|
||||||
|
module Math.Bezier.Subdivision where
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
41
src/lib/Math/Module.hs
Normal file
41
src/lib/Math/Module.hs
Normal file
|
|
@ -0,0 +1,41 @@
|
||||||
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
|
module Math.Module
|
||||||
|
( Module(..)
|
||||||
|
, lerp
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
-- acts
|
||||||
|
import Data.Act
|
||||||
|
( Torsor
|
||||||
|
( (-->) )
|
||||||
|
)
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
infixl 6 ^+^, ^-^
|
||||||
|
infix 8 ^*, *^
|
||||||
|
|
||||||
|
class Num r => Module r m where
|
||||||
|
|
||||||
|
{-# MINIMAL (^+^), ( (^*) | (*^) ) #-}
|
||||||
|
|
||||||
|
(^+^) :: m -> m -> m
|
||||||
|
(^-^) :: m -> m -> m
|
||||||
|
(*^) :: r -> m -> m
|
||||||
|
(^*) :: m -> r -> m
|
||||||
|
|
||||||
|
(*^) = flip (^*)
|
||||||
|
(^*) = flip (*^)
|
||||||
|
m ^-^ n = m ^+^ (-1) *^ n
|
||||||
|
|
||||||
|
instance Num a => Module a a where
|
||||||
|
(^+^) = (+)
|
||||||
|
(*^) = (*)
|
||||||
|
(^*) = (*)
|
||||||
|
|
||||||
|
lerp :: forall v r p. ( Module r v , Torsor v p ) => r -> p -> p -> p
|
||||||
|
lerp t p0 p1 = ( t *^ ( p0 --> p1 ) ) • p0
|
||||||
51
src/lib/Math/Vector2D.hs
Normal file
51
src/lib/Math/Vector2D.hs
Normal file
|
|
@ -0,0 +1,51 @@
|
||||||
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
|
{-# LANGUAGE DerivingVia #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
|
||||||
|
module Math.Vector2D
|
||||||
|
( Point2D(..), Vector2D(..) )
|
||||||
|
where
|
||||||
|
|
||||||
|
-- base
|
||||||
|
import GHC.Generics
|
||||||
|
( Generic )
|
||||||
|
|
||||||
|
-- acts
|
||||||
|
import Data.Act
|
||||||
|
( Act, Torsor )
|
||||||
|
|
||||||
|
-- generic-data
|
||||||
|
import Data.Generic
|
||||||
|
( GenericProduct(..) )
|
||||||
|
|
||||||
|
-- groups
|
||||||
|
import Data.Group
|
||||||
|
( Group ( invert ) )
|
||||||
|
|
||||||
|
-- MetaBrush
|
||||||
|
import Math.Module
|
||||||
|
( Module (..) )
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
data Point2D a = Point2D !a !a
|
||||||
|
deriving stock ( Show, Generic, Functor, Foldable, Traversable )
|
||||||
|
deriving ( Act ( Vector2D a ), Torsor ( Vector2D a ) )
|
||||||
|
via Vector2D a
|
||||||
|
|
||||||
|
newtype Vector2D a = Vector2D { tip :: Point2D a }
|
||||||
|
deriving stock Show
|
||||||
|
deriving ( Semigroup, Monoid, Group )
|
||||||
|
via GenericProduct ( Point2D ( Sum a ) )
|
||||||
|
deriving newtype ( Functor, Foldable, Traversable )
|
||||||
|
|
||||||
|
instance Num a => Module a ( Vector2D a ) where
|
||||||
|
(^+^) = (<>)
|
||||||
|
p ^-^ q = p <> invert q
|
||||||
|
|
||||||
|
c *^ p = fmap ( c * ) p
|
||||||
|
p ^* c = fmap ( * c ) p
|
||||||
Loading…
Reference in a new issue