Program random_dice;
uses crt, strings;
var
dice : array[1..3] of string;
roll_index, roll_num : integer;
roll_history : packed array[1..1000] of integer;
rand_table : array[1..100,1..100] of integer;
values : boolean;
init_count : integer;
delay_index : integer;
tolong : boolean;
function is_integer(input : string) : boolean;
var i : integer;
temp : integer;
begin
for i:=1 to strlen(input) do begin
if temp<> 0 then begin
case ord(input[i]) of
48 : temp := 1;
49 : temp := 1;
50 : temp := 1;
51 : temp := 1;
52 : temp := 1;
53 : temp := 1;
54 : temp := 1;
55 : temp := 1;
56 : temp := 1;
57 : temp := 1;
else temp := 0;
end;end;
end;
if temp = 1 then is_integer := true else is_integer := false;
end;
function change_to_integer(input : string) : integer;
var i : integer;change : integer;
begin
change := 0;
for i:=1 to strlen(input) do begin
if input[i] = '1' then begin
if change = 0 then change := 1
else change := (change * 10) + 1;
end;
if input[i] = '2' then begin
if change = 0 then change := 2
else change := (change * 10) + 2;
end;
if input[i] = '3' then begin
if change = 0 then change := 3
else change := (change * 10) + 3;
end;
if input[i] = '4' then begin
if change = 0 then change := 4
else change := (change * 10) + 4;
end;
if input[i] = '5' then begin
if change = 0 then change := 1
else change := (change * 10) + 5;
end;
if input[i] = '6' then begin
if change = 0 then change := 6
else change := (change * 10) + 6;
end;
if input[i] = '7' then begin
if change = 0 then change := 7
else change := (change * 10) + 7;
end;
if input[i] = '8' then begin
if change = 0 then change := 8
else change := (change * 10) + 8;
end;
if input[i] = '9' then begin
if change = 0 then change := 9
else change := (change * 10) + 9;
end;
if input[i] = '0' then begin
if change = 0 then change := 0
else change := (change * 10) + 0;
end;
end;
change_to_integer := change;
end;
procedure change_text(input_opp : string);
var i : string[50];p : integer;
begin
if (input_opp = 'change color') or (input_opp = 'color') then begin
writeln('Enter color : ');
readln(i);
if is_integer(i) then begin
p := change_to_integer(i);
textcolor((p mod 15) + 1);
end
else begin
writeln('Sorry that was not a integer, please try again.');
change_text('color');
end;
end;
end;
procedure fill_rand;
var
x, y : integer;
begin
if values = true then write('Creating random value tables : ');
for x:=1 to 100 do begin
for y := 1 to 100 do rand_table[x, y] := random(600);
end;
if values = true then writeln('Done');
end;
function rand_number : integer;
{this is the random number genarator
it get numbers by fillling a 2d array with random numbers in the
range 1-100, then plucking one at random, and applying mod 6
to get a dice number}
var temp : integer;
begin
fill_rand;
temp := rand_table[random(99) + 1, random(99) + 1];
temp := (temp mod 6) + 1;
rand_number := temp;
end;
procedure update_history(roll, index : integer);
begin
roll_history[index] := roll;
end;
function roll_similarity(look_up, place : integer) : real;
var count, i : integer;
begin
count := 0;
for i:=1 to place do begin
if roll_history[i] = look_up then count := count + 1;
end;
roll_similarity := (count / place) * 100;
end;
function roll_amount(look_up, place : integer) : integer;
var count, i : integer;
begin
count := 0;
for i:=1 to place do begin
if roll_history[i] = look_up then count := count + 1;
end;
roll_amount := count;
end;
function anaylse_opp(input:string; amount:integer) : boolean;
var i, z : integer;tempry : string[120];
begin
anaylse_opp := false;
if input = '? cache' then begin
writeln('the cache command will just list all item in the history array, this contains 100 places.');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? clear' then begin
writeln('The clear command will clear the history and reset the number of rolls to 0');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? stats' then begin
writeln('This displays the number of times each number has been rolled, and the % of the rolls thats are that number');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? rand' then begin
writeln('fills the rand table with random number');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? write rand' then begin
writeln('This will write out the contence of the rand table');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? mod rand' then begin
writeln('This does a write rand but apply mod 6 to each number');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? check off' then begin
writeln('This will turn information labels off');
writeln('Information labels tell you what is going on.');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? check on' then begin
writeln('This will turn on the information labels');
writeln('It will then prompt you for a delay index, this has to be a integer.');
writeln('The use of this is so that, for example when you use the cache commmand,');
writeln('it will delay it by the delay index before wrighting the next entry.');
writeln('If this is not a integer, then it will be regected, and checks will be turned off');
writeln('and the delay index cleared.');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? text' then begin
writeln('This command will bring up the text command prompt,');
writeln('The available command are color, this will then prompt you for a color');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? dump' then begin
writeln('This command will reset all variables to 0');
anaylse_opp := true;
readln;
clrscr;
end;
if input = '? write dump' then begin
writeln('This will peform a dump but writes out all variables while it does it');
anaylse_opp := true;
readln;
clrscr;
end;
if (input = '?') or (input = 'help') then begin
writeln('The commands for use are : ');
writeln(' cache : displays the history or rolls');
writeln(' clear : clears the history');
writeln(' stats : displays various statsistics for the rolls in history');
writeln(' rand : refills the random table');
writeln(' write rand : writes out the rand table, fill it with rand first');
writeln(' mod rand : write out the rand table with mod 6 attached to the number');
writeln(' check off : turns off the labels which tell you whats happening');
writeln(' check on : turns on the labels, then prompts you for a delay index');
writeln(' which delays the labels so you have time to read them');
writeln(' text : brings up the command for text changes');
writeln(' dump : this will dump all variables');
writeln(' write dump : write out the contence of the dump');
writeln(' exit : qute program straight away.');
writeln('type ? followed by a command for more help on it');
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'cache') or (input = 'history') then begin for i:=1 to amount do begin
writeln('Roll number ',i, ' = ',roll_history[i]); delay(2);
delay(delay_index);
end;
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'clear') or (input = 'dump cache') then begin
write('Clearing roll history');
for i:=1 to amount do roll_history[i] := 0;
roll_num := 1;
writeln(' : Done');
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'stats') then begin
for i:=1 to 6 do
begin
writeln(i,' has had a total if ',roll_similarity(i,amount):2:1,'% of the last ',amount,' rolls.');
writeln('which is an occurance of ',roll_amount(i, amount),' times');
end;
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'rand') or (input = 'fill rand table') then begin
fill_rand;
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'write rand') or (input = 'write rand table') then begin
if rand_table[1, 1] <> 0 then for i:=1 to 100 do begin for z:=1 to 100 do write(' ',rand_table[i, z]);end;
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'mod rand') then begin
if rand_table[1, 1] <> 0 then for i:=1 to 100 do begin for z:=1 to 100 do write(' ',((rand_table[i, z]) mod 6 ) + 1);end;
anaylse_opp := true;
readln;
clrscr;
readln;
end;
if (input = 'check off') or (input = 'checks off') then begin
values := false;
writeln('Checks are now off');
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'check on') or (input = 'checks on') then begin
values := true;
writeln('Please enter delay index : ');
readln(tempry);
if is_integer(tempry) then delay_index := change_to_integer(tempry)
else begin writeln('Im sorry you did not enter a correct delay index');
writeln('Therfore checks are now switched to off');values := false; delay_index := 0;end;
writeln('Checks are now on with a delay of ',delay_index);
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'dump') then begin
write('Dumping all variables ');
for i := 1 to 1000 do roll_history[i] := 0;
for i := 1 to 3 do dice[i] := '';
roll_index := 0;
roll_num := 0;
values := false;
init_count := 0;
delay_index := 0;
for i:=1 to 100 do for z :=1 to 100 do rand_table[i,z] := 0;
writeln('Done');
anaylse_opp := true;
readln;
clrscr;
end;
if (input = 'write dump') then begin
write('Dumping all variables ');
writeln('Dunping history');delay(delay_index);
for i := 1 to 1000 do begin write(' ',roll_history[i]);roll_history[i] := 0;delay(delay_index);end;
writeln;
writeln('Dumping dice');delay(delay_index);
for i := 1 to 3 do begin write(' ',dice[i]);dice[i] := '';delay(delay_index);end;
writeln('Dumping roll index');delay(delay_index);
write(' ',roll_index);
roll_index := 0;
writeln('Dumping roll num');delay(delay_index);
write(' ',roll_num);
roll_num := 0;
writeln('Dumping values');delay(delay_index);
write(' ',values);
values := false;
writeln('Dumping init_count');delay(delay_index);
write(' ',init_count);
init_count := 0;
writeln('Dumping roll num');delay(delay_index);
for i:=1 to 100 do for z :=1 to 100 do begin write(' ',rand_table[i,z]);rand_table[i,z] := 0;delay(delay_index);end;
writeln('Dumping delay index');
write(' ',delay_index);delay(delay_index);
delay_index := 0;
anaylse_opp := true;
writeln('Done');
readln;
clrscr;
end;
if (input = 'text opptions') or (input = 'text') or (input = 'text opp') then begin
writeln('Enter in your text command : ');
readln(tempry);
change_text(tempry);
anaylse_opp := true;
readln;
clrscr;
end;
if input = 'exit' then begin
writeln('Thank you for using random dice roller.');
writeln(' Written by joey ciechanowicz');
delay(2000);
halt;
end;
end;
procedure map_dice(roll : integer);
begin
if values = true then begin write('Mapping dice : ');delay(delay_index);write('.');delay(delay_index);write('.');delay(delay_index);writeln('.');writeln('done');end;
case roll of
1 : begin
dice[1] := ' ';
dice[2] := ' . ';
dice[3] := ' ';
end;
2 : begin
dice[1] := ' . ';
dice[2] := ' ';
dice[3] := ' . ';
end;
3 : begin
dice[1] := '. ';
dice[2] := ' . ';
dice[3] := ' .';
end;
4 : begin
dice[1] := '. .';
dice[2] := ' ';
dice[3] := '. .';
end;
5 : begin
dice[1] := '. .';
dice[2] := ' . ';
dice[3] := '. .';
end;
6 : begin
dice[1] := '. . .';
dice[2] := ' ';
dice[3] := '. . .';
end;
end; {case}
end;
Procedure draw_dice(roll : integer);
var i : integer;
begin
map_dice(roll);
clrscr;
writeln;
case roll of
1 : for i:=1 to 3 do writeln(dice[i]);
2 : for i:=1 to 3 do writeln(dice[i]);
3 : for i:=1 to 3 do writeln(dice[i]);
4 : for i:=1 to 3 do writeln(dice[i]);
5 : for i:=1 to 3 do writeln(dice[i]);
6 : for i:=1
