Skip to content

Commit

Permalink
Fix Test build
Browse files Browse the repository at this point in the history
  • Loading branch information
fjvallarino committed Jul 30, 2020
1 parent b2dc945 commit c4a7a1a
Show file tree
Hide file tree
Showing 8 changed files with 45 additions and 62 deletions.
2 changes: 1 addition & 1 deletion app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ main = do
SDL.windowInitialSize = SDL.V2 screenWidth screenHeight,
SDL.windowHighDPI = windowHiDPI,
SDL.windowResizable = True,
SDL.windowOpenGL = Just customOpenGL
SDL.windowGraphicsContext = SDL.OpenGLContext customOpenGL
}

err <- SRE.getError
Expand Down
38 changes: 24 additions & 14 deletions src/Monomer/Widget/Widgets/Scroll.hs
Original file line number Diff line number Diff line change
Expand Up @@ -321,20 +321,30 @@ scrollStatus config wenv scrollState viewport = ScrollContext{..} where
vScrollRatio = min (vpHeight / childHeight) 1
hScrollRequired = hScrollRatio < 1
vScrollRequired = vScrollRatio < 1
hScrollRect =
Rect vpLeft (vpTop + hScrollTop) (vpLeft + vpWidth) (vpTop + vpHeight)
vScrollRect =
Rect (vpLeft + vScrollLeft) vpTop (vpLeft + vpWidth) (vpTop + vpHeight)
hThumbRect = Rect
(vpLeft - hScrollRatio * dx)
(vpTop + hScrollTop)
(hScrollRatio * vpWidth)
barThickness
vThumbRect = Rect
(vpLeft + vScrollLeft)
(vpTop - vScrollRatio * dy)
barThickness
(vScrollRatio * vpHeight)
hScrollRect = Rect {
_rx = vpLeft,
_ry = vpTop + hScrollTop,
_rw = vpLeft + vpWidth,
_rh = vpTop + vpHeight
}
vScrollRect = Rect {
_rx = vpLeft + vScrollLeft,
_ry = vpTop,
_rw = vpLeft + vpWidth,
_rh = vpTop + vpHeight
}
hThumbRect = Rect {
_rx = vpLeft - hScrollRatio * dx,
_ry = vpTop + hScrollTop,
_rw = hScrollRatio * vpWidth,
_rh = barThickness
}
vThumbRect = Rect {
_rx = vpLeft + vScrollLeft,
_ry = vpTop - vScrollRatio * dy,
_rw = barThickness,
_rh = vScrollRatio * vpHeight
}
hMouseInScroll = pointInRect mousePos hScrollRect
vMouseInScroll = pointInRect mousePos vScrollRect
hMouseInThumb = pointInRect mousePos hThumbRect
Expand Down
6 changes: 1 addition & 5 deletions stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -40,12 +40,8 @@ packages:
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps:
- hedgehog-1.0
- hedgehog-classes-0.2.1
- hedgehog-classes-0.2.5
- nanovg-0.6.0.0
- StateVar-1.1.1.1@sha256:cd3b516a49faf0627ea31885e012611e63600824976dcb276bcb2e92cdb0790f,1417
- git: https://github.com/haskell-game/sdl2
commit: 647c5611e23ad2822e974d9868faa481059258ca

# Override default flag values for local packages and extra-deps
# flags: {}
Expand Down
36 changes: 4 additions & 32 deletions stack.yaml.lock
Original file line number Diff line number Diff line change
Expand Up @@ -5,47 +5,19 @@

packages:
- completed:
hackage: hedgehog-1.0@sha256:440dafedac48a34eac3871f8622b215462cfc0708536cb0458b7a8cf38247c69,4463
hackage: hedgehog-classes-0.2.5@sha256:a37e4af8b8ddb3e92120d0a5ddd892f669fe75fc13dcfd9723850574530d1f2b,5723
pantry-tree:
size: 2409
sha256: 985f5ddc16bc1fd4b0c33d4b4e6f54d205fc63aa97b5912b0fcb370dc2a672e3
size: 5192
sha256: 965b5001ec24cddf85cf72f15ab99d335d0b19c0c8515f8b09fdc8b8d68c89b4
original:
hackage: hedgehog-1.0
- completed:
hackage: hedgehog-classes-0.2.1@sha256:17efa4f03e2de7936c119266d8b3710b167b2615a3455b45461c2dfa23b82fb6,5351
pantry-tree:
size: 4974
sha256: 625a4d7494774e9d1f58420c3520dc652d36798c97d7018763435e42fb8908e8
original:
hackage: hedgehog-classes-0.2.1
hackage: hedgehog-classes-0.2.5
- completed:
hackage: nanovg-0.6.0.0@sha256:326e73fe2c4ec56656fa42894c53a8e26b3e60449c69578f5f6da50c0ad60ed2,4146
pantry-tree:
size: 2477
sha256: a5e327e2216aea778723aeb77d8868376ff4999d1b3cd4d4fe17d38d0ff04265
original:
hackage: nanovg-0.6.0.0
- completed:
hackage: StateVar-1.1.1.1@sha256:cd3b516a49faf0627ea31885e012611e63600824976dcb276bcb2e92cdb0790f,1417
pantry-tree:
size: 314
sha256: d2b673886d4d8866aecb9b7f32ec6719fa9a8f8d2ccccea059edc3c45db4e1f0
original:
hackage: StateVar-1.1.1.1@sha256:cd3b516a49faf0627ea31885e012611e63600824976dcb276bcb2e92cdb0790f,1417
- completed:
cabal-file:
size: 11219
sha256: 036f43db9e3ac46d9c9b96b58b1b26defc6b39674633ff05886cb2159135520f
name: sdl2
version: 2.4.0.1
git: https://github.com/haskell-game/sdl2
pantry-tree:
size: 6949
sha256: d6ac403f4c9bf8622d1d2bb36276010c25bcb0a6f21db33f96f01af1d6ab6f7b
commit: 647c5611e23ad2822e974d9868faa481059258ca
original:
git: https://github.com/haskell-game/sdl2
commit: 647c5611e23ad2822e974d9868faa481059258ca
snapshots:
- completed:
size: 524996
Expand Down
4 changes: 3 additions & 1 deletion tasks.md
Original file line number Diff line number Diff line change
Expand Up @@ -129,9 +129,9 @@
- Move currentPath into WidgetInstance
- Move focusedPath and targetPath to WidgetEnv
- Visible and enabled would get updated on init/merge
- Format code!

- Pending
- Format code!
- Add testing
- Delayed until this point to try to settle down interfaces
- Validate stack assigns space correctly
Expand All @@ -152,6 +152,8 @@
- Find non visible character that returns correct height if input is empty
- Request text input when text field gets focus (required for mobile)
- Also set TextInputRect
- Use newtypes whenever possible
- Compare Cairo/Skia interfaces to make Renderer able to handle future implementations
- Create Layer widget
- Create Dialog
- Make sure that focus change requests do not leave overlay if active (most likely an if clause is needed in handleFocusChange)
Expand Down
File renamed without changes.
Original file line number Diff line number Diff line change
Expand Up @@ -8,33 +8,36 @@ import TestUtils
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import Monomer.Core
import Monomer.Widget.Style
import Monomer.Common.Style
import Monomer.Graphics.Types

spec :: Spec
spec = describe "Style" $ do
it "should do nothing, again" $ do
it "should do nothing, again" $
1 `shouldBe` 1

it "should have require function that checks hedgehog properties" $ do
it "should have require function that checks hedgehog properties" $
require $ property $ do
x <- forAll (Gen.int Range.constantBounded)
x === x

it "should check BorderSide fulfills Semigroup laws" $ do
it "should check BorderSide fulfills Semigroup laws" $
1 `shouldBe` 1

it "should check Padding fulfills Semigroup laws" $ do
it "should check Padding fulfills Semigroup laws" $
checkLaws genPadding [monoidLaws]

genInt :: Gen Int
genInt = Gen.int (Range.linear (-10000) 10000)

genDouble :: Gen Double
genDouble = Gen.double (Range.linearFrac (-10000) 10000)

genMDouble :: Gen (Maybe Double)
genMDouble = Gen.maybe $ genDouble
genMDouble = Gen.maybe genDouble

genRGB :: Gen Color
genRGB = RGB <$> genDouble <*> genDouble <*> genDouble
genRGB = Color <$> genInt <*> genInt <*> genInt <*> pure 1

genBorderSide :: Gen BorderSide
genBorderSide = BorderSide <$> genDouble <*> genRGB
Expand Down
2 changes: 1 addition & 1 deletion watch-tests.sh
Original file line number Diff line number Diff line change
@@ -1 +1 @@
ghcid --command "stack ghci hs-music:lib hs-music:test:hs-music-test --ghci-options=-fobject-code"
ghcid --command "stack ghci monomer:lib monomer:test:monomer-test --ghci-options=-fobject-code"

0 comments on commit c4a7a1a

Please sign in to comment.