lf2-survival-stage-generator/model.scm

(import
  (except (rnrs base) let-values)
  (only (guile)
        lambda* λ
        error
        simple-format
        current-output-port)
  (prefix (logging) log:)
  ;; for functional structs (not part of srfi-9 directly)
  (srfi srfi-9 gnu)
  ;; hash tables
  (srfi srfi-69))


(define entity-names
  (alist->hash-table
   ;; standard chars
   '((0 . template)
     (1 . deep)
     ;; weird gap
     (2 . john)
     (4 . henry)
     (5 . rudolf)
     (6 . louis)
     (7 . firen)
     (8 . freeze)
     (9 . dennis)
     (10 . woody)
     (11 . davis)
     ;; stage chars
     (30 . bandit)
     (31 . hunter)
     (32 . mark)
     (33 . jack)
     (34 . sorcerer)
     (35 . monk)
     (36 . jan)
     (37 . knight)
     (39 . justin)
     ;; boss chars
     (38 . bat)
     (50 . louis-ex)
     (51 . firzen)
     (52 . julian)
     ;; randoms
     (1000 . 'random-hero)
     (3000 . 'random-bandit-hunter)
     ;; weapons
     (100 . stick)
     (101 . pick)
     (120 . knife)
     (121 . baseball)
     (122 . milk)
     (150 . stone)
     (151 . wooden-box)
     (123 . beer)
     (124 . boomerang)
     (217 . louis-armor-1)
     (218 . louis-armor-2)
     (300 . criminal))
   eqv?))


(define data-ids
  (alist->hash-table
   ;; standard chars
   '((template . 0)
     (deep . 1)
     ;; weird gap
     (john . 2)
     (henry . 4)
     (rudolf . 5)
     (louis . 6)
     (firen . 7)
     (freeze . 8)
     (dennis . 9)
     (woody . 10)
     (davis . 11)
     ;; stage chars
     (bandit . 30)
     (hunter . 31)
     (mark . 32)
     (jack . 33)
     (sorcerer . 34)
     (monk . 35)
     (jan . 36)
     (knight . 37)
     (justin . 39)
     ;; boss chars
     (bat . 38)
     (louis-ex . 50)
     (firzen . 51)
     (julian . 52)
     ;; randoms
     ('random-hero . 1000)
     ('random-bandit-hunter . 3000)
     ;; weapons
     (stick . 100)
     (pick . 101)
     (knife . 120)
     (baseball . 121)
     (milk . 122)
     (stone . 150)
     (wooden-box . 151)
     (beer . 123)
     (boomerang . 124)
     (louis-armor-1 . 217)
     (louis-armor-2 . 218)
     (criminal . 300))
   eqv?))


(define data-id->entity-name
  (λ (data-id)
    (hash-table-ref entity-names
                    data-id
                    (λ (id) #f))))


(define entity-name->data-id
  (λ (entity-name)
    (hash-table-ref data-ids
                    entity-name
                    (λ (name) #f))))


(define-immutable-record-type <phase>
  ;; define constructor
  (make-phase entities
              bound
              comment
              music-switch
              go-to-phase)
  ;; define predicate
  phase?
  ;; define accessors and functional setters
  (entities phase-entities set-phase-entities)
  (bound phase-bound set-phase-bound)
  (comment phase-comment set-phase-comment)
  (music-switch phase-music-switch set-phase-music-switch)
  (go-to-phase phase-go-to-phase set-phase-go-to-phase))


(define-immutable-record-type <entity>
  ;; define constructor
  (make-entity id
               x
               y
               hp
               act
               ratio
               times
               reserve
               join
               join-reserve
               boss
               soldier
               comment)
  ;; define predicate
  entity?
  ;; define accessors and functional setters
  (id entity-id set-entity-id)
  (x entity-x set-entity-x)
  (y entity-y set-entity-y)
  (hp entity-hp set-entity-hp)
  (act entity-act set-entity-act)
  (ratio entity-ratio set-entity-ratio)
  (times entity-times set-entity-times)
  (reserve entity-reserve set-entity-reserve)
  (join entity-join set-entity-join)
  (join-reserve entity-join-reserve set-entity-join-reserve)
  (boss entity-boss set-entity-boss)
  (soldier entity-soldier set-entity-soldier)
  (comment entity-comment set-entity-comment))

(define create-entity
  (lambda* (id
            hp
            #:key
            (y #f)
            (act #f)
            (ratio #f)
            (times #f)
            (reserve #f)
            (join #f)
            (join-reserve #f)
            (boss #f)
            (soldier #f)
            (comment #f)
            (default-hint? #f))
    "Helper procedure for creating entities."
    (make-entity
     id x y hp act ratio times reserve join join-reserve boss soldier comment)))


(define-immutable-record-type <hint>
  ;; define constructor
  (make-hint name val)
  ;; define predicate
  hint?
  ;; define accessors and functional setters
  (name hint-name set-hint-name)
  (val hint-val set-hint-val))