diff options
| -rw-r--r-- | scenes/game.scm | 186 |
1 files changed, 100 insertions, 86 deletions
diff --git a/scenes/game.scm b/scenes/game.scm index 3ab3512..7182beb 100644 --- a/scenes/game.scm +++ b/scenes/game.scm @@ -192,21 +192,42 @@ given MAX-WIDTH. Return a list of lines." (- 0 (vec2-y pos))))) (define-method (update (player <player>) dt) - ;; Check the action key separately. We only want to act on a - ;; state change, not when the key is held. - (when (key-released? 'space) - (set! (action-held player) #f)) - (or (and=> (talking? player) ;; Use arrow keys to select a message, hit action key to ;; confirm the selection. (lambda (who) - (handle-talking player who) + ;; Render the player messages in the selected order. + (unless (speaking? who) + (let ((bubble (child-ref (parent (parent player)) 'text-bubble)) + (messages (accepted-messages who))) + (clear-messages bubble) + (fold (lambda (message n lines) + (match message + ((message text . flags) + (when (zero? n) + (attach bubble + (make <filled-rect> + #:name 'dialog-selection-indicator + #:region (make-rect 0.0 0.0 10 10) + #:position (vec2 0 40) + #:color region))) + (+ lines + (render-text bubble text + #:suffix message + #:y-offset + (+ (* n %message-margin) + (* lines %line-height))))))) + 0 + messages + (iota (length messages))))) ;; Always end on #T to avoid passing through to the ;; motion branch. #t)) - ;; React to current key presses with motion. + ;; React to current key presses with motion. We don't use the + ;; on-key-press handler here, because it does not seem to behave + ;; right when two keys are pressed at the same time (e.g. left + ;; and up). (begin ;; Stop any motion in a direction when the matching key has just ;; been released. @@ -232,115 +253,100 @@ given MAX-WIDTH. Return a list of lines." (vel (velocity player)) (game (parent player))) (vec2-add! pos vel) - (and=> (collides? player game #:layer "collision") - (lambda (obj) - (match (map-object-type obj) - ;; Reset when the new position is invalid. - ('obstacle - (vec2-sub! pos vel)) - ('action - (when (and (not (action-held player)) - (key-pressed? 'space)) - (set! (action-held player) #t) - (match (map-object-name obj) - ("enter-house" - (teleport player 560.0 1800.0) - ;; TODO: change music? - (pause-music)) - ("exit-house" - (teleport player 620.0 1100.0) - (resume-music)) - ("talk-to-reaper" - (let ((reaper (child-ref game 'reaper))) - (unless (equal? (talking? player) reaper) - (talk player reaper 'hello)))) - (_ #t)))) - (_ #t)))))))) - -(define-method (handle-talking (player <player>) (who <character>)) + ;; Reset when the new position is invalid. + (when (collides? player game #:layer "collision") + (vec2-sub! pos vel)))))) + +(define-method (on-key-press (player <player>) key modifiers repeat?) + (when (eq? key 'q) + (switch-scene (root-node) (death))) + (let ((who (talking? player))) + (cond + ((and (not who) (eq? 'space key)) + (handle-action player)) + ((and who (not repeat?)) + (handle-talking player key))))) + +(define (handle-action player) + "Check if the PLAYER is on any region of the map where an action can +be executed; if so, perform the action." + (let ((game (parent player))) + (and=> (collides? player game #:layer "actions") + (lambda (obj) + (match (map-object-name obj) + ("enter-house" + (teleport player 560.0 1800.0) + ;; TODO: change music? + (pause-music)) + ("exit-house" + (teleport player 620.0 1100.0) + (resume-music)) + ("talk-to-reaper" + (start-talking player + (child-ref game 'reaper))) + (_ #t)))))) + +(define (handle-talking player key) + (define who (talking? player)) ;; Use arrow keys to select a message, hit action key to ;; confirm the selection. - (when (or (and (eq? 'up (selecting-message? player)) - (key-released? 'up)) - (and (eq? 'down (selecting-message? player)) - (key-released? 'down))) - (set! (selecting-message? player) #f)) - - (match (accepted-messages who) + (match (cond + ((wants-to-stop-talking? player) '()) + ((assoc-ref (resume-messages player) (name who)) => list) + (else (accepted-messages who))) ;; Nothing more to say, so just wait for the action key to ;; be hit to dismiss the dialogue. (() - (when (and (not (action-held player)) - (key-pressed? 'space)) - (set! (action-held player) #t) + (when (eq? 'space key) + (set! (speaking? who) #f) ; TODO? (stop-talking player))) - ((and ((and (message text) selected) . rest) messages) + ((and ((and (message text . flags) selected) . rest) messages) (cond ;; Select previous message - ((and (not (eq? 'up (selecting-message? player))) - (key-pressed? 'up)) + ((eq? 'up key) (set! (accepted-messages who) (append (list (last messages)) (drop-right messages 1))) (set! (selecting-message? player) 'up)) ;; Select next message - ((and (not (eq? 'down (selecting-message? player))) - (key-pressed? 'down)) + ((eq? 'down key) (set! (accepted-messages who) (append rest (list selected))) (set! (selecting-message? player) 'down)) ;; Submit selected message. - ((and (not (action-held player)) - (key-pressed? 'space) + ((and (eq? 'space key) (not (speaking? who))) - (set! (action-held player) #t) + ;; Delete remembered resume point if it exists, because we want + ;; to only use them once. + (when (assoc-ref (resume-messages player) (name who)) + (set! (resume-messages player) + (acons (name who) #f + (resume-messages player)))) + (and=> (member #:resume flags) + (match-lambda + ((#:resume (and (message text) pair)) + (set! (resume-messages player) + (acons (name who) pair + (resume-messages player))) + (set! (accepted-messages who) (list message)) + (set! (wants-to-stop-talking? player) #t)))) (talk player who message)) ;; Dismiss character's text. - ((and (not (action-held player)) - (key-pressed? 'space) + ((and (eq? 'space key) (speaking? who)) - (set! (action-held player) #t) (set! (speaking? who) #f)))) - (_ #t)) - - ;; Render the messages in the new order once the - ;; character's text has been dismissed. - (unless (speaking? who) - (let ((bubble (child-ref (parent (parent player)) 'text-bubble)) - (messages (accepted-messages who))) - (clear-messages bubble) - (fold (lambda (message n lines) - (match message - ((message text) - (when (zero? n) - (attach bubble - (make <filled-rect> - #:name 'dialog-selection-indicator - #:region (make-rect 0.0 0.0 10 10) - #:position (vec2 0 40) - #:color region))) - (+ lines - (render-text bubble text - #:suffix message - #:y-offset - (+ (* n %message-margin) - (* lines %line-height))))))) - 0 - messages - (iota (length messages)))))) + (_ (pk 'this-should-never-happen #t)))) (define-method (talk (player <player>) (who <character>) message) + "Send MESSAGE to WHO and display the response." (let ((bubble (child-ref (parent (parent player)) 'text-bubble))) - (when (not (talking? player)) - (set! (visible? bubble) #t)) - (match (assoc-ref (conversations who) message) ((text next) - (set! (talking? player) who) (set! (speaking? who) #t) + (set! (talking? player) who) ;; Clear any shown messages. (clear-messages bubble) @@ -354,10 +360,18 @@ given MAX-WIDTH. Return a list of lines." ;; conversation matching a message. (oops (pk 'oops #t))))) +(define-method (start-talking (player <player>) (who <character>)) + (unless (equal? (talking? player) who) + (let ((bubble (child-ref (parent (parent player)) 'text-bubble))) + (clear-messages bubble) + (set! (visible? bubble) #t)) + (set! (talking? player) who))) + (define-method (stop-talking (player <player>)) (when (talking? player) (set! (visible? (child-ref (parent (parent player)) 'text-bubble)) #f) - (set! (talking? player) #f))) + (set! (talking? player) #f) + (set! (wants-to-stop-talking? player) #f))) (define* (render-text bubble text #:key (y-offset 0) (suffix '-text)) "Fill the bubble with lines of text. Return the number of lines." |