From e5f84c4f7ca645b5629cf661adbcbfff5979370b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kamil=20D=C4=85browski?= Date: Wed, 12 Jul 2017 19:02:41 +0200 Subject: [PATCH] dev(client): basics of reading objects, specify schema of value tree --- client/src/Common.elm | 13 ++- client/src/Main.elm | 62 +++++++++++--- client/src/ObjectModelNode.elm | 10 ++- client/src/Serialization.elm | 147 ++++++++++++++++++++++++++++++--- client/src/ValueTree.elm | 59 +++++++++++-- 5 files changed, 257 insertions(+), 34 deletions(-) diff --git a/client/src/Common.elm b/client/src/Common.elm index aee2b67..4188ed5 100644 --- a/client/src/Common.elm +++ b/client/src/Common.elm @@ -40,15 +40,14 @@ elemIndex arr expectedElem = find 0 -iterateFoldl : (a -> Int -> Maybe a) -> a -> Int -> Int -> a +iterateFoldl : (a -> Int -> a) -> a -> Int -> Int -> a iterateFoldl callback acc startIndex endIndex = if startIndex <= endIndex then - case callback acc startIndex of - Just newAcc -> - iterateFoldl callback newAcc (startIndex + 1) endIndex - - Nothing -> - acc + let + newAcc = + callback acc startIndex + in + iterateFoldl callback newAcc (startIndex + 1) endIndex else acc diff --git a/client/src/Main.elm b/client/src/Main.elm index d884b80..54a50a0 100644 --- a/client/src/Main.elm +++ b/client/src/Main.elm @@ -1,5 +1,6 @@ module Main exposing (..) +import Array exposing (Array) import Binary.ArrayBuffer exposing (ArrayBuffer, asUint8Array, byteLength, bytesToDebugString, getByte, stringToBufferArray) import Common exposing (send, sure) import Constants exposing (..) @@ -10,6 +11,7 @@ import Html.Events exposing (..) import List.Extra import ObjectModelNode exposing (..) import Serialization exposing (..) +import ValueTree exposing (..) import WebSocket import WebSocket.LowLevel exposing (MessageData(..)) @@ -31,10 +33,11 @@ type alias Model = { input : String , messages : List String , objModelNodes : List ObjectModelNode + , valueTrees : List ValueTree , entities : Dict Int EntityInfo , systems : List EntitySystemInfo , managers : List EntityManagerInfo - , componentTypes : List ComponentTypeInfo + , componentTypes : Array ComponentTypeInfo } @@ -66,13 +69,13 @@ type alias EntityManagerInfo = type alias ComponentTypeInfo = { name : String , index : Int - , objModelId : Int + , objModelId : ObjectModelNodeId } init : ( Model, Cmd Msg ) init = - ( Model "" [] [] Dict.empty [] [] [], Cmd.none ) + ( Model "" [] [] [] Dict.empty [] [] Array.empty, Cmd.none ) createEntitySystemInfo : String -> Int -> Maybe BitVector -> Maybe BitVector -> Maybe BitVector -> EntitySystemInfo @@ -104,12 +107,13 @@ type Msg | Msg_OnUpdatedEntitySystem Int Int Int | Msg_OnAddedEntity EntityId BitVector | Msg_OnDeletedEntity EntityId + | Msg_OnUpdatedComponentState EntityId Int update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = let - { input, messages, objModelNodes } = + { input, messages, objModelNodes, valueTrees, componentTypes } = model in case msg of @@ -127,14 +131,15 @@ update msg model = NewNetworkMessage (ArrayBuffer bytes) -> let ( des, packet ) = - deserializePacket bytes + deserializePacket objModelNodes valueTrees componentTypes bytes cmd = send packet in ( { model | messages = (bytes |> bytesToDebugString) :: messages - , objModelNodes = objModelNodes ++ des.models + , objModelNodes = des.models + , valueTrees = valueTrees } , cmd ) @@ -158,10 +163,11 @@ update msg model = Msg_OnAddedComponentType index name objModelId -> let + newComponentType : ComponentTypeInfo newComponentType = { name = name, index = index, objModelId = objModelId } in - { model | componentTypes = newComponentType :: model.componentTypes |> List.sortBy .index } ! [] + { model | componentTypes = Array.push newComponentType model.componentTypes } ! [] Msg_OnUpdatedEntitySystem index entitiesCount maxEntitiesCount -> let @@ -180,12 +186,16 @@ update msg model = Msg_OnDeletedEntity id -> { model | entities = Dict.remove id model.entities } ! [] + Msg_OnUpdatedComponentState entityId componentIndex -> + -- TODO + model ! [] + -deserializePacket : ArrayBuffer -> ( DeserializationPoint, Msg ) -deserializePacket bytes = +deserializePacket : List ObjectModelNode -> List ValueTree -> Array ComponentTypeInfo -> ArrayBuffer -> ( DeserializationPoint, Msg ) +deserializePacket objModelNodes valueTrees componentTypes bytes = let ( des0, packetType ) = - beginDeserialization bytes + beginDeserialization objModelNodes valueTrees bytes |> readRawByte in if packetType == type_AddedEntitySystem then @@ -233,12 +243,42 @@ deserializePacket bytes = readBitVector des1 in ( des2, Msg_OnAddedEntity id (sure components) ) + else if packetType == type_UpdatedEntitySystem then + let + ( des1, index ) = + readInt des0 + + ( des2, entitiesCount ) = + readInt des1 + + ( des3, maxEntitiesCount ) = + readInt des2 + in + ( des3, Msg_OnUpdatedEntitySystem index entitiesCount maxEntitiesCount ) else if packetType == type_DeletedEntity then let ( des1, id ) = readInt des0 in ( des1, Msg_OnDeletedEntity id ) + else if packetType == type_UpdatedComponentState then + let + ( des1, entityId ) = + readInt des0 + + ( des2, componentIndex ) = + readInt des1 + + componentTypeInfo = + Array.get componentIndex componentTypes + |> sure + + ( des3, _, valueTreeId ) = + readObject des0 componentTypeInfo.objModelId + + -- TODO do something with the valueTree! + in + ( des3, Msg_OnUpdatedComponentState entityId componentIndex ) else Debug.log ("unknown msg " ++ toString packetType) ( des0, Msg_Unknown ) @@ -264,7 +304,7 @@ view model = , h2 [] [ text "Managers" ] , div [] (List.map viewManager model.managers) , h2 [] [ text "Component types" ] - , div [] (List.map viewComponentType model.componentTypes) + , div [] (List.map viewComponentType (Array.toList model.componentTypes)) , h2 [] [ text "Entities" ] , div [] (Dict.foldr viewEntity [] model.entities) , h2 [] [ text "Debug messages" ] diff --git a/client/src/ObjectModelNode.elm b/client/src/ObjectModelNode.elm index 412b7b2..0d437ee 100644 --- a/client/src/ObjectModelNode.elm +++ b/client/src/ObjectModelNode.elm @@ -5,13 +5,15 @@ module ObjectModelNode , ObjectModelNodeId , createModelNode , defaultModelNode + , getObjectModelById , intToType , isSimpleType , typeToInt ) import Array exposing (..) -import Common exposing (elemIndex, intentionalCrash) +import Common exposing (elemIndex, intentionalCrash, sure) +import List.Extra type DataType @@ -152,3 +154,9 @@ createModelNode id = defaultModelNode : ObjectModelNode defaultModelNode = createModelNode -1 + + +getObjectModelById : List ObjectModelNode -> ObjectModelNodeId -> ObjectModelNode +getObjectModelById models id = + List.Extra.find (\m -> m.id == id) models + |> sure diff --git a/client/src/Serialization.elm b/client/src/Serialization.elm index 581b126..52ba8ac 100644 --- a/client/src/Serialization.elm +++ b/client/src/Serialization.elm @@ -1,12 +1,43 @@ -module Serialization exposing (..) +module Serialization + exposing + ( BitVector + , DeserializationPoint + , ObjectReadSession + , beginDeserialization + , bitVectorToDebugString + , checkNull + , expectTypeOrNull + , isDone + , readBitVector + , readBoolean + , readByte + , readDataDescription + , readFloat + , readInt + , readLong + , readObject + , readRawBoolean + , readRawByte + , readRawBytes + , readRawDataDescription + , readRawFloat + , readRawInt + , readRawLong + , readRawObject + , readRawShort + , readShort + , readString + , readType + ) import Array exposing (Array) import Binary.ArrayBuffer as Buffer import Bitwise -import Common exposing (intentionalCrash, iterateFoldl) +import Common exposing (intentionalCrash, iterateFoldl, sure) import List.Extra import Native.Serialization import ObjectModelNode exposing (..) +import ValueTree exposing (..) type alias DeserializationPoint = @@ -14,6 +45,12 @@ type alias DeserializationPoint = , len : Int , arr : Buffer.Uint8Array , models : List ObjectModelNode + , valueTrees : List ValueTree + } + + +type alias ObjectReadSession = + { valueTrees : List ( ValueTreeId, Maybe ObjectModelNodeId ) } @@ -30,13 +67,13 @@ integerSize = 32 -beginDeserialization : Buffer.ArrayBuffer -> DeserializationPoint -beginDeserialization buf = +beginDeserialization : List ObjectModelNode -> List ValueTree -> Buffer.ArrayBuffer -> DeserializationPoint +beginDeserialization objModels valueTrees buf = let arr = Buffer.asUint8Array buf in - { pos = 0, len = Buffer.byteLength buf, arr = arr, models = [] } + { pos = 0, len = Buffer.byteLength buf, arr = arr, models = objModels, valueTrees = valueTrees } intBitsToFloat : Int -> Float @@ -430,7 +467,7 @@ readRawDataDescription des0 = ( newDes, childObjModelId ) = readDataDescription des in - Just ( newDes, childObjModelId :: childrenIds ) + ( newDes, childObjModelId :: childrenIds ) ) ( des5, [] ) 0 @@ -472,15 +509,105 @@ readRawDataDescription des0 = intentionalCrash ( des0, 0 ) ("unsupported type: " ++ toString nodeType) +readObject : DeserializationPoint -> ObjectModelNodeId -> ( DeserializationPoint, ObjectReadSession, Maybe ValueTreeId ) +readObject des0 objModelId = + let + session : ObjectReadSession + session = + { valueTrees = [] } + in + readObjectWithSession des0 objModelId session + + +readObjectWithSession : DeserializationPoint -> ObjectModelNodeId -> ObjectReadSession -> ( DeserializationPoint, ObjectReadSession, Maybe ValueTreeId ) +readObjectWithSession des0 objModelId objReadSession = + let + des1 = + checkType des0 TObject + in + readRawObject des1 objModelId Nothing objReadSession + + +readRawObject : DeserializationPoint -> ObjectModelNodeId -> Maybe ValueTreeId -> ObjectReadSession -> ( DeserializationPoint, ObjectReadSession, Maybe ValueTreeId ) +readRawObject des0 objModelId maybeParentValueTreeId objReadSession0 = + let + ( des1, isNull ) = + checkNull des0 + + objModel = + getObjectModelById des0.models objModelId + in + if isNull then + ( des1, objReadSession0, Nothing ) + else if objModel.dataType == TObject || objModel.dataType == TUnknown then + let + ( des2, dataType ) = + readType des1 + + ( des3, id ) = + readRawShort des2 + in + if dataType == TObject then + let + n = + List.length (Maybe.withDefault [] objModel.children) + + tree : ValueTree + tree = + createValueTree id maybeParentValueTreeId (Just objModelId) + + objReadSession1 = + rememberInSession objReadSession0 id (Just objModelId) + + ( des4, objReadSession2, valueTreeIds ) = + iterateFoldl + (\( des, session, valueTreeIds ) idx -> + let + childObjModelId = + List.Extra.getAt idx (sure objModel.children) + + ( des1, session1, valueTreeId ) = + readRawObject des (sure childObjModelId) (Just id) session + in + ( des1, session1, valueTreeId :: valueTreeIds ) + ) + ( des3, objReadSession1, [] ) + 0 + (n - 1) + in + -- other valueTrees are saved inside at this point + ( { des4 | valueTrees = tree :: des4.valueTrees }, objReadSession2, Just id ) + else if dataType == TObjectRef then + -- TODO + ( des1, objReadSession0, Nothing ) + else if dataType == TArray then + -- TODO + ( des1, objReadSession0, Nothing ) + else + intentionalCrash ( des3, objReadSession0, Nothing ) ("Types are divergent, expected: " ++ toString TObject ++ " or " ++ toString TObjectRef ++ ", got: " ++ toString dataType) + else if isSimpleType objModel.dataType then + -- TODO + ( des1, objReadSession0, Nothing ) + else if objModel.dataType == TEnum then + -- TODO + ( des1, objReadSession0, Nothing ) + else if objModel.dataType == TArray then + -- TODO + ( des1, objReadSession0, Nothing ) + else + intentionalCrash ( des1, objReadSession0, Nothing ) ("unsupported type:" ++ (toString objModel.dataType ++ ", subtype: " ++ toString objModel.dataSubType)) + + +rememberInSession : ObjectReadSession -> ValueTreeId -> Maybe ObjectModelNodeId -> ObjectReadSession +rememberInSession session id objModelId = + { session | valueTrees = ( id, objModelId ) :: session.valueTrees } + + {- # TODO: - * readDataDescription - * readRawDataDescription * readObject - * readRawObject * possiblyReadDescriptions * readArray * readPrimitive*Array - * ObjectReadSession -} diff --git a/client/src/ValueTree.elm b/client/src/ValueTree.elm index 1060660..951cbf1 100644 --- a/client/src/ValueTree.elm +++ b/client/src/ValueTree.elm @@ -1,9 +1,58 @@ -module ValueTree exposing (ValueTree) +module ValueTree + exposing + ( AValue + , ValueHolder + , ValueTree + , ValueTreeId + , createValueTree + ) + +import ObjectModelNode exposing (..) type alias ValueTree = - { id : Int - , values : List a - , parentId : Maybe Int - , modelId : Maybe Int + { id : ValueTreeId + , parentId : Maybe ValueTreeId + , modelId : Maybe ObjectModelNodeId + , values : List AValue + } + + +type alias ValueTreeId = + Int + + +type alias AValue = + { dataType : DataType + , value : ValueHolder + } + + +type ValueHolder + = ANull + | AValueTreeRef Int + | AString String + | AInt Int + | AChar Char + | AFloat Float + | ACharList List Char + | AIntList List Int + | AFloatList List Float + | AValueList List AValue + + +createValueTree : ValueTreeId -> Maybe ValueTreeId -> Maybe ObjectModelNodeId -> ValueTree +createValueTree id parentId objModelId = + { id = id, parentId = parentId, modelId = objModelId, values = [] } + + +d1 : ValueTree +d1 = + { id = 1 + , parentId = Just 2 + , modelId = Just 10 + , values = + [ { dataType = TString, value = AString "omg" } + , { dataType = TInt, value = AInt 2 } + ] }