CD PowerPlay 6/TheCompleteAdventureCollection1995/CDPP6.ISO/utility/agtsrc/spctools.pa4

Text File | 1989-12-20 | 18.6 KB | 557 lines

  {SPCTOOLS.PA2 -- special GAGS tools}

  { Is_verb }
  {Searches verb list via ascii name. }
  {Returns TRUE if found and FALSE otherwise}
  {NOTE: Synonyms have already been taken care of in PARSE}

  FUNCTION Is_Verb(w : words) : Boolean;

  VAR i : Integer;                {index to verbs array}
    match : Boolean;
  BEGIN
    i := 0;                       {start with 'ANY'}
    match := False;
    REPEAT
      match := (V[i] = w);
      i := i+1;
    UNTIL ((i > MaxVerb) OR (match)); {exits if match found}
    IF NOT match THEN IF w = 'VERB' THEN match := True;
    Is_Verb := match;
  END;                            {Is_Verb}

  { Is_direction }
  {Searches direction list via ascii name. }
  {Returns TRUE if found and FALSE otherwise}

  FUNCTION Is_Direction(w : words) : Boolean;

  VAR i : Integer;
    match : Boolean;
  BEGIN
    i := 1;
    match := False;
    REPEAT
      match := (V[i] = w);
      i := i+1;
    UNTIL ((i > Num_Dirs) OR (match)); {exits if match found}
    Is_Direction := match;
  END;                            {Is_Verb}

  { Is_noun }
  {Searches noun.name list via ascii name. }
  {Also matches for valid synonyms to valid nouns.}
  {Returns TRUE if found and FALSE otherwise. }
  {Also Returns TRUE if word is number. }
  FUNCTION Is_Noun(w : words) : Boolean;
  VAR i, code : Integer;
    match : Boolean;
  BEGIN
    Capitalize(w);
    match := False;
    Val(w, i, code);
    IF code = 0 THEN match := True {If noun is a number, then OK noun}
    ELSE BEGIN                    {not number -- so search list of nouns}
      i := First_noun;
      IF w <> '' THEN
        WHILE (i <= MaxNoun) AND
        (NOT match) DO
          BEGIN
            IF N[i]^.Has_Synonyms
            THEN match := (POS(' '+w+' ', N[i]^.synonyms) <> 0)
              {noun name also in synonym list}
            ELSE match := (N[i]^.name = w);
            i := i+1;
          END;                    {exits if match found}
      IF NOT match THEN
        IF w = 'ALL' THEN match := True ELSE
          IF w = 'EXITS' THEN match := True ELSE
            IF w = 'DOORS' THEN match := True ELSE
              IF w = 'GAME' THEN match := True ELSE
                IF w = 'IT' THEN match := True ELSE
                  IF w = 'THEM' THEN match := True ELSE
                    IF w = 'HIM' THEN match := True ELSE
                      IF w = 'HER' THEN match := True ELSE
                        IF w = 'VERB' THEN match := True ELSE
                          IF w = 'NAME' THEN match := True ELSE
                            IF w = 'NOUN' THEN match := True ELSE
                              IF w = 'OBJECT' THEN match := True ELSE
                                IF w = 'ANY' THEN match := True ELSE
                                  IF w = 'DOOR' THEN match := True;
    END;                          {not number}
    Is_Noun := match;
  END;                            {Is_Noun}

  { Is_creature }
  {Searches creature.name list via ascii name}
  {Returns TRUE if found and FALSE otherwise.}

  FUNCTION Is_Creature(w : words) : Boolean;

  VAR i : Integer;                {index to creature array}
    match : Boolean;
  BEGIN
    i := First_creature;
    match := False;
    IF w <> '' THEN
      WHILE (i <= MaxCreature) AND
      (NOT match) DO
        BEGIN
          IF M[i]^.Has_Synonyms
          THEN match := (POS(' '+w+' ', M[i]^.synonyms) <> 0)
            {creature name also in synonym list}
          ELSE match := (M[i]^.name = w);
          i := i+1;
        END;
    Is_Creature := match;
  END;                            {Is_Creature}

  { Is_prep }
  {Checks word against hard-coded list of preps.}
  {Returns TRUE if found and FALSE otherwise. }

  FUNCTION Is_Prep(w : words) : Boolean;

  BEGIN
    Is_Prep := ((w = 'IN')
                OR (w = 'ON')
                OR (w = 'OFF')
                OR (w = 'UP')
                OR (w = 'DOWN')
                OR (w = 'THRU')
                OR (w = 'THROUGH')
                OR (w = 'INSIDE')
                OR (w = 'NEAR')
                OR (w = 'BESIDE')
                OR (w = 'BY')
                OR (w = 'UNDER')
                OR (w = 'OVER')
                OR (w = 'ACROSS')
                OR (w = 'BEHIND')
                OR (w = 'ANY')
                OR (w = 'ABOUT')
                OR (w = 'AT')
                OR (w = 'FROM')
                OR (w = 'FOR')
                OR (w = 'WITH')
                OR (w = 'INTO')
                OR (w = 'TO'));
  END;                            {Is_Prep}


  { Function Verb_Number }
  {Searches verb list via ascii name. }
  {Returns number if found and 0 otherwise}

  FUNCTION Verb_Number(w : words) : Integer;

  VAR i : Integer;                {index to verbs array}
    match : Boolean;
  BEGIN
    i := 0;
    match := False;
    REPEAT
      match := (V[i] = w);
      i := i+1;
    UNTIL ((i > MaxVerb) OR (match)); {exits if match found}
    IF match
    THEN Verb_Number := i-1
    ELSE Verb_Number := 0;
  END;                            {Verb_Number}

  { Function Location }
  {Given an integer, returns its ROOM location }
  {unless it's in a closed noun. If it's inside }
  {a closed noun, that noun's number is returned,}
  {else the room number is returned. Basically, }
  {returns the location at which it is visible. }

  FUNCTION location(num : Integer) : Integer;

  VAR i : Integer;
  BEGIN
    IF num = 0 THEN location := 0
    ELSE
      IF num <= MaxNoun
      THEN
        BEGIN
          i := N[num]^.location;
          IF (i > MaxRoom) AND (i <> Wearing)
          THEN IF N[i]^.open
            THEN i := location(i);
          location := i;
        END
      ELSE
        BEGIN
          i := M[num]^.location;
          IF (i > MaxRoom) AND (i <> Wearing)
          THEN IF N[i]^.open
            THEN i := location(i);
          location := i;
        END;
  END;                            {fn.Location}

  { Function Is_Visible }
  {Given a noun number, returns true if the noun}
  {is present in the room and is not inside a }
  {closed noun -- i.e. if it can be seen by the }
  {player in his/her current location. }

  FUNCTION Is_Visible(num : Integer) : Boolean;

  VAR i : Integer;
  BEGIN
    i := location(num);
    IF ((i = Current_room) OR (i = Player) OR (i = Wearing))
    THEN Is_Visible := True
    ELSE Is_Visible := False;
  END;                            {fn.Is_Visible}


  { Function Noun_Number }
  {Given a string (of type words), checks to see }
  {if it's a noun or a creature. If it is, returns}
  {the integer value of that noun or creature; }
  {else it returns the value 0. }

  {This function will work with nouns that have }
  {the same names. It does this by matching on }
  {the adjective (if one has been entered) as well}
  {as the noun. This function also looks at where}
  {the noun is, i.e., if only one of the nouns }
  {(with the same name) is in the room, being }
  {carried or being worn -- that is assumed to be }
  {the correct noun. If there is more than one }
  {noun (with the same name) present, then an }
  {error message asks the player to repeat his }
  {command and be more specific about which noun }
  {is meant. }
  {Also matches for valid synonyms to valid nouns.}

  FUNCTION Noun_Number(w : words) : Integer;

  VAR i, J, k, Answer, RightOne, LastOne : Integer;
    NumWithRightAdj, NounWithAdj : Integer;
    match, FoundIt, FoundRightOne : Boolean;
    TempAdj : words;
  BEGIN
    {$V-} Capitalize(w); {$V+}
    Duplicate := False;
    FoundIt := False;
    NumWithRightAdj := 0;
    NounWithAdj := 0;
    IF MaxCreature > MaxNoun
    THEN LastOne := MaxCreature
    ELSE LastOne := MaxNoun;
    IF w = '' THEN
      Answer := 0
    ELSE
      IF (w = noun) AND (NounNumber <> 0)
      THEN Answer := NounNumber ELSE
        IF (w = object_word) AND (ObjectNumber <> 0)
        THEN Answer := ObjectNumber
        ELSE BEGIN
          {main routine}
          i := First_noun-1;
          FoundRightOne := False;
          J := 0;                 {number of matches}
          k := 0;                 {number of first match}
          WHILE (i <= MaxNoun) AND
          (NOT FoundRightOne) DO
            BEGIN
              i := i+1;
              IF N[i]^.Has_Synonyms
              THEN match := (POS(' '+w+' ', N[i]^.synonyms) <> 0) {noun name also in list}
              ELSE match := (N[i]^.name = w);
              IF match THEN
                BEGIN
                  J := J+1;
                  IF J = 1 THEN k := i;
                  IF Adjective = N[i]^.adj THEN
                    BEGIN
                      FoundRightOne := True;
                      k := i;
                      NumWithRightAdj := NumWithRightAdj+1;
                      NounWithAdj := i;
                      IF Is_Visible(i) THEN J := 1;
                      {This is it -- visible and right adjective}
                    END;
                END;              {match}
            END;                  {exits if match found}
          IF ((NOT FoundRightOne) AND (MaxCreature > MaxNoun)) THEN
            BEGIN
              i := First_creature-1;
              WHILE (i <= MaxCreature) AND
              (NOT FoundRightOne) DO
                BEGIN
                  i := i+1;
                  IF M[i]^.Has_Synonyms
                  THEN match := (POS(' '+w+' ', M[i]^.synonyms) <> 0)
                    {creature name also in synonym list}
                  ELSE match := (M[i]^.name = w);
                  IF match THEN
                    BEGIN
                      J := J+1;
                      IF J = 1 THEN k := i;
                      IF Adjective = M[i]^.adj THEN
                        BEGIN
                          FoundRightOne := True;
                          k := i;
                          NumWithRightAdj := NumWithRightAdj+1;
                          NounWithAdj := i;
                          IF Is_Visible(i) THEN J := 1;
                          {This is it -- visible and right adjective}
                        END;
                    END;          {match}
                END;
            END;                  {NOT FoundRightOne}
          Duplicate := (J > 1);   {j = number of matches -- duplicates if > 1}
          i := k;                 {i = first (maybe only) match}
          IF NumWithRightAdj = 1 THEN {only one with right adjective - it is it}
            BEGIN
              i := NounWithAdj;
              Duplicate := False;
              J := 1;
            END;
          IF (NOT Duplicate) THEN
            IF J = 1
            THEN Answer := i
            ELSE Answer := 0;
          IF Duplicate THEN
            BEGIN
              IF Is_Visible(i)    {i is first occurrance of name}
              THEN BEGIN
                NumberInRoom := 1;
                DuplicatesInRoom[1].num := i;
                IF i <= MaxNoun
                THEN
                  BEGIN
                    DuplicatesInRoom[1].adj := N[i]^.adj;
                    DuplicatesInRoom[1].name := N[i]^.name;
                  END
                ELSE
                  BEGIN
                    DuplicatesInRoom[1].adj := M[i]^.adj;
                    DuplicatesInRoom[1].name := M[i]^.name;
                  END;
              END                 {Is_Visible}
              ELSE NumberInRoom := 0;
              RightOne := i;      {to start with}
              J := i;
              REPEAT
                J := J+1;
                IF J <= MaxNoun
                THEN BEGIN        {noun}
                  IF N[J]^.Has_Synonyms
                  THEN match := (POS(' '+w+' ', N[J]^.synonyms) <> 0) {noun name also in list}
                  ELSE match := (N[J]^.name = w);
                  TempAdj := N[J]^.adj;
                END
                ELSE BEGIN        {creature}
                  IF M[J]^.Has_Synonyms
                  THEN match := (POS(' '+w+' ', M[J]^.synonyms) <> 0)
                    {creature name also in synonym list}
                  ELSE match := (M[J]^.name = w);
                  TempAdj := M[J]^.adj;
                END;
                IF match AND (TempAdj = Adjective) {correct Adjective and match}
                THEN BEGIN
                  FoundIt := True;
                  RightOne := J;
                END;
                IF match AND (NOT FoundIt) AND Is_Visible(J) THEN
                  BEGIN
                    NumberInRoom := NumberInRoom+1;
                    IF NumberInRoom <= MaxDupsInRoom THEN
                      BEGIN
                        DuplicatesInRoom[NumberInRoom].num := J;
                        IF J <= MaxNoun
                        THEN
                          BEGIN
                            DuplicatesInRoom[NumberInRoom].adj := N[J]^.adj;
                            DuplicatesInRoom[NumberInRoom].name := N[J]^.name;
                          END
                        ELSE
                          BEGIN
                            DuplicatesInRoom[NumberInRoom].adj := M[J]^.adj;
                            DuplicatesInRoom[NumberInRoom].name := M[J]^.name;
                          END;
                      END;
                    RightOne := J;
                  END;
                IF J = MaxNoun THEN J := Last_noun;
              UNTIL ((J >= LastOne) OR FoundIt);
              Answer := RightOne;
              IF NumberInRoom < 2 THEN Duplicate := False;
              IF FoundIt THEN Duplicate := False;
            END;                  {IF Duplicate}
        END;                      {main routine}
    Noun_Number := Answer;
  END;                            {Fn.Noun_Number}


  { Function Creature_Number }
  {Given a string (of type words), checks to see}
  {if it's a creature. If it is, returns }
  {the integer value of that creature; else }
  {it returns the value 0. }

  FUNCTION Creature_Number(w : words) : Integer;

  VAR i : Integer;                {index to creature array}
  BEGIN
    i := Noun_Number(w);          {also handles duplicate names}
    IF (i >= First_creature) AND (i <= MaxCreature)
    THEN Creature_Number := i
    ELSE Creature_Number := 0;
  END;                            {Creature_Number}

  { Function Name }
  {Given an integer, returns a lowercase string}
  {corresponding to the name of the room, noun,}
  {or creature that has that number. }

  FUNCTION name(num : Integer) : names;

  VAR st : names;
  BEGIN
    IF num < First_noun           {then it's a room}
    THEN st := Room[num]^.name
    ELSE
      IF num < First_creature
      THEN st := N[num]^.name
      ELSE st := M[num]^.name;
    Normalize(st);
    name := st;
  END;                            {fn.name}


  { Room_Location }
  {Returns room location where a noun number}
  {if located }

  FUNCTION Room_Location(num : Integer) : Integer;

  BEGIN
    IF (num >= First_noun) AND
    (num <> Wearing) THEN         { avoids index overflow }
      Room_Location := Room_Location(location(num))
    ELSE
      Room_Location := num;
  END;

  {Load_Weight}

  FUNCTION Load_Weight : Integer;

  VAR i, lw : Integer;
  BEGIN
    lw := 0;
    FOR i := First_noun TO MaxNoun DO
      IF Room_Location(i) = Player THEN { consider adding Wearing to total? }
        lw := lw+N[i]^.weight;
    Load_Weight := lw;
  END;

  {Load_Size}

  FUNCTION Load_Size : Integer;

  VAR i, ls : Integer;
  BEGIN
    ls := 0;
    FOR i := First_noun TO MaxNoun DO
      IF Room_Location(i) = Player THEN ls := ls+N[i]^.size;
    Load_Size := ls;
  END;


  { Adjust_Count }
  {Adjusts count of number items at PLACE}
  {by added INCREMENT. }

  PROCEDURE Adjust_Count(PLACE, INCREMENT : Integer);

  BEGIN
    IF PLACE = Wearing THEN Items_Being_Worn := Items_Being_Worn+INCREMENT;
    IF PLACE = Player THEN Items_Being_Carried := Items_Being_Carried+INCREMENT;
    IF (PLACE >= First_Room) AND (PLACE <= MaxRoom)
    THEN Room[PLACE]^.nouns_inside := Room[PLACE]^.nouns_inside+INCREMENT;
    IF (PLACE >= First_noun) AND (PLACE <= MaxNoun)
    THEN N[PLACE]^.nouns_inside := N[PLACE]^.nouns_inside+INCREMENT;
    IF (PLACE >= First_creature) AND (PLACE <= MaxCreature)
    THEN M[PLACE]^.nouns_inside := M[PLACE]^.nouns_inside+INCREMENT;
  END;                            {Adjust_Count}



  { Things_Here }
  {Returns count of number items at PLACE}

  FUNCTION Things_Here(PLACE : Integer) : Integer;

  BEGIN
    IF PLACE = Wearing THEN
      Things_Here := Items_Being_Worn
    ELSE IF PLACE = Player THEN
      Things_Here := Items_Being_Carried
    ELSE IF (PLACE >= First_Room) AND (PLACE <= MaxRoom) THEN
      Things_Here := Room[PLACE]^.nouns_inside
    ELSE IF (PLACE >= First_noun) AND (PLACE <= MaxNoun) THEN
      Things_Here := N[PLACE]^.nouns_inside
    ELSE IF (PLACE >= First_creature) AND (PLACE <= MaxCreature) THEN
      Things_Here := M[PLACE]^.nouns_inside
    ELSE
      Things_Here := 0;
  END;                            {Things_Here}

  { Things_Adjective }
  {Returns adj for noun or creature}

  FUNCTION Things_Adjective(num : Integer) : words;

  VAR Answer : words;
  BEGIN
    IF (num >= First_noun) AND (num <= MaxNoun)
    THEN Answer := N[num]^.adj
    ELSE IF (num >= First_creature) AND (num <= MaxCreature)
    THEN Answer := M[num]^.adj
    ELSE Answer := ' ';
    Normalize(Answer);
    IF Answer = ' '
    THEN Things_Adjective := ''
    ELSE Things_Adjective := Answer;
  END;

  { Consume }
  {Eat or drink, and checks for poison}
  {Only cause food or drink to disappear if it is movable.}
  {Allows player to drink from lake without having the water disappear}
  {(if and only if the lake had been specified as unmovable.)}

  PROCEDURE Consume(noun : words);

  VAR n_num : Integer;
    sentence : s;
  BEGIN
    WriteLn(IO, 'The ', noun,
            ' slides down your throat, and your stomach quickly is full.');
    sentence := noun; Capitalize(sentence); noun := sentence;
    n_num := Noun_Number(noun);
    IF N[n_num]^.movable THEN N[n_num]^.location := Nowhere;
    {Only cause food or drink to disappear if it is movable.}
    {Allows player to drink from lake without having the water disappear}
    {(if and only if the lake had been specified as unmovable.)}
    IF N[n_num]^.poisonous
    THEN
      BEGIN
        WriteLn(IO, 'After only a moment, you begin to sense a bitter taste,');
        WriteLn(IO, 'and your vision blurs. In only seconds, you slip to your');
        WriteLn(IO, 'knees and your throat closes. You gasp unsuccessfully');
        WriteLn(IO, 'for air.');
        player_dead := True;
      END;
  END;