content: module Note where
  import Rumpus
  
  colorOn = colorHSL 0.1 0.8 0.8
  colorOff = colorHSL 0.1 0.8 0.2
  
  noteBase :: Num a => a
  noteBase = 48
  notesPerMeter :: Num a => a
  notesPerMeter = 24
  
  start :: Start
  start = do
      setBody Animated
      setSize (V3 (1/4) (1/24) (1/4))
  
      setState (0::Int)
  
      let noteHue note = fromIntegral note / notesPerMeter
  
      let updateNote play = editState $ \currentNote -> do
              position <- getPosition
              let height = position ^. _y
                  note = floor (height * notesPerMeter + noteBase) :: Int
  
              when (play && note /= currentNote) $ do
                  setColor (colorHSL (noteHue note) 0.8 0.5)
                  acquirePolyPatch "Note.pd"
                  sendSynth "note" (fromIntegral note)
                  sendSynth "trigger" 1
              return note
  
  
      updateNote False
  
      myCollisionBegan ==> \hitEntityID _ -> do
          shape <- getEntityComponentDefault Cube hitEntityID myShape
          when (shape /= Sphere) $ do
  --            spawnBall
              note <- getState (0::Int)
              acquirePolyPatch "Note.pd"
              sendSynth "note" (fromIntegral note)
              sendSynth "trigger" 1
  
  
              let hue = noteHue note
                  fromColor = colorHSL (hue + 0.5) 0.8 0.5
                  toColor   = colorHSL hue         0.8 0.5
              animateColor fromColor toColor 0.2
  
      myDragContinues ==> \_ -> updateNote True
  
      -- Quantize note position on release
      myDragEnded ==> do
          V3 x y z <- getPosition
          let quantPos = V3
                  (quantizeToF (1/8) x)
                  (quantizeToF (1/24) y)
                  (quantizeToF (1/8) z)
          animatePositionTo quantPos 0.3
  
          V3 x y z <- getRotationEuler
          let quantRot = eulerToQuat $ V3
                  (quantizeToF (pi/4) x)
                  (quantizeToF (pi/4) y)
                  (quantizeToF (pi/4) z)
          animateRotationTo quantRot 0.3
          -- Save quantized position
          setDelayedAction 0.3 (sceneWatcherSaveEntity =<< ask)
  
      myCodeHidden ==> True
  
  
  
  spawnBall :: EntityMonad ()
  spawnBall = do
      noteColor <- getColor
      notePosition <- getPosition
      spawnChild_ $ do
          myLifetime ==> 3
          myShape    ==> Sphere
          mySize     ==> 0.1
          myBody     ==> Physical
          myColor    ==> noteColor
          myPose     ==> position (notePosition + (V3 0 (-0.05) 0))