...

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)
+      )