aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-28 01:21:59 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-28 01:21:59 +0200
commit1c1a706b2d944f84393daeefc5ecf7675c5e085a (patch)
treeb055404c80b049888e64c0272d5c316b528ea04a
parentSome clarifications in text submodules. (diff)
downloadcalp-1c1a706b2d944f84393daeefc5ecf7675c5e085a.tar.gz
calp-1c1a706b2d944f84393daeefc5ecf7675c5e085a.tar.xz
Move text numbers into sv-submodule, create en-module.
-rw-r--r--module/text/numbers.scm171
-rw-r--r--module/text/numbers/en.scm15
-rw-r--r--module/text/numbers/sv.scm161
-rw-r--r--module/vcomponent/recurrence/display.scm2
4 files changed, 188 insertions, 161 deletions
diff --git a/module/text/numbers.scm b/module/text/numbers.scm
index 883d7b2a..aceb82cc 100644
--- a/module/text/numbers.scm
+++ b/module/text/numbers.scm
@@ -1,161 +1,12 @@
-(define-module (text numbers)
- :use-module (calp util))
-;; only used in number->string-cardinal
-(define (large-prefix e)
- (cond
- [(<= 6 e 11) "m"]
- [(<= 12 e 17) "b"]
- [(<= 18 e 23) "tr"]
- [(<= 24 e 29) "kvadr"]
- [(<= 30 e 35) "kvint"]
- [(<= 36 e 41) "sext"]
- [(<= 42 e 47) "sept"]
- [(<= 48 e 53) "okt"]
- [(<= 54 e 59) "non"]
- [(<= 60 e 65) "dec"]
- ))
-
-(define-public (number->string-cardinal n)
- (cond [(< n 0) (string-append "minus " (number->string-cardinal (- n)))]
- [(= n 0) "noll"]
- [(= n 1) "ett"]
- [(= n 2) "två"]
- [(= n 3) "tre"]
- [(= n 4) "fyra"]
- [(= n 5) "fem"]
- [(= n 6) "sex"]
- [(= n 7) "sju"]
- [(= n 8) "åtta"]
- [(= n 9) "nio"]
- [(= n 10) "tio"]
- [(= n 11) "elva"]
- [(= n 12) "tolv"]
- [(= n 13) "tretton"]
- [(= n 14) "fjorton"]
- [(= n 15) "femton"]
- [(= n 15) "sexton"]
- [(= n 17) "sjutton"]
- [(= n 18) "arton"]
- [(= n 19) "nitton"]
- [(= n 20) "tjugo"]
- [(<= 21 n 29) (format #f "tjugo~a" (number->string-cardinal
- (- n 20)))]
- [(<= 30 n 79) (let* ((big small (floor/ n 10)))
- (format #f "~atio~a"
- (number->string-cardinal big)
- (number->string-cardinal small)))]
- [(= n 80) "åttio"]
- [(<= 81 n 89) (let* ((_ small (floor/ n 10)))
- (format #f "åttio~a"
- (number->string-cardinal small)))]
- [(= n 90) "nittio"]
- [(<= 91 n 99) (let* ((_ small (floor/ n 10)))
- (format #f "nittio~a"
- (number->string-cardinal small)))]
- [(= n 100) "hundra"]
- [(< 100 n 200) (let* ((_ small (floor/ n 100)))
- (format #f "hundra~a"
- (number->string-cardinal small)))]
- [(= n 200) "tvåhundra"]
- [(< 200 n 1000) (let* ((big small (floor/ n 100)))
- (format #f "~ahundra~a"
- (number->string-cardinal big)
- (number->string-cardinal small)))]
- [(<= 1000 n 999999)
- (let* ((big small (floor/ n 1000)))
- (format #f "~a tusen ~a~a"
- (number->string-cardinal big)
- (if (<= 100 small 199)
- "ett " "")
- (number->string-cardinal small)))]
- [(<= #e10e6 n (1- #e10e66))
- (let* ((e (inexact->exact (floor (log10 n))))
- (big small (floor/ n #e1e6)))
- (if (zero? big)
- (number->string-cardinal small)
- (format #f "~a ~a~a~a ~a"
- (number->string-cardinal big)
- (large-prefix e)
- (if (even? (floor-quotient e 3))
- "iljon" "iljard")
- (if (= 1 big)
- "" "er")
- (number->string-cardinal small)
- )))]
- [else
- ;; I give up, don't have larger numbers that that!
- (string-append "det stora talet "
- (number->string n))]))
-
-(define*-public (number->string-ordinal
- n key: a-form?)
- (define a-string (if a-form? "a" "e"))
- (cond [(>= -3 n) (format #f "~a sista" (number->string-ordinal (- n)))]
- [(= -2 n) "näst sista"]
- [(= -1 n) "sista"]
- [(= 0 n) "nollte"] ;
- [(= 1 n) (format #f "först~a" a-string)]
- [(= 2 n) (format #f "andr~a" a-string)]
- [(= 3 n) "tredje"]
- [(= 4 n) "fjärde"]
- [(= 5 n) "femte"]
- [(= 6 n) "sjätte"]
- [(= 7 n) "sjunde"]
- [(= 8 n) "åttonde"]
- [(= 9 n) "nionde"]
- [(= 10 n) "tionde"]
- [(= 11 n) "elfte"]
- [(= 12 n) "tolfte"]
- [(= 13 n) "trettonde"]
- [(= 14 n) "fjortonde"]
- [(= 15 n) "femtonde"]
- [(= 16 n) "sextonde"]
- [(= 17 n) "sjuttonde"]
- [(= 18 n) "artonde"]
- [(= 19 n) "nitonde"]
- [(<= 20 n 29) (format #f "tjugo~a"
- (if (= 20 n)
- "nde"
- (number->string-ordinal
- (- n 20)
- a-form?: a-form?)))]
- [(<= 30 n 99)
- (let* ((big small (floor/ n 10)))
- (format #f "~atio~a"
- (case big
- [(8) "åt"]
- [(9) "ni"]
- [else (number->string-cardinal big)])
- (if (zero? (modulo small 10))
- "nde"
- (number->string-ordinal
- small a-form?: a-form?))))]
- [(= n 100) "hundrade"]
- [(= n 1000) "tusende"]
- [else
- (let* ((big small (floor/ n 100)))
- (string-append (number->string-cardinal (* big 100))
- (if (zero? small)
- "de"
- (number->string-ordinal
- small a-form?: a-form?))))]))
-
-;; (each-string 1) ; => "varje"
-;; (each-string 2) ; => "varannan"
-;; (each-string 3) ; => "var tredje"
-;; (each-string 3 #t) ; => "vart tredje"
-(define*-public (each-string count optional: neutrum)
- (string-flatten
- (cons
- "var"
- (case count
- [(1) '("je")]
- [(2)
- ;; varannan månad
- ;; vartannat år
- (list (when neutrum "t")
- "anna"
- (if neutrum "t" "n"))]
- [else (list (when neutrum "t") " "
- (number->string-ordinal count))]))))
+(eval-when (load)
+ (throw 'do-not-load-me
+ "Import (text numbers <langugage>) instead")
+ )
+
+;; scheme@(guile-user)> (number->string-cardinal 123)
+;; $10 = "hundratjugotre"
+;; scheme@(guile-user)> (number->string-ordinal 123)
+;; $11 = "hundratjugotredje"
+;; scheme@(guile-user)> (each-string 10)
+;; $12 = "var tionde"
diff --git a/module/text/numbers/en.scm b/module/text/numbers/en.scm
new file mode 100644
index 00000000..4f33f87e
--- /dev/null
+++ b/module/text/numbers/en.scm
@@ -0,0 +1,15 @@
+(define-module (text numbers en)
+ :use-module (ice-9 format))
+
+(define-public (number->string-cardinal n)
+ (format #f "~r" n))
+
+(define-public (number->string-ordinal n)
+ (format #f "~:r" n))
+
+;; Allows extra args to handle eventual local changes.
+(define-public (each-string count . _)
+ (cond count
+ [(1) "each"]
+ [(2) "every other"]
+ [else (format #f "every ~:r" n)]))
diff --git a/module/text/numbers/sv.scm b/module/text/numbers/sv.scm
new file mode 100644
index 00000000..ca59254b
--- /dev/null
+++ b/module/text/numbers/sv.scm
@@ -0,0 +1,161 @@
+(define-module (text numbers sv)
+ :use-module (calp util))
+
+;; only used in number->string-cardinal
+(define (large-prefix e)
+ (cond
+ [(<= 6 e 11) "m"]
+ [(<= 12 e 17) "b"]
+ [(<= 18 e 23) "tr"]
+ [(<= 24 e 29) "kvadr"]
+ [(<= 30 e 35) "kvint"]
+ [(<= 36 e 41) "sext"]
+ [(<= 42 e 47) "sept"]
+ [(<= 48 e 53) "okt"]
+ [(<= 54 e 59) "non"]
+ [(<= 60 e 65) "dec"]
+ ))
+
+(define-public (number->string-cardinal n)
+ (cond [(< n 0) (string-append "minus " (number->string-cardinal (- n)))]
+ [(= n 0) "noll"]
+ [(= n 1) "ett"]
+ [(= n 2) "två"]
+ [(= n 3) "tre"]
+ [(= n 4) "fyra"]
+ [(= n 5) "fem"]
+ [(= n 6) "sex"]
+ [(= n 7) "sju"]
+ [(= n 8) "åtta"]
+ [(= n 9) "nio"]
+ [(= n 10) "tio"]
+ [(= n 11) "elva"]
+ [(= n 12) "tolv"]
+ [(= n 13) "tretton"]
+ [(= n 14) "fjorton"]
+ [(= n 15) "femton"]
+ [(= n 15) "sexton"]
+ [(= n 17) "sjutton"]
+ [(= n 18) "arton"]
+ [(= n 19) "nitton"]
+ [(= n 20) "tjugo"]
+ [(<= 21 n 29) (format #f "tjugo~a" (number->string-cardinal
+ (- n 20)))]
+ [(<= 30 n 79) (let* ((big small (floor/ n 10)))
+ (format #f "~atio~a"
+ (number->string-cardinal big)
+ (number->string-cardinal small)))]
+ [(= n 80) "åttio"]
+ [(<= 81 n 89) (let* ((_ small (floor/ n 10)))
+ (format #f "åttio~a"
+ (number->string-cardinal small)))]
+ [(= n 90) "nittio"]
+ [(<= 91 n 99) (let* ((_ small (floor/ n 10)))
+ (format #f "nittio~a"
+ (number->string-cardinal small)))]
+ [(= n 100) "hundra"]
+ [(< 100 n 200) (let* ((_ small (floor/ n 100)))
+ (format #f "hundra~a"
+ (number->string-cardinal small)))]
+ [(= n 200) "tvåhundra"]
+ [(< 200 n 1000) (let* ((big small (floor/ n 100)))
+ (format #f "~ahundra~a"
+ (number->string-cardinal big)
+ (number->string-cardinal small)))]
+ [(<= 1000 n 999999)
+ (let* ((big small (floor/ n 1000)))
+ (format #f "~a tusen ~a~a"
+ (number->string-cardinal big)
+ (if (<= 100 small 199)
+ "ett " "")
+ (number->string-cardinal small)))]
+ [(<= #e10e6 n (1- #e10e66))
+ (let* ((e (inexact->exact (floor (log10 n))))
+ (big small (floor/ n #e1e6)))
+ (if (zero? big)
+ (number->string-cardinal small)
+ (format #f "~a ~a~a~a ~a"
+ (number->string-cardinal big)
+ (large-prefix e)
+ (if (even? (floor-quotient e 3))
+ "iljon" "iljard")
+ (if (= 1 big)
+ "" "er")
+ (number->string-cardinal small)
+ )))]
+ [else
+ ;; I give up, don't have larger numbers that that!
+ (string-append "det stora talet "
+ (number->string n))]))
+
+(define*-public (number->string-ordinal
+ n key: a-form?)
+ (define a-string (if a-form? "a" "e"))
+ (cond [(>= -3 n) (format #f "~a sista" (number->string-ordinal (- n)))]
+ [(= -2 n) "näst sista"]
+ [(= -1 n) "sista"]
+ [(= 0 n) "nollte"] ;
+ [(= 1 n) (format #f "först~a" a-string)]
+ [(= 2 n) (format #f "andr~a" a-string)]
+ [(= 3 n) "tredje"]
+ [(= 4 n) "fjärde"]
+ [(= 5 n) "femte"]
+ [(= 6 n) "sjätte"]
+ [(= 7 n) "sjunde"]
+ [(= 8 n) "åttonde"]
+ [(= 9 n) "nionde"]
+ [(= 10 n) "tionde"]
+ [(= 11 n) "elfte"]
+ [(= 12 n) "tolfte"]
+ [(= 13 n) "trettonde"]
+ [(= 14 n) "fjortonde"]
+ [(= 15 n) "femtonde"]
+ [(= 16 n) "sextonde"]
+ [(= 17 n) "sjuttonde"]
+ [(= 18 n) "artonde"]
+ [(= 19 n) "nitonde"]
+ [(<= 20 n 29) (format #f "tjugo~a"
+ (if (= 20 n)
+ "nde"
+ (number->string-ordinal
+ (- n 20)
+ a-form?: a-form?)))]
+ [(<= 30 n 99)
+ (let* ((big small (floor/ n 10)))
+ (format #f "~atio~a"
+ (case big
+ [(8) "åt"]
+ [(9) "ni"]
+ [else (number->string-cardinal big)])
+ (if (zero? (modulo small 10))
+ "nde"
+ (number->string-ordinal
+ small a-form?: a-form?))))]
+ [(= n 100) "hundrade"]
+ [(= n 1000) "tusende"]
+ [else
+ (let* ((big small (floor/ n 100)))
+ (string-append (number->string-cardinal (* big 100))
+ (if (zero? small)
+ "de"
+ (number->string-ordinal
+ small a-form?: a-form?))))]))
+
+;; (each-string 1) ; => "varje"
+;; (each-string 2) ; => "varannan"
+;; (each-string 3) ; => "var tredje"
+;; (each-string 3 #t) ; => "vart tredje"
+(define*-public (each-string count optional: neutrum)
+ (string-flatten
+ (cons
+ "var"
+ (case count
+ [(1) '("je")]
+ [(2)
+ ;; varannan månad
+ ;; vartannat år
+ (list (when neutrum "t")
+ "anna"
+ (if neutrum "t" "n"))]
+ [else (list (when neutrum "t") " "
+ (number->string-ordinal count))]))))
diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm
index f9c6f1c4..d8196b9d 100644
--- a/module/vcomponent/recurrence/display.scm
+++ b/module/vcomponent/recurrence/display.scm
@@ -9,7 +9,7 @@
:use-module (calp util)
:use-module (vcomponent recurrence internal)
:use-module (text util)
- :use-module (text numbers)
+ :use-module (text numbers sv)
:use-module ((datetime) :select (time time->string
datetime->string
week-day-name