-
Notifications
You must be signed in to change notification settings - Fork 2
/
GemMetalJewelry.pm
142 lines (116 loc) · 4.23 KB
/
GemMetalJewelry.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
package Random::GemMetalJewelry;
use v5.10.0;
use strict;
use warnings;
use Exporter qw(import);
use Lingua::EN::Inflect qw(A);
use Fancy::Rand qw(fancy_rand);
use Fancy::Join::Grammatical qw(grammatical_join);
our $VERSION = '1.000';
our @EXPORT_OK = qw(random_gem random_gem_variety random_gem_color random_gem_cut random_metal random_jewelry random_gem_expanded);
my %gem_varieties = (
'unsorted' => [qw(diamond garnet spinel topaz tourmaline zircon crystal)],
'beryl' => [qw(emerald aquamarine)],
'chalcedony' => [qw(agate bloodstone carnelian jasper onyx sard sardonyx)],
'corundum' => [qw(ruby sapphire)],
'quartz' => [qw(amethyst citrine), map("$_ quartz",('milky','rose','smokey'))],
'organic' => [qw(amber coral ivory jet pearl seashell)],
'metal' => [qw(aluminum brass bronze cobalt copper electrum gold iron lead nickel pewter platinum silver steel tin titanium)],
);
my %gem_colors = (
'diamond' => [qw(black blue brown colorless gray green pink red yellow)],
'garnet' => [qw(black brown colorless green orange pink purple red violet yellow)],
'sapphire' => [qw(blue colorless green pink yellow)],
'spinel' => [qw(blue orange pink red)],
'topaz' => [qw(blue green pink yellow brown orange)],
'gold' => [qw(blue black green gray pink purple red rose white yellow)],
);
my %gem_cuts = (
'brilliant' => [qw(oval round)],
'fancy' => [qw(marquise pendeloque scissors)],
'mixed' => [qw(cushion mixed)],
'step' => [qw(baguette octagon oval square table)],
'other' => [qw(bead carving cabochon polished)],
);
my @jewelry = (
qw(anklet bracelet brooch chatelaine crown earrings necklace ring tiara),
'belt buckle', 'cuff link', 'tie bar', 'wrist watch', 'pocket watch'
);
my @gems;
for my $gems_key (grep(!/metal/,keys %gem_varieties)) {
push @gems, @{$gem_varieties{$gems_key}};
}
sub random_gem_variety {
my ($user_variety, $user_additions) = @_;
my $gem_variety = fancy_rand(\%gem_varieties, $user_variety, { caller => 'random_gem_variety', additions => $user_additions ? $user_additions : undef });
return $gem_variety;
}
sub random_gem_color {
my ($user_color, $user_additions) = @_;
my $gem_color = fancy_rand(\%gem_colors, $user_color, { caller => 'random_gem_color', additions => $user_additions ? $user_additions : undef });
return $gem_color;
}
sub random_gem_cut {
my ($user_cut, $user_additions) = @_;
my $gem_cut = fancy_rand(\%gem_cuts, $user_cut, { caller => 'random_gem_cut', additions => $user_additions ? $user_additions : undef });
return $gem_cut;
}
sub random_gem_expanded {
my ($user_gem) = @_;
my $base_gem = $user_gem ? random_gem_variety($user_gem) : random_gem_variety;
my $gem;
if ($gem_colors{$base_gem}) {
my $gem_color = random_gem_color($base_gem);
$gem = "$gem_color $base_gem";
}
else {
$gem = $base_gem;
}
return $gem;
}
sub random_gem {
my $user_gem = shift;
$gem_varieties{'no metal'} = [map { @$_ } @gem_varieties{ grep $_ ne 'metal', keys %gem_varieties }];
my $gem = $user_gem ? random_gem_variety($user_gem) : random_gem_variety('no metal');
delete $gem_varieties{'no metal'};
return $gem;
}
sub random_metal {
random_gem_variety('metal');
}
sub random_jewelry {
my $user_gems = shift;
my $gem_varieties = $user_gems ? $user_gems : 0;
my $piece = $jewelry[rand @jewelry];
my $metal = random_metal;
my $item = A("$metal $piece");
if ($gem_varieties and $gem_varieties > 0) {
my @jewlery_gems = map(random_gem_expanded, 1..$gem_varieties);
my $jewlery_gems_text = grammatical_join('and', @jewlery_gems);
return "$jewlery_gems_text on $item";
}
elsif ($gem_varieties != 0) {
return "$item";
}
else {
my $roll = int(rand(100));
if ($roll <= 30) {
return "$item";
}
elsif ($roll <= 50) {
return random_jewelry(1);
}
elsif ($roll <= 75) {
return random_jewelry(2);
}
elsif ($roll <= 90) {
return random_jewelry(3);
}
else {
return random_jewelry(4);
}
}
}
# This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See https://dev.perl.org/licenses/artistic.html.
# Copyright © 2020, Lady Aleena (aleena@cpan.org). All rights reserved.
1;