!::
! ROODYLIB EXTRA ROUTINES
!::

#ifset VERSIONS
#message "extraroutines.hug Version 1.2"
#endif

!\ Roody's note: ClearArray, as you might guess, clears arrays of values.
I made it mainly to stop having to write array-clearing loops each time.

	Originally, it looped through the entire array, but doing so in a large
	string array like _temp_string is a real memory-killer. Now it clears
	until it gets two empty slots.\!

routine ClearArray(array_to_be_cleared)
{
	local n,t
	for (n=0;n< array array_to_be_cleared[] ; n++ )
	{
		if	array array_to_be_cleared[n] = 0
			t++
		else
		{
			array array_to_be_cleared[n] = 0
			t = 0
		}
		if t = 2
			break
	}
}

! CenterLine is a one-line only version of CenterTitle, printing
! string "a" in the center of the current line. Its accuracy will
! probably be affected by the current font, but it still could be useful.
! Add an override value if you *don't* want Indent-ing where there isn't
! enough room to center.

routine CenterLine(a,override,drawthrough)
{
	print newline ! make sure we are at the start of a line
	local l
	l = string(_temp_string, a)
	if l < display.linelength
		print to (display.linelength / 2 - l/2);
	elseif not override	! if we don't have enough line width to center it, we'll
		Indent	! show the line's importance by indenting
	print a;
	if drawthrough
		print to display.linelength
	else
		""
}


!\ Roody's note: FindObjectOfType and FindObjectWithAttribute both look
for an object of a certain type or attribute in the scope of the given
location. If there are none or more than one, it returns false. Otherwise,
it returns the object. Written by Kent Tessman for Future Boy!
\!

! FindObjectOfType(t, location)
! Used to find an object of type t; returns either the single available
! object, or nothing.

routine FindObjectOfType(t, loc)
{
	local i, obj, suspect

	if loc = 0:  loc = location

	for i in loc
	{
		if i.type = t
		{
			if suspect
				return nothing
			suspect = i
		}
		elseif children(i) and (i is not container or i is open or i is not openable)
		{
			obj = FindObjectOfType(t, i)
			if obj
			{
				if suspect
					! More than 1
					return nothing
				else
					suspect = obj
			}
		}
	}

	! Only do the whole-tree check when loc is a room-level object:
	if parent(loc) = nothing and not suspect
	{
		for (i=1; i<=objects; i++)
		{
			if i.type = t and i ~= suspect
			{
				if FindObject(i, location)
				{
					if suspect
						! More than one
						return nothing
					else
						suspect = obj
				}
			}
		}
	}
	return suspect
}


! FindObjectWithAttribute(attr, location)
! Used to find an object with attribute attr; returns either the
! single available object, or nothing.

routine FindObjectWithAttribute(attr, loc)
{
	local i, obj, suspect

	if loc = 0:  loc = location

	for i in loc
	{
		if i is attr and i ~= player
		{
			if suspect
				return nothing
			suspect = i
		}
		elseif children(i) and (i is not container or i is open or i is not openable)
		{
			obj = FindObjectWithAttribute(attr, i)
			if obj
			{
				if suspect
					! More than 1
					return nothing
				else
					suspect = obj
			}
		}
	}

	! Only do the whole-tree check when loc is a room-level object:
	if parent(loc) = nothing and not suspect
	{
		for (i=1; i<=objects; i++)
		{
			if i is attr and i ~= suspect and i ~= player
			{
				if FindObject(i, location)
				{
					if suspect
						! More than one
						return nothing
					else
						suspect = obj
				}
			}
		}
	}

	return suspect
}

!----------------------------------------------------------------------------
! GetPrompt
! receives input from the keyboard, parsing into the word[] array; unknown
! words--i.e. those that aren't in the dictionary--are equated to the null
! string ("")
!
! GetPrompt(prompt)
! where the optional <prompt> represents a dictionary word, prints <prompt>
! before receiving input, otherwise it prints the global-variable prompt

!\ Roody's note: This is basically GetInput except it always prints some kind
of prompt. Changing GetInput would break a million things, so here's a new
alternative (you can always just call "input" if you don't want to print a
prompt). \!

routine GetPrompt(p)
{
	if p
		print p;
	else
		print ">";
	input
}

!\ IsNear - new approximation routine. returns true if
value fir is within value range of value sec \!

#ifclear NO_AUX_MATH
routine IsNear(fir,sec,range)
{
	if (abs(fir - sec) <= range)
		return true
	else
		return false
}
#endif

! Roody's note: IsYounger by Kent Tessman for Future Boy!
! IsYounger
!
! returns true if object1 is younger (i.e., further down in the children list)
! than object2

routine IsYounger(object1, object2)
{
	local p, obj
	p = parent(object1)
	if parent(object2) ~= p
		return false

	obj = object1
	while (obj)
	{
		if obj = object2
			return false
		obj = sibling(obj)
	}
	return true
}

routine IsYoungerThan(obj1,obj2)
{
	local x
	x = obj1
	while x
	{
		x = elder(x)
		if x = obj2
			return true
	}
	return false
}

!\ Roody's note: PrintArrayList is like PropertyList except it doesn't
print the total of objects (and it uses arrays and not property arrays).
Written by Kent Tessman for Future Boy!
\!

! PrintArrayList(list, count)
! Prints count elements of the array list.

routine PrintArrayList(list, count, conjunction)
{
	if not conjunction
		conjunction = AND_WORD
	local i
	for (i=1; i<=count; i++)
	{
		if i > 1:  " ";
		The(array list[i-1])
		if i < count and count > 2:  ",";
		if i = count-1:  print " "; conjunction;
	}
	return false
}

!\ Roody's note: Routine for quickly moving objects from one object to another.
Written by Kent Tessman for Future Boy!
\!

routine TransferObjects(from_obj, to_obj)
{
	local i

	i = child(from_obj)
	while i
	{
		local j
		j = sibling(i)
		move i to to_obj
		i = j
	}
}

!\ Roody's note: WordInCommand- a routine by Kent Tessman for checking if a
particular word is in a command. Probably could have some novel uses.
I imagine you'd use it in PreParse to catch whatever you're looking for. \!

! WordInCommand(word)
!
! Returns true if 'word' was used as part of the player's command (i.e., is
! part of the word[] array).

routine WordInCommand(w)
{
	local i
	for (i=1; i<=words; i++)
	{
		if word[i] = w
			return true
		elseif word[i] = ""
			return false
	}
}

!\ PickAChild and PickAnElement - These are routines for picking objects
 from a parent or elements from an array. The argument routine determines
 which objects/elements are eligible. If rand is true, one of the eligible
 objects/elements is randomly selected. \!

#if undefined MAX_SUSPECTS
constant MAX_SUSPECTS 5
#endif

array suspects_array[MAX_SUSPECTS]

routine PickAChild(par,arg, rand)
{
	local obj, qualify, n, val,obj2

	for obj in par
	{
		obj2 = val
		qualify = call arg(obj, obj2)
		if qualify
		{
			val = obj
			suspects_array[n] = obj
			n++
		}
	}

	if rand
	{
		n = random(n)
		n--
		val = suspects_array[n]
	}
	return val
}

!\ Usage Example:

routine DoPick
{
	local a
	select word[2]
		case "1": a = PickAChild(basket, &IsGreater)
		case "2": a = PickAChild(basket, &IsEdible, true)
	print "The item is "; a.name
}

routine IsEdible(obj)
{
	return (obj is edible)
}

routine IsGreater(obj,obj2)
{
	if obj2
	{
		return (obj.misc > obj2.misc)
	}
	else
		return true
}  \!


! An array-based version of the above next:

routine PickAnElement(arr,arg, rand)
{
	local obj, qualify, n, val,obj2

	for (i = 0;i < array arr ;i++ )
	{
		obj = array arr[i]
		obj2 = val
		qualify = call arg(obj, obj2)
		if qualify
		{
			val = obj
			suspects_array[n] = obj
			n++
		}
	}

	if rand
	{
		n = random(n)
		n--
		val = suspects_array[n]
	}
	return val
}

! sample routine calling PickAnElement
!routine DoPick
!{
!	local a
!	select word[2]
!	! first case picks the item in basket_array that has the greatest
!	!   misc property value
!		case "1": a = PickAnElement(basket_array, &IsGreater)
!	! second case picks random value from all items in basket_array that
!	! are edible
!		case "2": a = PickAnElement(basket_array, &IsEdible, true)
!	print "The item is "; a.name
!}

!----------------------------------------------------------------------------
!* ARRAY SORTING
!----------------------------------------------------------------------------

!\ Roody's note - SortArray and the comparison routines below were
written by Christopher Tate.  It used to be a part of Roodylib, but as Roodylib
has mostly moved on to "object sorting," these routines were moved over here. \!

!-----------------------------------------------------------------------
! SortArray() arguments:
!
! data = array to sort
! num = number of elements in the array
! comp_routine = the address of the comparison routine to use
! beginn = beginning element to start with (for arrays not starting with 0 )

routine SortArray(data_arr, num, comp_routine,beginn)
{
	local i
	local did_swap

	for (i = beginn; i < (beginn + num); i = i + 1)
	{
		local j
		did_swap = false
		for (j = (num + beginn - 1); j > i; j = j - 1)
		{
			local swap
			swap = call comp_routine(array data_arr[j-1], array data_arr[j])
			if swap
			{
				local tmp
				tmp = array data_arr[j]
				array data_arr[j] = array data_arr[j-1]
				array data_arr[j-1] = tmp
				did_swap = true
			}
		}
		! if we didn't swap any elements, then the array is sorted
		if not did_swap : return
	}
}

! SortProp is a version that works off a property array
!  obj = the object, prp = the property array to be sorted
!  comp_routine = like above
routine SortProp(obj, prp, comp_routine)
{
	local i
	local did_swap

	for (i = 1; i <= obj.#prp; i = i + 1)
	{
		local j
		did_swap = false
		for (j = obj.#prp ; j > i; j = j - 1)
		{
			local swap
			swap = call comp_routine(obj.prp #(j-1), obj.prp #j)
			if swap
			{
				local tmp
				tmp = obj.prp #j
				obj.prp #j = obj.prp #(j-1)
				obj.prp #(j-1) = tmp
				did_swap = true
			}
		}
		! if we didn't swap any elements, then the array is sorted
		if not did_swap : return
	}
}

!-----------------------------------------------------------------------
! SORT_ASCENDING() and SORT_DESCENDING()
!
! These simple comparison routines are provided to handle the
! common cases of sorting a numeric array in ascending or
! descending order.  For example, to sort an entire numeric array
! called "data_arr" in ascending order, just do this:
!
! SortArray(data_arr, data_arr[], &SORT_ASCENDING)

routine SORT_ASCENDING(obj1, obj2)
{
	return (obj1 > obj2)
}

routine SORT_DESCENDING(obj1, obj2)
{
	return (obj1 < obj2)
}

routine SORT_RANDOM(obj1, obj2)
{
	return (random(2) - 1)
}

!----------------------------------------------------------------------------
!* PAUSING WITH TITLE_CAPTION
!----------------------------------------------------------------------------
!\ This changes the game's title caption to "press a key to continue" while
   waiting for a key press. \!

routine PauseWithCaption(pausetext)
{
	local save_title
#ifset NO_ACCESSIBILITY
	local cheap
#endif
	if display.title_caption and not cheap
	{
		save_title = display.title_caption
		display.title_caption = "[PRESS A KEY TO CONTINUE]"
	}
	CoolPause(pausetext)
	if save_title
		display.title_caption = save_title
}

routine TopPauseWithCaption(pausetext)
{
	local save_title
#ifset NO_ACCESSIBILITY
	local cheap
#endif
	if display.title_caption and not cheap
	{
		save_title = display.title_caption
		display.title_caption = "[PRESS A KEY TO CONTINUE]"
	}
	TopPause(pausetext)
	if save_title
		display.title_caption = save_title
}

!----------------------------------------------------------------------------
!* EXTRA "NEW_DESCRIBEPLACE" OBJECTS
!----------------------------------------------------------------------------

!\ This breaks up the ParentofPlayerScenery object into two objects in case
you need to fine-tune where they are listed. \!

object parentofplayer
{
	in describeplace_settings
	first_pass
	{
		local obj,ret
		if player not in describe_loc and describe_loc = location
		{
			for obj in (Parent(player))
			{
				if obj is not hidden and obj ~= player
					return true
			}
		}
		return false
	}
	second_pass
	{
		local ret
#ifset USE_RELATIVE_DESCRIPTIONS
		if RelativeParent(parent(player)) and children(parent(player)) > 1 and
			player not in describe_loc and describe_loc = location and
			not (FORMAT & LIST_F)
		{
			local tempformat
			tempformat = FORMAT
			FORMAT = FORMAT | FIRSTCAPITAL_F | ISORAREHERE_F
			DESCRIBEPLACEFORMAT = DESCRIBEPLACEFORMAT | OVERRIDEHERE_F
			list_nest = 2
			! called WhatsIn and not ListObjects so the parent's listcontents
			! property will be checked
			ret = WhatsIn(parent(player))
			FORMAT = tempformat
		}
		else
		{
#endif
			list_nest = 1
			if player not in describe_loc and describe_loc = location
				ret = WhatsIn(Parent(player))
#ifset USE_RELATIVE_DESCRIPTIONS
		}
#endif
		print newline
		list_nest = 0
		return ret
	}
}

object SceneryChildren
{
	in describeplace_settings
	first_pass
	{
		local obj
		for obj in describe_loc
		{
			if obj.type = scenery
			{
            if player not in obj and
				(obj is open or obj is not openable or obj is platform or
				obj is transparent) and obj is not quiet
				{
					local a
					obj is not already_listed
					for a in obj
					{
						if a is not hidden
						{
							return true
						}
					}
				}
			}
		}
		return false
	}
	second_pass
	{
		local obj, ret
		for obj in describe_loc
		{
			if obj.type = scenery
			{
				obj is known
				if player not in obj and
					((obj is container and ((obj is openable and obj is open)  or
					obj is not openable or obj is transparent))  or
					obj is platform) and obj is not quiet
				{
					if not (FORMAT & DESCFORM_D)
						print newline
					list_nest = 1
					if WhatsIn(obj)
						ret = true
				}
			}
			! For scenery-derived objects that may change the type
			elseif obj is static, hidden
#ifset MULTI_PCS
				MakeKnown(obj)
#else
				obj is known
#endif
		}
		print newline
		list_nest = 0
		return ret
	}
}

routine ObjsWithNewDescs(place, for_reals)
{
	local obj, ret
	if not for_reals
	{
		for obj in place
		{
#ifset USE_ATTACHABLES
		! Exclude all attachables for now (and characters)
			if obj is not living and not obj.type = attachable and
				player not in obj and obj is not hidden and
				(verbosity ~= 1 and obj.new_desc) and
				obj is not already_printed
#else
			if obj is not living and player not in obj and
				obj is not hidden and
				(verbosity ~= 1 and obj.new_desc) and
				obj is not already_printed
#endif
			{
#ifset USE_PLURAL_OBJECTS
				if (obj.identical_to).type = identical_class
					obj is already_listed
				else
				{
#endif
					ret = true
					obj is not already_listed
#ifset USE_PLURAL_OBJECTS
				}
#endif
			}
			else
				obj is already_listed
		}
		return ret
	}
	else
	{
		for obj in place
		{
			if player not in obj
			{
				if obj is not already_listed and
					obj is not hidden and obj is not already_printed
				{
					if verbosity ~= 1
						NewDescribe(obj)
					if obj is already_listed ! did we print something?
					{
						ret = true
						obj is already_printed
					}
				}
			}
		}
		print newline
		return ret
	}
}

routine CharsWithNewDescs(describe_loc, for_reals)
{
	local obj
	if not for_reals
	{
		for obj in describe_loc
		{
			if (obj is not hidden and obj is living and
				 obj ~= player and (obj.new_desc and verbosity ~= 1) and
				obj is not already_printed )
			{
				return true
			}
		}
		return false
	}
	else
	{
		! List all characters, if any
!		count = 0
		for obj in describe_loc
		{
			if obj is hidden or obj is not living or
				player in obj
				obj is already_listed
			else
				obj is not already_listed
		}
		local ret
		for obj in describe_loc
		{
			if obj is not already_listed
			{
!				print newline
				if verbosity ~= 1
					NewDescribe(obj)
				if obj is already_listed  ! did we print something?
				{
					ret = true
					obj is already_printed
				}
			}
		}
		print newline
		return ret
	}
}

routine NewDescribe(obj)
{
	local ListContents
	obj is known

	if list_nest = 1
		print newline

	AssignPronoun(obj)

	if (not ListContents)
	{
		if verbosity = 1
			return

		local a
		a = obj.new_desc

		if a
		{
			Indent
			print a ;
		}
		elseif not a
			return
	}
!  "ListContents" section
	obj is already_listed
	obj is already_printed
	AssignPronoun(obj)

	! If INDENT_SIZE is 0, formatting may be thrown off when listing
	! the contents of an object:
	if INDENT_SIZE = 0:  need_newline = true

}