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

Text File | 1991-06-10 | 18.5 KB | 475 lines

  {DESCRIBE.PA2}


  { Proc List_Contents }
  { *recursive* }
  {Given a location (integer) and the recursion }
  {level, prints out the items which are inside }
  {the location specified. If any of the items are}
  {themselves open, calls itself again to list }
  {the contents of that item, passing level+1 to }
  {insure proper indentation. }
  {Routine only executes if something}
  {is at location that should be listed}

  PROCEDURE List_Contents(loc : Integer;
                          level : Integer);
  LABEL Done;
  VAR i : Integer;
    FWord : words;

    FUNCTION ds : names;          {handles spacing}
    VAR k : Integer;              {level is global to this}
      st : names;
    BEGIN
      k := 0;
      st := ' ';
      REPEAT
        st := st+' ';
        k := k+1;
      UNTIL k >= ((2*level)-1);
      ds := st;
    END;                          {ds}

  BEGIN                           {List_Contents}
    IF Things_Here(loc) < 1 THEN GOTO Done;
    FOR i := First_noun TO MaxNoun DO
      IF N[i]^.location = loc THEN
        BEGIN
          IF (morecount >= MoreLimit)
          THEN BEGIN
            morecount := 0;
            Pause;
          END;
          FWord := first_word(N[i]^.short); {get first world of short description}
          {$V-} Capitalize(FWord); {$V+} {Capitalize it}
          IF FWord <> 'INVISIBLE' THEN
            BEGIN
              Write(IO, ds, N[i]^.short);
              IF ((level = 1) AND (N[i]^.position <> 'none'))
              THEN Write(IO, ' (', N[i]^.position, ')');
              IF (level > 1) THEN Write(IO, ' (in the ', name(loc), ')');
              WriteLn(IO, ' ');
              morecount := morecount+1;
              IF N[i]^.open THEN List_Contents(i, level+1);
            END;
        END;
Done:
  END;                            {list_contents}

  { Procedure List_Creatures }
  {Similar in function to List_Contents. Lists }
  {all creatures whose location is specified. This}
  {is not a recursive procedure, since creatures }
  {can only be in rooms, not other creatures or }
  {nouns. }

  PROCEDURE List_Creatures(loc : Integer);

  VAR i : Integer;
    FWord : words;
  BEGIN
    FOR i := First_creature TO MaxCreature DO
      IF M[i]^.location = loc THEN
        BEGIN
          IF (morecount >= MoreLimit)
          THEN BEGIN
            morecount := 0;
            Pause;
          END;
          FWord := M[i]^.short;   {get first world of short description}
          {$V-} Capitalize(FWord); {$V+} {Capitalize it}
          IF FWord <> 'INVISIBLE' THEN
            BEGIN
              WriteLn(IO, '  ', M[i]^.short);
              morecount := morecount+1;
            END;
        END;
  END;                            {list_Creatures}


  { SwapWords }
  {Swaps two words in a sentence}

  PROCEDURE SwapWords(FromWord, ToWord : words; VAR sentence : s; LowerCase : Boolean);

  VAR
    Spot, FromLength : Integer;
  BEGIN
    IF LowerCase THEN Normalize(ToWord); {make lower case}
    IF (FromWord[1] = '$') THEN
      BEGIN
        Normalize(ToWord);        { make lower case }
        IF (FromWord[2] <= 'Z') THEN { if first letter capital... }
          ToWord[1] := Upcase(ToWord[1]);
        IF (FromWord[3] <= 'Z') THEN { if second letter capital... }
          FOR Spot := 2 TO Length(ToWord) DO ToWord[Spot] := Upcase(ToWord[Spot]);
      END;
    FromLength := Length(FromWord);
    WHILE POS(FromWord, sentence) <> 0 DO
      BEGIN
        Spot := POS(FromWord, sentence);
        Delete(sentence, Spot, FromLength); {delete FromWord}
        Insert(ToWord, sentence, Spot); {insert ToWord}
      END;
    IF (FromWord[1] = '$') AND (FromWord[3] <= 'Z') THEN
      BEGIN
        Normalize(FromWord);
        SwapWords(FromWord, ToWord, sentence, LowerCase);
        FromWord[2] := Upcase(FromWord[2]);
        SwapWords(FromWord, ToWord, sentence, LowerCase);
      END;
  END;                            {SwapWords}



  { Handle Word Combinations }
  {Remove the specific word combination from the}
  {sentence and replace them with other words.}
  PROCEDURE Handle_Word_Combinations(VAR sentence : s);
  BEGIN
    SwapWords(',', ' AND ', sentence, False); {convert ,s to 'and'}
    SwapWords(';', ' AND ', sentence, False); {convert ;s to 'and'}
    SwapWords('  ', ' ', sentence, False); {remove any double spaces}
    SwapWords(' AND AND ', ' AND ', sentence, False);
    SwapWords(' AND THEN ', ' AND ', sentence, False);
    SwapWords(' IN TO ', ' INTO ', sentence, False);
    SwapWords(' NEAR BY ', ' BY ', sentence, False);
    SwapWords(' NEXT TO ', ' NEAR ', sentence, False);
  END;


  { Check For Name }
  {Checks to see if the command is being addressed to a creature}
  {If it is then routine sets Global NameStr to name of creature and}
  {  the Global NameNum to the creature's number.}
  {If it is NOT then routine sets Global NameStr to '' and}
  {  the Global NameNum to 0.}
  {After returning from this routine, sentence has the name (if any) stripped off}
  PROCEDURE CheckForName(VAR sentence : s);
  VAR FWord : words;
    num : Integer;
  BEGIN
    FWord := first_word(sentence);
    num := Creature_Number(FWord);
    IF ((FWord = 'ANYONE') OR (FWord = 'ANYBODY'))
    THEN num := Num_Verbs+1;
    IF ((FWord = 'EVERYONE') OR (FWord = 'EVERYBODY'))
    THEN num := Num_Verbs+2;
    IF num = 0 THEN               {Command is NOT being addressed to a creature}
      BEGIN
        NameStr := '';
        NameNum := 0;
      END
    ELSE BEGIN                    {Command is NOT being addressed to a creature}
      NameNum := num;
      Normalize(FWord);           {make lower case except for first letter}
      IF (FWord[1] IN ['a'..'z'])
      THEN FWord[1] := Char(Integer(FWord[1])-32);
      NameStr := FWord;
      sentence := But_First(sentence); {strip off name}
      FWord := first_word(sentence); {second word of command}
      IF FWord = 'AND' THEN sentence := But_First(sentence); {strip off AND}
    END;
  END;

  {Move any group member in FromLoc to ToLoc}
  PROCEDURE MoveGroup(FromLoc, ToLoc : Integer);
  VAR i : Integer;
  BEGIN
    IF MaxCreature > 0 THEN
      FOR i := First_creature TO MaxCreature DO
        IF ((M[i]^.location = FromLoc) AND (M[i]^.groupmember))
        THEN M[i]^.location := ToLoc;
  END;


  { Procedure Describe_It }
  {Given a number, it searches the data file and }
  {provides a description. }
  { 1. Allow Verb, Noun or Object to be "played back" in output.}
  { 2. Give short description (if available), if long description is missing.}
  { 3. Show short description of any nouns inside noun being described.}

  PROCEDURE Describe_It(keyword : words; num : Integer);

  VAR st : s;
    i, k, adjnum, Tries : Integer;
    VarStr, adj, SubWord, CapSubWord : words;
    start, len, Spot, VarLn, VarNum, ErrorNum, FirstDollar, NextDollar : Integer;

  BEGIN
    start := 0;
    IF keyword = 'NOUN_DESCR' THEN start := Noun_Ptr[num].start
    ELSE IF keyword = 'PLAY_DESCR' THEN start := Play_Ptr[num].start
    ELSE IF keyword = 'PUSH_DESCR' THEN start := Push_Ptr[num].start
    ELSE IF keyword = 'PULL_DESCR' THEN start := Pull_Ptr[num].start
    ELSE IF keyword = 'TURN_DESCR' THEN start := Turn_Ptr[num].start
    ELSE IF keyword = 'TEXT' THEN start := Text_Ptr[num].start
    ELSE IF keyword = 'ROOM_DESCR' THEN start := Room_Ptr[num].start
    ELSE IF keyword = 'SPECIAL' THEN start := Special_Ptr[num].start
    ELSE IF keyword = 'MESSAGE' THEN start := Message_Ptr[num].start
    ELSE IF keyword = 'HELP' THEN start := Help_Ptr[num].start
    ELSE IF keyword = 'INTRO' THEN start := Intro_Ptr.start
    ELSE IF keyword = 'CREATURE_DESCR' THEN start := Creature_Ptr[num].start;
    IF start > 0 THEN
      IF keyword = 'NOUN_DESCR' THEN len := Noun_Ptr[num].len
      ELSE IF keyword = 'PLAY_DESCR' THEN len := Play_Ptr[num].len
      ELSE IF keyword = 'PUSH_DESCR' THEN len := Push_Ptr[num].len
      ELSE IF keyword = 'PULL_DESCR' THEN len := Pull_Ptr[num].len
      ELSE IF keyword = 'TURN_DESCR' THEN len := Turn_Ptr[num].len
      ELSE IF keyword = 'TEXT' THEN len := Text_Ptr[num].len
      ELSE IF keyword = 'ROOM_DESCR' THEN len := Room_Ptr[num].len
      ELSE IF keyword = 'SPECIAL' THEN len := Special_Ptr[num].len
      ELSE IF keyword = 'MESSAGE' THEN len := Message_Ptr[num].len
      ELSE IF keyword = 'HELP' THEN len := Help_Ptr[num].len
      ELSE IF keyword = 'INTRO' THEN len := Intro_Ptr.len
      ELSE IF keyword = 'CREATURE_DESCR' THEN len := Creature_Ptr[num].len;
    IF start <= 0 THEN
      IF keyword = 'MESSAGE'
      THEN WriteLn(IO, 'MESSAGE ',num, ' is missing from .MSG file!')
      ELSE IF (num >= First_noun) AND (num <= MaxNoun)
      THEN WriteLn(IO, N[num]^.short) {give short description of no long one}
      ELSE IF (num >= First_creature) AND (num <= MaxCreature)
      THEN WriteLn(IO, M[num]^.short) {give short description of no long one}
      ELSE WriteLn(IO, 'Sorry, I can''t describe that.')
    ELSE                          {seek(datafile,start)}
      BEGIN
        Seek(descr_file, start);
        FOR i := 1 TO len DO
          BEGIN
            IF (morecount >= MoreLimit)
            THEN BEGIN
              morecount := 0;
              Pause;
            END;
            Read(descr_file, st);
            st := Decode(st);
            WHILE POS('#VAR', st) <> 0 DO
              BEGIN               {Sub Variable N (0 .. 9) for #VARN#}
                Spot := POS('#VAR', st);
                VarStr := Copy(st, Spot+4, 2);
                IF VarStr[2] = '#'
                THEN BEGIN
                  VarLn := 1;
                  VarStr := VarStr[1];
                END ELSE VarLn := 2;
                Delete(st, Spot+4, VarLn); {get ride of Var digit}
                Val(VarStr, VarNum, ErrorNum);
                IF ErrorNum = 0 THEN
                  BEGIN
                    VarNum := Variable[VarNum];
                    Str(VarNum, VarStr);
                    SwapWords('#VAR#', VarStr, st, True); {substitute Variable value}
                  END;
              END;                {WHILE}
            WHILE POS('#CTR', st) <> 0 DO
              BEGIN               {Sub Counter N (0 .. 9) for #CTRN#}
                Spot := POS('#CTR', st);
                VarStr := Copy(st, Spot+4, 2);
                IF VarStr[2] = '#'
                THEN BEGIN
                  VarLn := 1;
                  VarStr := VarStr[1];
                END ELSE VarLn := 2;
                Delete(st, Spot+4, VarLn); {get ride of Ctr digit(s)}
                Val(VarStr, VarNum, ErrorNum);
                IF ErrorNum = 0 THEN
                  BEGIN
                    VarNum := counter[VarNum];
                    Str(VarNum, VarStr);
                    SwapWords('#CTR#', VarStr, st, True); {substitute Counter value}
                  END;
              END;                {WHILE}
            adjnum := Noun_Number(noun);
            adj := Things_Adjective(adjnum);
            Tries := 0;
            WHILE ((POS('$', st) <> 0) AND (Tries < 10)) DO
              BEGIN
                Tries := Tries + 1;
                FirstDollar := POS('$', st);
                st[FirstDollar] := 'X';
                NextDollar := POS('$', st);
                st[FirstDollar] := '$'; {restore first '$' sign}
                IF NextDollar > FirstDollar THEN
                  BEGIN
                    {FromWord to substitute -- no necessarily capitalized}
                    SubWord := Copy(st, FirstDollar, NextDollar-FirstDollar+1);
                    CapSubWord := SubWord;
                    FOR k := 1 TO Length(CapSubWord) DO
                      CapSubWord[k] := Upcase(CapSubWord[k]); {capitalized word}
                    IF CapSubWord = '$ADJECTIVE$'
                    THEN SwapWords(SubWord, adj, st, True);
                    {substitute Adj wherever $ADJECTIVE$ appears}
                    IF CapSubWord = '$PREPOSITION$'
                    THEN SwapWords(SubWord, prep, st, True);
                    {substitute Prep wherever it appears}
                    IF CapSubWord = '$NOUN$'
                    THEN SwapWords(SubWord, noun, st, True);
                    {substitute Noun wherever $NOUN$ appears}
                    IF CapSubWord = '$VERB$'
                    THEN SwapWords(SubWord, Original_Verb, st, True);
                    {substitute verb for $VERB$}
                    IF CapSubWord = '$OBJECT$'
                    THEN SwapWords(SubWord, object_word, st, True);
                    {substitute Object for $OBJECT$}
                    IF CapSubWord = '$NAME$'
                    THEN SwapWords(SubWord, NameStr, st, False);
                    {substitute NameStr for $NAME$}
                  END;            {NextDollar > FirstDollar}
              END;                {WHILE}

            WriteLn(IO, st);
            morecount := morecount+1;
          END;
      END;
    IF (keyword = 'NOUN_DESCR') AND (num >= First_noun) AND (num <= MaxNoun)
    THEN IF N[num]^.open THEN List_Contents(num, 2); {show items inside - if any}
  END;

  { Function LightIsHere }
  {Returns true if possible to see in Current_Room}

  FUNCTION LightIsHere : Boolean;

  VAR i, l : Integer;
    can_see : Boolean;
  BEGIN
    can_see := False;
    {determine if need and have specific light}
    IF (Room[Current_room]^.light <= 0)
    THEN can_see := True          {do not need light}
    ELSE
      IF Room[Current_room]^.light > 1 {room needs specific light if > 1}
      THEN
        BEGIN
          l := location(Room[Current_room]^.light);
          can_see := ((l = Player) OR (l = Current_room));
        END
      ELSE
        FOR i := First_noun TO MaxNoun DO
          BEGIN
            l := location(i);
            IF (N[i]^.on) AND (N[i]^.is_light)
            AND ((l = Player) OR (l = Current_room))
            THEN can_see := True;
          END;
    LightIsHere := can_see;
  END;                            {LightIsHere}

  { Proc Describe_Scene }
  { (Describe Room, Situation) }
  {Assumes that everything is global but doesn't }
  {modify any variables. It checks the boolean }
  {variable 'verbose' to see if full descriptions }
  {are normally desired. Calls all three of the }
  {above procedures. }

  PROCEDURE Describe_scene;

  VAR
    can_see : Boolean;
  BEGIN
    IF (Current_room <> Previous_room) {just moved into room}
    THEN IF (NOT Room[Current_room]^.has_seen)
      THEN FirstVisitFlag := True {Player has been here before}
      ELSE FirstVisitFlag := False; {Player has not been here before}
    can_see := LightIsHere;
    {determine if need and have specific light}
    IF NOT can_see
    THEN
      IF (Room[Current_room]^.light = 1)
      THEN                        {player isn't carrying any light at all}
        WriteLn(IO, 'It is pitch black. You can see nothing, not even your hands.')
      ELSE                        {player may be carrying a light but still can't see}
        WriteLn(IO, 'For some reason, you can''t see anything here.')
    ELSE
      BEGIN                       {Show room description only if first turn in room}
        IF ((verb <> 'LOOK') AND (verb <> 'L')
            AND (Current_room = Previous_room) AND (NOT Is_Direction(verb)))
        THEN BEGIN                {No Description}
        END                       {No description}
        ELSE IF ((verb = 'LOOK') OR (verb = 'L') OR (FirstVisitFlag)
                 OR ((verbose) AND (Current_room <> Previous_room)))
        THEN BEGIN                {Verbose Description}
          IF Scripting THEN WriteLn(IO, '<< ', Room[Current_room]^.name, ' >>');
          morecount := morecount+2;
          Describe_It('ROOM_DESCR', Current_room);
          List_Contents(Current_room, 1);
          List_Creatures(Current_room);
        END                       {full verbose description}
        ELSE IF (NOT verbose) AND ((Current_room <> Previous_room)
                                   OR (Room[Current_room]^.has_seen))
        THEN BEGIN                {Brief Description}
          WriteLn(IO, '<< ', Room[Current_room]^.name, ' >>');
          morecount := morecount+2;
          List_Contents(Current_room, 1);
          List_Creatures(Current_room);
        END;                      {Brief description}
      END;                        {normal room description if light on or not needed}
    Previous_room := Current_room;
    Room[Current_room]^.has_seen := True;
  END;                            {describe_scene}

  {Describe(something)}

  PROCEDURE Describe(w : words);

  VAR l, num : Integer;
  BEGIN
    {$V-} Capitalize(w); {$V+}
    IF noun = 'ALL'
    THEN WriteLn(IO, 'Not everything at once! Pick one thing at a time!')
    ELSE
      IF (noun = 'DOOR') AND (location(NounNumber) <> Current_room)
      THEN IF Room[Current_room]^.locked_door
        THEN WriteLn(IO, 'It looks like a solid, locked door.')
        ELSE WriteLn(IO, 'The doors here all look pretty much like doors.')
      ELSE
        IF ((NounNumber >= First_noun) AND (NounNumber <= MaxNoun)) OR
        (NounNumber = 0)
        THEN
          BEGIN
            Normalize(w);
            IF (NOT Is_Visible(NounNumber)) AND (NOT(location(NounNumber) = Player))
            THEN WriteLn(IO, 'I see no ', w, ' here.')
            ELSE Describe_It('NOUN_DESCR', NounNumber);
          END
        ELSE                      {it must be a creature}
          BEGIN
            num := Creature_Number(w);
            Normalize(w);
            l := M[num]^.location;
            IF NOT(l = Current_room)
            THEN WriteLn(IO, 'The ', w, ' isn''t here.')
            ELSE Describe_It('CREATURE_DESCR', num);
          END;
  END;                            {describe}

  { Drop (noun ) }
  {Also take off or remove worn nouns}
  {e.g., drop axe or take off hat }
  { 1. Allows player to drop a worn item.}
  { 2. Keeps track of number of items being carried and in room.}

  PROCEDURE Drop(noun : words);

  VAR num : Integer;
    adj : words;
  BEGIN
    num := Noun_Number(noun);
    Normalize(noun);
    adj := Things_Adjective(num);
    IF (N[num]^.location <> Player) AND (N[num]^.location <> Wearing)
    THEN WriteLn(IO, 'You don''t seem to have the ', adj, ' ', noun, '.')
    ELSE
      BEGIN
        Adjust_Count(N[num]^.location, -1);
        Adjust_Count(Current_room, 1);
        N[num]^.location := Current_room;
        WriteLn(IO, 'You ', Original_Verb, ' the ', adj, ' ', noun, '.');
      END;
  END;                            {drop}