日本語版

[nazghul-jp/nazghul-jp.git] / worlds / haxima-1.002 / quests-mech.scm

;; Sets a quest to be complete, with notification if it is in progress
;; Note that if you set the quest to be complete before you assign it,
;; then the assignment notification will say that it has been immediately
;; completed, avoiding spamming the player with multiple notifications

(define (quest-complete quest)
        (if (and (quest-assigned? quest) use-quest-pane)
                (kern-log-msg "^c+mËÁ¸±¤ò´°Î»¤·¤¿:^c-\n^c+m" (qst-title quest) "^c-")
                )
        (qst-complete! quest)
        )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; internal utility methods

(define (quest-data-add-child parent quest)
        (let ((childlist (quest-data-getvalue parent 'qchildren)))
                (if (not (in-list? quest childlist))
                        (quest-data-update parent 'qchildren
                                (cons
                                        quest
                                        childlist
                                )
                        ))
        ))
                
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; quest assignment callbacks for use in quest definition

;; causes a notification on assignment
(define (quest-assign-notify quest target)
        (let ((notifytext (if (qst-complete? quest)
                                                "^c+mËÁ¸±¤ò´°Î»¤·¤¿:^c-\n^c+m"
                                                "^c+m¿·¤·¤¤ËÁ¸±:^c-\n^c+m"
                                                )))
                (if use-quest-pane
                        (kern-log-msg notifytext (qst-title quest) "^c-")
                )
                #t
        ))
        
;; ensures parent/subquest relation once quest is assigned
(define (quest-assign-subquest quest target)
        (let ((parent (quest-tbl-get quest 'qparent)))
                (if (not (null? parent))
                        (quest-data-add-child parent (qst-tag quest))
                        )
                #t
        ))
        
;; allows quest to proceed without any other action
(define (quest-assign-silent quest target)
                #t
        )
        
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; quest display callbacks for use in quest definition
        
;; doesnt actually do anything
(define (quest-status-from-payload quest)
        "In progress"
        )

;; doesnt actually do anything
(define (quest-status-inprogress quest)
        "In progress"
        )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interacting with the Quest Data Table
;;
;; The quest data table is a global storage location for fixed, plot
;; based quests that are created once and then activated at the
;; appropriate time
;;
;; Anything procedurally generated on the fly would need
;; to interface directly with the quest-sys module.
;;
        
;; retrieves a quest from the quest data table
(define (quest-data-get tag)
  (println "quest-data-get:" tag)
        (let* ((questdata (tbl-get (gob (kern-get-player)) 'questdata))
                        )
                        (tbl-get questdata tag)
                )
        )
        
;; retrieves a value from a quest payload tbl, given the key for the quest
;; and for the value
(define (quest-data-getvalue quest tag)
        (let* ((qpayload (car (qst-payload (quest-data-get quest)))))
                (tbl-get qpayload tag)
                )
        )

;; assigns a quest from the quest data table, while ensuring it is not
;;      given out repeatedly
(define (quest-data-assign-once tag)
        (let ((questentry (quest-data-get tag)))
                (if (not (quest-assigned? questentry))
                        (quest-assign questentry)
                )
        ))
        
;; checks if a quest from the quest data table has been assigned
(define (quest-data-assigned? tag)
        (quest-assigned? (quest-data-get tag))
        )
        
;; assuming quest in the QDT uses a tbl for payload, updates a key/value pair
(define (quest-data-update tag key value)
        (let* ((qpayload (car (qst-payload (quest-data-get tag))))
                        (updatehook (tbl-get qpayload 'on-update))
                        )
                (if (not (equal? (tbl-get qpayload key) value))
                        (begin
                                (tbl-set! qpayload key value)
                                (if (not (null? updatehook))
                                        ((eval updatehook))
                                )
                                (qst-bump! (quest-data-get tag))
                        ))
        ))
        
;; updates as per quest-data-update, but additionally triggers a passed in function
(define (quest-data-update-with tag key value callback)
  (println "quest-data-update-with")
  (let* (       
         (quest (quest-data-get tag))
         (qpayload (car (qst-payload quest)))
         )
    (println "quest:" quest)
    (println "qpayload:" qpayload)
    (if (is-tbl? qpayload)
        (let (
              (updatehook (tbl-get qpayload 'on-update))
              )
          (println "updatehook" updatehook)
          (if (not (equal? (tbl-get qpayload key) value))
              (begin                    
                (tbl-set! qpayload key value)
                (callback quest)
                (if (not (null? updatehook))
                    ((eval updatehook))
                    )           
                (qst-bump! (quest-data-get tag))
                )
              )
          )
        )
    )
  )

;; sets the description for a quest in the QDT
(define (quest-data-descr! tag descr)
        (qst-set-descr! (quest-data-get tag) descr)
        )

;; sets the icon for a quest in the QDT
(define (quest-data-icon! tag icon)
        (qst-set-icon! (quest-data-get tag) icon)
        )       

;; sets a quest in the QDT to be complete, giving a notification if appropriate
;;    see the notes for quest-complete, above
(define (quest-data-complete tag)
        (quest-complete (quest-data-get tag))
        )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     
;; callbacks for quest-data-update-with

;; if appropriate, notifies the player about a change in quest state
;; can be chained to further functions
(define (quest-notify subfunction)
  (println "quest-notify")
        (lambda (quest) 
                (if (and (quest-assigned? quest) use-quest-pane)
                        (kern-log-msg "^c+mËÁ¸±¤¬¿Ê¤ó¤À:^c-\n^c+m" (qst-title quest) "^c-")
                        )
                (if (not (null? subfunction))
                        (subfunction quest))
        ))
        
;; grants the player a given amount of experience, using or adding to the bonus xp
;;          as appropriate
(define (grant-xp-fn amount)
        (lambda (quest) 
                (let* ((qpayload (car (qst-payload quest)))
                                (bonusxp (tbl-get qpayload 'bonus-xp))
                                (bonusxp (if (null? bonusxp)
                                                        0 bonusxp))
                                (totalxp (+ bonusxp amount))
                                )
                        (if (quest-assigned? quest)
                                (begin
                                        (kern-char-add-experience (car (kern-party-get-members (kern-get-player))) totalxp)
                                        (tbl-set! qpayload 'bonus-xp 0)
                                )
                                (tbl-set! qpayload 'bonus-xp totalxp)
                        )
                )
        ))
        
;; shares amongst the players party a given amount of experience,
;;       using or adding to the bonus xp as appropriate
(define (grant-party-xp-fn amount)
        (lambda (quest) 
                (let* ((qpayload (car (qst-payload quest)))
                                (bonusxp (tbl-get qpayload 'bonus-xp))
                                (bonusxp (if (null? bonusxp)
                                                        0 bonusxp))
                                (totalxp (+ bonusxp amount))
                                (party (kern-party-get-members (kern-get-player)))
                                (xp-each (ceiling (/ totalxp (length party))))
                                )
                        (if (quest-assigned? quest)
                                (begin
                                        (map (lambda (kchar) (kern-char-add-experience kchar xp-each)) party)
                                        (tbl-set! qpayload 'bonus-xp 0)
                                )
                                (tbl-set! qpayload 'bonus-xp totalxp)
                        )
                )
        ))
        
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Reconcile active and pregenned quests at game load to simplify
;; ingame tracking
;;
;; internal methods- will run automatically
        
(kern-add-hook 'new_game_start_hook 'reconcile-quests)
(kern-add-hook 'new_game_start_hook 'refresh-quests)

(define (reconcile-quests kplayer)
        (let ((questlist
                                        (tbl-get (gob
                                                (kern-get-player)) 'quests))
                                (questdata
                                        (tbl-get (gob 
                                                (kern-get-player)) 'questdata))
                        )
                (map 
                        (lambda (quest)
                                (let ((tag (qst-tag quest)))
                                        (if (and (not (null? tag))
                                                        (not (null? (tbl-get questdata tag))))
                                                (tbl-set! questdata tag quest))
                                ))
                questlist)
        ))

(define (refresh-quests)
        (load "quests-data.scm")
        )
        
        
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utilities
        
;; links a quest and subquest after they are already in-play
(define (quest-data-convert-subquest quest parent)
        (quest-data-update quest 'qparent parent)
        (quest-data-add-child parent quest)
        )