mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
83 lines
3.2 KiB
Scheme
83 lines
3.2 KiB
Scheme
;;> A library for Sanskrit Prosody.
|
|
;;>
|
|
;;> Sanskrit poetry classifies syllables as "light" or "heavy".
|
|
;;> Patterns of three syllables are called a "gana", of which there
|
|
;;> are 2^3 = 8 combinations of light and heavy. This library allows
|
|
;;> looking up gana by number, and inquiring on their syllable
|
|
;;> pattern from name or number.
|
|
;;>
|
|
;;> See \hyperlink["http://en.wikipedia.org/wiki/Sanskrit_prosody"]{Sanskrit Poetry}.
|
|
|
|
(define-library (pingala prosody)
|
|
(export ganas ganas-pattern)
|
|
(import (scheme base) (scheme file) (scheme lazy) (scheme process-context))
|
|
(begin
|
|
;; String utilities.
|
|
(define (string-find str ch start)
|
|
(let ((end (string-length str)))
|
|
(let lp ((i start))
|
|
(cond ((>= i end) end)
|
|
((eqv? ch (string-ref str i)) i)
|
|
(else (lp (+ i 1)))))))
|
|
(define (string-split str ch)
|
|
(let ((end (string-length str)))
|
|
(let lp ((i 0) (res '()))
|
|
(let* ((j (string-find str ch i))
|
|
(res (cons (substring str i j) res)))
|
|
(if (>= j end)
|
|
(reverse res)
|
|
(lp (+ j 1) res))))))
|
|
;; Filesystem utilities.
|
|
(define (find-in-path base dirs)
|
|
(let lp ((ls dirs))
|
|
(and (pair? ls)
|
|
(let ((path (string-append (car ls) "/" base)))
|
|
(if (file-exists? path)
|
|
path
|
|
(lp (cdr ls)))))))
|
|
;; We install data files alongside source files, but have no way
|
|
;; to determine where this is. We need a SRFI providing an API to
|
|
;; determine standard system directories relative to the host
|
|
;; Scheme implementations install prefix. For now, for testing,
|
|
;; we use an env var hack.
|
|
(define ganas-path
|
|
(let ((prefix (or (get-environment-variable "SNOW_TEST_DATA_DIR") ".")))
|
|
(map (lambda (f) (string-append prefix "/" f))
|
|
(string-split
|
|
(or (get-environment-variable "PINGALA_GANAS_PATH")
|
|
".:/usr/local/share/pingala")
|
|
#\:))))
|
|
;; This data file is tiny - we keep it separate only for testing
|
|
;; purposes.
|
|
(define ganas-data
|
|
(delay
|
|
(let ((file (find-in-path "ganas.txt" ganas-path)))
|
|
(if (not file)
|
|
(error "couldn't find ganas.txt in " ganas-path))
|
|
(call-with-input-file file
|
|
(lambda (in)
|
|
(let lp ((res '()))
|
|
(let ((line (read-line in)))
|
|
(if (or (eof-object? line) (equal? "" line))
|
|
(list->vector (reverse res))
|
|
(lp (cons line res))))))))))
|
|
;;> Lookup a ganas by number.
|
|
(define (ganas x)
|
|
(if (integer? x)
|
|
(vector-ref (force ganas-data) x)
|
|
x))
|
|
;;> Returns the pattern as a string such as "H-L-L".
|
|
(define (ganas-pattern x)
|
|
(define (weight n)
|
|
(if (zero? n) "H" "L"))
|
|
(if (integer? x)
|
|
(string-append
|
|
(weight (modulo x 2)) "-"
|
|
(weight (modulo (quotient x 2) 2)) "-"
|
|
(weight (quotient x 4)))
|
|
(let lp ((i 0))
|
|
(and (< i (vector-length (force ganas-data)))
|
|
(if (equal? x (vector-ref (force ganas-data) i))
|
|
(ganas-pattern i)
|
|
(lp (+ i 1)))))))
|
|
))
|