204 lines
9.1 KiB
Racket
204 lines
9.1 KiB
Racket
#lang racket/base
|
|
|
|
; Floraverse-related pages
|
|
; Includes the floraverse character generator
|
|
(require
|
|
json
|
|
racket/string
|
|
racket/date
|
|
"templates.rkt"
|
|
"../generators/flora-character.rkt"
|
|
"../generators/flora/database.rkt"
|
|
"../generators/flora/calendar.rkt"
|
|
"../generators/flora/species.rkt"
|
|
"../generators/phonagen.rkt"
|
|
"../webcontainer/weblets.rkt"
|
|
"../webcontainer/weblet-parameter.rkt"
|
|
"../lang/english.rkt"
|
|
"../lang/case.rkt")
|
|
|
|
(provide
|
|
pages:floraverse
|
|
pages:floraverse-character-generator-about
|
|
pages:floraverse-character-generator
|
|
pages:floraverse-character-generator-tweet
|
|
pages:floraverse-calendar)
|
|
|
|
; The generator
|
|
(define *FloraGenDataDir* "/data/flora-generator-data")
|
|
(define *FloraGen* (make-flora-generator "./static" *FloraGenDataDir* "/data/phonagen.json"))
|
|
|
|
; Floraverse welcome page
|
|
(define pages:floraverse
|
|
(pages:template
|
|
#:title "Floraverse"
|
|
#:author "Feufochmar"
|
|
#:date "2020-02-02"
|
|
#:content
|
|
'(article
|
|
(p "As I'm a fan of the " (a ((href "http://floraverse.com")) "Floraverse comic") ", I wrote a generator making characters living in the world of the comic. "
|
|
"In fact, I originally made this website to host the generator. "
|
|
"This section regroups the character generator and other tools related to the Floraverse universe. ")
|
|
)))
|
|
|
|
; About the generator
|
|
(define pages:floraverse-character-generator-about
|
|
(pages:template
|
|
#:title "About the Floraverse Character Generator"
|
|
#:author "Feufochmar"
|
|
#:date "2020-02-02"
|
|
#:content
|
|
'(article
|
|
(section
|
|
(h3 "Origin")
|
|
(p "The character generator is inspired by " (a ((href "http://fav.me/d7569je")) "this journal post on deviantArt") ", "
|
|
"which used the " (a ((href "http://marnok.com/content/_adventure/101npcs.php")) "Marnok's NPC generator") " to generate personality traits. "))
|
|
(section
|
|
(h3 "History")
|
|
(p "The current generator is the fifth iteration of the generator. " (br)
|
|
"The first version was a written in Java and started as a desktop application, before I added features to run it as a webservice. "
|
|
"This lead to the creation of this website, to initially host that generator. " (br)
|
|
"The second version was written in Guile Scheme and ran only as a webservice. " (br)
|
|
"The third version was based on the previous version and was the result of the merger "
|
|
"of several generators I wrote and hosted on this website into a single project. " (br)
|
|
"The fourth version was caused by a rewrite of this website in Racket. " (br)
|
|
"The fifth and current version is an iteration of the previous to separate the data used by the generators from the code. "))
|
|
(section
|
|
(h3 "Data")
|
|
(p "The data used by the generator is available in a "
|
|
(a ((href "https://projects.feuforeve.fr/Feufochmar/flora-generator-data")) "git repository")
|
|
", and is mainly written in JSON. "
|
|
"A mirror of the repository is also hosted on " (a ((href "https://github.com/Feufochmar/flora-generator-data")) "GitHub") ". " (br)
|
|
"The file structures are documented in the " (code "README.md") " file. "))
|
|
(section
|
|
(h3 "Code")
|
|
(p "The code of the generator is available along with the code of this website in a "
|
|
(a ((href "https://projects.feuforeve.fr/Feufochmar/feuforeve.v4")) "git repository") ". "
|
|
"It is released under the terms of the GNU General Public License version 2 or any later version (GPLv2+). "
|
|
"The code is written in " (a ((href "http://racket-lang.org/")) "Racket") ". "))
|
|
)))
|
|
|
|
; Generator page
|
|
(define *generable-species*
|
|
(sort
|
|
(species-database-all (flora-generator-species *FloraGen*) species-generable-as-character?)
|
|
(lambda (x y) (string<? (species-name x) (species-name y)))))
|
|
(define *languages*
|
|
(sort
|
|
(phonagen-generator-ids (flora-generator-name *FloraGen*))
|
|
(lambda (x y) (string<? (symbol->string x) (symbol->string y)))))
|
|
|
|
(define pages:floraverse-character-generator
|
|
(pages:template
|
|
#:title "Floraverse Character Generator"
|
|
#:author "MechaMaskedOwl"
|
|
#:content
|
|
(lambda (param)
|
|
(define asked-species (weblet-parameter-ref param 'species #f))
|
|
(define species (and asked-species (species-database-get (flora-generator-species *FloraGen*) asked-species)))
|
|
(define forced? (equal? "on" (weblet-parameter-ref param 'forced #f)))
|
|
(define asked-language (weblet-parameter-ref param 'language #f))
|
|
(define constraints (make-immutable-hash
|
|
`((species . ,species)
|
|
(nb-ascendents . ,(if forced? 0 3))
|
|
(language . ,(and asked-language (string->symbol asked-language)))
|
|
)))
|
|
;
|
|
`(article
|
|
(section
|
|
(form
|
|
((action "/Floraverse/CharacterGenerator"))
|
|
(label "Species "
|
|
(select ((name "species"))
|
|
(option ((value "")) "— random species —")
|
|
,@(map
|
|
(lambda (x)
|
|
(define sp-name (species-name x))
|
|
`(option ((value ,sp-name)
|
|
,@(if (equal? sp-name asked-species) '((selected "true")) '()))
|
|
,sp-name))
|
|
*generable-species*)
|
|
))
|
|
" — "
|
|
(input ((name "forced")(type "checkbox")
|
|
,@(if forced? '((checked "true")) '()))
|
|
"No family (force the species)")
|
|
(br)
|
|
(label "Names from "
|
|
(select ((name "language"))
|
|
(option ((value "")) "— random word generator —")
|
|
,@(map
|
|
(lambda (x)
|
|
(define str-lang (symbol->string x))
|
|
`(option ((value ,str-lang)
|
|
,@(if (equal? str-lang asked-language) '((selected "true")) '()))
|
|
,str-lang))
|
|
*languages*)
|
|
))
|
|
(br)
|
|
(button "New character"))
|
|
)
|
|
,(flora-character-generate *FloraGen* flora-character->full-html constraints)))))
|
|
|
|
; Tweet output, as json
|
|
(define pages:floraverse-character-generator-tweet
|
|
(raw-data-weblet
|
|
#:content-type #"application/json;charset=utf-8"
|
|
#:body
|
|
(lambda (param)
|
|
(jsexpr->bytes
|
|
(flora-character-generate *FloraGen* flora-character->tweets)))))
|
|
|
|
; Calendar Tool
|
|
(define pages:floraverse-calendar
|
|
(pages:template
|
|
#:title "Floraverse Calendar"
|
|
#:author "MechaMaskedOwl"
|
|
#:content
|
|
(lambda (param)
|
|
(define today (current-date))
|
|
(define today-flora (calendar-get-date (flora-generator-calendar *FloraGen*) (date-month today) (date-day today)))
|
|
(define req-date (weblet-parameter-ref param 'date #f))
|
|
(define split-date (and req-date (string-split req-date "-")))
|
|
(define req-month (and split-date (eq? 3 (length split-date)) (cadr split-date)))
|
|
(define req-day (and split-date (eq? 3 (length split-date)) (caddr split-date)))
|
|
(define match-month (weblet-parameter-ref param 'month #f))
|
|
(define match-day (weblet-parameter-ref param 'day #f))
|
|
(define month (or (and req-month (string->number req-month))
|
|
(and match-month (string->number match-month))))
|
|
(define day (or (and req-day (string->number req-day))
|
|
(and match-day (string->number match-day))))
|
|
(define req-flora
|
|
(with-handlers ([exn:fail? (lambda (v) #f)])
|
|
(calendar-get-date (flora-generator-calendar *FloraGen*) month day)))
|
|
(define (show-date d+s)
|
|
`(p
|
|
"The " ,(english:ordinal (date+sign-day d+s)) " of " ,(date+sign-month-name d+s) " "
|
|
"is under the astrological sign of " ,(date+sign-sign-name d+s) ". " (br)
|
|
(img ((src ,(string-append *FloraGenDataDir* "/" (date+sign-sign-symbol d+s)))
|
|
(width "64")
|
|
(height "64")
|
|
))))
|
|
`(article
|
|
,(if req-flora
|
|
`(section
|
|
(h3 ,(string-append "YYYY-" (number->string month) "-" (number->string day)))
|
|
,(show-date req-flora))
|
|
"")
|
|
(section
|
|
(h3 "Convert a date to Floraverse date")
|
|
(form ((action "/Floraverse/Calendar"))
|
|
(label "Pick a date: "
|
|
(input ((name "date")
|
|
(type "date")
|
|
(value ,(string-append
|
|
(number->string (date-year today)) "-"
|
|
(number->string (date-month today)) "-"
|
|
(number->string (date-day today)))))))
|
|
(br)
|
|
(button "Convert to Floraverse date")))
|
|
(section
|
|
(h3 "Today")
|
|
,(show-date today-flora))
|
|
))))
|