you can draw ellilpse now

Author: minimapletinytools

TODO.txt

@@ -241,10 +241,11 @@ DONE-support label and text area
   -make BoxLabelHandler generic to shapes
   -make BoxTextHandler generic to shapes
   -finish ShapeModifyHandler when you do the above 2 thing
--connect fully and deprecate BoxLabel/TextHandler
+IGNORE-refactor ShapeDef please...
+DONE-connect fully and deprecate BoxLabel/TextHandler
   -you can still keep BoxHandler for now as it does multi-select for you
+-make ellipse drawer
 -add UTs
-IGNORE-refactor ShapeDef please...
 -make basic shape renderer that just fills all intersecting lines with fill character or whatever
 
 :: shape tool spec

src/Potato/Flow/Controller/Goat.hs

@@ -182,18 +182,22 @@ goatState_hasLocalPreview = owlPFWorkspace_hasLocalPreview . _goatState_workspac
 makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler
 makeHandlerFromNewTool GoatState{..} = \case
   Tool_Box    -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Box }
+  -- TODO this should just work, need to update UTs
+  --Tool_Box    -> SomePotatoHandler $ (def { _shapeCreationHandler_shapeType = ShapeType_Box } )
   Tool_Line   -> SomePotatoHandler $ def { _autoLineHandler_isCreation = True }
   Tool_Select -> makeHandlerFromSelection _goatState_canvasSelection
   Tool_Text   -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Text }
   Tool_TextArea -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_TextArea }
   Tool_Pan           -> SomePotatoHandler $ (def :: PanHandler)
-  Tool_Shape         -> SomePotatoHandler $ (def { _shapeCreationHandler_shapeType = ShapeType_Box } )
+  Tool_Shape         -> SomePotatoHandler $ (def { _shapeCreationHandler_shapeType = ShapeType_Ellipse } )
 
 
 -- TODO rename to makeHandlerFromCanvasSelection
 makeHandlerFromSelection :: CanvasSelection -> SomePotatoHandler
 makeHandlerFromSelection selection = case computeSelectionType selection of
   SMTBox         -> SomePotatoHandler $ (def :: BoxHandler)
+  -- TODO this should just work, need to update UTs
+  --SMTBox         -> SomePotatoHandler $ (def :: ShapeModifyHandler)
   SMTBoxText     -> SomePotatoHandler $ (def :: BoxHandler)
   SMTLine        -> SomePotatoHandler $ (def :: AutoLineHandler)
   SMTTextArea    -> SomePotatoHandler $ (def :: BoxHandler)

src/Potato/Flow/Controller/Manipulator/Box.hs

@@ -518,7 +518,7 @@ instance PotatoHandler BoxHandler where
 
 
 -- TODO move this to a more appropriate place
-data ShapeType = ShapeType_Unknown | ShapeType_Box deriving (Show, Eq)
+data ShapeType = ShapeType_Unknown | ShapeType_Box | ShapeType_Ellipse deriving (Show, Eq)
 
 
 
@@ -600,12 +600,14 @@ instance PotatoHandler ShapeCreationHandler where
 
       mdd = makeDragDeltaBox _shapeCreationHandler_handle rmd
 
-      shapeDef = case _shapeCreationHandler_shapeType of
-        ShapeType_Box -> boxShapeDef
+      someShapeDef = case _shapeCreationHandler_shapeType of
+        ShapeType_Box -> SomeShapeDef boxShapeDef
+        ShapeType_Ellipse -> SomeShapeDef ellipseShapeDef
         ShapeType_Unknown -> error "attempting to use ShapeCreationHandler with ShapeType_Unknown"
 
-      mop = Just $ makeAddEltLlama _potatoHandlerInput_pFState newEltPos $ 
-        shapeType_to_owlItem _potatoHandlerInput_potatoDefaultParameters (canonicalLBox_from_lBox $ LBox _mouseDrag_from dragDelta) shapeDef
+      mop = case someShapeDef of
+        SomeShapeDef shapeDef -> Just $ makeAddEltLlama _potatoHandlerInput_pFState newEltPos $ 
+          shapeType_to_owlItem _potatoHandlerInput_potatoDefaultParameters (canonicalLBox_from_lBox $ LBox _mouseDrag_from dragDelta) shapeDef
 
       newbh = bh {
           _shapeCreationHandler_undoFirst = True
@@ -686,6 +688,7 @@ shapeModifyHandlerFromSelection :: CanvasSelection -> ShapeModifyHandler
 shapeModifyHandlerFromSelection cs = r where 
   (shapeType, _) = case superOwl_toSElt_hack <$> selectionToMaybeFirstSuperOwl cs of
     Just (SEltBox sbox) -> (ShapeType_Box, _shapeDef_impl boxShapeDef sbox)
+    Just (SEltEllipse sellipse) -> (ShapeType_Ellipse, _shapeDef_impl ellipseShapeDef sellipse)
     _ -> (ShapeType_Unknown, emptyShapeImpl)
   r = def {
     _shapeModifyHandler_shapeType = shapeType
@@ -701,8 +704,11 @@ instance PotatoHandler ShapeModifyHandler where
   pHandlerName _ = handlerName_shapeModify
   pHandleMouse bh@ShapeModifyHandler {..} phi@PotatoHandlerInput {..} rmd@(RelMouseDrag MouseDrag {..}) = let
       selt = superOwl_toSElt_hack $ selectionToFirstSuperOwl _potatoHandlerInput_canvasSelection
+
+      -- TODO we should combine ShapeImpl with ShapeDef and add type param to ShapeModifyHandler so we don't have to do this weirdness
       (shapeDef, shapeImpl) = case (_shapeModifyHandler_shapeType, selt) of
         (ShapeType_Box, SEltBox sbox) -> (boxShapeDef, _shapeDef_impl boxShapeDef sbox)
+        (ShapeType_Ellipse, SEltEllipse sellipse) -> (boxShapeDef, _shapeDef_impl ellipseShapeDef sellipse)
         (x, y) -> error ("attempting to use ShapeModifyHandler with (" <> show x <> ", " <> show y <> ")")
 
     in case _mouseDrag_state of

src/Potato/Flow/Controller/Manipulator/Select.hs

@@ -45,6 +45,7 @@ doesOwlSubItemIntersectBox ot rcache lbox sowl = case superOwl_owlSubItem sowl o
       Just (OwlItemCache_Line lar _)  -> lar
       _ -> assert False (sSimpleLineNewRenderFnComputeCache ot sline)
     r = lineAnchorsForRender_doesIntersectBox anchors lbox
+  OwlSubItemEllipse x -> does_lBox_intersect_include_zero_area lbox (_sEllipse_box x)
   _ -> False
 
 

src/Potato/Flow/Methods/SEltMethods.hs

@@ -58,6 +58,8 @@ doesSEltIntersectBox_DEPRECATED lbox selt = case selt of
   SEltFolderEnd                -> False
   SEltBox x                    -> does_lBox_intersect_include_zero_area lbox (_sBox_box x)
   SEltTextArea x                   -> does_lBox_intersect_include_zero_area lbox (_sTextArea_box x)
+  -- TODO you could use the isInEllipse function here instead
+  SEltEllipse x                -> does_lBox_intersect_include_zero_area lbox (_sEllipse_box x)
   -- TODO this is wrong, do it correctly...
   -- we use does_lBox_intersect since it's impossible for a SAutoLine to have zero sized box
   SEltLine sline -> does_lBox_intersect lbox (fromJust $ getSEltBox_naive (SEltLine sline))
@@ -207,9 +209,18 @@ sEllipse_drawer sellipse = SEltDrawer {
   , _sEltDrawer_maxCharWidth = 1
 }
 
--- TODO proper rendering
+isInEllipse :: LBox -> XY -> Bool
+isInEllipse (LBox (V2 x y) (V2 w h)) (V2 px py) = isInEllipse (px, py)
+  where
+    (width, height) = (w, h)
+    centerX = x + w `div` 2
+    centerY = y + h `div` 2
+    a = fromIntegral w / 2
+    b = fromIntegral h / 2
+    isInEllipse (i, j) = ((fromIntegral (i - centerX) / a) ^ 2 + (fromIntegral (j - centerY) / b) ^ 2) <= 1
+
 sEllipse_renderFn :: forall a. (HasOwlTree a) => SEllipse -> a -> XY -> Maybe PChar
-sEllipse_renderFn sellipse ot (V2 x y) = if does_lBox_contains_XY (_sEllipse_box sellipse) (V2 x y)
+sEllipse_renderFn sellipse ot (V2 x y) = if isInEllipse (_sEllipse_box sellipse) (V2 x y)
   then Just '#'
   else Nothing
 
@@ -283,6 +294,9 @@ modify_sElt_with_cBoundingBox isDo selt cbb@CBoundingBox {..} = case selt of
   SEltTextArea stext -> SEltTextArea $ stext {
       _sTextArea_box     = modifyDelta isDo (_sTextArea_box stext) _cBoundingBox_deltaBox
     }
+  SEltEllipse sellipse -> SEltEllipse $ sellipse {
+      _sEllipse_box = modifyDelta isDo (_sEllipse_box sellipse) _cBoundingBox_deltaBox
+    }
   x          -> x
 
 modify_sElt_with_cSuperStyle :: Bool -> SElt -> CSuperStyle -> SElt

src/Potato/Flow/Methods/Shape.hs

@@ -19,7 +19,9 @@ import Data.Default
 import qualified Text.Show
 
 
--- TODO probably just combine this with ShapeImpl and make ShapeModifyHandler take an `o` parameter
+data SomeShapeDef = forall o. () => SomeShapeDef (ShapeDef o)
+
+-- TODO probably just combine this with ShapeImpl
 data ShapeDef o = ShapeDef {
   _shapeDef_name :: Text
   , _shapeDef_create :: PotatoDefaultParameters -> LBox -> OwlItem
@@ -29,11 +31,6 @@ data ShapeDef o = ShapeDef {
   , _shapeDef_textImpl :: TextImpl o
 }
 
-
-
-
-
-
 data ShapeImpl = ShapeImpl {
   _shapeImpl_updateFromLBox :: REltId -> LBox -> Llama
   , _shapeImpl_toLBox :: LBox

src/Potato/Flow/Methods/Types.hs

@@ -83,6 +83,7 @@ getSEltBox_naive selt = case selt of
     r = make_lBox_from_XYlist $ (_sAutoLine_start x) : (_sAutoLine_end x) : (_sAutoLine_start x + 1) : (_sAutoLine_end x + 1) : midpoints
 
   SEltTextArea x      -> Just $ canonicalLBox_from_lBox_ $ _sTextArea_box x
+  SEltEllipse x -> Just $ canonicalLBox_from_lBox_ $ _sEllipse_box x
 
 getSEltLabelBox :: SEltLabel -> Maybe LBox
 getSEltLabelBox (SEltLabel _ x) = getSEltBox_naive x

test/Potato/Flow/Controller/Manipulator/ShapeSpec.hs

@@ -28,8 +28,8 @@ drawShape (x, y, sx, sy) = do
   canvasMouseUp (x+sx, y+sy)
   let
     f sowl = case _superOwl_elt sowl of
-      OwlItem _ (OwlSubItemBox _) -> Nothing
-      xx                           -> Just ("expected box, got " <> show xx)
+      OwlItem _ (OwlSubItemEllipse _) -> Nothing
+      xx                           -> Just ("expected ellipse, got " <> show xx)
   verifySelectionIsAndOnlyIs "shape is selected" f
 
 basic_test :: Spec