summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ElmModule/Update.elm35
-rw-r--r--src/Struct/Event.elm2
-rw-r--r--src/Struct/UI.elm23
-rw-r--r--src/Tonkadur/Compute.elm104
-rw-r--r--src/Tonkadur/Execute.elm6
-rw-r--r--src/Tonkadur/Json.elm4
-rw-r--r--src/Tonkadur/Types.elm104
-rw-r--r--src/Update/Story.elm79
-rw-r--r--src/View/PlayerInput.elm44
-rw-r--r--www/style.css4
10 files changed, 342 insertions, 63 deletions
diff --git a/src/ElmModule/Update.elm b/src/ElmModule/Update.elm
index 9fc9a93..7f02d79 100644
--- a/src/ElmModule/Update.elm
+++ b/src/ElmModule/Update.elm
@@ -1,6 +1,7 @@
module ElmModule.Update exposing (update)
-- Elm -------------------------------------------------------------------------
+import Http
-- Local Module ----------------------------------------------------------------
import Struct.Event
@@ -27,6 +28,15 @@ update event model =
((Update.Story.select_choice ix model), Cmd.none)
Struct.Event.None -> (model, Cmd.none)
+ (Struct.Event.UserInputInProgress string) ->
+ (
+ {model | ui = (Struct.UI.set_field_content string model.ui)},
+ Cmd.none
+ )
+
+ Struct.Event.UserInputValidated ->
+ ((Update.Story.handle_prompt_input model), Cmd.none)
+
(Struct.Event.LoadStory http_result) ->
case http_result of
(Ok story) ->
@@ -47,7 +57,30 @@ update event model =
{model |
ui =
(Struct.UI.display_string_error
- "Failed to load story"
+ (
+ "Failed to load story:\n"
+ ++
+ (
+ case error of
+ (Http.BadUrl details) ->
+ ("Bad URL: " ++ details)
+
+ Http.Timeout -> "Timeout."
+ Http.NetworkError -> "Network Error."
+ (Http.BadStatus code) ->
+ (
+ "Error code "
+ ++ (String.fromInt code)
+ ++ "."
+ )
+
+ (Http.BadBody details) ->
+ (
+ "Invalid content: "
+ ++ details
+ )
+ )
+ )
model.ui
)
},
diff --git a/src/Struct/Event.elm b/src/Struct/Event.elm
index 77fb564..6faf1c1 100644
--- a/src/Struct/Event.elm
+++ b/src/Struct/Event.elm
@@ -14,6 +14,8 @@ import Tonkadur.Types
type Type =
None
| ChoiceSelected Int
+ | UserInputInProgress String
+ | UserInputValidated
| LoadStory (Result Http.Error Tonkadur.Types.State)
--------------------------------------------------------------------------------
diff --git a/src/Struct/UI.elm b/src/Struct/UI.elm
index 9f1ce8f..ade62ce 100644
--- a/src/Struct/UI.elm
+++ b/src/Struct/UI.elm
@@ -26,7 +26,8 @@ type alias Type =
max : Int,
min_float : Float,
max_float : Float,
- input : InputType
+ input : InputType,
+ field_content : String
}
--------------------------------------------------------------------------------
@@ -46,7 +47,8 @@ new =
max = -1,
min_float = -1.0,
max_float = -1.0,
- input = NoInput
+ input = NoInput,
+ field_content = ""
}
display_text : (Html.Html Struct.Event.Type) -> Type -> Type
@@ -81,7 +83,16 @@ 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_prompt ui =
+ {ui |
+ min = -1,
+ min_float = -1.0,
+ max = -1,
+ max_float = -1.0,
+ input = NoInput,
+ displayed_choices = [],
+ field_content = ""
+ }
clear_displayed_texts : Type -> Type
clear_displayed_texts ui = {ui | displayed_texts = []}
@@ -91,3 +102,9 @@ clear_displayed_errors ui = {ui | displayed_errors = []}
clear_displayed_choices : Type -> Type
clear_displayed_choices ui = {ui | displayed_choices = []}
+
+set_field_content : String -> Type -> Type
+set_field_content value ui = {ui | field_content = value}
+
+get_field_content : Type -> String
+get_field_content ui = ui.field_content
diff --git a/src/Tonkadur/Compute.elm b/src/Tonkadur/Compute.elm
index a75ef7c..182d812 100644
--- a/src/Tonkadur/Compute.elm
+++ b/src/Tonkadur/Compute.elm
@@ -1,6 +1,7 @@
module Tonkadur.Compute exposing (compute)
-- Elm -------------------------------------------------------------------------
+import Debug
import Dict
import List
@@ -61,6 +62,20 @@ unsupported_cast from to =
("Unsupported cast from " ++ from ++ " to " ++ to ++ ".")
)
+unsupported_cast_with_hint : String -> String -> String -> Tonkadur.Types.Value
+unsupported_cast_with_hint from to hint =
+ (Tonkadur.Types.StringValue
+ (
+ "Unsupported cast from "
+ ++ from
+ ++ " to "
+ ++ to
+ ++ " (original value was \""
+ ++ hint
+ ++ "\")"
+ )
+ )
+
cast : (
Tonkadur.Types.State ->
String ->
@@ -69,7 +84,8 @@ cast : (
Tonkadur.Types.Value
)
cast state from to param =
- case (compute state param) of
+ let original_value = (compute state param) in
+ case original_value of
(Tonkadur.Types.BoolValue bool) ->
case to of
"string" ->
@@ -85,7 +101,14 @@ cast state from to param =
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText "false"))
"bool" -> (Tonkadur.Types.BoolValue bool)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.FloatValue float) ->
case to of
@@ -97,7 +120,14 @@ cast state from to param =
"int" -> (Tonkadur.Types.IntValue (floor float))
"float" -> (Tonkadur.Types.FloatValue float)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.IntValue int) ->
case to of
@@ -110,7 +140,14 @@ cast state from to param =
"float" -> (Tonkadur.Types.FloatValue (toFloat int))
"bool" -> (Tonkadur.Types.BoolValue (not (int == 0)))
"int" -> (Tonkadur.Types.IntValue int)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.TextValue text_v) ->
let
@@ -123,12 +160,12 @@ cast state from to param =
"string" -> (Tonkadur.Types.StringValue as_string)
"float" ->
case (String.toFloat as_string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to as_string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt as_string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to as_string)
(Just result) -> (Tonkadur.Types.IntValue result)
"bool" ->
@@ -137,19 +174,26 @@ cast state from to param =
)
"text" -> (Tonkadur.Types.TextValue text_v)
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
(Tonkadur.Types.StringValue string) ->
case to of
"string" -> (Tonkadur.Types.StringValue string)
"float" ->
case (String.toFloat string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt string) of
- Nothing -> (unsupported_cast from to)
+ Nothing -> (unsupported_cast_with_hint from to string)
(Just result) -> (Tonkadur.Types.IntValue result)
"bool" ->
@@ -160,9 +204,23 @@ cast state from to param =
"text" ->
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText string))
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
- _ -> (unsupported_cast from to)
+ _ ->
+ (Debug.log
+ (
+ "Failed cast: "
+ ++ (Tonkadur.Types.debug_value_to_string original_value)
+ )
+ (unsupported_cast from to)
+ )
constant : (
Tonkadur.Types.State ->
@@ -175,17 +233,19 @@ constant state target_type as_string =
"string" -> (Tonkadur.Types.StringValue as_string)
"float" ->
case (String.toFloat as_string) of
- Nothing -> (unsupported_cast as_string target_type)
+ Nothing -> (unsupported_cast_with_hint as_string target_type as_string)
(Just result) -> (Tonkadur.Types.FloatValue result)
"int" ->
case (String.toInt as_string) of
- Nothing -> (unsupported_cast as_string target_type)
+ Nothing -> (unsupported_cast_with_hint as_string target_type as_string)
(Just result) -> (Tonkadur.Types.IntValue result)
"text" ->
(Tonkadur.Types.TextValue (Tonkadur.Types.StringText as_string))
+ "bool" -> (Tonkadur.Types.BoolValue (as_string == "true"))
+
_ -> (unsupported_cast as_string target_type)
extra_computation : (
@@ -389,7 +449,7 @@ relative_address state base extra =
(Tonkadur.Types.PointerValue
(List.append
(Tonkadur.Types.value_to_address (compute state base))
- (Tonkadur.Types.value_to_address (compute state extra))
+ [Tonkadur.Types.value_to_string (compute state extra)]
)
)
@@ -400,7 +460,9 @@ size : (
)
size state computation =
(Tonkadur.Types.IntValue
- (Dict.size (Tonkadur.Types.value_to_dict (compute state computation)))
+ (Dict.size
+ (Tonkadur.Types.value_to_dict (value_of state computation))
+ )
)
@@ -436,8 +498,16 @@ value_of state computation =
case (Dict.get next_step (Tonkadur.Types.value_to_dict object)) of
(Just value) -> value
Nothing ->
- (Tonkadur.Types.StringValue
- "Segmentation Fault (incorrect address)"
+ (Debug.log
+ (
+ "No "
+ ++ next_step
+ ++ " in "
+ ++ (Tonkadur.Types.debug_value_to_string object)
+ )
+ (Tonkadur.Types.StringValue
+ "Segmentation Fault (incorrect address)"
+ )
)
)
(Tonkadur.Types.StructureValue state.memory)
diff --git a/src/Tonkadur/Execute.elm b/src/Tonkadur/Execute.elm
index a65df88..865687b 100644
--- a/src/Tonkadur/Execute.elm
+++ b/src/Tonkadur/Execute.elm
@@ -273,7 +273,7 @@ set_random : (
Tonkadur.Types.State ->
Tonkadur.Types.State
)
-set_random address min max state =
+set_random min max address state =
let
(value, next_random_seed) =
(Random.step
@@ -378,8 +378,8 @@ execute instruction state =
(increment_program_counter (resolve_choice new_state))
(Tonkadur.Types.SetPC value) -> (set_pc value new_state)
- (Tonkadur.Types.SetRandom address min max) ->
- (increment_program_counter (set_random address min max new_state))
+ (Tonkadur.Types.SetRandom min max address) ->
+ (increment_program_counter (set_random min max address new_state))
(Tonkadur.Types.SetValue address value) ->
(increment_program_counter (set_value address value new_state))
diff --git a/src/Tonkadur/Json.elm b/src/Tonkadur/Json.elm
index d7ae3b3..fbdbcfe 100644
--- a/src/Tonkadur/Json.elm
+++ b/src/Tonkadur/Json.elm
@@ -53,7 +53,7 @@ specific_computation_decoder name =
(\from to value -> (Tonkadur.Types.Cast from to value))
(Json.Decode.field "from" (Json.Decode.string))
(Json.Decode.field "to" (Json.Decode.string))
- (Json.Decode.field "content" (computation_decoder))
+ (Json.Decode.field "value" (computation_decoder))
)
"constant" ->
@@ -357,7 +357,7 @@ sequences_decoder =
(Json.Decode.map2
(\name line -> (name, line))
(Json.Decode.field "name" (Json.Decode.string))
- (Json.Decode.field "value" (Json.Decode.int))
+ (Json.Decode.field "line" (Json.Decode.int))
)
)
)
diff --git a/src/Tonkadur/Types.elm b/src/Tonkadur/Types.elm
index 2a4df76..7b10e40 100644
--- a/src/Tonkadur/Types.elm
+++ b/src/Tonkadur/Types.elm
@@ -135,26 +135,42 @@ value_to_bool : Value -> Bool
value_to_bool value =
case value of
(BoolValue result) -> result
- _ -> False
+ _ ->
+ (Debug.log
+ ("Can't value_to_bool " ++ (debug_value_to_string value))
+ False
+ )
value_to_float : Value -> Float
value_to_float value =
case value of
(FloatValue result) -> result
- _ -> 0.0
+ _ ->
+ (Debug.log
+ ("Can't value_to_float " ++ (debug_value_to_string value))
+ 0.0
+ )
value_to_int : Value -> Int
value_to_int value =
case value of
(IntValue result) -> result
- _ -> 0
+ _ ->
+ (Debug.log
+ ("Can't value_to_int " ++ (debug_value_to_string value))
+ 0
+ )
value_to_text_or_string : Value -> RichText
value_to_text_or_string value =
case value of
(TextValue result) -> result
(StringValue string) -> (StringText string)
- _ -> (StringText "")
+ _ ->
+ (Debug.log
+ ("Can't value_to_text_or_string" ++ (debug_value_to_string value))
+ (StringText "")
+ )
value_to_string : Value -> String
value_to_string value =
@@ -175,18 +191,93 @@ value_to_string value =
_ -> "Cannot turn this value into string without cast."
+debug_value_to_string : Value -> String
+debug_value_to_string value =
+ case value of
+ (StringValue result) -> result
+ (TextValue text) ->
+ case text of
+ (StringText result) -> result
+ (AugmentedText rich_text) ->
+ (String.concat
+ (List.map
+ (\text_value -> (value_to_string (TextValue text_value)))
+ rich_text.content
+ )
+ )
+
+ NewlineText -> "\n"
+ (BoolValue bool) ->
+ if (bool)
+ then "true"
+ else "false"
+
+ (FloatValue float) -> (String.fromFloat float)
+ (IntValue int) -> (String.fromInt int)
+ (ListValue dict) ->
+ (
+ "["
+ ++
+ (String.join
+ ", "
+ (List.map
+ (\(key, val) ->
+ (
+ key
+ ++ ": "
+ ++ (debug_value_to_string val)
+ )
+ )
+ (Dict.toList dict)
+ )
+ )
+ ++
+ "]"
+ )
+
+ (PointerValue list) -> ("(addr [" ++ (String.join ", " list) ++ "])")
+ (StructureValue dict) ->
+ (
+ "["
+ ++
+ (String.join
+ ", "
+ (List.map
+ (\(key, val) ->
+ (
+ key
+ ++ ": "
+ ++ (debug_value_to_string val)
+ )
+ )
+ (Dict.toList dict)
+ )
+ )
+ ++
+ "]"
+ )
+
+
value_to_dict : Value -> (Dict.Dict String Value)
value_to_dict value =
case value of
(StructureValue dict) -> dict
(ListValue dict) -> dict
- _ -> (Dict.empty)
+ _ ->
+ (Debug.log
+ ("Can't value_to_dict" ++ (debug_value_to_string value))
+ (Dict.empty)
+ )
value_to_address : Value -> (List String)
value_to_address value =
case value of
(PointerValue result) -> result
- _ -> []
+ _ ->
+ (Debug.log
+ ("Can't value_to_adress " ++ (debug_value_to_string value))
+ []
+ )
no_text_effect : String
no_text_effect = ""
@@ -271,6 +362,7 @@ maybe_get_default_primitive type_name =
"string" -> (Just (StringValue ""))
"list" -> (Just (ListValue (Dict.empty)))
"ptr" -> (Just (PointerValue []))
+ "wild dict" -> (Just (StructureValue (Dict.empty)))
_ -> Nothing
apply_at_address : (
diff --git a/src/Update/Story.elm b/src/Update/Story.elm
index 708f5a9..173d7b3 100644
--- a/src/Update/Story.elm
+++ b/src/Update/Story.elm
@@ -2,9 +2,7 @@ module Update.Story exposing
(
start,
select_choice,
- input_string,
- input_integer,
- input_command
+ handle_prompt_input
)
-- Elm -------------------------------------------------------------------------
@@ -63,7 +61,10 @@ step model =
(Struct.UI.prompt_command
(Tonkadur.Types.value_to_int min)
(Tonkadur.Types.value_to_int max)
- model.ui
+ (Struct.UI.display_text
+ (Util.TonkadurToHtml.convert label)
+ model.ui
+ )
)
}
@@ -74,7 +75,10 @@ step model =
(Struct.UI.prompt_float
(Tonkadur.Types.value_to_float min)
(Tonkadur.Types.value_to_float max)
- model.ui
+ (Struct.UI.display_text
+ (Util.TonkadurToHtml.convert label)
+ model.ui
+ )
)
}
@@ -85,7 +89,10 @@ step model =
(Struct.UI.prompt_integer
(Tonkadur.Types.value_to_int min)
(Tonkadur.Types.value_to_int max)
- model.ui
+ (Struct.UI.display_text
+ (Util.TonkadurToHtml.convert label)
+ model.ui
+ )
)
}
@@ -96,7 +103,10 @@ step model =
(Struct.UI.prompt_string
(Tonkadur.Types.value_to_int min)
(Tonkadur.Types.value_to_int max)
- model.ui
+ (Struct.UI.display_text
+ (Util.TonkadurToHtml.convert label)
+ model.ui
+ )
)
}
@@ -155,26 +165,6 @@ step model =
-- _ -> model
---------------------------------------------------------------------------------
--- EXPORTED --------------------------------------------------------------------
---------------------------------------------------------------------------------
-start : Struct.Model.Type -> Struct.Model.Type
-start model = (step model)
-
-select_choice : Int -> Struct.Model.Type -> Struct.Model.Type
-select_choice ix model =
- (step
- {model |
- tonkadur =
- (Tonkadur.Types.clear_all_options
- (Tonkadur.Types.set_last_choice_index
- ix
- model.tonkadur
- )
- )
- }
- )
-
input_string : String -> Struct.Model.Type -> Struct.Model.Type
input_string string model =
let string_length = (String.length string) in
@@ -310,3 +300,38 @@ input_command string model =
)
}
)
+
+--------------------------------------------------------------------------------
+-- EXPORTED --------------------------------------------------------------------
+--------------------------------------------------------------------------------
+start : Struct.Model.Type -> Struct.Model.Type
+start model = (step model)
+
+select_choice : Int -> Struct.Model.Type -> Struct.Model.Type
+select_choice ix model =
+ (step
+ {model |
+ tonkadur =
+ (Tonkadur.Types.clear_all_options
+ (Tonkadur.Types.set_last_choice_index
+ ix
+ model.tonkadur
+ )
+ ),
+ ui = (Struct.UI.clear_prompt model.ui)
+ }
+ )
+
+handle_prompt_input : Struct.Model.Type -> Struct.Model.Type
+handle_prompt_input model =
+ case model.ui.input of
+ Struct.UI.NoInput -> model
+ Struct.UI.FloatInput -> (input_float (Struct.UI.get_field_content model.ui) model)
+ Struct.UI.IntegerInput ->
+ (input_integer (Struct.UI.get_field_content model.ui) model)
+ Struct.UI.StringInput ->
+ (input_string (Struct.UI.get_field_content model.ui) model)
+
+ Struct.UI.CommandInput ->
+ (input_command (Struct.UI.get_field_content model.ui) model)
+
diff --git a/src/View/PlayerInput.elm b/src/View/PlayerInput.elm
index e8004f4..da3162c 100644
--- a/src/View/PlayerInput.elm
+++ b/src/View/PlayerInput.elm
@@ -71,9 +71,18 @@ get_html model =
),
(Html.Attributes.max
(String.fromFloat model.ui.max_float)
- )
+ ),
+ (Html.Events.onInput (Struct.Event.UserInputInProgress))
+ ]
+ [
]
+ ),
+ (Html.button
[
+ (Html.Events.onClick (Struct.Event.UserInputValidated))
+ ]
+ [
+ (Html.text "OK")
]
)
]
@@ -105,9 +114,18 @@ get_html model =
[
(Html.Attributes.class "tonkadur-input-field"),
(Html.Attributes.min (String.fromInt model.ui.min)),
- (Html.Attributes.max (String.fromInt model.ui.max))
+ (Html.Attributes.max (String.fromInt model.ui.max)),
+ (Html.Events.onInput (Struct.Event.UserInputInProgress))
+ ]
+ [
+ ]
+ ),
+ (Html.button
+ [
+ (Html.Events.onClick (Struct.Event.UserInputValidated))
]
[
+ (Html.text "OK")
]
)
]
@@ -139,9 +157,18 @@ get_html model =
[
(Html.Attributes.class "tonkadur-input-field"),
(Html.Attributes.minlength model.ui.min),
- (Html.Attributes.maxlength model.ui.max)
+ (Html.Attributes.maxlength model.ui.max),
+ (Html.Events.onInput (Struct.Event.UserInputInProgress))
+ ]
+ [
+ ]
+ ),
+ (Html.button
+ [
+ (Html.Events.onClick (Struct.Event.UserInputValidated))
]
[
+ (Html.text "OK")
]
)
]
@@ -174,9 +201,18 @@ get_html model =
[
(Html.Attributes.class "tonkadur-input-field"),
(Html.Attributes.minlength model.ui.min),
- (Html.Attributes.maxlength model.ui.max)
+ (Html.Attributes.maxlength model.ui.max),
+ (Html.Events.onInput (Struct.Event.UserInputInProgress))
+ ]
+ [
+ ]
+ ),
+ (Html.button
+ [
+ (Html.Events.onClick (Struct.Event.UserInputValidated))
]
[
+ (Html.text "OK")
]
)
]
diff --git a/www/style.css b/www/style.css
new file mode 100644
index 0000000..dd2c124
--- /dev/null
+++ b/www/style.css
@@ -0,0 +1,4 @@
+.tonkadur-value
+{
+ display: inline;
+}