TGen_Prototype

diff --git a/bin/templates/hints_acidobazic_acid.html b/bin/templates/hints_acidobazic_acid.html new file mode 100644 index 0000000..a707c6d --- /dev/null +++ b/bin/templates/hints_acidobazic_acid.html @@ -0,0 +1,45 @@ +

+ Definice pH: +

+ ZÃ¡kladnÃ vztah pro koncentraci kationÅ¯ H3O, nenÃ-li uvaÅ¾ovÃ¡n vliv autoprotolÃ½zy nebo Ãºbytku disociacÃ: +

+ +

+ V nÄkterÃ½ch pÅÃpadech je nutnÃ© do zÃ¡kladnÃho vztahu pro vÃ½poÄet koncentrace H3O pÅidat korekce na vliv autoprotolÃ½zy Äi Ãºbytku disociacÃ. ExistujÃ vztahy, z nichÅ¾ mÅ¯Å¾eme urÄit, kdy je nutnÃ© kterÃ½ vliv uvaÅ¾ovat. +

+ Je-li splnÄna tato rovnice, lze zanedbat vliv autoprotolÃ½zy: +

OvÄÅenÃ zanedbÃ¡nÃ autoprotolÃ½zy - vztah

+ Je-li splnÄna tato rovnice, lze zanedbat vliv Ãºbytku disociacÃ: +

+ +

+ Vztah pro koncentraci H3O , je-li uvaÅ¾ovÃ¡na autoprotolÃ½za: +

Vztah pro koncentraci H3O+ s autoprotolÃ½zou

+ Vztah pro koncentraci H3O , je-li uvaÅ¾ovÃ¡n Ãºbytek disociacÃ: +

Vztah pro koncentraci H3O+ s Ãºbyktem disociacÃ

+ +

+ GrafickÃ© znÃ¡zornÄnÃ oblastÃ, kde je tÅeba uvaÅ¾ovat autoprotolÃ½zu a Ãºbytek disociacÃ: +

+ diff --git a/bin/templates/hints_acidobazic_base.html b/bin/templates/hints_acidobazic_base.html new file mode 100644 index 0000000..98d695d --- /dev/null +++ b/bin/templates/hints_acidobazic_base.html @@ -0,0 +1,44 @@ +

+ Definice pOH: +

+ ZÃ¡kladnÃ vztah pro koncentraci aniontÅ¯ -OH, nenÃ-li uvaÅ¾ovÃ¡n vliv autoprotolÃ½zy nebo Ãºbytku disociacÃ: +

+ +

+ V nÄkterÃ½ch pÅÃpadech je nutnÃ© do zÃ¡kladnÃho vztahu pro vÃ½poÄet koncentrace -OH, pÅidat korekce na vliv autoprotolÃ½zy Äi Ãºbytku disociacÃ. ExistujÃ vztahy, z nichÅ¾ mÅ¯Å¾eme urÄit, kdy je nutnÃ© kterÃ½ vliv uvaÅ¾ovat. +

+ Je-li splnÄna tato rovnice, lze zanedbat vliv autoprotolÃ½zy: +

+ Je-li splnÄna tato rovnice, lze zanedbat vliv Ãºbytku disociacÃ: +

+ +

+ Vztah pro koncentraci -OH, je-li uvaÅ¾ovÃ¡na autoprotolÃ½za: +

Vztah pro koncentraci -OH s autoprotolÃ½zou

+ Vztah pro koncentraci -OH, je-li uvaÅ¾ovÃ¡n Ãºbytek disociacÃ: +

Vztah pro koncentraci -OH s Ãºbyktem disociacÃ

+ +

diff --git a/src/face_generators/face_generator.adb b/src/face_generators/face_generator.adb new file mode 100644 index 0000000..6790ad8 --- /dev/null +++ b/src/face_generators/face_generator.adb @@ -0,0 +1,130 @@ +with AWS.Templates; + +package body Face_Generator is + + function Generate_Index_Face(HTML: out HTML_Code) return Boolean is + use AWS.Templates; + Temp: HTML_Code; + Translations_Hdr: Translate_Set; + begin + Insert(Translations_Hdr, Assoc(HEADER_CAPTION_KEY, "...")); + Temp := Parse(Filename => "templates/header.html", Translations => Translations_Hdr, Cached => True); + Append_HTML(Source => HTML, New_Item => Temp); + + Temp := Parse(Filename => "templates/face_index.html", Cached => True); + Append_HTML(Source => HTML, New_Item => Temp); + + Temp := Parse(Filename => "templates/footer.html", Cached => True); + Append_HTML(Source => HTML, New_Item => Temp); + return True; + end Generate_Index_Face; + + function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Parameters: + in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean is + begin + return Generate_Face_With_Answer(Assignment => Assignment, Parameters => Parameters, HTML => HTML, + Answer_Message => To_UB_Text(""), Answer_Code => Problem_Generator_Syswides.Invalid_Answer); + end Generate_Face; + + function Generate_Face_With_Answer(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; + Answer_Message: in UB_Text; + Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean is + use Problem_Generator_Syswides; + use Problem_Generator_Syswides.Assignment_Info; + + begin + if Assignment.Find(PROBLEM_TYPE_KEY) = Assignment_Info.No_Element then + return False; + end if; + + declare + Problem_Type_Str: constant String := Assignment.Element(PROBLEM_TYPE_KEY); + begin + if Problem_Type_Str = Problem_Type'Image(Acidobazic) then + return Generate_Face_Acidobazic(Assignment, Answer_Message, Answer_Code, Parameters, HTML); + else + return False; + end if; + end; + end Generate_Face_With_Answer; + + -- BEGIN: Private functions + function Generate_Face_Acidobazic(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; + Answer_Message: in UB_Text; + Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean is + use AWS.Templates; + use Problem_Generator_Syswides; + use Problem_Generator_Syswides.Assignment_Info; + use Problem_Generator_Syswides.Parameters_Info; + + Translations_Answer: Translate_Set; + Translations_Hdr: Translate_Set; + Translations: Translate_Set; + Temp: HTML_Code; + begin + Insert(Translations_Hdr, Assoc(HEADER_CAPTION_KEY, "< " & Acidobazic_Suite.PROBLEM_NAME_READABLE)); + Insert(Translations_Hdr, Assoc(META_EXPIRE_NOW_KEY, META_EXPIRE_NOW_TEXT)); + Insert(Translations_Hdr, Assoc(META_NO_CACHE_KEY, META_NO_CACHE_TEXT)); + HTML := Parse(Filename => "templates/header.html", Translations => Translations_Hdr); + -- Add JavaScripts + Temp := Parse(Filename => "scripts/expand_collapse.js", Cached => True); + Append_HTML(Source => HTML, New_Item => Temp); + + Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_INT_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_INT_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_DEC_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_DEC_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.CONCENTRATION_EXP_KEY, Assignment.Element(Acidobazic_Suite.CONCENTRATION_EXP_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.PKX_KEY, Assignment.Element(Acidobazic_Suite.PKX_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.PKX_VALUE_INT_KEY, Assignment.Element(Acidobazic_Suite.PKX_VALUE_INT_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.PKX_VALUE_DEC_KEY, Assignment.Element(Acidobazic_Suite.PKX_VALUE_DEC_KEY))); + Insert(Translations, Assoc(Acidobazic_Suite.SUBSTANCE_KEY, Assignment.Element(Acidobazic_Suite.SUBSTANCE_KEY))); + Insert(Translations, Assoc("ANSWER_PH", Acidobazic_Suite.ANSWER_PH_KEY)); + Insert(Translations, Assoc("ANSWER_SIMPLIFICATION", Acidobazic_Suite.ANSWER_SIMPLIFICATION_KEY)); + Insert(Translations, Assoc("ANSWER_OPTION_SIMPL_ATPR", Acidobazic_Suite.Simplification'Image(Acidobazic_Suite.Autoprotolysis))); + Insert(Translations, Assoc("ANSWER_OPTION_SIMPL_BOTH", Acidobazic_Suite.Simplification'Image(Acidobazic_Suite.Both))); + Insert(Translations, Assoc("ANSWER_OPTION_SIMPL_DISSOC", Acidobazic_Suite.Simplification'Image(Acidobazic_Suite.Dissociation))); + Insert(Translations, Assoc("PARAMETER_NO_BOTH_SIMPLIFICATIONS", Acidobazic_Suite.PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY)); + if Parameters.Find(Acidobazic_Suite.PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY) = Parameters_Info.No_Element then + Insert(Translations, Assoc("PARAMETER_NO_BOTH_SIMPLIFICATIONS_CHECKED", "")); + else + Insert(Translations, Assoc("PARAMETER_NO_BOTH_SIMPLIFICATIONS_CHECKED", "checked")); + end if; + + case Answer_Code is + when Correct_Answer => + Insert(Translations_Answer, Assoc(ANSWER_KIND_KEY, ANSWER_KIND_GOOD)); + Insert(Translations_Answer, Assoc(ANSWER_MESSAGE_KEY, UB_Text_To_Fixed_String(Answer_Message))); + Temp := Parse(Filename => "templates/answer_section.html", Translations => Translations_Answer); + Insert(Translations, Assoc(ANSWER_SECTION_KEY, HTML_To_Fixed_String(Temp))); + when Wrong_Answer | Malformed_Answer => + Insert(Translations_Answer, Assoc(ANSWER_KIND_KEY, ANSWER_KIND_BAD)); + Insert(Translations_Answer, Assoc(ANSWER_MESSAGE_KEY, UB_Text_To_Fixed_String(Answer_Message))); + Temp := Parse(Filename => "templates/answer_section.html", Translations => Translations_Answer); + Insert(Translations, Assoc(ANSWER_SECTION_KEY, HTML_To_Fixed_String(Temp))); + when others => + Insert(Translations, Assoc(ANSWER_SECTION_KEY, "")); + end case; + + -- Generate hints + if Assignment.Element(Acidobazic_Suite.PKX_KEY) = Acidobazic_Suite.PKX_PKA_TEXT then + Temp := Parse(Filename => "templates/hints_acidobazic_acid.html", Cached => True); + Insert(Translations, Assoc(HINTS_SECTION_KEY, Temp)); + elsif Assignment.Element(Acidobazic_Suite.PKX_KEY) = Acidobazic_Suite.PKX_PKB_TEXT then + Temp := Parse(Filename => "templates/hints_acidobazic_base.html", Cached => True); + Insert(Translations, Assoc(HINTS_SECTION_KEY, Temp)); + end if; + + Temp := Parse(Filename => "templates/face_acidobazic.html", Translations => Translations); + Append_HTML(Source => HTML, New_Item => Temp); + + + Temp := Parse(Filename => "templates/footer.html"); + Append_HTML(Source => HTML, New_Item => Temp); + + return True; + end Generate_Face_Acidobazic; +end Face_Generator; diff --git a/src/face_generators/face_generator.ads b/src/face_generators/face_generator.ads new file mode 100644 index 0000000..3a26435 --- /dev/null +++ b/src/face_generators/face_generator.ads @@ -0,0 +1,32 @@ +with Global_Types; +with Problem_Generator_Syswides; + +use Global_Types; +package Face_Generator is + function Generate_Index_Face(HTML: out HTML_Code) return Boolean; + + function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean; + + function Generate_Face_With_Answer(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; + Answer_Message: in UB_Text; + Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean; + +private + function Generate_Face_Acidobazic(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; + Answer_Message: in UB_Text; + Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean; + + HEADER_CAPTION_KEY: constant String := "HEADER_CAPTION"; + HINTS_SECTION_KEY: constant String := "HINTS_SECTION"; + META_EXPIRE_NOW_KEY: constant String := "META_EXPIRE_NOW"; + META_EXPIRE_NOW_TEXT: constant String := ""; + META_NO_CACHE_KEY: constant String := "META_NO_CACHE"; + META_NO_CACHE_TEXT: constant String := ""; + +end Face_Generator; diff --git a/src/formatting_helpers.adb b/src/formatting_helpers.adb new file mode 100644 index 0000000..313032f --- /dev/null +++ b/src/formatting_helpers.adb @@ -0,0 +1,75 @@ +with Ada.Numerics.Generic_Elementary_Functions; +with Ada.Strings.Fixed; +--with Ada.Text_IO; + +package body Formatting_Helpers is + + function Round_To_Valid_Nums(Num: in FH_Float; Decimals: in FH_Float) return FH_Float is + package FHEF is new Ada.Numerics.Generic_Elementary_Functions(FH_Float); + use FHEF; + + F_Log_Num: constant FH_Float := FH_Float'Floor(FHEF.Log(Base => 10.0, X => Num)); + F_Log_Dec: constant FH_Float := FH_Float'Floor(FHEF.Log(Base => 10.0, X => Decimals)); + Shift: FH_Float; + TNum: FH_Float; + begin + Shift := 10.0 ** (F_Log_Num - F_Log_Dec); + TNum := FH_Float'Rounding(Num / Shift) * Shift; + + --Ada.Text_IO.Put_Line("FLN: " & FH_Float'Image(F_Log_Num) & " FLD: " & FH_Float'Image(F_Log_Dec) & " S: " & FH_Float'Image(Shift) & " Res: " & FH_Float'Image(TNum)); + return TNum; + end Round_To_Valid_Nums; + + procedure Split_Integer_Decimal_Strs(Num: in FH_Float; Decimals: in FH_Float; Integer_Part: out UB_Text; Decimal_Part: out UB_Text) is + I: Integer; + D: Integer; + begin + Split_Integer_Decimal_Ints(Num, Decimals, I, D); + + Integer_Part := To_UB_Text(Integer'Image(I)); + Get_Decimal_Part_Str(Decimal_Part, D, Decimals); + + --Ada.Text_IO.Put_Line("I: " & Integer'Image(I) & " D: " & Integer'Image(D) & " Num: " & FH_Float'Image(Num)); + end Split_Integer_Decimal_Strs; + + procedure Split_Integer_Decimal_Exponent_Strs(Num: in FH_Float; Decimals: in FH_Float; Integer_Part: out UB_Text; Decimal_Part: out UB_Text; + Exponent_Part: out UB_Text) is + package FHEF is new Ada.Numerics.Generic_Elementary_Functions(FH_Float); + use FHEF; + + FE: FH_Float; + TNum: FH_Float; + begin + --Ada.Text_IO.Put_Line("Num: " & FH_Float'Image(Num)); + FE := FH_Float'Floor(FHEF.Log(Base => 10.0, X => Num)); + --Ada.Text_IO.Put_Line("Exp: " & FH_Float'Image(FE)); + TNum := Num / (10.0 ** FE); + + Split_Integer_Decimal_Strs(TNum, Decimals, Integer_Part, Decimal_Part); + Append_UB_Text(Exponent_Part, To_UB_Text(Integer'Image(Integer(FE)))); + + end Split_Integer_Decimal_Exponent_Strs; + + -- BEGIN: Private functions + procedure Get_Decimal_Part_Str(Decimal_Part: out UB_Text; D: in Integer; Decimals: in FH_Float) is + Pos: Integer := Integer(Decimals) / 10; + begin + while Pos > 1 loop + if D < Pos then + Append_UB_Text(Decimal_Part, To_UB_Text("0")); + else + exit; + end if; + Pos := Pos / 10; + end loop; + + Append_UB_Text(Decimal_Part, To_UB_Text(Ada.Strings.Fixed.Trim(Integer'Image(D), Ada.Strings.Left))); + end Get_Decimal_Part_Str; + + procedure Split_Integer_Decimal_Ints(Num: in FH_Float; Decimals: in FH_Float; I: out Integer; D: out Integer) is + begin + I := Integer(FH_Float'Floor(Num)); + D := Integer(FH_Float'Rounding((Num - FH_Float(I)) * Decimals)); + end Split_Integer_Decimal_Ints; + +end Formatting_Helpers; diff --git a/src/formatting_helpers.ads b/src/formatting_helpers.ads new file mode 100644 index 0000000..ba0128d --- /dev/null +++ b/src/formatting_helpers.ads @@ -0,0 +1,17 @@ +with Global_Types; + +use Global_Types; +generic +type FH_Float is digits <>; +package Formatting_Helpers is + + function Round_To_Valid_Nums(Num: in FH_Float; Decimals: FH_Float) return FH_Float; + procedure Split_Integer_Decimal_Strs(Num: in FH_Float; Decimals: in FH_Float; Integer_Part: out UB_Text; Decimal_Part: out UB_Text); + procedure Split_Integer_Decimal_Exponent_Strs(Num: in FH_Float; Decimals: in FH_Float; Integer_Part: out UB_Text; Decimal_Part: out UB_Text; + Exponent_Part: out UB_Text); + +private + procedure Get_Decimal_Part_Str(Decimal_Part: out UB_Text; D: Integer; Decimals: in FH_Float); + procedure Split_Integer_Decimal_Ints(Num: in FH_Float; Decimals: in FH_Float; I: out Integer; D: out Integer); + +end Formatting_Helpers; diff --git a/src/global_types.adb b/src/global_types.adb new file mode 100644 index 0000000..ab6ccba --- /dev/null +++ b/src/global_types.adb @@ -0,0 +1,33 @@ +package body Global_Types is + + procedure Append_HTML(Source: in out HTML_Code; New_Item: in HTML_Code) is + begin + Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item); + end Append_HTML; + + procedure Append_UB_Text(Source: in out UB_Text; New_Item: in UB_Text) is + begin + Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item); + end Append_UB_Text; + + function HTML_To_Fixed_String(HTML: in HTML_Code) return String is + begin + return Ada.Strings.Unbounded.To_String(HTML); + end HTML_To_Fixed_String; + + function To_HTML_Code(S: in String) return HTML_Code is + begin + return Ada.Strings.Unbounded.To_Unbounded_String(S); + end To_HTML_Code; + + function To_UB_Text(S: in String) return UB_Text is + begin + return Ada.Strings.Unbounded.To_Unbounded_String(S); + end To_UB_Text; + + function UB_Text_To_Fixed_String(Text: in UB_Text) return String is + begin + return Ada.Strings.Unbounded.To_String(Text); + end UB_Text_To_Fixed_String; + +end Global_Types; diff --git a/src/global_types.ads b/src/global_types.ads new file mode 100644 index 0000000..6d18c20 --- /dev/null +++ b/src/global_types.ads @@ -0,0 +1,17 @@ +with Ada.Containers; +with Ada.Strings.Unbounded; + +package Global_Types is + + subtype Unique_ID is Ada.Containers.Count_Type; + subtype HTML_Code is Ada.Strings.Unbounded.Unbounded_String; + subtype UB_Text is Ada.Strings.Unbounded.Unbounded_String; + + procedure Append_HTML(Source: in out HTML_Code; New_Item: in HTML_Code); + procedure Append_UB_Text(Source: in out UB_Text; New_Item: in UB_Text); + function HTML_To_Fixed_String(HTML: in HTML_Code) return String; + function To_HTML_Code(S: in String) return HTML_Code; + function To_UB_Text(S: in String) return UB_Text; + function UB_Text_To_Fixed_String(Text: in UB_Text) return String; + +end Global_Types; diff --git a/src/handlers/handler_check_answer.adb b/src/handlers/handler_check_answer.adb new file mode 100644 index 0000000..af41bb8 --- /dev/null +++ b/src/handlers/handler_check_answer.adb @@ -0,0 +1,74 @@ +with AWS.Containers.Tables; +with AWS.Messages; +with AWS.MIME; +with AWS.Parameters; +with AWS.Response; +with AWS.Session; +with AWS.Status; + +with Global_Types; +with Problem_Manager; +with Problem_Generator_Syswides; + +with Ada.Text_IO; + +use Global_Types; +package body Handler_Check_Answer is + + function Handle(Request: AWS.Status.Data) return AWS.Response.Data is + SID: constant AWS.Session.ID := AWS.Status.Session(Request); + Req_Type: constant AWS.Status.Request_Method := AWS.Status.Method(Request); + + Raw_UID: constant String := AWS.Session.Get(SID, "UID"); + UID: Unique_ID; + HTML: HTML_Code; + begin + Ada.Text_IO.Put_Line("Handling /check_answer"); + + case Req_Type is + when AWS.Status.POST => + declare + use Problem_Generator_Syswides; + use Problem_Generator_Syswides.Answer_Info; + + POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request); + Answer: Answer_Info.Map; + Success: Boolean; + begin + -- Get UID + Success := Problem_Manager.Get_UID(Raw_UID, UID); + if Success = False then + -- UID could not have been registered + -- TODO: Print some sensible error message, for now just redirect to index + Ada.Text_IO.Put_Line("UID has not been registered: " & Raw_UID); + return AWS.Response.URL(Location => "/"); + end if; + + for Idx in 1 .. POST_Data.Count loop + declare + C: Answer_Info.Cursor; + E: constant AWS.Containers.Tables.Element := POST_Data.Get(Idx); + Success: Boolean; + begin + Answer.Insert(E.Name, E.Value, C, Success); + -- TODO: Handle error + end; + end loop; + + Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML); + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => HTML_To_Fixed_String(HTML), + Status_Code => AWS.Messages.S200); + end; + when others => + Ada.Text_IO.Put_Line("Invalid request"); + return AWS.Response.URL(Location => "/"); + end case; + end Handle; + + function Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Handle'Access); + end Callback; + +end Handler_Check_Answer; diff --git a/src/handlers/handler_check_answer.ads b/src/handlers/handler_check_answer.ads new file mode 100644 index 0000000..8daf92f --- /dev/null +++ b/src/handlers/handler_check_answer.ads @@ -0,0 +1,5 @@ +with AWS.Dispatchers.Callback; + +package Handler_Check_Answer is + function Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Check_Answer; diff --git a/src/handlers/handler_default.adb b/src/handlers/handler_default.adb new file mode 100644 index 0000000..f89fb29 --- /dev/null +++ b/src/handlers/handler_default.adb @@ -0,0 +1,32 @@ +with AWS.Messages; +with AWS.MIME; +with AWS.Response; +with AWS.Status; +with Face_Generator; +with Global_Types; + +use Global_Types; +package body Handler_Default is + + function Handle(Request: AWS.Status.Data) return AWS.Response.Data is + HTML: HTML_Code; + Success: Boolean; + begin + Success := Face_Generator.Generate_Index_Face(HTML); + if Success = False then + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => "Internal server error occured, we're sorry about that...", + Status_Code => AWS.Messages.S503); + else + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => HTML_To_Fixed_String(HTML), + Status_Code => AWS.Messages.S200); + end if; + end Handle; + + function Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Handle'Access); + end Callback; + +end Handler_Default; diff --git a/src/handlers/handler_default.ads b/src/handlers/handler_default.ads new file mode 100644 index 0000000..edecf1f --- /dev/null +++ b/src/handlers/handler_default.ads @@ -0,0 +1,5 @@ +with AWS.Dispatchers.Callback; + +package Handler_Default is + function Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Default; \ No newline at end of file diff --git a/src/handlers/handler_images.adb b/src/handlers/handler_images.adb new file mode 100644 index 0000000..575f545 --- /dev/null +++ b/src/handlers/handler_images.adb @@ -0,0 +1,50 @@ +with Ada.Strings.Fixed; +with AWS.Messages; +with AWS.MIME; +with AWS.Response; +with AWS.Status; +with Ada.Text_IO; + +package body Handler_Images is + + function File_Exists(Path: in String) return Boolean is + File: Ada.Text_IO.File_Type; + begin + begin + Ada.Text_IO.Open(File => File, Mode => Ada.Text_IO.In_File, Name => Path); + Ada.Text_IO.Close(File); + return True; + exception + when Ada.Text_IO.Name_Error => + return False; + end; + end File_Exists; + + function Handle(Request: AWS.Status.Data) return AWS.Response.Data is + use Ada.Strings.Fixed; + + URI: constant String := AWS.Status.URI(Request); + Idx: Positive; + begin + Idx := Index(Source => URI, Pattern => "/", From => URI'Last, Going => Ada.Strings.Backward); + declare + Image_Path: constant String := "images/" & URI(Idx + 1 .. URI'Last); + begin + if File_Exists(Image_Path) = False then + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => "", + Status_Code => AWS.Messages.S404); + else + return AWS.Response.File(Content_Type => AWS.MIME.Image_Png, + Filename => Image_Path, + Status_Code => AWS.Messages.S200); + end if; + end; + end Handle; + + function Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Handle'Access); + end Callback; + +end Handler_Images; diff --git a/src/handlers/handler_images.ads b/src/handlers/handler_images.ads new file mode 100644 index 0000000..c2b542c --- /dev/null +++ b/src/handlers/handler_images.ads @@ -0,0 +1,5 @@ +with AWS.Dispatchers.Callback; + +package Handler_Images is + function Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Images; diff --git a/src/handlers/handler_next_problem.adb b/src/handlers/handler_next_problem.adb new file mode 100644 index 0000000..18675dc --- /dev/null +++ b/src/handlers/handler_next_problem.adb @@ -0,0 +1,76 @@ +with AWS.Containers.Tables; +with AWS.Messages; +with AWS.MIME; +with AWS.Parameters; +with AWS.Response; +with AWS.Session; +with AWS.Status; + +with Global_Types; +with Problem_Generator_Syswides; +with Problem_Manager; + +use Global_Types; + +package body Handler_Next_Problem is + + function Handle(Request: AWS.Status.Data) return AWS.Response.Data is + SID: constant AWS.Session.ID := AWS.Status.Session(Request); + + HTML: HTML_Code; + Raw_UID: constant String := AWS.Session.Get(SID, "UID"); + Req_Method : constant AWS.Status.Request_Method := AWS.Status.Method(Request); + UID: Unique_ID; + begin + case Req_Method is + when AWS.Status.POST => + declare + use Problem_Generator_Syswides; + use Problem_Generator_Syswides.Parameters_Info; + + Problem_Parameters: Parameters_Info.Map; + POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request); + Success: Boolean; + begin + -- Get UID + Success := Problem_Manager.Get_UID(Raw_UID, UID); + if Success = False then + -- UID could not have been registered + -- TODO: Print some sensible error message, for now just redirect to index + return AWS.Response.URL(Location => "/"); + end if; + + -- UID OK, read problem parameters + for Idx in 1 .. POST_Data.Count loop + declare + C: Parameters_Info.Cursor; + E: constant AWS.Containers.Tables.Element := POST_Data.Get(Idx); + Success: Boolean; + begin + Problem_Parameters.Insert(E.Name, E.Value, C, Success); + -- TODO: Handle error + end; + end loop; + + -- Display new problem + Success := Problem_Manager.Display_Next_Assignment(UID, Problem_Parameters, HTML); + if Success = False then + -- TODO: Handle error in a less reckless manner + return AWS.Response.URL(Location => "/"); + end if; + + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => HTML_To_Fixed_String(HTML), + Status_Code => AWS.Messages.S200); + end; + when others => + return AWS.Response.URL(Location => "/"); + end case; + end Handle; + + function Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Handle'Access); + end Callback; + +end Handler_Next_Problem; diff --git a/src/handlers/handler_next_problem.ads b/src/handlers/handler_next_problem.ads new file mode 100644 index 0000000..77c930f --- /dev/null +++ b/src/handlers/handler_next_problem.ads @@ -0,0 +1,5 @@ +with AWS.Dispatchers.Callback; + +package Handler_Next_Problem is + function Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Next_Problem; \ No newline at end of file diff --git a/src/handlers/handler_start.adb b/src/handlers/handler_start.adb new file mode 100644 index 0000000..d4d9def --- /dev/null +++ b/src/handlers/handler_start.adb @@ -0,0 +1,78 @@ +with AWS.Messages; +with AWS.MIME; +with AWS.Response; +with AWS.Session; +with AWS.Status; +with Global_Types; +with Problem_Manager; + +--with Ada.Text_IO; + +use Global_Types; +package body Handler_Start is + + function Handle(Request: AWS.Status.Data) return AWS.Response.Data is + SID: constant AWS.Session.ID := AWS.Status.Session(Request); + Req_Type: constant AWS.Status.Request_Method := AWS.Status.Method(Request); + + Raw_UID: constant String := AWS.Session.Get(SID, "UID"); + HTML: HTML_Code; + begin + --Ada.Text_IO.Put_Line("Handling /start"); + + case Req_Type is + when AWS.Status.GET => + declare + Raw_Problem_Category: constant String := AWS.Status.Parameter(Request, "problem_category"); + P_Cat: Problem_Manager.Problem_Category; + UID: Unique_ID; + Success: Boolean; + begin + if Raw_Problem_Category = Problem_Manager.Problem_Category'Image(Problem_Manager.Acidobazic) then + P_Cat := Problem_Manager.Acidobazic; + else + return AWS.Response.URL(Location => "/"); + end if; + + -- Register new UID if necessary and create a first problem + Success := Problem_Manager.Get_UID(Raw_UID, UID); + if Success = False then + -- UID stored within this session is not valid, register a new one + Success := Problem_Manager.Register_UID(UID); + if Success = False then + -- UID could not have been registered + -- TODO: Print some sensible error message, for now just redirect to index + return AWS.Response.URL(Location => "/"); + end if; + -- Save the new UID + AWS.Session.Set(SID, "UID", Unique_ID'Image(UID)); + AWS.Session.Set_Callback(Problem_Manager.Session_Expired'Access); + end if; + + -- We're all set, create a new problem + Success := Problem_Manager.Prepare_Problem(UID, P_Cat); + if Success = False then + -- Something went wrong when generating the problem + -- TODO: Print some sensible error message, for now just redirect to index + return AWS.Response.URL(Location => "/"); + end if; + + Success := Problem_Manager.Display_New_Assignment(UID, HTML); + if Success = False then + HTML := To_HTML_Code("Cannot display assignment"); + end if; + return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, + Message_Body => HTML_To_Fixed_String(HTML), + Status_Code => AWS.Messages.S200); + end; + when others => + return AWS.Response.URL(Location => "/"); + end case; + end Handle; + + function Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Handle'Access); + end Callback; + +end Handler_Start; diff --git a/src/handlers/handler_start.ads b/src/handlers/handler_start.ads new file mode 100644 index 0000000..4a672ea --- /dev/null +++ b/src/handlers/handler_start.ads @@ -0,0 +1,5 @@ +with AWS.Dispatchers.Callback; + +package Handler_Start is + function Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Start; \ No newline at end of file diff --git a/src/handlers/handler_styles.adb b/src/handlers/handler_styles.adb new file mode 100644 index 0000000..54523df --- /dev/null +++ b/src/handlers/handler_styles.adb @@ -0,0 +1,21 @@ +with AWS.Messages; +with AWS.MIME; +with AWS.Templates; +with AWS.Response; +with AWS.Status; + +package body Handler_Styles is + + function Main_Handle(Request: AWS.Status.Data) return AWS.Response.Data is + begin + return AWS.Response.Build(Content_Type => AWS.MIME.Text_CSS, + Message_Body => AWS.Templates.Parse(Filename => "styles/main.css", Cached => True), + Status_Code => AWS.Messages.S200); + end Main_Handle; + + function Main_Callback return AWS.Dispatchers.Callback.Handler is + begin + return AWS.Dispatchers.Callback.Create(Main_Handle'Access); + end Main_Callback; + +end Handler_Styles; diff --git a/src/handlers/handler_styles.ads b/src/handlers/handler_styles.ads new file mode 100644 index 0000000..9f3b28a --- /dev/null +++ b/src/handlers/handler_styles.ads @@ -0,0 +1,6 @@ +with AWS.Dispatchers.Callback; + +package Handler_Styles is + function Main_Callback return AWS.Dispatchers.Callback.Handler; +end Handler_Styles; + diff --git a/src/handlers/handlers.adb b/src/handlers/handlers.adb new file mode 100644 index 0000000..3bf75c0 --- /dev/null +++ b/src/handlers/handlers.adb @@ -0,0 +1,27 @@ +with Handler_Check_Answer; +with Handler_Default; +with Handler_Images; +with Handler_Next_Problem; +with Handler_Start; +with Handler_Styles; + +package body Handlers is + function Get_Dispatchers return AWS.Services.Dispatchers.URI.Handler is + Handler: AWS.Services.Dispatchers.URI.Handler; + begin + Handler.Register_Default_Callback(Action => Handler_Default.Callback); + Handler.Register(URI => "/check_answer", + Action => Handler_Check_Answer.Callback); + Handler.Register(URI => "/images", + Action => Handler_Images.Callback, + Prefix => True); + Handler.Register(URI => "/next_problem", + Action => Handler_Next_Problem.Callback); + Handler.Register(URI => "/start", + Action => Handler_Start.Callback); + Handler.Register(URI => "/main_stylesheet", + Action => Handler_Styles.Main_Callback); + + return Handler; + end Get_Dispatchers; +end Handlers; diff --git a/src/handlers/handlers.ads b/src/handlers/handlers.ads new file mode 100644 index 0000000..e0b9679 --- /dev/null +++ b/src/handlers/handlers.ads @@ -0,0 +1,5 @@ +with AWS.Services.Dispatchers.URI; + +package Handlers is + function Get_Dispatchers return AWS.Services.Dispatchers.URI.Handler; +end Handlers; \ No newline at end of file diff --git a/src/nine_q.adb b/src/nine_q.adb new file mode 100644 index 0000000..a13a970 --- /dev/null +++ b/src/nine_q.adb @@ -0,0 +1,29 @@ +with Ada.Text_IO; + +with AWS.Config; +with AWS.Config.Set; +with AWS.Server; + +with Handlers; + +procedure Nine_Q is + Server_Config: AWS.Config.Object; + Web_Server: AWS.Server.HTTP; +begin + Server_Config := AWS.Config.Get_Current; + AWS.Config.Set.Session(Server_Config, True); + AWS.Config.Set.Server_Host(Server_Config, "localhost"); + AWS.Config.Set.Server_Port(Server_Config, 18400); + + AWS.Config.Set.Session_Lifetime(1800.0); + AWS.Config.Set.Session_Cleanup_Interval(900.0); + + Ada.Text_IO.Put_Line("Starting server..."); + AWS.Server.Start(Web_Server => Web_Server, + Dispatcher => Handlers.Get_Dispatchers, + Config => Server_Config); + + AWS.Server.Wait(AWS.Server.Q_Key_Pressed); + AWS.Server.Shutdown(Web_Server); + +end Nine_Q; diff --git a/src/problem_generators/problem_generator-acidobazic_suite.adb b/src/problem_generators/problem_generator-acidobazic_suite.adb new file mode 100644 index 0000000..8dba22e --- /dev/null +++ b/src/problem_generators/problem_generator-acidobazic_suite.adb @@ -0,0 +1,497 @@ +with Ada.Numerics.Discrete_Random; +with Ada.Numerics.Float_Random; +with Ada.Numerics.Generic_Elementary_Functions; +with Ada.Strings.Fixed; +--with Ada.Text_IO; +with Formatting_Helpers; + +separate(Problem_Generator) + +package body Acidobazic_Suite is + -- BEGIN: Inherited functions + function Create return access Acidobazic_Problem is + Parameters: Acidobazic_Parameters; + Problem: access Acidobazic_Problem; + begin + Problem := new Acidobazic_Problem; + + Parameters := (No_Both_Simplifications => False); + Problem.Parameters := Parameters; + + return Problem; + end Create; + + function Check_Answer(Problem: in out Acidobazic_Problem; Answer: in Answer_Info.Map; + Message: out UB_Text) return Answer_RetCode is + package FH is new Formatting_Helpers(pH_Float); + use Answer_Info; + + pH: pH_Float; + pH_Answered: pH_Float; + begin + Problem.Lock_State; + + pH := Calculate_Solution(Problem); + -- Verify answer data + if Answer.Find(ANSWER_PH_KEY) = Answer_Info.No_Element then + return Malformed_Answer; + end if; + if Answer.Find(ANSWER_SIMPLIFICATION_KEY) = Answer_Info.No_Element then + Problem.Unlock_State; + return Malformed_Answer; + end if; + + declare + pH_Answered_S: String := Answer.Element(ANSWER_PH_KEY); + Idx: Natural; + begin + -- Replace "," with "." as decimal seaprator + Idx := Ada.Strings.Fixed.Index(Source => pH_Answered_S, Pattern => ",", From => 1); + if Idx > 0 then + Ada.Strings.Fixed.Replace_Slice(Source => pH_Answered_S, Low => Idx, High => Idx, By => "."); + end if; + pH_Answered := pH_Float'Value(pH_Answered_S); + exception + when Constraint_Error => + Message := To_UB_Text("NesprÃ¡vnÄ zadanÃ¡ hodnota pH"); + Problem.Unlock_State; + return Malformed_Answer; + end; + + -- Check correctness of simplification + declare + Simplification_Str: constant String := Answer.Element(ANSWER_SIMPLIFICATION_KEY); + begin + Ada.Text_IO.Put_Line("SS : " & Simplification_Str & " SI : " & Simplification'Image(Problem.Simpl)); + if Simplification_Str /= Simplification'Image(Problem.Simpl) then + Message := To_UB_Text("NesprÃ¡vnÃ© zanedbÃ¡nÃ"); + Problem.Unlock_State; + return Wrong_Answer; + end if; + end; + + -- Check correctness of the result + pH := FH.Round_To_Valid_Nums(pH, Decimals); + pH_Answered := FH.Round_To_Valid_Nums(pH_Answered, Decimals); + + if pH_Answered - (Precision * 5.0) < pH and pH_Answered + (Precision * 5.0) > pH then + Message := To_UB_Text("SprÃ¡vnÃ¡ odpovÄÄ"); + Problem.Unlock_State; + return Correct_Answer; + else + declare + package FH is new Formatting_Helpers(pH_Float); + + Int_S: UB_Text; + Dec_S: UB_Text; + begin + FH.Split_Integer_Decimal_Strs(pH, Decimals, Int_S, Dec_S); + Message := To_UB_Text("NesprÃ¡vnÃ¡ odpovÄÄ. (pH vypoÄtenÃ© programem = "); + Append_UB_Text(Source => Message, New_Item => Int_S); + Append_UB_Text(Source => Message, New_Item => To_UB_Text(",")); + Append_UB_Text(Source => Message, New_Item => Dec_S); + Append_UB_Text(Source => Message, New_Item => To_UB_Text(")")); + Problem.Unlock_State; + return Wrong_Answer; + end; + end if; + end Check_Answer; + + function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return Boolean is + C: Assignment_Info.Cursor; + Success: Boolean; + pKx: pH_Float; + begin + Problem.Lock_State; + + Assignment.Insert(PROBLEM_TYPE_KEY, PROBLEM_TYPE_ACIDOBAZIC, C, Success); + if Success = False then + Problem.Unlock_State; + return False; + end if; + case Problem.Subst_Type is + when Acid => + Assignment.Insert(SUBSTANCE_KEY, "kyseliny", C, Success); + Assignment.Insert(PKX_KEY, PKX_PKA_TEXT, C, Success); + when Base => + Assignment.Insert(SUBSTANCE_KEY, "bÃ¡ze", C, Success); + Assignment.Insert(PKX_KEY, PKX_PKB_TEXT, C, Success); + end case; + + pKx := X_To_pX(Problem.Kx); + -- Print pKx in nn.nnn format + declare + package FH is new Formatting_Helpers(pH_Float); + + Int_S: UB_Text; + Dec_S: UB_Text; + begin + FH.Split_Integer_Decimal_Strs(pKx, Decimals, Int_S, Dec_S); + Assignment.Insert(PKX_VALUE_INT_KEY, UB_Text_To_Fixed_String(Int_S), C, Success); + Assignment.Insert(PKX_VALUE_DEC_KEY, UB_Text_To_Fixed_String(Dec_S), C, Success); + if Success = False then + Problem.Unlock_State; + return False; + end if; + end; + + -- Print concentration in N.nnn 10^n format + declare + package FH is new Formatting_Helpers(pH_Float); + + Int_S: UB_Text; + Dec_S: UB_Text; + Exp_S: UB_Text; + begin + FH.Split_Integer_Decimal_Exponent_Strs(Problem.cX, Decimals, Int_S, Dec_S, Exp_S); + Assignment.Insert(CONCENTRATION_INT_KEY, UB_Text_To_Fixed_String(Int_S), C, Success); + Assignment.Insert(CONCENTRATION_DEC_KEY, UB_Text_To_Fixed_String(Dec_S), C, Success); + Assignment.Insert(CONCENTRATION_EXP_KEY, UB_Text_To_Fixed_String(Exp_S), C, Success); + if Success = False then + Problem.Unlock_State; + return False; + end if; + end; + + Problem.Unlock_State; + return True; + end Get_Assignment; + + function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return Boolean is + C: Parameters_Info.Cursor; + Success: Boolean; + begin + Problem.Lock_State; + if Problem.Parameters.No_Both_Simplifications then + Parameters.Insert(PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY, "True", C, Success); + Problem.Unlock_State; + return Success; + end if; + Problem.Unlock_State; + return True; + end Get_Parameters; + + procedure New_Problem(Problem: in out Acidobazic_Problem) is + + package Random_Substance_Type_Gen is new Ada.Numerics.Discrete_Random(Result_Subtype => Substance_Type); + package Random_Dissoc_Type_Gen is new Ada.Numerics.Discrete_Random(Result_Subtype => Dissociation_Constant_Type); + + DCT_G: Random_Dissoc_Type_Gen.Generator; + ST_G: Random_Substance_Type_Gen.Generator; + + cX_Min: pH_Float; + cX_Max: pH_Float; + begin + Problem.Lock_State; + -- Dissociation constant type (pKa or pKb) + Random_Dissoc_Type_Gen.Reset(Gen => DCT_G); + Problem.DCT := Random_Dissoc_Type_Gen.Random(Gen => DCT_G); + + -- Substance type (acid or base) + Random_Substance_Type_Gen.Reset(Gen => ST_G); + Problem.Subst_Type := Random_Substance_Type_Gen.Random(Gen => ST_G); + -- What simplification to use + if (Problem.Parameters.No_Both_Simplifications = False) then + declare + package Random_Simplification_Gen is new Ada.Numerics.Discrete_Random(Result_Subtype => Simplification); + SIM_G: Random_Simplification_Gen.Generator; + begin + Random_Simplification_Gen.Reset(Gen => SIM_G); + Problem.Simpl := Random_Simplification_Gen.Random(Gen => SIM_G); + + -- Random dissociation constant + Problem.Kx := Random_Kx; + end; + else + declare + subtype Enforced_Simplification is Simplification range Autoprotolysis .. Dissociation; + package Random_Simplification_Gen is new Ada.Numerics.Discrete_Random(Result_Subtype => Enforced_Simplification); + SIM_G: Random_Simplification_Gen.Generator; + begin + Random_Simplification_Gen.Reset(Gen => SIM_G); + Problem.Simpl := Random_Simplification_Gen.Random(Gen => SIM_G); + + Problem.Kx := Random_Kx_Enforced(Problem.Simpl); + -- Generate dissociation constant that fits the enforced simplification mode + end; + end if; + + Calculate_Concentration_Limits(cX_Min, cX_Max, Problem.Kx, Problem.Simpl); + Problem.cX := Random_cX(cX_Min, cX_Max); + Problem.Unlock_State; + end New_Problem; + + function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return Boolean is + use Parameters_Info; + begin + Problem.Lock_State; + if Parameters.Find(PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY) = Parameters_Info.No_Element then + Problem.Parameters.No_Both_Simplifications := False; + else + Problem.Parameters.No_Both_Simplifications := True; + end if; + + Problem.Unlock_State; + return True; + end Set_Parameters; + -- END: Inherited functions + + -- BEGIN: Private functions + function Autoprotolysis_Limit(Kx: in pH_Float) return pH_Float is + Ratio: constant pH_Float := 2.0E-13; + begin + return Ratio / Kx; + end Autoprotolysis_Limit; + + function Dissociation_Limit(Kx: in pH_Float) return pH_Float is + Ratio_Squared: constant pH_Float := 0.0025; + begin + return Kx / Ratio_Squared; + end Dissociation_Limit; + + procedure Calculate_Concentration_Limits(Min: out pH_Float; Max: out pH_Float; Kx: in pH_Float; S: in Simplification) is + begin + case S is + -- We are ignoring autoprotolysis but taking dissociation into account + when Autoprotolysis => + Min := Autoprotolysis_Limit(Kx); + Max := Dissociation_Limit(Kx); + -- We are ignoring dissociation but taking autoprotolysis into account + when Dissociation => + Min := Dissociation_Limit(Kx); + Max := Autoprotolysis_Limit(Kx); + when Both => + declare + ATPR: constant pH_Float := Autoprotolysis_Limit(Kx); + Dissoc: constant pH_Float := Dissociation_Limit(Kx); + begin + Min := pH_Float'Max(ATPR, Dissoc); + Max := Min + MAX_CONCENTRATION_DIFF; + end; + end case; + + -- Apply hard limit on minimum concentration, approximation we use does not work reliably below this limit + if Min < CONCENTRATION_HARD_MIN_LIMIT then + Min := CONCENTRATION_HARD_MIN_LIMIT; + else + Min := Correct_Up(Min); + end if; + Max := Correct_Down(Max); + --Ada.Text_IO.Put_Line("Min: " & pH_Float'Image(Min) & " Max: " & pH_Float'Image(Max) & " Simpl: " & Simplification'Image(S)); + end Calculate_Concentration_Limits; + + function Calculate_Solution(Problem: in Acidobazic_Problem) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + + package pH_Float_IO is new Ada.Text_IO.Float_IO(pH_Float); + use pH_Float_IO; + use Ada.Text_IO; + begin + -- DEBUG Dump + --Put("* Kx = "); Put(Problem.Kx); + --Put(" | cX = "); Put(Problem.cX); + --case Problem.Subst_Type is + -- when Acid => + -- Put_Line(" | ACID"); + -- when Base => + -- Put_Line(" | BASE"); + -- end case; + -- END DEBUG Dump + + case Problem.Simpl is + -- We are ignoring everything + when Both => + declare + pH: constant pH_Float := X_To_pX(Sqrt(Problem.Kx * Problem.cX)); + begin + --Ada.Text_IO.Put_Line("Both simplifications"); + case Problem.Subst_Type is + when Acid => + return pH; + when Base => + return 14.0 - pH; + end case; + end; + -- We are ignoring autoprotolysis and taking dissociation into account + when Autoprotolysis => + declare + D: pH_Float; + X_1: pH_Float; + X_2: pH_Float; + pH: pH_Float; + begin + --Ada.Text_IO.Put_Line("Taking only dissociation into account"); + -- Solve the quadratic equation + D := (Problem.Kx ** 2.0) + (4.0 * Problem.Kx * Problem.cX); + if D < 0.0 then + raise Constraint_Error; + end if; + D := MEF.Sqrt(D); + X_1 := (-Problem.Kx + D) / 2.0; + X_2 := (-Problem.Kx - D) / 2.0; + pH := X_To_pX(pH_Float'Max(X_1, X_2)); + if Problem.Subst_Type = Base then + return 14.0 - pH; + else + return pH; + end if; + end; + -- We are ignoring dissociation and taking autoprotolysis into account + when Dissociation => + declare + pH: constant pH_Float := X_To_pX(Sqrt(Problem.Kx * Problem.cX + K_W)); + begin + --Ada.Text_IO.Put_Line("Taking only autoprotolysis into account"); + case Problem.Subst_Type is + when Acid => + return pH; + when Base => + return 14.0 - pH; + end case; + end; + end case; + + end Calculate_Solution; + + function Correct_Down(Num: in pH_Float) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + + F: constant pH_Float := Correction_Exponent(Num); + begin + return Num - 10.0 ** F; + end Correct_Down; + + function Correct_Up(Num: in pH_Float) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + + F: constant pH_Float := Correction_Exponent(Num); + begin + return Num + 10.0 ** F; + end Correct_Up; + + function Correction_Exponent(Num: in pH_Float) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + + F_Log_Num: constant pH_Float := pH_Float'Floor(Log(Base => 10.0, X => Num)); + F_Log_Dec: constant pH_Float := pH_Float'Floor(Log(Base => 10.0, X => Decimals)); + begin + return F_Log_Num - F_Log_Dec; + end Correction_Exponent; + + function pX_To_X(pX: in pH_Float) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + begin + return 10.0 ** (-pX); + end pX_To_X; + + function Random_cX(Min: in pH_Float; Max: in pH_Float) return pH_Float is + package FH is new Formatting_Helpers(pH_Float); + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + use MEF; + use Ada.Numerics.Float_Random; + + Seed: Generator; + Rand: Float; + cX_Rand: pH_Float; + cX: pH_Float; + Log_Min: constant pH_Float := Log(Base => 10.0, X => Min); + Log_Max: constant pH_Float := Log(Base => 10.0, X => Max); + Concentration_Scale: constant pH_Float := Log_Max - Log_Min; + begin + Reset(Gen => Seed); + Rand := Random(Gen => Seed); + cX_Rand := pH_Float(Rand); + + cX := (Concentration_Scale * cX_Rand) + Log_Min; + cX := 10.0 ** cX; + return FH.Round_To_Valid_Nums(cX, Decimals); + end Random_cX; + + function Random_Kx return pH_Float is + package FH is new Formatting_Helpers(pH_Float); + use Ada.Numerics.Float_Random; + + type pH_Region is (Acidic, Basic); + package pH_Region_Random is new Ada.Numerics.Discrete_Random(Result_Subtype => pH_Region); + + pH_Seed: pH_Region_Random.Generator; + Seed: Generator; + Region: pH_Region; + Rand: Float; + pH_Rand: pH_Float; + pKx: pH_Float; + + Acid_Scale: constant pH_Float := Acidic_Max_pH - Acidic_Min_pH; + Base_Scale: constant pH_Float := Basic_Max_pH - Basic_Min_pH; + + begin + pH_Region_Random.Reset(Gen => pH_Seed); + Region := pH_Region_Random.Random(Gen => pH_Seed); + + Reset(Seed); + Rand := Random(Gen => Seed); + pH_Rand := pH_Float(Rand); + + -- There is no need to normalize the scale because the generator already returns + -- a normalized range + case Region is + when Acidic => + pKx := (Acid_Scale * pH_Rand) + Acidic_Min_pH; + when Basic => + pKx := (Base_Scale * pH_Rand) + Basic_Min_pH; + end case; + + pKx := FH.Round_To_Valid_Nums(pKx, Decimals); + return pX_To_X(pKx); + end Random_Kx; + + function Random_Kx_Enforced(S: in Simplification) return pH_Float is + package FH is new Formatting_Helpers(pH_Float); + use Ada.Numerics.Float_Random; + + Seed: Generator; + Rand: Float; + pH_Rand: pH_Float; + pKx: pH_Float; + begin + Reset(Seed); + Rand := Random(Seed); + pH_Rand := pH_Float(Rand); + + case S is + -- Ignore autoprotolysis, enforce dissociation + when Autoprotolysis => + declare + Scale: constant pH_Float := Acidic_Max_pH - Acidic_Min_pH; + begin + -- pKa and pKb between <2.0; 7.5> can overpower autoprotolysis and might require dissociation + pKx := (Scale * pH_Rand) + Acidic_Min_pH; + end; + -- Ignore dissociation, enforce autoprotolysis + when Dissociation => + -- pKa and pKb between <7.6; 12> do not require dissociation but might require autoprotolysis + declare + Scale: constant pH_Float := Basic_Max_pH - Basic_Min_pH; + begin + pKx := (Scale * pH_Rand) + Basic_Min_pH; + end; + when others => + raise Constraint_Error; + end case; + + pKx := FH.Round_To_Valid_Nums(pKx, Decimals); + return pX_To_X(pKx); + end Random_Kx_Enforced; + + function X_To_pX(X: in pH_Float) return pH_Float is + package MEF is new Ada.Numerics.Generic_Elementary_Functions(pH_Float); + begin + return MEF.Log(Base => 10.0, X => X) * (-1.0); + end X_To_pX; + +end Acidobazic_Suite; diff --git a/src/problem_generators/problem_generator.adb b/src/problem_generators/problem_generator.adb new file mode 100644 index 0000000..16d1960 --- /dev/null +++ b/src/problem_generators/problem_generator.adb @@ -0,0 +1,37 @@ +with Ada.Text_IO; + +package body Problem_Generator is + + protected body Problem_Mutex is + entry Lock when Locked = False is + begin + Locked := True; + end Lock; + + procedure Unlock is + begin + Locked := False; + end Unlock; + end Problem_Mutex; + + function Get_Problem(P_Type: in Problem_Type) return access Chem_Problem'Class is + begin + case P_Type is + when Acidobazic => + return Acidobazic_Suite.Create; + end case; + end Get_Problem; + + procedure Lock_State(Problem: in out Chem_Problem) is + begin + Problem.Mutex.Lock; + end Lock_State; + + procedure Unlock_State(Problem: in out Chem_Problem) is + begin + Problem.Mutex.Unlock; + end Unlock_State; + + package body Acidobazic_Suite is separate; + +end Problem_Generator; diff --git a/src/problem_generators/problem_generator.ads b/src/problem_generators/problem_generator.ads new file mode 100644 index 0000000..c98e408 --- /dev/null +++ b/src/problem_generators/problem_generator.ads @@ -0,0 +1,97 @@ +with Global_Types; +with Problem_Generator_Syswides; + +use Global_Types; +use Problem_Generator_Syswides; +package Problem_Generator is + + protected type Problem_Mutex is + entry Lock; + procedure Unlock; + + private + Locked: Boolean := False; + end Problem_Mutex; + + type Chem_Problem is abstract tagged limited private; + + function Create return access Chem_Problem is abstract; + function Check_Answer(Problem: in out Chem_Problem; Answer: in Answer_Info.Map; Message: out UB_Text) return Answer_RetCode is abstract; + function Get_Assignment(Problem: in out Chem_Problem; Assignment: in out Assignment_Info.Map) return Boolean is abstract; + function Get_Parameters(Problem: in out Chem_Problem; Parameters: out Parameters_Info.Map) return Boolean is abstract; + procedure New_Problem(Problem: in out Chem_Problem) is abstract; + procedure Lock_State(Problem: in out Chem_Problem); + function Set_Parameters(Problem: in out Chem_Problem; Parameters: in Parameters_Info.Map) return Boolean is abstract; + procedure Unlock_State(Problem: in out Chem_Problem); + + function Get_Problem(P_Type: in Problem_Type) return access Chem_Problem'Class; + +private + type Chem_Problem is abstract tagged limited + record + Mutex: Problem_Mutex; + end record; + + package Acidobazic_Suite is + use Problem_Generator_Syswides.Acidobazic_Suite; + + type Acidobazic_Problem is new Problem_Generator.Chem_Problem with private; + -- Constructor + function Create return access Acidobazic_Problem; + -- Inherited + function Check_Answer(Problem: in out Acidobazic_Problem; Answer: in Answer_Info.Map; Message: out UB_Text) return Answer_RetCode; + procedure New_Problem(Problem: in out Acidobazic_Problem); + function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return Boolean; + function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return Boolean; + function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return Boolean; + + private + type pH_Float is digits 15; + -- Present dissociation constant as pKa or pKb? + type Dissociation_Constant_Type is (pKa, pKb); + -- Is the substance acidic or basic? + type Substance_Type is (Acid, Base); + + type Acidobazic_Parameters is + record + No_Both_Simplifications: Boolean; + end record; + + function Autoprotolysis_Limit(Kx: in pH_Float) return pH_Float; + procedure Calculate_Concentration_Limits(Min: out pH_Float; Max: out pH_Float; Kx: in pH_Float; S: in Simplification); + function Calculate_Solution(Problem: in Acidobazic_Problem) return pH_Float; + function Correct_Down(Num: in pH_Float) return pH_Float; + function Correct_Up(Num: in pH_Float) return pH_Float; + function Correction_Exponent(Num: in pH_Float) return pH_Float; + function Dissociation_Limit(Kx: in pH_Float) return pH_Float; + function pX_To_X(pX: in pH_Float) return pH_Float; + function Random_cX(Min: in pH_Float; Max: in pH_Float) return pH_Float; + function Random_Kx return pH_Float; + function Random_Kx_Enforced(S: in Simplification) return pH_Float; + function X_To_pX(X: in pH_Float) return pH_Float; + + type Acidobazic_Problem is new Problem_Generator.Chem_Problem with + record + Answer: pH_Float; + cX: pH_Float; + DCT: Dissociation_Constant_Type; + Kx: pH_Float; + Parameters: Acidobazic_Parameters; + Simpl: Simplification; + Subst_Type: Substance_Type; + end record; + + Acidic_Min_pH: constant pH_Float := 1.75; + Acidic_Max_pH: constant pH_Float := 5.75; + Basic_Min_pH: constant pH_Float := 9.5; + Basic_Max_pH: constant pH_Float := 12.5; + K_W: constant pH_Float := 1.0E-14; + -- Maximum concentration can be only 1.5 mol/dm3 higher than minimum concentration + MAX_CONCENTRATION_DIFF: constant pH_Float := 0.75; + CONCENTRATION_HARD_MIN_LIMIT: constant pH_Float := 1.0E-6; + Decimals: constant pH_Float := 1.0E3; + Precision: constant pH_Float := 1.0E-3; + + end Acidobazic_Suite; + +end Problem_Generator; diff --git a/src/problem_generators/problem_generator_syswides.ads b/src/problem_generators/problem_generator_syswides.ads new file mode 100644 index 0000000..86da247 --- /dev/null +++ b/src/problem_generators/problem_generator_syswides.ads @@ -0,0 +1,41 @@ +with Ada.Containers.Indefinite_Ordered_Maps; + +package Problem_Generator_Syswides is + + type Answer_RetCode is (Invalid_Answer, No_Answer, Correct_Answer, Wrong_Answer, Malformed_Answer); + type Problem_Type is (Acidobazic); + package Answer_Info is new Ada.Containers.Indefinite_Ordered_Maps(String, String); + package Assignment_Info is new Ada.Containers.Indefinite_Ordered_Maps(String, String); + package Parameters_Info is new Ada.Containers.Indefinite_Ordered_Maps(String, String); + + ANSWER_KIND_KEY: constant String := "ANSWER_KIND"; + ANSWER_KIND_GOOD: constant String := "answer_kind_good"; + ANSWER_KIND_BAD: constant String := "answer_kind_bad"; + ANSWER_MESSAGE_KEY: constant String := "ANSWER_MESSAGE"; + ANSWER_SECTION_KEY: constant String := "ANSWER_SECTION"; + PROBLEM_TYPE_KEY: constant String := "PROBLEM_TYPE"; + PROBLEM_TYPE_ACIDOBAZIC: constant String := Problem_Type'Image(Acidobazic); + + package Acidobazic_Suite is + -- What effect to ignore in calculations? + type Simplification is (Autoprotolysis, Dissociation, Both); + + PROBLEM_NAME_READABLE: constant String := "pH jednosytnÃ© kyseliny/bÃ¡ze"; + CONCENTRATION_INT_KEY: constant String := "CONCENTRATION_INT"; + CONCENTRATION_DEC_KEY: constant String := "CONCENTRATION_DEC"; + CONCENTRATION_EXP_KEY: constant String := "CONCENTRATION_EXP"; + PKX_KEY: constant String := "PKX"; + PKX_PKA_TEXT: constant String := "pKa"; + PKX_PKB_TEXT: constant String := "pKb"; + PKX_VALUE_DEC_KEY: constant String := "PKX_VALUE_DEC"; + PKX_VALUE_INT_KEY: constant String := "PKX_VALUE_INT"; + SIMPLIFICATION_KEY: constant String := "SIMPLIFICATION"; + SUBSTANCE_KEY: constant String := "SUBSTANCE"; + -- + ANSWER_PH_KEY: constant String := "ANSWER_PH"; + ANSWER_SIMPLIFICATION_KEY: constant String := "ANSWER_SIMPLIFICATION"; + -- + PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY: constant String := "PARAMETER_NO_BOTH_SIMPLIFICATIONS"; + end Acidobazic_Suite; + +end Problem_Generator_Syswides; diff --git a/src/problem_manager.adb b/src/problem_manager.adb new file mode 100644 index 0000000..d7bb1fd --- /dev/null +++ b/src/problem_manager.adb @@ -0,0 +1,237 @@ +with Ada.Text_IO; +with Face_Generator; + +package body Problem_Manager is + + function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code) return Boolean is + Answer_Message: UB_Text; + ARC: Problem_Generator_Syswides.Answer_RetCode; + Assignment: Problem_Generator_Syswides.Assignment_Info.Map; + Parameters: Problem_Generator_Syswides.Parameters_Info.Map; + Success: Boolean; + USD: User_Session_Data_Access; + begin + USD := Active_Sessions.Get_Session_Data(UID, Success); + if Success = False then + return False; + end if; + + Success := USD.Problem.Get_Parameters(Parameters); + if Success = False then + -- TODO: Handle error in a better way + return False; + end if; + Success := USD.Problem.Get_Assignment(Assignment); + if Success = False then + -- TODO: Handle error in a better way + return False; + end if; + + ARC := USD.Problem.Check_Answer(Answer, Answer_Message); + return Face_Generator.Generate_Face_With_Answer(Assignment => Assignment, Answer_Message => Answer_Message, + Answer_Code => ARC, HTML => HTML, + Parameters => Parameters); + end Display_Checked_Answer; + + function Display_New_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean is + Assignment: Problem_Generator_Syswides.Assignment_Info.Map; + Parameters: Problem_Generator_Syswides.Parameters_Info.Map; + USD: User_Session_Data_Access; + Success: Boolean; + begin + USD := Active_Sessions.Get_Session_Data(UID, Success); + if Success = False then + return False; + end if; + + -- Get default problem parameters + Success := USD.Problem.Get_Parameters(Parameters); + if Success = False then + return False; + end if; + -- Get assignment + Success := USD.Problem.Get_Assignment(Assignment); + if Success = False then + return False; + end if; + + return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Parameters); + end Display_New_Assignment; + + function Display_Next_Assignment(UID: in Unique_ID; Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean is + Assignment: Problem_Generator_Syswides.Assignment_Info.Map; + Success: Boolean; + USD: User_Session_Data_Access; + begin + USD := Active_Sessions.Get_Session_Data(UID, Success); + if Success = False then + return False; + end if; + + -- Set parameters before creating a new problem + Success := USD.Problem.Set_Parameters(Problem_Parameters); + if Success = False then + -- TODO: Handle error + return False; + end if; + + -- Create new problem and display it + USD.Problem.New_Problem; + Success := USD.Problem.Get_Assignment(Assignment); + if Success = False then + -- TODO: Handle error in a better way + return False; + end if; + + return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Problem_Parameters); + end Display_Next_Assignment; + + function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean is + begin + begin + UID := Unique_ID'Value(Raw_UID); + return Active_Sessions.Contains(UID); + exception + when Constraint_Error => + return False; + end; + end Get_UID; + + function Prepare_Problem(UID: in Unique_ID; P_Cat: in Problem_Category) return Boolean is + New_USD: User_Session_Data_Access; + Success: Boolean; + begin + New_USD := new User_Session_Data; + New_USD.P_Cat := P_Cat; + + case P_Cat is + when Acidobazic => + New_USD.Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Acidobazic); + when others => + return False; + end case; + + New_USD.Problem.New_Problem; + + Active_Sessions.Set_Session_Data(UID, New_USD, Success); + return Success; + end Prepare_Problem; + + function Register_UID(UID: out Unique_ID) return Boolean is + Success: Boolean; + begin + -- Raw UID is empty, assuming a new session + Active_Sessions.Register_UID(UID, Success); + return Success; + end Register_UID; + + procedure Session_Expired(SID: in AWS.Session.ID) is + Raw_UID: constant String := AWS.Session.Get(SID, "UID"); + UID: Unique_ID; + Success: Boolean; + begin + Success := Get_UID(Raw_UID, UID); + if Success = False then + Ada.Text_IO.Put_Line("Session expired: No such session"); + return; + end if; + + Active_Sessions.Remove_Session(UID); + Ada.Text_IO.Put_Line("Session expired: Session " & Raw_UID & " data deleted"); + end Session_Expired; + + -- BEGIN: Private functions + protected body Active_Sessions is + + function Contains(UID: in Unique_ID) return Boolean is + use Session_Keeping; + begin + if Sessions.Find(UID) = Session_Keeping.No_Element then + return False; + else + return True; + end if; + end Contains; + + procedure Check_Free_And_Register(UID: in Unique_ID; Success: out Boolean; Stop: out Boolean) is + use Session_Keeping; + + C: Session_Keeping.Cursor; + begin + Success := False; + if Sessions.Find(UID) = Session_Keeping.No_Element then + -- We have a free slot + Sessions.Insert(UID, null, C, Success); + if Success then + Last_UID := UID; + -- Registration successful + Stop := True; + return; + else + -- Registration failed + Stop := True; + return; + end if; + end if; + -- Slot occupied, keep looking + Stop := False; + end Check_Free_And_Register; + + function Get_Session_Data(UID: in Unique_ID; Success: out Boolean) return User_Session_Data_Access is + use Session_Keeping; + begin + if Sessions.Find(UID) = Session_Keeping.No_Element then + Success := False; + return null; + else + Success := True; + return Sessions.Element(UID); + end if; + end Get_Session_Data; + + procedure Set_Session_Data(UID: in Unique_ID; USD: in User_Session_Data_Access; Success: out Boolean) is + use Session_Keeping; + begin + if Sessions.Find(UID) = Session_Keeping.No_Element then + Success := False; + else + Sessions.Replace(UID, USD); + Success := True; + end if; + end Set_Session_Data; + + procedure Register_UID(UID: out Unique_ID; Success: out Boolean) is + Stop: Boolean; + begin + -- Look for an available UID slot + for Idx in Last_UID .. Unique_ID'Last loop + Check_Free_And_Register(Idx, Success, Stop); + if Stop then + UID := Idx; + return; + end if; + end loop; + + -- We found no free slot above, search the area below Last_UID + for Idx in Unique_ID'First .. Last_UID loop + Check_Free_And_Register(Idx, Success, Stop); + if Stop then + UID := Idx; + return; + end if; + end loop; + + -- There are no free slots available + Success := False; + end Register_UID; + + procedure Remove_Session(UID: in Unique_ID) is + use Session_Keeping; + begin + Sessions.Delete(UID); + end Remove_Session; + + end Active_Sessions; + +end Problem_Manager; diff --git a/src/problem_manager.ads b/src/problem_manager.ads new file mode 100644 index 0000000..f717374 --- /dev/null +++ b/src/problem_manager.ads @@ -0,0 +1,46 @@ +with Global_Types; +with Problem_Generator; +with Problem_Generator_Syswides; +with Ada.Containers.Ordered_Maps; +with AWS.Session; + +use Global_Types; +package Problem_Manager is + + type Problem_Category is (Invalid, Acidobazic); + + function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code) return Boolean; + function Display_New_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean; + function Display_Next_Assignment(UID: in Unique_ID; + Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; + HTML: out HTML_Code) return Boolean; + function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean; + function Prepare_Problem(UID: in Unique_ID; P_Cat: in Problem_Category) return Boolean; + function Register_UID(UID: out Unique_ID) return Boolean; + procedure Session_Expired(SID: AWS.Session.ID); + +private + type User_Session_Data is + record + P_Cat: Problem_Category; + Problem: access Problem_Generator.Chem_Problem'Class; + end record; + type User_Session_Data_Access is access all User_Session_Data; + + package Session_Keeping is new Ada.Containers.Ordered_Maps(Key_Type => Unique_ID, Element_Type => User_Session_Data_Access); + + protected Active_Sessions is + function Contains(UID: in Unique_ID) return Boolean; + function Get_Session_Data(UID: in Unique_ID; Success: out Boolean) return User_Session_Data_Access; + procedure Set_Session_Data(UID: in Unique_ID; USD: in User_Session_Data_Access; Success: out Boolean); + procedure Register_UID(UID: out Unique_ID; Success: out Boolean); + procedure Remove_Session(UID: in Unique_ID); + + private + procedure Check_Free_And_Register(UID: in Unique_ID; Success: out Boolean; Stop: out Boolean); + + Sessions: Session_Keeping.Map; + Last_UID: Unique_ID := Unique_ID'First; + end Active_Sessions; + +end Problem_Manager;