Skip to content

Fix normalization of point shapes #118

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
patritzenfeld merged 2 commits into from
Jun 16, 2026
Merged

Fix normalization of point shapes #118

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
765fbda
fix closed to open rewrite of curves and polygons
patritzenfeld Jun 16, 2026
c6ebbef
task config adjustments
patritzenfeld Jun 16, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 3 additions & 2 deletions examples/configs/Task11.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -288,7 +288,7 @@ test =
oneOf (\p -> hasRelation (p `isLeftOf` p)) eggChoices <||>
oneOf (\p -> hasRelation (p `isRightOf` p)) eggChoices
complain "Eggs are above the grass?" $
oneOf (\p -> hasRelation (p `isAbove` grass)) (take 3 eggChoices) <||>
oneOf (\p -> hasRelation (p `isAbove` grass)) eggChoices <||>
hasRelation (polyEggThick `atSamePosition` grass)

complain "Cannot detect movement. Make sure you are not ignoring parameter 't'."
Expand Down Expand Up @@ -369,7 +369,8 @@ test =
fromMaybe 0 (getExactCircleRadius normalized)
, x == 0
, isEgg normalized
, abs (y - eggSize) <= eggSize*0.5
, abs (y - eggSize) <= eggSize*0.5 ||
any (normalized `contains`) curveEggs
]


Expand Down
8 changes: 4 additions & 4 deletions src/CodeWorld/Test/AbstractHelpers.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -158,15 +158,15 @@ largerY = reNormalize $ scaled 1 2
Draw an abstract, open curve with this many segments.
-}
someCurve :: Int -> AbstractPicture
someCurve points = normalizeAndAbstract $
curve $ take (points+1) $ iterate (both (+0.1)) (1,0)
someCurve segments = normalizeAndAbstract $
curve $ take (segments+1) $ iterate (both (+0.1)) (1,0)

{- |
Draw an abstract, filled in and closed curve with this many segments.
-}
someSolidCurve :: Int -> AbstractPicture
someSolidCurve points = normalizeAndAbstract $
solidClosedCurve $ take (points+1) $ iterate (both (+0.1)) (1,0)
someSolidCurve segments = normalizeAndAbstract $
solidClosedCurve $ take segments $ iterate (both (+0.1)) (1,0)

{- |
Compose two abstract pictures.
Expand Down
12 changes: 8 additions & 4 deletions src/CodeWorld/Test/Rewrite.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module CodeWorld.Test.Rewrite (

import Data.Fixed (mod')
import Data.Generics.Uniplate.Data (rewrite)
import Data.List.Extra (sort, takeEnd)
import Data.List.Extra (sort, takeEnd, dropEnd)

import CodeWorld.Tasks.Color (black)
import CodeWorld.Tasks.VectorSpace (
Expand Down Expand Up @@ -84,10 +84,12 @@ rewriting (AnyRectangle s l w) = toWideRectangle s l w
rewriting (AnyArc s a1 a2 r) = checkArc s a1 a2 r

rewriting (AnyPolyline (Closed (Outline mOutline)) ps) = AnyPolyline (Open mOutline) $ toOpenShape ps
rewriting (AnyPolyline s (removeSurplus -> ps)) = checkForRectangle s $ toOpenShape ps
rewriting (AnyPolyline s (removeSurplus -> ps)) = checkForRectangle s $ case s of
Closed Solid -> toOpenShape ps
Open _ -> ps

rewriting (AnyCurve (Closed (Outline mOutline)) ps) = AnyCurve (Open mOutline) $ toOpenShape ps
rewriting (AnyCurve s ps) = handlePointList (AnyCurve s) $ toOpenShape ps
rewriting (AnyCurve s ps) = handlePointList (AnyCurve s) ps

rewriting (Lettering "") = Blank
rewriting (StyledLettering _ _ "") = Blank
Expand Down Expand Up @@ -261,7 +263,9 @@ handleLikeFreeShapes s1 ps1 ps2

checkForRectangle :: Shape -> [Point] -> Picture
checkForRectangle shape ps = case pointsToRectangle shape ps of
Nothing -> handlePointList (AnyPolyline shape) ps
Nothing -> handlePointList (AnyPolyline shape) $ case shape of
Closed Solid -> dropEnd 1 ps
_ -> ps
Just r -> r

pointsToRectangle :: Shape -> [Point] -> Maybe Picture
Expand Down
Loading