#lang racket/base

; Character structure for the floraverse character generator
(require
  racket/string
  racket/list
  "../../base-generation/random.rkt"
  "../../base-generation/category.rkt"
  "../../base-generation/distribution.rkt"
  "database.rkt"
  "calendar.rkt"
  "motto.rkt"
  "gender.rkt"
  "sex.rkt"
  "element.rkt"
  "affinity.rkt"
  "geography.rkt"
  "species.rkt"
  "../phonagen.rkt"
  "trait.rkt"
  "ability.rkt"
  "../../lang/english.rkt"
  )

(provide
  ; Generation of a character
  character-generate
  ; Character accessors
  character-father
  character-mother
  character-birthday
  character-motto
  character-natures
  character-gender
  character-sex
  character-affinity
  character-birth-place
  character-living-place
  character-species-genes
  character-species-start
  character-species-imited
  character-name
  character-traits
  character-abilities
  character-size
  character-weight
  )

; Character structure
(struct character
  (internal-natures-dict ; Dictionnary of natures - for internal use only
   internal-traits-word-dict ; Dictionnary of words used in traits - for internal use only
   internal-language ; Language used for generating the name - for internal use only
   internal-traits ; Dictionnary of traits - for internal use only
   father ; Father of character
   mother ; Mother of character
   birthday ; Date of birth, as a date+sign
   motto ; Motto
   natures ; List of main natures
   sex ; Sex of character
   gender ; Gender of character
   affinity ; Elemental affinity of character
   birth-place ; Place of birth
   living-place ; Place where the character lives
   species-genes ; List of species genes of the character
   species-start ; The starting point for species generation
   species-imited ; For mimic species, the imited species
   name ; Name of the character
   traits ; List of traits
   abilities ; List of abilities
   size ; Size of character.
   weight ; Weight of character.
  ))

; Full reduction of affinity: merge all the affinity with the same elements into one, to make a gene-like list with element-name + count
(define (affinity-reduce-for-ability affinity)
  (define composition (make-hash))
  (for-each
    (lambda (elem)
      (hash-set!
        composition
        (signed-element-name elem)
        (+ (signed-element-count elem)
           (hash-ref composition (signed-element-name elem) 0))))
    (affinity-composition affinity))
  (hash->list composition))

; Generate a gene list
(define (generate-species-genes starting-species imited-species)
  (define mimic? (species-mimic? starting-species))
  (define mimic-genes-used? (species-mimic-genes-used? starting-species))
  (define compatibility-name (species-compatibility-name imited-species))
  (cond
    ; Mimic using the genes of the mimic species and not those of the imited species
    ( (and mimic? mimic-genes-used?)
      (list (cons (species-compatibility-name starting-species) 100)))
    ; Crossbreed case
    ( (list? compatibility-name)
      (map
        (lambda (x) (cons x 50))
        compatibility-name))
    ; Non-crossbreed
    ( #t
      (list (cons compatibility-name 100)))))

; Size generator
(define (generate-size)
  (let ((numeric (random:normal)))
    (cond
      ((> numeric 1.35) "huge")
      ((> numeric 0.67) "large")
      ((> numeric -0.67) #f)
      ((> numeric -1.35) "small")
      (#t "tiny"))))

; Weight generator
(define (generate-weight)
  (let ((numeric (random:normal)))
    (cond
      ((> numeric 1.35) "obese")
      ((> numeric 0.67) "fat")
      ((> numeric 0.15) "plump")
      ((> numeric -0.15) #f)
      ((> numeric -0.67) "slim")
      ((> numeric -1.35) "thin")
      (#t "emaciated"))))

; Sex generation
(define (generate-sex-name floragen genes)
  (distribution-generate
    (distribution-linear-combination
      (map
        (lambda (x)
          (cons
            (species-sex-distribution
              (species-database-get (flora-generator-species floragen) (car x)))
            (cdr x)))
        genes))))

; Generate a place
(define (generate-place floragen species (place #f))
  (cond
    ( (and place (< (random 10) 6))
      place)
    ( (or (species-restricted-to-endemic-areas? species) (< (random 10) 6))
      (geography-random-subplace
        (flora-generator-geography floragen)
        (random:from-list (species-endemic-in species))))
    (#t
      (geography-random-subplace (flora-generator-geography floragen) "Floraverse"))
    ))

; Generate an affinity
(define (generate-affinity floragen genes)
  (make-affinity
    (flora-generator-elements floragen)
    (distribution-linear-combination
      (map
        (lambda (x)
          (cons
            (species-affinity-distribution
              (species-database-get (flora-generator-species floragen) (car x)))
            (cdr x)))
        genes))))

; Generate the parent couple for a given species
; Return a pair of species, first is father, second is mother
(define (generate-parent-species floragen starting-species imited-species)
  (define reproduction (species-reproduction starting-species))
  ;
  (cond
    ; Artifacts are built => no parents
    ((eq? reproduction 'artifact)
     (cons #f #f))
    ; Asexual reproduction => mother only, from the asexual-parent-species, sex is set to #f
    ((eq? reproduction 'asexual)
     (define parent-species
      (species-database-get
        (flora-generator-species floragen)
        (random:from-list (species-asexual-parent-species starting-species))))
     (cons #f parent-species))
    ; Mimic using imited species genes - one of two possible case, so 50% to trigger
    ((and (species-mimic? starting-species)
          (not (species-mimic-genes-used? starting-species)) (random:boolean))
     ; one of the parent is of the mimic species, the other is of the imited species
     (if (random:boolean)
         (cons imited-species starting-species)
         (cons starting-species imited-species)))
    ; Crossbred species, case 1: parents are from the two compatible species
    ((and (random:boolean) (list? (species-compatibility-name starting-species)))
      (define compat-name
        (map
          (lambda (x) (species-database-get (flora-generator-species floragen) x))
          (species-compatibility-name starting-species)))
      (if (random:boolean)
          (cons (car compat-name) (cadr compat-name))
          (cons (cadr compat-name) (car compat-name))))
    ; Sexual reproduction, case 1 / Crossbred species, case 2: parents are both of the same species
    ((or (random:boolean) (list? (species-compatibility-name starting-species)))
      (cons starting-species starting-species))
    ; Sexual reproduction, case 2: parents are of compatible species
    (#t
      ; All possible parents
      (define all-possible-parents (species-database-all-possible-parents (flora-generator-species floragen) starting-species))
      (cons
        (random:from-list all-possible-parents)
        (random:from-list all-possible-parents)))
    ))

; Combine genes from two list of genes
(define (combine-genes genome1 genome2)
  ; Distribution for genome1
  (define d1 (apply distribution genome1))
  (define d2 (apply distribution genome2))
  ; Generate 60 genes from each distribution, append, shuffle, and drop the 20 first elements
  (define lst-genes
    (list-tail
      (shuffle
        (append
          (build-list 60 (lambda (_) (distribution-generate d1)))
          (build-list 60 (lambda (_) (distribution-generate d2)))))
      20))
  ; Simplify the list into a list of (species . count)
  ; Use a distribution to do this
  (define d (distribution))
  (for-each
    (lambda (x)
      (distribution-add-to! d x))
    lst-genes)
  (hash->list (distribution-items d)))

; Mother sex for a species
(define (mother-sex floragen sp)
  ; Generate from the sex distribution with only the sexes that are mother
  (define d
    (distribution-filter
      (species-sex-distribution sp)
      (lambda (x)
        (sex-mother? (sexes-ref (flora-generator-sexes floragen) x)))))
  ; If d is empty, take a sex from the species-sex-distribution
  (distribution-generate
    (if (distribution-empty? d) (species-sex-distribution sp) d)))

; Father sex for a species
(define (father-sex floragen sp)
  ; Generate from the sex distribution with only the sexes that are father
  (define d
    (distribution-filter
      (species-sex-distribution sp)
      (lambda (x)
        (define mother? (sex-mother? (sexes-ref (flora-generator-sexes floragen) x)))
        (or (not mother?) (eq? 'maybe mother?)))))
  ; If d is empty, take a sex from the species-sex-distribution
  (distribution-generate
    (if (distribution-empty? d) (species-sex-distribution sp) d)))

; Generator
; Generate a character from a hash of constraints
(define (character-generate floragen [constraints (make-immutable-hash)])
  (define asked-language (hash-ref constraints 'language #f))
  (define starting-species
    (or
      (hash-ref constraints 'species #f)
      (species-database-random (flora-generator-species floragen) species-generable-as-character?)))
  (define mimic? (species-mimic? starting-species))
  (define imited-species
    (if mimic?
      (species-database-random (flora-generator-species floragen) (species-mimic-method starting-species))
      starting-species))
  ; Generate parents if needed
  (define generate-ascendents? (< 0 (hash-ref constraints 'nb-ascendents 0)))
  (define parent-species (if generate-ascendents?
                             (generate-parent-species floragen starting-species imited-species)
                             (cons #f #f)))
  (define father (and (car parent-species)
                      (character-generate
                        floragen
                        (make-immutable-hash
                          `((species . ,(car parent-species))
                            (nb-ascendents . ,(- (hash-ref constraints 'nb-ascendents 1) 1))
                            (sex . ,(father-sex floragen (car parent-species)))
                            (language . ,asked-language)
                            )))))
  (define mother (and (cdr parent-species)
                      (character-generate
                        floragen
                        (make-immutable-hash
                          `((species . ,(cdr parent-species))
                            (nb-ascendents . ,(- (hash-ref constraints 'nb-ascendents 1) 1))
                            (sex . ,(mother-sex floragen (cdr parent-species)))
                            (language . ,asked-language)
                            )))))
  ; Generate species genes
  (define unsorted-genes (or (and father mother (combine-genes (character-species-genes mother) (character-species-genes father)))
                             (generate-species-genes starting-species imited-species)))
  (define species-genes (sort unsorted-genes (lambda (x y) (> (cdr x) (cdr y)))))
  ; Generate everything else
  (define sex (sexes-ref
                (flora-generator-sexes floragen)
                (hash-ref
                  constraints
                  'sex
                  (generate-sex-name floragen species-genes))))
  (define gender (genders-ref (flora-generator-genders floragen) (sex-generate-gender-name sex)))
  (define birth-place (or (and father (random:boolean) (character-living-place father))
                          (and mother (random:boolean) (character-living-place mother))
                          (generate-place floragen starting-species)))
  (define language (or (and asked-language (member asked-language (phonagen-generator-ids (flora-generator-name floragen))) asked-language)
                       (and father (random:boolean) (character-internal-language father))
                       (and mother (random:boolean) (character-internal-language mother))
                       (random:from-list (phonagen-generator-ids (flora-generator-name floragen)))))
  (define nature-dict (random:hash-combine
                        (or (and father (character-internal-natures-dict father)) (make-hash))
                        (or (and mother (character-internal-natures-dict mother)) (make-hash))
                        (category-generate-dictionary (flora-generator-natures floragen))))
  (define word-dict (random:hash-combine
                      (or (and father (character-internal-traits-word-dict father)) (make-hash))
                      (or (and mother (character-internal-traits-word-dict mother)) (make-hash))
                      (category-generate-dictionary (flora-generator-word-lists floragen))))
  (define traits-dict (random:hash-combine
                        (or (and father (character-internal-traits father)) (make-hash))
                        (or (and mother (character-internal-traits mother)) (make-hash))
                        (traits-generate (flora-generator-traits floragen))))
  (define affinity (generate-affinity floragen species-genes))
  ;
  (character
    ; Internal nature dict
    nature-dict
    ; Internal word dict
    word-dict
    ; Internal language
    language
    ; Internal traits dict
    traits-dict
    ; Father
    father
    ; Mother
    mother
    ; Birthday
    (calendar-generate-date (flora-generator-calendar floragen))
    ; Motto
    (motto-generate (flora-generator-mottos floragen))
    ; Natures
    (random:sublist (hash-values nature-dict) (+ 2 (random 3)))
    ; Sex
    sex
    ; Gender
    gender
    ; Affinity
    affinity
    ; Birth place
    birth-place
    ; Living place
    (generate-place floragen starting-species birth-place)
    ; Species genes
    species-genes
    ; Starting species
    starting-species
    ; Imited species
    imited-species
    ; Name
    (phonagen-generate (flora-generator-name floragen) language)
    ; Traits
    (map
      (lambda (x)
        (trait->string
          x
          gender
          word-dict
          (flora-generator-natures floragen)
          (flora-generator-species floragen)
          (flora-generator-geography floragen)))
      (random:sublist (hash-values traits-dict) (+ 3 (random 3))))
    ; Abilities
    (random:sublist
      (ability-database-select
        (flora-generator-abilities floragen)
        species-genes
        (affinity-reduce-for-ability affinity))
      5)
    ; Size
    (generate-size)
    ; Weight
    (generate-weight)
    ))
