Motivation

• Tell an interactive story
• Use Forth for something specific

Interactive Fiction

• Simple text parsers, e.g. [VERB] [OBJECT]
• Descriptive text in place of graphics
• Direct world "model"

Colossal Cave Adventure

• 1976 - Will Crowther on PDP-10, in Fortran
• 1977 - Expanded by Don Woods (Stanford)
• You are in a maze of twisty little passages, all alike.
• XYZZY, PLUGH
• Knuth - "What a thrill it was when I first got past the green snake! Clearly the game was potentially addictive, so I forced myself to stop playing"

Infocom

• 1977 - Zork (Dungeon)
• 1979 - Infocom forms: Dave Lebling, Marc Blank, Albert Vezza, and Joel Berez
• A Mind Forever Voyaging
• Hitchhiker's Guide to the Galaxy
• Planetfall
• The Lurking Horror
• Leather Goddesses of Phobos

MDL (Muddle)

<DEFINE EXIT-TO (EXITS RMS)
        #DECL ((EXITS) EXIT (RMS) <UVECTOR [REST ROOM]>)
        <MAPF <>
              <FUNCTION (E)
                 #DECL ((E) <OR DIRECTION ROOM CEXIT NEXIT DOOR>)
                 <COND (<TYPE? .E DIRECTION>)
                       (<AND <TYPE? .E ROOM> <MEMQ .E .RMS>>
                        <MAPLEAVE T>)
                       (<AND <TYPE? .E CEXIT> <MEMQ <2 .E> .RMS>>
                        <MAPLEAVE T>)
                       (<AND <TYPE? .E DOOR>
                             <OR <MEMQ <DROOM1 .E> .RMS>
                                 <MEMQ <DROOM2 .E> .RMS>>>
                        <MAPLEAVE T>)>>
              .EXITS>>

ZIL / Zilch

<OBJECT LANTERN 
                (LOC LIVING-ROOM) 
                (SYNONYM LAMP LANTERN LIGHT) 
                (ADJECTIVE BRASS) 
                (DESC "brass lantern") 
                (FLAGS TAKEBIT LIGHTBIT) 
                (ACTION LANTERN-F) 
                (FDESC "A battery-powered lantern is on the trophy 
               case.") 
                (LDESC "There is a brass lantern (battery-powered) 
               here.") 
                (SIZE 15)>

Z-Machine

• 64K memory model, 16-bit words, 256 memory mapped globals
• Dynamic Data (objects, game state)
• Static Data (grammar table, actions, dictionary)
• High Data (Z-Code, static strings)

  @mul 1000 c -> sp;     d6 2f 03 e8 02 00
      variable form; count 2OP; opcode number 22; operands:
          03 e8  long constant (1000 decimal)
          02     variable c
      store result to stack pointer (var number 00).

Z-Machine (Strings)

   Z-char 6789abcdef0123456789abcdef
current   --------------------------
  A0      abcdefghijklmnopqrstuvwxyz
  A1      ABCDEFGHIJKLMNOPQRSTUVWXYZ
  A2       ^0123456789.,!?_#'"/\-:()
          --------------------------

Z-Machine (object model)

• Parent, children, sibling
• 24/32 Attributes (Binary Flags)
• Variable 16-bit properties, with default values

Interactive Fiction Continues

• 1986 - Infocom acquired by Activision
• Sierra Online
• LucasArt

Interactive Fiction as Art

• XYZZY Awards
• Photopia
• Lost Pig

TADS (Text Adventure Development System)

hallway: Room 'Hallway'
    "This hall is pretty bare,
    but there are exits to west and south. "
    south = startRoom
    west = study
;

study: Room 'Study'
    "This study is much as you would expect.
    A desk stands in the middle of the
    room. The way out is to the east. "
    east = hallway
;

Inform

Object  foyer "Foyer of the Opera House"
  with  description
           "You are standing in a spacious hall,
            splendidly decorated in red
            and gold, with glittering chandeliers overhead.
            The entrance from the street is to the north,
            and there are doorways south and west.",
        s_to  bar,
        w_to  cloakroom,
        n_to
           "You've only just arrived, and besides,
            the weather outside seems to be getting worse.",
  has   light;

Inform7 / Natural Inform

Foyer of the Opera House is a room.
"You are standing in a spacious hall,
splendidly decorated in red and gold,
with glittering chandeliers overhead.
The entrance from the street is to the north,
and there are doorways south and west."

Instead of going north in the Foyer,
say "You've only just arrived, and besides,
the weather outside seems to be getting worse."

Forth for Interactive Fiction

• Re-use the Forth Parser
• Mimic the core of the Z-Machine object model
• Domain Specific Vocabulary for this purpose
• An eye to targeting JS / Z-Machine
• Use GForth for now

Components

• Core Engine
• Generic World Model
• Game Specific

Trailing Strings

ROOM: shed   Inside Shed
DESCRIPTION: The shed is illuminated by a single dim lightbulb.
A small hatch in the floor leads into darkness. A metal ladder,
fused with the concrete is visible.

Trailing Strings

( Manipulate the rest of the current line )
: trailing? ( -- f) source nip >in @ - ;
: trailing ( -- a n ) source >in @ - swap >in @ + swap ;
: space? ( -- f ) source drop >in @ + c@ bl = ;
: skip-space   begin trailing? space? and while 1 >in +! repeat ;
: skip-trailing   source nip >in ! ;
: eat-trailing   skip-space trailing skip-trailing ;
: trailing,   eat-trailing dup , dup >r here swap cmove r> allot ;
: while-trailing ( xt -- )
   begin trailing? while dup execute repeat drop ;

Vocabulary for Parser

( Words common to many games )
game-words set-current
  NOUNS: north south east west up down
  NOUNS: northwest northeast southwest southeast
  NOUNS: n s e w nw ne sw se u d
  NOUNS: all
  VERBS: inventory i get drop look examine eat drink go
  FILLERS: a an the at
only forth definitions

Vocabulary for Parser

( Handle parts of a phrase )
variable cmd   variable obj   variable failed
variable uid   2 uid !
: noun create uid @++ , does> @ obj @ 8 lshift + obj ! ;
: NOUNS: ['] noun while-trailing ;
: verb create uid @++ , does> @ cmd @ 8 lshift + cmd ! ;
: VERBS: ['] verb while-trailing ;
: filler create does> drop ;
: FILLERS: ['] filler while-trailing ;

Handling Input

  q" drop" verb= if
    ego find-object
    dup if
      room into
      say: Dropped.
    else
      drop
      say: I don't have that.
    then
    exit
  then

String Encoding

• Lots of strings to pass around
• Mostly immutable strings
• > 255 characters
• Use a cell sized counted string!

Word Wrapping

( Print with word wrap )
: last-ch ( a n -- ch ) dup 0= if 2drop bl else + 1- c@ then ;
: bl-trim ( a n -- a n ) begin 2dup last-ch bl <> while 1- repeat ;
: wrap-point ( a n -- n )
   dup cols < if nip else drop cols 1- bl-trim nip then ;
: wrap-one ( a n -- a n )
   2dup wrap-point swap >r over >r dup >r type cr
   r> r> over + swap r> swap - ;
: wrap ( a n -- ) begin dup 0<> while wrap-one repeat 2drop cr ;
: cwrap ( ccs -- ) cc>s wrap ;
: say:   eat-trailing postpone sliteral postpone wrap ; immediate

Properties

variable property-count
: property create property-count @++ , does> @ cells + ;
: PROPERTIES: ['] property while-trailing ;
( Built-in properties )
PROPERTIES: .parent .children .sibling
PROPERTIES: .short-name .description .attributes .called

Attributes

( Game object attributes )
variable attribute-count
: attribute create attribute-count @++ 1 swap lshift , does> @ ;
: ATTRIBUTES: ['] attribute while-trailing ;
: set ( a attr -- ) swap .attributes or! ;
: clear ( a attr -- ) invert swap .attributes and! ;
: get ( a attr -- f ) swap .attributes @ and 0<> ;
( Built-in attributes )
ATTRIBUTES: .room .entity .prop

Applying Properties & Attributes

( Additional attributes and properties )
PROPERTIES: .north .south .east .west .up .down
PROPERTIES: .northeast .northwest .southwest .southeast
ATTRIBUTES: .holdable .described
ATTRIBUTES: .open .locked

Objects and Lists

: remove' ( o -- )
   dup .parent @ .children begin dup @ while
     2dup @ = if dup @ .sibling @ swap ! drop exit then
     @ .sibling
   repeat 2drop ;
: insert' ( o p -- )
   2dup   swap .parent !
   dup .children @ >r over r> swap .sibling !  .children ! ;
: into ( o p -- ) over remove' insert' ;
: contains ( o p -- f ) swap .parent = ;

Iteration

: iterate ( o xt -- )
   swap .children begin dup @ while
     2dup dup @ >r >r >r @ swap execute r> r> r>
     over @ = if @ .sibling then
   repeat 2drop ;

Iteration (cont.)

: drop-all-one ( o -- )
   dup .holdable get if room into else drop then ;
: drop-all ego ['] drop-all-one iterate ;

: get-all-one ( o -- )
   dup .holdable get if ego into else drop then ;
: get-all room ['] get-all-one iterate ;

Connecting Rooms

create direction-table
q" n" ,   q" north" ,      ' .north ,
q" s" ,   q" south" ,      ' .south ,
q" e" ,   q" east" ,       ' .east ,
q" w" ,   q" west" ,       ' .west ,
q" nw" ,  q" northwest" ,  ' .northwest ,
q" ne" ,  q" northeast" ,  ' .northeast ,
q" sw" ,  q" southwest" ,  ' .southwest ,
q" se" ,  q" southeast" ,  ' .southeast ,
q" u" ,   q" up" ,         ' .up ,
q" d" ,   q" down" ,       ' .down ,
10 constant direction-count
: direction ( n n -- ) swap 3 * + cells direction-table + @ ;
: short-direction 0 direction ;
: long-direction 1 direction ;
: in-direction 2 direction execute @ ;

Connecting Rooms (cont.)

( Connect rooms )
: connect-we ( a b -- ) 2dup .west ! swap .east ! ;
: connect-ns ( a b -- ) 2dup .north ! swap .south ! ;
: connect-nwse ( a b -- ) 2dup .northwest ! swap .southeast ! ;
: connect-nesw ( a b -- ) 2dup .northeast ! swap .southwest ! ;
: connect-ud ( a b -- ) 2dup .up ! swap .down ! ;

Maps

map-inside:
 0  R01  0   0   0  R17 |m
 0  R02 R03  0   0  R16 |m
 0   0  R04 R05  0  R15 |m
 0  R07 R06 R11 R12 R14 |m
R09 R08  0   0  R13  0  |m
 0  R10  0   0   0   0  |m
;map

Maps

( Build up a map )
variable map-width  variable map-height
variable map-start  variable map-outside
: map-init   0 map-width !  0 map-height !  here map-start ! ;
: map-inside: 0 map-outside !  map-init ;
: map-outside: -1 map-outside !  map-init ;
: |m   depth map-width !  1 map-height +!
       depth 0 do , loop ;

Maps

: map-x-inside? ( x -- f ) dup 0>= swap map-width @ < and ;
: map-y-inside? ( y -- f ) dup 0>= swap map-height @ < and ;
: map-inside? ( x y -- f ) map-y-inside? swap map-x-inside? and ;
: map-at ( x y -- a ) 2dup map-inside? 0= if 2drop 0 exit then
                      map-width @ * map-width @ 1- rot - +
                      cells map-start @ + @ ;
: validpair ( a b xt -- )
   -rot 2dup 0<> swap 0<> and if rot execute else 2drop drop then ;

Maps

: ;map map-height @ 0 do map-width @ 0 do
     i j map-at  i 1+ j    map-at  ['] connect-we validpair
     i j map-at  i j 1+    map-at  ['] connect-ns validpair
     map-outside @ if
       i j map-at  i 1+ j 1+ map-at  ['] connect-nwse validpair
       i j map-at  i 1- j 1+ map-at  ['] connect-nesw validpair
     then
   loop loop ;

Size and Complexity

       4 README.md
     127 engine.fs
     194 generic.fs
     250 svf-adventure.fs
     575 total

Thoughts on Complexity

• Z-Machine Object Model is powerful
• Very DOM like (Web object model)
• Re-using parser works well, but is harder then needed

Thoughts on Interactive Fiction

• Tantalizingly potent
• Cautionary history

Future Possibilities

• Actually finish a real work
• More flexible parser
• Target Z-Machine / Web
• A Z-Machine Forth
• Teaching Forth through Interactive Fiction

source and slides at:
github.com/flagxor

⚘

Thank you