<commit_before>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module Rumpus.Systems.Hands where
import Rumpus.Systems.Controls
import Rumpus.Systems.Physics
import Rumpus.Systems.Collisions
import Rumpus.Systems.Shared
import PreludeExtra
data HandsSystem = HandsSystem 
    { _hndLeftHand  :: EntityID
    , _hndRightHand :: EntityID
    , _hndBeams :: Map WhichHand EntityID
    --, _hndHead      :: EntityID
    } deriving Show
makeLenses ''HandsSystem

defineSystemKey ''HandsSystem

startHandsSystem :: (MonadState ECS m, MonadIO m) => m ()
startHandsSystem = do
    let handColor = V4 0.6 0.6 0.9 1

    leftHandID <- spawnEntity $ do
        myColor             ==> handColor
        mySize              ==> V3 0.1 0.1 0.3
        myShape         ==> Cube
        myProperties ==> [Floating, Ghostly, Static]
        myMass              ==> 0
        myCollisionStart  ==> \_ impulse -> do
            hapticPulse LeftHand (floor $ impulse * 10000)
    rightHandID <- spawnEntity $ do
        myColor             ==> handColor
        mySize              ==> V3 0.1 0.1 0.3
        myShape         ==> Cube
        myProperties ==> [Floating, Ghostly, Static]
        myMass              ==> 0
        myCollisionStart  ==> \_ impulse -> 
            hapticPulse RightHand (floor $ impulse * 10000)
    registerSystem sysHands $ HandsSystem
            { _hndLeftHand  = leftHandID
            , _hndRightHand = rightHandID
            , _hndBeams = mempty
            }

    return ()

beginBeam :: (MonadState ECS m, MonadIO m) => WhichHand -> m ()
beginBeam whichHand = do

    beamID <- spawnEntity $ do
        myShape      ==> Cube
        myProperties ==> [NoPhysicsShape]

    modifySystemState sysHands $ hndBeams . at whichHand ?= beamID
    updateBeam whichHand
            
updateBeam :: (MonadState ECS m, MonadIO m) => WhichHand -> m ()
updateBeam whichHand = traverseM_ (viewSystem sysHands (hndBeams . at whichHand)) $ \beamID -> do
    handID <- getHandID whichHand
    handPose <- getEntityPose handID

    let handRay = poseToRay (poseFromMatrix handPose) (V3 0 0 (-1)) :: Ray GLfloat

    mRayResult <- castRay handRay
    forM_ mRayResult $ \RayResult{..} -> do
        entityID <- unCollisionObjectID <$> getCollisionObjectID rrCollisionObject
        teleportable <- getIsTeleportable entityID


        let handLocation = handPose ^. translation 
            rayLength = distance handLocation rrLocation
            rayCenter = handLocation + (handLocation - rrLocation) / 2

        -- Update ray's postition/size
        runEntity beamID $ do
            setPose (handPose & translation .~ rayCenter)
            setSize (V3 0.5 0.5 rayLength)
            setColor $ if teleportable then V4 0 1 0 1 else V4 0.2 0.2 0.2 1
        when teleportable $ do
            hapticPulse whichHand 1000

endBeam :: (MonadIO m, MonadState ECS m) => WhichHand -> m ()
endBeam whichHand = traverseM_ (viewSystem sysHands (hndBeams . at whichHand)) $ \beamID -> do
    removeEntity beamID
    modifySystemState sysHands $ hndBeams . at whichHand .= Nothing

    handID <- getHandID whichHand
    handPose <- getEntityPose handID<commit_msg>Teleport ray fixes<commit_after>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
module Rumpus.Systems.Hands where
import Rumpus.Systems.Controls
import Rumpus.Systems.Physics
import Rumpus.Systems.Collisions
import Rumpus.Systems.Shared
import PreludeExtra
data HandsSystem = HandsSystem 
    { _hndLeftHand  :: EntityID
    , _hndRightHand :: EntityID
    , _hndBeams :: Map WhichHand EntityID
    --, _hndHead      :: EntityID
    } deriving Show
makeLenses ''HandsSystem

defineSystemKey ''HandsSystem

startHandsSystem :: (MonadState ECS m, MonadIO m) => m ()
startHandsSystem = do
    let handColor = V4 0.6 0.6 0.9 1

    leftHandID <- spawnEntity $ do
        myColor             ==> handColor
        mySize              ==> V3 0.1 0.1 0.3
        myShape         ==> Cube
        myProperties ==> [Floating, Ghostly, Static]
        myMass              ==> 0
        myCollisionStart  ==> \_ impulse -> do
            hapticPulse LeftHand (floor $ impulse * 10000)
    rightHandID <- spawnEntity $ do
        myColor             ==> handColor
        mySize              ==> V3 0.1 0.1 0.3
        myShape         ==> Cube
        myProperties ==> [Floating, Ghostly, Static]
        myMass              ==> 0
        myCollisionStart  ==> \_ impulse -> 
            hapticPulse RightHand (floor $ impulse * 10000)
    registerSystem sysHands $ HandsSystem
            { _hndLeftHand  = leftHandID
            , _hndRightHand = rightHandID
            , _hndBeams = mempty
            }

    return ()

beginBeam :: (MonadState ECS m, MonadIO m) => WhichHand -> m ()
beginBeam whichHand = do

    beamID <- spawnEntity $ do
        myShape      ==> Cube
        myProperties ==> [NoPhysicsShape]

    modifySystemState sysHands $ hndBeams . at whichHand ?= beamID
    updateBeam whichHand
            
updateBeam :: (MonadState ECS m, MonadIO m) => WhichHand -> m ()
updateBeam whichHand = traverseM_ (viewSystem sysHands (hndBeams . at whichHand)) $ \beamID -> do
    handID <- getHandID whichHand
    handPose <- getEntityPose handID

    let handRay = poseToRay (poseFromMatrix handPose) (V3 0 0 (-1)) :: Ray GLfloat

    mRayResult <- castRay handRay
    let noHitLocation = V3 0 0 (-1000) *! handPose ^. _m33
    (hitLocation, teleportable) <- fmap (fromMaybe (noHitLocation, False)) . forM mRayResult $ \RayResult{..} -> do
        entityID <- unCollisionObjectID <$> getCollisionObjectID rrCollisionObject
        teleportable <- getIsTeleportable entityID
        
        when teleportable $ do
            hapticPulse whichHand 1000

        return (rrLocation, teleportable)

    let handLocation = handPose ^. translation 
        rayLength = distance handLocation hitLocation
        rayCenter = handLocation + (hitLocation - handLocation) / 2

    -- Update ray's postition/size
    runEntity beamID $ do
        setPose (handPose & translation .~ rayCenter)
        setSize (V3 0.05 0.05 rayLength)
        setColor $ if teleportable then V4 0 1 0 1 else V4 0.2 0.2 0.2 1

endBeam :: (MonadIO m, MonadState ECS m) => WhichHand -> m ()
endBeam whichHand = traverseM_ (viewSystem sysHands (hndBeams . at whichHand)) $ \beamID -> do
    removeEntity beamID
    modifySystemState sysHands $ hndBeams . at whichHand .= Nothing

    handID <- getHandID whichHand
    handPose <- getEntityPose handID
{'fraction_non_alphanumeric': 0.08907128742970057, 'fraction_numerical': 0.020215838273293815, 'mean_word_length': 2.3333333333333335, 'pattern_counts': {'":': 0, '<': 26, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3487717', 'n_tokens_mistral': 2184, 'n_tokens_neox': 2037, 'n_words': 562}