###
# Soap Opera Simulator
###
package require clay

namespace eval ::iritrad {}

proc ::lrandom list {
  set len [llength $list]
  set idx [expr int(rand()*$len)]
  return [lindex $list $idx]
}

proc ::iritrad::ability_modifier {score} {
  if {$score < 2} {
    return -5
  }
  if {$score >= 30} {
    return +10
  }
  return [expr {int($score/2)-5}]
}
proc ::iritrad::die_roll {string} {
  set total 0
  foreach element $string {
    if {[scan $element %dd%d count die]==2} {
      for {set x 0} {$x < $count} {incr x} {
        incr total [expr {int(rand()*$die)+1}]
      }
    } else {
      incr total $element
    }
  }
  return $total
}

###
# Statistical average
###
proc ::iritrad::standard_roll {string} {
  set total 0
  foreach element $string {
    if {[scan $element %dd%d count die]==2} {
      for {set x 0} {$x < $count} {incr x} {
        incr total [expr {int(0.5*$die)+1}]
      }
    } else {
      incr total $element
    }
  }
  return $total
}

###
# For attributes roll 4d6 and throw out the lowest roll
###
proc ::iritrad::attribute_roll {} {
  set total 0
  set rolls {}
  for {set x 0} {$x < 4} {incr x} {
    lappend rolls [expr {int(rand()*6)+1}]
  }
  foreach item [lrange [lsort -integer $rolls] 1 end] {
    incr total $item
  }
  return $total
}

proc ::iritrad::find_class {type genus species} {
  if {[info commands ::iritrad::dnd5e::${type}::${genus}.${species}] ne {}} {
    return ::iritrad::dnd5e::${type}::${genus}.${species}
  }
  return {}
}

clay::define relationship {
  Variable encounters 0

  Dict a_side {
    lust       0
    trust      0
    love       0
    hate       0
    rivalry    0
    like       0
  }
  Dict b_side {
    lust       0
    trust      0
    love       0
    hate       0
    rivalry    0
    like       0
  }

  constructor {A B} {
    my variable a_side b_side
    dict set a_side object $A
    dict set b_side object $B
    my clay delegate A $A
    my clay delegate B $B
    set coro [my Coro]
  }

  method Coro {} {
    return [info object namespace [self]]::coro
  }


  method dump {} {
    my variable a_side b_side
    set result {}
    lappend result [info object mixins [self]]
    lappend result $a_side
    lappend result $b_side
  }

  method evolve type {
    set A [my clay delegate A]
    set B [my clay delegate B]
    puts [list $A -> $B evolve to $type]
    my clay mixin $type
  }

  # Evaluate a day in the live
  method step {} {
    set coro [my Coro]
    if {[info commands $coro] eq {}} {
      # Start relationship
      coroutine $coro {*}[namespace code [list my coro]]
      my clay delegate coro $coro
    }
    # Do one step
    $coro
  }

  method frequency {} {
    return {1d12 12}
  }

  # Behaviors inside the coroutine
  method coro {} {
    set A [my clay delegate A]
    set B [my clay delegate B]

    while 1 {
      yield
      lassign [my frequency] dice hit
      set roll [::iritrad::die_roll $dice]
      if {$roll<$hit} {
        continue
      }
      switch [::iritrad::die_roll 1d2] {
        1 {
          # A is the initiator
          my random_interaction $A $B
        }
        2 {
          # B is the initiator
          my random_interaction $B $A
        }
      }
    }
  }

  method interactions {} {
    return {flirt betray help neutral}
  }

  method random_interaction {A B} {
    my variable a_side b_side type
    set interact [lrandom [my interactions]]
    set react [$A interact $interact $B]
    puts [list $A -> $B $interact $react]
    if {[dict exists $react a]} {
      dict for {f v} [dict get $react a] {
        dict incr a_side $f $v
      }
    }
    if {[dict exists $react b]} {
      dict for {f v} [dict get $react b] {
        dict incr b_side $f $v
      }
    }
    if {[dict get $a_side lust]>0 && [dict get $b_side lust]>0} {
      # Change the relationship to casual
      my evolve relationship.casual
    }
    if {[dict get $a_side trust]<0} {
      # Change the relationship to foe
      my evolve relationship.foe
    } elseif {[dict get $b_side trust]<0} {
      # Change the relationship to foe
      my evolve relationship.foe
    }
  }
}

clay::define relationship.foe {
  method frequency {} {
    return {1d6 5}
  }

  method interactions {} {
    return {insult betray insult betray neutral neutral sex help}
  }

  method random_interaction {A B} {
    my variable a_side b_side type
    set interact [lrandom [my interactions]]
    set react [$A interact $interact $B]
    puts [list $A -> $B $interact $react]
    if {[dict exists $react a]} {
      dict for {f v} [dict get $react a] {
        dict incr a_side $f $v
      }
    }
    if {[dict exists $react b]} {
      dict for {f v} [dict get $react b] {
        dict incr b_side $f $v
      }
    }
    if {[dict get $a_side lust]>0 && [dict get $b_side lust]>0} {
      # Change the relationship to casual
      my evolve relationship.casual
    }
    if {[dict get $a_side trust]>0 && [dict get $b_side trust]>0} {
      # Change the relationship to foe
      my evolve relationship.friend
    }
  }
}

clay::define relationship.friend {
  method frequency {} {
    return {1d6 5}
  }

  method interactions {} {
    return {compliment compliment compliment help help help neutral neutral neutral insult}
  }
}

clay::define relationship.casual {
  method frequency {} {
    return {1d6 5}
  }

  method interactions {} {
    return {compliment help neutral neutral neutral sex sex betray kiss}
  }
}

clay::define relationship.couple {
  method frequency {} {
    return {1d3 2}
  }

  method interactions {} {
    return {compliment help help compliment neutral neutral neutral sex sex betray kiss kiss kiss}
  }
}

clay::define human {
  Dict relationship {}

  method relationship {who args} {
    my variable relationship
    if {[llength $args]} {
      dict set relationship $who [lindex $args 0]
    }
    if {[dict exists $relationship who]} {
      return [dict get $relationship $who]
    }
    set obj [relationship new [self] $who]
    dict set relationship $who $obj
    return $obj
  }

  # Assume that any default interaction promotes at least a little trust
  # between the parties
  Ensemble interact::default {who} {
    dict set react a trust 1
    dict set react b trust 1
    dict set react b like  1
    return $react
  }

  Ensemble interact::betray {who} {
    dict set react b lust -10
    dict set react b love -10
    dict set react b trust -10
    dict set react b like -10
    return $react
  }

  Ensemble interact::insult {who} {
    dict set react b like  -1
    return $react
  }

  Ensemble interact::compliment {who} {
    dict set react a like  1
    dict set react b like  1
    return $react
  }

  Ensemble interact::help {who} {
    dict set react b love 1
    dict set react b trust 1
    dict set react b like  1
    return $react
  }

  Ensemble interact::flirt {who} {
    dict set react a {}
    dict set react b {}
    if {![my attraction $who]} {
      # If the initiator is not attracted, empty event
      return {}
    }
    dict set react a lust 1
    if {[$who attraction [self]]} {
      dict set react b lust 1
    }
    return $react
  }

  Ensemble interact::kiss {who} {
    dict set react a {}
    dict set react b {}
    if {![my attraction $who]} {
      # If the initiator is not attracted, empty event
      return {}
    }
    dict set react a lust 2
    if {[$who attraction [self]]} {
      dict set react b lust 2
    }
    return $react
  }

  Ensemble interact::sex {who} {
    dict set react a {}
    dict set react b {}
    set mate [my clay get mate]
    if {$mate ne {}} {
      if {$person ne $mate} {
        my interact betray $mate
        dict set react $who
      }
      return 0
    }
    if {![my attraction $who]} {
      # If the initiator is not attracted, empty event
      return {}
    }
    dict set react a love 1
    dict set react b love 1
    dict set react a lust -1
    if {[$who attraction [self]]} {
      dict set react b lust -1
    }
    return $react
  }
  method Faith_Check person {
    set mate [my clay get mate]
    if {$mate ne {}} {
      if {$person eq $mate} {
        return 1
      }
      return 0
    }
    return 1
  }

  method attraction {person} {
    if {![my Faith_Check $person]} {
      return 0
    }
    if {[$person clay get gender] eq [my clay get gender]} {
      return 0
    }
    return 1
  }

}

clay::define gender.female {
  clay set gender female
}

clay::define gender.male {
  clay set gender male
}

clay::define psyche.nymphomaniac {

}

clay::define psyche.philanderer {
  method Faith_Check person {
    # Bypass the faith checks. Open season on anyone
    return 1
  }
}

clay::define psyche.homosexual {
  method attraction {person} {
    if {![my Faith_Check $person]} {
      return 0
    }
    if {[$person clay get gender] ne [my clay get gender]} {
      return 0
    }
    return 1
  }
}

clay::define psyche.bisexual {
  method attracted {person} {
    if {![my Faith_Check $person]} {
      return 0
    }
    return 1
  }
}

clay::define psyche.asexual {
  method attracted {person} {
    return 0
  }
}

set people {}
dict for {name opts} {
  Alice     {psyche.nymphomaniac}
  Becky     {psyche.philanderer}
  Chris     {psyche.nymphomaniac}
  Daphne    {}
  Ellie     {}
  Ferne     {psyche.asexual}
  Georgia   {psyche.bisexual}
  Holly     {psyche.bisexual}
  Issabelle {psyche.philanderer}
  Joyce     {psyche.philanderer psyche.nymphomaniac psyche.bisexual}
  Kelly     {}
  Linda     {}
  Megan     {}
  Nancy     {}
  Ophelia   {psyche.homosexual}
  Patty     {psyche.homosexual}
  Roberta   {}
  Simone    {}
  Tiffany   {}
  Vera      {}
} {
  human create $name
  $name clay mixin gender.female {*}$opts
  lappend people $name
}

dict for {name opts} {
  Adam      {psyche.nymphomaniac}
  Brian     {psyche.philanderer}
  Charles   {psyche.nymphomaniac}
  David     {}
  Eddy      {}
  Frank     {psyche.asexual}
  George    {psyche.bisexual}
  Horace    {psyche.bisexual}
  Issac     {psyche.philanderer}
  Jacob     {psyche.philanderer psyche.nymphomaniac psyche.bisexual}
  Kenny     {}
  Larry     {}
  Mike      {}
  Nick      {}
  Oscar     {psyche.homosexual}
  Peter     {psyche.homosexual}
  Ralph     {}
  Scotty    {}
  Thomas    {}
  Vernon    {}
} {
  human create $name
  $name clay mixin gender.male {*}$opts
  lappend people $name
}

# Establish relationships
set relationships {}
foreach a $people {
  foreach b $people {
    if {$a eq $b} continue
    if {[dict exists $relationships $a $b]} continue
    if {[dict exists $relationships $b $a]} continue
    set obj [$a relationship $b]
    dict set relationships $a $b $obj
  }
}

for {set x 0} {$x < 100} {incr x} {
  dict for {a blist} $relationships {
    dict for {b list} $blist {
      foreach obj $list {
       $obj step
      }
    }
  }
}
puts "FINAL"
dict for {a blist} $relationships {
  dict for {b list} $blist {
    foreach obj $list {
      puts [list $a <-> $b | [$obj dump]]
    }
  }
}

puts "Romances"
dict for {a blist} $relationships {
  dict for {b list} $blist {
    foreach obj $list {
      set dump [$obj dump]
      if {[lindex $dump 0] in {relationship.casual relationship.couple}} {
        puts [list $a <-> $b | [$obj dump]]
      }
    }
  }
}