<div class="caption_v1">Zadání:</div>
<div class="assignment_text">Vypočítejte pH <span class="key_info">@_SUBSTANCE_@</span> jejíž <span class="key_info">@_PKX_@ = @_PKX_VALUE_INT_@,@_PKX_VALUE_DEC_@</span> a koncentrace <span class="key_info">c = @_CONCENTRATION_INT_@,@_CONCENTRATION_DEC_@ . 10<span class="exponent">@_CONCENTRATION_EXP_@</span></span> mol/L.</div>
<form class="problem_form" method="post" action="/check_answer" enctype="multipart/form-data">
+ <input type="hidden" name="@_RESERVED__PROBLEM_ID_@" value="@_RESERVED__PROBLEM_ID_VAL_@">
<div class="form_line">
<label class="form_label_ac" for="@_ANSWER_PH_@">pH:</label>
<input class="form_input_ac" type="text" name="@_ANSWER_PH_@" maxlength="128" value="" />
<div class="backgrounded_block">
<div class="caption_v1">Parametry příkladů:</div>
<form class="problem_form" method="post" action="/next_problem" enctype="multipart/form-data">
+ <input type="hidden" name="@_RESERVED__PROBLEM_CATEGORY_@" value="@_RESERVED__PROBLEM_CATEGORY_VAL_@">
<div class="form_line">
<label class="form_label_ac_param" for="@_PARAMETER_NO_BOTH_SIMPLIFICATIONS_@">Pouze příklady, kde nelze zanedbat oba jevy:</label>
<input type="checkbox" name="@_PARAMETER_NO_BOTH_SIMPLIFICATIONS_@" value="True" @_PARAMETER_NO_BOTH_SIMPLIFICATIONS_CHECKED_@ />
<form class="problem_form" method="post" action="/next_problem" enctype="multipart/form-data">
+ <input type="hidden" name="@_RESERVED__PROBLEM_CATEGORY_@" value="@_RESERVED__PROBLEM_CATEGORY_VAL_@">
<div class="form_line">
<label class="form_label_sol_param" for="@_PARAMETER_IONIC_STRENGTH_@">Uvažovat iontovou sílu:</label>
<input type="checkbox" name="@_PARAMETER_IONIC_STRENGTH_@" value="True" @_PARAMETER_IONIC_STRENGTH_CHECKED_@ />
<form class="problem_form" method="post" action="/check_answer" enctype="multipart/form-data">
+ <input type="hidden" name="@_RESERVED__PROBLEM_ID_@" value="@_RESERVED__PROBLEM_ID_VAL_@">
<div class="form_line">
<label class="form_label_sol" for="ANSWER_NUM">Výsledek:</label>
<input class="form_input_sol" type="text" name="ANSWER_NUM" maxlength="128" value="" />
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
+ HTML: out HTML_Code;
+ Pr_ID: in String; Pr_Cat: in String) 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);
+ Answer_Message => To_UB_Text(""), Answer_Code => Problem_Generator_Syswides.Invalid_Answer,
+ Pr_ID => Pr_ID, Pr_Cat => Pr_Cat);
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
+ HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is
use Problem_Generator_Syswides;
use Problem_Generator_Syswides.Assignment_Info;
Problem_Type_Str: constant String := Assignment.Element(PROBLEM_TYPE_KEY);
begin
if Problem_Type_Str = PROBLEM_TYPE_ACIDOBAZIC then
- return Generate_Face_Acidobazic(Assignment, Answer_Message, Answer_Code, Parameters, HTML);
+ return Generate_Face_Acidobazic(Assignment, Answer_Message, Answer_Code, Parameters, HTML, Pr_ID, Pr_Cat);
elsif Problem_Type_Str = PROBLEM_TYPE_SOLUBILITY then
- return Generate_Face_Solubility(Assignment, Answer_Message, Answer_Code, Parameters, HTML);
+ return Generate_Face_Solubility(Assignment, Answer_Message, Answer_Code, Parameters, HTML, Pr_ID, Pr_Cat);
else
return False;
end if;
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
+ HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is
use AWS.Templates;
use Problem_Generator_Syswides;
use Problem_Generator_Syswides.Assignment_Info;
Temp := Parse(Filename => "scripts/expand_collapse.js", Cached => True);
Append_HTML(Source => HTML, New_Item => Temp);
+ -- Mandatory hidden parameters
+ Insert(Translations, Assoc(RESERVED_PROBLEM_ID_KEY, RESERVED_PROBLEM_ID_KEY));
+ Insert(Translations, Assoc(RESERVED_PROBLEM_ID_VAL_KEY, Pr_ID));
+ Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_KEY, RESERVED_PROBLEM_CATEGORY_KEY));
+ Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_VAL_KEY, Pr_Cat));
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)));
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
+ HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is
use Ada.Strings.Unbounded;
use AWS.Templates;
use Problem_Generator_Syswides;
Translations_Hdr: Translate_Set;
Translations_Params: Translate_Set;
+ Translations_Submit: Translate_Set;
Translations: Translate_Set;
Temp: HTML_Code;
Params_Code: HTML_Code;
Add_Answer_Section(Translations, Answer_Message, Answer_Code);
- Temp := Parse(Filename => "templates/face_solubility_submit.html", Cached => True);
+ -- Add submit section
+ -- - Mandatory parameters
+ Insert(Translations_Submit, Assoc(RESERVED_PROBLEM_ID_KEY, Pr_ID));
+ Insert(Translations_Submit, Assoc(RESERVED_PROBLEM_ID_VAL_KEY, Pr_ID));
+ --
+ Temp := Parse(Filename => "templates/face_solubility_submit.html", Translations => Translations_Submit);
Insert(Translations, Assoc("SUBMIT_FORM", HTML_To_Fixed_String(Temp)));
-- Add parameters section
+ -- - Mandatory parameters
+ Insert(Translations_Params, Assoc(RESERVED_PROBLEM_CATEGORY_KEY, Pr_Cat));
+ Insert(Translations, Assoc(RESERVED_PROBLEM_CATEGORY_VAL_KEY, Pr_Cat));
+ --
Insert(Translations_Params, Assoc(Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY, Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY));
if Parameters.Find(Solubility_Suite.PARAMETER_IONIC_STRENGTH_KEY) /= Parameters_Info.No_Element then
Insert(Translations_Params, Assoc("PARAMETER_IONIC_STRENGTH_CHECKED", "checked=""checked"""));
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;
+ HTML: out HTML_Code;
+ Pr_ID: in String; Pr_Cat: in String) 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;
+ HTML: out HTML_Code;
+ Pr_ID: in String; Pr_Cat: in String) return Boolean;
private
procedure Add_Answer_Section(Translations: in out AWS.Templates.Translate_Set; Answer_Message: in UB_Text;
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;
+ HTML: out HTML_Code;
+ Pr_ID: in String; Pr_Cat: in String) return Boolean;
function Generate_Face_Solubility(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;
+ HTML: out HTML_Code;
+ Pr_ID: in String; Pr_Cat: in String) return Boolean;
HEADER_CAPTION_KEY: constant String := "HEADER_CAPTION";
HINTS_SECTION_KEY: constant String := "HINTS_SECTION";
end Get_Integer_Part_Int;
function String_To_Float(S: in String) return FH_Float is
- F: FH_Float;
Idx: Natural;
SS: String := S;
begin
package body Global_Types is
procedure Append_HTML(Source: in out HTML_Code; New_Item: in HTML_Code) is
+ use Ada.Strings.Unbounded;
begin
- Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item);
+ 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
+ use Ada.Strings.Unbounded;
begin
- Ada.Strings.Unbounded.Append(Source => Source, New_Item => New_Item);
+ Append(Source => Source, New_Item => New_Item);
end Append_UB_Text;
procedure Append_UB_Text(Source: in out UB_Text; New_Item: in String) is
+ use Ada.Strings.Unbounded;
begin
- Ada.Strings.Unbounded.Append(Source => Source, New_Item => To_UB_Text(New_Item));
+ Append(Source => Source, New_Item => To_Unbounded_String(New_Item));
end Append_UB_Text;
function HTML_To_Fixed_String(HTML: in HTML_Code) return String is
+ use Ada.Strings.Unbounded;
begin
- return Ada.Strings.Unbounded.To_String(HTML);
+ return To_String(HTML);
end HTML_To_Fixed_String;
function To_HTML_Code(S: in String) return HTML_Code is
+ use Ada.Strings.Unbounded;
begin
- return Ada.Strings.Unbounded.To_Unbounded_String(S);
+ return To_Unbounded_String(S);
end To_HTML_Code;
function To_UB_Text(S: in String) return UB_Text is
+ use Ada.Strings.Unbounded;
begin
- return Ada.Strings.Unbounded.To_Unbounded_String(S);
+ return To_Unbounded_String(S);
end To_UB_Text;
function UB_Text_To_Fixed_String(Text: in UB_Text) return String is
+ use Ada.Strings.Unbounded;
begin
- return Ada.Strings.Unbounded.To_String(Text);
+ return To_String(Text);
end UB_Text_To_Fixed_String;
+
+ protected body Simple_Mutex is
+ entry Lock when Locked = False is
+ begin
+ Locked := True;
+ end Lock;
+
+ entry Unlock when Locked is
+ begin
+ Locked := False;
+ end Unlock;
+ end Simple_Mutex;
+
end Global_Types;
package Global_Types is
- subtype Unique_ID is Ada.Containers.Count_Type;
+ type Problem_ID is new Ada.Containers.Count_Type;
+ type Unique_ID is new Ada.Containers.Count_Type;
subtype HTML_Code is Ada.Strings.Unbounded.Unbounded_String;
subtype UB_Text is Ada.Strings.Unbounded.Unbounded_String;
function To_UB_Text(S: in String) return UB_Text;
function UB_Text_To_Fixed_String(Text: in UB_Text) return String;
+ protected type Simple_Mutex is
+ entry Lock;
+ entry Unlock;
+ private
+ Locked: Boolean := False;
+ end Simple_Mutex;
+ type Simple_Mutex_All_Access is access all Simple_Mutex;
+
end Global_Types;
POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request);
Answer: Answer_Info.Map;
+ Pr_ID: Problem_ID;
Success: Boolean;
begin
-- Get UID
end;
end loop;
- Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML);
+ -- Get problem ID
+ if Answer.Find(Problem_Generator_Syswides.RESERVED_PROBLEM_ID_KEY) = Answer_Info.No_Element then
+ Ada.Text_IO.Put_Line("Problem ID not found!");
+ return AWS.Response.URL(Location => "/");
+ end if;
+
+ begin
+ Pr_ID := Problem_ID'Value(Answer.Element(Problem_Generator_Syswides.RESERVED_PROBLEM_ID_KEY));
+ Ada.Text_IO.Put_Line("Got problem ID " & Problem_ID'Image(Pr_ID));
+ exception
+ when Constraint_Error =>
+ Ada.Text_IO.Put_Line("Invalid problem ID value");
+ return AWS.Response.URL(Location => "/");
+ end;
+
+ Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML, Pr_ID);
+ if Success = False then
+ Ada.Text_IO.Put_Line("No such problem in storage");
+ 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);
with AWS.Session;
with AWS.Status;
+with Ada.Text_IO;
+
with Global_Types;
with Problem_Generator_Syswides;
with Problem_Manager;
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
+ -- Create a new problem
+ if Problem_Parameters.Find(Problem_Generator_Syswides.RESERVED_PROBLEM_CATEGORY_KEY) = Parameters_Info.No_Element then
+ Ada.Text_IO.Put_Line("No problem category tag");
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);
+ declare
+ Raw_P_Cat: constant String := Problem_Parameters.Element(Problem_Generator_Syswides.RESERVED_PROBLEM_CATEGORY_KEY);
+ begin
+ Success := Problem_Manager.Prepare_Problem(UID, Raw_P_Cat, Problem_Parameters);
+ if Success = False then
+ -- TODO: Handle error in a less reckless manner
+ return AWS.Response.URL(Location => "/");
+ end if;
+ -- Display new problem
+ Success := Problem_Manager.Display_Assignment(UID, 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;
end;
when others =>
return AWS.Response.URL(Location => "/");
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;
- elsif Raw_Problem_Category = Problem_Manager.Problem_Category'Image(Problem_Manager.Solubility) then
- P_Cat := Problem_Manager.Solubility;
- else
- return AWS.Response.URL(Location => "/");
- end if;
-
+ begin
-- Register new UID if necessary and create a first problem
Success := Problem_Manager.Get_UID(Raw_UID, UID);
if Success = False then
end if;
-- We're all set, create a new problem
- Success := Problem_Manager.Prepare_Problem(UID, P_Cat);
+ Success := Problem_Manager.Prepare_Problem(UID, Raw_Problem_Category);
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);
+ Success := Problem_Manager.Display_Assignment(UID, HTML);
if Success = False then
HTML := To_HTML_Code("Cannot display assignment");
end if;
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);
+ AWS.Config.Set.Session_Lifetime(90.0);
+ AWS.Config.Set.Session_Cleanup_Interval(180.0);
Ada.Text_IO.Put_Line("Starting server...");
AWS.Server.Start(Web_Server => Web_Server,
-- BEGIN: Inherited funcions
function Create return access Solubility_Problem is
Problem: access Solubility_Problem;
- Parameters: Solubility_Parameters;
begin
- Parameters := (Ionic_Strength => False,
- P_Subtype => V_FROM_G_KS);
-
Problem := new Solubility_Problem;
- Problem.Parameters := Parameters;
+ Problem.Parameters := Solubility_Parameters'(Ionic_Strength => False, P_Subtype => V_FROM_G_KS);
return Problem;
end;
begin
Auto_Lock.Init(Guard, Problem.Mutex'Unchecked_Access);
Guard.Lock;
- -- Generate MW
Reset(Gen => Float_RGen);
-- Generate stochiometry of the molecul
case Problem.Parameters.P_Subtype is
when V_FROM_G_KS =>
declare
- MOLECULE_WEIGHT_RANGE: constant SS_Float := MOLECULE_WEIGHT_MAX - MOLECULE_WEIGHT_MIN;
+ MOLAR_WEIGHT_RANGE: constant SS_Float := MOLAR_WEIGHT_MAX - MOLAR_WEIGHT_MIN;
SAMPLE_WEIGHT_RANGE: constant SS_Float := SAMPLE_WEIGHT_MAX - SAMPLE_WEIGHT_MIN;
G: SS_Float; -- Sample weight in grams
Ks: SS_Float; -- Solubility product
G := (SS_Float(Random(Gen => Float_RGen)) * SAMPLE_WEIGHT_RANGE) + SAMPLE_WEIGHT_MIN;
G := Round_To_Valid_Nums(G, DECIMALS);
Ks := Round_To_Valid_Nums(Generate_Solubility_Product, DECIMALS);
- MW := (SS_Float(Random(Gen => Float_RGen)) * MOLECULE_WEIGHT_RANGE) + MOLECULE_WEIGHT_MIN;
+ MW := (SS_Float(Random(Gen => Float_RGen)) * MOLAR_WEIGHT_RANGE) + MOLAR_WEIGHT_MIN;
MW := Round_To_Valid_Nums(MW, DECIMALS_MW);
Prob_Data := (Option => V_FROM_G_KS,
M => SS_Float(M), N => SS_Float(N),
end;
when KS_FROM_G_V =>
declare
- MOLECULE_WEIGHT_RANGE: constant SS_Float := MOLECULE_WEIGHT_MAX - MOLECULE_WEIGHT_MIN;
+ MOLAR_WEIGHT_RANGE: constant SS_Float := MOLAR_WEIGHT_MAX - MOLAR_WEIGHT_MIN;
SAMPLE_WEIGHT_RANGE: constant SS_Float := SAMPLE_WEIGHT_MAX - SAMPLE_WEIGHT_MIN;
G: SS_Float; -- Sample weight in grams
MW: SS_Float; -- Molar mass
begin
G := (SS_Float(Random(Gen => Float_RGen)) * SAMPLE_WEIGHT_RANGE) + SAMPLE_WEIGHT_MIN;
G := Round_To_Valid_Nums(G, DECIMALS);
- MW := (SS_Float(Random(Gen => Float_RGen)) * MOLECULE_WEIGHT_RANGE) + MOLECULE_WEIGHT_MIN;
+ MW := (SS_Float(Random(Gen => Float_RGen)) * MOLAR_WEIGHT_RANGE) + MOLAR_WEIGHT_MIN;
MW := Round_To_Valid_Nums(MW, DECIMALS_MW);
V := Round_To_Valid_Nums(Generate_Sample_Volume, DECIMALS);
Prob_Data := (Option => KS_FROM_G_V,
package body Problem_Generator is
- protected body Problem_Mutex is
- entry Lock when Locked = False is
- begin
- Locked := True;
- end Lock;
-
- entry Unlock when Locked is
- begin
- Locked := False;
- end Unlock;
- end Problem_Mutex;
-
package body Auto_Lock is
- procedure Init(This: in out LC; Mutex: Problem_Mutex_All_Access; Auto_Unlock: in Boolean := True) is
+ procedure Init(This: in out LC; Mutex: Simple_Mutex_All_Access; Auto_Unlock: in Boolean := True) is
begin
This.Auto_Unlock := Auto_Unlock;
This.Mutex := Mutex;
use Global_Types;
use Problem_Generator_Syswides;
package Problem_Generator is
-
- protected type Problem_Mutex is
- entry Lock;
- entry Unlock;
-
- private
- Locked: Boolean := False;
- end Problem_Mutex;
- type Problem_Mutex_All_Access is access all Problem_Mutex;
-
type Chem_Problem is abstract tagged limited private;
function Create return access Chem_Problem is abstract;
private
type Chem_Problem is abstract tagged limited
record
- Mutex: aliased Problem_Mutex;
+ Mutex: aliased Simple_Mutex;
end record;
package Auto_Lock is
type LC is limited new Ada.Finalization.Limited_Controlled with private;
- procedure Init(This: in out LC; Mutex: Problem_Mutex_All_Access; Auto_Unlock: in Boolean := True);
+ procedure Init(This: in out LC; Mutex: Simple_Mutex_All_Access; Auto_Unlock: in Boolean := True);
procedure Lock(This: in out LC);
procedure Unlock(This: in out LC);
private
type LC is limited new Ada.Finalization.Limited_Controlled with
record
Auto_Unlock: Boolean;
- Mutex: Problem_Mutex_All_Access;
+ Mutex: Simple_Mutex_All_Access;
end record;
overriding procedure Finalize(This: in out LC);
-
- Pragma Volatile(LC);
end Auto_Lock;
package Acidobazic_Suite is
ELECTROLYTE_CONCENTRATION_LOG_MAX: constant SS_Float := 0.176;
ELECTROLYTE_CONCENTRATION_LOG_MIN: constant SS_Float := -4.0;
- MOLECULE_WEIGHT_MAX: constant SS_Float := 450.0;
- MOLECULE_WEIGHT_MIN: constant SS_Float := 45.0;
+ MOLAR_WEIGHT_MAX: constant SS_Float := 450.0;
+ MOLAR_WEIGHT_MIN: constant SS_Float := 45.0;
PKS_MAX: constant SS_Float := 54.0;
PKS_MIN: constant SS_Float := 10.0;
SAMPLE_VOLUME_LOG_MAX: constant SS_Float := 10.0;
PROBLEM_TYPE_KEY: constant String := "PROBLEM_TYPE";
PROBLEM_TYPE_ACIDOBAZIC: constant String := Problem_Type'Image(Acidobazic);
PROBLEM_TYPE_SOLUBILITY: constant String := Problem_Type'Image(Solubility);
+ --
+ RESERVED_PROBLEM_ID_KEY: constant String := "RESERVED__PROBLEM_ID";
+ RESERVED_PROBLEM_ID_VAL_KEY: constant String := "RESERVED__PROBLEM_ID_VAL";
+ RESERVED_PROBLEM_CATEGORY_KEY: constant String := "RESERVED__PROBLEM_CATEGORY";
+ RESERVED_PROBLEM_CATEGORY_VAL_KEY: constant String := "RESERVED__PROBLEM_CATEGORY_VAL";
package Acidobazic_Suite is
-- What effect to ignore in calculations?
with Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
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
+ function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; Pr_ID: in Problem_ID) 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;
+ Pr_Cat: Problem_Category;
Success: Boolean;
- USD: User_Session_Data_Access;
+ Stored: Stored_Problem_All_Access;
begin
- USD := Active_Sessions.Get_Session_Data(UID, Success);
- if Success = False then
+ Stored := Active_Sessions.Get_Problem(UID, Pr_ID);
+ if Stored = null then
return False;
end if;
- Success := USD.Problem.Get_Parameters(Parameters);
+ Success := Stored.Problem.Get_Parameters(Parameters);
if Success = False then
-- TODO: Handle error in a better way
+ Stored.Mutex.Unlock;
return False;
end if;
- Success := USD.Problem.Get_Assignment(Assignment);
+ Success := Stored.Problem.Get_Assignment(Assignment);
if Success = False then
-- TODO: Handle error in a better way
+ Stored.Mutex.Unlock;
return False;
end if;
- ARC := USD.Problem.Check_Answer(Answer, Answer_Message);
+ Ada.Text_IO.Put_Line("Checking problem ID " & Problem_ID'Image(Pr_ID));
+ ARC := Stored.Problem.Check_Answer(Answer, Answer_Message);
+ Pr_Cat := Stored.Category;
+ Stored.Mutex.Unlock;
return Face_Generator.Generate_Face_With_Answer(Assignment => Assignment, Answer_Message => Answer_Message,
Answer_Code => ARC, HTML => HTML,
- Parameters => Parameters);
+ Parameters => Parameters, Pr_ID => Problem_ID'Image(Pr_ID), Pr_Cat => Problem_Category'Image(Pr_Cat));
end Display_Checked_Answer;
- function Display_New_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean is
+ function Display_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;
+ Stored: Stored_Problem_All_Access;
+ Pr_ID: Problem_ID;
+ Pr_Cat: Problem_Category;
Success: Boolean;
begin
- USD := Active_Sessions.Get_Session_Data(UID, Success);
- if Success = False then
+ Stored := Active_Sessions.Get_Latest_Problem_With_ID(UID, Pr_ID);
+ if Stored = null then
return False;
end if;
- -- Get default problem parameters
- Success := USD.Problem.Get_Parameters(Parameters);
+ Success := Stored.Problem.Get_Parameters(Parameters);
if Success = False then
+ Stored.Mutex.Unlock;
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);
+ Success := Stored.Problem.Get_Assignment(Assignment);
if Success = False then
+ Stored.Mutex.Unlock;
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;
+ Pr_Cat := Stored.Category;
+ Stored.Mutex.Unlock;
+ return Face_Generator.Generate_Face(Assignment => Assignment, HTML => HTML, Parameters => Parameters, Pr_ID => Problem_ID'Image(Pr_ID),
+ Pr_Cat => Problem_Category'Image(Pr_Cat));
+ end Display_Assignment;
function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean is
begin
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;
+ function Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String;
+ Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean is
+ Problem: Chem_Problem_All_Access;
+ Storage: Stored_Problem_All_Access;
+ P_Cat: Problem_Category;
Success: Boolean;
begin
- New_USD := new User_Session_Data;
- New_USD.P_Cat := P_Cat;
+ if Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Acidobazic) then
+ P_Cat := Problem_Manager.Acidobazic;
+ elsif Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Solubility) then
+ P_Cat := Problem_Manager.Solubility;
+ else
+ return False;
+ end if;
case P_Cat is
when Acidobazic =>
- New_USD.Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Acidobazic);
+ Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Acidobazic);
when Solubility =>
- New_USD.Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Solubility);
+ Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Solubility);
when others =>
return False;
end case;
- New_USD.Problem.New_Problem;
+ if Problem = null then
+ return False;
+ end if;
+ -- Initialize problem
+ if Parameters.Is_Empty = False then
+ Success := Problem.Set_Parameters(Parameters);
+ Ada.Text_IO.Put_Line("Setting problem parameters");
+ if Success = False then
+ Free_Chem_Problem(Problem);
+ return False;
+ end if;
+ end if;
+ Problem.New_Problem;
+
+ Storage := new Stored_Problem;
+ Storage.Problem := Problem;
+ Storage.Category := P_Cat;
+ Active_Sessions.Add_Problem(UID, Storage, Success);
- Active_Sessions.Set_Session_Data(UID, New_USD, Success);
- return Success;
+ if Success = False then
+ Free_Chem_Problem(Problem);
+ Free_Stored_Problem(Storage);
+ end if;
+ return True;
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;
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
+
+ procedure Free_Chem_Problem(Problem: in out Chem_Problem_All_Access) is
+ procedure Free_Chem_Problem_Internal is new Ada.Unchecked_Deallocation(Object => Problem_Generator.Chem_Problem'Class, Name => Chem_Problem_All_Access);
+ begin
+ Free_Chem_Problem_Internal(Problem);
+ end Free_Chem_Problem;
+
+ procedure Free_Stored_Problem(Problem: in out Stored_Problem_All_Access) is
+ procedure Free_Stored_Problem_Internal is new Ada.Unchecked_Deallocation(Object => Stored_Problem, Name => Stored_Problem_All_Access);
+ begin
+ Free_Stored_Problem_Internal(Problem);
+ end Free_Stored_Problem;
+
protected body Active_Sessions is
+ procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean) is
+ use Problem_Storage;
+ use Session_Keeping;
+ use Ada.Containers;
+
+ C: Problem_Storage.Cursor;
+ USD: User_Session_All_Access;
+ begin
+ if Sessions.Find(UID) = Session_Keeping.No_Element then
+ Success := False;
+ return;
+ end if;
+ USD := Sessions.Element(UID);
+
+ USD.Problems.Insert(USD.Last_Problem_ID, Problem, C, Success);
+ if Success = False then
+ return;
+ end if;
+
+ USD.Last_Problem_ID := USD.Last_Problem_ID + 1;
+ -- Delete old problems
+ declare
+ Del_ID: Problem_ID;
+ begin
+ if USD.Last_Problem_ID - 1 <= MAX_STORED_PROBLEMS then
+ Del_ID := Problem_ID'Last - (MAX_STORED_PROBLEMS - (USD.Last_Problem_ID - 1));
+ else
+ Del_ID := (USD.Last_Problem_ID - 1) - MAX_STORED_PROBLEMS;
+ end if;
+
+ if USD.Problems.Find(Del_ID) /= Problem_Storage.No_Element then
+ declare
+ SP: Stored_Problem_All_Access := USD.Problems(Del_ID);
+ begin
+ -- Delete pointer to the problem, grab a lock to make sure that the pointer is not used
+ -- anywhere else while we are deleting it
+ SP.Mutex.Lock;
+ Free_Chem_Problem(SP.Problem);
+ SP.Mutex.Unlock;
+ Free_Stored_Problem(SP);
+ USD.Problems.Delete(Del_ID);
+ end;
+ end if;
+ end;
+ Success := True;
+ end Add_Problem;
+
function Contains(UID: in Unique_ID) return Boolean is
use Session_Keeping;
begin
use Session_Keeping;
C: Session_Keeping.Cursor;
+ NUSD: User_Session_All_Access;
begin
Success := False;
if Sessions.Find(UID) = Session_Keeping.No_Element then
-- We have a free slot
- Sessions.Insert(UID, null, C, Success);
+ NUSD := new User_Session_Data;
+ if NUSD = null then
+ Success := False;
+ Stop := False;
+ return;
+ end if;
+ Sessions.Insert(UID, NUSD, C, Success);
if Success then
Last_UID := UID;
-- Registration successful
Stop := False;
end Check_Free_And_Register;
- function Get_Session_Data(UID: in Unique_ID; Success: out Boolean) return User_Session_Data_Access is
+ procedure Free_Session_Data(Data: in out User_Session_All_Access) is
+ procedure Free_Session_Data_Internal is new Ada.Unchecked_Deallocation(Object => User_Session_Data, Name => User_Session_All_Access);
+ begin
+ Free_Session_Data_Internal(Data);
+ end Free_Session_Data;
+
+ function Get_Problem(UID: in Unique_ID; Pr_ID: in Problem_ID) return Stored_Problem_All_Access is
+ use Problem_Storage;
use Session_Keeping;
+
+ USD: User_Session_All_Access;
+ S: Stored_Problem_All_Access;
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;
+ USD := Sessions.Element(UID);
+
+ if USD.Problems.Find(Pr_ID) = Problem_Storage.No_Element then
+ return null;
+ end if;
- procedure Set_Session_Data(UID: in Unique_ID; USD: in User_Session_Data_Access; Success: out Boolean) is
+
+ S := USD.Problems.Element(Pr_ID);
+ -- Check if the problem has not been deleted
+ if S = null then
+ return null;
+ end if;
+ if S.Problem = null then
+ return null;
+ end if;
+
+ S.Mutex.Lock;
+ return S;
+ end Get_Problem;
+
+ function Get_Latest_Problem_With_ID(UID: in Unique_ID; Pr_ID: out Problem_ID) return Stored_Problem_All_Access is
use Session_Keeping;
+
begin
if Sessions.Find(UID) = Session_Keeping.No_Element then
- Success := False;
- else
- Sessions.Replace(UID, USD);
- Success := True;
+ return null;
end if;
- end Set_Session_Data;
+
+ Pr_ID := Sessions.Element(UID).Last_Problem_ID - 1;
+ return Get_Problem(UID, Pr_ID);
+ end Get_Latest_Problem_With_ID;
procedure Register_UID(UID: out Unique_ID; Success: out Boolean) is
Stop: Boolean;
end Register_UID;
procedure Remove_Session(UID: in Unique_ID) is
+ use Problem_Storage;
use Session_Keeping;
+
+ USD: User_Session_All_Access;
begin
+ if Sessions.Find(UID) = Session_Keeping.No_Element then
+ return;
+ end if;
+
+ USD := Sessions.Element(UID);
+
+ while USD.Problems.Is_Empty = False loop
+ declare
+ SP: Stored_Problem_All_Access := USD.Problems.First_Element;
+ begin
+ SP.Mutex.Lock;
+ Free_Chem_Problem(SP.Problem);
+ SP.Mutex.Unlock;
+ Free_Stored_Problem(SP);
+ USD.Problems.Delete_First;
+ end;
+ end loop;
+
+ Free_Session_Data(USD);
+
Sessions.Delete(UID);
end Remove_Session;
type Problem_Category is (Invalid, Acidobazic, Solubility);
- 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 Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code;
+ Pr_ID: in Problem_ID) return Boolean;
+ function Display_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 Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String;
+ Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean;
function Register_UID(UID: out Unique_ID) return Boolean;
procedure Session_Expired(SID: AWS.Session.ID);
private
+ type Chem_Problem_All_Access is access all Problem_Generator.Chem_Problem'Class;
+ procedure Free_Chem_Problem(Problem: in out Chem_Problem_All_Access);
+
+ type Stored_Problem is
+ record
+ Mutex: Simple_Mutex;
+ Problem: Chem_Problem_All_Access;
+ Category: Problem_Category;
+ end record;
+ type Stored_Problem_All_Access is access all Stored_Problem;
+ procedure Free_Stored_Problem(Problem: in out Stored_Problem_All_Access);
+
+ package Problem_Storage is new Ada.Containers.Ordered_Maps(Key_Type => Problem_ID, Element_Type => Stored_Problem_All_Access);
+
type User_Session_Data is
record
- P_Cat: Problem_Category;
- Problem: access Problem_Generator.Chem_Problem'Class;
+ Problems: Problem_Storage.Map;
+ Last_Problem_ID: Problem_ID := Problem_ID'First;
end record;
- type User_Session_Data_Access is access all User_Session_Data;
+ type User_Session_All_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);
+ package Session_Keeping is new Ada.Containers.Ordered_Maps(Key_Type => Unique_ID, Element_Type => User_Session_All_Access);
protected Active_Sessions is
+ procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean);
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);
+ function Get_Problem(UID: in Unique_ID; Pr_ID: in Problem_ID) return Stored_Problem_All_Access;
+ function Get_Latest_Problem_With_ID(UID: in Unique_ID; Pr_ID: out Problem_ID) return Stored_Problem_All_Access;
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);
+ procedure Free_Session_Data(Data: in out User_Session_All_Access);
Sessions: Session_Keeping.Map;
Last_UID: Unique_ID := Unique_ID'First;
end Active_Sessions;
+ MAX_STORED_PROBLEMS: Problem_ID := 20;
end Problem_Manager;
git://gitweb.devoid-pointer.net / Nine-Q.git / commitdiff