[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]

unit Dices;
(*
  Handy if you need to throw dices.
  Can only handle the basic notation "AdB+C"


  If you have any improvement ideas, or you use this unit in
  your programs, send me email. 
  
  Feel free to do whatever you wish with this.

            pkalli@cs.joensuu.fi
*)

interface

type
     Dicenum = integer; {could be longint}
     Dice = object
                  private
                  times,
                  sides,
                  bonus:Dicenum;  (*AdB+C*)

                  public
                  procedure Init(tim,sid,bon:Dicenum);
                  procedure InitRange(minimum,maximum:Dicenum);
                  function  Throw:longint;
                  function  Dice2Str:string;
                  function  Str2Dice(st:string):boolean;
                  function  Min:longint;
                  function  Max:longint;
            end;


implementation

const
     plussign  = '+';
     minussign = '-';
     Dicesign  = 'd';
     Dicesign2 = 'D';

procedure Dice.Init(tim,sid,bon:Dicenum);
(*Sets Dice values*)
begin
     times:=tim;
     sides:=sid;
     bonus:=bon;
end; (*Dice.Init*)

procedure Dice.InitRange(minimum,maximum:Dicenum);
(*Sets Dice range. 
  Ugh! What code. But it seems to work, so...*)
var tmp:Dicenum;
    tmp2:Dicenum;
begin
     times:=0;
     sides:=0;
     bonus:=0;
     if minimum>maximum then begin
        tmp:=minimum;
        minimum:=maximum;
        maximum:=tmp;
     end;
     tmp:=0;
     tmp2:=0;
     if minimum=maximum then begin
        bonus:=minimum;
     end else begin
         if minimum=0 then begin
            inc(minimum);
            inc(maximum);
            inc(tmp2);
         end else
         if minimum<1 then begin
            inc(tmp2,abs(minimum*2));
            inc(minimum,tmp2);
            inc(maximum,tmp2);
         end;
         while ((maximum mod minimum)<>0) and (minimum>1) do begin
              dec(minimum);
              dec(maximum);
              inc(tmp);
         end;
         if (maximum mod minimum)=0 then begin
               bonus:=(maximum mod minimum)+tmp-tmp2;
               sides:= maximum div minimum;
               times:= minimum;
         end else begin
             writeln('koe!');
                bonus:=minimum-1-tmp-tmp2;
                sides:=maximum-minimum+1;
                times:=1;
         end;
     end;
end; (*Dice.InitRange*)

function Dice.Throw:longint;
(*Throws the Dices*)
var x:longint;
    tmp:dicenum;
begin
     x:=0;
     tmp:=times;
     while (tmp>0) do begin
        inc(x,Random(sides)+1);
        dec(tmp);
     end;
     inc(x,bonus);
     if x<0 then x:=0;
     Throw:=x;
end; (*Dice.Throw*)

function Dice.Dice2Str:string;
(*Converts Dice to String*)
var st,t:string;
begin
     st:='';
     if (times>0) then begin
        str(times,t);
        st:=st+t+Dicesign;
        str(sides,t);
        st:=st+t;
        if bonus>0 then st:=st+plussign;
     end;
     if (bonus<>0) then begin
        str(bonus,t);
        st:=st+t;
     end else if (sides=0) and (times=0) then st:='0';
     Dice2Str:=st;
end; (*Dice.Dice2Str*)

function Dice.Str2Dice(st:string):boolean;
(*Converts String to Dice.
  Returns true if there occurred any errors, false otherwise*)
const sign:char = '+';
var errcode,errcount:integer;
    dsign:char;
begin
     sides:=0;
     times:=0;
     bonus:=0;
     errcount:=0;
     if pos(Dicesign,st)>0 then dsign:=Dicesign else dsign:=Dicesign2;
     if (pos(Dsign,st)>0) then begin
        Val(copy(st,1,pos(dsign,st)-1),times,errcode);
        if errcode<>0 then times:=1;
        if (pos(minussign,st)>0) then sign:=st[pos(minussign,st)];
        if (pos(sign,st)>0) then begin

Val(copy(st,pos(dsign,st)+1,pos(sign,st)-pos(dsign,st)-1),sides,errcode);
           inc(errcount,errcode);
           Val(copy(st,pos(sign,st),length(st)),bonus,errcode);
           inc(errcount,errcode);
        end else begin
            Val(copy(st,pos(dsign,st)+1,length(st)),sides,errcode);
        end;
     end else begin
         val(st,bonus,errcode);
         inc(errcount,errcode);
     end;
     Str2Dice:=(errcount<>0);
end; (*Dice.Str2Dice*)

function Dice.Min:longint;
(*Returns the min. number dice can give*)
begin
     Min:=bonus+times;
end; (*Dice.Min*)

function Dice.Max:longint;
(*Returns the max. number dice can give*)
begin
     Max:=bonus+(times*sides);
end; (*Dice.Max*)

begin
     Randomize;
end.

[Back to MISC SWAG index]  [Back to Main SWAG index]  [Original]