Why a dice-roller?

It's always a fun task coming up with good programs to use in tutorials. You don't want the program to be so simple that it presents no challenge whatsoever and you most certainly don't want it to be too complicated. A dice-roller is a nice and simple program that presents us with a good challenge, without venturing into the realm of advanced Ada usage. So a dice-roller is what we'll be doing in this tutorial.

Before we start doing any actual programming, we should first figure out how we want our dice-roller to work: We need to decide on some requirements.

The dice-roller requirements

All dice rolls must be configured in one or more dice-roll configuration files. For this program, we will use the following syntax:

Battleaxe:(atk)1d20:(dmg)1d8
Magic Staff:(atk)1d20+2:(dmg)2d4+2
Gnomish Hook:(atk)1d20:(dmg)3d6:(dmg)4d4-1

The first section is the name of the roll, here Battleaxe, Magic Staff or Gnomish Hook. The following sections contain the actual dice, with a roll-type enclosed in parentheses. Each roll is described by first writing the dice-amount followed by a d and then the kind of dice to roll. A bonus or penalty is added with a simple +/- character, as is done with the Magic Staff where there's a +2 bonus for both the (atk) and (dmg) rolls.

The dice rolls are called by referencing their numerical position in the configuration file, ie. Battleaxe is no. 1 and Gnomish Hook is no. 3.

Rolling the three example rolls should result in output looking something like this:

1
Rolling: Battleaxe
atk:  18   18(+0)
dmg:   8   8(+0)

2
Rolling: Magic Staff
atk:  19   17(+2)
dmg:   8   4+2(+2)

3
Rolling: Gnomish Hook
atk:  16   16(+0)
dmg:  13   5+3+5(+0)
dmg:   9   4+2+3+1(-1)

Note the two (dmg) rolls for the Gnomish Hook. This is of course due to the ”(dmg)3d6:(dmg)4d4-1” setup in the configuration.

The program should print out the number and name of all known rolls on request and it should provide a simple help text that explains whatever features that might be available in the program. It should also provide a way to load one or more configuration files when executed. A basic help text describing command-line options should also be available.

Finally we will set some limits of the dice and bonus/penalty sizes available:

  • Valid dice sizes range from 2 to 20
  • Valid bonus/penalty numbers range from -20 to 20
  • The amount of dice to roll is limited to the range 1 to 20
  • We allow no more than 100 configured dice rolls

If these limits are broken, the program should stop and inform the user about the problem.

These are the basic requirements our dice-roller. It's not very complicated, yet it does present us with a variety of tasks that must be dealt with.

The program

I've heavily commented the program, so it should be fairly easy to understand what's going on. The Dice Roller consists of 12 Ada source files, 1 project file and 1 dice roll configuration file. You can grab the entire program from this Git repository:

git://github.com/ThomasLocke/The-Dice-Roller.git

Git is available for all Linux distros. The commands to clone the Dice Roller program and compile it are:

$ git clone git://github.com/ThomasLocke/The-Dice-Roller.git
$ cd The-Dice-Roller
$ gnatmake -P diceroller.gpr

The executable can now be found in the exe/ directory.

If you don't feel like using Git, the full source code can be copied from below. I will of course do my best to make sure that the code on this page matches the code in the Git repository, but seeing as this is a wiki where anybody can changes, I cannot guarantee the safety of running the code on this page. So use with caution.

diceroller.gpr

This file sets up compile options. It informs the compiler about the location of the source files and where to put the object files and the executable.

project DiceRoller is
   for Source_Dirs use ("./**");
   for Main use ("diceroller.adb");
   for Exec_Dir use "exe";
   for Object_Dir use "objects";
 
   package Ide is
      for Compiler_Command ("ada") use "gnatmake";
   end Ide;
 
   package Compiler is
      Common_Options := ("-gnatwa",
                         "-gnaty3abcdefhiklmnoprstux",
                         "-Wall",
                         "-O2",
                         "-gnat05");
 
     for Default_Switches ("Ada") use Common_Options;
   end Compiler;
end DiceRoller;

diceroller.adb

This file contains the main procedure of the Dice Roller program. This is equivalent to the main() function in C. For this program we have named the main procedure DiceRoller. It is this procedure that sets everything in motion.

-------------------------------------------------------------------------------
-- DiceRoller (MAIN)
--
-- The DiceRoller rolls dice. It can either roll dice set up from one or more
-- dice configuration files, or it can roll dice from a default setup, which
-- is loaded if there are no dice configuration files.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Text_IO;    use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with Dice;           use Dice;
with Dice.Action;    use Dice.Action;
with Dice.CLI;       use Dice.CLI;
with Dice.Help;      use Dice.Help;
with Dice.Init;      use Dice.Init;
 
procedure DiceRoller is
   My_Dice_Rolls : Dice_Rolls;
   --  Declare My_Dice_Rolls as a Dice_Roll type. See dice.ads.
 
   WTD : What_To_Do;
   --  Declare WTD as a What_To_Do type. See dice.ads.
begin
   Check_Passed_Parameters;
   --  Check the commandline parameters. See dice-cli.ads
 
   Initialize (My_Dice_Rolls);
   --  Load dice rolls into the My_Dice_Rolls object. See dice-init.ads
 
   New_Line;
   Put_Line (Item => "DiceRoller is ready to serve!");
   New_Line;
 
   if Count_Rolls (Some_Dice_Rolls => My_Dice_Rolls) < 10 then
      WTD.Interface_Mode := Mode_Interactive;
      Put_Line (Item => "DiceRoller is running in interactive mode.");
   else
      WTD.Interface_Mode := Mode_Standard;
      Put_Line (Item => "DiceRoller is running in standard mode.");
   end if;
   --  Set the WTD object according to the amount of dice rolls available.
 
   List_Dice_Rolls (Some_Dice_Rolls => My_Dice_Rolls,
                    A_WTD           => WTD);
   --  Here we list the dice rolls available in My_Dice_Rolls.
   --  See dice-action.ads for more info about List_Dice_Rolls.
 
   loop
      declare
         function User_Command return String;
         --  This function grabs the user input. The method used depends on 
         --  the mode the program is running in. If the Interface_Mode is
         --  Mode_Interactice, the user input is grabbed using Get_Immediate,
         --  else we just use regular Get_Line.
 
         --------------------
         --  User_Command  --
         --------------------
 
         function User_Command return String
         is
         begin
            if WTD.Interface_Mode = Mode_Interactive then
               declare
                  Buffer : String (1 .. 1);
               begin
                  Get_Immediate (Item => Buffer (1));
                  --  Wait here for the user to press a key. When a key is 
                  --  pressed, return it as a String. Get_Immediate reads the 
                  --  next character immediately. The user does not need to 
                  --  press enter to "send" the input.
 
                  return Buffer;
               end;
            else
               return Get_Line;
               --  Note that we don't use a specifically declared buffer to 
               --  hold the user input. Instead we rely on the Get_Line 
               --  function, which simply return the user input as a string. 
               --  This approach requires the user to terminate her input by 
               --  pressing "enter".
            end if;
         end User_Command;
      begin
         Read_Input (A_WTD    => WTD,
                     A_String => User_Command);
         --  Pass WTD and the return value from User_Command to Read_Input. The
         --  Read_Input procedure parse A_String and set the components of WTD
         --  accordingly. See dice-action.ads
 
         if WTD.List_Rolls then
            --  The user entered either 'l' or 'L', so we list the dice
            --  rolls again.
            List_Dice_Rolls (Some_Dice_Rolls => My_Dice_Rolls,
                             A_WTD           => WTD);
         end if;
 
         if WTD.Quit then
            --  The user entered either 'q' or 'Q', so we quit the program,
            --  which in this case simply means exit the loop and fall to
            --  the bottom of the program. We can get away with this
            --  because nothing happens between the final 'end if;' and
            --  the 'exception' statement.
            New_Line (2);
            Put_Line (Item => "DiceRoller exiting.");
            New_Line;
            exit;
         end if;
 
         if WTD.Do_Roll then
            --  A dice roll is requested, so we hand it over to the
            --  Roll_It procedure. Remember that the roll number is stored
            --  in the WTD object (see dice.ads).
            --  My_Dice_Rolls is also passed to Roll_It, because it contains
            --  the actual data about the roll(s). At this point it is not
            --  yet decided whether the requested roll is actually valid,
            --  ie. it exists in the My_Dice_Rolls list of dice rolls. This
            --  is decided in the Roll_It procedure by checking if the
            --  WTD.Roll_Number exists in the My_Dice_Rolls.Vector.
            Roll_It (Some_Dice_Rolls   => My_Dice_Rolls,
                     A_WTD             => WTD);
         end if;
      end;
   end loop;
 
exception
   when Event : File_Error =>
      Put (Item => "ERROR: Cannot load configuration file: ");
      Put_Line (Item => Exception_Message (X => Event));
      --  We cannot load one or more of the given dice roll configuration
      --  files. Output an error message and exit. See dice-cli.ads
   when Help_Needed =>
      Print_Help;
      --  -h or -H found as one of the commandline parameters. Output the help
      --  text and exit the program. See dice-help.ads
   when Too_Many_Rolls_Error =>
      Put_Line (Item => "ERROR: Too many dice rolls configured.");
      Put_Line (Item => "Maximum amount allowed:" &
                Max_Amount_Of_Rolls'Last'Img);
end DiceRoller;

dice.ads

In dice.ads we define all the necessary exceptions and types used in the program.

-------------------------------------------------------------------------------
-- Dice (spec)
--
-- Dice defines the core types and exceptions that are used throughout the
-- DiceRoller program.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Containers.Vectors;  use Ada.Containers;
with Ada.Strings.Unbounded;   use Ada.Strings.Unbounded;
with Ada.Text_IO;             use Ada.Text_IO;
 
package Dice is
   package Result_Container is new Vectors (Positive, Positive);
   package IIO is new Ada.Text_IO.Integer_IO (Integer);
 
   type Mode_Type is (Mode_Interactive, Mode_Standard);
   --  How we interact with the program. Mode_Interactive means that we have
   --  fewer than 10 roll definitions loaded and can execute the roll without
   --  waiting for the Enter key to be pressed. (We could use the order of
   --  magnitude of the roll table to decide whether a second or subsequent
   --  keystroke was needed. E.g., if we knew we loaded 25 roll definitions,
   --  we could accept either a second digit or the Enter key as the stroke
   --  that starts the rolling.)
   --  When using Mode_Standard, we have to follow up with a return to activate
   --  the entered dice roll.
   subtype Dice_Type_Range is Integer range 2 .. 20;
   --  The smallest die we allow is 2 sides, largest 20 sides.
   subtype Dice_Amount_Range is Integer range 1 .. 20;
   --  We can roll no fewer than 1 die, and no more than 20 dice.
   subtype Adjustment_Range is Integer range -20 .. 20;
   --  Biggest bonus is +20 and biggest penalty is -20.
   subtype Max_Amount_Of_Rolls is Integer range 1 .. 100;
   --  Max number of dice rolls we can configure in one or more dice roll
   --  configuration files.
 
   subtype String_256 is String (1 .. 256);
   --  We use the String_256 to read dice roll configuration files. Dice roll
   --  configurations above 256 characters are cut down to 256 characters, and
   --  then evaluated as any other dice roll.
 
   type What_To_Do is record
      Interface_Mode : Mode_Type;
      Roll_Number    : Integer range 0 .. Max_Amount_Of_Rolls'Last := 0;
      Do_Roll        : Boolean := False;
      Quit           : Boolean := False;
      List_Rolls     : Boolean := False;
   end record;
   --  When input is read, we either quit the program, list the rolls or roll
   --  some dice.
   --  if Do_Roll is Boolean True, we try to roll the dice roll in question.
   --  If Quit is Boolean True, we quit the program.
   --  If List_Rolls is Boolean True we output the dice rolls.
 
   type Dice_Rolls is tagged limited private;
private
   type Roll_Spec is tagged record
      Roll_Type   : Unbounded_String;
      Dice_Type   : Dice_Type_Range;
      Dice_Amount : Dice_Amount_Range;
      Adjustment  : Adjustment_Range := 0;
   end record;
   --  The Roll_Spec type defines a single dice roll. A Roll_Spec is build from
   --  the following string:
   --    (xxx)NdS+B  (The "+" may also be a "-".)
   --  Where:
   --    xxx is the Roll_Type. It is not limited to 3 characters, but
   --    please remember the 256-character line length limit.
   --    N is the Dice_Amount (the number of S-sided dice to roll)
   --    S is the Dice_Type (the number of sides on the die)
   --    +/-B is an Adjustment (a bonus or penalty to be applied to the total)
   --  Exaple: (dmg)2d4+2
   --    The roll is documented as a "dmg" ("damage") roll, calculated by
   --    rolling a 4-sided die twice (in physical play, two dice at once),
   --    and adding 2 to the result.
 
   package Roll_Spec_Container is new Vectors (Positive, Roll_Spec);
 
   type Roll is tagged record
      Name        : Unbounded_String;
      Is_Valid    : Boolean := True;
      Roll_Specs  : Roll_Spec_Container.Vector;
   end record;
   --  The Roll type collects a group of Roll_Spec's. The Name element is
   --  fetched from the dice roll configuration string:
   --    Magic Staff:(atk)1d20+2:(dmg)2d4+2
   --  Where:
   --    Magic Staff becomes Name. (This element and all string punctuation
   --    counts against the 256-character line length limit!)
   --  The remainder of the string is used to build one or more Roll_Spec
   --  records.
 
   package Dice_Rolls_Container is new Vectors (Max_Amount_Of_Rolls, Roll);
 
   type Dice_Rolls is tagged limited record
      Vector : Dice_Rolls_Container.Vector;
   end record;
   --  The "main" dice roll record. This record contains a vector of
   --  Parse_Dice_Roll.Roll records, which in turn contains one or more
   --  Parse_Dice_Roll.Roll_Spec records.
end Dice;

dice-cli.ads and dice-cli.adb

The Dice.CLI package provides functionality to check commandline parameters given to the program when it is started.

-------------------------------------------------------------------------------
-- Dice.CLI (spec)
--
-- Defines methods necessary for checking parameters passed to DiceRoller when
-- the program was started.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package Dice.CLI is
   File_Error  : exception;
   --  A File_Error is raised when a dice roll configuration cannot be read by
   --  the program. Raising File_Error should:
   --    1: Inform the user about the missing file
   --    2: Terminate the program
 
   Help_Needed : exception;
   --  A Help_Needed exception is raised if -h/-H option is given when the
   --  program is invoked. Raising Help should:
   --    1: Output the help text
   --    2: Exit the program
 
   procedure Check_Passed_Parameters;
   --  This procedure checks for the -h commandline parameter. If -h is found,
   --  the Help_Needed exception is raised.
   --  If no -h parameter is found Check_Passed_Parameters assumes that any
   --  remaining parameters are files containing dice roll configurations,
   --  each of which is checked. If a file cannot be found, the File_Error
   --  exception is raised.
end Dice.CLI;
-------------------------------------------------------------------------------
-- Dice.CLI (body)
--
-- The methods necessary for checking parameters passed to DiceRoller when
-- the program was started.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Command_Line;        use Ada.Command_Line;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Directories;         use Ada.Directories;
 
package body Dice.CLI is
   -------------------------------
   --  Check_Passed_Parameters  --
   -------------------------------
 
   procedure Check_Passed_Parameters 
   is
   begin
      for i in 1 .. Argument_Count loop
         if To_Lower (Argument (i)) = "-h" then
            raise Help_Needed;
         end if;
 
         if not Exists (Name => Argument (Number => i)) then
            raise File_Error with Argument (Number => i);
         end if;
      end loop;
   end Check_Passed_Parameters;
end Dice.CLI;

dice-help.ads and dice-help.adb

The Dice.Help package handles output of the help (-h commandline parameter) text.

-------------------------------------------------------------------------------
-- Dice.Help (spec)
--
-- Output the DiceRoller help text.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package Dice.Help is
   procedure Print_Help;
   --  Print the DiceRoller help text.
end Dice.Help;
-------------------------------------------------------------------------------
-- Dice.Help (body)
--
-- Output the DiceRoller help text.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package body Dice.Help is
   ------------------
   --  Print_Help  --
   ------------------
 
   procedure Print_Help 
   is
   begin
      New_Line;
      Put_Line (Item => "DiceRoller v. 1.0.0");
      New_Line (1);
      Put_Line (Item => "usage: diceroller [[options]] " &
                "[[dice|roll configuration file(s)]]");
      New_Line (1);
      Put_Line (Item => "Options:");
      Set_Col (To => 5);
      Put_Line (Item => "-h | -H : Output this help");
      Set_Col (To => 1);
      New_Line;
      Put_Line (Item => "Usage example:");
      Set_Col (To => 5);
      Put_Line (Item => "./diceroller rolls_1 rolls_2");
      New_Line;
      Put_Line (Item => "The above example will start the DiceRoller program");
      Put_Line (Item => "and attempt to load the files rolls_1 and rolls2.");
      Put_Line (Item => "You must provide at least one dice roll");
      Put_Line (Item => "configuration file.");
      New_Line;
      Put_Line (Item => "The syntax to describe a roll looks like this:");
      New_Line;
      Set_Col (To => 5);
      Put_Line (Item => "Battleaxe:(atk)1d20:(dmg)1d8");
      New_Line;
      Set_Col (To => 1);
      Put_Line (Item => "Where 'Battleaxe' is the name of the roll, a");
      Put_Line (Item => "20-sided die is rolled once for the (atk) label and");
      Put_Line (Item => "an 8-sided die is rolled once for the (dmg) label.");
      Put_Line ("You can add a bonus or a penalty to a roll like this:");
      New_Line;
      Set_Col (To => 5);
      Put_Line (Item => "Battleaxe:(atk)1d20+2:(dmg)1d8+2");
      New_Line;
      Set_Col (To => 1);
      Put_Line (Item => "In which case 1d20+2 and 1d8+2 are rolled.");
      Put_Line (Item => "You're not limited to (atk) and (dmg) labels. You");
      Put_Line (Item => "make up your own labels if you wish, e.g.:");
      New_Line;
      Set_Col (To => 5);
      Put_Line (Item => "Sword:(normal)2d12+3:(frenzy)4d8+2:(dazed)1d20");
      New_Line;
      Set_Col (To => 1);
      Put_Line (Item => "The name of the roll and the names of the labels");
      Put_Line (Item => "can be set to whatever you like, though the labels");
      Put_Line (Item =>  "MUST be enclosed in ().");
      New_Line;
      Put_Line (Item => "The following limits are imposed on dice roll");
      Put_Line (Item => "configurations:");
      Set_Col (To => 5);
      Put_Line (Item => "A maximum of 100 configured dice rolls allowed.");
      Set_Col (To => 5);
      Put_Line (Item => "Allowed dice range from 2 to 20 sides.");
      Set_Col (To => 5);
      Put_Line (Item => "Maximum number of dice rolled is 20.");
      Set_Col (To => 5);
      Put_Line (Item => "Bonus/penalty range is -20 to +20.");
      Set_Col (To => 5);
      Put_Line (Item => "Maximum 256 characters are allowed to describe ");
      Set_Col (To => 5);
      Put_Line (Item => "a dice roll. Excess characters are ignored.");
      New_Line;
      Set_Col (To => 1);
      Put_Line (Item => "If no dice configuration files are passed to the");
      Put_Line (Item => "program when invoked, a default set of dice is");
      Put_Line (Item => "loaded.");
      New_Line;
      Put_Line (Item => "If fewer than 11 dice rolls are loaded, the program");
      Put_Line (Item => "goes into interactive mode, which basically means");
      Put_Line (Item => "you don't have to press enter when selecting a");
      Put_Line (Item => "roll.");
      Put_Line (Item => "If there are more than 10 dice rolls loaded, the");
      Put_Line (Item => "program goes into standard mode, which means you");
      Put_Line (Item => "will have to press enter to activate a roll.");
      New_Line;
      Put_Line (Item => "The dice roll list is printed by pressing 'l'.");
      Put_Line (Item => "The program is stopped by pressing 'q'.");
      New_Line;
   end Print_Help;
end Dice.Help;

dice-init.ads and dice-init.adb

This package loads the dice roll config file(s). If no file(s) are given, it loads a default set of rolls.

-------------------------------------------------------------------------------
-- Dice.Init (spec)
--
-- Load the dice rolls, either from dice roll configuration files or from
-- a default set of dice rolls.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package Dice.Init is
   Parse_Error : exception;
   --  A Parse_Error is raised when a dice roll configuration string does not
   --  adhere to the proper syntax. Raising Parse_Error should:
   --    1: Warn the user about the failing roll
   --    2: Continue processing the remaining rolls
 
   Too_Many_Rolls_Error : exception;
   --  A Too_Many_Rolls_Error is raised when an attempt is made to load more
   --  than Max_Amount_Of_Rolls dice rolls.
   --  Raising Too_Many_Rolls_Error should:
   --    1: Warn the user about the error.
   --    2: Exit the program.
 
   procedure Initialize 
     (Some_Dice_Rolls : in out Dice_Rolls);
   --  Initialize populates the Dice_Rolls record according to the given
   --  dice roll configuration files.
   --  EXCEPTIONS:
   --    none
private
   procedure Load_Default_Dice 
     (Some_Dice_Rolls : in out Dice_Rolls);
   --  Load an arbitrary set of default dice rolls when no configuration
   --  files are provided.
   --  EXCEPTIONS:
   --    Too_Many_Rolls_Error
 
   procedure Parse 
     (A_Roll             : in out Roll;
      Roll_Config_String : in     String_256);
   --  Parse is responsible for building the Roll and Roll_Spec records from
   --  the dice roll configuration strings. See dice.ads for the format.
   --  A configuration string is parsed and used to build a Roll record
   --  consisting of one or more Roll_Spec records.
   --  EXCEPTIONS:
   --    Parse_Error
 
   procedure Read_Into_List 
     (File_Name       : in     String;
      Some_Dice_Rolls : in out Dice_Rolls);
   --  If a given dice roll configuration file exists (File_Name), this
   --  procedure reads its contents and dispatches each dice roll string to the
   --  Parse procedure. If a roll is parsed successfully, then the roll is
   --  added to the Some_Dice_Rolls.Vector.
   --  EXCEPTIONS:
   --    Too_Many_Rolls_Error
 
   procedure Set_Name 
     (A_Roll             : in out Roll;
      Roll_Config_String : in out Unbounded_String);
   --  Set the A_Roll.Name element based on the dice roll configuration
   --  string Roll_Config_String.
   --  EXCEPTIONS:
   --    Parse_Error
 
   procedure Set_Spec 
     (A_Roll_Spec        : in out Roll_Spec;
      A_Roll             : in out Roll;
      Roll_Config_String : in out Unbounded_String;
      Split_Index        : in     Natural);
   --  Build the Roll_Spec record A_Spec and add it to the A_Roll.Roll_Specs
   --  vector based on the dice roll configuration string
   --  Roll_Config_String.
   --  EXCEPTIONS:
   --    Parse_Error
end Dice.Init;

This is a big one. In here we parse the dice rolls, and parsing is always a somewhat messy and complex affair. Luckily the dice roll configuration format is not too complex, so if you grab a cup of your favorite beverage and arm yourself with some patience, I'm sure you'll get through this one without too much trouble.

-------------------------------------------------------------------------------
-- Dice.Init (body)
--
-- Load the dice rolls, either from dice roll configuration files or from
-- a default set of dice rolls.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Command_Line;  use Ada.Command_Line;
with Ada.Strings;       use Ada.Strings;
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
 
package body Dice.Init is
   ------------------
   --  Initialize  --
   ------------------
 
   procedure Initialize 
     (Some_Dice_Rolls : in out Dice_Rolls) 
   is
   begin
      if Argument_Count > 0 then
         for i in 1 .. Argument_Count loop
            Read_Into_List (File_Name        => Argument (Number => i),
                            Some_Dice_Rolls  => Some_Dice_Rolls);
            --  We will read as many files as are given in the CLI,
            --  as long as the filenames are valid. If the list gets too long,
            --  then the reader will raise an exception.
         end loop;
      else
         Load_Default_Dice (Some_Dice_Rolls => Some_Dice_Rolls);
         --  We have no dice roll configuration files, so lets load a few
         --  default dice.
      end if;
   end Initialize;
 
   -------------------------
   --  Load_Default_Dice  --
   -------------------------
 
   procedure Load_Default_Dice 
     (Some_Dice_Rolls : in out Dice_Rolls) 
   is
      Roll_Array : array (1 .. 6) of String_256;
   begin
      Move (Source => "1d4:(roll)1d4",
            Target => Roll_Array (1),
            Drop   => Right);
      Move (Source => "1d6:(roll)1d6",
            Target => Roll_Array (2),
            Drop   => Right);
      Move (Source => "1d8:(roll)1d8",
            Target => Roll_Array (3),
            Drop   => Right);
      Move (Source => "1d10:(roll)1d10",
            Target => Roll_Array (4),
            Drop   => Right);
      Move (Source => "1d12:(roll)1d12",
            Target => Roll_Array (5),
            Drop   => Right);
      Move (Source => "1d20:(roll)1d20",
            Target => Roll_Array (6),
            Drop   => Right);
 
      for i in Roll_Array'Range loop
         declare
            A_Roll : Roll;
         begin
            Parse (A_Roll              => A_Roll,
                   Roll_Config_String  => Roll_Array (i));
            if A_Roll.Is_Valid then
               Some_Dice_Rolls.Vector.Append (New_Item => A_Roll);
            end if;
         end;
      end loop;
 
   exception
      when Constraint_Error =>
         raise Too_Many_Rolls_Error;
   end Load_Default_Dice;
 
   -------------
   --  Parse  --
   -------------
 
   procedure Parse 
     (A_Roll             : in out Roll;
      Roll_Config_String : in     String_256) 
   is
      A_Spec            : Roll_Spec;
      Raw_Roll_String   : Unbounded_String;
      Split_Index       : Natural;
   begin
      Raw_Roll_String := To_Unbounded_String (Source => Roll_Config_String);
      Trim (Source => Raw_Roll_String, Side   => Both);
      --  Make the Roll_Config_String into an Unbounded_String and Trim it.
      --  We do this because there are some nice tools available for parsing
      --  Unbounded Strings.
 
      Set_Name (A_Roll             => A_Roll,
                Roll_Config_String => Raw_Roll_String);
      --  Lets see if we can grab a valid name from the Raw_Roll_String. Note
      --  that if we successfully parse a roll name, then that part of the
      --  Raw_Roll_String is deleted, so if Raw_Roll_String looks like this
      --  before the Set_Name call
      --    Magic Staff:(atk)1d20+2:(dmg)2d4+2
      --  then it will look like this after Set_Name
      --    (atk)1d20+2:(dmg)2d4+2
 
      loop
         --  We loop until the Raw_Roll_String is empty.
 
         exit when Length (Source => Raw_Roll_String) = 0;
         --  There's no more Raw_Roll_String left. We exit the loop.
 
         Split_Index := Index (Source  => Raw_Roll_String,
                               Pattern => ":");
         --  Figure out the position of the first : in the dice roll
         --  configuration string.
         if Split_Index > 0 then
            --  We have found a : in the dice roll configuration. This means
            --  that it appears that we have at least two dice roll specs, ie.
            --  something like this:  (atk)1d20+2:(dmg)2d4+2.
            --  Next we try to parse the first roll spec and add it to the
            --  Roll_Specs vector using the Set_Spec procedure.
            Set_Spec (A_Roll_Spec         => A_Spec,
                      A_Roll              => A_Roll,
                      Roll_Config_String  => Raw_Roll_String,
                      Split_Index         => Split_Index - 1);
            Delete (Source  => Raw_Roll_String,
                    From    => 1,
                    Through => 1);
            --  Delete the ":"
         else
            Split_Index := Length (Source => Raw_Roll_String);
            --  This is the last dice roll spec, so we set the Split_Index to
            --  the length of the remaining Raw_Roll_String.
            Set_Spec (A_Roll_Spec         => A_Spec,
                      A_Roll              => A_Roll,
                      Roll_Config_String  => Raw_Roll_String,
                      Split_Index         => Split_Index);
         end if;
      end loop;
 
   exception
      when Parse_Error =>
         A_Roll.Is_Valid := False;
         Put (Item => "WARNING: Bad syntax for roll: ");
         Put_Line (Item => Trim (Source => Roll_Config_String, Side => Both));
   end Parse;
 
   ----------------------
   --  Read_Into_List  --
   ----------------------
 
   procedure Read_Into_List 
     (File_Name       : in     String;
      Some_Dice_Rolls : in out Dice_Rolls) 
   is
      Input : File_Type;
   begin
      Open (File => Input,
            Mode => In_File,
            Name => File_Name);
      while not End_Of_File (File => Input) loop
         declare
            A_Roll   : Roll;
            Raw_Roll : String_256;
         begin
            Move (Source => Trim (Source => Get_Line (Input), Side => Both),
                  Target => Raw_Roll,
                  Drop   => Right);
            --  Read a dice roll configuration from the file, and place it in
            --  Raw_Roll. The Move procedure automatically discards characters
            --  if the string is longer than 256 characters and it does so
            --  according to the Drop parameter, which in our case is set to
            --  Right.
            Parse (A_Roll              => A_Roll,
                   Roll_Config_String  => Raw_Roll);
            if A_Roll.Is_Valid then
               Some_Dice_Rolls.Vector.Append (New_Item => A_Roll);
            end if;
         end;
      end loop;
      Close (File => Input);
 
   exception
      when Constraint_Error =>
         raise Too_Many_Rolls_Error;
   end Read_Into_List;
 
   ----------------
   --  Set_Name  --
   ----------------
 
   procedure Set_Name 
     (A_Roll             : in out Roll;
      Roll_Config_String : in out Unbounded_String) 
   is
      First_Colon_Index : Natural;
   begin
      First_Colon_Index := Index (Source  => Roll_Config_String,
                                  Pattern => ":");
      if First_Colon_Index < 2 then
         raise Parse_Error;
         --  We found the first : at position 1 in the Roll_Config_String. This
         --  is not acceptable, so we raise the Parse_Error, which is caught
         --  in the Parse procedure.
      end if;
 
      A_Roll.Name := Unbounded_Slice (Source => Roll_Config_String,
                                      Low    => 1,
                                      High   => First_Colon_Index - 1);
      Trim (Source => A_Roll.Name, Side => Right);
      --  Add the roll name to the Name component of the A_Roll record, and
      --  then trim it for excessive whitespace.
      Delete (Source  => Roll_Config_String,
              From    => 1,
              Through => First_Colon_Index);
      --  Delete the name part and the first : from the Roll_Config_String.
   end Set_Name;
 
   ----------------
   --  Set_Spec  --
   ----------------
 
   procedure Set_Spec 
     (A_Roll_Spec        : in out Roll_Spec;
      A_Roll             : in out Roll;
      Roll_Config_String : in out Unbounded_String;
      Split_Index        : in     Natural) 
   is
      Raw_Spec          : Unbounded_String;
      Open_Parentheses  : Natural; --  Position of the first (
      Close_Parentheses : Natural; --  Position of the first )
      Search_Index      : Natural;
   begin
      Raw_Spec := Unbounded_Slice (Source => Roll_Config_String,
                                   Low    => 1,
                                   High   => Split_Index);
      Trim (Source => Raw_Spec, Side => Both);
      --  Grab the first dice roll specification and trim it for excessive
      --  whitespace.
 
      Open_Parentheses := Index (Source   => Raw_Spec,
                                 Pattern  => "(",
                                 Going    => Backward);
      Close_Parentheses := Index (Source  => Raw_Spec,
                                  Pattern => ")",
                                  Going   => Backward);
      --  Find the positions of the first "(" and ")"
 
      if Open_Parentheses /= 1 or Close_Parentheses < 3 then
         raise Parse_Error;
         --  Invalid parentheses found. The raised Parse_Error is caught in
         --  the Parse procedure.
      end if;
 
      A_Roll_Spec.Roll_Type :=
        Unbounded_Slice (Source => Raw_Spec,
                         Low    => 2,
                         High   => Close_Parentheses - 1);
      Trim (Source => A_Roll_Spec.Roll_Type, Side => Both);
 
      if Length (Source => A_Roll_Spec.Roll_Type) < 3 then
         raise Parse_Error;
         --  The found Roll_Type is too short. It must be at least 3 characters
         --  long.
      end if;
 
      Delete (Source  => Raw_Spec,
              From    => 1,
              Through => Close_Parentheses);
      --  Delete the Roll_Type part of the dice roll specification.
 
      Search_Index := Index (Source  => Raw_Spec,
                             Pattern => "d",
                             Going   => Backward);
      --  Find the position of the first d, as in eg. 1d20
      if Search_Index < 2 then
         raise Parse_Error;
         --  Invalid position. We raise a Parse_Error.
      end if;
 
      A_Roll_Spec.Dice_Amount := Dice_Amount_Range'Value
        (Slice (Source => Raw_Spec,
                Low    => 1,
                High   => Search_Index - 1));
      --  Grab the first number before the d, eg. 1 for 1d20, and cast it as
      --  a Dice_Amount_Range type (Integer range 2 .. 20). If the number found
      --  breaks the constriant of Dice_Amount_Range, a Constraint_Error is
      --  Raised, which we catch at the end of this procedure.
 
      Delete (Source  => Raw_Spec,
              From    => 1,
              Through => Search_Index);
      --  Delete the found number from the dice roll specification.
 
      Search_Index := Index (Source  => Raw_Spec,
                             Pattern => "+");
      --  Search for a + character. If one is found, then we have a positive
      --  adjustment to the dice roll, eg. 1d20+4
 
      if Search_Index /= 0 then
         --  A positive adjustment found!
 
         A_Roll_Spec.Dice_Type := Dice_Type_Range'Value
           (Slice (Source => Raw_Spec,
                   Low    => 1,
                   High   => Search_Index - 1));
         --  Grab the kind of dice to be rolled, eg. 20 dice for a 3d20+2
         --  dice roll. We cast the found value as a Dice_Type_Range type,
         --  and that fails, a Constraint_Error exception is raised.
 
         A_Roll_Spec.Adjustment := Adjustment_Range'Value
           (Slice (Source => Raw_Spec,
                   Low    => Search_Index + 1,
                   High   => Length (Source => Raw_Spec)));
         --  Grab the positive adjustment to the roll, eg. 2 for 1d20+2, and
         --  cast it as a Adjustment_Range type. As usual, the Constraint_Error
         --  exception is raised if we break the constraints of the type.
      else
         --  No positive adjustment found. Perhaps we have a negative?
 
         Search_Index := Index (Source  => Raw_Spec,
                                Pattern => "-");
         --  Search for the - character. If one is found, then we have a
         --  negative adjustment to the dice roll, eg. 2d20-5
 
         if Search_Index /= 0 then
            --  A negative adjustment found!
 
            A_Roll_Spec.Dice_Type := Dice_Type_Range'Value
              (Slice (Source => Raw_Spec,
                      Low    => 1,
                      High   => Search_Index - 1));
            A_Roll_Spec.Adjustment := Adjustment_Range'Value
           (Slice (Source => Raw_Spec,
                   Low    => Search_Index,
                   High   => Length (Source => Raw_Spec)));
            --  The same mechanics as for the positive adjustment above.
         else
            A_Roll_Spec.Dice_Type := Dice_Type_Range'Value
              (To_String (Source => Raw_Spec));
            --  No adjustments found. The last number must be the type of
            --  dice for the roll, eg. 8 for 2d8
         end if;
      end if;
 
      A_Roll.Roll_Specs.Append (New_Item => A_Roll_Spec);
      --  We now have a complete A_Roll_Spec record. Lets append it to the
      --  Roll_Specs vector.
 
      Delete (Source  => Roll_Config_String,
              From    => 1,
              Through => Split_Index);
      --  Finally we delete the roll from the Roll_Config_String.
 
   exception
      when Constraint_Error =>
         raise Parse_Error;
   end Set_Spec;
end Dice.Init;
</codee>
 
==== dice-random.ads and dice-random.adb ====
 
This little gem is responsible for the randomness that is a big part of rolling an actual die.
 
<code ada>
-------------------------------------------------------------------------------
-- Dice.Random (spec)
--
-- Random number generator. Generates the actual dice rolls.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package Dice.Random is
   procedure Get_Random 
     (A_Low         : in     Natural;
      A_High        : in     Natural;
      A_Dice_Amount : in     Natural;
      A_Total       : in out Natural;
      A_Result_List : in out Result_Container.Vector);
   --  Get_Random builds a list of dice roll results and appends them to the
   --  Result_Container.Vector.
   --  The results are random numbers in the range A_Low .. A_High.
   --  An A_Dice_Amount of results are calculated, along with the A_Total,
   --  which is the sum of all the individual dice rolls.
   --  EXCEPTIONS:
   --    none
end Dice.Random;
-------------------------------------------------------------------------------
-- Dice.Random (body)
--
-- Random number generator. Generates the actual dice rolls.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Numerics.Discrete_Random; use Ada.Numerics;
 
package body Dice.Random is
   ------------------
   --  Get_Random  --
   ------------------
 
   procedure Get_Random 
     (A_Low         : in     Natural;
      A_High        : in     Natural;
      A_Dice_Amount : in     Natural;
      A_Total       : in out Natural;
      A_Result_List : in out Result_Container.Vector) 
   is
      subtype My_Range is Integer range A_Low .. A_High;
      package My_Ran is new Discrete_Random (My_Range);
      Randomizer  : My_Ran.Generator;
      Num         : Natural;
   begin
      My_Ran.Reset (Gen => Randomizer);
      for i in 1 .. A_Dice_Amount loop
         Num := My_Ran.Random (Gen => Randomizer);
         A_Total := A_Total + Num;
         A_Result_List.Append (New_Item => Num);
      end loop;
   end Get_Random;
end Dice.Random;

dice-action.ads and dice-action.adb

Count, list, read and roll the dice. It all happens here.

-------------------------------------------------------------------------------
-- Dice.Action (spec)
--
-- Defines various actions to perform on a Dice_Rolls object. Stuff like List,
-- Count, Roll and so on.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
package Dice.Action is
   function Count_Rolls (Some_Dice_Rolls : in Dice_Rolls) return Natural;
   --  Return the number of dice rolls loaded.
   --  EXCEPTIONS:
   --    none
 
   procedure List_Dice_Rolls 
     (Some_Dice_Rolls   : in     Dice_Rolls;
      A_WTD             : in out What_To_Do);
   --  Output the loaded dice rolls with numerical alias and name.
   --  EXCEPTIONS:
   --    none
 
   procedure Read_Input 
     (A_WTD      : in out What_To_Do;
      A_String   : in     String);
   --  Parse and interpret user-input.
   --  EXCEPTIONS:
   --    Constraint_Error
 
   procedure Roll_It 
     (Some_Dice_Rolls  : in     Dice_Rolls;
      A_WTD            : in out What_To_Do);
   --  Perform an actual dice roll and output the result.
   --  EXCEPTIONS:
   --    none
end Dice.Action;
-------------------------------------------------------------------------------
-- Dice.Action (body)
--
-- Defines various actions to perform on a Dice_Rolls object. Stuff like List,
-- Count, Roll and so on.
--
-- Author: Thomas Løcke
-- Copyleft 2010. You may freely do with this source as you wish.
-------------------------------------------------------------------------------
with Ada.Characters.Latin_1;     use Ada.Characters.Latin_1;
with Ada.Characters.Handling;    use Ada.Characters.Handling;
with Ada.Text_IO.Unbounded_IO;   use Ada.Text_IO.Unbounded_IO;
with Dice.Random;                use Dice.Random;
 
package body Dice.Action is
   -------------------
   --  Count_Rolls  --
   -------------------
 
   function Count_Rolls 
     (Some_Dice_Rolls : in Dice_Rolls) 
      return Natural 
   is
   begin
      return Natural (Some_Dice_Rolls.Vector.Length);
   end Count_Rolls;
 
   ------------
   --  List  --
   ------------
 
   procedure List_Dice_Rolls 
     (Some_Dice_Rolls   : in Dice_Rolls;
      A_WTD             : in out What_To_Do) 
   is
      package IIO is new Integer_IO (Natural);
      SDR      : Dice_Rolls renames Some_Dice_Rolls;
      --  We rename Some_Dice_Rolls to lessen the typing burden.
      A_Roll   : Roll;
   begin
      New_Line;
      Put_Line (Item => "List of registered Dice Rolls:");
      Set_Col (To => 2);
      Put_Line (Item => "Enter " & Quotation & "l" & Quotation &
                " to list rolls.");
      Set_Col (To => 2);
      Put_Line (Item => "Enter " & Quotation & "q" & Quotation & " to quit");
 
      for i in SDR.Vector.First_Index .. SDR.Vector.Last_Index loop
         A_Roll := SDR.Vector.Element (Index => i);
         Set_Col (To => 2);
         Put (Item => "Enter " & Quotation);
         IIO.Put (Item  => i, Width => 1);
         Put (Item => Quotation & " to roll ");
         Put_Line (Item => A_Roll.Name);
      end loop;
 
      A_WTD.List_Rolls := False;
      --  Reset the List_Rolls component to Boolean False
 
      New_Line;
      Put (Item => "Enter your choice: ");
   end List_Dice_Rolls;
 
   ------------------
   --  Read_Input  --
   ------------------
 
   procedure Read_Input 
     (A_WTD      : in out What_To_Do;
      A_String   : in     String) 
   is
   begin
      if To_Lower (A_String (A_String'First)) = 'q' then
         A_WTD.Quit := True;
      elsif To_Lower (A_String (A_String'First)) = 'l' then
         A_WTD.List_Rolls := True;
      else
         A_WTD.Roll_Number := Integer'Value (A_String);
         --  Try to convert user input to an Integer. A Constraint_Error is
         --  raised if this fails.
         A_WTD.Do_Roll := True;
      end if;
 
   exception
      when Constraint_Error =>
         A_WTD.Roll_Number := 0;
         A_WTD.Do_Roll := True;
         --  The user input, A_String, could not be converted to an Integer.
         --  We set the Roll_Number component to 0 and Do_Roll to Boolean True.
         --  The Roll_It procedure simply return a "unknown dice roll" on 0.
   end Read_Input;
 
   ---------------
   --  Roll_It  --
   ---------------
 
   procedure Roll_It 
     (Some_Dice_Rolls  : in     Dice_Rolls;
      A_WTD            : in out What_To_Do) 
   is
      SDR      : Dice_Rolls renames Some_Dice_Rolls;
      A_Roll   : Roll;
   begin
      if A_WTD.Roll_Number <= SDR.Vector.Last_Index
        and A_WTD.Roll_Number >= SDR.Vector.First_Index then
         A_Roll := SDR.Vector.Element (Index => A_WTD.Roll_Number);
         New_Line (2);
         Put_Line (Item => "Rolling: " & A_Roll.Name);
         for i in
           A_Roll.Roll_Specs.First_Index .. A_Roll.Roll_Specs.Last_Index loop
            declare
               A_Spec      : constant Roll_Spec :=
                 A_Roll.Roll_Specs.Element (Index => i);
               --  We declare A_Spec a constant because we don't need to alter
               --  its value.
               Result_List : Result_Container.Vector;
               --  We keep track of the results in this vector.
               Total       : Natural := 0;
            begin
               Put (Item => A_Spec.Roll_Type & ": ");
               Get_Random (A_Low          => 1,
                           A_High         => A_Spec.Dice_Type,
                           A_Dice_Amount  => A_Spec.Dice_Amount,
                           A_Total        => Total,
                           A_Result_List  => Result_List);
               --  Roll the dice! All the results are appended to the
               --  Result_List vector.
               IIO.Put (Item  => Total + A_Spec.Adjustment,
                        Width => 3);
               --  Output the result of the roll.
 
               Set_Col (To => Col + 3);
               for i in Result_List.First_Index .. Result_List.Last_Index loop
                  IIO.Put (Item  => Result_List.Element (Index => i),
                           Width => 1);
                  if i < Result_List.Last_Index then
                     Put (Item => "+");
                  end if;
               end loop;
               --  In this loop we output the roll sequence, in case the roll
               --  requires more than one die.
 
               if A_Spec.Adjustment < 0 then
                  Put (Item => "(");
                  IIO.Put (Item  => A_Spec.Adjustment,
                           Width => 1);
                  Put (Item => ")");
                  --  Output the (-n) parentheses
               elsif A_Spec.Adjustment >= 0 then
                  Put (Item => "(+");
                  IIO.Put (Item  => A_Spec.Adjustment,
                           Width => 1);
                  Put (Item => ")");
                  --  Output the (+n) parentheses
               end if;
               New_Line;
            end;
         end loop;
      else
         if A_WTD.Interface_Mode = Mode_Interactive then
            New_Line (2); --  Output two newlines when using interactive mode.
         else
            New_Line; --  Output one newline when using standard mode.
         end if;
         Put_Line (Item => "Unknown dice roll. Try again.");
      end if;
 
      A_WTD.Do_Roll := False;
      --  We did what we set out to do, so now we reset the Do_Roll component
      --  to Boolean False.
      New_Line;
      Put (Item => "Enter your choice: ");
   end Roll_It;
end Dice.Action;

Final thoughts

Because this project is a bit larger than the usual “thirty-something lines of code” tutorial program, I decided I would go for a style where the source was heavily commented and available in full. I tried dividing the code up into smaller bits and write some explanations, but it felt disjointed and wrong. If you feel that the commented source code is a bad idea, and you would like some additional explanations here and there, please feel free to ping Thomas Løcke @ Google+ or any Ada-DK member at the Ada-DK Google+ page.

Enjoy!


Navigation