#lang racket/base

; Floraverse character generator
; Generates a character and transform it into various formats

(require
  racket/string
  "flora/character.rkt"
  "flora/database.rkt"
  "flora/calendar.rkt"
  "flora/gender.rkt"
  "flora/sex.rkt"
  "flora/element.rkt"
  "flora/affinity.rkt"
  "flora/geography.rkt"
  "flora/species.rkt"
  "flora/ability.rkt"
  "phonagen.rkt"
  "../lang/english.rkt"
  "../lang/case.rkt"
  )

(provide
  ; Generation of a character description, with a format, and constraints
  flora-character-generate
  ; Formating functions
  flora-character->full-html
  flora-character->tweets
  )

(define (flora-character-generate floragen format [constraints (make-hash)])
  ; Generate the character
  (define character (character-generate floragen constraints))
  ; Output with the format
  (format character floragen))

; Formating functions
; Format to the full html description as sxml
(define (flora-character->full-html chr floragen)
  ; Gender and grammatical words
  (define gender (character-gender chr))
  (define plural? (gender-plural? gender))
  (define subject (gender-subject gender))
  (define genitive (gender-genitive gender))
  ; Name
  (define name (character-name chr))
  ; Species name
  (define sp-name (compute-species-name
                    floragen
                    (character-species-genes chr)
                    (character-species-start chr)
                    (character-species-imited chr)))
  ; Birth
  (define birthday (character-birthday chr))
  ; Affinity
  (define affinity (character-affinity chr))
  ; Output
  `(section
    (h2 ,(show-name name))
    (p
      (h3 "Identity")
      ,(gender-title-abbreviation gender) " "
      ,(show-name name) " "
      ,(english:3rd-person-of "be" plural?) " "
      ,(english:undefined-article (car sp-name)) " " ,(cdr sp-name) ". " (br)
      ,(case:upcase-1st genitive) " name is pronounced "
      "/" ,(word-pronounciation name) "/. " (br)
      ,(case:upcase-1st subject) " " ,(english:3rd-person-of "live" plural?) " "
      ,(cdr (show-place (character-living-place chr) #t)) ". "
      (details
        (summary "Genes")
        (table
          (tr
            (td (strong "Species"))
            ,@(map (lambda (x) `(td ,(car x))) (character-species-genes chr)))
          (tr
            (td (strong "Amount"))
            ,@(map (lambda (x) `(td ,(number->string (cdr x)) "%")) (character-species-genes chr)))
          ))
      )
    (p
      (h3 "Birth")
      ,(case:upcase-1st subject) " " ,(english:3rd-person-of "be" plural?) " born "
      ,(sex-name (character-sex chr))
      " on the " ,(english:ordinal (date+sign-day birthday)) " of " ,(date+sign-month-name birthday) " "
      ,(cdr (show-place (character-birth-place chr) #t)) ". " (br)
      ,(case:upcase-1st genitive) " astrological sign is "
      (img ((src ,(string-append (flora-generator-path floragen) "/" (date+sign-sign-symbol birthday)))
            (width "16")
            (height "16")
           ))
      " " ,(date+sign-sign-name birthday) ". "
      )
    (p
      (h3 "Affinity")
      ,(case:upcase-1st subject) " " ,(english:3rd-person-of "have" plural?) " "
      ,(element-affinity-description
        (elements-ref
          (flora-generator-elements floragen)
          (signed-element-name (car (affinity-composition affinity))))) ". "
      (details
        (summary "Affinity breakdown")
        ,(affinity-composition-table (affinity-composition affinity)))
      (details
        (summary "Primary affinity breakdown")
        ,(affinity-composition-table (affinity-non-reduced-composition affinity)))
      )
    (p
      (h3 "Appearance and personnality")
      ; Size
      ,(if (character-size chr)
          `(span
             ,(case:upcase-1st subject) " " ,(english:3rd-person-of "be" plural?) " "
             ,(character-size chr) " for " ,genitive " species. ")
          "")
      ; Weight
      ,(if (character-weight chr)
          `(span
             ,(case:upcase-1st subject) " " ,(english:3rd-person-of "be" plural?) " "
             ,(character-weight chr) ". " (br))
          "")
      ; Natures
      ,(case:upcase-1st subject) " " ,(english:3rd-person-of "be" plural?) " "
      ,@(english:add-commas (character-natures chr)) ". " (br)
      ; Traits
      ,@(apply append (map (lambda (x) (list x '(br))) (character-traits chr)))
      ; Motto
      ,(case:upcase-1st genitive) " motto is “" ,(character-motto chr) "” "
      )
    (p
      (h3 "Abilities")
      ,@(map
          (lambda (ab)
            `(details
              (summary ,(case:upcase-1st (ability-name ab)))
              ,(ability-description ab)))
          (character-abilities chr))
      )
    ,(if (or (character-father chr) (character-mother chr))
      `(p
        (h3 "Family")
          ,(if (character-father chr)
            `(details
              (summary "Father")
              ,(flora-character->full-html (character-father chr) floragen))
            "")
          ,(if (character-mother chr)
            `(details
              (summary "Mother")
              ,(flora-character->full-html (character-mother chr) floragen))
            "")
          )
      "")
    ))

; Generation into a series of tweets
; Return a hash with the following values:
; identity, birth, traits, motto
(define (flora-character->tweets chr floragen)
  ; Gender and grammatical words
  (define gender (character-gender chr))
  (define plural? (gender-plural? gender))
  (define subject (gender-subject gender))
  (define genitive (gender-genitive gender))
  ; Name
  (define name (character-name chr))
  ; Species name
  (define sp-name (compute-species-name
                    floragen
                    (character-species-genes chr)
                    (character-species-start chr)
                    (character-species-imited chr)))
  ; Birth
  (define birthday (character-birthday chr))
  ; Affinity
  (define affinity (character-affinity chr))
  ;
  (make-immutable-hash
    `((identity .
        ,(string-append
          (gender-title-abbreviation gender) " " (show-name name) " "
          (english:3rd-person-of "be" plural?) " " (english:with-undefined-article (car sp-name)) " with "
          (element-affinity-description
            (elements-ref
              (flora-generator-elements floragen)
              (signed-element-name (car (affinity-composition affinity))))) ". "
          (case:upcase-1st genitive) " name is pronounced "
          "/" (word-pronounciation name) "/."))
      (birth .
        ,(string-append
          (case:upcase-1st subject) " " (english:3rd-person-of "be" plural?) " born "
          (sex-name (character-sex chr)) " on the " (english:ordinal (date+sign-day birthday)) " of " (date+sign-month-name birthday) " "
          (car (show-place (character-birth-place chr) #t)) ". "
          (case:upcase-1st genitive) " astrological sign is " (date+sign-sign-name birthday) "."))
      (traits . ,(string-join (character-traits chr) " "))
      (motto .
        ,(string-append
          (case:upcase-1st genitive) " motto is “" (character-motto chr) "”"))
      )))

; Helping functions for the diverse outputs

; Display a name, and eventually its latin transcription
(define (show-name name)
  (let ((native-name (word-native-transcription name))
        (latin-name (word-latin-transcription name)))
    (string-append
      (case:upcase-1st native-name)
      (if (equal? native-name latin-name)
          ""
          (string-append " (" (case:upcase-1st latin-name) ")")))))

; Species names from genes, as plain text and sxml
; Compute the name of the species, as string and sxml pair: (cons str-name sxml-name)
; Note: genes are sorted by the more predominent to the less predominent
(define (compute-species-name floragen genes starting-species imited-species)
  ; Mimic?
  (define mimic? (species-mimic? starting-species))
  ; Only keep the species name whose genes are predominent enough
  (define main-gene-count (cdar genes))
  (define kept-species-name
    (map
      car
      (filter
        (lambda (sp-name+count)
          (>= (* 2 (cdr sp-name+count)) main-gene-count))
        genes)))
  ; Get name from the kept species
  ; Return a string if a name is found or a list of string
  (define sp-name
    (cond
      ( (eq? 1 (length kept-species-name))
        (car kept-species-name))
      ( (eq? 2 (length kept-species-name))
        (species-database-find-crossbred-name
          (flora-generator-species floragen)
          kept-species-name))
      ( #t
        kept-species-name)))
  ; Function to show a species name with its link, accept a string or a species
  (define (with-link sp)
    (define species
      (if (string? sp)
          (species-database-get (flora-generator-species floragen) sp)
          sp))
    `(a ((href ,(species-reference-link species))) ,(species-name species)))
  ; Return the result
  (cond
    ; Mimic of a mix of species - imply the use of imited species genes
    ( (and (list? sp-name) mimic?)
      (cons
        ; String version
        (string-append
          (species-name starting-species)
          " looking like a mix of "
          (string-join (english:add-commas sp-name) ""))
        ; Sxml version
        `(span
          ,(with-link starting-species)
          " looking like a mix of "
          ,@(english:add-commas
              (map with-link sp-name)))))
    ; Mimic - use imited species genes
    ( (and mimic? (not (species-mimic-genes-used? starting-species)))
      (cons
        ; String version
        (string-append
          sp-name
          " "
          (species-name starting-species))
        ; Sxml version
        `(span
          ,(with-link sp-name)
          " "
          ,(with-link starting-species))))
    ; Mimic - use mimic species genes
    ( mimic?
      (cons
        ; String version
        (string-append
          (species-name imited-species)
          " "
          (species-name starting-species))
        ; Sxml version
        `(span
          ,(with-link imited-species)
          " "
          ,(with-link starting-species))))
    ; Unnamed hybrid of species
    ( (list? sp-name)
      (cons
        ; String version
        (string-append
          "hybrid of "
          (string-join (english:add-commas sp-name) ""))
        ; Sxml version
        `(span
          "hybrid of "
          ,@(english:add-commas
              (map with-link sp-name)))))
    ; Variety
    ; sp-name corresponds to compatibility-name of starting-species
    ; => use species-name, so that the variety is kept
    ( (and (equal? sp-name (species-compatibility-name starting-species))
           (species-name starting-species))
      (cons
        ; String version
        (species-name starting-species)
        ; Sxml version
        `(span
           ,(with-link (species-name starting-species)))))
    ; Named species
    ( #t
      (cons
        ; String version
        sp-name
        ; Sxml version
        `(span
          ,(with-link sp-name))))
    ))

; Affinity composition
(define (affinity-composition-table composition)
  `(table
    (tr
      (td (strong "Element"))
      ,@(map (lambda (x) `(td ,(signed-element-name x))) composition))
    (tr
      (td (strong "Sign"))
      ,@(map (lambda (x) `(td ,(signed-element-sign x))) composition))
    (tr
      (td (strong "Amount"))
      ,@(map (lambda (x) `(td ,(number->string (signed-element-count x)) "%")) composition))
    ))

; Display a place
; As plain text and sxml
(define (show-place place in?)
  (define preposition ((if in? location-type-preposition-in location-type-preposition-near)
                       (place-type place)))
  (cons
    ; String version
    (string-append preposition " " (place-name place))
    ; sxml version
    `(span ,preposition " " (a ((href ,(place-reference-link place))) ,(place-name place)))
    ))
