Boxes as folders

LearningMono/Entity.fs

@@ -39,7 +39,7 @@
     | Id
     | GoToNextLevel
     | Toggle of bool
-   // | MultiToggle of bool
+    // | MultiToggle of bool
     | Map of EntityType
     | Filter of EntityType
     | Compare
@@ -88,7 +88,7 @@
         | Box { IsOpen = false } -> boxClosedSpriteConfig
     | Observable { Type = ob } ->
         match ob with
-        | GoToNextLevel _ -> nextLevelSpriteConfig
+        | GoToNextLevel -> nextLevelSpriteConfig
         | Id -> idSpriteConfig
         | Toggle true -> toggleOnSpriteConfig
         | Toggle false -> toggleOffSpriteConfig
@@ -109,7 +109,7 @@
         | Box { IsOpen = false } -> boxClosedImage
     | Observable { Type = ob } ->
         match ob with
         | GoToNextLevel _ -> nextLevelImage
         | Toggle _ -> toggleOnImage
         | Id -> idImage
         | Map _ -> mapImage
@@ -128,8 +128,8 @@
     | Observable { Type = Compare }, Observable { Type = Compare } -> true
     | Observable { Type = Merge }, Observable { Type = Merge } -> true
     | Subject { Type = Timer _ }, Subject { Type = Timer _ } -> true
-    | Subject { Type = Button _ }, Subject { Type = Button _ } -> true
-    | Subject { Type = Box { IsOpen = a} }, Subject { Type = Box {IsOpen = b} } when a = b -> true // check contents ?? check open/closed
+    | Subject { Type = Button }, Subject { Type = Button } -> true
+    | Subject { Type = Box { IsOpen = a } }, Subject { Type = Box { IsOpen = b } } when a = b -> true // check contents ?? check open/closed
     | _, _ -> false
 
 let getCollider (eType: EntityType) (pos: Vector2) : AABB voption =
@@ -182,28 +182,31 @@
                             { IsOpen = true
                               Items = inputEntity :: items } }
         )
-    | _ -> ValueNone
+    | other ->
+        ValueSome(
+            Subject
+                { defaultSubjectData with
+                    Type = Box { IsOpen = true; Items = [ inputEntity; other ] } }
+        )
 
 [<return: Struct>]
-let (|CanPickOutOfEntity|_|) (entityType: EntityType) : voption<EntityType * EntityType> =
+let (|CanPickOutOfEntity|_|) (entityType: EntityType) : voption<voption<EntityType> * EntityType> =
     match entityType with
     | Observable { Type = Map Unit }
     | Observable { Type = Filter Unit } -> ValueNone
-    | Observable({ Type = Map e } as obs) -> ValueSome(Observable { obs with Type = Map Unit }, e)
-    | Observable({ Type = Filter e } as obs) -> ValueSome(Observable { obs with Type = Filter Unit }, e)
-    | Subject({ Type = Box { IsOpen = true; Items = e :: rest } } as sub) ->
-        ValueSome(Subject { sub with Type = Box { IsOpen = true; Items = rest } }, e)
+    | Observable({ Type = Map e } as obs) -> ValueSome (ValueSome(Observable { obs with Type = Map Unit }), e)
+    | Observable({ Type = Filter e } as obs) -> ValueSome (ValueSome(Observable { obs with Type = Filter Unit }), e)
+    | Subject({ Type = Box { IsOpen = true; Items = e :: (_ :: _ :: _ as rest) } } as sub) ->
+        ValueSome (ValueSome(
+            Subject
+                { sub with
+                    Type = Box { IsOpen = true; Items = rest } }),
+             e)      
+    | Subject({ Type = Box { IsOpen = true; Items = e :: f :: [] } }) ->
+        ValueSome( ValueSome f, e )   
     | _ -> ValueNone
 
 
-let takeOutOf (existingEntity: EntityType) =
-    match existingEntity with
-    | Observable({ Type = Map _ } as oData) -> Observable { oData with Type = Map Unit }
-    | Observable({ Type = Filter _ } as oData) -> Observable { oData with Type = Filter Unit }
-    | Subject({ Type = Box { IsOpen = true; Items = _ :: rest } } as sub) ->
-        Subject { sub with Type = Box { IsOpen = true; Items = rest } }
-    | _ -> existingEntity
-
 let private behaviorFunc (observable: ObservableData) (a: EntityType voption) (b: EntityType voption) =
     match observable.Type with
     | Id
@@ -228,7 +231,11 @@
     | Merge ->
         match (a, b) with
         | (ValueSome e1), (ValueSome e2) ->
-            WillEmit(Subject { defaultSubjectData with Type = Box { Items = [ e1; e2 ]; IsOpen = false } })
+            WillEmit(
+                Subject
+                    { defaultSubjectData with
+                        Type = Box { Items = [ e1; e2 ]; IsOpen = false } }
+            )
         | (ValueSome e1), ValueNone -> WillEmit e1
         | ValueNone, ValueSome e2 -> WillEmit e2
         | _ -> Nothing
@@ -283,7 +290,10 @@
                  else
                      toggleOffSpriteConfig)
 
-            let newObs = Observable { obData with Type = (Toggle(not state)) }
+            let newObs =
+                Observable
+                    { obData with
+                        Type = (Toggle(not state)) }
 
             { entity with
                 Type = newObs
@@ -327,10 +337,10 @@
 let getSubjectFunc (sub: SubjectType) =
     match sub with
     | Timer(box, time) -> buildRepeatListEmittingEvery box time
-    | Button _ -> subjectStep
+    | Button -> subjectStep
     | Box _ -> subjectStep
 
-let getBoxYPos (boxType:BoxData) = 
+let getBoxYPos (boxType: BoxData) =
     match boxType with
     | { IsOpen = false } -> 0
     | { Items = _ :: _ } -> 1
@@ -372,7 +382,14 @@
 
 let updateSprite (entity: Model) =
     let yPos = getYpos entity.Type entity.Facing
-    { entity with Sprite = Sprite.switchAnimation ({ imageSpriteConfig with Index = yPos }, 0, false) entity.Sprite }
+
+    //concept of one entity changing into another not modeled here
+    let spriteConfig = getSpriteConfig entity.Type
+
+    { entity with
+        Sprite = Sprite.reInit entity.Sprite spriteConfig (ValueSome yPos)
+        //Sprite = Sprite.switchAnimation ({ imageSpriteConfig with Index = yPos }, 0, false) entity.Sprite }
+    }
 
 let buildRepeatItemEmitEvery (every: int) (item: EntityType) =
     buildRepeatListEmittingEvery { Items = [ item ]; IsOpen = false } every
@@ -412,24 +429,34 @@
             Type =
                 Subject
                     { subData with
-                        ToEmit = (WillEmit << Subject) { defaultSubjectData with Type = Button }
+                        ToEmit =
+                            (WillEmit << Subject)
+                                { defaultSubjectData with
+                                    Type = Button }
                         TicksSinceEmit = 0
                         GenerationNumber = subData.GenerationNumber + 1 } },
         InteractionEvent.NoEvent
     | Subject({ Type = Box({ IsOpen = isOpen } as boxType) } as subj) ->
         let boxData = { boxType with IsOpen = not isOpen }
         let animIndex = getBoxYPos boxData
-        let boxImageConfig = if boxData.IsOpen then boxOpenSpriteConfig else boxClosedSpriteConfig
 
-        let newSprite =
-            Sprite.reInit entity.Sprite boxImageConfig (ValueSome animIndex)
+        let boxImageConfig =
+            if boxData.IsOpen then
+                boxOpenSpriteConfig
+            else
+                boxClosedSpriteConfig
+
+        let newSprite = Sprite.reInit entity.Sprite boxImageConfig (ValueSome animIndex)
 
         { entity with
             Type =
                 Subject
                     { subj with
                         Type = Box boxData
-                        ToEmit = (WillEmit << Subject) { defaultSubjectData with Type = Box boxData }
+                        ToEmit =
+                            (WillEmit << Subject)
+                                { defaultSubjectData with
+                                    Type = Box boxData }
                         TicksSinceEmit = 0
                         GenerationNumber = subj.GenerationNumber + 1 }
             Sprite = newSprite },

LearningMono/Game.fs

@@ -173,14 +173,21 @@ type PickupEntityFn = Entity.Model -> int32 -> Tile -> Model -> Model
 let pickUp (targetEntity: Entity.Model) (i: int) (tile: Tile) (model: Model) : Model =
     let newTile, pickedUpEntity =
         match targetEntity with
-        | { Type = CanPickOutOfEntity(eData, entityType) } as targetEntity ->
+        | { Type = CanPickOutOfEntity(ValueSome eData, entityType) } as targetEntity ->
             let newTarget = Entity.updateSprite { targetEntity with Type = eData }
             let fromObserverEntity = Entity.init entityType Vector2.Zero 0 FacingRight true
 
             let tile =
                 { tile with
                     Entity = ValueSome newTarget }
 
+            tile, fromObserverEntity
+        | { Type = CanPickOutOfEntity(ValueNone, entityType) } ->
+            let fromObserverEntity = Entity.init entityType Vector2.Zero 0 FacingRight true
+            let tile =
+                { tile with
+                    Entity = ValueNone }
+
             tile, fromObserverEntity
         | _ -> { tile with Entity = ValueNone }, targetEntity
 
@@ -484,8 +491,8 @@ let update (message: Message) (model: Model) : Model =
                     (fun curr next ->
                         curr
                         || match next with
-                        | { Entity = ValueSome { Type = Unit } } -> true
-                        | _ -> false)
+                            | { Entity = ValueSome { Type = Unit } } -> true
+                            | _ -> false)
                     false
 
             let tiles = updateWorldSprites time tiles

LearningMono/Level.fs

@@ -264,10 +264,12 @@ let viewEntities (maybeTargetColor:voption<Color>) (cameraOffset:Vector2) (tile:
                 spriteBatch
                 (depth + DepthConfig.Entities_And_Player)
 
-            // match entity.Type with
-            // | EmittingObservable(_, _) -> loadedAssets.sounds["click"].Play(0.05f, 0.0f, 0.0f) |> ignore
-            // | _ -> ()
+            match entity.Type with
+            | EmittingObservable(_, _) -> 
+                loadedAssets.sounds["click"].Play(0.05f, 0.0f, 0.0f) |> ignore
+            | _ -> ()
 
+            // emitting
             match entity.Type with
             | RenderEmittingObservable(etype, t) ->
                 viewEmitting
@@ -278,6 +280,7 @@ let viewEntities (maybeTargetColor:voption<Color>) (cameraOffset:Vector2) (tile:
                     loadedAssets.textures[(getEmitImage etype).TextureName]
             | _ -> ()
 
+            //
             match entity.Type, maybeTargetColor with
             | CanPickOutOfEntity(_, eType), ValueSome _ ->
                 viewObserverItem

LearningMono/Levels.fs

@@ -61,11 +61,11 @@
         let ww = createCollidableTile Wall
         let wt = createCollidableTile FloorType.TopWall
         let bb = createButtonOnGrass time true
         let rr = createRockOnGrass time true
 
         let xu = observerCannotPick time (observing Id) FacingUp
         let xl = observerCannotPick time (observing Id) FacingLeft
         let xr = observerCannotPick time (observing Id) FacingRight
         let NL = observerCannotPick time (observing GoToNextLevel) FacingLeft
 
 
@@ -150,8 +150,8 @@
         let wt = createCollidableTile FloorType.TopWall
         let bb = createButtonOnGrass time false
 
         let xu = observerCannotPick time (observing Id) FacingUp
         let xl = observerCanPick time (observing Id) FacingLeft
         let xr = observerCanPick time (observing Id) FacingRight
         let NL = observerCannotPick time (observing GoToNextLevel) FacingRight
 
@@ -180,8 +180,8 @@
         let wt = createCollidableTile FloorType.TopWall
         let bb = createButtonOnGrass time false
 
         let xu = observerCannotPick time (observing Id) FacingUp
         let xl = observerCanPick time (observing Id) FacingLeft
         let xr = observerCanPick time (observing Id) FacingRight
         let NL = observerCannotPick time (observing GoToNextLevel) FacingLeft
 
@@ -210,7 +210,7 @@
         let wt = createCollidableTile FloorType.TopWall
         let bb = createButtonOnGrass time false
 
         let xu = observerCannotPick time (observing Id) FacingUp
         let xl = observerCanPick time (observing Id) FacingLeft
         let xr = observerCanPick time (observing Id) FacingRight
         let NL = observerCannotPick time (observing GoToNextLevel) FacingLeft
@@ -863,23 +863,23 @@
 
 let levels: LevelBuilder[] =
     [| 
-        level_playerMoves
-        level_playerPickUp
-        level_left
-        level_dangRocks
-        level_observers
-        level_observers2
-        level_observers3
-        level_observers4
-        level_observers5
-        level_box0
-        level_box1
-        level_box2
-        level_toggles
-        level_toggles2
-        level_merge1
-        //level_merge2
-        level_filter1
-        level_filter11
-        level_filter2
+        // level_playerMoves
+        // level_playerPickUp
+        // level_left
+        // level_dangRocks
+        // level_observers
+        // level_observers2
+        // level_observers3
+        // level_observers4
+        // level_observers5
+        // level_box0
+        // level_box1
+        // level_box2
+        // level_toggles
+        // level_toggles2
+        // level_merge1
+        // //level_merge2
+        // level_filter1
+        // level_filter11
+        // level_filter2
         levelSandBox |]