data-abstraction.scm 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104
  1. (library (data-abstraction)
  2. (export get-all-effects
  3. get-all-means-of-transportation
  4. get-travelers
  5. get:traveler/route
  6. get:event-groups
  7. get:event-group/events
  8. ;; get:next-route-part
  9. ;; get:route-part/from
  10. ;; get:route-part/to
  11. ;; get:route-part/transportation
  12. )
  13. (import
  14. (except (rnrs base) let-values map error)
  15. (only (guile)
  16. lambda* λ
  17. map)
  18. (srfi srfi-1)
  19. ;; custom libraries
  20. (lib user-input-output)
  21. (lib list-procs)
  22. (lib alist-procs)
  23. (lib set)
  24. (prefix (lib logger) log:)
  25. (model)))
  26. ;; ================
  27. ;; DATA ABSTRACTION
  28. ;; ================
  29. ;; The goal of these procedures is to ease changes of data
  30. ;; structures for example for configuration objects, by
  31. ;; providing ways of accessing the data structures for other
  32. ;; parts of the program to use. If all other parts of the
  33. ;; program only make use of the data abstraction procedures,
  34. ;; then one can change the data structure and only adapt
  35. ;; these procedures, to get back to a working program,
  36. ;; instead of having to modify the whole program.
  37. (define get-all-effects
  38. (λ (story-params)
  39. (define items (alist-ref story-params "transportation"))
  40. (define events
  41. (apply append
  42. (map (λ (item)
  43. (vector->list (alist-ref (rest item) "events")))
  44. items)))
  45. (define effects
  46. (apply append
  47. (map (λ (event)
  48. (vector->list (alist-ref event "effects")))
  49. events)))
  50. (set->list (list->set effects))))
  51. (define get-all-means-of-transportation
  52. (λ (transportation-configs)
  53. (map (λ (entry) (first entry))
  54. transportation-configs)))
  55. (define get-travelers
  56. (λ (players)
  57. (map (λ (entry) (first entry))
  58. players)))
  59. (define get:traveler/route
  60. (λ (traveler-config)
  61. (vector->list (alist-ref (rest traveler-config) "route"))))
  62. (define get:event-groups
  63. (λ (transportations-config transportation)
  64. (alist-nested-refs transportations-config `(,transportation "events")
  65. #:default
  66. (λ ()
  67. (log:debug (string-format "using fallback transportation for ~a" transportation))
  68. (alist-nested-refs transportations-config `("default" "events"))))))
  69. (define get:event-group/events
  70. (λ (event-group)
  71. ;; (log:debug (string-format "getting events from event group ~a" event-group))
  72. (vector->list (rest event-group))))
  73. (define get:next-route-part
  74. (λ (route)
  75. (first route)))
  76. (define get:route-part/from
  77. (λ (route-part)
  78. (alist-ref route-part "from")))
  79. (define get:route-part/to
  80. (λ (route-part)
  81. (alist-ref route-part "to")))
  82. (define get:route-part/transportation
  83. (λ (route-part)
  84. (alist-ref route-part "transportation")))