Printing 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.


#Iftrue CHARSIZE == 1;
Constant SHORT_NAME_BUFFER_LEN = 250;
Array StorageForShortName buffer SHORT_NAME_BUFFER_LEN;
#Ifnot;
Constant SHORT_NAME_BUFFER_LEN = 1000;
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);
    VM_PrintBuffer(StorageForShortName, length);
    #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;
];

! No longer used within Printing.i6t
[ 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 i;
  if (~~o) { 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;
  @push indef_mode;
  indef_mode = NULL;
  PSN__(obj);
  @pull indef_mode;
];

§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;
  if (~~parameter_value) { LW_Response('Y'); return; }
  obj = parameter_value;
  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.&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: the red herring, an elephant, 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 length;
  if (obj provides articles) {
    artval = (obj.&articles)-->(acode + (short_name_case * LanguageCases));
    if (capitalise) CPrintOrRun(artval);
    else print (string) artval;
    print " ";
    if (pluralise) return;
    print (PSN__) obj;
    return;
  }
  i = GetGNAOfObject(obj);
  if (pluralise && (i < 3 || (i >= 6 && i < 9))) { i = i + 3; }
  i = LanguageGNAsToArticles-->i;

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

  findout = ((LanguageContractionForms > 4 || LanguageContractionForms < 2) ||
             (artform-->acode ~= artform-->(acode+ARTBLOCK_LEN)) ||
             ((LanguageContractionForms >= 3) && (artform-->(acode+ARTBLOCK_LEN) ~= artform-->(acode+(2*ARTBLOCK_LEN)))) ||
             ((LanguageContractionForms == 4) && (artform-->(acode+(2*ARTBLOCK_LEN)) ~= artform-->(acode+(3*ARTBLOCK_LEN)))));
  if (findout) {
    #Ifdef TARGET_ZCODE;
    if (pluralise) { length = VM_PrintToBuffer(StorageForShortName, SHORT_NAME_BUFFER_LEN, LanguageNumber, pluralise); }
    else { length = VM_PrintToBuffer(StorageForShortName, SHORT_NAME_BUFFER_LEN, PSN__, obj); }
    acode = acode + ARTBLOCK_LEN * LanguageContraction(StorageForShortName + 2);
    #Ifnot; ! TARGET_GLULX
    if (pluralise) {
      length = Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, LanguageNumber, pluralise);
    }
    else {
      length = Glulx_PrintAnyToArrayUni(StorageForShortName, SHORT_NAME_BUFFER_LEN, PSN__, obj);
    }
    if (length > SHORT_NAME_BUFFER_LEN) length = SHORT_NAME_BUFFER_LEN;
    acode = acode + ARTBLOCK_LEN * LanguageContraction(StorageForShortName);
    #Endif; ! TARGET_GLULX
  }

  print (string) artform-->acode;
  if (pluralise) return;

  #ifdef TARGET_GLULX;
  if (findout) glk_put_buffer_uni(StorageForShortName, length);
  #ifnot; ! TARGET_ZCODE
  print (PSN__) obj;
  #endif;
];

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

[ IndefArt obj;
  if (~~obj) { LW_Response('Y'); rtrue; }
  @push indef_mode;
  @push self;
  indef_mode = true;
  self = obj;
  if (obj has proper) {
    indef_mode = NULL;
    print (PSN__) obj;
  }
  else if ((obj provides article) && (TEXT_TY_Compare(obj.article, EMPTY_TEXT_VALUE))) {
    PrintOrRun(obj, article, true);
    print " ", (PSN__) obj;
  }
  else { PrefaceByArticle(obj, INDEFART_INDEX); }
  @pull self;
  @pull indef_mode;
];

[ CIndefArt obj;
  if (~~obj) { LW_Response('X'); rtrue; }
  @push indef_mode;
  @push self;
  indef_mode = true;
  self = obj;
  if (obj has proper) {
    indef_mode = NULL;
    caps_mode = true;
!    
print "CIA->P";



    print (PSN__) obj;
    caps_mode = false;
  }
  else if ((obj provides article) && TEXT_TY_Compare(obj.article, EMPTY_TEXT_VALUE)) {
    TEXT_TY_Say_Capitalised(obj.article);
    print " ", (PSN__) obj;
  }
  else {
    PrefaceByArticle(obj, CINDEFART_INDEX, 0, 1); ! (obj, acode, pluralise, capitalise)
  }
  @pull self;
  @pull indef_mode;
];

[ DefArt obj;
  @push indef_mode;
  @push self;
  indef_mode = false;
  self = obj;
  if ((~~obj ofclass Object) || obj has proper) print (PSN__) obj;
  else PrefaceByArticle(obj, DEFART_INDEX);
  @pull self;
  @pull indef_mode;
];

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

§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 "; ];

Array CaptureListOfMarkedObjectsText --> [ CONSTANT_PACKED_TEXT_STORAGE; CaptureListOfMarkedObjects; ];
Array CaptureListOfDefMarkedObjectsText --> [ CONSTANT_PACKED_TEXT_STORAGE; CaptureListOfDefMarkedObjects; ];

[ CaptureListOfMarkedObjects;
    say__p = 1;
    ParaContent();
    WriteListOfMarkedObjects(ENGLISH_BIT);
];

[ CaptureListOfDefMarkedObjects;
    say__p = 1;
    ParaContent();
    WriteListOfMarkedObjects(ENGLISH_BIT + DEFART_BIT + CFIRSTART_BIT);
];

§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;
];