mirror of
https://gitlab.com/sheaf/metabrush.git
synced 2024-11-05 14:53:37 +00:00
refactor ruler subdivision handling
This commit is contained in:
sheaf
parent
07c789ccc3
commit
dc6602bb79
|
|
@ -55,6 +55,7 @@ common common
|
|||
-fwarn-incomplete-uni-patterns
|
||||
-fwarn-missing-deriving-strategies
|
||||
-fno-warn-unticked-promoted-constructors
|
||||
-fno-show-valid-hole-fits
|
||||
|
||||
library
|
||||
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NegativeLiterals #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module MetaBrush.Render.Rulers
|
||||
|
|
@ -11,6 +12,8 @@ module MetaBrush.Render.Rulers
|
|||
where
|
||||
|
||||
-- base
|
||||
import Control.Arrow
|
||||
( first )
|
||||
import Control.Monad
|
||||
( when )
|
||||
import Data.Fixed
|
||||
|
|
@ -19,6 +22,10 @@ import Data.Foldable
|
|||
( for_, traverse_, toList )
|
||||
import Data.Int
|
||||
( Int32 )
|
||||
import Data.List.NonEmpty
|
||||
( NonEmpty(..) )
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
( reverse )
|
||||
|
||||
-- acts
|
||||
import Data.Act
|
||||
|
|
@ -175,53 +182,54 @@ renderRuler
|
|||
renderTicks :: Cairo.Render ()
|
||||
renderTicks = case actionOrigin of
|
||||
ViewportOrigin -> pure ()
|
||||
RulerOrigin ruler -> case ruler of
|
||||
RulerOrigin ruler ->
|
||||
let
|
||||
smallSpacing, bigSpacing :: Double
|
||||
subdivs, displayedSubdivs :: [ Int ]
|
||||
( bigSpacing, subdivs ) = tickSpacing ( 60 / zoomFactor )
|
||||
smallSpacing = bigSpacing / fromIntegral ( product displayedSubdivs )
|
||||
displayedSubdivs = dropTightTicks subdivs
|
||||
dropTightTicks :: [ Int ] -> [ Int ]
|
||||
dropTightTicks = go 1
|
||||
where
|
||||
go :: Double -> [Int] -> [Int]
|
||||
go _ [] = []
|
||||
go s ( x : xs )
|
||||
| s' > threshold
|
||||
= []
|
||||
| otherwise
|
||||
= x : go s' xs
|
||||
where
|
||||
s', threshold :: Double
|
||||
s' = s * fromIntegral x
|
||||
threshold = 0.25 * bigSpacing * zoomFactor
|
||||
increasingSubdivs :: NonEmpty ( Int, ( Double, Bool ) )
|
||||
increasingSubdivs = NonEmpty.reverse $ ( 1, ( 15, True ) ) :| zip displayedSubdivs [ ( 8, False ), ( 6, False ), ( 4, False ) ]
|
||||
in case ruler of
|
||||
RulerCorner -> pure ()
|
||||
TopRuler -> do
|
||||
let
|
||||
spacing, subdivs, subsubdivs, start :: Double
|
||||
( spacing, subdivs, subsubdivs ) = tickSpacing ( 60 / zoomFactor )
|
||||
start = truncateWith spacing left
|
||||
start :: Double
|
||||
start = truncateWith bigSpacing left
|
||||
setTickRenderContext
|
||||
traverse_ renderTickV
|
||||
traverse_ renderTickV $
|
||||
[ Tick { .. }
|
||||
| i <- [ 0, 1 .. 1 + ( right - left ) / spacing ]
|
||||
, j <- [ 0, 1 .. subdivs - 1 ]
|
||||
, k <- if spacing / ( subdivs * subsubdivs ) < 4 / zoomFactor
|
||||
then [ 0 ]
|
||||
else [ 0, 1 .. subsubdivs - 1 ]
|
||||
| ( i :: Int ) <- [ 0, 1 .. ceiling ( ( right - start ) / smallSpacing ) ]
|
||||
, let
|
||||
tickPosition = start + spacing * ( i + ( j + k / subsubdivs ) / subdivs )
|
||||
, let tickSize
|
||||
| j == 0 && k == 0 = 12
|
||||
| k == 0 = 6
|
||||
| otherwise = 3
|
||||
, let tickHasLabel
|
||||
| j == 0 && k == 0 = True
|
||||
| otherwise = False
|
||||
( tickSize, tickHasLabel ) = subdivAt i increasingSubdivs
|
||||
tickPosition = start + fromIntegral i * smallSpacing
|
||||
]
|
||||
LeftRuler -> do
|
||||
let
|
||||
spacing, subdivs, subsubdivs, start :: Double
|
||||
( spacing, subdivs, subsubdivs ) = tickSpacing ( 60 / zoomFactor )
|
||||
start = truncateWith spacing top
|
||||
start :: Double
|
||||
start = truncateWith bigSpacing top
|
||||
setTickRenderContext
|
||||
traverse_ renderTickH
|
||||
traverse_ renderTickH $
|
||||
[ Tick { .. }
|
||||
| i <- [ 0, 1 .. 1 + ( bottom - top ) / spacing ]
|
||||
, j <- [ 0, 1 .. subdivs - 1 ]
|
||||
, k <- if spacing / ( subdivs * subsubdivs ) < 4 / zoomFactor
|
||||
then [ 0 ]
|
||||
else [ 0, 1 .. subsubdivs - 1 ]
|
||||
| ( i :: Int ) <- [ 0, 1 .. ceiling ( ( bottom - start ) / smallSpacing ) ]
|
||||
, let
|
||||
tickPosition = start + spacing * ( i + ( j + k / subsubdivs ) / subdivs )
|
||||
, let tickSize
|
||||
| j == 0 && k == 0 = 12
|
||||
| k == 0 = 6
|
||||
| otherwise = 3
|
||||
, let tickHasLabel
|
||||
| j == 0 && k == 0 = True
|
||||
| otherwise = False
|
||||
( tickSize, tickHasLabel ) = subdivAt i increasingSubdivs
|
||||
tickPosition = start + fromIntegral i * smallSpacing
|
||||
]
|
||||
|
||||
renderTickV, renderTickH :: Tick -> Cairo.Render ()
|
||||
|
|
@ -278,14 +286,23 @@ renderGuide ( Colours {..} ) zoom ( Guide { guidePoint = Point2D x y, guideNorma
|
|||
|
||||
Cairo.restore
|
||||
|
||||
tickSpacing :: Double -> ( Double, Double, Double )
|
||||
tickSpacing :: Double -> ( Double, [ Int ] )
|
||||
tickSpacing d
|
||||
| d <= 1 = ( 1, 4, 5 )
|
||||
| d <= 2 = ( 2, 2, 10 )
|
||||
| d <= 5 = ( 5, 5, 4 )
|
||||
| d <= 1 = ( 1, cycle [ 2, 5 ] )
|
||||
| d <= 2 = ( 2, 2 : cycle [ 2, 5 ] )
|
||||
| d <= 5 = ( 5, cycle [ 5, 2 ] )
|
||||
| otherwise
|
||||
= case tickSpacing ( 0.1 * d ) of
|
||||
( sp, sub, subsub ) -> ( 10 * sp, sub, subsub )
|
||||
= first ( 10 * ) $ tickSpacing ( 0.1 * d )
|
||||
|
||||
subdivAt :: Int -> NonEmpty ( Int, d ) -> d
|
||||
subdivAt _ ( ( _, d ) :| [] ) = d
|
||||
subdivAt i ( ( t, d ) :| ( nxt : nxts ) )
|
||||
| r == 0
|
||||
= subdivAt q ( nxt :| nxts )
|
||||
| otherwise
|
||||
= d
|
||||
where
|
||||
( q, r ) = i `divMod` t
|
||||
|
||||
truncateWith :: Double -> Double -> Double
|
||||
truncateWith m x = x - ( x `mod'` m )
|
||||
|
|
|
|||
Loading…
Reference in a new issue