LINGO UTILITY FUNCTIONS and COMMAND ROUTINES
by David Jackson-Shields
-- utility function to return a maximum value:
on max a, b
if a >= b then
return a
else
return b
end if
end max
-- utility function to return a minimum value:
on min a, b
if a <= b then
return a
else
return b
end if
end min
-- utility function to convert a string to all upperCase,
-- for making comparisons which are not case-sensitive:
on upperCase s
set r = EMPTY
set len = length( s )
repeat with i = 1 to len
set c = chars( s, i, i )
if charToNum( c ) >= 97 AND charToNum( c ) <= 122 then Â
set c = numToChar( charToNum( c ) - 32 )
set r = r & c
end repeat
return r
end upperCase
-- utility function to trim the end of a string of a specified character:
on trim s, ch
set len = length( s )
if len = 0 then
return EMPTY
else
repeat while chars( s, len, len ) = ch AND len > 0
set s = chars( s, 1, len - 1 )
set len = length( s )
end repeat
return s
end if
end trim
-- utility function to strip the front of a string of a specified character:
on strip s, ch
set len = length( s )
if len = 0 then
return EMPTY
else
repeat while s starts ch AND len > 0
set s = chars( s, 2, length( s ) )
set len = length( s )
end repeat
return s
end if
end strip
-- utility function to convert a number to a string, and pad with
-- leading characters (ch) up to a certain number of digits (d).
-- Typically this is used to pad a number with leading zeros etc...:
on pad n, d, ch
set s = string( n )
set len = length( s )
repeat while len < d
set s = ch & s
set len = length( s )
end repeat
return s
end pad
-- function to test for whether a thing has been assigned
-- a value...returns TRUE if it does, FALSE if <NoValue>.
on valueP thing
if integerP( thing ) then
return TRUE
else if floatP( thing ) then
return TRUE
else if stringP( thing ) then
return TRUE
else if symbolP( thing ) then
return TRUE
else if objectP( thing ) then
return TRUE
else
return FALSE
end if
end valueP
-- utility handler to wait a specified number of seconds...
-- ( we subtract 1 tick (1/60th-second) for calling the handler ):
on wait secs
startTimer
repeat while the timer < ( secs * 60 ) - 1
end repeat
end wait
-- utility handler used for calculating a power (base raised to an exponent.)
-- This routine only handles exponents which are positive integers:
on power base, exp
set returnVal = base
repeat with i = 1 to exp - 1
set returnVal = base * returnVal
end repeat
return returnVal
end power
-- Utility handler used for founding out the factor of a number, that is
-- to find out how many times the base goes into the number (n)...
-- This is helpful in deciding the units column for various base number systems:
on factor n, base
set returnVal = 0
repeat while n >= base
set n = n / base
set returnVal = returnVal + 1
end repeat
return returnVal
end factor
-- utility function returns a Director Cast Window position consisting
-- of a letter (from A to H) and two numeric digits from the
-- cast number (n) expressed as an integer from 1 to 512:
on castID n
if ( n <= 512 ) or ( n >= 1 ) then
return numToChar((( n - 1) / 64 ) + 65 ) & Â
string((((((( n - 1 ) / 8) mod 64 ) mod 8 ) + 1 ) * 10 ) + Â
((( n - 1 ) mod 64 ) mod 8 ) + 1 )
else
alert "Error ¬ castNum larger than 512 or smaller than 1"
end if
end castID
-- function to return a string to use as a dateStamp within a Macintosh fileName
on findDateNTime
-- substitute an underline for the colon, to use within a Mac fileName:
set theTime = the short time
set colonPtr = offset( ":", theTime )
set theTime = chars( theTime, 1, colonPtr - 1 ) & "_" & Â
chars( theTime, colonPtr + 1, length( theTime ) )
return the short date && theTime
end findDateNTime
--
-- utility function to convert an alphabetic character to its
-- ordinal value within the alphabet...( not case-sensitive )
-- If the char is non-alphabetic, it returns a negative error code...
on alphaRank ch
-- set default errorFlag:
set r = -1
set n = charToNum( ch )
-- test for upperCase letters:
if ( n >= 65 ) and ( n <= 90 ) then
set r = n - 64
-- test for lowerCase letters:
else if ( n >= 97 ) and ( n <= 122 ) then
set r = n - 96
end if
return r
end alphaRank
-- utility handler to replace a char within a string:
-- *Due to a bug in the text function "put...into char n of str",
-- which causes extra blank chars to be inserted before char n...
-- Note: the bug was fixed in 3.1 beta v6...but this still could
-- be an alternate method used with strings (instead of fields.)
on replaceChar s, ptr, ch
set len = length( s )
if ( ptr < 1 ) OR ( ptr > len ) then
return s
else
set tmp = chars( s, 1, ptr - 1 )
set tmp = tmp & ch
return tmp & chars( s, ptr + 1, len )
end if
end replaceChar
-- +++++++++++++++++++++ end of utility Functions +++++++++++++++++++++++++++++++
-- +++++++++++++++++++++ start of utility Commands ++++++++++++++++++++++
-- turns puppetSprites on or off for a range of sprite channels
on setPuppets start, end, boolVal
repeat with channel = start to end
puppetSprite channel, boolVal
end repeat
end setPuppets
-- sorting routine for a range of elements in a Factory Object array:
on oldQuickSort objName, firstElement, lastElement
global passCtr
do "global" && objName
set lo = firstElement
set up = lastElement
repeat while up > lo
set i = lo
set j = up
do "set tempr =" && objName & "( mGet, lo )"
-- split file in two:
repeat while i < j
do "set sortKey =" && objName & "( mGet, j )"
repeat while sortKey > tempr
set j = j - 1
do "set sortKey =" && objName & "( mGet, j )"
end repeat
do objName & "( mPut, i," && objName & "( mGet, j ) )"
do "set sortKey =" && objName & "( mGet, i )"
repeat while ( i < j ) AND ( sortKey <= tempr )
set i = i + 1
do "set sortKey =" && objName & "( mGet, i )"
end repeat
do objName & "( mPut, j," && objName & "( mGet, i ) )"
end repeat
do objName & "( mPut, i, tempr )"
-- sort recursively:
do "oldQuickSort" && QUOTE & objName & QUOTE & ", lo, ( i - 1 )"
set lo = i + 1
set passCtr = passCtr + 1
end repeat
end oldQuickSort
-- IMPROVED sorting routine for a range of elements in a Factory Object array
-- thanks to JT's explanation passing the object itself instead of the object name:
on quickSort theObj, firstElement, lastElement
global passCtr
set lo = firstElement
set up = lastElement
repeat while up > lo
set i = lo
set j = up
set tempr = theObj( mGet, lo )
-- split file in two:
repeat while i < j
set sortKey = theObj( mGet, j )
repeat while sortKey > tempr
set j = j - 1
set sortKey = theObj( mGet, j )
end repeat
theObj( mPut, i, theObj( mGet, j ) )
set sortKey = theObj( mGet, i )
repeat while ( i < j ) AND ( sortKey <= tempr )
set i = i + 1
set sortKey = theObj( mGet, i )
end repeat
theObj( mPut, j, theObj( mGet, i ) )
end repeat
theObj( mPut, i, tempr )
-- sort recursively:
quickSort theObj, lo, ( i - 1 )
set lo = i + 1
set passCtr = passCtr + 1
end repeat
end quickSort
-- the following factory can be used to create an array for testing quickSort:
factory arrayFac
-- following two handlers can be used for testing the above quickSort routine
-- the argument limitNum is the argument of the random function:
on makeRandomArray arraySize, limitNum
global randomArray
if objectP( randomArray ) then randomArray( mDispose )
set randomArray = arrayFac( mNew )
repeat with i = 1 to arraySize
randomArray( mPut, i, random( limitNum ) )
end repeat
put "Done making the randomArray"
end makeRandomArray
--
on showRandomArray arraySize
global randomArray
if objectP( randomArray ) = 0 then
put "No randomArray exists"
else
repeat with i = 1 to arraySize
put i & ")" && randomArray( mGet, i )
end repeat
end if
end showRandomArray
--
on testQuickSort
global randomArray
set arrayElements = 50
set valueLimit = 100
put "making a random array of" && arrayElements && Â
"elements and a random value limit of" && valueLimit
makeRandomArray arrayElements, valueLimit
put "sorting the random array"
startTimer
quickSort randomArray, 1, arrayElements
put "quickSort took" && ( the timer ) / 60.0 && "seconds"
end testQuickSort
-- causes a scrolling text field to scroll to the desired line:
on forceAutoScroll fieldName, n
put EMPTY before line n of field fieldName
end forceAutoScroll
-- QuickSort algorithm applied to sorting lines of a field...for
-- demonstration purposes to watch it work on a field ONLY.
-- ACTUALLY...It would be more efficient to do the following:
-- Assign the lines of a field to an object array. Then use the
-- quickSort algorithm above to sort the array. Then write the lines
-- of the array back to the field.
-- Since the algorithm uses recursion, you must send the number
-- of lines of the field externally to the routine when you
-- call it.
-- EXAMPLE:
-- "quickFieldSort a12, 1, the number of lines of field a12"
on quickFieldSort fieldName, firstLine, lastLine
global passCtr
set lo = firstLine
set up = lastLine
repeat while up > lo
set i = lo
set j = up
set tempr = line lo of field fieldName
-- split file in two:
repeat while i < j
set sortKey = line j of field fieldName
repeat while sortKey > tempr
set j = j - 1
set sortKey = line j of field fieldName
end repeat
put line j of field fieldName into Â
line i of field fieldName
set sortKey = line i of field fieldName
repeat while ( i < j ) AND ( sortKey <= tempr )
set i = i + 1
set sortKey = line i of field fieldName
end repeat
put line i of field fieldName into Â
line j of field fieldName
end repeat
put tempr into line i of field fieldName
-- sort recursively:
quickFieldSort fieldName, lo, ( i - 1 )
set lo = i + 1
set passCtr = passCtr + 1
end repeat
end quickFieldSort
-- Function returns a positive number (n) using a specified base (b),
-- up to a particular maximum unit of the base (u)
-- Example: to find the largest factor of 2 contained in the number 140,
-- up to the seventh unit of the binary number system...ie: (2 to the 7th power),
-- you would: set x = FactorBase( 2, 7, 140 ).
--
-- This would provide factors of 2 contained in numbers up to 1 less than the
-- 8th unit of the binary system, or factors of the numbers 1 to 255, inclusive.
-- Returns a <Null> value if either the base, units, or number = Ø.
on FactorBase b, u, n
if ( b = 0 ) OR ( u = 0 ) OR ( n = 0 ) then exit
repeat with i = 0 to u
set p = b
repeat with e = 1 to i
set p = p * b
end repeat
if p > n then
return e - 1
end if
end repeat
end FactorBase
-- a function to return the label name of a given frame number;
-- works with Director 3.0 and later versions;
-- If the frame has no marker, then EMPTY is returned.
-- Syntax for calling the function is either:
-- put lookupMarker( 5 ) into labelName
-- ...OR...
-- set labelName = lookupMarker( 5 )
on lookupMarker frameNum
put the labelList into LL
set lineCtr = 0
repeat with i = 1 to length( LL )
if chars( LL, i, i ) = RETURN then set lineCtr = lineCtr + 1
end repeat
if lineCtr then
repeat with i = 1 to lineCtr
put line i of LL into LB
do "put string( label(" && QUOTE & LB & QUOTE && Â
") ) into labelFrame"
if labelFrame = frameNum then return LB
end repeat
end if
return EMPTY
end lookupMarker