Chapter 12: Game Commands

Let's implement command parsing and the main game loop.

Command Parser Module

Create adventure/commands.sgl:

(define-library (adventure commands)
  (import (adventure world)
          (sigil string))
  (export
   parse-command
   execute-command
   command-look
   command-go
   command-take
   command-drop
   command-inventory
   command-examine
   command-use
   command-help
   command-quit)

  (begin

    ;;; ========== Command Parsing ==========

    ;; Parse input into (verb . args) or #f
    (define (parse-command input)
      (let ((trimmed (string-trim input)))
        (if (string=? trimmed "")
            #f
            (let ((words (string-split trimmed " ")))
              (cons (string-downcase (car words))
                    (cdr words))))))


    ;;; ========== Direction Shortcuts ==========

    (define (expand-direction word)
      (cond
        ((string=? word "n") 'north)
        ((string=? word "s") 'south)
        ((string=? word "e") 'east)
        ((string=? word "w") 'west)
        ((string=? word "north") 'north)
        ((string=? word "south") 'south)
        ((string=? word "east") 'east)
        ((string=? word "west") 'west)
        (else #f)))


    ;;; ========== Command Execution ==========

    (define (execute-command cmd state)
      (if (not cmd)
          state
          (let ((verb (car cmd))
                (args (cdr cmd)))
            (cond
              ;; Movement
              ((or (string=? verb "go")
                   (expand-direction verb))
               (let ((dir (if (string=? verb "go")
                              (and (pair? args)
                                   (expand-direction (car args)))
                              (expand-direction verb))))
                 (if dir
                     (command-go dir state)
                     (begin
                       (display "Go where?")
                       (newline)
                       state))))

              ;; Looking
              ((string=? verb "look")
               (command-look state))

              ;; Taking items
              ((string=? verb "take")
               (if (pair? args)
                   (command-take (string->symbol (car args)) state)
                   (begin
                     (display "Take what?")
                     (newline)
                     state)))

              ;; Dropping items
              ((string=? verb "drop")
               (if (pair? args)
                   (command-drop (string->symbol (car args)) state)
                   (begin
                     (display "Drop what?")
                     (newline)
                     state)))

              ;; Inventory
              ((or (string=? verb "inventory")
                   (string=? verb "i"))
               (command-inventory state))

              ;; Examine
              ((or (string=? verb "examine")
                   (string=? verb "x")
                   (string=? verb "look"))
               (if (pair? args)
                   (command-examine (string->symbol (car args)) state)
                   (command-look state)))

              ;; Use
              ((string=? verb "use")
               (if (pair? args)
                   (command-use (string->symbol (car args)) state)
                   (begin
                     (display "Use what?")
                     (newline)
                     state)))

              ;; Help
              ((string=? verb "help")
               (command-help state))

              ;; Quit
              ((string=? verb "quit")
               (command-quit state))

              ;; Unknown
              (else
               (display "I don't understand '")
               (display verb)
               (display "'.")
               (newline)
               state)))))


    ;;; ========== Command Implementations ==========

    (define (command-look state)
      (let* ((room-id (game-state-current-room state))
             (rm (lookup-room state room-id)))
        (newline)
        (display "=== ")
        (display (room-name rm))
        (display " ===")
        (newline)
        (newline)
        (display (room-description rm))
        (newline)

        ;; Show items in room
        (let ((items (room-items rm)))
          (unless (null? items)
            (newline)
            (display "You can see:")
            (newline)
            (for-each
              (lambda (item-id)
                (let ((it (lookup-item state item-id)))
                  (display "  - ")
                  (display (item-name it))
                  (newline)))
              items)))
        (newline)
        state))

    (define (command-go direction state)
      (let* ((room-id (game-state-current-room state))
             (next-room (get-exit-room state room-id direction)))
        (if next-room
            (let ((new-state (game-state state current-room: next-room)))
              (command-look new-state))
            (begin
              (display "You can't go that way.")
              (newline)
              state))))

    (define (command-take item-id state)
      (let* ((room-id (game-state-current-room state))
             (rm (lookup-room state room-id))
             (room-items (room-items rm))
             (item (lookup-item state item-id)))
        (cond
          ((not item)
           (display "There's no such thing.")
           (newline)
           state)
          ((not (memq item-id room-items))
           (display "You don't see that here.")
           (newline)
           state)
          ((not (item-takeable item))
           (display "You can't take that.")
           (newline)
           state)
          (else
           ;; Remove from room, add to inventory
           (let ((new-room (room rm
                             items: (filter (lambda (x)
                                              (not (eq? x item-id)))
                                            room-items))))
             (display "Taken.")
             (newline)
             (game-state state
               inventory: (cons item-id (game-state-inventory state))
               rooms: (cons (cons room-id new-room)
                            (filter (lambda (p)
                                      (not (eq? (car p) room-id)))
                                    (game-state-rooms state)))))))))

    (define (command-drop item-id state)
      (let ((inv (game-state-inventory state)))
        (if (not (memq item-id inv))
            (begin
              (display "You're not carrying that.")
              (newline)
              state)
            (let* ((room-id (game-state-current-room state))
                   (rm (lookup-room state room-id))
                   (new-room (room rm items: (cons item-id (room-items rm)))))
              (display "Dropped.")
              (newline)
              (game-state state
                inventory: (filter (lambda (x) (not (eq? x item-id))) inv)
                rooms: (cons (cons room-id new-room)
                             (filter (lambda (p)
                                       (not (eq? (car p) room-id)))
                                     (game-state-rooms state))))))))

    (define (command-inventory state)
      (let ((inv (game-state-inventory state)))
        (if (null? inv)
            (display "You're not carrying anything.")
            (begin
              (display "You are carrying:")
              (newline)
              (for-each
                (lambda (item-id)
                  (let ((it (lookup-item state item-id)))
                    (display "  - ")
                    (display (item-name it))
                    (newline)))
                inv)))
        (newline)
        state))

    (define (command-examine item-id state)
      (let ((inv (game-state-inventory state))
            (room-items (get-room-items state (game-state-current-room state)))
            (item (lookup-item state item-id)))
        (cond
          ((not item)
           (display "There's no such thing.")
           (newline))
          ((or (memq item-id inv)
               (memq item-id room-items))
           (display (item-description item))
           (newline))
          (else
           (display "You don't see that here.")
           (newline)))
        state))

    (define (command-use item-id state)
      ;; Special handling for the key at the front door
      (cond
        ((and (eq? item-id 'key)
              (memq 'key (game-state-inventory state))
              (eq? (game-state-current-room state) 'hallway))
         (newline)
         (display "You insert the golden key into the front door's lock.")
         (newline)
         (display "With a satisfying *click*, the door swings open!")
         (newline)
         (display "Sunlight floods in. You step outside, finally free.")
         (newline)
         (newline)
         (display "*** CONGRATULATIONS! You escaped! ***")
         (newline)
         (game-state state won: #t))
        ((not (memq item-id (game-state-inventory state)))
         (display "You're not carrying that.")
         (newline)
         state)
        (else
         (display "You can't use that here.")
         (newline)
         state)))

    (define (command-help state)
      (display "Commands:")
      (newline)
      (display "  look          - Describe your surroundings")
      (newline)
      (display "  go <dir>      - Move in a direction (n/s/e/w)")
      (newline)
      (display "  take <item>   - Pick up an item")
      (newline)
      (display "  drop <item>   - Drop an item")
      (newline)
      (display "  inventory (i) - List what you're carrying")
      (newline)
      (display "  examine <item>- Look at something closely")
      (newline)
      (display "  use <item>    - Use an item")
      (newline)
      (display "  help          - Show this help")
      (newline)
      (display "  quit          - Exit the game")
      (newline)
      (newline)
      state)

    (define (command-quit state)
      (display "Thanks for playing!")
      (newline)
      (game-state state won: 'quit))))

Main Game Module

Create adventure/game.sgl:

(define-library (adventure game)
  (import (adventure world)
          (adventure commands))
  (export run-game)

  (begin

    (define (show-intro)
      (display "========================================")
      (newline)
      (display "        THE LOST KEY")
      (newline)
      (display "     A Text Adventure")
      (newline)
      (display "========================================")
      (newline)
      (newline)
      (display "You wake up in an unfamiliar house.")
      (newline)
      (display "The front door is locked, but there")
      (newline)
      (display "must be a key somewhere...")
      (newline)
      (newline)
      (display "(Type 'help' for commands)")
      (newline))

    (define (game-loop state)
      ;; Check for game over
      (cond
        ((eq? (game-state-won state) #t)
         state)  ; Player won, exit loop
        ((eq? (game-state-won state) 'quit)
         state)  ; Player quit
        (else
         ;; Get input
         (display "> ")
         (let ((input (read-line)))
           (if (eof-object? input)
               state
               (let* ((cmd (parse-command input))
                      (new-state (execute-command cmd state)))
                 (game-loop new-state)))))))

    (define (run-game)
      (show-intro)
      (let ((state (create-world)))
        (command-look state)
        (game-loop state)))))

Running the Game

Run from your project directory (use -L . to find the adventure modules):

sigil eval -L . -f adventure/main.sgl

You should see the intro, then be able to explore:

========================================
        THE LOST KEY
     A Text Adventure
========================================

You wake up in an unfamiliar house.
The front door is locked, but there
must be a key somewhere...

(Type 'help' for commands)

=== The Kitchen ===

A cozy kitchen with copper pots hanging from the ceiling.
The morning light streams through a window over the sink.
A door leads east to the hallway.

You can see:
  - a kitchen knife
  - a red apple

> e

=== The Hallway ===
...

Walkthrough

To win:

1. e — Go to hallway
2. s — Go to garden
3. take key — Pick up the key
4. n — Back to hallway
5. use key — Escape!

Practice Exercises

1. Add a read command for the note
2. Add more items and rooms
3. Create a puzzle that requires multiple items
4. Add synonyms (e.g., "grab" = "take")

What's Next

Let's polish the game with save/load and refinements.

Next: Game Polish →