12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915 |
- ! ==============================================================================
- ! VERBLIBM: Core of standard verbs library.
- !
- ! Supplied for use with Inform 6 -- Release 6/12 -- Serial number 151220
- !
- ! Copyright Graham Nelson 1993-2004 and David Griffith 2012-2015
- !
- ! This code is licensed under either the traditional Inform license as
- ! described by the DM4 or the Artistic License version 2.0. See the
- ! file COPYING in the distribution archive or at
- ! https://github.com/DavidGriffith/inform6lib/
- !
- ! This file is automatically Included in your game file by "VerbLib".
- ! ==============================================================================
- System_file;
- Constant DEBUG;
- Constant Grammar__Version 2;
- Include "linklpa";
- Include "linklv";
- ! ------------------------------------------------------------------------------
- [ Banner i;
-
- LanguageBanner();
- i = 0; ! suppress warning
-
- if (Story) {
-
-
- print "^", (string) Story;
-
-
- glk($0086, 3); ! set header style
- print (string) Story;
- glk($0086, 0); ! set normal style
-
- }
- if (Headline) print (string) Headline;
-
- print "Release ", (HDR_GAMERELEASE-->0) & $03ff, " / Serial number ";
- for (i=0 : i<6 : i++) print (char) HDR_GAMESERIAL->i;
-
- print "Release ";
- @aloads ROM_GAMERELEASE 0 i;
- print i;
- print " / Serial number ";
- for (i=0 : i<6 : i++) print (char) ROM_GAMESERIAL->i;
-
- print " / Inform v"; inversion;
- print " Library ", (string) LibRelease, " ";
-
- print "S";
-
-
- print "X";
-
-
- print "D";
-
-
- new_line;
-
- ];
- [ VersionSub ix;
-
- LanguageVersionSub();
- ix = 0; ! suppress warning
-
- Banner();
-
- ix = 0; ! shut up compiler warning
- if (standard_interpreter > 0) {
- print "Standard interpreter ", standard_interpreter/256, ".", standard_interpreter%256,
- " (", HDR_TERPNUMBER->0;
-
- print (char) '.', HDR_TERPVERSION->0;
-
- print (char) HDR_TERPVERSION->0;
-
- print ") / ";
- }
- else {
- print "Interpreter ", HDR_TERPNUMBER->0, " Version ";
-
- print HDR_TERPVERSION->0;
-
- print (char) HDR_TERPVERSION->0;
-
- print " / ";
- }
-
- @gestalt 1 0 ix;
- print "Interpreter version ", ix / $10000, ".", (ix & $FF00) / $100,
- ".", ix & $FF, " / ";
- @gestalt 0 0 ix;
- print "VM ", ix / $10000, ".", (ix & $FF00) / $100, ".", ix & $FF, " / ";
-
- print "Library serial number ", (string) LibSerial, "^";
-
- print (string) LanguageVersion, "^";
-
-
- ];
- [ RunTimeError n p1 p2;
-
- LanguageError(n, p1, p2);
-
-
- print "** Library error ", n, " (", p1, ", ", p2, ") **^** ";
- switch (n) {
- 1: print "preposition not found (this should not occur)";
- 2: print "Property value not routine or string: ~", (property) p2, "~ of ~", (name) p1,
- "~ (", p1, ")";
- 3: print "Entry in property list not routine or string: ~", (property) p2, "~ list of ~",
- (name) p1, "~ (", p1, ")";
- 4: print "Too many timers/daemons are active simultaneously.
- The limit is the library constant MAX_TIMERS
- (currently ", MAX_TIMERS, ") and should be increased";
- 5: print "Object ~", (name) p1, "~ has no ~", (property) p2, "~ property";
- 7: print "The object ~", (name) p1, "~ can only be used as a player object if it has
- the ~number~ property";
- 8: print "Attempt to take random entry from an empty table array";
- 9: print p1, " is not a valid direction property number";
- 10: print "The player-object is outside the object tree";
- 11: print "The room ~", (name) p1, "~ has no ~", (property) p2, "~ property";
- 12: print "Tried to set a non-existent pronoun using SetPronoun";
- 13: print "A 'topic' token can only be followed by a preposition";
- 14: print "Overflowed buffer limit of ", p1, " using '@@64output_stream 3' ", (string) p2;
- 15: print "LoopWithinObject broken because the object ", (name) p1, " was moved while the loop passed through it.";
- 16: print "Attempt to use illegal narrative_voice of ", p1, ".";
- default:
- print "(unexplained)";
- }
- " **";
-
- "** Library error ", n, " (", p1, ", ", p2, ") **";
-
-
- ];
- ! ----------------------------------------------------------------------------
- ! The WriteListFrom routine, a flexible object-lister taking care of
- ! plurals, inventory information, various formats and so on. This is used
- ! by everything in the library which ever wants to list anything.
- !
- ! If there were no objects to list, it prints nothing and returns false;
- ! otherwise it returns true.
- !
- ! o is the object, and style is a bitmap, whose bits are given by:
- ! ----------------------------------------------------------------------------
- Constant NEWLINE_BIT $0001; ! New-line after each entry
- Constant INDENT_BIT $0002; ! Indent each entry by depth
- Constant FULLINV_BIT $0004; ! Full inventory information after entry
- Constant ENGLISH_BIT $0008; ! English sentence style, with commas and and
- Constant RECURSE_BIT $0010; ! Recurse downwards with usual rules
- Constant ALWAYS_BIT $0020; ! Always recurse downwards
- Constant TERSE_BIT $0040; ! More terse English style
- Constant PARTINV_BIT $0080; ! Only brief inventory information after entry
- Constant DEFART_BIT $0100; ! Use the definite article in list
- Constant WORKFLAG_BIT $0200; ! At top level (only), only list objects
- ! which have the "workflag" attribute
- Constant ISARE_BIT $0400; ! Print " is" or " are" before list
- Constant CONCEAL_BIT $0800; ! Omit objects with "concealed" or "scenery":
- ! if WORKFLAG_BIT also set, then does _not_
- ! apply at top level, but does lower down
- Constant NOARTICLE_BIT $1000; ! Print no articles, definite or not
- Constant ID_BIT $2000; ! Print object id after each entry
- [ NextEntry o odepth;
- for (::) {
- o = sibling(o);
- if (o == 0) return 0;
- if (lt_value && o.list_together ~= lt_value) continue;
- if (c_style & WORKFLAG_BIT && odepth==0 && o hasnt workflag) continue;
- if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) continue;
- return o;
- }
- ];
- [ WillRecurs o;
- if (c_style & ALWAYS_BIT) rtrue;
- if (c_style & RECURSE_BIT == 0) rfalse;
- if ((o has transparent or supporter) || (o has container && o has open)) rtrue;
- rfalse;
- ];
- [ ListEqual o1 o2;
- if (child(o1) && WillRecurs(o1)) rfalse;
- if (child(o2) && WillRecurs(o2)) rfalse;
- if (c_style & (FULLINV_BIT + PARTINV_BIT)) {
- if ((o1 hasnt worn && o2 has worn) || (o2 hasnt worn && o1 has worn)) rfalse;
- if ((o1 hasnt light && o2 has light) || (o2 hasnt light && o1 has light)) rfalse;
- if (o1 has container) {
- if (o2 hasnt container) rfalse;
- if ((o1 has open && o2 hasnt open) || (o2 has open && o1 hasnt open))
- rfalse;
- }
- else if (o2 has container)
- rfalse;
- }
- return Identical(o1, o2);
- ];
- [ SortTogether obj value;
- ! print "Sorting together possessions of ", (object) obj, " by value ", value, "^";
- ! for (x=child(obj) : x : x=sibling(x))
- ! print (the) x, " no: ", x, " lt: ", x.list_together, "^";
- while (child(obj)) {
- if (child(obj).list_together ~= value) move child(obj) to out_obj;
- else move child(obj) to in_obj;
- }
- while (child(in_obj)) move child(in_obj) to obj;
- while (child(out_obj)) move child(out_obj) to obj;
- ];
- [ SortOutList obj i k l;
- ! print "^^Sorting out list from ", (name) obj, "^ ";
- ! for (i=child(location) : i : i=sibling(i))
- ! print (name) i, " --> ";
- ! new_line;
- .AP_SOL;
- for (i=obj : i : i=sibling(i)) {
- k = i.list_together;
- if (k ~= 0) {
- ! print "Scanning ", (name) i, " with lt=", k, "^";
- for (i=sibling(i) : i && i.list_together == k :) i = sibling(i);
- if (i == 0) rfalse;
- ! print "First not in block is ", (name) i, " with lt=", i.list_together, "^";
- for (l=sibling(i) : l : l=sibling(l))
- if (l.list_together == k) {
- SortTogether(parent(obj), k);
- ! print "^^After ST:^ ";
- ! for (i=child(location) : i : i=sibling(i))
- ! print (name) i, " --> ";
- ! new_line;
- obj = child(parent(obj));
- jump AP_SOL;
- }
- }
- }
- ];
- [ Print__Spaces n; ! To avoid a bug occurring in Inform 6.01 to 6.10
- if (n == 0) return;
- spaces n;
- ];
- [ Print__Spaces n;
- while (n > 0) {
- @streamchar ' ';
- n = n - 1;
- }
- ];
- [ WriteListFrom o style depth
- s1 s2 s3 s4 s5 s6;
- if (o == nothing) return 0;
- s1 = c_style; s2 = lt_value; s3 = listing_together;
- s4 = listing_size; s5 = wlf_indent; s6 = inventory_stage;
- if (o == child(parent(o))) {
- SortOutList(o);
- o = child(parent(o));
- }
- c_style = style;
- wlf_indent = 0;
- if (WriteListR(o, depth) == 0) return 0;
- c_style = s1; lt_value = s2; listing_together = s3;
- listing_size = s4; wlf_indent = s5; inventory_stage = s6;
- rtrue;
- ];
- [ WriteListR o depth stack_pointer classes_p sizes_p i j k k2 l m n q senc mr;
- if (depth > 0 && o == child(parent(o))) {
- SortOutList(o);
- o = child(parent(o));
- }
- for (::) {
- if (o == 0) rfalse;
- if (c_style & WORKFLAG_BIT && depth==0 && o hasnt workflag) {
- o = sibling(o);
- continue;
- }
- if (c_style & CONCEAL_BIT && (o has concealed || o has scenery)) {
- o = sibling(o);
- continue;
- }
- break;
- }
- classes_p = match_classes + stack_pointer;
- sizes_p = match_list + stack_pointer;
- for (i=o,j=0 : i && (j+stack_pointer)<128 : i=NextEntry(i,depth),j++) {
- classes_p->j = 0;
- if (i.plural) k++;
- }
- if (c_style & ISARE_BIT) {
- if (j == 1 && o hasnt pluralname) Tense(IS__TX, WAS__TX);
- else Tense(ARE__TX, WERE__TX);
- if (c_style & NEWLINE_BIT) print ":^";
- else print (char) ' ';
- c_style = c_style - ISARE_BIT;
- }
- stack_pointer = stack_pointer+j+1;
- if (k < 2) jump EconomyVersion; ! It takes two to plural
- n = 1;
- for (i=o,k=0 : k<j : i=NextEntry(i,depth),k++)
- if (classes_p->k == 0) {
- classes_p->k = n; sizes_p->n = 1;
- for (l=NextEntry(i,depth),m=k+1 : l && m<j : l=NextEntry(l,depth),m++)
- if (classes_p->m == 0 && i.plural && l.plural ~= 0) {
- if (ListEqual(i, l) == 1) {
- sizes_p->n = sizes_p->n + 1;
- classes_p->m = n;
- }
- }
- n++;
- }
- n--;
- for (i=1,j=o,k=0 : i<=n : i++,senc++) {
- while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) {
- k++; j=NextEntry(j, depth);
- }
- m = sizes_p->i;
- if (j == 0) mr = 0;
- else {
- if (j.list_together ~= 0 or lt_value && ZRegion(j.list_together) == Routine or String &&
- j.list_together == mr) senc--;
- mr = j.list_together;
- }
- }
- senc--;
- for (i=1,j=o,k=0,mr=0 : senc>=0 : i++,senc--) {
- while (((classes_p->k) ~= i) && ((classes_p->k) ~= -i)) {
- k++; j=NextEntry(j, depth);
- }
- if (j.list_together ~= 0 or lt_value) {
- if (j.list_together == mr) {
- senc++;
- jump Omit_FL2;
- }
- k2 = NextEntry(j, depth);
- if (k2 == 0 || k2.list_together ~= j.list_together) jump Omit_WL2;
- k2 = metaclass(j.list_together);
- if (k2 == Routine or String) {
- q = j; listing_size = 1; l = k; m = i;
- while (m < n && q.list_together == j.list_together) {
- m++;
- while (((classes_p->l) ~= m) && ((classes_p->l) ~= -m)) {
- l++; q = NextEntry(q, depth);
- }
- if (q.list_together == j.list_together) listing_size++;
- }
- ! print " [", listing_size, "] ";
- if (listing_size == 1) jump Omit_WL2;
- if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
- if (k2 == String) {
- q = 0;
- for (l=0 : l<listing_size : l++) q = q+sizes_p->(l+i);
- EnglishNumber(q); print " ";
- print (string) j.list_together;
- if (c_style & ENGLISH_BIT) print " (";
- if (c_style & INDENT_BIT) print ":^";
- }
- q = c_style;
- if (k2 ~= String) {
- inventory_stage = 1;
- parser_one = j; parser_two = depth+wlf_indent;
- if (RunRoutines(j, list_together) == 1) jump Omit__Sublist2;
- }
-
- @push lt_value; @push listing_together; @push listing_size;
-
- @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
-
- lt_value = j.list_together; listing_together = j; wlf_indent++;
- WriteListR(j, depth, stack_pointer); wlf_indent--;
-
- @pull listing_size; @pull listing_together; @pull lt_value;
-
- @copy sp listing_size;
- @copy sp listing_together;
- @copy sp lt_value;
-
- if (k2 == String) {
- if (q & ENGLISH_BIT) print ")";
- }
- else {
- inventory_stage = 2;
- parser_one = j; parser_two = depth+wlf_indent;
- RunRoutines(j, list_together);
- }
- .Omit__Sublist2;
- if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line;
- c_style = q;
- mr = j.list_together;
- jump Omit_EL2;
- }
- }
- .Omit_WL2;
- if (WriteBeforeEntry(j, depth, 0, senc) == 1) jump Omit_FL2;
- if (sizes_p->i == 1) {
- if (c_style & NOARTICLE_BIT) print (name) j;
- else {
- if (c_style & DEFART_BIT) print (the) j;
- else print (a) j;
- }
- if (c_style & ID_BIT) print " (", j, ")";
- }
- else {
- if (c_style & DEFART_BIT) PrefaceByArticle(j, 1, sizes_p->i);
- print (number) sizes_p->i, " ";
- PrintOrRun(j, plural, 1);
- }
- if (sizes_p->i > 1 && j hasnt pluralname) {
- give j pluralname;
- WriteAfterEntry(j, depth, stack_pointer);
- give j ~pluralname;
- }
- else {
- WriteAfterEntry(j,depth,stack_pointer);
- }
- .Omit_EL2;
- if (c_style & ENGLISH_BIT) {
- if (senc == 1) print (SerialComma) i+senc, (string) AND__TX;
- if (senc > 1) print (string) COMMA__TX;
- }
- .Omit_FL2;
- }
- rtrue;
- .EconomyVersion;
- n = j;
- for (i=1,j=o : i<=n : j=NextEntry(j,depth),i++,senc++) {
- if (j.list_together ~= 0 or lt_value && ZRegion(j.list_together) == 2 or 3 &&
- j.list_together==mr) senc--;
- mr = j.list_together;
- }
- for (i=1,j=o,mr=0 : i<=senc : j=NextEntry(j,depth),i++) {
- if (j.list_together ~= 0 or lt_value) {
- if (j.list_together == mr) {
- i--;
- jump Omit_FL;
- }
- k = NextEntry(j, depth);
- if (k == 0 || k.list_together ~= j.list_together) jump Omit_WL;
- k = metaclass(j.list_together);
- if (k == Routine or String) {
- if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
- if (k == String) {
- q = j; l = 0;
- do {
- q = NextEntry(q, depth); l++;
- } until (q == 0 || q.list_together ~= j.list_together);
- EnglishNumber(l); print " ";
- print (string) j.list_together;
- if (c_style & ENGLISH_BIT) print " (";
- if (c_style & INDENT_BIT) print ":^";
- }
- q = c_style;
- if (k ~= String) {
- inventory_stage = 1;
- parser_one = j; parser_two = depth+wlf_indent;
- if (RunRoutines(j, list_together) == 1) jump Omit__Sublist;
- }
-
- @push lt_value; @push listing_together; @push listing_size;
-
- @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
-
- lt_value = j.list_together; listing_together = j; wlf_indent++;
- WriteListR(j, depth, stack_pointer); wlf_indent--;
-
- @pull listing_size; @pull listing_together; @pull lt_value;
-
- @copy sp listing_size; @copy sp listing_together; @copy sp lt_value;
-
- if (k == String) {
- if (q & ENGLISH_BIT) print ")";
- }
- else {
- inventory_stage = 2;
- parser_one = j; parser_two = depth+wlf_indent;
- RunRoutines(j, list_together);
- }
- .Omit__Sublist;
- if (q & NEWLINE_BIT && c_style & NEWLINE_BIT == 0) new_line;
- c_style = q;
- mr = j.list_together;
- jump Omit_EL;
- }
- }
- .Omit_WL;
- if (WriteBeforeEntry(j, depth, i, senc) == 1) jump Omit_FL;
- if (c_style & NOARTICLE_BIT) print (name) j;
- else {
- if (c_style & DEFART_BIT) print (the) j;
- else print (a) j;
- }
- if (c_style & ID_BIT) print " (", j, ")";
- WriteAfterEntry(j, depth, stack_pointer);
- .Omit_EL;
- if (c_style & ENGLISH_BIT) {
- if (i == senc-1) print (SerialComma) senc, (string) AND__TX;
- if (i < senc-1) print (string) COMMA__TX;
- }
- .Omit_FL;
- }
- ]; ! end of WriteListR
- [ WriteBeforeEntry o depth ipos sentencepos
- flag;
- inventory_stage = 1;
- if (c_style & INDENT_BIT) Print__Spaces(2*(depth+wlf_indent));
- if (o.invent && (c_style & (PARTINV_BIT|FULLINV_BIT))) {
- flag = PrintOrRun(o, invent, 1);
- if (flag) {
- if (c_style & ENGLISH_BIT) {
- if (ipos == sentencepos-1)
- print (SerialComma) sentencepos, (string) AND__TX;
- if (ipos < sentencepos-1)
- print (string) COMMA__TX;
- }
- if (c_style & NEWLINE_BIT) new_line;
- }
- }
- return flag;
- ];
- [ WriteAfterEntry o depth stack_p
- p recurse_flag parenth_flag eldest_child child_count combo i j;
- inventory_stage = 2;
- if (c_style & PARTINV_BIT) {
- if (o.invent && RunRoutines(o, invent))
- if (c_style & NEWLINE_BIT) ""; else rtrue;
- combo = 0;
- if (o has light && location hasnt light) combo=combo+1;
- if (o has container && o hasnt open) combo=combo+2;
- if ((o has container && (o has open || o has transparent))) {
- objectloop(i in o) {
- if (i has concealed or scenery) j = false;
- if (i hasnt concealed && i hasnt scenery) j = true;
- }
- if (~~j) combo=combo+4;
- }
- if (combo) L__M(
- } ! end of PARTINV_BIT processing
- if (c_style & FULLINV_BIT) {
- if (o.invent && RunRoutines(o, invent))
- if (c_style & NEWLINE_BIT) ""; else rtrue;
- if (o has light && o has worn) { L__M(
- else {
- if (o has light) { L__M(
- if (o has worn) { L__M(
- }
- if (o has container)
- if (o has openable) {
- if (parenth_flag) print (string) AND__TX;
- else L__M(
- if (o has open)
- if (child(o)) L__M(
- else L__M(
- else
- if (o has lockable && o has locked) L__M(
- else L__M(
- parenth_flag = true;
- }
- else
- if (child(o)==0 && o has transparent)
- if (parenth_flag) L__M(
- else L__M(
- if (parenth_flag) print ")";
- } ! end of FULLINV_BIT processing
- if (c_style & CONCEAL_BIT) {
- child_count = 0;
- objectloop (p in o)
- if (p hasnt concealed && p hasnt scenery) { child_count++; eldest_child = p; }
- }
- else { child_count = children(o); eldest_child = child(o); }
- if (child_count && (c_style & ALWAYS_BIT)) {
- if (c_style & ENGLISH_BIT) L__M(
- recurse_flag = true;
- }
- if (child_count && (c_style & RECURSE_BIT)) {
- if (o has supporter) {
- if (c_style & ENGLISH_BIT) {
- if (c_style & TERSE_BIT) L__M(
- else L__M(
- if (o has animate) print (string) WHOM__TX;
- else print (string) WHICH__TX;
- }
- recurse_flag = true;
- }
- if (o has container && (o has open || o has transparent)) {
- if (c_style & ENGLISH_BIT) {
- if (c_style & TERSE_BIT) L__M(
- else L__M(
- if (o has animate) print (string) WHOM__TX;
- else print (string) WHICH__TX;
- }
- recurse_flag = true;
- }
- }
- if (recurse_flag && (c_style & ENGLISH_BIT))
- if (child_count > 1 || eldest_child has pluralname) Tense(ARE2__TX, WERE2__TX);
- else Tense(IS2__TX, WAS2__TX);
- if (c_style & NEWLINE_BIT) new_line;
- if (recurse_flag) {
- o = child(o);
-
- @push lt_value; @push listing_together; @push listing_size;
-
- @copy lt_value sp; @copy listing_together sp; @copy listing_size sp;
-
- lt_value = 0; listing_together = 0; listing_size = 0;
- WriteListR(o, depth+1, stack_p);
-
- @pull listing_size; @pull listing_together; @pull lt_value;
-
- @copy sp listing_size; @copy sp listing_together; @copy sp lt_value;
-
- if (c_style & TERSE_BIT) print ")";
- }
- ];
- ! ----------------------------------------------------------------------------
- ! LoopWithinObject(rtn,obj,arg)
- !
- ! rtn is the address of a user-supplied routine.
- ! obj is an optional parent object whose dependents are to be processed; the
- ! default is the current actor (normally the player).
- ! arg is an optional argument passed to the rtn; this can be a single variable
- ! or constant, or the address of an array (which enables multiple values to be
- ! passed and returned).
- !
- ! For each object o which is a child, grandchild, great-grandchild, etc, of the
- ! original obj, LoopWithinObject() calls rtn(o,arg).
- !
- ! The rtn should perform any appropriate testing or processing on each object o,
- ! using the optional arg value if necessary. If the rtn returns true (or any
- ! positive value), the children of o, if any, are also tested; those children
- ! are skipped if rtn returns false. To terminate the loop before all objects
- ! have been processed, rtn should return a large negative number (eg -99).
- !
- ! To deal with supporters and open containers, so that objects are processed
- ! only if they are accessible to the player, rtn might end with these
- ! statements:
- ! if ((o has transparent or supporter) || (o has container && o has open)) rtrue;
- ! rfalse;
- ! or alternatively with:
- ! c_style = RECURSE_BIT; return WillRecurs(o);
- !
- ! LoopWithinObject() returns the number of objects which have been processed.
- ! ----------------------------------------------------------------------------
- [ LoopWithinObject rtn obj arg
- n o x y;
- if (obj == 0) obj = actor;
- o = child(obj);
- while (o) {
- y = parent(o); n++;
- x = rtn(o, arg); ! user-supplied routine returning x.
- ! if x < 0: skip up to next parent
- ! if x = 0: jump across to next sibling
- ! if x > 0: continue down to child objects
- if (y ~= parent(o)) { RunTimeError(15, o); rfalse; }
- if (x > 0 && child(o)) o = child(o);
- else
- while (o) {
- if (++x > 0 && sibling(o)) { o = sibling(o); break; }
- o = parent(o);
- if (o == obj) return n;
- }
- }
- ];
- ! ----------------------------------------------------------------------------
- ! Much better menus can be created using one of the optional library
- ! extensions. These are provided for compatibility with previous practice:
- ! ----------------------------------------------------------------------------
- [ LowKey_Menu menu_choices EntryR ChoiceR lines main_title i j;
- menu_nesting++;
- .LKRD;
- menu_item = 0;
- lines = EntryR();
- main_title = item_name;
- print "--- "; print (string) main_title; print " ---^^";
- if (menu_choices ofclass Routine) menu_choices();
- else print (string) menu_choices;
- for (::) {
- L__M(
- print "> ";
-
-
- read buffer parse;
-
- read buffer parse DrawStatusLine;
-
- j = parse->1; ! number of words
-
- KeyboardPrimitive(buffer, parse);
- j = parse-->0; ! number of words
-
- i = parse-->1;
- if (j == 0 || (i == QUIT1__WD or QUIT2__WD)) {
- menu_nesting--; if (menu_nesting > 0) rfalse;
- if (deadflag == 0) <<Look>>;
- rfalse;
- }
- i = TryNumber(1);
- if (i == 0) jump LKRD;
- if (i < 1 || i > lines) continue;
- menu_item = i;
- j = ChoiceR();
- if (j == 2) jump LKRD;
- if (j == 3) rfalse;
- }
- ];
- [ DoMenu menu_choices EntryR ChoiceR; LowKey_Menu(menu_choices, EntryR, ChoiceR); ];
- [ DoMenu menu_choices EntryR ChoiceR
- lines main_title main_wid cl i j oldcl pkey ch cw y x;
- if (pretty_flag == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR);
- menu_nesting++;
- menu_item = 0;
- lines = EntryR();
- main_title = item_name; main_wid = item_width;
- cl = 7;
- .ReDisplay;
- oldcl = 0;
- @erase_window $ffff;
-
- @set_cursor -1;
- ch = HDR_FONTWUNITS->0;
-
- ch = 1;
-
- i = ch * (lines+7);
- @split_window i;
- i = HDR_SCREENWCHARS->0;
- if (i == 0) i = 80;
- @set_window 1;
- @set_cursor 1 1;
-
- @set_font 4 -> cw;
- cw = HDR_FONTHUNITS->0;
-
- cw = 1;
-
- style reverse;
- spaces(i); j=1+(i/2-main_wid)*cw;
- @set_cursor 1 j;
- print (string) main_title;
- y=1+ch; @set_cursor y 1; spaces(i);
- x=1+cw; @set_cursor y x; print (string) NKEY__TX;
- j=1+(i-13)*cw; @set_cursor y j; print (string) PKEY__TX;
- y=y+ch; @set_cursor y 1; spaces(i);
- @set_cursor y x; print (string) RKEY__TX;
- j=1+(i-18)*cw; @set_cursor y j;
- if (menu_nesting == 1) print (string) QKEY1__TX;
- else print (string) QKEY2__TX;
- style roman;
- y = y+2*ch;
- @set_cursor y x; font off;
- if (menu_choices ofclass String) print (string) menu_choices;
- else menu_choices();
- x = 1+3*cw;
- for (::) {
- if (cl ~= oldcl) {
- if (oldcl>0) {
- y=1+(oldcl-1)*ch; @set_cursor y x; print " ";
- }
- y=1+(cl-1)*ch; @set_cursor y x; print ">";
- }
- oldcl = cl;
- @read_char 1 -> pkey;
- if (pkey == NKEY1__KY or NKEY2__KY or 130) {
- cl++; if (cl == 7+lines) cl = 7; continue;
- }
- if (pkey == PKEY1__KY or PKEY2__KY or 129) {
- cl--; if (cl == 6) cl = 6+lines; continue;
- }
- if (pkey == QKEY1__KY or QKEY2__KY or 27 or 131) break;
- if (pkey == 10 or 13 or 132) {
- @set_window 0; font on;
- new_line; new_line; new_line;
- menu_item = cl-6;
- EntryR();
- @erase_window $ffff;
- @split_window ch;
- i = HDR_SCREENWCHARS->0; if ( i== 0) i = 80;
- @set_window 1; @set_cursor 1 1; style reverse; spaces(i);
- j=1+(i/2-item_width)*cw;
- @set_cursor 1 j;
- print (string) item_name;
- style roman; @set_window 0; new_line;
- i = ChoiceR();
- if (i == 2) jump ReDisplay;
- if (i == 3) break;
- L__M(
- @read_char 1 -> pkey; jump ReDisplay;
- }
- }
- menu_nesting--; if (menu_nesting > 0) rfalse;
- font on; @set_cursor 1 1;
- @erase_window $ffff; @set_window 0;
-
- @set_cursor -2;
-
- new_line; new_line; new_line;
- if (deadflag == 0) <<Look>>;
- ];
- [ DoMenu menu_choices EntryR ChoiceR
- winwid winhgt lines main_title main_wid cl i oldcl pkey;
- if (pretty_flag == 0 || gg_statuswin == 0) return LowKey_Menu(menu_choices, EntryR, ChoiceR);
- menu_nesting++;
- menu_item = 0;
- lines = EntryR();
- main_title = item_name;
- main_wid = item_width;
- cl = 0;
- ! If we printed "hit arrow keys" here, it would be appropriate to
- ! check for the availability of Glk input keys. But we actually
- ! print "hit N/P/Q". So it's reasonable to silently accept Glk
- ! arrow key codes as secondary options.
- .ReDisplay;
- glk($002A, gg_statuswin); ! window_clear
- glk($002A, gg_mainwin); ! window_clear
- glk($002F, gg_statuswin); ! set_window
- StatusLineHeight(lines+7);
- glk($0025, gg_statuswin, gg_arguments, gg_arguments+4); ! window_get_size
- winwid = gg_arguments-->0;
- winhgt = gg_arguments-->1;
- glk($0086, 4); ! set subheader style
- glk($002B, gg_statuswin, winwid/2-main_wid, 0); ! window_move_cursor
- print (string) main_title;
- glk($002B, gg_statuswin, 1, 1); ! window_move_cursor
- print (string) NKEY__TX;
- glk($002B, gg_statuswin, winwid-13, 1); ! window_move_cursor
- print (string) PKEY__TX;
- glk($002B, gg_statuswin, 1, 2); ! window_move_cursor
- print (string) RKEY__TX;
- glk($002B, gg_statuswin, winwid-18, 2); ! window_move_cursor
- if (menu_nesting == 1) print (string) QKEY1__TX;
- else print (string) QKEY2__TX;
- glk($0086, 0); ! set normal style
- glk($002B, gg_statuswin, 1, 4); ! window_move_cursor
- if (menu_choices ofclass String) print (string) menu_choices;
- else menu_choices();
- oldcl = -1;
- for (::) {
- if (cl ~= oldcl) {
- if (cl < 0 || cl >= lines) cl = 0;
- if (oldcl >= 0) {
- glk($002B, gg_statuswin, 3, oldcl+6);
- print (char) ' ';
- }
- oldcl = cl;
- glk($002B, gg_statuswin, 3, oldcl+6);
- print (char) '>';
- }
- pkey = KeyCharPrimitive(gg_statuswin, true);
- if (pkey == $80000000) jump ReDisplay;
- if (pkey == NKEY1__KY or NKEY2__KY or $fffffffb) {
- cl++;
- if (cl >= lines) cl = 0;
- continue;
- }
- if (pkey == PKEY1__KY or PKEY2__KY or $fffffffc) {
- cl--;
- if (cl < 0) cl = lines-1;
- continue;
- }
- if (pkey == QKEY1__KY or QKEY2__KY or $fffffff8 or $fffffffe) break;
- if (pkey == $fffffffa or $fffffffd) {
- glk($002F, gg_mainwin); ! set_window
- new_line; new_line; new_line;
- menu_item = cl+1;
- EntryR();
- glk($002A, gg_statuswin); ! window_clear
- glk($002A, gg_mainwin); ! window_clear
- glk($002F, gg_statuswin); ! set_window
- StatusLineHeight(1);
- glk($0025, gg_statuswin, gg_arguments, gg_arguments+4); ! window_get_size
- winwid = gg_arguments-->0;
- winhgt = gg_arguments-->1;
- glk($0086, 4); ! set subheader style
- glk($002B, gg_statuswin, winwid/2-item_width, 0); ! window_move_cursor
- print (string) item_name;
- glk($0086, 0); ! set normal style
- glk($002F, gg_mainwin); ! set_window
- new_line;
- i = ChoiceR();
- if (i == 2) jump ReDisplay;
- if (i == 3) break;
- L__M(
- pkey = KeyCharPrimitive(gg_mainwin, 1);
- jump ReDisplay;
- }
- }
- ! done with this menu...
- menu_nesting--;
- if (menu_nesting > 0) rfalse;
- glk($002F, gg_mainwin); ! set_window
- glk($002A, gg_mainwin); ! window_clear
- new_line; new_line; new_line;
- if (deadflag == 0) <<Look>>;
- ];
- ! ----------------------------------------------------------------------------
- ! A cunning routine (which could have been a daemon, but isn't, for the
- ! sake of efficiency) to move objects which could be in many rooms about
- ! so that the player never catches one not in place
- ! ----------------------------------------------------------------------------
- [ MoveFloatingObjects i k l m address flag;
- if (location == player or nothing) return;
- objectloop (i) {
- address = i.&found_in;
- if (address && i hasnt non_floating && ~~IndirectlyContains(player, i)) {
- if (metaclass(address-->0) == Routine)
- flag = i.found_in();
- else {
- flag = false;
- k = i.
- for (l=0 : l<k : l++) {
- m = address-->l;
- if ((m in Class && location ofclass m) ||
- m == location || m in location) {
- flag = true;
- break;
- }
- }
- }
- if (flag) {
- if (i notin location) move i to location;
- } else {
- if (parent(i)) remove i;
- }
- }
- }
- ];
- ! ----------------------------------------------------------------------------
- ! Two little routines for moving the player safely.
- ! ----------------------------------------------------------------------------
- [ PlayerTo newplace flag;
- NoteDeparture();
- move player to newplace;
- while (parent(newplace)) newplace = parent(newplace);
- location = real_location = newplace;
- MoveFloatingObjects(); AdjustLight(1);
- switch (flag) {
- 0: <Look>;
- 1: NoteArrival(); ScoreArrival();
- 2: LookSub(1);
- }
- ];
- [ MovePlayer direc; <Go direc>; <Look>; ];
- ! ----------------------------------------------------------------------------
- ! The handy YesOrNo routine, and some "meta" verbs
- ! ----------------------------------------------------------------------------
- [ YesOrNo noStatusRedraw
- i j;
- for (::) {
-
- if (location == nothing || parent(player) == nothing || noStatusRedraw)
- read buffer parse;
- else read buffer parse DrawStatusLine;
- j = parse->1;
-
- noStatusRedraw = 0; ! suppress warning
- KeyboardPrimitive(buffer, parse);
- j = parse-->0;
-
- if (j) { ! at least one word entered
- i = parse-->1;
- if (i == YES1__WD or YES2__WD or YES3__WD) rtrue;
- if (i == NO1__WD or NO2__WD or NO3__WD) rfalse;
- }
- L__M(
- }
- ];
- [ QuitSub;
- L__M(
- if (YesOrNo()) quit;
- ];
- [ RestartSub;
- L__M(
- if (YesOrNo()) { @restart; L__M(
- ];
- [ RestoreSub;
- restore Rmaybe;
- return L__M(
- .RMaybe;
- L__M(
- ];
- [ SaveSub flag;
-
- @save -> flag;
- switch (flag) {
- 0: L__M(
- 1: L__M(
- 2:
- RestoreColours();
- L__M(
- }
-
- save Smaybe;
- return L__M(
- .SMaybe;
- L__M(
-
- ];
- [ VerifySub;
- @verify ?Vmaybe;
- jump Vwrong;
- .Vmaybe;
- return L__M(
- .Vwrong;
- L__M(
- ];
- [ ScriptOnSub;
- transcript_mode = ((HDR_GAMEFLAGS-->0) & 1);
- if (transcript_mode) return L__M(
- @output_stream 2;
- if (((HDR_GAMEFLAGS-->0) & 1) == 0) return L__M(
- L__M(
- transcript_mode = true;
- ];
- [ ScriptOffSub;
- transcript_mode = ((HDR_GAMEFLAGS-->0) & 1);
- if (transcript_mode == false) return L__M(
- L__M(
- @output_stream -2;
- if ((HDR_GAMEFLAGS-->0) & 1) return L__M(
- transcript_mode = false;
- ];
- [ CommandsOnSub;
- @output_stream 4;
- xcommsdir = 1;
- L__M(
- ];
- [ CommandsOffSub;
- if (xcommsdir == 1) @output_stream -4;
- xcommsdir = 0;
- L__M(
- ];
- [ CommandsReadSub;
- @input_stream 1;
- xcommsdir = 2;
- L__M(
- ];
- [ QuitSub;
- L__M(
- if (YesOrNo()) quit;
- ];
- [ RestartSub;
- L__M(
- if (YesOrNo()) { @restart; L__M(
- ];
- [ RestoreSub res fref;
- fref = glk($0062, $01, $02, 0); ! fileref_create_by_prompt
- if (fref == 0) jump RFailed;
- gg_savestr = glk($0042, fref, $02, GG_SAVESTR_ROCK); ! stream_open_file
- glk($0063, fref); ! fileref_destroy
- if (gg_savestr == 0) jump RFailed;
- @restore gg_savestr res;
- glk($0044, gg_savestr, 0); ! stream_close
- gg_savestr = 0;
- .RFailed;
- L__M(
- ];
- [ SaveSub res fref;
- fref = glk($0062, $01, $01, 0); ! fileref_create_by_prompt
- if (fref == 0) jump SFailed;
- gg_savestr = glk($0042, fref, $01, GG_SAVESTR_ROCK); ! stream_open_file
- glk($0063, fref); ! fileref_destroy
- if (gg_savestr == 0) jump SFailed;
- @save gg_savestr res;
- if (res == -1) {
- ! The player actually just typed "restore". We're going to print
- ! L__M(
- ! now. But first, we have to recover all the Glk objects; the values
- ! in our global variables are all wrong.
- GGRecoverObjects();
- glk($0044, gg_savestr, 0); ! stream_close
- gg_savestr = 0;
- return L__M(
- }
- glk($0044, gg_savestr, 0); ! stream_close
- gg_savestr = 0;
- if (res == 0) return L__M(
- .SFailed;
- L__M(
- ];
- [ VerifySub res;
- @verify res;
- if (res == 0) return L__M(
- L__M(
- ];
- [ ScriptOnSub;
- if (gg_scriptstr) return L__M(
- if (gg_scriptfref == 0) {
- ! fileref_create_by_prompt
- gg_scriptfref = glk($0062, $102, $05, GG_SCRIPTFREF_ROCK);
- if (gg_scriptfref == 0) jump S1Failed;
- }
- ! stream_open_file
- gg_scriptstr = glk($0042, gg_scriptfref, $05, GG_SCRIPTSTR_ROCK);
- if (gg_scriptstr == 0) jump S1Failed;
- glk($002D, gg_mainwin, gg_scriptstr); ! window_set_echo_stream
- L__M(
- VersionSub();
- return;
- .S1Failed;
- L__M(
- ];
- [ ScriptOffSub;
- if (gg_scriptstr == 0) return L__M(
- L__M(
- glk($0044, gg_scriptstr, 0); ! stream_close
- gg_scriptstr = 0;
- ];
- [ CommandsOnSub fref;
- if (gg_commandstr) {
- if (gg_command_reading) return L__M(
- else return L__M(
- }
- ! fileref_create_by_prompt
- fref = glk($0062, $103, $01, 0);
- if (fref == 0) return L__M(
- gg_command_reading = false;
- ! stream_open_file
- gg_commandstr = glk($0042, fref, $01, GG_COMMANDWSTR_ROCK);
- glk($0063, fref); ! fileref_destroy
- if (gg_commandstr == 0) return L__M(
- L__M(
- ];
- [ CommandsOffSub;
- if (gg_commandstr == 0) return L__M(
- if (gg_command_reading) return L__M(
- glk($0044, gg_commandstr, 0); ! stream_close
- gg_commandstr = 0;
- gg_command_reading = false;
- L__M(
- ];
- [ CommandsReadSub fref;
- if (gg_commandstr) {
- if (gg_command_reading) return L__M(
- else return L__M(
- }
- ! fileref_create_by_prompt
- fref = glk($0062, $103, $02, 0);
- if (fref == 0) return L__M(
- gg_command_reading = true;
- ! stream_open_file
- gg_commandstr = glk($0042, fref, $02, GG_COMMANDRSTR_ROCK);
- glk($0063, fref); ! fileref_destroy
- if (gg_commandstr == 0) return L__M(
- L__M(
- ];
- [ NotifyOnSub; notify_mode = true; L__M(
- [ NotifyOffSub; notify_mode = false; L__M(
- [ Places1Sub i j k;
- L__M(
- objectloop (i has visited) j++;
- objectloop (i has visited) {
- print (name) i; k++;
- if (k == j) return L__M(
- if (k == j-1) print (SerialComma) j, (string) AND__TX;
- else print (string) COMMA__TX;
- }
- ];
- [ Objects1Sub i j f;
- L__M(
- objectloop (i has moved) {
- f = 1; print (the) i; j = parent(i);
- if (j) {
- if (j == player) {
- if (i has worn) L__M(
- else L__M(
- jump Obj__Ptd;
- }
- if (j has animate) { L__M(
- if (j has visited) { L__M(
- if (j has container) { L__M(
- if (j has supporter) { L__M(
- if (j has enterable) { L__M(
- }
- L__M(
- .Obj__Ptd;
- new_line;
- }
- if (f == 0) L__M(
- ];
- ! ----------------------------------------------------------------------------
- ! The scoring system
- ! ----------------------------------------------------------------------------
- [ ScoreSub;
-
- if (deadflag == 0) L__M(
-
- if (deadflag) new_line;
- L__M(
- if(PrintRank() == false) LibraryExtensions.RunAll(ext_printrank);
-
- ];
- [ TaskScore i;
- return task_scores->i;
- ];
- [ Achieved num;
- if (task_done->num == 0) {
- task_done->num = 1;
- score = score + TaskScore(num);
- }
- ];
- [ PANum m n;
- print " ";
- n = m;
- if (n < 0) { n = -m; n = n*10; }
- if (n < 10) { print " "; jump Panuml; }
- if (n < 100) { print " "; jump Panuml; }
- if (n < 1000) { print " "; }
- .Panuml;
- print m, " ";
- ];
- [ FullScoreSub i;
- ScoreSub();
- if (score == 0 || TASKS_PROVIDED == 1) rfalse;
- new_line;
- L__M(
- for (i=0 : i<NUMBER_TASKS : i++)
- if (task_done->i == 1) {
- PANum(TaskScore(i));
- if(PrintTaskName(i) == false)
- LibraryExtensions.RunAll(ext_printtaskname,i);
- }
- if (things_score) {
- PANum(things_score);
- L__M(
- }
- if (places_score) {
- PANum(places_score);
- L__M(
- }
- new_line; PANum(score); L__M(
- ];
- ! ----------------------------------------------------------------------------
- ! Real verbs start here: Inventory
- ! ----------------------------------------------------------------------------
- [ InvWideSub;
- if (actor == player)
- inventory_style = ENGLISH_BIT+FULLINV_BIT+RECURSE_BIT;
- else
- inventory_style = ENGLISH_BIT+PARTINV_BIT;
- <Inv, actor>;
- inventory_style = 0;
- ];
- [ InvTallSub;
- if (actor == player)
- inventory_style = NEWLINE_BIT+INDENT_BIT+FULLINV_BIT+RECURSE_BIT;
- else
- inventory_style = NEWLINE_BIT+INDENT_BIT+PARTINV_BIT;
- <Inv, actor>;
- inventory_style = 0;
- ];
- [ InvSub x;
- if (child(actor) == 0) return L__M(
- if (inventory_style == 0)
- if (actor == player) return InvTallSub();
- else return InvWideSub();
- L__M(
- if (inventory_style & NEWLINE_BIT) L__M(
- WriteListFrom(child(actor), inventory_style, 1);
- if (inventory_style & ENGLISH_BIT) L__M(
-
- objectloop (x in player) PronounNotice(x);
-
- x = 0; ! To prevent a "not used" error
- AfterRoutines();
- ];
- ! ----------------------------------------------------------------------------
- ! The object tree and determining the possibility of moves
- ! ----------------------------------------------------------------------------
- [ CommonAncestor o1 o2 i j;
- ! Find the nearest object indirectly containing o1 and o2,
- ! or return 0 if there is no common ancestor.
- i = o1;
- while (i) {
- j = o2;
- while (j) {
- if (j == i) return i;
- j = parent(j);
- }
- i = parent(i);
- }
- return 0;
- ];
- [ IndirectlyContains o1 o2;
- ! Does o1 indirectly contain o2? (Same as testing if their common ancestor is o1.)
- while (o2) {
- if (o1 == o2) rtrue;
- if (o2 ofclass Class) rfalse;
- o2 = parent(o2);
- }
- rfalse;
- ];
- [ ObjectScopedBySomething item i j k l m;
- i = item;
- objectloop (j .& add_to_scope) {
- l = j.&add_to_scope;
- k = (j.
- if (l-->0 ofclass Routine) continue;
- for (m=0 : m<k : m++)
- if (l-->m == i) return j;
- }
- rfalse;
- ];
- [ ObjectIsUntouchable item flag1 flag2 ancestor i;
- ! Determine if there's any barrier preventing the actor from moving
- ! things to "item". Return false if no barrier; otherwise print a
- ! suitable message and return true.
- ! If flag1 is set, do not print any message.
- ! If flag2 is set, also apply Take/Remove restrictions.
- ! If the item has been added to scope by something, it's first necessary
- ! for that something to be touchable.
- ancestor = CommonAncestor(actor, item);
- if (ancestor == 0) {
- ancestor = item;
- while (ancestor && (i = ObjectScopedBySomething(ancestor)) == 0)
- ancestor = parent(ancestor);
- if (i) {
- if (ObjectIsUntouchable(i, flag1, flag2)) return;
- ! An item immediately added to scope
- }
- }
- else
- ! First, a barrier between the actor and the ancestor. The actor
- ! can only be in a sequence of enterable objects, and only closed
- ! containers form a barrier.
- if (actor ~= ancestor) {
- i = parent(actor);
- while (i ~= ancestor) {
- if (i has container && i hasnt open) {
- if (flag1) rtrue;
- return L__M(
- }
- i = parent(i);
- }
- }
- ! Second, a barrier between the item and the ancestor. The item can
- ! be carried by someone, part of a piece of machinery, in or on top
- ! of something and so on.
- i = parent(item);
- if (item ~= ancestor && i ~= player) {
- while (i ~= ancestor) {
- if (flag2 && i hasnt container && i hasnt supporter) {
- if (i has animate) {
- if (flag1) rtrue;
- return L__M(
- }
- if (i has transparent) {
- if (flag1) rtrue;
- return L__M(
- }
- if (flag1) rtrue;
- return L__M(
- }
- if (i has container && i hasnt open) {
- if (flag1) rtrue;
- return L__M(
- }
- i = parent(i);
- }
- }
- rfalse;
- ];
- [ AttemptToTakeObject item
- ancestor after_recipient i k;
- ! Try to transfer the given item to the actor: return false
- ! if successful, true if unsuccessful, printing a suitable message
- ! in the latter case.
- ! People cannot ordinarily be taken.
- if (item == actor) return L__M(
- if (item has animate) return L__M(
- ancestor = CommonAncestor(actor, item);
- if (ancestor == 0) {
- i = ObjectScopedBySomething(item);
- if (i) ancestor = CommonAncestor(actor, i);
- }
- ! Is the actor indirectly inside the item?
- if (ancestor == item) return L__M(
- ! Does the actor already directly contain the item?
- if (item in actor) return L__M(
- ! Can the actor touch the item, or is there (e.g.) a closed container
- ! in the way?
- if (ObjectIsUntouchable(item, false, true)) rtrue;
- ! The item is now known to be accessible.
- ! Consult the immediate possessor of the item, if it's in a container
- ! which the actor is not in.
- i = parent(item);
- if (i && i ~= ancestor && (i has container or supporter)) {
- after_recipient = i;
- k = action; action =
- if (RunRoutines(i, before)) { action = k; rtrue; }
- action = k;
- }
- if (item has scenery) return L__M(
- if (item has static) return L__M(
- ! The item is now known to be available for taking. Is the player
- ! carrying too much? If so, possibly juggle items into the rucksack
- ! to make room.
- if (ObjectDoesNotFit(item, actor) ||
- LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, item, actor)) return;
- if (AtFullCapacity(item, actor)) return L__M(
- ! Transfer the item.
- move item to actor; give item ~worn;
- ! Send "after" message to the object letting go of the item, if any.
- if (after_recipient) {
- k = action; action =
- if (RunRoutines(after_recipient, after)) { action = k; rtrue; }
- action = k;
- }
- rfalse;
- ];
- [ AtFullCapacity n s
- obj k;
- n = n; ! suppress compiler warning
- if (s == actor) {
- objectloop (obj in s)
- if (obj hasnt worn) k++;
- } else
- k = children(s);
- if (k < RunRoutines(s, capacity) || (s == player && RoomInSack())) rfalse;
- ];
- [ RoomInSack
- obj ks;
- if (SACK_OBJECT && SACK_OBJECT in player) {
- ks = keep_silent; keep_silent = 2;
- for (obj=youngest(player) : obj : obj=elder(obj))
- if (obj ~= SACK_OBJECT && obj hasnt worn or light) {
- <Insert obj SACK_OBJECT>;
- if (obj in SACK_OBJECT) {
- keep_silent = ks;
- return L__M(
- }
- }
- keep_silent = ks;
- }
- rfalse;
- ];
- ! ----------------------------------------------------------------------------
- ! Support for implicit actions
- ! ----------------------------------------------------------------------------
- [ CheckImplicitAction act o1 o2
- sav_act sav_noun sav_sec res;
- if (o1 provides before_implicit) {
- sav_act = action; action = act;
- sav_noun = noun; noun = o1;
- if (o2) { sav_sec = second; second = o2; }
- res = RunRoutines(o1, before_implicit);
- action = sav_act; noun = sav_noun;
- if (sav_sec) second = sav_sec;
- }
- else {
- if (no_implicit_actions)
- res = 2;
- else
- res = 0;
- }
- return res;
- ];
- [ ImplicitTake obj
- res ks supcon;
- switch (metaclass(obj)) { Class, String, Routine, nothing: rfalse; }
- if (obj in actor) rfalse;
- if (action_to_be ==
- res = CheckImplicitAction(
- ! 0 = Take object, Tell the user (normal default)
- ! 1 = Take object, don't Tell
- ! 2 = don't Take object continue (default with no_implicit_actions)
- ! 3 = don't Take object, don't continue
- if (res >= 2) rtrue;
- if (parent(obj) && parent(obj) has container or supporter) supcon = parent(obj);
- ks = keep_silent; keep_silent = 2; AttemptToTakeObject(obj); keep_silent = ks;
- if (obj notin actor) rtrue;
- if (res == 0 && ~~keep_silent)
- if (supcon) L__M(
- else L__M(
- rfalse;
- ];
- [ ImplicitExit obj
- res ks;
- if (parent(obj) == nothing) rfalse;
- res = CheckImplicitAction(
- ! 0 = Exit object, Tell the user (normal default)
- ! 1 = Exit object, don't Tell
- ! 2 = don't Take object continue (default with no_implicit_actions)
- ! 3 = don't Take object, don't continue
- if (res >= 2) rtrue;
- ks = keep_silent; keep_silent = 2; <Exit obj, actor>; keep_silent = ks;
- if (parent(actor) == obj) rtrue;
- if (res == 0 && ~~keep_silent) L__M(
- rfalse;
- ];
- [ ImplicitClose obj
- res ks;
- if (obj hasnt open) rfalse;
- res = CheckImplicitAction(
- ! 0 = Close object, Tell the user (normal default)
- ! 1 = Close object, don't Tell
- ! 2 = don't Take object continue (default with no_implicit_actions)
- ! 3 = don't Take object, don't continue
- if (res >= 2) rtrue;
- ks = keep_silent; keep_silent = 2; <Close obj, actor>; keep_silent = ks;
- if (obj has open) rtrue;
- if (res == 0 && ~~keep_silent) L__M(
- rfalse;
- ];
- [ ImplicitOpen obj
- res ks;
- if (obj has open) rfalse;
- res = CheckImplicitAction(
- ! 0 = Open object, Tell the user (normal default)
- ! 1 = Open object, don't Tell
- ! 2 = don't Take object continue (default with no_implicit_actions)
- ! 3 = don't Take object, don't continue
- if (res >= 2) rtrue;
- if (obj has locked) rtrue;
- ks = keep_silent; keep_silent = 2; <Open obj, actor>; keep_silent = ks;
- if (obj hasnt open) rtrue;
- if (res == 0 && ~~keep_silent) L__M(
- rfalse;
- ];
- [ ImplicitUnlock obj;
- if (obj has locked) rtrue;
- rfalse;
- ];
- [ ImplicitDisrobe obj
- res ks;
- if (obj hasnt worn) rfalse;
- res = CheckImplicitAction(
- ! 0 = Take off object, Tell the user (normal default)
- ! 1 = Take off object, don't Tell
- ! 2 = don't Take object continue (default with no_implicit_actions)
- ! 3 = don't Take object, don't continue
- if (res >= 2) rtrue;
- ks = keep_silent; keep_silent = 1; <Disrobe obj, actor>; keep_silent = ks;
- if (obj has worn && obj in actor) rtrue;
- if (res == 0 && ~~keep_silent) L__M(
- rfalse;
- ];
- ! ----------------------------------------------------------------------------
- ! Object movement verbs
- ! ----------------------------------------------------------------------------
- [ TakeSub;
- if (onotheld_mode == 0 || noun notin actor)
- if (AttemptToTakeObject(noun)) return;
- if (AfterRoutines()) return;
- notheld_mode = onotheld_mode;
- if (notheld_mode == 1 || keep_silent) return;
- L__M(
- ];
- [ RemoveSub i;
- i = parent(noun);
- if (i && i has container && i hasnt open && ImplicitOpen(i)) return L__M(
- if (i ~= second) return L__M(
- if (i has animate) return L__M(
- if (AttemptToTakeObject(noun)) rtrue;
- action =
- action =
- if (keep_silent) return;
- L__M(
- ];
- [ DropSub;
- if (noun == actor) return L__M(
- if (noun in parent(actor)) return L__M(
- if (noun notin actor && ~~ImplicitTake(noun)) return L__M(
- if (noun has worn && ImplicitDisrobe(noun)) return;
- move noun to parent(actor);
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ PutOnSub ancestor;
- receive_action =
- if (second == d_obj || actor in second) <<Drop noun, actor>>;
- if (parent(noun) == second) return L__M(
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- ancestor = CommonAncestor(noun, second);
- if (ancestor == noun) return L__M(
- if (ObjectIsUntouchable(second)) return;
- if (second ~= ancestor) {
- action =
- if (RunRoutines(second, before)) { action =
- action =
- }
- if (second hasnt supporter) return L__M(
- if (ancestor == actor) return L__M(
- if (noun has worn && ImplicitDisrobe(noun)) return;
- if (ObjectDoesNotFit(noun, second) ||
- LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return;
- if (AtFullCapacity(noun, second)) return L__M(
- move noun to second;
- if (AfterRoutines()) return;
- if (second ~= ancestor) {
- action =
- if (RunRoutines(second, after)) { action =
- action =
- }
- if (keep_silent) return;
- if (multiflag) return L__M(
- L__M(
- ];
- [ InsertSub ancestor;
- receive_action =
- if (second == d_obj || actor in second) <<Drop noun, actor>>;
- if (parent(noun) == second) return L__M(
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- ancestor = CommonAncestor(noun, second);
- if (ancestor == noun) return L__M(
- if (ObjectIsUntouchable(second)) return;
- if (second ~= ancestor) {
- action =
- if (RunRoutines(second,before)) { action =
- action =
- if (second has container && second hasnt open && ImplicitOpen(second))
- return L__M(
- }
- if (second hasnt container) return L__M(
- if (noun has worn && ImplicitDisrobe(noun)) return;
- if (ObjectDoesNotFit(noun, second) ||
- LibraryExtensions.RunWhile(ext_objectdoesnotfit, false, noun, second)) return;
- if (AtFullCapacity(noun, second)) return L__M(
- move noun to second;
- if (second ~= ancestor) {
- action =
- if (RunRoutines(second, after)) { action =
- action =
- }
- if (keep_silent) rtrue;
- if (multiflag) return L__M(
- L__M(
- ];
- ! ----------------------------------------------------------------------------
- ! Empties and transfers are routed through the actions above
- ! ----------------------------------------------------------------------------
- [ TransferSub;
- if (noun notin actor && AttemptToTakeObject(noun)) return;
- if (second has supporter) <<PutOn noun second, actor>>;
- if (second == d_obj) <<Drop noun, actor>>;
- <<Insert noun second, actor>>;
- ];
- [ EmptySub; second = d_obj; EmptyTSub(); ];
- [ EmptyTSub i j k flag;
- if (noun == second) return L__M(
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt container) return L__M(
- if (noun hasnt open && ImplicitOpen(noun)) return L__M(
- if (second ~= d_obj) {
- if (second hasnt supporter) {
- if (second hasnt container) return L__M(
- if (second hasnt open && ImplicitOpen(second))
- return L__M(
- }
- }
- i = child(noun); k = children(noun);
- if (i == 0) return L__M(
- while (i) {
- j = sibling(i);
- flag = false;
- if (ObjectIsUntouchable(noun)) flag = true;
- if (noun hasnt container) flag = true;
- if (noun hasnt open) flag = true;
- if (second ~= d_obj) {
- if (second hasnt supporter) {
- if (second hasnt container) flag = true;
- if (second hasnt open) flag = true;
- }
- }
- if (k-- == 0) flag = 1;
- if (flag) break;
- if (keep_silent == 0) print (name) i, (string) COLON__TX;
- <Transfer i second, actor>;
- i = j;
- }
- ];
- ! ----------------------------------------------------------------------------
- ! Gifts
- ! ----------------------------------------------------------------------------
- [ GiveSub;
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- if (second == actor) return L__M(
- if (noun has worn && ImplicitDisrobe(noun)) return;
- if (second == player) {
- move noun to player;
- return L__M(
- }
- if (RunLife(second,
- L__M(
- ];
- [ GiveRSub; <Give second noun, actor>; ];
- [ ShowSub;
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- if (second == player) <<Examine noun, actor>>;
- if (RunLife(second,
- L__M(
- ];
- [ ShowRSub; <Show second noun, actor>; ];
- ! ----------------------------------------------------------------------------
- ! Travelling around verbs
- ! ----------------------------------------------------------------------------
- [ EnterSub ancestor j ks;
- if (noun has door || noun in compass) <<Go noun, actor>>;
- if (actor in noun) return L__M(
- if (noun hasnt enterable) return L__M(
- if (parent(actor) ~= parent(noun)) {
- ancestor = CommonAncestor(actor, noun);
- if (ancestor == actor or 0) return L__M(
- while (actor notin ancestor) {
- j = parent(actor);
- ks = keep_silent;
- if (parent(j) ~= ancestor || noun ~= ancestor) {
- L__M(
- keep_silent = 1;
- }
- <Exit, actor>;
- keep_silent = ks;
- if (actor in j) return;
- }
- if (actor in noun) return;
- if (noun notin ancestor) {
- j = parent(noun);
- while (parent(j) ~= ancestor) j = parent(j);
- L__M(
- ks = keep_silent; keep_silent = 1;
- <Enter j, actor>;
- keep_silent = ks;
- if (actor notin j) return;
- <<Enter noun, actor>>;
- }
- }
- if (noun has container && noun hasnt open && ImplicitOpen(noun)) return L__M(
- move actor to noun;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- if (actor == player) Locale(noun);
- ];
- [ GetOffSub;
- if (parent(actor) == noun) <<Exit, actor>>;
- L__M(
- ];
- [ ExitSub p;
- p = parent(actor);
- if (noun ~= nothing && noun ~= p) return L__M(
- if (p == location || (location == thedark && p == real_location)) {
- if (actor provides posture && actor.posture) {
- actor.posture = 0;
- return L__M(
- }
- if ((location.out_to) || (location == thedark && real_location.out_to))
- <<Go out_obj, actor>>;
- return L__M(
- }
- if (p has container && p hasnt open && ImplicitOpen(p))
- return L__M(
- if (noun == nothing) {
- inp1 = p;
- if (RunRoutines(p, before)) return;
- }
- move actor to parent(p);
- if (player provides posture) player.posture = 0;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- if (actor == player && p has container) LookSub(1);
- ];
- [ VagueGoSub; L__M(
- [ GoInSub; <<Go in_obj, actor>>; ];
- [ GoSub i j k movewith thedir next_loc;
- ! first, check if any PushDir object is touchable
- if (second && second notin Compass && ObjectIsUntouchable(second)) return;
- movewith = 0;
- i = parent(actor);
- if ((location ~= thedark && i ~= location) || (location == thedark && i ~= real_location)) {
- j = location;
- if (location == thedark) location = real_location;
- k = RunRoutines(i, before); if (k ~= 3) location = j;
- if (k == 1) {
- movewith = i; i = parent(i);
- }
- else {
- if (k) rtrue;
- if (ImplicitExit(i)) return L__M(
- i = parent(actor);
- }
- }
- thedir = noun.door_dir;
- if (metaclass(thedir) == Routine) thedir = RunRoutines(noun, door_dir);
- next_loc = i.thedir; k = metaclass(next_loc);
- if (k == String) { print (string) next_loc; new_line; rfalse; }
- if (k == Routine) {
- next_loc = RunRoutines(i, thedir);
- if (next_loc == 1) rtrue;
- }
- if (k == nothing || next_loc == 0) {
- if (i.cant_go ~= 0 or CANTGO__TX) PrintOrRun(i, cant_go);
- else L__M(
- rfalse;
- }
- if (next_loc has door) {
- if (next_loc has concealed) return L__M(
- if (next_loc hasnt open && ImplicitOpen(next_loc)) {
- if (noun == u_obj) return L__M(
- if (noun == d_obj) return L__M(
- return L__M(
- }
- k = RunRoutines(next_loc, door_to);
- if (k == 0) return L__M(
- if (k == 1) rtrue;
- next_loc = k;
- }
- action =
- if (RunRoutines(next_loc, before)) { action =
- action =
- if (movewith == 0) move actor to next_loc; else move movewith to next_loc;
- if (actor ~= player) return L__M(
- k = location; location = next_loc;
- MoveFloatingObjects();
- if (OffersLight(location))
- lightflag = true;
- else {
- lightflag = false;
- if (k == thedark) {
- if(DarkToDark() == false) ! From real_location To location
- LibraryExtensions.RunAll(ext_darktodark);
- if (deadflag) rtrue;
- }
- location = thedark;
- }
- NoteDeparture(); real_location = next_loc;
- action =
- if (RunRoutines(prev_location, after)) { action =
- action =
- if (AfterRoutines() || keep_silent) return;
- LookSub(1);
- ];
- ! ----------------------------------------------------------------------------
- ! Describing the world. SayWhatsOn(object) does just that (producing
- ! no text if nothing except possibly "scenery" and "concealed" items are).
- ! Locale(object) runs through the "tail end" of a Look-style room
- ! description for the contents of the object, printing up suitable
- ! descriptions as it goes.
- ! ----------------------------------------------------------------------------
- [ SayWhatsOn descon j f;
- if (descon == parent(player)) rfalse;
- objectloop (j in descon)
- if (j hasnt concealed && j hasnt scenery) f = 1;
- if (f == 0) rfalse;
- L__M(
- ];
- [ NotSupportingThePlayer o i;
- i = parent(player);
- while (i && i ~= visibility_ceiling) {
- if (i == o) rfalse;
- i = parent(i);
- if (i && i hasnt supporter) rtrue;
- }
- rtrue;
- ];
- ! modified with the fix for L61122
- [ Locale descin text_without_ALSO text_with_ALSO
- o p num_objs must_print_ALSO;
- objectloop (o in descin) give o ~workflag;
- num_objs = 0;
- objectloop (o in descin)
- if (o hasnt concealed && NotSupportingThePlayer(o)) {
-
- PronounNotice(o);
-
- if (o has scenery) {
- if (o has supporter && child(o)) SayWhatsOn(o);
- }
- else {
- give o workflag; num_objs++;
- p = initial;
- if ((o has door or container) && o has open && o provides when_open) {
- p = when_open; jump Prop_Chosen;
- }
- if ((o has door or container) && o hasnt open && o provides when_closed) {
- p = when_closed; jump Prop_Chosen;
- }
- if (o has switchable && o has on && o provides when_on) {
- p = when_on; jump Prop_Chosen;
- }
- if (o has switchable && o hasnt on && o provides when_off) {
- p = when_off;
- }
- .Prop_Chosen;
- if (o.&describe && RunRoutines(o, describe)) {
- must_print_ALSO = true;
- give o ~workflag; num_objs--;
- continue;
- }
- if (o.p && (o hasnt moved || p ~= initial)) {
- new_line;
- PrintOrRun(o, p);
- must_print_ALSO = true;
- give o ~workflag; num_objs--;
- if (o has supporter && child(o)) SayWhatsOn(o);
- }
- }
- }
- if (num_objs == 0) return 0;
- if (actor ~= player) give actor concealed;
- if (text_without_ALSO) {
- new_line;
- if (must_print_ALSO) print (string) text_with_ALSO, " ";
- else print (string) text_without_ALSO, " ";
- WriteListFrom(child(descin),
- ENGLISH_BIT+RECURSE_BIT+PARTINV_BIT+TERSE_BIT+CONCEAL_BIT+WORKFLAG_BIT);
- }
- else {
- if (must_print_ALSO) L__M(
- else L__M(
- }
- if (actor ~= player) give actor ~concealed;
- return num_objs;
- ];
- ! ----------------------------------------------------------------------------
- ! Looking. LookSub(1) is allowed to abbreviate long descriptions, but
- ! LookSub(0) (which is what happens when the Look action is generated)
- ! isn't. (Except that these are over-ridden by the player-set lookmode.)
- ! ----------------------------------------------------------------------------
- [ LMode1Sub; lookmode=1; print (string) Story; L__M(
- [ LMode2Sub; lookmode=2; print (string) Story; L__M(
- [ LMode3Sub; lookmode=3; print (string) Story; L__M(
- [ LModeNormalSub; ! 'normal' value: the default, or as set in Initialise()
- switch (initial_lookmode) {
- 1: <<LMode1>>;
- 3: <<LMode3>>;
- default: <<LMode2>>;
- }
- ];
- [ NoteArrival descin;
- if (location ~= lastdesc) {
- if (location.initial) PrintOrRun(location, initial);
- if (location == thedark) { lastdesc = thedark; return; }
- descin = location;
- if(NewRoom() == false) LibraryExtensions.RunAll(ext_newroom);
- lastdesc = descin;
- }
- ];
- [ NoteDeparture;
- prev_location = real_location;
- ];
- [ ScoreArrival;
- if (location hasnt visited) {
- give location visited;
- if (location has scored) {
- score = score + ROOM_SCORE;
- places_score = places_score + ROOM_SCORE;
- }
- }
- ];
- [ FindVisibilityLevels visibility_levels;
- visibility_levels = 1;
- visibility_ceiling = parent(player);
- while ((parent(visibility_ceiling)) &&
- (visibility_ceiling hasnt container || visibility_ceiling has open or transparent)) {
- visibility_ceiling = parent(visibility_ceiling);
- visibility_levels++;
- }
- return visibility_levels;
- ];
- [ LookSub allow_abbrev visibility_levels i j k nl_flag;
- if (parent(player) == 0) return RunTimeError(10);
- .MovedByInitial;
- if (location == thedark) { visibility_ceiling = thedark; NoteArrival(); }
- else {
- visibility_levels = FindVisibilityLevels();
- if (visibility_ceiling == location) {
- NoteArrival();
- if (visibility_ceiling ~= location) jump MovedByInitial;
- }
- }
- ! Printing the top line: e.g.
- ! Octagonal Room (on the table) (as Frodo)
- new_line;
-
- style bold;
-
- glk($0086, 4); ! set subheader style
-
- if (visibility_levels == 0) print (name) thedark;
- else {
- if (visibility_ceiling ~= location) print (The) visibility_ceiling;
- else print (name) visibility_ceiling;
- }
-
- style roman;
-
- glk($0086, 0); ! set normal style
-
- for (j=1,i=parent(player) : j<visibility_levels : j++,i=parent(i))
- if (i has supporter) L__M(
- else L__M(
- if (print_player_flag == 1) L__M(
- new_line;
- ! The room description (if visible)
- if (lookmode < 3 && visibility_ceiling == location) {
- if ((allow_abbrev ~= 1) || (lookmode == 2) || (location hasnt visited)) {
- if (location.&describe) RunRoutines(location, describe);
- else {
- if (location.description == 0) RunTimeError(11, location, description);
- else PrintOrRun(location, description);
- }
- }
- }
- if (visibility_ceiling == location) nl_flag = 1;
- if (visibility_levels == 0) Locale(thedark);
- else {
- for (i=player,j=visibility_levels : j>0 : j--,i=parent(i)) give i workflag;
- for (j=visibility_levels : j>0 : j--) {
- for (i=player,k=0 : k<j : k++) i=parent(i);
- if (i.inside_description) {
- if (nl_flag) new_line; else nl_flag = 1;
- PrintOrRun(i,inside_description);
- }
- if (Locale(i)) nl_flag=1;
- }
- }
- if(LookRoutine() == false) LibraryExtensions.RunAll(ext_lookroutine);
- ScoreArrival();
- action =
- AfterRoutines();
- ];
- [ ExamineSub i;
- if (location == thedark) return L__M(
- i = noun.description;
- if (i == 0) {
- if (noun has container)
- if (noun has open) <<Search noun, actor>>;
- else return L__M(
- if (noun has switchable) { L__M(
- return L__M(
- }
- i = PrintOrRun(noun, description);
- if (i < 2 && noun has switchable) L__M(
- AfterRoutines();
- ];
- [ LookUnderSub;
- if (location == thedark) return L__M(
- L__M(
- ];
- [ VisibleContents o i f;
- objectloop (i in o) if (i hasnt concealed or scenery) f++;
- return f;
- ];
- [ SearchSub f;
- if (location == thedark) return L__M(
- if (ObjectIsUntouchable(noun)) return;
- f = VisibleContents(noun);
- if (noun has supporter) {
- if (f == 0) return L__M(
- return L__M(
- }
- if (noun hasnt container) return L__M(
- if (noun hasnt transparent or open && ImplicitOpen(noun)) return L__M(
- if (AfterRoutines()) return;
- if (f == 0) return L__M(
- L__M(
- ];
- ! ----------------------------------------------------------------------------
- ! Verbs which change the state of objects without moving them
- ! ----------------------------------------------------------------------------
- [ UnlockSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt lockable) return L__M(
- if (noun hasnt locked) return L__M(
- if (noun.with_key ~= second) return L__M(
- give noun ~locked;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ LockSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt lockable) return L__M(
- if (noun has locked) return L__M(
- if (noun has open && ImplicitClose(noun)) return L__M(
- if (noun.with_key ~= second) return L__M(
- give noun locked;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ SwitchonSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt switchable) return L__M(
- if (noun has on) return L__M(
- give noun on;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ SwitchoffSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt switchable) return L__M(
- if (noun hasnt on) return L__M(
- give noun ~on;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ OpenSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt openable) return L__M(
- if (noun has locked && ImplicitUnlock(noun)) return L__M(
- if (noun has open) return L__M(
- give noun open;
- if (AfterRoutines() || keep_silent) return;
- if (noun hasnt container)
- return L__M(
- if ((noun has container && location ~= thedark && VisibleContents(noun)
- && IndirectlyContains(noun, player)) == 0) {
- if (noun hasnt transparent && noun hasnt door) return L__M(
- }
- L__M(
- ];
- [ CloseSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt openable) return L__M(
- if (noun hasnt open) return L__M(
- give noun ~open;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ DisrobeSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt worn) return L__M(
- give noun ~worn;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ WearSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt clothing) return L__M(
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- if (noun has worn) return L__M(
- give noun worn;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- [ EatSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun hasnt edible) return L__M(
- if (noun has worn && ImplicitDisrobe(noun)) return;
- remove noun;
- if (AfterRoutines() || keep_silent) return;
- L__M(
- ];
- ! ----------------------------------------------------------------------------
- ! Verbs which are really just stubs (anything which happens for these
- ! actions must happen in before rules)
- ! ----------------------------------------------------------------------------
- [ AllowPushDir i;
- if (parent(second) ~= compass) return L__M(
- if (second == u_obj or d_obj) return L__M(
- AfterRoutines(); i = noun; move i to actor;
- <Go second, actor>;
- if (location == thedark) move i to real_location;
- else move i to location;
- ];
- [ AnswerSub;
- if (second && RunLife(second,
- L__M(
- ];
- [ AskSub;
- if (RunLife(noun,
- L__M(
- ];
- [ AskForSub;
- if (noun == player) <<Inv, actor>>;
- L__M(
- ];
- [ AskToSub; L__M(
- [ AttackSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun has animate && RunLife(noun,
- L__M(
- ];
- [ BlowSub; L__M(
- [ BurnSub;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ BuySub; L__M(
- [ ClimbSub;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ ConsultSub; L__M(
- [ CutSub;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ DigSub; L__M(
- [ DrinkSub; L__M(
- [ FillSub;
- if (second == nothing) return L__M(
- L__M(
- ];
- [ JumpSub; L__M(
- [ JumpInSub;
- if (noun has animate) return L__M(
- if (noun has enterable) <<Enter noun>>;
- L__M(
- ];
- [ JumpOnSub;
- if (noun has animate) return L__M(
- if (noun has enterable && noun has supporter) <<Enter noun>>;
- L__M(
- ];
- [ JumpOverSub;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ KissSub;
- if (ObjectIsUntouchable(noun)) return;
- if (RunLife(noun,
- if (noun == actor) return L__M(
- L__M(
- ];
- [ ListenSub; L__M(
- [ MildSub; L__M(
- [ NoSub; L__M(
- [ PraySub; L__M(
- [ PullSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun == player) return L__M(
- if (noun == actor) return L__M(
- if (noun has static) return L__M(
- if (noun has scenery) return L__M(
- if (noun has animate) return L__M(
- L__M(
- ];
- [ PushSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun == player) return L__M(
- if (noun == actor) return L__M(
- if (noun has static) return L__M(
- if (noun has scenery) return L__M(
- if (noun has animate) return L__M(
- L__M(
- ];
- [ PushDirSub; L__M(
- [ RubSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ SetSub; L__M(
- [ SetToSub; L__M(
- [ SingSub; L__M(
- [ SleepSub; L__M(
- [ SmellSub;
- if (noun ~= nothing && noun has animate) return L__M(
- L__M(
- ];
- [ SorrySub; L__M(
- [ SqueezeSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun has animate && noun ~= player) return L__M(
- L__M(
- ];
- [ StrongSub; L__M(
- [ SwimSub; L__M(
- [ SwingSub; L__M(
- [ TasteSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ TellSub;
- if (noun == actor) return L__M(
- if (RunLife(noun,
- L__M(
- ];
- [ ThinkSub; L__M(
- [ ThrowAtSub;
- if (ObjectIsUntouchable(noun)) return;
- if (second > 1) {
- action =
- if (RunRoutines(second, before)) { action =
- action =
- }
- if (noun has worn && ImplicitDisrobe(noun)) return;
- if (second hasnt animate) return L__M(
- if (RunLife(second,
- L__M(
- ];
- [ TieSub;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ TouchSub;
- if (noun == actor) return L__M(
- if (ObjectIsUntouchable(noun)) return;
- if (noun has animate) return L__M(
- L__M(
- ];
- [ TurnSub;
- if (ObjectIsUntouchable(noun)) return;
- if (noun == player) return L__M(
- if (noun == actor) return L__M(
- if (noun has static) return L__M(
- if (noun has scenery) return L__M(
- if (noun has animate) return L__M(
- L__M(
- ];
- [ WaitSub;
- if (AfterRoutines()) rtrue;
- L__M(
- ];
- [ WakeSub; L__M(
- [ WakeOtherSub;
- if (ObjectIsUntouchable(noun)) return;
- if (RunLife(noun,
- L__M(
- ];
- [ WaveSub;
- if (noun == player) return L__M(
- if (noun == actor) return L__M(
- if (noun notin actor && ImplicitTake(noun)) return L__M(
- L__M(
- ];
- [ WaveHandsSub;
- if (noun) return L__M(
- L__M(
- [ YesSub; L__M(
- ! ----------------------------------------------------------------------------
- ! Debugging verbs
- ! ----------------------------------------------------------------------------
- [ TraceOnSub; parser_trace = 1; "[Trace on.]"; ];
- [ TraceLevelSub;
- parser_trace = noun;
- print "[Parser tracing set to level ", parser_trace, ".]^";
- ];
- [ TraceOffSub; parser_trace = 0; "Trace off."; ];
- [ RoutinesOnSub;
- debug_flag = debug_flag | DEBUG_MESSAGES;
- "[Message listing on.]";
- ];
- [ RoutinesOffSub;
- debug_flag = debug_flag & ~DEBUG_MESSAGES;
- "[Message listing off.]";
- ];
- [ RoutinesVerboseSub;
- debug_flag = debug_flag | (DEBUG_VERBOSE|DEBUG_MESSAGES);
- "[Verbose message listing on.]";
- ];
- [ ActionsOnSub;
- debug_flag = debug_flag | DEBUG_ACTIONS;
- "[Action listing on.]";
- ];
- [ ActionsOffSub;
- debug_flag = debug_flag & ~DEBUG_ACTIONS;
- "[Action listing off.]";
- ];
- [ TimersOnSub;
- debug_flag = debug_flag | DEBUG_TIMERS;
- "[Timers listing on.]";
- ];
- [ TimersOffSub;
- debug_flag = debug_flag & ~DEBUG_TIMERS;
- "[Timers listing off.]";
- ];
- [ ChangesOnSub; debug_flag = debug_flag | DEBUG_CHANGES; "[Changes listing on.]"; ];
- [ ChangesOffSub; debug_flag = debug_flag & ~DEBUG_CHANGES; "[Changes listing off.]"; ];
- [ ChangesOnSub; "[Changes listing available only from Inform 6.2 onwards.]"; ];
- [ ChangesOffSub; "[Changes listing available only from Inform 6.2 onwards.]"; ];
- [ PredictableSub i;
- i = random(-100);
- "[Random number generator now predictable.]";
- ];
- [ PredictableSub;
- @setrandom 100;
- "[Random number generator now predictable.]";
- ];
- [ XTestMove obj dest;
- if (~~obj ofclass Object) "[Not an object.]";
- if (~~dest ofclass Object) "[Destination not an object.]";
- if ((obj <= InformLibrary) || (obj == LibraryMessages) || (obj in 1))
- "[Can't move ", (name) obj, ": it's a system object.]";
- while (dest) {
- if (dest == obj) "[Can't move ", (name) obj, ": it would contain itself.]";
- dest = parent(dest);
- }
- rfalse;
- ];
- [ XPurloinSub;
- if (XTestMove(noun, player)) return;
- move noun to player; give noun moved ~concealed;
- "[Purloined.]";
- ];
- [ XAbstractSub;
- if (XTestMove(noun, second)) return;
- move noun to second;
- "[Abstracted.]";
- ];
- [ XObj obj f;
- if (parent(obj) == 0) print (name) obj; else print (a) obj;
- print " (", obj, ") ";
- if (f && parent(obj))
- print "in ~", (name) parent(obj), "~ (", parent(obj), ")";
- new_line;
- if (child(obj) == 0) rtrue;
- if (obj == Class) ! ???
- WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+NOARTICLE_BIT, 1);
- else
- WriteListFrom(child(obj), NEWLINE_BIT+INDENT_BIT+ALWAYS_BIT+ID_BIT+FULLINV_BIT, 1);
- ];
- [ XTreeSub i;
- if (noun && ~~noun ofclass Object) "[Not an object.]";
- if (noun == 0) {
- objectloop (i)
- if (i ofclass Object && parent(i) == 0) XObj(i);
- }
- else XObj(noun, true);
- ];
- [ GotoSub;
- if ((~~noun ofclass Object) || parent(noun)) "[Not a safe place.]";
- PlayerTo(noun);
- ];
- [ GoNearSub x;
- if (~~noun ofclass Object) "[Not a safe place.]";
- x = noun;
- while (parent(x)) x = parent(x);
- PlayerTo(x);
- ];
- [ Print_ScL obj; print_ret ++x_scope_count, ": ", (a) obj, " (", obj, ")"; ];
- [ ScopeSub;
- if (noun && ~~noun ofclass Object) "[Not an object.]";
- x_scope_count = 0;
- LoopOverScope(Print_ScL, noun);
- if (x_scope_count == 0) "Nothing is in scope.";
- ];
- [ GlkListSub id val;
- id = glk($0020, 0, gg_arguments); ! window_iterate
- while (id) {
- print "Window ", id, " (", gg_arguments-->0, "): ";
- val = glk($0028, id); ! window_get_type
- switch (val) {
- 1: print "pair";
- 2: print "blank";
- 3: print "textbuffer";
- 4: print "textgrid";
- 5: print "graphics";
- default: print "unknown";
- }
- val = glk($0029, id); ! window_get_parent
- if (val) print ", parent is window ", val;
- else print ", no parent (root)";
- val = glk($002C, id); ! window_get_stream
- print ", stream ", val;
- val = glk($002E, id); ! window_get_echo_stream
- if (val) print ", echo stream ", val;
- print "^";
- id = glk($0020, id, gg_arguments); ! window_iterate
- }
- id = glk($0040, 0, gg_arguments); ! stream_iterate
- while (id) {
- print "Stream ", id, " (", gg_arguments-->0, ")^";
- id = glk($0040, id, gg_arguments); ! stream_iterate
- }
- id = glk($0064, 0, gg_arguments); ! fileref_iterate
- while (id) {
- print "Fileref ", id, " (", gg_arguments-->0, ")^";
- id = glk($0064, id, gg_arguments); ! fileref_iterate
- }
- val = glk($0004, 8, 0); ! gestalt, Sound
- if (val) {
- id = glk($00F0, 0, gg_arguments); ! schannel_iterate
- while (id) {
- print "Soundchannel ", id, " (", gg_arguments-->0, ")^";
- id = glk($00F0, id, gg_arguments); ! schannel_iterate
- }
- }
- ];
- ! ----------------------------------------------------------------------------
- ! Finally: the mechanism for library text (the text is in the language defn)
- ! ----------------------------------------------------------------------------
- [ L__M act n x1 x2 s;
- if (keep_silent == 2) return;
- s = sw__var;
- sw__var = act;
- if (n == 0) n = 1;
- L___M(n, x1, x2);
- sw__var = s;
- ];
- [ L___M n x1 x2 s;
- s = action;
- lm_n = n;
- lm_o = x1;
- lm_s = x2;
- action = sw__var;
- if (RunRoutines(LibraryMessages, before)) { action = s; rfalse; }
- if (LibraryExtensions.RunWhile(ext_messages, false )) { action = s; rfalse; }
- action = s;
- LanguageLM(n, x1, x2);
- ];
- ! ==============================================================================
|