To handle the printing of names of objects.

§1. Short Name Storage. None of the following functions should be called for the Z-machine if the short name exceeds the size of the following buffer: whereas the Glulx implementation of VM_PrintToBuffer will safely truncate overlong text, that's impossible for the Z-machine, and horrible results will follow.

CPrintOrRun is a variation on PrintOrRun, simplified by not needing to handle entire paragraphs (so, no fuss about dividing) but complicated by having to capitalise the first letter. We do this by writing to the buffer and then altering the first character. 

Constant SHORT_NAME_BUFFER_LEN = 160;

#Iftrue CHARSIZE == 1;
Allow a generous overrun
Array StorageForShortName buffer SHORT_NAME_BUFFER_LEN+90;
#Ifnot;
Array StorageForShortName --> SHORT_NAME_BUFFER_LEN;
#Endif;

[ CPrintOrRun obj prop  v length i;
    if ((obj ofclass String or Routine) || (prop == 0)) {
        #Ifdef TARGET_ZCODE;
        length = VM_PrintToBuffer (StorageForShortName, SHORT_NAME_BUFFER_LEN, obj);
        #Ifnot;
        length = Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, obj);
        #Endif;
    }
    else {
        if (obj.prop == NULL) rfalse;
        if (metaclass(obj.prop) == Routine or String) {
            #Ifdef TARGET_ZCODE;
            length = VM_PrintToBuffer(StorageForShortName, SHORT_NAME_BUFFER_LEN, obj, prop);
            #Ifnot;
            length = Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, obj.prop);
            #Endif;
        }
        else {
             return RunTimeError(2, obj, prop);
        }
    }

    #Ifdef TARGET_ZCODE;
    StorageForShortName->WORDSIZE = VM_LowerToUpperCase(StorageForShortName->WORDSIZE);
    for (i=WORDSIZE: i<length+WORDSIZE: i++) print (char) StorageForShortName->i;
    #Ifnot;
    if (length > SHORT_NAME_BUFFER_LEN) length = SHORT_NAME_BUFFER_LEN;
    if (length)
        StorageForShortName-->0 = VM_LowerToUpperCase(StorageForShortName-->0);
    glk_put_buffer_uni(StorageForShortName, length);
    #Endif;

    if (length) say__p = 1;

    return;
];

[ Cap str nocaps;
    if (nocaps) print (string) str;
    else CPrintOrRun(str, 0);
];

§2. Object Names I. We now begin the work of printing object names. In the lowest level of this process we print just the name itself (without articles attached), and we do it by carrying out an activity. 

[ PSN__ o;
    if (o == 0) { LW_Response('Y'); rtrue; }
    switch (metaclass(o)) {
        Routine:  print "<routine ", o, ">"; rtrue;
        String:   print "<string ~", (string) o, "~>"; rtrue;
        nothing:  print "<illegal object number ", o, ">"; rtrue;
    }
    RegardingSingleObject(o);
    CarryOutActivity(PRINTING_THE_NAME_ACT, o);
];

[ PrintShortName obj i;
    i = indef_mode; indef_mode = NULL;
    PSN__(obj); indef_mode = i;
];

§3. Standard Name Printing Rule. In its initial state, the "printing the name of" activity has just one rule: the following "for" rule. 

Global caps_mode = false;

[ STANDARD_NAME_PRINTING_R obj;
    obj = parameter_value;
    if (obj == 0) {
        LW_Response('Y'); return;
    }
    switch (metaclass(obj)) {
        Routine:  print "<routine ", obj, ">"; return;
        String:   print "<string ~", (string) obj, "~>"; return;
        nothing:  print "<illegal object number ", obj, ">"; return;
    }
    if (obj == player) {
        PRINT_PROTAGONIST_INTERNAL_R();
        return;
    }
    if (LanguagePrintShortName(obj)) return;
    if (indef_mode && obj provides short_name_indef &&
        PrintOrRun(obj, short_name_indef, true) ~= 0) return;
    if (caps_mode &&
        obj provides cap_short_name && PrintOrRun(obj, cap_short_name, true) ~= 0) {
        caps_mode = false;
        return;
    }
    if (obj provides short_name && PrintOrRun(obj, short_name, true) ~= 0) return;
    print (object) obj;
];

[ STANDARD_PLURAL_NAME_PRINTING_R obj;
    obj = parameter_value;
    PrintOrRun(obj, plural, true);
];

§4. Object Names II. The second level of the system for printing object names handles the placing of articles in front of them: {\it the} red herring, {\it an} elephant, {\it Some} bread. The following routine allows us to choose:

The routine then looks after issues such as which contraction form to use: for instance, in English, whether to use "a" or "an" for the indefinite singular depends on the text of the object's name. 

Global short_name_case;

[ PrefaceByArticle obj acode pluralise capitalise  i artform findout artval;
    if (obj provides articles) {
        artval=(obj.&articles)-->(acode+short_name_case*LanguageCases);
        if (capitalise)
            print (Cap) artval;
        else
            print (string) artval;
        if (pluralise) return;
        print (PSN__) obj; return;
    }

    i = GetGNAOfObject(obj);
    if (pluralise) {
        if (i < 3 || (i >= 6 && i < 9)) i = i + 3;
    }
    i = LanguageGNAsToArticles-->i;

    artform = LanguageArticles
        + 3*WORDSIZE*LanguageContractionForms*(short_name_case + i*LanguageCases);

    switch (LanguageContractionForms) {
        2: if (artform-->acode ~= artform-->(acode+3)) findout = true;
        3: if (artform-->acode ~= artform-->(acode+3)) findout = true;
           if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true;
        4: if (artform-->acode ~= artform-->(acode+3)) findout = true;
           if (artform-->(acode+3) ~= artform-->(acode+6)) findout = true;
           if (artform-->(acode+6) ~= artform-->(acode+9)) findout = true;
        default: findout = true;
    }
    #Ifdef TARGET_ZCODE;
    if (standard_interpreter ~= 0 && findout) {
        StorageForShortName-->0 = SHORT_NAME_BUFFER_LEN;
        @output_stream 3 StorageForShortName;
        if (pluralise) print (number) pluralise; else print (PSN__) obj;
        @output_stream -3;
        acode = acode + 3*LanguageContraction(StorageForShortName + 2);
    }
    #Ifnot; TARGET_GLULX
    if (findout) {
        if (pluralise)
            Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, EnglishNumber, pluralise);
        else
            Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, PSN__, obj);
        acode = acode + 3*LanguageContraction(StorageForShortName);
    }
    #Endif; TARGET_

    Cap (artform-->acode, ~~capitalise); print article
    if (pluralise) return;
    print (PSN__) obj;
];

§5. Object Names III. The routines accessible from outside this segment. 

[ IndefArt obj i s;
    if (obj == 0) { LW_Response('Y'); rtrue; }
    i = indef_mode; indef_mode = true; s = self; self = obj;
    if (obj has proper) { indef_mode = NULL; print (PSN__) obj; indef_mode = i; self = s; return; }
    if ((obj provides article) && (TEXT_TY_Compare(obj.article, EMPTY_TEXT_VALUE) ~= 0)) {
        PrintOrRun(obj, article, true); print " ", (PSN__) obj; indef_mode = i; self = s;
        return;
    }
    PrefaceByArticle(obj, 2); indef_mode = i; self = s;
];

[ CIndefArt obj i s;
    if (obj == 0) { LW_Response('X'); rtrue; }
    i = indef_mode; indef_mode = true; s = self; self = obj;
    if (obj has proper) {
        indef_mode = NULL;
        caps_mode = true;
        print (PSN__) obj;
        indef_mode = i;
        caps_mode = false;
        self = s;
        return;
    }
    if ((obj provides article) && (TEXT_TY_Compare(obj.article, EMPTY_TEXT_VALUE) ~= 0)) {
        TEXT_TY_Say_Capitalised(obj.article); print " ", (PSN__) obj; indef_mode = i; self = s;
        return;
    }
    PrefaceByArticle(obj, 2, 0, 1); indef_mode = i; self = s;
];

[ DefArt obj i s;
    i = indef_mode; indef_mode = false; s = self; self = obj;
    if ((~~obj ofclass Object) || obj has proper) {
        indef_mode = NULL; print (PSN__) obj; indef_mode = i; self = s;
        return;
    }
    PrefaceByArticle(obj, 1); indef_mode = i; self = s;
];

[ CDefArt obj i s;
    i = indef_mode; indef_mode = false; s = self; self = obj;
    if ((obj ofclass Object) && (obj has proper || obj == player)) {
        indef_mode = NULL;
        caps_mode = true;
        print (PSN__) obj;
        indef_mode = i;
        caps_mode = false;
        self = s;
        return;
    }
    if ((~~obj ofclass Object) || obj has proper) {
        indef_mode = NULL; print (PSN__) obj; indef_mode = i; self = s;
        return;
    }
    PrefaceByArticle(obj, 0); indef_mode = i; self = s;
];

§6. Printing in number bases. The following prints the number n in base base, which must be 2 to 36. If digits is supplied, the number is padded with leading zeros to form at least that many digits.

n is printed as a signed number if base is 10 and digits is not supplied, but in all other cases is printed as unsigned.

For example, -1 prints as FFFFFFFF in hex, either -1 or 4294967285 in decimal, 37777777777 in octal, 11111111111111111111111111111111 in binary, 102002022201221111200 in base 3 and 1Z141Y3 in base 36. 

[ PrintInBase n base digits digitset a digit_count j k d;
    if ((base < 2) || (base > 36)) { print "(", n, " in base ", base, ")"; return; }
    if (digits < 1) digits = 0;
    if (digits > 100) digits = 100;
    if ((base == 10) && (digits == 0) && (digitset == 0)) { print n; return; }
    if (n == 0) {
        digit_count = 1;
    } else {
        a = n;
        digit_count = 0;
        do {
            a = DropDigit(a, base);
            digit_count++;
        } until (a == 0);
    }
    for (j = digits: j > digit_count: j--) {
        if (digitset) digitset(0);
        else print "0";
    }
    for (j = digit_count: j >= 1: j--) {
        a = n; for (k = 1: k < j: k++) a = DropDigit(a, base);
        d = LeastDigit(a, base);
        if (digitset) digitset(d);
        else {
            if (d < 10) print d;
            else print (char) 'A' + d - 10;
        }
    }
];

§7. Here, n may be negative, but we want to treat it as an unsigned integer, not as twos-complement signed, and that is very annoying because we only have access to signed integer division and remainder. On the bright side, base is between 2 and 36.

The idea here is that if n has the top bit set, we take that bit away and then can safely perform signed division getting the right answer; but then we have to compensate by working out what difference it made that we changed the value of n (from an unsigned point of view) by subtracting $80000000. 

[ DropDigit n base;
    if (n & WORD_HIGHBIT) {
        n = n - WORD_HIGHBIT;
        n = n/base;
        n = n + (WORD_HIGHBIT - base)/base + 1;
        return n;
    } else {
        return n/base;
    }
];

[ LeastDigit n base;
    if (n & WORD_HIGHBIT) {
        n = n - DropDigit(n, base)*base;
        n = n%base;
        if (n < 0) n = n + base;
        return n;
    } else {
        return n%base;
    }
];

§8. Miscellaneous. What the following functions have in common is that they are all minimal definitions which apply only to Basic Inform programs. More elaborate WorldModelKit alternatives will be used if that kit is present, as it always is for non-Basic Inform projects. 

[ DefaultTopic; return 0; ]; Topics exist only in CommandParserKit
[ PrintSnippet x; ]; Snippets exist only in CommandParserKit
[ PRINT_PROTAGONIST_INTERNAL_R; ]; There is no player in Basic Inform

§9. PNToVP() takes no arguments and returns the GNA (gender-noun-animation) for the prior_named_noun. 

[ PNToVP gna;
    if (prior_named_noun) gna = GetGNAOfObject(prior_named_noun);
    if (((gna%6)/3 == 1) || (prior_named_list >= 2)) return 6;
    return 3;
];
[ GetGNAOfObject obj case gender;
    if (gender == 0) {
        if (case == 0) gender = LanguageAnimateGender;
        else gender = LanguageInanimateGender;
    }
    if (obj has pluralname) case = case + 3;
    return case;
];

§10. This provides just a little of the list-writer. 

[ WriteListOfMarkedObjects in_style
    obj c;
    objectloop (obj ofclass Object && obj has workflag2) {
        c++;
    }
    objectloop (obj ofclass Object && obj has workflag2) {
        PrintShortName(obj);
        c--;
        if (c > 0) print ", ";
    }
];
[ LW_Response X o; print " and "; ];

§11. These two functions are not really to do with printing, but are also stubs provided for Basic Inform only. 

[ OwnerOf o; return nothing; ]; "owner" implies personhood, and we have no people
[ MoveObject A B; this is considerably more restricted by WorldModelKit
    if ((A) && (B)) move A to B;
];