| summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ElmModule/Update.elm | 4 | ||||
| -rw-r--r-- | src/ElmModule/View.elm | 14 | ||||
| -rw-r--r-- | src/Struct/Event.elm | 1 | ||||
| -rw-r--r-- | src/Struct/UI.elm | 64 | ||||
| -rw-r--r-- | src/Tonkadur/Compute.elm | 5 | ||||
| -rw-r--r-- | src/Tonkadur/Execute.elm | 96 | ||||
| -rw-r--r-- | src/Tonkadur/Types.elm | 9 | ||||
| -rw-r--r-- | src/Update/Story.elm | 139 | ||||
| -rw-r--r-- | src/Util/TonkadurToHtml.elm | 48 | ||||
| -rw-r--r-- | src/View/PlayerInput.elm | 152 |
10 files changed, 494 insertions, 38 deletions
diff --git a/src/ElmModule/Update.elm b/src/ElmModule/Update.elm index a4b827a..3dbad82 100644 --- a/src/ElmModule/Update.elm +++ b/src/ElmModule/Update.elm @@ -6,6 +6,8 @@ module ElmModule.Update exposing (update) import Struct.Event import Struct.Model +import Update.Story + -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- @@ -21,3 +23,5 @@ update : ( update event model = case event of Struct.Event.None -> (model, Cmd.none) + (Struct.Event.ChoiceSelected ix) -> + ((Update.Story.select_choice ix model), Cmd.none) diff --git a/src/ElmModule/View.elm b/src/ElmModule/View.elm index fb99b89..f93928c 100644 --- a/src/ElmModule/View.elm +++ b/src/ElmModule/View.elm @@ -8,6 +8,7 @@ import Html.Attributes import Struct.Event import Struct.Model +import View.PlayerInput -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- @@ -22,5 +23,18 @@ view model = (Html.Attributes.class "fullscreen-module") ] [ + (Html.div + [ + (Html.Attributes.class "tonkadur-errors") + ] + model.ui.displayed_errors + ), + (Html.div + [ + (Html.Attributes.class "tonkadur-texts") + ] + model.ui.displayed_texts + ), + (View.PlayerInput.get_html model) ] ) diff --git a/src/Struct/Event.elm b/src/Struct/Event.elm index 5127422..4493b1a 100644 --- a/src/Struct/Event.elm +++ b/src/Struct/Event.elm @@ -9,6 +9,7 @@ module Struct.Event exposing (..) -------------------------------------------------------------------------------- type Type = None + | ChoiceSelected Int -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- diff --git a/src/Struct/UI.elm b/src/Struct/UI.elm index 80cd9e6..b3bdaae 100644 --- a/src/Struct/UI.elm +++ b/src/Struct/UI.elm @@ -1,19 +1,29 @@ -module Struct.UI exposing - ( - Type, - new - ) +module Struct.UI exposing (..) -- Elm ------------------------------------------------------------------------- import List -import String +import Html + +-- Local Module ---------------------------------------------------------------- +import Struct.Event -------------------------------------------------------------------------------- -- TYPES ----------------------------------------------------------------------- -------------------------------------------------------------------------------- +type InputType = + NoInput + | IntegerInput + | StringInput + | CommandInput + type alias Type = { - displayed_options : (List String) + displayed_texts : (List (Html.Html Struct.Event.Type)), + displayed_errors : (List (Html.Html Struct.Event.Type)), + displayed_choices : (List (Int, (Html.Html Struct.Event.Type))), + min : Int, + max : Int, + input : InputType } -------------------------------------------------------------------------------- @@ -26,5 +36,43 @@ type alias Type = new : Type new = { - displayed_options = [] + displayed_texts = [], + displayed_errors = [], + displayed_choices = [], + min = -1, + max = -1, + input = NoInput } + +display_text : (Html.Html Struct.Event.Type) -> Type -> Type +display_text html ui = + {ui | displayed_texts = (List.append ui.displayed_texts [html])} + +display_error : (Html.Html Struct.Event.Type) -> Type -> Type +display_error html ui = + {ui | displayed_errors = (List.append ui.displayed_errors [html])} + +display_choice : Int -> (Html.Html Struct.Event.Type) -> Type -> Type +display_choice ix html ui = + {ui | displayed_choices = (List.append ui.displayed_choices [(ix, html)])} + +prompt_string : Int -> Int -> Type -> Type +prompt_string min max ui = {ui | min = min, max = max, input = StringInput} + +prompt_integer : Int -> Int -> Type -> Type +prompt_integer min max ui = {ui | min = min, max = max, input = IntegerInput} + +prompt_command : Int -> Int -> Type -> Type +prompt_command min max ui = {ui | min = min, max = max, input = CommandInput} + +clear_prompt : Type -> Type +clear_prompt ui = {ui | min = -1, max = -1, input = NoInput} + +clear_displayed_texts : Type -> Type +clear_displayed_texts ui = {ui | displayed_texts = []} + +clear_displayed_errors : Type -> Type +clear_displayed_errors ui = {ui | displayed_errors = []} + +clear_displayed_choices : Type -> Type +clear_displayed_choices ui = {ui | displayed_choices = []} diff --git a/src/Tonkadur/Compute.elm b/src/Tonkadur/Compute.elm index 489ab3b..2a3410f 100644 --- a/src/Tonkadur/Compute.elm +++ b/src/Tonkadur/Compute.elm @@ -160,7 +160,10 @@ newline : Tonkadur.Types.State -> Tonkadur.Types.Value newline state = (TextValue Newline) next_allocable_address : Tonkadur.Types.State -> Tonkadur.Types.Value -next_allocable_address state = (IntValue state.next_allocable_address) +next_allocable_address state = + if (List.isEmpty state.freed_addresses) + then (PointerValue [(".alloc." ++ (String.fromInt state.allocated_data))]) + else (PointerValue [state.freed_addresses[0]]) operation : ( Tonkadur.Types.State -> diff --git a/src/Tonkadur/Execute.elm b/src/Tonkadur/Execute.elm index cf582dd..cf88968 100644 --- a/src/Tonkadur/Execute.elm +++ b/src/Tonkadur/Execute.elm @@ -89,23 +89,51 @@ initialize : ( Tonkadur.Types.State ) initialize type_name address state = - {state | - memory = - (Tonkadur.Types.apply_at_address - (Tonkadur.Types.value_to_list - (Tonkadur.Compute.compute state address) - ) - (\last_addr dict -> - (Dict.insert - last_addr - (Tonkadur.Types.get_default state type_name) - dict + let + new_state = + {state | + memory = + (Tonkadur.Types.apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> + (Dict.insert + last_addr + (Tonkadur.Types.get_default state type_name) + dict + ) + ) + state.memory ) - ) - state.memory - ) - -- TODO: detect allocated memory for special handling. - } + -- TODO: detect allocated memory for special handling. + } + in + case address of + [single_element] -> + if (String.startsWith ".alloc." single_element) + then + if + ( + single_element + == (".alloc." ++ (String.fromInt new_state.allocated_data)) + ) + then + {new_state | + allocated_data = new_state.allocated_data + 1 + } + else + {new_state | + freed_addresses = + (List.filter + (\addr -> (addr /= single_element)) + new_state.freed_addresses + ) + } + + else new_state + + _ -> new_state prompt_command : ( Tonkadur.Types.PromptInstructionData -> @@ -161,17 +189,31 @@ remove : ( Tonkadur.Types.State ) remove address state = - {state | - memory = - (Tonkadur.Types.apply_at_address - (Tonkadur.Types.value_to_list - (Tonkadur.Compute.compute state address) - ) - (\last_addr dict -> (Dict.remove last_addr dict)) - state.memory - ) - -- TODO: detect allocated memory for special handling. - } + let + new_state = + {state | + memory = + (Tonkadur.Types.apply_at_address + (Tonkadur.Types.value_to_list + (Tonkadur.Compute.compute state address) + ) + (\last_addr dict -> (Dict.remove last_addr dict)) + state.memory + ) + } + in + case address of + [single_element] -> + if (String.startsWith ".alloc." single_element) + then + {new_state | + freed_addresses = + (single_element :: new_state.freed_addresses) + } + else new_state + + _ -> new_state + resolve_choice : Tonkadur.Types.State -> Tonkadur.Types.State resolve_choice state = diff --git a/src/Tonkadur/Types.elm b/src/Tonkadur/Types.elm index 504695b..ec6c3c2 100644 --- a/src/Tonkadur/Types.elm +++ b/src/Tonkadur/Types.elm @@ -97,7 +97,8 @@ type alias State = available_options : (List Option), memorized_target : Value, - last_instruction_effect : InstructionEffect + last_instruction_effect : InstructionEffect, + freed_addresses : (List String) } -------------------------------------------------------------------------------- @@ -120,7 +121,8 @@ new_state = available_options = [], memorized_target = (PointerValue [""]), - last_instruction_effect = MustContinue + last_instruction_effect = MustContinue, + freed_addresses = [] } value_to_bool : Value -> Bool @@ -302,3 +304,6 @@ apply_at_address address fun memory = ) memory ) + +allow_continuing : State -> State +allow_continuing state = {state | last_instruction_effect = MustContinue} diff --git a/src/Update/Story.elm b/src/Update/Story.elm new file mode 100644 index 0000000..bee5cc8 --- /dev/null +++ b/src/Update/Story.elm @@ -0,0 +1,139 @@ +module Update.Story exposing + ( + new, + select_choice, + input_string, + input_integer, + input_command + ) + +-- Elm ------------------------------------------------------------------------- +import Html + +-- Local Module ---------------------------------------------------------------- +import Struct.Event +import Struct.Model + +import Util.TonkadurToHtml + +import Tonkadur.Execute + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +step : Struct.Model.Type -> Struct.Model.Type +step model = + case model.tonkadur.last_instruction_effect of + MustContinue -> + (step + {model | + tonkadur = + (Tonkadur.Execute.execute + model.tonkadur.code[model.tonkadur.program_counter] + model.tonkadur + ) + } + ) + + MustEnd -> model -- TODO + + (MustPromptCommand min max label) -> + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (Struct.UI.prompt_command + (Tonkadur.Types.value_to_int min) + (Tonkadur.Types.value_to_int max) + model.ui + ) + } + + (MustPromptInteger min max label) -> + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (Struct.UI.prompt_integer + (Tonkadur.Types.value_to_int min) + (Tonkadur.Types.value_to_int max) + model.ui + ) + } + + (MustPromptString min max label) -> + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (Struct.UI.prompt_string + (Tonkadur.Types.value_to_int min) + (Tonkadur.Types.value_to_int max) + model.ui + ) + } + + MustPromptChoice -> + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (List.foldl + (\option (ix, ui) -> + case option of + (Choice rich_text) -> + ( + (ix + 1), + (Struct.UI.display_choice + ix + (Util.TonkadurToHtml.convert + (TextValue rich_text) + ) + ) + ) + + _ -> ((ix + 1), ui) + ) + (0, model.ui) + model.tonkadur.available_options + ) + } + + (MustDisplay text) -> + (step + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (Struct.UI.display_text + (Util.TonkadurToHtml.convert text) + model.ui + ) + } + ) + + (MustDisplayError text) -> + (step + {model | + tonkadur = (Tonkadur.Types.allow_continuing model.tonkadur), + ui = + (Struct.UI.display_error + (Util.TonkadurToHtml.convert text) + model.ui + ) + } + ) + + _ -> model + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +new : Type +new = + { + displayed_text = [], + displayed_options = [] + } + + diff --git a/src/Util/TonkadurToHtml.elm b/src/Util/TonkadurToHtml.elm new file mode 100644 index 0000000..452d6a3 --- /dev/null +++ b/src/Util/TonkadurToHtml.elm @@ -0,0 +1,48 @@ +module Util.TonkadurToHtml exposing (..) + +-- Elm ------------------------------------------------------------------------- +import List +import Html +import Html.Attributes + +-- Tonkadur -------------------------------------------------------------------- +import Tonkadur.Types + +-- Local Module ---------------------------------------------------------------- +import Struct.Event + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +convert : Tonkadur.Types.Value -> (Html.Html Struct.Event.Type) +convert value = + case (Tonkadur.Types.value_to_text_or_string value) of + (Tonkadur.Types.AugmentedText text_data) -> + (Html.div + [ + (Html.Attributes.class "tonkadur-value") + -- TODO: more classes depending on effects. + ] + (List.map + (\v -> (convert (Tonkadur.Types.TextValue v))) + text_data.content + ) + ) + + (Tonkadur.Types.StringText string) -> + (Html.div + [ + (Html.Attributes.class "tonkadur-value") + ] + [(Html.text string)] + ) + + Tonkadur.Types.NewlineText -> (Html.br [] []) diff --git a/src/View/PlayerInput.elm b/src/View/PlayerInput.elm new file mode 100644 index 0000000..01d926c --- /dev/null +++ b/src/View/PlayerInput.elm @@ -0,0 +1,152 @@ +module View.PlayerInput exposing (get_html) + +-- Elm ------------------------------------------------------------------------- +import List +import Html +import Html.Attributes +import Html.Events + +-- Local Module ---------------------------------------------------------------- +import Struct.Event +import Struct.Model +import Struct.UI + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_choice_html : ( + (Int, (Html.Html Struct.Event.Type)) -> + (Html.Html Struct.Event.Type) + ) +get_choice_html data = + let (ix, html) = data in + (Html.div + [ + (Html.Attributes.class "tonkadur-choice"), + (Html.Events.onClick (Struct.Event.ChoiceSelected ix)) + ] + [html] + ) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +get_html : Struct.Model.Type -> (Html.Html Struct.Event.Type) +get_html model = + if (List.isEmpty model.ui.displayed_choices) + then + case model.ui.input of + Struct.UI.NoInput -> (Html.div [] []) + Struct.UI.IntegerInput -> + (Html.div + [ + (Html.Attributes.class "tonkadur-input") + ] + [ + (Html.div + [ + (Html.Attributes.class "tonkadur-input-instruction") + ] + [ + (Html.text + ( + "A number between " + ++ (String.fromInt model.ui.min) + ++ " and " + ++ (String.fromInt model.ui.max) + ++ " is expected:" + ) + ) + ] + ), + (Html.input + [ + (Html.Attributes.class "tonkadur-input-field"), + (Html.Attributes.min (String.fromInt model.ui.min)), + (Html.Attributes.max (String.fromInt model.ui.max)) + ] + [ + ] + ) + ] + ) + + Struct.UI.StringInput -> + (Html.div + [ + (Html.Attributes.class "tonkadur-input") + ] + [ + (Html.div + [ + (Html.Attributes.class "tonkadur-input-instruction") + ] + [ + (Html.text + ( + "A string of size between " + ++ (String.fromInt model.ui.min) + ++ " and " + ++ (String.fromInt model.ui.max) + ++ " characters is expected:" + ) + ) + ] + ), + (Html.input + [ + (Html.Attributes.class "tonkadur-input-field"), + (Html.Attributes.minlength model.ui.min), + (Html.Attributes.maxlength model.ui.max) + ] + [ + ] + ) + ] + ) + + Struct.UI.CommandInput -> + (Html.div + [ + (Html.Attributes.class "tonkadur-input") + ] + [ + (Html.div + [ + (Html.Attributes.class "tonkadur-input-instruction") + ] + [ + (Html.text + ( + "A space-separated list of strings (total size " + ++ " between " + ++ (String.fromInt model.ui.min) + ++ " and " + ++ (String.fromInt model.ui.max) + ++ " characters) is expected:" + ) + ) + ] + ), + (Html.input + [ + (Html.Attributes.class "tonkadur-input-field"), + (Html.Attributes.minlength model.ui.min), + (Html.Attributes.maxlength model.ui.max) + ] + [ + ] + ) + ] + ) + else + (Html.div + [ + (Html.Attributes.class "tonkadur-choice-list") + ] + (List.map (get_choice_html) model.ui.displayed_choices) + ) |