'OHRRPGCE - util.bi '(C) Copyright 1997-2020 James Paige, Ralph Versteegen, and the OHRRPGCE Developers 'Dual licensed under the GNU GPL v2+ and MIT Licenses. Read LICENSE.txt for terms and disclaimer of liability. #IFNDEF UTIL_BI #DEFINE UTIL_BI #include "config.bi" #include "crt/stddef.bi" #include "miscc.bi" 'To make strprintf always available #include "lib/sha1.bi" #include "os.bi" #include "vector.bi" #include "const.bi" 'For DirNum '#ifdef __FB_ANDROID__ '#define DEBUG_FILE_IO '#endif declare sub lowlevel_init() declare sub setup_fb_error_handler() declare sub remove_fb_error_handler() extern "C" declare sub fb_error_hook (message as const zstring ptr, interrupt_signal as boolint) end extern 'Ensure that all executables call lowlevel_init at the top of main(). Want this 'in main() so COMMAND is initialised and the module constructor ordering doesn't 'matter. #IFDEF __FB_MAIN__ lowlevel_init #ENDIF '---------------------------------------------------------------------- ' Macro utilities #define cvar(v, x) cast(typeof(v), x) #define canyptr(x) cast(any ptr, cast(intptr_t, x)) #define cintptr32(x) cast(integer, cast(intptr_t, x)) 'Cast a ptr to a 32 bit int #macro EXIT_MSG_IF(condition, errlvl, message, retwhat...) if condition then debugc errlvl, __FUNCTION__ ": " & message return retwhat 'If retwhat isn't given, just "return" end if #endmacro 'Log an error message and exit (with optional return value) if 'condition' is true #define FAIL_IF(condition, message, retwhat...) EXIT_MSG_IF(condition, errError, message, retwhat) 'Show an engine error (which might have a cause other than a bug) message and 'exit (with optional return value) if 'condition' is true. "Please report this error if unexpected..." #define ERROR_IF(condition, message, retwhat...) EXIT_MSG_IF(condition, errShowError, message, retwhat) 'Report an error that's probably due to a serious bug #define BUG_IF(condition, message, retwhat...) EXIT_MSG_IF(condition, errShowBug, message, retwhat) 'Used to dereference a ptr only if not NULL... a bit yuck 'E.g. "IF_PTR(ptr_to_foo)->widgets += 1" #define IF_PTR(arg) if arg then arg #DEFINE _CONCAT(a,b) a##b #DEFINE TEMPLNAME(a,b) a##__##b #DEFINE MACROSTART #MACRO #MACRO TEMPLATE_BASE(name, typename) 'Internal junk. See TEMPLATED for documentation #MACRO INHERIT_##name(T) name##_MEMBERS(T) #ENDMACRO 'Gimmick, ignore. Like a TEMPLATE_GENERIC version of INHERIT #MACRO INHERITAS_##name(T, whatalias) UNION TYPE name##_MEMBERS(T) END TYPE whatalias as TEMPLNAME(name, ANY) END UNION #ENDMACRO #DEFINE name(T) _CONCAT(name##__, T) #UNDEF CUR_TEMPL_DEFN #DEFINE CUR_TEMPL_DEFN name MACROSTART name##_MEMBERS(typename) #ENDMACRO #MACRO TEMPLATED(name, typename) /' ' Workaround for lack of templates. Single type argument (could add more). Usage example: TEMPLATED(MyTemplate, T) foo as T #ENDMACRO 'yes, weird, can't do anything about it 'instantiate MyTemplate MAKETYPE_MyTemplate(integer) ' Instantiated templates need to be declared with MAKETYPE_* before use. Then ' MyTemplate(integer) is the instance (compare MyTemplate in C++). ' You can embed as unnamed nested types with INHERIT_*; MAKETYPE_* is not required. '/ #MACRO MAKETYPE_##name(T) 'you can declare the same alias multiple times. TYPE _CONCAT(T,Fwd) as T TYPE TEMPLNAME(name, T) name##_MEMBERS(_CONCAT(T,Fwd)) END TYPE #ENDMACRO TEMPLATE_BASE(name, typename) #ENDMACRO #MACRO TEMPLATE_GENERIC(name, typename) /' ' This is the same as TEMPLATED, but assumes that Any is a valid substitution for T, ' as MAKETYPE creates a union with a member 'generic' for easy casting to TypeName(Any), ' intended for passing to generic functions. Templates really need OO to patch up the ' problems they introduce. ' You should insert 'ENDGENERIC' after the '#ENDMACRO' '/ #MACRO MAKETYPE_##name(T) 'you can declare the same alias multiple times. TYPE _CONCAT(T,Fwd) as T UNION TEMPLNAME(name, T) TYPE name##_MEMBERS(_CONCAT(T,Fwd)) END TYPE generic as TEMPLNAME(name, ANY) END UNION #ENDMACRO TEMPLATE_BASE(name, typename) #ENDMACRO #DEFINE ENDGENERIC _ /'This is just MAKETYPE_##name(ANY), but that would be recursive, says FB'/ _ TYPE TEMPLNAME(CUR_TEMPL_DEFN, ANY) : _ _CONCAT(CUR_TEMPL_DEFN,_MEMBERS)(ANY) : _ END TYPE '---------------------------------------------------------------------- ' Data types TYPE IntStrPair i as integer s as string END TYPE declare function a_find overload (array() as string, value as string, notfound as integer = -1) as integer declare function a_findcasei (array() as string, value as string, notfound as integer = -1) as integer declare function a_find overload (array() as integer, value as integer, notfound as integer = -1) as integer declare function a_find overload (array() as IntStrPair, value as integer, notfound as integer = -1) as integer declare function a_find overload (array() as IntStrPair, value as string, notfound as integer = -1) as integer declare sub a_shuffle_to_end overload (array() as integer, which as integer) declare sub a_shuffle_to_end overload (array() as string, which as integer) 'These act on *dynamic length* destination arrays only! Static arrays will segfault! declare sub a_append overload (array() as string, value as zstring ptr) declare sub a_append overload (array() as integer, value as integer) declare sub a_append overload (array() as IntStrPair, byval k as integer, s as zstring ptr) declare sub a_insert overload (array() as string, pos as integer, value as string) declare sub a_insert overload (array() as integer, pos as integer, value as integer) declare sub a_pop overload (array() as string, which as integer = -&h7FFFFFFF) declare sub a_pop overload (array() as integer, which as integer = -&h7FFFFFFF) declare function a_remove overload (array() as string, value as string) as integer declare function a_remove overload (array() as integer, value as integer) as integer declare sub a_copy overload (fromarray() as integer, toarray() as integer) declare sub a_copy overload (fromarray() as string, toarray() as string) /' declare sub a_exclude (() as integer, array() as integer) declare sub a_sort (dest() as integer, src() as integer) '/ ' This macro removes the i-th element from a 1-D array by shuffling it to the end ' and redimming. Has to be a macro since FB doesn't have templates, ' and can't be named a_remove as that clashes. #MACRO a_any_remove(array, which) FOR _aidx as integer = which TO UBOUND(array) - 1 SWAP array(_aidx), array(_aidx + 1) NEXT REDIM PRESERVE array(LBOUND(array) TO UBOUND(array) - 1) 'FB now supports zero-length arrays #ENDMACRO '--------------- Stack ---------------- 'New stack TYPE Stack pos as integer ptr bottom as integer ptr size as integer END TYPE declare sub createstack (st as Stack) declare sub destroystack (st as Stack) declare sub checkoverflow (st as Stack, byval amount as integer = 1) declare sub setstackposition (st as Stack, byval position as integer) #define stackposition(stack) ((stack).pos - (stack).bottom) #define pushstack(stack, datum) *(stack).pos = (datum) : (stack).pos += 1 #define popstack(stack, var) (stack).pos -= 1 : (var) = *(stack).pos 'read from a stack offset from the last push (eg. 0 is last int pushed, -1 is below that) #define readstack(stack, off) stack.pos[(off) - 1] #define checkunderflow(stack, amount) ((stack).pos - (amount) < (stack).bottom) 'Old allmodex stack (FIXME: get rid of this, can be directly replaced with the above) declare sub setupstack () declare sub pushdw (byval word as integer) declare function popdw () as integer declare sub releasestack () declare function stackpos () as integer declare function readstackdw (byval off as integer) as integer '------------ String Cache ------------ 'See also the intstr_* functions. declare function search_string_cache (cache() as IntStrPair, byval key as integer, resetter as string = CHR(234)) as string declare sub add_string_cache (cache() as IntStrPair, byval key as integer, value as string) declare sub remove_string_cache (cache() as IntStrPair, byval key as integer) '--------- Doubly Linked List --------- 'doubly linked list header TEMPLATE_GENERIC(DoubleList, T) numitems as integer first as T ptr last as T ptr memberoffset as integer '= OFFSETOF(T, DListItem) #ENDMACRO ENDGENERIC 'doubly linked list item 'WARNING: don't add strings to this TEMPLATE_GENERIC(DListItem, T) next as T ptr prev as T ptr #ENDMACRO ENDGENERIC 'DList function 'item' arguments are pointers to objects containing DListItem instances. 'You have to provide the offset of the DListItem as itemoffset to dlist_construct. 'Pass declare sub dlist_construct (byref this as DoubleList(Any), byval itemoffset as integer) 'NULL as beforeitem inserts at end 'newitem must not already be a member of a list! declare sub dlist_insertat (byref this as DoubleList(Any), byval beforeitem as any ptr, byval newitem as any ptr) #define dlist_append(this, newitem) dlist_insertat((this), NULL, (newitem)) declare sub dlist_remove (byref this as DoubleList(Any), byval item as any ptr) 'swap the positions of two items, already in (possibly different) lists declare sub dlist_swap (byref this as DoubleList(Any), byval item1 as any ptr, byref that as DoubleList(Any), byval item2 as any ptr) 'returns 0-based index of item in the list, or -1 if not found declare function dlist_find (byref this as DoubleList(Any), byval item as any ptr) as integer 'Move along a list n spaces: positive is forward, negative backwards. Returns NULL past either end declare function dlist_walk (byref this as DoubleList(Any), byval startitem as any ptr, byval n as integer) as any ptr 'the nth item in a list, counting from 0. NULL past end #define dlist_nth(this, n) dlist_walk((this), NULL, n) 'declare sub dlist_print (byref this as DoubleList(Any)) '---------------------------------------------------------------------- ' HashTable Type HashBucketItem hash as integer key as any ptr 'If the table uses integer keys, 'key' is NULL Union value as any ptr value_int as integer end Union end Type DECLARE_VECTOR_OF_TYPE(HashBucketItem, HashBucketItem) 'This is a multimap (it allows duplicate keys). 'Keys and values can be either integers or pointers to any type. 'The table optionally will make copies of keys or values instead of just treating them 'as opaque pointers - to do that you need to either use the construct() overload which provides type 'information, or manually set some of the key_* or value_* members. 'Use DECLARE_VECTOR_OF_TYPE() and DEFINE_CUSTOM_VECTOR_TYPE() to declare/create a TypeTable for a UDT. '(But note that the default hash function for a UDT just hashes its contents, which will not work 'if the compiler adds padding to the UDT! And it might not be what you want if the UDT contains pointers, 'including strings.) 'You need to ensure that you don't mix different key/value types in the same table, and that you use the 'correct overloads, because in most cases that isn't checked. Type HashTable 'Public members: (you may wish to manually set some function ptrs instead of providing TypeTables) numitems as integer key_compare as FnCompare 'If NULL, items are compared by hash value only, and keys should be NULL. 'Arguments to comparefunc are (byval as KeyType ptr, byval as KeyType ptr) key_hash as FnHash key_copy as FnCopy 'May be NULL key_delete as FnDelete 'May be NULL key_length as integer 'May be 0. Needed only if key_hash is NULL and not using integer keys key_is_integer as bool 'Whether key_type is integer, rather than using ptrs as keys value_copy as FnCopy 'May be NULL value_delete as FnDelete 'May be NULL value_is_string as bool 'value_type is type_table(string) value_is_zstring as bool 'value_type is type_table(zstring) 'Internal members: tablesize as uinteger 'Length of the 'table' array table as HashBucketItem vector ptr 'An array of hash table buckets, each a vector or NULL 'Use this constructor if either keys and values are just integers or opaque ptrs, 'or if you want to set the .key_* and .value_* members yourself. 'E.g. set tbl.value_delete = @DEALLOCATE to free values when they are removed. 'tablesize should be manually adjusted to something suitable, because it does not grow automatically. 'If there are N items in the table, then time to lookup a key will be on average N/tablesize. declare sub construct(tablesize as integer = 31) 'Construct a HashTable with information about the types, if you want to store non-opaque pointers. 'Pass a type info struct like 'type_table(T)' if you want the key/value to be a T ptr. '(You need to use DECLARE_VECTOR_OF_TYPE, DEFINE_VECTOR_* to declare/create a type_table.) 'For example you should pass type_table(string) or type_table(zstring) to store FB or C strings; 'do NOT use type_table(zstring_ptr)! 'type_table(integer) as key or value is a special case, as integers are stored directly instead of 'pointers to integers. type_table(any_ptr) (not type_table(any)) is also a special case, and means 'an opaque pointer. 'If you want the keys or values to be copied with NEW and freed with DELETE when added/removed 'from the table, pass copy_and_delete_{keys,values} = YES. (Hint: you probably want that for keys 'and values which are 'string's.) Otherwise, you are responsible for allocating and deleting them. 'If you want the table to take ownership of ptrs, just delete but not copy them, then set '.key_copy = NULL or .value_copy = NULL afterwards. (Or set .value_delete manually.) 'These args have no effect when key/value_type is integer, and must not be used with any_ptr. declare sub construct(tablesize as integer = 31, key_type as TypeTable, copy_and_delete_keys as bool, value_type as TypeTable, copy_and_delete_values as bool) 'Frees all memory. construct() can be called afterwards, with any types. 'Optional, since the automatic destructor calls destruct(). declare sub destruct() declare destructor() 'Whether construct() has been called declare function constructed() as bool 'Remove and everything in the table and call the dtors, if provided declare sub clear() 'Provide either a hash, or both a key and its hash. Both key and value may be NULL. 'However if the value is NULL you can't distinguish between NULL values and keys that aren't present! 'NOTE: if the key already exists, it will be duplicated! Use set() instead to overwrite. 'The add order of duplicated keys is preserved. declare sub add(hash as integer, value as any ptr, _key as any ptr = NULL) 'Ignore _key declare sub add(hash as integer, value as integer) declare sub add(key as any ptr, value as any ptr) declare sub add(key as any ptr, value as integer) 'Change the value of (the first instance of) a key, or add it if it's not in the table yet. declare sub set(hash as integer, value as any ptr, _key as any ptr = NULL) 'Ignore _key declare sub set(hash as integer, value as integer) declare sub set(key as any ptr, value as any ptr) declare sub set(key as any ptr, value as integer) 'Returns the value for (the first instance of) a key, or default if not present declare function get(hash as integer, default as any ptr = NULL, _key as any ptr = NULL) as any ptr 'Ignore _key declare function get(key as any ptr, default as any ptr = 0) as any ptr 'Convenience functions, which cast the return value of .get() declare function get_int(hash as integer, default as integer = 0) as integer declare function get_int(key as any ptr, default as integer = 0) as integer declare function get_str(hash as integer, default as zstring ptr = @"", _key as any ptr = NULL) as string 'Ignore _key declare function get_str(key as any ptr, default as zstring ptr = @"") as string 'Remove (the first instance of) an item and call key/value dtors, if provided. 'Returns YES if it was found, NO otherwise declare function remove(hash as integer, _key as any ptr = NULL) as bool 'Ignore _key declare function remove(key as any ptr) as bool 'To iterate over a hash table, dim state as uinteger = 0 and prev_value = NULL and 'pass to iter until value = NULL. Returns values, and optionally keys ('key' set byref). 'Adding items to the table while iterating is OK; they may or may not get iterated over. Removing items while 'iterating is OK, provided that prev_value isn't removed and that values are unique. declare function iter(byref state as uinteger, prev_value as any ptr, byref key as any ptr = NULL) as any ptr 'Returns either an integer vector (if this.key_is_integer) or else an any ptr vector '(you should store the result in an appropriate variable!) 'Unsorted. Keys are not copied, so pointers will become invalid if you free the key '(e.g. remove from the table if it's set to delete keys) declare function keys() as any ptr vector 'Implemented, but I don't think this is needed. 'declare function hashes() as integer vector 'Unsorted contents of the table. Only a shallow copy of key and value ptrs, so 'make sure they haven't been deleted yet and you don't double-free! You must 'free the vector. 'Duplicate keys appear in the order they were added. declare function items() as HashBucketItem vector 'Like .items(), but sorted either using key_compare, or by hash. 'Duplicate keys do NOT appear in the order they were added. 'Not thread-safe! declare function items_sorted() as HashBucketItem vector 'For internal use, mostly. Get the hash of a key ptr. declare function hash_key(key as any ptr) as integer end Type 'This convenience class is a HashTable with 'string' key, and has method overloads for that. Type StrHashTable Extends HashTable 'REMEMBER: almost certainly you want copy_and_delete_values=YES if the value type is string declare sub construct(tablesize as integer = 31, value_type as TypeTable = type_table(any_ptr), copy_and_delete_values as bool) declare sub add(key as string, value as any ptr) declare sub add(key as string, value as integer) declare sub add(key as string, value as string) declare sub set(key as string, value as any ptr) declare sub set(key as string, value as integer) declare sub set(key as string, value as string) declare function get(key as string, default as any ptr = NULL) as any ptr declare function get_int(key as string, default as integer = 0) as integer declare function get_str(key as string, default as zstring ptr = @"") as string declare function remove(key as string) as bool end Type '---------------------------------------------------------------------- ' Hash Functions declare sub file_hash_SHA1 overload (filename as string, result_out as SHA160 ptr) declare sub file_hash_SHA1 overload (fh as integer, result_out as SHA160 ptr) declare function file_hash64 overload (filename as string) as ulongint declare function file_hash64 overload (fh as integer) as ulongint declare function SHA1_to_string(hash as SHA160) as string declare function strhash (hstr as string) as unsigned integer '---------------------------------------------------------------------- ' Path and File Functions 'Path manipulation declare function join_path (path1 as string, path2 as string) as string declare function normalize_path (filename as string) as string declare function simplify_path (pathname as string) as string declare function simplify_path_further (pathname as string, fromwhere as string = "") as string declare function paths_equal(path1 as string, path2 as string) as bool declare function add_trailing_slash (dirname as string) as string declare function trim_trailing_slashes (filename as string) as string declare function trimpath (filename as string) as string declare function trimfilename (filename as string) as string declare function trimextension (filename as string) as string declare function justextension (filename as string) as string declare function get_path_root (pathname as string) as string declare function trim_path_root (pathname as string) as string declare function is_absolute_path (sDir as string) as bool declare function is_possibly_absolute_path (sDir as string) as bool declare function absolute_path (pathname as string) as string declare function absolute_with_orig_path (file_or_dir as string, byval add_slash as bool = NO) as string declare function parentdir (pathname as string, byval upamount as integer = 1) as string declare function anycase (filename as string) as string declare function url_hostname (url as string) as string 'Escaping declare function escape_filename (filename as string) as string declare function escape_filenamec cdecl alias "escape_filenamec" (byval filename as zstring ptr) as zstring ptr declare function fixfilename (filename as string) as string declare function lump_filename_valid (filename as string) as bool declare function decode_filename (filename as string) as string 'Find files/dirs declare sub findfiles (directory as string, namemask as string = "", filetype as FileTypeEnum = fileTypeFile, findhidden as bool = NO, filelist() as string) declare sub recursefiles (directory as string, namemask as string = "", findhidden as bool = NO, filelist() as string, cur_depth as integer = 0) declare function find_file_portably (path as string) as string declare function find_file_anycase (path as string, file_type as FileTypeEnum = fileTypeFile) as string 'Copy/move/delete/create file/dir declare function writeablecopyfile (src as string, dest as string) as bool declare sub copyfiles (src as string, dest as string, copyhidden as bool = NO, lowercase as bool = NO) declare function copydirectory (src as string, dest as string, byval copyhidden as bool = YES) as string declare function confirmed_copy (srcfile as string, destfile as string) as bool declare function confirmed_copydirectory(src as string, dest as string) as bool declare function os_shell_move(src as string, dest as string) as bool declare sub killdir (directory as string, recurse as bool = NO) declare function makedir (directory as string) as integer declare function makedir_recurse (directory as string) as integer declare function safekill (filename as string) as bool declare sub safekill_pattern (dirname as string, filepattern as string) declare function killfile (filename as string) as bool declare sub touchfile (filename as string) declare sub extendfile (byval fh as integer, byval length as integer) 'Check existence declare function fileisreadable(filename as string) as bool declare function fileiswriteable(filename as string) as bool declare function diriswriteable(filename as string) as bool declare function isfile(filename as string) as bool declare function real_isfile(filename as string) as bool declare function is_not_file(filename as string) as bool declare function isdir (filename as string) as bool 'File/dir size declare function filesize (file as string) as string declare function format_filesize (size as integer) as string declare function count_directory_size(directory as string, byref file_count as integer = 0, limit as integer = 999999) as integer 'Read/write file declare function read_file (filename as string, expect_exists as bool = YES, byref success as bool = NO) as string declare sub write_file (filename as string, outdata as string) declare function string_from_first_line_of_file (filename as string) as string declare function string_from_file (filename as string, expect_exists as bool = YES, byref success as bool = NO) as string declare sub string_to_file (string_to_write as string, filename as string) declare function lines_from_file (strarray() as string, filename as string, expect_exists as bool = YES) as bool declare function lines_to_file(strarray() as string, filename as string, lineending as string = !"\n") as bool declare function get_tmpdir () as string '---------------------------------------------------------------------- ' File read/write helpers 'Slight hackery to get more versatile read function declare function fget alias "fb_FileGet" ( byval fnum as long, byval pos as long = 0, byval dst as any ptr, byval bytes as size_t ) as long declare function fput alias "fb_FilePut" ( byval fnum as long, byval pos as long = 0, byval src as any ptr, byval bytes as size_t ) as long declare function fgetiob alias "fb_FileGetIOB" ( byval fnum as long, byval pos as long = 0, byval dst as any ptr, byval bytes as size_t, byval bytesread as size_t ptr ) as long declare function ReadShort overload (byval fh as integer, byval p as long=-1) as short declare function ReadShort overload (filename as string, byval p as integer) as short declare sub WriteShort overload (byval fh as integer, byval p as long, byval v as integer) declare sub WriteShort overload (byval fh as integer, byval p as long, byval v as short) declare sub WriteShort overload (filename as string, byval p as integer, byval v as integer) declare function ReadVStr(byval fh as integer, byval maxlen as integer) as string declare sub WriteVStr(byval fh as integer, byval maxlen as integer, s as string) declare sub WriteByte(byval fh as integer, byval v as ubyte, byval p as long=-1) declare function ReadByte(byval fh as integer, byval p as long=-1) as ubyte declare sub WriteByteStr(byval fh as integer, byval maxlen as integer, s as string) declare function ReadByteStr(byval fh as integer, byval maxlen as integer) as string '---------------------------------------------------------------------- ' Shell declare function safe_shell (cmd as string, timeout as double = 5., log_it as bool = YES) as integer declare function run_and_get_output(cmd as string, byref stdout_s as string, byref stderr_s as string = "", log_it as bool = YES) as integer '---------------------------------------------------------------------- ' Math 'TYPE XYPairFwd as XYPair UNION Float2 TYPE x as single y as single END TYPE TYPE w as single h as single END TYPE TYPE u as single 'texture coords v as single END TYPE DECLARE OPERATOR CAST () as string 'DECLARE OPERATOR CAST () as XYPairFwd 'FB doesn't allow casting to an incomplete type DECLARE OPERATOR += (rhs as Float2) END UNION DECLARE OPERATOR = (lhs as Float2, rhs as Float2) as bool DECLARE OPERATOR <> (lhs as Float2, rhs as Float2) as bool DECLARE OPERATOR + (lhs as Float2, rhs as Float2) as Float2 DECLARE OPERATOR + (lhs as Float2, rhs as double) as Float2 DECLARE OPERATOR - (lhs as Float2, rhs as Float2) as Float2 DECLARE OPERATOR - (lhs as Float2, rhs as double) as Float2 DECLARE OPERATOR * (lhs as Float2, rhs as Float2) as Float2 DECLARE OPERATOR * (lhs as Float2, rhs as double) as Float2 DECLARE OPERATOR / (lhs as Float2, rhs as Float2) as Float2 DECLARE OPERATOR / (lhs as Float2, rhs as double) as Float2 ' Don't use this directly. TYPE XYSimple x as integer y as integer END TYPE 'The only reason this exists in addition to XYSimple is for the CAST to string 'operator, so you can write '"size " & foo.wh' to get "size 2*3" TYPE WHSimple w as integer h as integer DECLARE OPERATOR CAST () as string END TYPE UNION XYPair TYPE x as integer y as integer END TYPE TYPE w as integer h as integer END TYPE TYPE wide as integer high as integer END TYPE n(1) as integer xy as XYSimple 'This is to allow LET(posx,posy) = pos.xy wh as WHSimple DECLARE OPERATOR += (rhs as XYPair) DECLARE OPERATOR CAST () as string DECLARE OPERATOR CAST () as Float2 DECLARE OPERATOR LET (value as integer) DECLARE OPERATOR LET (f2 as Float2) 'Not as good as a constructor or cast Operator :( END UNION DECLARE OPERATOR = (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR = (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR <> (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR <> (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR < (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR < (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR <= (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR <= (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR > (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR > (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR >= (lhs as XYPair, rhs as XYPair) as bool DECLARE OPERATOR >= (lhs as XYPair, rhs as integer) as bool DECLARE OPERATOR + (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR + (lhs as XYPair, rhs as integer) as XYPair DECLARE OPERATOR - (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR - (lhs as XYPair, rhs as integer) as XYPair DECLARE OPERATOR * (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR * (lhs as XYPair, rhs as integer) as XYPair DECLARE OPERATOR * (lhs as XYPair, rhs as double) as XYPair DECLARE OPERATOR \ (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR \ (lhs as XYPair, rhs as integer) as XYPair DECLARE OPERATOR / (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR / (lhs as XYPair, rhs as double) as XYPair DECLARE OPERATOR ABS (lhs as XYPair) as XYPair DECLARE OPERATOR MOD (lhs as XYPair, rhs as XYPair) as XYPair DECLARE OPERATOR MOD (lhs as XYPair, rhs as integer) as XYPair DECLARE OPERATOR - (lhs as XYPair) as XYPair #DEFINE XY(x, y) TYPE(x, y) #DEFINE XYF(x, y) TYPE(x, y) 'This allows us to create vectors of XYPair using vector.bas DECLARE_VECTOR_OF_TYPE(XYPair, XYPair) ' --------- Inline operators ---------- 'These are the common XYPair (and some Float2) operators (put here so they 'can be inlined); the remainder are in util.bas. 'See the declarations above for the complete list. PRIVATE OPERATOR = (lhs as XYPair, rhs as XYPair) as bool RETURN lhs.x = rhs.x ANDALSO lhs.y = rhs.y END OPERATOR PRIVATE OPERATOR = (lhs as XYPair, rhs as integer) as bool RETURN lhs.x = rhs ANDALSO lhs.y = rhs END OPERATOR PRIVATE OPERATOR <> (lhs as XYPair, rhs as XYPair) as bool RETURN lhs.x <> rhs.x ORELSE lhs.y <> rhs.y END OPERATOR PRIVATE OPERATOR <> (lhs as XYPair, rhs as integer) as bool RETURN lhs.x <> rhs ORELSE lhs.y <> rhs END OPERATOR PRIVATE OPERATOR XYPair.CAST () as Float2 RETURN XYF(x, y) END OPERATOR PRIVATE OPERATOR XYPair.+= (rhs as XYPair) x += rhs.x y += rhs.y END OPERATOR PRIVATE OPERATOR XYPair.LET (rhs as Float2) x = rhs.x y = rhs.y END OPERATOR PRIVATE OPERATOR XYPair.LET (value as integer) x = value y = value END OPERATOR PRIVATE OPERATOR + (lhs as XYPair, rhs as XYPair) as XYPair RETURN TYPE(lhs.x + rhs.x, lhs.y + rhs.y) END OPERATOR PRIVATE OPERATOR + (lhs as XYPair, rhs as integer) as XYPair RETURN TYPE(lhs.x + rhs, lhs.y + rhs) END OPERATOR PRIVATE OPERATOR - (lhs as XYPair, rhs as XYPair) as XYPair RETURN TYPE(lhs.x - rhs.x, lhs.y - rhs.y) END OPERATOR PRIVATE OPERATOR - (lhs as XYPair, rhs as integer) as XYPair RETURN TYPE(lhs.x - rhs, lhs.y - rhs) END OPERATOR PRIVATE OPERATOR * (lhs as XYPair, rhs as XYPair) as XYPair RETURN TYPE(lhs.x * rhs.x, lhs.y * rhs.y) END OPERATOR PRIVATE OPERATOR * (lhs as XYPair, rhs as integer) as XYPair RETURN TYPE(lhs.x * rhs, lhs.y * rhs) END OPERATOR PRIVATE OPERATOR * (lhs as XYPair, rhs as double) as XYPair RETURN TYPE(lhs.x * rhs, lhs.y * rhs) END OPERATOR PRIVATE OPERATOR \ (lhs as XYPair, rhs as XYPair) as XYPair RETURN TYPE(lhs.x \ rhs.x, lhs.y \ rhs.y) END OPERATOR PRIVATE OPERATOR \ (lhs as XYPair, rhs as integer) as XYPair RETURN TYPE(lhs.x \ rhs, lhs.y \ rhs) END OPERATOR PRIVATE OPERATOR / (lhs as XYPair, rhs as double) as XYPair RETURN TYPE(lhs.x / rhs, lhs.y / rhs) END OPERATOR PRIVATE OPERATOR / (lhs as XYPair, rhs as XYPair) as XYPair RETURN TYPE(lhs.x / rhs.x, lhs.y / rhs.y) END OPERATOR PRIVATE OPERATOR - (lhs as XYPair) as XYPair RETURN TYPE(-lhs.x, -lhs.y) END OPERATOR PRIVATE OPERATOR + (lhs as Float2, rhs as Float2) as Float2 RETURN TYPE(lhs.x + rhs.x, lhs.y + rhs.y) END OPERATOR PRIVATE OPERATOR - (lhs as Float2, rhs as Float2) as Float2 RETURN TYPE(lhs.x - rhs.x, lhs.y - rhs.y) END OPERATOR '--------------------------------------- DECLARE FUNCTION xypair_direction (v as XYPair, byval axis as integer, byval default as DirNum = dirNone) as DirNum DECLARE FUNCTION xypair_to_direction (v as XYPair) as DirNum DECLARE SUB xypair_move (v as XYPair, byval direction as integer, byval amount as integer = 1) DECLARE FUNCTION xypair_manhattan_distance(v1 as XYPair, v2 as XYPair) as integer DECLARE FUNCTION xypair_distance_squared(v1 as XYPair, v2 as XYPair) as integer DECLARE FUNCTION dirX(dirn as DirNum, dist as integer = 1) as integer DECLARE FUNCTION dirY(dirn as DirNum, dist as integer = 1) as integer UNION XYZTriple TYPE x as integer y as integer z as integer END TYPE TYPE w as integer h as integer depth as integer END TYPE n(2) as integer END UNION UNION RectType TYPE x as integer y as integer UNION TYPE wide as integer high as integer END TYPE TYPE w as integer h as integer END TYPE END UNION END TYPE TYPE topleft as XYPair size as XYPair END TYPE TYPE xy as XYPair wh as XYPair END TYPE DECLARE OPERATOR CAST () as string END UNION #DEFINE XYWH(x, y, w, h) TYPE(x, y, w, h) 'Just TYPE will nearly always do too. 'If you get an error like "Expected ')', found '.'" when using the XY_WH macro 'in a SUB's argument list, enclose the arg list in brackets as a workaround. 'This is an FB bug: https://sourceforge.net/p/fbc/bugs/922/ #DEFINE XY_WH(xy, wh) TYPE((xy).x, (xy).y, (wh).w, (wh).h) DECLARE OPERATOR = (lhs as RectType, rhs as RectType) as bool DECLARE OPERATOR <> (lhs as RectType, rhs as RectType) as bool DECLARE OPERATOR + (lhs as RectType, rhs as RectType) as RectType DECLARE OPERATOR * (lhs as RectType, rhs as integer) as RectType 'Specify opposite points instead of width and height 'NOTE: p1 and p2 don't have to be the topleft/bottomright, some code 'might accept other opposite corners. TYPE RectPoints UNION p1 as XYPair topleft as XYPair TYPE left as integer top as integer END TYPE END UNION UNION p2 as XYPair bottomright as XYPair TYPE right as integer bottom as integer END TYPE END UNION END TYPE 'Used for menu and slice anchor points and slice align points 'Not to be confused with the rCenter, ancCenter, etc, constants! Type AlignType as ubyte Enum 'AlignType alignLeft = 0 alignTop = 0 alignMiddle = 1 alignCenter = 1 alignNone = 1 'Only used by slice clamp options alignRight = 2 alignBottom = 2 alignBoth = 3 'Only used by slice clamp options alignINVALID = 127 End Enum CONST _rFactor = 10100000 ' Max amount that can be added to/subtracted from an r* or anc* constant CONST _rMargin = 50000 ' Relative coordinates, used by relative_pos() and various functions ' such as edgebox, printstr, rectangle. ' Not to be confused with the alignCenter, etc, constants! These ' are not usable as slice or menu positions. ' You can add together at most one r*, one anc* and one show* constant... ' with the exception that you can assume rCenter + rCenter = rRight, and rLeft = 0. ' Note that INT_MAX, 99999, 999999, 9999999 (other large values close to power of 10) ' get passed through unchanged, without being interpreted as having any flags. ' r* constants say which edge of the screen this RelPos position is relative to. CONST rLeft = 0 CONST rTop = 0 CONST rCenter = _rFactor * 3 CONST rMiddle = _rFactor * 3 CONST rHalf = _rFactor * 3 ' Use this as an object size to mean "half the size of the dest page" CONST rRight = _rFactor * 6 CONST rBottom = _rFactor * 6 CONST rWidth = _rFactor * 6 ' Use this as an object width to mean "width of the dest page" CONST rHeight = _rFactor * 6 ' Use this as an object height to mean "height of the dest page" ' anc* constants say which edge of the object this RelPos gives the position of CONST ancTop = 0 CONST ancLeft = 0 CONST ancCenter = _rFactor * 1 CONST ancMiddle = _rFactor * 1 CONST ancBottom = _rFactor * 2 CONST ancRight = _rFactor * 2 ' show* constants shift if over the screen edge, so the left-most or right-most part of the object is visible CONST showLeft = _rFactor * 9 CONST showTop = _rFactor * 9 CONST showRight = _rFactor * 18 CONST showBottom = _rFactor * 18 ' placements; used especially for printstr, etc. CONST pLeft = rLeft + ancLeft ' =0 CONST pTop = rTop + ancTop ' =0 CONST pCentered = rCenter + ancCenter CONST pCenteredLeft = rCenter + ancCenter + showLeft 'AKA xstring CONST pCenteredRight = rCenter + ancCenter + showRight 'AKA xstringright CONST pBottom = rBottom + ancBottom CONST pRight = rRight + ancRight ' Type of a relative coordinate or relative XYPair, use this to indicate whether a function supports them! ' (However RelPosXY/RelRectType are hardly used anywhere currently) TYPE RelPos as integer TYPE RelPosXY as XYPair TYPE RelRectType as RectType declare function relative_pos overload (pos as RelPos, pagewidth as integer, objwidth as integer = 0) as integer declare function relative_pos overload (pos as RelPosXY, pagesize as XYPair, objsize as XYPair = XY(0,0)) as XYPair declare sub RelPos_decode (pos as RelPos, byref offset as integer, byref align as AlignType, byref anchor as AlignType, byref show as AlignType) declare function bitcount (byval v as unsigned integer) as integer declare function ceiling (byval n as integer) as integer declare function bound overload (byval n as integer, byval lowest as integer, byval highest as integer) as integer declare function bound overload (byval n as longint, byval lowest as longint, byval highest as longint) as longint declare function bound overload (byval n as double, byval lowest as double, byval highest as double) as double declare function bound overload (point as XYPair, lefttop as XYPair, rightbottom as XYPair) as XYPair declare function in_bound (byval n as integer, byval lowest as integer, byval highest as integer) as integer declare sub clamp_value (byref value as integer, byval min as integer, byval max as integer, argname as string) declare function large overload (byval n1 as integer, byval n2 as integer) as integer declare function large overload (byval n1 as longint, byval n2 as longint) as longint declare function large overload (byval n1 as double, byval n2 as double) as double declare function large overload (xy1 as XYPair, xy2 as XYPair) as XYPair declare sub loopvar overload (byref value as integer, min as integer, max as integer, inc as integer = 1) declare sub loopvar overload (byref value as longint, min as longint, max as longint, inc as longint = 1) declare function small overload (byval n1 as integer, byval n2 as integer) as integer declare function small overload (byval n1 as longint, byval n2 as longint) as longint declare function small overload (byval n1 as double, byval n2 as double) as double declare function small overload (xy1 as XYPair, xy2 as XYPair) as XYPair declare sub corners_to_rect (p1 as XYPair, p2 as XYPair, result as RectType) declare sub corners_to_rect_inclusive (p1 as XYPair, p2 as XYPair, result as RectType) declare function rect_collide_point (r as RectType, p as XYPair) as bool declare function rect_collide_rect (r1 as RectType, r2 as RectType) as bool declare function rect_collide_point_vertical_chunk (r as RectType, p as XYPair, chunk_spacing as integer) as integer declare sub reseed_prng (seed as double) declare function rando () as double declare function randint (byval limit as integer) as integer declare function range (number as integer, percent as integer) as integer declare function isnan overload (byval value as double) as integer declare function isnan overload (byval value as single) as integer declare function isfinite overload (byval value as double) as integer declare function isfinite overload (byval value as single) as integer declare function fuzzythreshold (byval value as double, byval low as double, byval high as double) as double declare function simple_rand (byref prng_state as uinteger) as double declare function simple_randint (byref prng_state as uinteger, byval upperbound as integer) as uinteger 'Euclidean modulo (always positive) #DEFINE POSMOD(dividend, divisor) ((((dividend) MOD (divisor)) + (divisor)) MOD (divisor)) #DEFINE ROT(a,b) ((a shl b) or (a shr (32 - b))) PRIVATE FUNCTION small (byval n1 as integer, byval n2 as integer) as integer small = n1 IF n2 < n1 THEN small = n2 END FUNCTION PRIVATE FUNCTION small (byval n1 as longint, byval n2 as longint) as longint small = n1 IF n2 < n1 THEN small = n2 END FUNCTION PRIVATE FUNCTION small (byval n1 as double, byval n2 as double) as double IF n2 < n1 THEN RETURN n2 ELSE RETURN n1 END FUNCTION PRIVATE FUNCTION small (xy1 as XYPair, xy2 as XYPair) as XYPair DIM ret as XYPair = any ret.x = IIF(xy1.x > xy2.x, xy2.x, xy1.x) ret.y = IIF(xy1.y > xy2.y, xy2.y, xy1.y) RETURN ret END FUNCTION PRIVATE FUNCTION large (byval n1 as integer, byval n2 as integer) as integer large = n1 IF n2 > n1 THEN large = n2 END FUNCTION PRIVATE FUNCTION large (byval n1 as longint, byval n2 as longint) as longint large = n1 IF n2 > n1 THEN large = n2 END FUNCTION PRIVATE FUNCTION large (byval n1 as double, byval n2 as double) as double IF n2 > n1 THEN RETURN n2 ELSE RETURN n1 END FUNCTION PRIVATE FUNCTION large (xy1 as XYPair, xy2 as XYPair) as XYPair DIM ret as XYPair = any ret.x = IIF(xy1.x < xy2.x, xy2.x, xy1.x) ret.y = IIF(xy1.y < xy2.y, xy2.y, xy1.y) RETURN ret END FUNCTION PRIVATE FUNCTION in_bound (byval n as integer, byval lowest as integer, byval highest as integer) as integer RETURN (n >= lowest) AND (n <= highest) END FUNCTION PRIVATE FUNCTION bound (byval n as integer, byval lowest as integer, byval highest as integer) as integer bound = n IF n < lowest THEN bound = lowest IF n > highest THEN bound = highest END FUNCTION PRIVATE FUNCTION bound (byval n as longint, byval lowest as longint, byval highest as longint) as longint bound = n IF n < lowest THEN bound = lowest IF n > highest THEN bound = highest END FUNCTION PRIVATE FUNCTION bound (byval n as double, byval lowest as double, byval highest as double) as double bound = n IF n < lowest THEN bound = lowest IF n > highest THEN bound = highest END FUNCTION PRIVATE FUNCTION bound (point as XYPair, lefttop as XYPair, rightbottom as XYPair) as XYPair DIM ret as XYPair = any ret.x = IIF(point.x > rightbottom.x, rightbottom.x, IIF(point.x < lefttop.x, lefttop.x, point.x)) ret.y = IIF(point.y > rightbottom.y, rightbottom.y, IIF(point.y < lefttop.y, lefttop.y, point.y)) RETURN ret END FUNCTION '---------------------------------------------------------------------- ' String functions Enum clipDir clipNone clipLeft clipRight End Enum type FnReplacement as function(original as string, arg as any ptr) as string declare function cstring (s as string) as zstring ptr declare function copy_zstring (str_ptr as zstring ptr) as zstring ptr declare function blob_to_string (byval str_ptr as zstring ptr, byval str_len as integer) as string declare function utf8_to_latin1(utf8string as ustring) as string declare function latin1_to_utf8(s as string) as ustring declare function utf8_to_mbs(u8str as ustring) as string declare function rpad (s as string, pad_char as zstring ptr = @" ", size as integer, clip as clipDir = clipNone) as string declare function lpad (s as string, pad_char as zstring ptr = @" ", size as integer, clip as clipDir = clipNone) as string declare function rlpad (s as string, pad_char as zstring ptr = @" ", pad_right as integer, pad_left as integer, clip as clipDir = clipNone) as string declare function instr_nth overload (byval start as integer, s as string, substring as string, byval nth as integer) as integer declare function instr_nth overload (s as string, substring as string, byval nth as integer) as integer declare function length_matching (s1 as string, s2 as string) as integer declare function skip_over (text as string, byref idx as integer, tok as zstring ptr, maxskips as integer = -1) as integer declare function starts_with(s as string, prefix as string) as bool declare function ends_with(s as string, suffix as string) as bool declare function parse_int (stri as zstring ptr, ret as integer ptr=NULL, strict as bool=NO) as bool declare function str2int (stri as zstring ptr, default as integer=0, strict as bool=NO) as integer declare function split_str_int(z as zstring ptr, byref action as string, byref arg as integer) as bool declare function str2bool(q as string, default as integer = NO) as integer declare function rotascii (s as string, o as integer) as string declare function titlecase(word as string) as string declare function escape_string(s as string, chars as string) as string declare function replacestr overload (byref buffer as string, replacewhat as string, replacefunc as FnReplacement, arg as any ptr, maxtimes as integer = -1, caseinsensitive as bool = NO) as integer declare function replacestr overload (byref buffer as string, replacewhat as string, withwhat as string, maxtimes as integer = -1, caseinsensitive as bool = NO) as integer declare function normalize_newlines (buffer as string, newline as string = LINE_END) as string declare function exclude (s as string, x as string) as string declare function exclusive (s as string, x as string) as string declare function special_char_sanitize(s as string) as string declare function scancodename (k as KBScancode, longname as bool = NO) as string declare function sign_string (n as integer, neg_str as string, zero_str as string, pos_str as string) as string declare function zero_default (n as integer, default_caption as string="default") as string declare function defaultint (n as integer, default_caption as string="default", default_value as integer=-1) as string declare function blank_default (s as string, blankcaption as string="[default]") as string declare function caption_or_int (captions() as string, n as integer) as string declare function safe_caption (caption_array() as string, index as integer, description as string = "value") as string declare function safe_captionz (caption_array() as zstring ptr, index as integer, description as string = "value") as string declare Function wordwrap(z as string, byval width as integer, sep as string = chr(10)) as string declare sub split(in as string, ret() as string, sep as string = chr(10)) declare sub split_line_positions(original_text as string, lines() as string, line_starts() as integer, sep as string = chr(10)) declare function split_chunk(in as string, index as integer, sep as string = chr(10), default as string="") as string declare function find_on_word_boundary_excluding(haystack as string, needle as string, excludeword as string) as integer declare function find_on_word_boundary(haystack as string, needle as string) as integer declare function extract_string_chunk(haystack as string, start_needle as string, end_needle as string, byref success as bool = NO, byref foundat as integer=0) as string declare function replace_string_chunk(haystack as string, start_needle as string, end_needle as string, new_chunk as string, byref success as bool = NO) as string '---------------------------------------------------------------------- ' Commandline processing ' A function to handle commandline options, e.g. gfx_setoption type FnSetOption as function(opt as string, arg as string) as integer declare function commandline_flag(opt as string) as bool declare sub processcommandline(cmdline_args() as string, opt_handler as FnSetOption, args_file as string = "") '---------------------------------------------------------------------- ' ini file read/write declare function read_ini_str overload (ini() as string, key as string, default as string="", byref linenum as integer = 0) as string declare function read_ini_str overload (ini_filename as string, key as string, default as string="", byref linenum as integer = 0) as string declare function read_ini_int overload (ini_filename as string, key as string, default as integer=0) as integer declare function read_ini_double overload (ini_filename as string, key as string, default as double=0.) as double declare sub write_ini_value overload (ini() as string, key as string, value as string) declare sub write_ini_value overload (ini_filename as string, key as string, value as string) declare sub write_ini_value overload (ini_filename as string, key as string, value as integer) declare sub write_ini_value overload (ini_filename as string, key as string, value as double) declare function ini_key_match(text as string, key as string, byref value as string = "") as bool '---------------------------------------------------------------------- ' Other declare function days_since_datestr(datestr as string) as integer declare function format_duration(length as double, decimal_places as integer = 1) as string declare function format_date(timeser as double) as string declare function seconds2str(sec as integer, f as string = " %m: %S") as string declare sub flusharray (array() as integer, byval size as integer=-1, byval value as integer=0) declare sub sort_integers_indices(indices() as integer, byval start as integer ptr, byval number as integer = 0, byval stride as integer = SIZEOF(integer)) declare sub qsort_indices(indices() as integer, byval start as any ptr, byval number as integer = 0, byval stride as integer, byval compare_fn as FnCompare) declare sub qsort_integers_indices(indices() as integer, byval start as integer ptr, byval number as integer, byval stride as integer) declare sub qsort_strings_indices(indices() as integer, byval start as string ptr, byval number as integer, byval stride as integer) declare function ptr_compare cdecl (byval a as any ptr ptr, byval b as any ptr ptr) as long declare function integer_compare cdecl (byval a as integer ptr, byval b as integer ptr) as long declare function string_compare cdecl (a as string, b as string) as integer declare function numeric_string_compare cdecl (a as string, b as string, case_insen as bool = NO) as integer declare sub invert_permutation overload (indices() as integer, inverse() as integer) declare sub invert_permutation overload (indices() as integer) declare function readkey () as string #macro debug_if_slow(starttime, seconds, extrainfo) IF TIMER > starttime + seconds THEN _ debuginfo __FUNCTION__ "(" & extrainfo & ") took " & CINT((TIMER - starttime) * 1000) & "ms" #endmacro declare function measure_timer_overhead() as double 'This throws out outliers and smooths over many repeated start() to stop() timings. 'In comparison to ExpSmoothedTimer this is more useful for timing/profiling code. 'Instances of this should typically be static or globals type SmoothedTimer timing as double 'Current timing times as double vector 'Buffer smoothtime as double 'Smoothed timing value ran as bool 'Whether stop() has been called (not automatically set to false) smooth_updated as bool 'Whether smoothtime updated on the last stop() call declare destructor() declare sub start() declare function stop() as bool declare function add_time(time as double) as bool declare function tell() as string declare sub stop_and_print() end type 'Exponentially smooths over many time steps (enclosed in begin() to end() calls), 'which are each the sum of multiple start() to stop() timings. type ExpSmoothedTimer cur_time as double 'Current time step smooth_time as double 'Smoothed time value display_time as double 'Set equal to smooth_delay only when update_display=YES 'The following are used internally by CPUUsageMode hide_delay as integer 'Number of ticks before recomputing .hide hide as bool 'Don't display, because it's zero declare sub begin_timestep() declare function finish_timestep(halflife as double, update_display as bool = YES) as double declare sub start() declare sub stop() declare operator +=(rhs as ExpSmoothedTimer) end type enum TimerIDs explicit None = -2 Total = -1 'Can't be passed to substart/substop/switch Default = 0 'Time not assigned to any subtimer Pause = 1 'Special subtimer subtracted from Total FIRST = 2 'First normal subtimer 'For main_timer 'Default is gameplay logic UpdateSlices = 2 'Updating the slice tree, and AdvanceSlices DrawSlices = 3 DrawOther = 4 'Things not converted to slices, other than debug menus DrawDebug = 5 'Debug menus UpdateScreen = 6 'setvispage Scripts = 7 FileIO = 8 'Doesn't include all file IO, just slowest (eg. loading the map, sfx, reloading lumps( IOBackend = 9 'setkeys, io_waitprocessing, Steam 'For gfx_slice_timer Map = 2 Text = 3 'For gfx_op_timer Dissolve = 2 Rotozoom = 3 Blend = 4 'Max value of any valid timer ID LAST = 9 end enum 'Time sections of code, attributing time to a certain subtimer or to the default one, 'performing smoothing between timesteps. 'You can make nested calls to substart/substop, provided that they have different TimerIDs, 'but only the first takes effect, the rest are ignored: it's assumed the first call is the 'most specific (e.g. a sprite dissolve might do a blended draw). 'Alternatively, use switch() to override the current subtimer or perform nesting. 'Use TimerIDs.Pause to pause the timestep. type MultiTimer enabled as bool 'True if and only if subtimer <> None (true when Paused) subtimer as TimerIDs = TimerIDs.None 'Never equal to Total. timers(-1 to TimerIDs.LAST) as ExpSmoothedTimer 'num_timer_calls as integer declare sub begin_timestep() declare sub finish_timestep(halflife as double, update_display as bool = YES) declare function substart(new_subtimer as TimerIDs) as TimerIDs declare sub substop(cur_subtimer as TimerIDs) declare function switch(new_subtimer as TimerIDs) as TimerIDs declare sub add_time(to_subtimer as TimerIDs, amount as double) end type '---------------------------------------------------------------------- ' Old allmodex functions DECLARE SUB xbload (f as string, array() as integer, e as string) DECLARE SUB xbsave (f as string, array() as integer, bsize as integer) DECLARE SUB setbitmask (byref bitsets as integer, bitmask as integer, value as bool) DECLARE SUB setbit (bitwords() as integer, wordnum as integer, bitnum as integer, value as bool) DECLARE FUNCTION readbit (bitwords() as integer, wordnum as integer = 0, bitnum as integer) as integer DECLARE FUNCTION xreadbit (bitwords() as integer, bitnum as integer, wordoffset as integer=0) as bool DECLARE SUB array2str (arr() as integer, byval o as integer, s as string) DECLARE SUB str2array (s as string, arr() as integer, byval o as integer) '---------------------------------------------------------------------- ' Globals (think twice before adding more) EXTERN tmpdir as string 'Ideally would not be in this module EXTERN orig_dir as string EXTERN exename as string EXTERN default_arg as integer EXTERN "C" EXTERN program_start_timer as double END EXTERN ''''' #ENDIF