1 files changed, 44 insertions, 1 deletions
diff --git a/src/LivingVillage.Desktop/VillagePresentation.fs b/src/LivingVillage.Desktop/VillagePresentation.fs
index 95dc178..eee7fac 100644
--- a/src/LivingVillage.Desktop/VillagePresentation.fs
+++ b/src/LivingVillage.Desktop/VillagePresentation.fs
@@ -1,5 +1,8 @@
 namespace LivingVillage.Desktop
 
+open System
+open LivingVillage.Kernel.Sim
+
 module VillagePresentation =
 
     (**
@@ -18,6 +21,11 @@ module VillagePresentation =
           Y: int }
 
     [<Struct>]
+    type PixelPosition =
+        { X: float32
+          Y: float32 }
+
+    [<Struct>]
     type SimulationTick =
         | SimulationTick of int64
 
@@ -74,6 +82,11 @@ module VillagePresentation =
         | Outside
         | Inside of HomeId
 
+    type HomeInputAction =
+        | EnterHomeAction of HomeId
+        | ExitHomeAction of HomeId
+        | DialogueAction
+
     type HomeTransitionError =
         | NotNearHomeDoor
         | AlreadyInsideHome of HomeId
@@ -120,7 +133,18 @@ module VillagePresentation =
     let scene : PrototypeScene =
         createScene ()
 
-    let private manhattanDistance first second : int =
+    let sceneOrigin : TilePosition =
+        tile 25 18
+
+    let sceneTileFromPixel (pixel: PixelPosition) : TilePosition =
+        { X = int (Math.Floor(float pixel.X / float tilePixels)) - sceneOrigin.X
+          Y = int (Math.Floor(float pixel.Y / float tilePixels)) - sceneOrigin.Y }
+
+    let worldTileForSceneTile (sceneTile: TilePosition) : TilePosition =
+        { X = sceneOrigin.X + sceneTile.X
+          Y = sceneOrigin.Y + sceneTile.Y }
+
+    let private manhattanDistance (first: TilePosition) (second: TilePosition) : int =
         abs (first.X - second.X) + abs (first.Y - second.Y)
 
     let isNearHomeDoor (position: TilePosition) (home: Home) : bool =
@@ -143,6 +167,25 @@ module VillagePresentation =
             else
                 Error(HomeNotFound homeId)
 
+    let homeInputAction (pixel: PixelPosition) (mode: HomeMode) : HomeInputAction =
+        let scenePosition = sceneTileFromPixel pixel
+
+        match mode with
+        | Outside ->
+            match enterHome scenePosition Outside with
+            | Ok(Inside homeId) -> EnterHomeAction homeId
+            | _ -> DialogueAction
+        | Inside homeId ->
+            match scene.Homes |> List.tryFind (fun home -> home.Id = homeId) with
+            | Some home when isNearHomeDoor scenePosition home ->
+                match exitHome mode with
+                | Ok Outside -> ExitHomeAction homeId
+                | _ -> DialogueAction
+            | _ -> DialogueAction
+
+    let resetHomeMode () : HomeMode =
+        Outside
+
     let directionForInput (input: DirectionInput) : Direction option =
         match input with
         | UpInput -> Some North