plants.scm 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  1. (require easy
  2. plants-csv
  3. sg1
  4. musictypes)
  5. (defmacro (define-genus-aliases)
  6. `(begin
  7. ,@(.map (genus-alist)
  8. (lambda-pair ((card family))
  9. `(begin
  10. (define ,card ,(symbol-append '% card))
  11. (define ,family ,(symbol-append '% card))
  12. (define ,(=> family
  13. .string
  14. .downcase
  15. .symbol)
  16. ,(symbol-append '% card)))))))
  17. (define-genus-aliases)
  18. (defmacro (define-species-aliases)
  19. `(begin
  20. ,@(.map (species-alist)
  21. (lambda-pair ((setclass species-variable-string))
  22. (let ((species-variable (.symbol species-variable-string))
  23. (species-variable-lc
  24. (.symbol
  25. (.downcase species-variable-string))))
  26. `(begin
  27. (define ,species-variable ',setclass)
  28. (define ,species-variable-lc ,species-variable)))))))
  29. (define-species-aliases)
  30. (def genus-values-alist
  31. (map (lambda (p)
  32. (cons (eval (car p)) p))
  33. (genus-alist)))
  34. (def species-values-alist
  35. (map (lambda (p)
  36. (let-pair ((setclass species-variable-name-string) p)
  37. (cons setclass
  38. (.symbol species-variable-name-string))))
  39. (species-alist)))
  40. (def (maybe-show-genus [(list-of chord?) chs])
  41. (cond ((assoc chs genus-values-alist)
  42. => cdr)
  43. (else #f)))
  44. (def (maybe-show-species [chord? ch])
  45. (cond ((assoc ch species-values-alist)
  46. => cdr)
  47. (else #f)))
  48. (def chords? (list-of chord?))
  49. (def (genus-chords? v)
  50. (and (chords? v)
  51. (maybe-show-genus v)
  52. #t))
  53. (def (species-chord? v)
  54. (and (chord? v)
  55. (maybe-show-species v)
  56. #t))
  57. (def. (genus-chords.show v show)
  58. (maybe-show-genus v))
  59. (def. (species-chord.show v show)
  60. (maybe-show-species v))
  61. (TEST
  62. > (show '(0 0 1))
  63. (list 0 0 1)
  64. > (show '(0 1 2))
  65. Ipomoea-hederifolia)
  66. (def. (any.lily-annotate v)
  67. v)
  68. (def. (list.lily-annotate v)
  69. (map .lily-annotate v))
  70. (def. (genus-chords.lily-annotate v)
  71. (maybe-show-genus v))
  72. (def. (species-chord.lily-annotate v)
  73. (xcond ((maybe-show-species v)
  74. => (lambda (species-variable)
  75. `(annotation
  76. up
  77. ,(variable-symbol->plain-name species-variable)
  78. ,v)))))
  79. (TEST
  80. > (.lily-annotate '(0 0 1))
  81. (0 0 1)
  82. > (.lily-annotate '(0 1 2))
  83. (annotation up "Ipomoea hederifolia" (0 1 2))
  84. > (.lily-annotate '((1 2 3) (0 1 2) (0) (3 4 5)))
  85. ((1 2 3)
  86. (annotation up "Ipomoea hederifolia" (0 1 2))
  87. (annotation up "Nymphaea odorata" (0))
  88. (3 4 5)))