<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>>https://en.wikipedia.org/wiki/MDL_(programming_language)
<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)>https://www.filfre.net/2012/01/zil-and-the-z-machine/
@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).https://www.inform-fiction.org/zmachine/standards/z1point0/sect04.html
Z-char 6789abcdef0123456789abcdef current -------------------------- A0 abcdefghijklmnopqrstuvwxyz A1 ABCDEFGHIJKLMNOPQRSTUVWXYZ A2 ^0123456789.,!?_#'"/\-:() --------------------------https://www.inform-fiction.org/zmachine/standards/z1point0/sect03.html
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 ;https://www.tads.org/t3doc/doc/t3QuickStart.htm#sample
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;http://www.firthworks.com/roger/cloak/inform/index.html
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."http://www.firthworks.com/roger/cloak/inform/index.html
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.
( 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 ;
( 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
( 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 ;
q" drop" verb= if ego find-object dup if room into say: Dropped. else drop say: I don't have that. then exit then
( 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
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
( 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
( Additional attributes and properties ) PROPERTIES: .north .south .east .west .up .down PROPERTIES: .northeast .northwest .southwest .southeast ATTRIBUTES: .holdable .described ATTRIBUTES: .open .locked
: 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 = ;
: iterate ( o xt -- ) swap .children begin dup @ while 2dup dup @ >r >r >r @ swap execute r> r> r> over @ = if @ .sibling then repeat 2drop ;
: 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 ;
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 @ ;
( 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 ! ;
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
( 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 ;
: 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 ;
: ;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 ;
4 README.md 127 engine.fs 194 generic.fs 250 svf-adventure.fs 575 total
source
and
slides
at:
github.com/flagxor