@program kurinzonian-crossbreeding.muf
1 1000 d
i
$include $lib/alynna
lvar param
lvar sex1
lvar species11
lvar species12 
lvar sex2
lvar species21
lvar species22
lvar cubgender
lvar cubspecies1
lvar cubspecies2

$def HERMTABLE "{chakat}"
 
: 1d100 ( -- i )
random 100 % 1 +
;
 
: succeed? ( i -- b )
1d100 swap >=
;

: sexsanity
( Sex sanity for all herm species ) 
cubspecies1 @ HERMTABLE smatch if "herm" cubgender ! then
cubspecies2 @ if cubspecies2 @ HERMTABLE smatch if "herm" cubgender ! then then
;

: helpmedamnit
{
"Kurinzonian crossbreeding - Alynna Trypnotk"
" "
"Syntaxes:"
" All breed commands should place the kit bearer first."
" Therefore, only female or herm is taken in the first parameter, "
" and only male or herm in the second. "
" "
" For parents of single species:"
"  breed <female|herm>:<species>=<male|herm>:<species>"
" "
" For a single crossbreed parent:"
"  breed <female|herm>:<species1>/<species2>=<male|herm>:<species>"
"  breed <female|herm>:<species>=<male|herm>:<species1>/<species2>"
" "
" For a two crossbreed parents:"
"  breed <female|herm>:<species1>/<species2>=<male|herm>:<species1>/<species2>"
" "
" To view the formulae for breeding:"
"  breed #formulae"
} array_make atellme
;
: helpmedamnit2
{
"Kurinzonian crossbreeding - Alynna Trypnotk"
" "
"Formulae:"
" Cub counts: 1d100"
"  1-79:       1 cub"
"  80-94:      2 cubs"
"  95-100:     1d7+2"
"   3-9:       the number of cubs"
" Gender determination:"
"  Male-Female: 1d100"
"   1-45:      male"
"   45-90:     female"
"   91-100:    hermaphrodite"
"  Male-herm or female-herm:"
"   1-33:      male"
"   34-66:     female"
"   67-100:    hermaphrodite"
"  Herm-herm:"
"   1-16:      male"
"   17-33:     female"
"   34-100:    hermaphrodite"
" Species determinations:"
"  Parents same species: 1d100"
"   1-100:     Parents species"
"  Parents both crossbreeds but share the same pair of species: 1d100"
"   1-100:     Parents primary and secondary species"
"  Parents different species, neither is a crossbreed: 1d100"
"   1-33:      Fathers species"
"   34-50:     Crossbreed"
"              (Mothers species primary, fathers secondary,"
"               even though equally represented in form)"
"   51-100:    Mothers species"
"  Parents different species, mother is a crossbreed: 1d100"
"   1-33:      Fathers species"
"   34-66:     Mothers primary species"
"   67-100:    Mothers secondary species"
"  Parents different species, father is a crossbreed: 1d100"
"   1-16:      Fathers primary species"
"   17-33:     Fathers secondary species"
"   34-100:    Mothers species"
"  Both parents crossbreeds: 1d100"
"   1-16:      Fathers primary species"
"   17-33:     Fathers secondary species"
"   34-66:     Mothers primary species"
"   67-100:    Mothers secondary species"
} array_make atellme
;

: parsecmdline ( s -- b )
var tmp
var count
var tmp1
var tmp2
var tmpa
( seperate at = )
"=" explode count !
 
( only 2 params legal )
count @ 2 = not if count @ popn 0 exit then
 
( seperate first parameter at : )
":" explode array_make tmpa !
 
( sex and species legal only )
tmpa @ array_count 2 = not if pop 0 exit then
tmpa @ array_vals pop sex1 !
 
( seperate species at / )
"/" explode array_make tmpa !
 
( 1 or 2 params only )
tmpa @ array_count 1 < if pop 0 exit then
tmpa @ array_count 2 > if pop 0 exit then
 
( fill species parameters )
tmpa @ array_vals count ! 
 count @ 2 = if species11 !    species12 ! then
 count @ 1 = if species11 ! "" species12 ! then

( seperate second parameter at : )
":" explode array_make tmpa !
 
( sex and species legal only )
tmpa @ array_count 2 = not if 0 exit then
tmpa @ array_vals pop sex2 !
 
( seperate species at / )
"/" explode array_make tmpa !
 
( 1 or 2 params only )
tmpa @ array_count 1 < if 0 exit then
tmpa @ array_count 2 > if 0 exit then
 
( fill species parameters )
tmpa @ array_vals count ! 
 count @ 2 = if species21 !    species22 ! then
 count @ 1 = if species21 ! "" species22 ! then

( return 1 )
1
;

: getcubcount ( -- i )
var result
1d100 case
 80 <= when "One cub spawned." "Breed" pretty tellhere 1 end
 95 <= when "Two cubs spawned." "Breed" pretty tellhere 2 end
    default random 7 % 3 +
            { over " cubs spawned." }cat "Breed" pretty tellhere end
endcase 
;

: getsex ( -- b )
var result
var s1
var s2
var male
var female
var herm

sex1 @ 1 strcut pop tolower s1 !
sex2 @ 1 strcut pop tolower s2 !
"mfh" s1 @ instr not if "Required: male/female/herm in parent #1" "Breed" pretty tellhere 0 exit then
"mfh" s2 @ instr not if "Required: male/female/herm in parent #2" "Breed" pretty tellhere 0 exit then
s1 @ "f" smatch s2 @ "m" smatch and if 45 male ! 90 female ! 100 herm ! then
s1 @ "h" smatch s2 @ "m" smatch and if 33 male ! 66 female ! 100 herm ! then
s1 @ "f" smatch s2 @ "h" smatch and if 33 male ! 66 female ! 100 herm ! then
s1 @ "h" smatch s2 @ "h" smatch and if 16 male ! 33 female ! 100 herm ! then
1d100 case
 male @   <= when "male"   cubgender ! end
 female @ <= when "female" cubgender ! end
 herm @   <= when "herm"   cubgender ! end
 default          "neuter" cubgender ! end
endcase
1
;

: getspecies ( -- b )
( Purebloods have no speciesx2 )
0 cubspecies1 !
0 cubspecies2 !

( Purebloods of the same species always have the same species cubs )
species11 @ species21 @ smatch 
species12 @ not and 
species22 @ not and if
 species11 @ cubspecies1 ! 
 1 exit 
 then

( Crossbreeds of the same species, primary and secondary always have crossbreeds based on mom )
species11 @ species21 @ smatch 
species12 @ species22 @ smatch and
species11 @ species22 @ smatch 
species12 @ species21 @ smatch and or if
 species11 @ cubspecies1 ! 
 species12 @ cubspecies2 !
 1 exit 
 then

( Purebloods have their algorithm... )
species11 @ species21 @ smatch not 
species12 @ not and 
species22 @ not and if
 1d100 case
   33 <= when species21 @ cubspecies1 ! end
   50 <= when species11 @ cubspecies1 ! species21 @ cubspecies2 ! end  
  100 <= when species11 @ cubspecies1 ! end
 endcase
 1 exit  
 then

( Mom is a crossbreed... )
species11 @ species21 @ smatch not 
species12 @ and 
species22 @ not and if
 1d100 case
   33 <= when species21 @ cubspecies1 ! end
   66 <= when species11 @ cubspecies1 ! end  
  100 <= when species12 @ cubspecies1 ! end
 endcase
 1 exit  
 then

( Dad is a crossbreed... )
species11 @ species21 @ smatch not 
species12 @ not and 
species22 @ and if
 1d100 case
   16 <= when species21 @ cubspecies1 ! end
   33 <= when species22 @ cubspecies1 ! end  
  100 <= when species11 @ cubspecies1 ! end
 endcase
 1 exit  
 then

( Both parents are crossbreeds... )
species11 @ species21 @ smatch not 
species12 @ and 
species22 @ and if
 1d100 case
   16 <= when species21 @ cubspecies1 ! end
   33 <= when species22 @ cubspecies1 ! end  
   66 <= when species11 @ cubspecies1 ! end  
  100 <= when species12 @ cubspecies1 ! end
 endcase
 1 exit  
 then

{
"Something went terribly wrong while determining the species!  [" param @ "]" 
}cat "Breed" pretty tellme
0
;

: main
var cubcount
var curcub
param !
param @ "#h*" smatch if helpmedamnit exit then
param @ "#f*" smatch if helpmedamnit2 exit then
param @ parsecmdline not if { "Syntax invalid, see " command @ " #help" }cat "Breed" pretty tellme exit then
( fail if a guy is trying to have kits or if a girl is trying to fertilize kits )
sex1 @ "m*" smatch if { "ERROR in parameter 1: A male cannot have cubs.  [" param @ "]" }cat "Breed" pretty tellhere exit then
sex2 @ "f*" smatch if { "ERROR in parameter 2: A female cannot fertilize eggs.  [" param @ "]" }cat "Breed" pretty tellhere exit then
{ "Attempting to breed a " sex1 @ " " species11 @ 
    species12 @ if "/" species12 @ then
    " with a " sex2 @ " " species21 @ 
    species22 @ if "/" species22 @ then
    }cat "Breed" pretty tellhere
getcubcount cubcount !
1 cubcount @ 1 for curcub !
 getsex not if exit then
 getspecies not if exit then
 sexsanity
{ "Cub # " curcub @ ": " 
    cubgender @ if cubgender @ then
    cubspecies1 @ if " " cubspecies1 @ then
    cubspecies2 @ if "/" cubspecies2 @ then
    }cat "Breed" pretty tellhere 
repeat
;
.
c
q