'OHRRPGCE - Some Custom/Game common code '(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. ' This file is for code that is shared between GAME and CUSTOM. ' It is disorganised; .rpg upgrade routines, much loading/saving code, and a ' number of general menus like multichoice and show_help are here. ' Code that is not OHRRPGCE-specific that would be of general use ' to any FreeBasic program belongs in util.bas instead. ' Also, a few of these functions (those declared in common_base.bi) ' have alternative simpler implementations in common_base.bas ' and can used in commandline utilities. #include "config.bi" #include "const.bi" #include "allmodex.bi" #include "audiofile.bi" #include "os.bi" #include "miscc.bi" #include "string.bi" #include "gfx.bi" #include "udts.bi" #include "scrconst.bi" #include "uiconst.bi" #include "common.bi" #include "slices.bi" #include "reload.bi" #include "sliceedit.bi" #include "music.bi" #include "loading.bi" #IFDEF __FB_MAIN__ #include "testing.bi" #endif 'Subs and functions only used here DECLARE SUB setup_sprite_sizes () DECLARE SUB check_map_count () DECLARE SUB apply_script_fixups () DECLARE SUB fatal_error_shutdown () DECLARE SUB zero_out_pre_july_8_1999_general_map_data_garbage () DECLARE SUB append_to_logfile(s as string) DECLARE SUB archive_log_file(logfile as string, archivefile as string) #IFDEF IS_GAME #include "game.bi" #include "gglobals.bi" #include "moresubs.bi" #include "scripting.bi" #include "scriptcommands.bi" #include "yetmore2.bi" #ENDIF #IFDEF IS_CUSTOM #include "cglobals.bi" #include "customsubs.bi" #include "custom.bi" #ENDIF DEFINE_VECTOR_OF_POD_TYPE(TagRangeCheck, TagRangeCheck) DEFINE_VECTOR_OF_POD_TYPE(TileMap ptr, TileMap_ptr) DEFINE_VECTOR_OF_POD_TYPE(TilesetData ptr, TilesetData_ptr) '============================== Global variables =============================' '=== Graphics globals ===' DIM vpage as integer = 0 DIM dpage as integer = 1 REDIM master(256) as RGBcolor 'Length 257 because also a RGBPalette REDIM uilook(uiColorLast) as integer REDIM boxlook(uiBoxLast) as BoxStyle REDIM current_font(1023) as integer '=== Debug logging ===' 'app_name is used only by the crash handler #IFDEF IS_CUSTOM DIM app_name as zstring ptr = @"OHRRPGCE-Custom" DIM app_log_filename as zstring ptr = @"c_debug.txt" DIM app_archive_filename as zstring ptr = @"c_debug_archive.txt" #ELSEIF DEFINED(IS_GAME) DIM app_name as zstring ptr = @"OHRRPGCE-Game" DIM app_log_filename as zstring ptr = @"g_debug.txt" DIM app_archive_filename as zstring ptr = @"g_debug_archive.txt" #ELSE 'Utilities DIM app_name as zstring ptr = NULL 'Use executable name DIM app_log_filename as zstring ptr = @"u_debug.txt" DIM app_archive_filename as zstring ptr = @"u_debug_archive.txt" #ENDIF 'Allocate sprite size table REDIM sprite_sizes(sprTypeFirst TO sprTypeLast) as SpriteSize setup_sprite_sizes 'Used as a description of the context of what we were doing when an error occurs, 'useful if bound_arg or reporterr is called from outside the script interpreter '(it's always printed by reporterr) 'NOTE: you must remember to reset this to "" when leaving a context! DIM context_string as string '=== Other global dirs and files ===' 'This should usually be used instead of exepath as the location of the executables. 'Always has a trailing slash. 'on Mac: where the .app is 'on Android: where the extracted .apk contents are (actually the files/ subdirectory) ' (exepath is garbage on Android) 'on Linux: where the ohrrpgce-* wrapper shell scripts (renamed game/custom.sh) are 'otherwise: where the exe is (same as exepath) DIM app_dir as string 'Used on Mac to point to the app bundle Resources directory (if running an .app). Otherwise empty. DIM app_resources_dir as string 'User's documents directory (if it exists, otherwise another suitable writeable default location) DIM documents_dir as string 'This is for application-wide settings, and prefsdir for games will be a subdirectory of it. DIM settings_dir as string 'Game-specific subdirectory (named game_fname) of settings_dir. Currently only used by Game DIM prefsdir as string 'ohrrpgce_config.ini. This is stored in either app_dir or settings_dir. For non-game-specific settings. DIM global_config_file as string '_config.ini next to sourcerpg, or else gameconfig.ini in prefsdir. Settings here 'shadow those in global_config_file, but only game-specific settings are written here by 'default. Mostly for settings remembered by Game for a single game, or user overrides. DIM game_config_file as string '=== Game data ===' 'Current game DIM game as string DIM sourcerpg as string DIM workingdir as string 'Has been spawned from Custom. This is a common global for the benefit of gfx_sdl DIM running_under_Custom as bool = NO 'The .rpg filename with path & extension trimmed. Used as prefsdir subdirectory name DIM game_fname as string 'Used for search_string_cache. Should change every time the current game changes; changing 'it on reloading some lumps while live previewing also useful, to clear certain caches '(Always blank in Custom) DIM game_unique_id as string 'General game data array and Doc REDIM gen(499) DIM gen_reld_doc as DocPtr 'The global reload document acts as a parent to any misc reload data structures (e.g. hero data) kept in memory. DIM global_reload_doc as Reload.DocPtr 'Data caches DIM statnames() as string REDIM herotags() as HeroTagsCache REDIM itemtags() as ItemDefTags 'TODO: when can we get rid of this? REDIM buffer(16384) as integer '=========================== Module-local variables ==========================' 'Used by intgrabber, reset by reset_menu_edit_state (called by usemenu etc) DIM SHARED negative_zero as bool = NO 'Used by percent_grabber and format_percent, reset by usemenu DIM SHARED editing_float_ptr as any ptr 'Ptr to a single or double which was last passed to percent_grabber DIM SHARED editing_float_repr as string 'a primitive system for printing messages that scroll TYPE ConsoleData as integer x = 0, y = 0, top = 0, h = 200, c = 0, margin = 4 END TYPE DIM SHARED console as ConsoleData DIM SHARED show_upgrade_messages as bool 'Whether any upgrade messages have been shown yet DIM SHARED got_upgrade_messages as bool 'upgrading timing stuff DIM SHARED time_rpg_upgrade as bool = NO 'Change to YES, or pass --time-upgrade DIM SHARED last_upgrade_time as double DIM SHARED upgrade_overhead_time as double DIM SHARED upgrade_start_time as double 'Upgrade all game data (required for writing), or only enough to allow reading? #IFDEF IS_CUSTOM DIM SHARED full_upgrade as bool = YES #ELSE DIM SHARED full_upgrade as bool = NO #ENDIF ' Debug log stuff DIM debug_to_console as bool = NO 'don't delete the debug file at end of play DIM SHARED importantdebug as bool = NO 'Stores debug messages printed during initialisation, or in-game between playing different games. DIM SHARED log_buffer as string 'When restarting the log, the previous path if significant DIM SHARED lastlogfile as string 'Prevent two threads from writing to debug log at once 'Disabled for now, because it needs to be recursive to allow OPENFILE to write to log file. 'DIM SHARED debug_log_mutex as any ptr 'debug_log_mutex = mutexcreate 'The directory to write logs like g/c_debug[_archive].txt '(Should have a slash. For very short time during initialisation equal to "" to write to CWD) DIM log_dir as string 'While true, debug messages also get appended to log_buffer. DIM remember_debug_messages as bool = YES 'How many errors ('debug' or higher, so anything but debuginfo) have been logged DIM num_logged_errors as integer = 0 'And how many have been logged to log_buffer specifically DIM SHARED num_log_buffer_errors as integer = 0 'True if called send_bug_report already this session DIM SHARED reported_a_bug as bool TYPE SavedGfxIOState prev_mouse_vis as CursorVisibility vpages_were_32bit as bool resolution_was_unlocked as bool anim_framerate as integer 'ms use_speed_control as bool vpage as integer dpage as integer keymap as PlayerKeyMap END TYPE REDIM SHARED gfxio_state_stack(-1 TO -1) as SavedGfxIOState '-1th element unused '.stt lump read into memory DIM SHARED global_strings_buffer as string 'Used by ensure_normal_palette & restore_previous_palette DIM SHARED entered_ensure_normal_palette as integer = 0 DIM SHARED remember_faded_in as bool DIM SHARED remember_faded_to_color as RGBcolor 'binsize.bin, fixbits.bin cache DIM SHARED binsize_cache(binLASTENTRY) as integer DIM SHARED binsize_cache_loaded as bool = NO REDIM SHARED fixbits_cache() as ubyte DIM SHARED fixbits_cache_loaded as bool = NO DIM SHARED dummy_000_extravec as integer vector '=============================================================================' FUNCTION common_setoption(opt as string, arg as string) as integer IF opt = "time-upgrade" THEN time_rpg_upgrade = YES RETURN 1 'arg not used ELSEIF opt = "full-upgrade" THEN full_upgrade = YES RETURN 1 'arg not used END IF END FUNCTION '========================================================================================== ' Save or reset gfx state '========================================================================================== 'Call before showing debug screens and messages in Game, in case the screen is faded out or 'the palette has been modified (e.g. for a scripted screen fade) 'Call restore_previous_palette() before resuming (mandatory) 'The ensure-restore calls can be nested. ' 'Use push_and_reset_gfxio_state() instead when you need to reset more than just the palette. 'Use load_default_master_palette when being certain the user can read the screen is more important 'than respecting customisations (ie. in showerror). SUB ensure_normal_palette () #IFDEF IS_GAME 'IF faded_in = NO THEN setpal master() 'Simpler solution entered_ensure_normal_palette += 1 IF entered_ensure_normal_palette > 1 THEN EXIT SUB remember_faded_in = faded_in remember_faded_to_color = faded_to_color IF gam.ingame THEN DIM mpal(255) as RGBcolor loadpalette mpal(), gam.current_master_palette 'UI colors aren't editable with scripts, so don't care that we overwrite them. LoadUIColors uilook(), boxlook(), gam.current_master_palette, mpal() setpal mpal() ELSE 'Haven't loaded a game yet setpal master() 'Already have default ui cols END IF #ENDIF END SUB SUB restore_previous_palette () #IFDEF IS_GAME entered_ensure_normal_palette -= 1 IF entered_ensure_normal_palette > 0 THEN EXIT SUB IF remember_faded_in THEN setpal master() ELSE setpal_to_color remember_faded_to_color END IF 'Assume uilook(), boxlook() haven't changed and don't need reloading #ENDIF END SUB 'Call this when opening an editor, menu, error message, etc, which should be shown 'with working mouse, unmodified (normal) master palette, and resizable window. 'Mostly used in-game, but also useful in Custom since some menus hide the mouse cursor. 'Note: this doesn't stop or pause replaying or recording an .ohrkeys file. SUB push_and_reset_gfxio_state () REDIM PRESERVE gfxio_state_stack(-1 TO UBOUND(gfxio_state_stack) + 1) WITH gfxio_state_stack(UBOUND(gfxio_state_stack)) 'Switch to 32-bit color so that changing the master palette doesn't distort colours 'of previous screen contents (holdscreen). This converts vpages to 32-bit using 'the current master palette. Hacky, likely better to give each vpage its own palette. '(Note that pages created with allocatepage change their bitdepth on 'switch_to_32bit_vpages, while those created with duplicatepage don't!) .vpages_were_32bit = vpages_are_32bit() switch_to_32bit_vpages ensure_normal_palette .prev_mouse_vis = getcursorvisibility() showmousecursor pause_mouserect force_use_mouse += 1 .keymap = get_keymap(1) 'Makes a copy reset_to_basic_keymap 'Ensures Ctrl is not mapped to Use setkeys #IFDEF IS_GAME .resolution_was_unlocked = resolution_unlocked() unlock_resolution 320, 200 #ENDIF .anim_framerate = get_animation_framerate() .use_speed_control = use_speed_control use_speed_control = YES 'Save vpage/dpage because some menus use compatpage, drawing to a view of vpage, 'but still need to "setvispage vpage". This only works if vpage doesn't change. .vpage = vpage .dpage = dpage END WITH END SUB 'Undoes push_and_reset_gfxio_state SUB pop_gfxio_state () BUG_IF(UBOUND(gfxio_state_stack) < 0, "Unmatched call!") WITH gfxio_state_stack(UBOUND(gfxio_state_stack)) IF .vpages_were_32bit THEN switch_to_32bit_vpages ELSE switch_to_8bit_vpages END IF restore_previous_palette setcursorvisibility(.prev_mouse_vis) resume_mouserect force_use_mouse -= 1 set_keymap 1, .keymap setkeys #IFDEF IS_GAME IF .resolution_was_unlocked = NO THEN IF gam.ingame THEN set_resolution(gen(genResolutionX), gen(genResolutionY)) lock_resolution END IF #ENDIF set_animation_framerate(.anim_framerate) use_speed_control = .use_speed_control vpage = .vpage dpage = .dpage END WITH REDIM PRESERVE gfxio_state_stack(-1 TO UBOUND(gfxio_state_stack) - 1) END SUB SUB save_window_state_to_config () DIM winstate as WindowState ptr = gfx_getwindowstate() IF winstate->structsize >= 4 ANDALSO winstate->fullscreen THEN EXIT SUB END IF IF winstate->structsize >= 9 ANDALSO winstate->maximised THEN 'Don't save window size: it would go slightly over the screen edge rather than 'properly maximised (though if there were a gfx function to maximise, we could 'start maximised). And if we don't save the size, better not save zoom either 'unless we bound the total size. EXIT SUB END IF IF winstate->structsize >= 8 THEN 'Do this even if overrode_default_zoom write_config(exe_prefix & "gfx.zoom", winstate->zoom) END IF IF gfx_supports_variable_resolution() THEN WITH get_resolution() write_config(exe_prefix & "gfx.resolution_w", .w) write_config(exe_prefix & "gfx.resolution_h", .h) END WITH END IF END SUB '========================================================================================== ' debug logs '========================================================================================== ' If c/g_debug.txt already exists, archive it and create a new one. ' title is what message to write at the top SUB start_new_debug(title as string) os_close_logfile DIM as string logfile, archivefile logfile = log_dir & *app_log_filename archivefile = log_dir & *app_archive_filename ' Don't archive if we're already writing to this logfile IF lastlogfile <> absolute_path(logfile) THEN IF isfile(logfile) THEN archive_log_file logfile, archivefile END IF IF LEN(log_buffer) THEN ' Write internal buffer, which contains a lot of useful info printed during startup. append_to_logfile log_buffer END IF IF num_log_buffer_errors = num_logged_errors ANDALSO LEN(lastlogfile) > 0 THEN 'If errors, if any, only occurred during startup and are already saved 'in a different log file, then we don't need to mark this new one 'to be preserved. importantdebug = NO END IF num_logged_errors = num_log_buffer_errors 'num_log_buffer_errors doesn't get reset, because log_buffer doesn't. END IF debuginfo " ----" & title & "----" os_open_logfile logfile END SUB ' Append logfile to archivefile and delete it. LOCAL SUB archive_log_file(logfile as string, archivefile as string) '(Don't call log_openfile) DIM dlog as integer = FREEFILE OPEN logfile FOR BINARY as dlog DIM archive as integer = FREEFILE OPEN archivefile FOR BINARY as archive CONST buflen = 128 * 1024 DIM as ubyte ptr buf = ALLOCATE(buflen) DIM copyamount as size_t = bound(buflen - LOF(dlog), 0, LOF(archive)) IF copyamount THEN SEEK #archive, LOF(archive) - copyamount + 1 'don't cut the file in the middle of a line DO GET #archive, , buf[0] LOOP UNTIL buf[0] = 10 GET #archive, , buf[0], buflen, copyamount END IF CLOSE #archive archive = FREEFILE OPEN archivefile FOR BINARY ACCESS WRITE as archive PUT #archive, , *buf, copyamount IF LOF(dlog) > buflen THEN SEEK #dlog, LOF(dlog) - buflen + 1 DO GET #dlog, , buf[0] LOOP UNTIL buf[0] = 10 END IF GET #dlog, , buf[0], buflen, copyamount PUT #archive, , LINE_END " +++|=========> APPLY SWORD, CUT HERE (Please send whole sections)" LINE_END LINE_END PUT #archive, , *buf, copyamount CLOSE #dlog CLOSE #archive DEALLOCATE(buf) safekill logfile END SUB ' Delete the log file if there were no important error messages. SUB end_debug os_close_logfile IF NOT importantdebug THEN safekill log_dir & *app_log_filename lastlogfile = "" log_buffer &= "end_debug: no debug/error messages during startup (skipping rest of startup)" LINE_END ELSE 'Remember not to archive the log if we restart the log in the same directory lastlogfile = absolute_path(log_dir & *app_log_filename) END IF END SUB SUB debug (msg as const zstring ptr) importantdebug = YES num_logged_errors += 1 IF remember_debug_messages THEN num_log_buffer_errors += 1 END IF debuginfo "! " & *msg END SUB LOCAL FUNCTION get_timestamp() as string IF program_start_timer <> 0.0 THEN RETURN strprintf("%4.1f ", TIMER - program_start_timer) RETURN "" END FUNCTION EXTERN "C" 'A debug message which is only logged/printed once. Use if would otherwise be to spammy. 'You don't have to use this instead of showerror/showbug, because those 'always give the user the option of silencing a message (it won't even be logged), 'but you can if you want to save the user the trouble of ignoring. SUB onetime_debug (errorlevel as errorLevelEnum = errDebug, msg as const zstring ptr) STATIC silenced_messages() as string IF a_find(silenced_messages(), *CAST(zstring ptr, msg)) <> -1 THEN EXIT SUB 'Mustn't call debugc here. Instead give debugc_internal no callsite so can't ignore. debugc_internal NULL, errorlevel, msg a_append silenced_messages(), *msg END SUB SUB debugc_internal (callsite as any ptr, errorlevel as errorLevelEnum, s as const zstring ptr) 'This both provides a C interface to 'debug', and error levels to distinguish the significance of 'different messages 'See enum in const.bi for error level details 'Note: this is called by the debugc wrapper function in miscc.c, which adds the callsite argument '(which we can only obtain in C), which is used by errShowBug and errShowError to ignore certain 'debugc invocations. SELECT CASE errorlevel CASE errInfo 'aka debuginfo debuginfo *s CASE errShowInfo debuginfo *s notification *s + !"\nPress any key..." CASE errDebug 'aka debug debug *s CASE errShowDebug 'aka visible_debug visible_debug *s CASE errError 'aka debugerror debugerror *s CASE errBug debug "(BUG) " & *s CASE errShowError 'aka showerror showerror_internal callsite, *s CASE errShowBug 'aka showbug showerror_internal callsite, *s, NO, YES CASE errFatalError 'aka fatalerror showerror_internal callsite, *s, YES, NO CASE errFatalBug 'aka fatalbug showerror_internal callsite, *s, YES, YES CASE errDie PRINT "DIE: " & *s debug "DIE: " & *s 'It's arguable whether this is a bug and should attempt to report or not. 'But it's basically a crash, so let's say yes. IF reported_a_bug = NO THEN send_bug_report s fatal_error_shutdown END SELECT END SUB 'This is a kludge (the whole debug logging system is a mess)... debuginfo 'replacement before start_new_debug has been called, to avoid junk ending up in '?_debug_archive.txt when start_new_debug is called. SUB early_debuginfo (msg as const zstring ptr) external_log msg IF debug_to_console THEN PRINT *msg DIM tagged_msg as string = get_timestamp() & *msg log_buffer &= tagged_msg & LINE_END END SUB END EXTERN SUB debuginfo (msg as const zstring ptr) 'Use for throwaway messages like upgrading '(Also this is internally the implementation of debug()) 'If the mutex hasn't been created yet this is a noop 'mutexlock debug_log_mutex 'For now, on Android log everything to the kernel log for convenience external_log msg DIM tagged_msg as string = get_timestamp() & *msg IF debug_to_console THEN PRINT tagged_msg IF remember_debug_messages THEN 'Don't keep growing the buffer or the program will grind to a halt IF LEN(log_buffer) < 10000 THEN log_buffer &= tagged_msg & LINE_END END IF append_to_logfile tagged_msg 'mutexunlock debug_log_mutex END SUB LOCAL FUNCTION open_logfile() as integer STATIC sizeerror as bool = NO DIM filename as string = log_dir & *app_log_filename DIM fh as integer = FREEFILE IF OPEN(filename FOR APPEND as #fh) THEN external_log "Couldn't open debug log " & filename PRINT "Couldn't open debug log " & filename RETURN 0 END IF IF LOF(fh) > 2 * 1024 * 1024 THEN IF sizeerror = NO THEN PRINT #fh, "too much debug() output, not printing any more messages" sizeerror = YES CLOSE #fh RETURN 0 END IF sizeerror = NO RETURN fh END FUNCTION LOCAL SUB append_to_logfile(s as string) DIM fh as integer = open_logfile() IF fh = 0 THEN EXIT SUB PRINT #fh, normalize_newlines(s, LINE_END) CLOSE #fh END SUB 'Print a RELOAD node tree to the debug log as XML. 'Note: this doesn't behave the same as debug(), as it doesn't 'print to the console, to the android log, and to log_buffer. SUB debug_reload(nod as Node ptr) DIM fh as integer = open_logfile() IF fh = 0 THEN EXIT SUB PRINT #fh, get_timestamp(), IF nod = NULL THEN PRINT #fh, "[NULL Node]" ELSE Reload.SerializeXML nod, fh, YES, YES 'Don't print very long strings in full END IF CLOSE #fh importantdebug = YES 'Preserve ?_debug.txt END SUB '========================================================================================== ' Text markup '========================================================================================== 'Wrap a string in colour tags. Default to flashing. FUNCTION hilite(what as string, col as integer = -1) as string IF col = -1 THEN col = uilook(uiSelectedItem + global_tog) 'IF col = -1 THEN col = uilook(IIF(global_tog, uiSelectedItem, uiHighlight2)) RETURN "${K" & col & "}" & what & "${K-1}" END FUNCTION ' Takes "a string with `certain` parts marked to be `High`lighted" with colour 'col' ' and returns a marked-up string. FUNCTION ticklite(what as string, col as integer = -1) as string IF col = -1 THEN col = uilook(uiSelectedItem + global_tog) DIM ret as string DIM index as integer DIM lastindex as integer = 1 DIM inside_hilite as bool = NO ' Already opened a highlight tag DO index = INSTR(lastindex, what, "`") IF index = 0 THEN RETURN ret & MID(what, lastindex) 'Add the final part ret &= MID(what, lastindex, index - lastindex) IF inside_hilite THEN ret &= "${K-1}" ELSE ret &= "${K" & col & "}" inside_hilite XOR= YES lastindex = index + 1 LOOP END FUNCTION #IFDEF __FB_MAIN__ startTest(ticklite) uilook(uiSelectedItem) = 2 uilook(uiSelectedItem + 1) = 2 IF ticklite("`Test`f`x``") <> "${K2}Test${K-1}f${K2}x${K-1}${K2}" THEN fail endTest #ENDIF 'Return the markup tag to switch foreground color. -1 resets to initial. 'Optionally, if you pass a string, wraps it with start/reset color tags. 'Redundant to fgcol_text FUNCTION fgtag(col as integer, text as string = "") as string IF LEN(text) THEN RETURN "${K" & col & "}" & text & "${K-1}" ELSE RETURN "${K" & col & "}" END IF END FUNCTION 'Return the markup tag to switch background color (0 is transparent). -1 resets to initial. 'Optionally, if you pass a string, wraps it with start/reset color tags. 'Redundant to bgcol_text FUNCTION bgtag(col as integer, text as string = "") as string IF LEN(text) THEN RETURN "${KB" & col & "}" & text & "${KB-1}" ELSE RETURN "${KB" & col & "}" END IF END FUNCTION '========================================================================================== ' notification '========================================================================================== 'See also pop_warning 'Draw a wrapped string in a box, by default at the middle of the page. 'You can optionally specify a maximum width (default whole screen) 'If shrink=NO then the textbox extends to maximum width, otherwise its width is minimal. 'Returns the position of the bottom of the box. FUNCTION basic_textbox (msg as zstring ptr, col as integer = -1, page as integer, ypos as RelPos = pCentered, width as RelPos = -1, shrink as bool = NO, suppress_borders as bool = NO, fontnum as integer = fontEdged) as integer IF col = -1 THEN col = uilook(uiText) IF width = -1 THEN width = small(vpages(page)->w - 20, 450) DIM size as XYPair = textsize(*msg, width, fontEdged) ypos = relative_pos(ypos, vpages(page)->h, size.h) ypos = large(6, ypos) DIM text_xpos as RelPos = pCentered IF shrink = NO THEN size.w = relative_pos(width, vpages(page)->w) text_xpos = rCenter - size.w \ 2 END IF edgeboxstyle pCentered, ypos - 5, size.w + 10, size.h + 10, 2, page, , suppress_borders wrapprint *msg, text_xpos, ypos, col, page, width /'- rCenter + size.w \ 2'/, , fontnum RETURN ypos + size.h + 10 END FUNCTION ' Show a message in a box and wait for the user to advance with a keypress. ' Returns the scancode of the keypress (it is cleared!) FUNCTION notification (msg as zstring ptr, shrink as bool = NO) as KBScancode ' Allow reentering a few times - for example use of F9 global menu in Custom ' might harmlessly result in reentering - but stop any infinite loop. STATIC entered as integer = 0 IF entered >= 5 THEN showbug !"notification() reentered excessively, with message:\n" & *msg RETURN 0 END IF entered += 1 ensure_normal_palette DIM prev_mouse_vis as CursorVisibility = getcursorvisibility() defaultmousecursor DIM holdpage as integer = allocatepage copypage vpage, holdpage basic_textbox msg, uilook(uiText), holdpage, , , shrink setvispage holdpage setkeys DIM scancode as KBScancode = waitforanykey() freepage holdpage restore_previous_palette setcursorvisibility(prev_mouse_vis) entered -= 1 RETURN scancode END FUNCTION '========================================================================================== ' fixbits & prefbits '========================================================================================== LOCAL SUB load_fixbits_cache () DIM fh as integer ' No error if missing IF OPENFILE(workingdir + SLASH + "fixbits.bin", FOR_BINARY + ACCESS_READ, fh) = fberrOK THEN REDIM fixbits_cache(LOF(fh)) 'dim 1 larger than file - doesn't matter DIM bytesread as size_t GET #fh, , fixbits_cache(), , bytesread IF bytesread <> LOF(fh) THEN showerror "Couldn't read fixbits! Data will load corrupted" CLOSE #fh ELSE REDIM fixbits_cache(0) END IF fixbits_cache_loaded = YES END SUB SUB clear_fixbits_cache () fixbits_cache_loaded = NO END SUB 'Returns 0 or 1, not NO/YES! FUNCTION getfixbit(byval bitnum as integer) as integer BUG_IF(bitnum < 0, "Bad fixbit " & bitnum, 0) IF fixbits_cache_loaded = NO THEN load_fixbits_cache IF bitnum >= UBOUND(fixbits_cache) * 8 THEN RETURN 0 RETURN BIT(fixbits_cache(bitnum \ 8), bitnum MOD 8) END FUNCTION SUB setfixbit(byval bitnum as integer, byval bitval as integer) IF bitnum >= sizeFixBits THEN fatalbug "setfixbit(" & bitnum & "): sizefixbits wrong!" DIM f as string f = workingdir + SLASH + "fixbits.bin" DIM fh as integer IF OPENFILE(f, FOR_BINARY + ACCESS_READ_WRITE, fh) THEN fatalerror "Impossible to upgrade game: Could not write " & f 'Really bad! extendfile fh, (bitnum \ 8) + 1 'Prevent writing garbage DIM ub as UBYTE GET #fh, (bitnum \ 8) + 1, ub IF bitval THEN ub = BITSET(ub, bitnum MOD 8) ELSE ub = BITRESET(ub, bitnum MOD 8) PUT #fh, (bitnum \ 8) + 1, ub CLOSE #fh clear_fixbits_cache END SUB 'Value of a general preference/backcompat bitset FUNCTION prefbit(bitnum as integer) as bool DIM genidx as integer = IIF(bitnum >= 48, genBits3, IIF(bitnum >= 16, genBits2, genBits)) DIM bitidx as integer = IIF(bitnum >= 48, bitnum - 48, IIF(bitnum >= 16, bitnum - 16, bitnum)) RETURN xreadbit(gen(), bitidx, genidx) END FUNCTION 'Set a general preference/backcompat bitset SUB setprefbit(bitnum as integer, newval as bool = YES) DIM genidx as integer = IIF(bitnum >= 48, genBits3, IIF(bitnum >= 16, genBits2, genBits)) DIM bitidx as integer = IIF(bitnum >= 48, bitnum - 48, IIF(bitnum >= 16, bitnum - 16, bitnum)) setbit gen(), genidx, bitidx, newval END SUB '========================================================================================== ' Styled boxes '========================================================================================== 'All of the following require a box style rather than color, border, etc. 'Backwards compatibility wrapper 'x and y default to center of the screen 'This is equivalent to calling edgeboxstyle with ancCenter added to x/y SUB centerbox (x as RelPos=rCenter, y as RelPos=rCenter, w as RelPos, h as RelPos, boxstyle_plus1 as integer, page as integer) center_edgeboxstyle x, y, w, h, boxstyle_plus1 - 1, page END SUB SUB centerfuz (x as RelPos, y as RelPos, w as RelPos, h as RelPos, boxstyle_plus1 as integer, page as integer) center_edgeboxstyle x, y, w, h, boxstyle_plus1 - 1, page, YES END SUB 'boxstyle must be >= 0 SUB center_edgeboxstyle (x as RelPos=rCenter, y as RelPos=rCenter, w as RelPos, h as RelPos, boxstyle as integer, page as integer, fuzzy as bool=NO, suppress_borders as bool=NO) w = relative_pos(w, vpages(page)->w) h = relative_pos(h, vpages(page)->h) edgeboxstyle x - w \ 2, y - h \ 2, w, h, boxstyle, page, fuzzy, suppress_borders END SUB SUB edgeboxstyle (rect as RectType, boxstyle as integer, page as integer, fuzzy as bool=NO, suppress_borders as bool=NO) edgeboxstyle rect.x, rect.y, rect.wide, rect.high, boxstyle, page, fuzzy, suppress_borders END SUB SUB edgeboxstyle (x as RelPos, y as RelPos, w as RelPos, h as RelPos, boxstyle as integer, page as integer, fuzzy as bool=NO, suppress_borders as bool=NO) IF boxstyle < 0 OR boxstyle > UBOUND(boxlook) THEN showerror "edgeboxstyle: invalid boxstyle " & boxstyle EXIT SUB END IF DIM col as integer = boxlook(boxstyle).bgcol DIM bordercol as integer = boxlook(boxstyle).edgecol DIM border as RectBorderTypes = boxstyle DIM trans as RectTransTypes = transOpaque IF suppress_borders THEN border = borderLine IF fuzzy THEN trans = transFuzzy edgebox x, y, w, h, col, bordercol, page, trans, border END SUB 'Convert from box style to box border spriteset, or -1 or -2 FUNCTION lookup_box_border(border as RectBorderTypes) as RectBorderTypes IF border < 0 THEN RETURN border IF border <= UBOUND(boxlook) THEN RETURN boxlook(border).border - 1 debug "bad box border " & border RETURN 0 END FUNCTION '========================================================================================== ' Unstyled boxes '========================================================================================== 'The following take col/bgcol/border instead of a box style number SUB edgebox (x as RelPos, y as RelPos, w as RelPos, h as RelPos, col as integer, bordercol as integer, page as integer, trans as RectTransTypes=transOpaque, border as RectBorderTypes=borderLine) '--border: -2 is none, -1 is simple line, 0+ is styled box edge DIM borderindex as RectBorderTypes = lookup_box_border(border) DIM fr as Frame ptr = vpages(page) w = relative_pos(w, fr->w) h = relative_pos(h, fr->h) x = relative_pos(x, fr->w, w) y = relative_pos(y, fr->h, h) draw_box_back fr, XY(x, y), XY(w, h), col, trans draw_box_border fr, XY(x, y), XY(w, h), bordercol, borderindex, trans END SUB SUB draw_box_back (fr as Frame ptr, pos as XYPair, size as XYPair, col as integer, trans as RectTransTypes, fuzzfactor as integer=50, fuzz_stationary as bool=NO, fuzz_zoom as integer=1) IF trans = transFuzzy THEN fuzzyrect(fr, XY_WH(pos, size), col, fuzzfactor, fuzz_stationary, fuzz_zoom) ELSEIF trans = transOpaque THEN rectangle(fr, XY_WH(pos, size), col) ELSEIF trans = transBlend THEN trans_rectangle(fr, XY_WH(pos, size), curmasterpal(col), fuzzfactor / 100.) 'ELSEIF trans = transHollow THEN END IF END SUB SUB draw_box_border (fr as Frame ptr, pos as XYPair, size as XYPair, bordercol as integer, borderindex as RectBorderTypes, trans as RectTransTypes = transHollow) DIM as integer x = pos.x, y = pos.y, w = size.w, h = size.h IF w < 0 THEN x = x + w + 1: w = -w IF h < 0 THEN y = y + h + 1: h = -h IF borderindex = borderLine THEN '--Simple line border drawbox fr, x, y, w, h, bordercol ELSEIF borderindex >= 0 AND borderindex <= gen(genMaxBoxBorder) THEN '--Normal Border IF trans <> transHollow THEN drawbox fr, x, y, w, h, bordercol DIM border_gfx as GraphicPair load_sprite_and_pal border_gfx, sprTypeBoxBorder, borderindex WITH border_gfx IF .sprite THEN ' Only proceed if a sprite is actually selected 'Draw edges DIM byref cliprect as ClipState = get_cliprect(fr) DIM oldclip as ClipState = cliprect '--Top and bottom edges FOR i as integer = x + 8 TO x + w - 24 STEP 16 shrinkclip , , , y + h - 1 frame_draw .sprite + 2, .pal, i, y - 8, , fr cliprect = oldclip shrinkclip , y, , frame_draw .sprite + 13, .pal, i, y + h - 8, , fr cliprect = oldclip NEXT i '--Left and right edges FOR i as integer = y + 8 TO y + h - 24 STEP 16 shrinkclip , , x + w - 1, frame_draw .sprite + 7, .pal, x - 8, i, , fr cliprect = oldclip shrinkclip x, , , frame_draw .sprite + 8, .pal, x + w - 8, i, , fr cliprect = oldclip NEXT i 'Draw end-pieces IF w > 26 THEN '--Top end pieces shrinkclip , , , y + h - 1 frame_draw .sprite + 3, .pal, x + w - 24, y - 8, , fr frame_draw .sprite + 1, .pal, x + 8, y - 8, , fr cliprect = oldclip '--Bottom end pieces shrinkclip , y, , frame_draw .sprite + 14, .pal, x + w - 24, y + h - 8, , fr frame_draw .sprite + 12, .pal, x + 8, y + h - 8, , fr cliprect = oldclip ELSEIF w > 16 THEN '--Not enough space for the end pieces, have to draw part of the edge after all '--Top and bottom edges shrinkclip x + 8, , x + w - 9, y + h - 1 frame_draw .sprite + 2, .pal, x + 8, y - 8, , fr cliprect = oldclip shrinkclip x + 8, y, x + w - 9, frame_draw .sprite + 13, .pal, x + 8, y + h - 8, , fr cliprect = oldclip END IF IF h > 26 THEN '--Left side end pieces shrinkclip , , x + w - 1, frame_draw .sprite + 9, .pal, x - 8, y + h - 24, , fr frame_draw .sprite + 5, .pal, x - 8, y + 8, , fr cliprect = oldclip '--Right side end pieces shrinkclip x, , , frame_draw .sprite + 10, .pal, x + w - 8, y + h - 24, , fr frame_draw .sprite + 6, .pal, x + w - 8, y + 8, , fr cliprect = oldclip ELSEIF h > 16 THEN '--Not enough space for the end pieces, have to draw part of the edge after all '--Left and right edges shrinkclip , y + 8, x + w - 1, y + h - 9 frame_draw .sprite + 7, .pal, x - 8, y + 8, , fr cliprect = oldclip shrinkclip x, y + 8, , y + h - 9 frame_draw .sprite + 8, .pal, x + w - 8, y + 8, , fr cliprect = oldclip END IF 'Draw corners 'If the box is really tiny, we need to only draw part of each corner shrinkclip , , x + w - 1, y + h - 1 frame_draw .sprite, .pal, x - 8, y - 8, , fr cliprect = oldclip shrinkclip x, , , y + h - 1 frame_draw .sprite + 4, .pal, x + w - 8, y - 8, , fr cliprect = oldclip shrinkclip , y, x + w - 1, frame_draw .sprite + 11, .pal, x - 8, y + h - 8, , fr cliprect = oldclip shrinkclip x, y, , frame_draw .sprite + 15, .pal, x + w - 8, y + h - 8, , fr cliprect = oldclip END IF END WITH unload_sprite_and_pal border_gfx END IF END SUB '========================================================================================== ' Script names & IDs '========================================================================================== ' Given a trigger or script ID, return a script ID. If the script is missing ' show an error (Game only) if showerr, and return 0. FUNCTION decodetrigger (trigger as integer, showerr as bool = YES) as integer 'debug "decoding " + STR(trigger) IF trigger >= 16384 ANDALSO trigger - 16384 <= UBOUND(lookup1_bin_cache) THEN WITH lookup1_bin_cache(trigger - 16384) 'debug " id " & .id & " name " & .name #ifdef IS_GAME IF .id = 0 ANDALSO showerr THEN ' Not an error in Custom as we're not trying to actually run it scripterr "Tried to use script '" + .name + "' but none with that name. (It was missing last time scripts were re-imported. Use ""Find broken script triggers"" in the editor.)", serrMajor END IF #endif RETURN .id END WITH ELSE RETURN trigger END IF END FUNCTION 'A script trigger which has a default value, such the onkeypress trigger FUNCTION trigger_or_default(trigger as integer, default as integer) as integer IF trigger < 0 THEN RETURN 0 IF trigger = 0 THEN RETURN default RETURN trigger END FUNCTION ' Find the name of a script given ID number or trigger ID. ' If called with an invalid script id, the result will be "[id ###]" FUNCTION scriptname (id_or_trigger as integer) as string IF id_or_trigger = 0 THEN RETURN "[none]" ELSE DIM idx as integer = a_find(script_names(), id_or_trigger) IF idx > -1 THEN RETURN script_names(idx).s RETURN "[id " & id_or_trigger & "]" END IF END FUNCTION ' 0 means use default_trigger, -1 means none FUNCTION scriptname_default(id_or_trigger as integer, default_trigger as integer) as string IF id_or_trigger = -1 THEN RETURN "[none]" IF id_or_trigger = 0 THEN IF default_trigger = 0 THEN RETURN "[default: none]" RETURN "[default] " & scriptname(default_trigger) END IF RETURN scriptname(id_or_trigger) END FUNCTION '========================================================================================== ' Default palettes '========================================================================================== FUNCTION getdefaultpal(byval fileset as SpriteType, byval index as integer) as integer IF fileset < 0 OR fileset > sprTypeLastPT THEN debugc errBug, "getdefaultpal: bad fileset " & fileset RETURN -1 END IF /' IF LEN(game) THEN 'Read from spriteset 'defpal#.bin will be obsoleted, and default palettes stored in .rgfx. 'Unfortunately some spritesets are missing their default palettes due to a bug. DIM fr as Frame ptr = frame_load(fileset, index) IF fr THEN DIM ret as integer = fr->defpal frame_unload @fr IF ret > -1 THEN RETURN ret END IF END IF '/ DIM as string lumpsdir, fname ' Use a default if no game has been loaded lumpsdir = IIF(LEN(game), workingdir, finddatadir("defaultgfx")) fname = lumpsdir & SLASH & "defpal" & fileset & ".bin" DIM fh as integer IF OPENFILE(fname, FOR_BINARY + ACCESS_READ, fh) = 0 THEN DIM v as short GET #fh, 1 + index * 2, v LAZYCLOSE fh RETURN v ELSE 'currently extended NPCs palettes are initialised to -1, which means lots of debug spam in old games 'debug "Default palette file " & fname & " does not exist" RETURN -1 END IF END FUNCTION FUNCTION abs_pal_num(byval num as integer, byval sprtype as SpriteType, byval spr as integer) as integer IF num >= 0 THEN RETURN num IF num = -1 THEN RETURN getdefaultpal(sprtype, spr) debug "decode_default_pal: invalid palette " & num RETURN 0 END FUNCTION SUB loaddefaultpals(byval fileset as SpriteType, poffset() as integer) DIM v as short DIM f as string = workingdir & SLASH & "defpal" & fileset & ".bin" DIM fh as integer IF OPENFILE(f, FOR_BINARY + ACCESS_READ, fh) = 0 THEN FOR i as integer = 0 to UBOUND(poffset) GET #fh, 1 + i * 2, v poffset(i) = v NEXT i LAZYCLOSE fh ELSE guessdefaultpals fileset, poffset() END IF END SUB 'Only poffset(0) .. poffset(sets) are actually saved '(TODO: this is due to old spriteset browser nonsense and can be removed soon) SUB savedefaultpals(byval fileset as SpriteType, poffset() as integer, maxset as integer) DIM v as short DIM f as string = workingdir & SLASH & "defpal" & fileset & ".bin" DIM fh as integer OPENFILE(f, FOR_BINARY + ACCESS_WRITE, fh) FOR i as integer = 0 TO maxset v = poffset(i) PUT #fh, 1 + i * 2, v NEXT i CLOSE #fh END SUB SUB guessdefaultpals(byval fileset as SpriteType, poffset() as integer) DIM her as HeroDef DIM found as integer flusharray poffset() SELECT CASE fileset CASE 0 'Heroes FOR j as integer = 0 TO gen(genMaxHero) loadherodata her, j IF her.sprite >= 0 AND her.sprite <= UBOUND(poffset) THEN poffset(her.sprite) = her.sprite_pal NEXT CASE 1 TO 3 'Enemies 'Inefficient DIM enemy as EnemyDef FOR j as integer = 0 TO gen(genMaxEnemy) loadenemydata enemy, j, NO IF enemy.size + 1 = fileset THEN IF enemy.pic >= 0 AND enemy.pic <= UBOUND(poffset) THEN poffset(enemy.pic) = enemy.pal END IF NEXT j CASE 4 'Walkabouts FOR j as integer = 0 TO gen(genMaxHero) loadherodata her, j IF her.walk_sprite >= 0 AND her.walk_sprite <= UBOUND(poffset) THEN poffset(her.walk_sprite) = her.walk_sprite_pal END IF NEXT j REDIM npcbuf(0) as NPCType FOR mapi as integer = 0 TO gen(genMaxMap) LoadNPCD maplumpname(mapi, "n"), npcbuf() FOR j as integer = 0 to UBOUND(npcbuf) IF npcbuf(j).picture >= 0 AND npcbuf(j).picture <= UBOUND(poffset) THEN poffset(npcbuf(j).picture) = npcbuf(j).palette END IF NEXT j NEXT mapi CASE 5 'Weapons REDIM buf(dimbinsize(binITM)) as integer FOR j as integer = 0 TO gen(genMaxItem) loaditemdata buf(), j IF item_is_equippable_in_slot(buf(), 0) THEN IF buf(52) >= 0 AND buf(52) <= UBOUND(poffset) THEN poffset(buf(52)) = buf(53) END IF NEXT CASE 6 'Attacks REDIM buf(40 + dimbinsize(binATTACK)) as integer FOR j as integer = 0 TO gen(genMaxAttack) loadattackdata buf(), j IF buf(0) >= 0 AND buf(0) <= UBOUND(poffset) THEN poffset(buf(0)) = buf(1) NEXT CASE ELSE 'Portraits and later 'Default palettes were implemented before portraits, so this can only be called 'the first time you ever open the portrait editor in an old game -- no point 'implementing this END SELECT END SUB '========================================================================================== ' binsize.bin '========================================================================================== ' Returns the default record size in BYTES to use for getbinsize() when binsize.bin is missing FUNCTION defbinsize (byval id as integer) as integer IF id = binATTACK THEN RETURN 0 'attack.bin IF id = binSTF THEN RETURN 64 '.stf IF id = binSONGDATA THEN RETURN 0 'songdata.bin IF id = binSFXDATA THEN RETURN 0 'sfxdata.bin IF id = binMAP THEN RETURN 40 '.map IF id = binMENUS THEN RETURN 0 'menus.bin IF id = binMENUITEM THEN RETURN 0 'menuitem.bin IF id = binUICOLORS THEN RETURN 0 'uicolors.bin IF id = binSAY THEN RETURN 400 '.say IF id = binN THEN RETURN 30 '.n## IF id = binDT0 THEN RETURN 636 '.dt0 IF id = binDT1 THEN RETURN 320 '.dt1 IF id = binITM THEN RETURN 200 '.itm IF id = binTAP THEN RETURN 40 '.tap RETURN 0 END FUNCTION ' Returns the native size in BYTES of the records for the version you are running FUNCTION curbinsize (byval id as integer) as integer IF id = binATTACK THEN RETURN 632 'attack.bin '(size of combined attack data as on DT6 page minus 80) IF id = binSTF THEN RETURN 84 '.stf IF id = binSONGDATA THEN RETURN 32 'songdata.bin IF id = binSFXDATA THEN RETURN 34 'sfxdata.bin IF id = binMAP THEN RETURN 764 '.map IF id = binMENUS THEN RETURN 56 'menus.bin IF id = binMENUITEM THEN RETURN 68 'menuitem.bin IF id = binUICOLORS THEN RETURN 126 'uicolors.bin IF id = binSAY THEN RETURN 422 '.say IF id = binN THEN RETURN 38 '.n## IF id = binDT0 THEN RETURN 858 '.dt0 IF id = binDT1 THEN RETURN 744 '.dt1 IF id = binITM THEN RETURN 480 '.itm IF id = binTAP THEN RETURN 314 '.tap RETURN 0 END FUNCTION LOCAL SUB load_binsize_cache () FOR i as integer = 0 TO binLASTENTRY binsize_cache(i) = defbinsize(i) NEXT DIM fh as integer ' No error if missing IF OPENFILE(workingdir + SLASH + "binsize.bin", FOR_BINARY + ACCESS_READ, fh) = fberrOK THEN DIM as short recordsize ' If binsize.bin is larger than expected that is reported in rpg_sanity_checks DIM as integer recs = LOF(fh) \ 2 FOR id as integer = 0 TO small(binLASTENTRY, recs - 1) GET #fh, 1 + id * 2, recordsize binsize_cache(id) = recordsize NEXT CLOSE #fh END IF binsize_cache_loaded = YES END SUB SUB clear_binsize_cache () binsize_cache_loaded = NO END SUB FUNCTION getbinsize (byval id as integer) as integer 'returns the current size in BYTES of the records in the specific binary file you are working with BUG_IF(id < 0 ORELSE id > binLASTENTRY, "Request for unknown binsize entry " & id, 0) IF binsize_cache_loaded = NO THEN load_binsize_cache RETURN binsize_cache(id) END FUNCTION 'INTS, not bytes! FUNCTION dimbinsize (byval id as integer) as integer 'curbinsize is size supported by current version of engine 'getbinsize is size of records in RPG file dimbinsize = large(curbinsize(id), getbinsize(id)) \ 2 - 1 END FUNCTION SUB setbinsize (byval id as integer, byval size as integer) BUG_IF(id < 0 ORELSE id > binLASTENTRY, "Unknown binsize entry " & id) DIM fh as integer IF OPENFILE(workingdir & SLASH & "binsize.bin", FOR_BINARY + ACCESS_READ_WRITE, fh) THEN showerror "Failed to write binsize.bin(" & id & "), this will definitely cause data corruption!!" RETURN END IF DIM dat as short = size PUT #fh, 1 + id * 2, dat CLOSE #fh binsize_cache(id) = size END SUB '========================================================================================== ' Error display '========================================================================================== 'Wrapper around SYSTEM - you should usually instead call exitprogram/cleanup_and_terminate 'to cleanly quit Game/Custom respectively, or fatal_error_shutdown for unclean quit. SUB terminate_program(retval as integer = 0) IF retval = 0 THEN end_debug close_lazy_files 'Only needed to avoid "Double close" warnings SYSTEM retval END SUB SUB fatal_error_shutdown #IFDEF IS_GAME exitprogram NO, 1 #ELSE #IFDEF IS_CUSTOM IF cleanup_workingdir_on_error ANDALSO LEN(workingdir) ANDALSO isdir(workingdir) THEN touchfile workingdir & SLASH & "__danger.tmp" killdir workingdir END IF #ENDIF closemusic restoremode terminate_program 1 #ENDIF END SUB 'The following wrapper functions aren't in miscc.c because they aren't ignorable errors, so we 'don't need to know the 'callsite' for them SUB visible_debug (msg as const zstring ptr) 'equivalent to: debugc errShowDebug, msg debug *msg notification *msg + !"\nPress any key..." END SUB SUB debugerror (msg as const zstring ptr) 'equivalent to: debugc errError, msg debug "Error: " & *msg END SUB SUB fatalerror (msg as const zstring ptr) 'equivalent to: debugc errFatalError, msg showerror msg, YES END SUB SUB fatalbug (msg as const zstring ptr) 'equivalent to: debugc errFatalBug, msg showerror msg, YES, YES END SUB 'showerror and showbug are wrapped in miscc.c, so that they can pass the callsite '(which we can only obtain in C) to showerror_internal, which is needed to ignore 'certain invocations EXTERN "C" 'Show an error. 'If multiple errors occur, give the user the option to quit instead of continuing. 'callsite: some pointer which uniquely identifies this particular call, e.g. return address. ' May be NULL if unknown (in which case the error can't be ignored). 'isfatal: end the program, never return. 'isbug: this error is a bug, so possibly try to report it. SUB showerror_internal (callsite as any ptr, zmsg as const zstring ptr, byval isfatal as bool = NO, isbug as bool = NO) STATIC num_ignored_callsites as integer STATIC ignored_callsites(9) as any ptr 'list of callsites IF isfatal = NO ANDALSO callsite THEN FOR idx as integer = 0 TO num_ignored_callsites - 1 IF callsite = ignored_callsites(idx) THEN EXIT SUB NEXT END IF DIM reported_this_bug as bool DIM saved_backtrace as bool IF isbug ANDALSO reported_a_bug = NO THEN 'Attempt to prompt the users to send a bug report (currently, using CrashRpt), 'but not if we've already done so; that would be annoying. reported_this_bug = send_bug_report(zmsg) reported_a_bug = reported_this_bug 'If we couldn't do that, try to save a backtrace to the debug log (this 'usually only does anything on Linux). May be skipped if already done. IF reported_this_bug = NO THEN saved_backtrace = save_backtrace() END IF DIM printmsg as string printmsg = IIF(isbug, "(BUG) ", "") + IIF(isfatal, "FATAL: ", "ERROR: ") + *zmsg 'Don't use PRINT, doesn't go to the terminal under gfx_fb 'also printing to stdout doesn't work on android 'MBG - this causes trouble, maybe due to define of stderr to __iob_func but it looks buggier than that #IF NOT (DEFINED(__FB_ANDROID__) OR DEFINED(__FB_BLACKBOX__)) fprintf(stderr, !"%s\n", STRPTR(printmsg)) #ENDIF STATIC last_error as string DIM msg as string = RTRIM(*zmsg, !"\n") 'Don't allow reentry into showerror; the error might be in debug() STATIC entered as integer = 0 IF entered THEN IF isfatal AND entered = 1 THEN entered = 2 fatal_error_shutdown END IF EXIT SUB END IF entered = 1 debug printmsg IF modex_initialised = NO ORELSE LEN(gfxbackend) = 0 THEN debug "showerror: no display" IF isfatal THEN fatal_error_shutdown EXIT SUB END IF 'Don't reenter the graphics backend either - if gfxmutex is already 'held then we would deadlock on trying to aquire it. IF main_thread_in_gfx_backend THEN debug "showerror: avoiding gfx backend rentry" IF isfatal THEN fatal_error_shutdown EXIT SUB END IF DIM quitmsg as string IF saved_backtrace THEN quitmsg += !"\n\nSaved backtrace to " & log_dir & *app_log_filename END IF IF isbug THEN IF reported_this_bug THEN quitmsg += !"\n\n(Invoked crash reporter)\n\n" ELSEIF reported_a_bug THEN quitmsg += !"\n\n(Not sending another crash report)\n\n" ELSE 'Couldn't send a report quitmsg += !"\n\nPlease report this engine bug by sending an e-mail to ohrrpgce-crash@HamsterRepublic.com\n\n" END IF ELSE quitmsg += !"\n\nIf this error is unexpected, please send an e-mail to ohrrpgce-crash@HamsterRepublic.com\n\n" END IF IF isfatal THEN quitmsg += "Press any key to quit." ELSE IF msg = last_error THEN quitmsg += !"(Error repeated)\n" END IF quitmsg += !"* Press ESC to hide occurrences of this error and continue.\n" _ "* Press any other key to try to continue." END IF last_error = msg IF isfatal ANDALSO isbug THEN msg = !" -- FATAL BUG --\n" + msg ELSEIF isfatal THEN msg = !" -- FATAL ERROR --\n" + msg ELSEIF isbug THEN msg = !" -- OHRRPGCE BUG --\n" + msg ELSE msg = !" -- ERROR --\n" + msg END IF msg += quitmsg 'Reset palette (in case the error happened in a fade-to-black or due to 'corrupt/missing palette or UI colours) REDIM default_palette(255) as RGBcolor load_default_master_palette default_palette() setpal default_palette() DefaultUIColors default_palette(), uilook(), boxlook() clearpage vpage 'suppress_borders to avoid needing to load the box border spriteset basic_textbox msg, uilook(uiText), vpage, , , , YES, fontBuiltinEdged 'suppress_borders=YES setvispage vpage, NO DIM key as KBScancode = waitforanykey IF isfatal ORELSE getquitflag THEN 'Quit the program #IFDEF IS_CUSTOM IF cleanup_workingdir_on_error = NO THEN setquitflag NO clearpage vpage basic_textbox "The editing state of the game will be preserved; run " CUSTOMEXE _ " again and you will be asked whether you want to recover it.", _ uilook(uiText), vpage, , , , YES, fontBuiltinEdged 'suppress_borders=YES setvispage vpage, NO waitforanykey END IF #ENDIF fatal_error_shutdown END IF IF key = scESC ANDALSO callsite ANDALSO num_ignored_callsites <= UBOUND(ignored_callsites) THEN 'Ignore the error '(No way to check for ccCancel...) ignored_callsites(num_ignored_callsites) = callsite num_ignored_callsites += 1 debug "showerror: hiding this error" END IF #IFDEF IS_CUSTOM 'Continuing to edit STATIC shown_warning as bool IF editing_a_game ANDALSO shown_warning = NO THEN shown_warning = YES clearpage vpage basic_textbox "You may want to backup your .RPG file BEFORE attempting to save any " _ "changes, because there is a chance that this error means some kind " _ "of data corruption has happened.", _ uilook(uiText), vpage, , , , YES, fontBuiltinEdged 'suppress_borders=YES setvispage vpage waitforanykey END IF IF activepalette > -1 THEN load_master_and_uicol activepalette END IF #ELSEIF DEFINED(IS_GAME) 'Restore game's master palette and ui colors IF gam.current_master_palette > -1 THEN load_master_and_uicol gam.current_master_palette END IF #ENDIF setpal master() clearpage vpage entered = 0 END SUB END EXTERN '========================================================================================== ' Font-aware text padding '========================================================================================== 'Replacement for RIGHT: Return the right end of a string, trimming and prepending '...' if longer than wide pixels 'Aware of text markup; doesn't break them. '(Might sometimes want to handle this using text slices instead) FUNCTION text_right (text as string, wide as integer, ellipsis as bool = YES, withtags as bool = YES, fontnum as integer = fontPlain) as string DIM w as integer = textwidth(text, fontnum, withtags) IF w <= wide THEN RETURN text IF ellipsis THEN wide -= textwidth("...", fontnum) DIM curspos as StringCharPos find_point_in_text @curspos, XY(w - wide, 0), text, , , fontnum, withtags DIM ret as string IF ellipsis THEN ret = "..." 'Include markup in the skipped portion of the text, to get the correct font/color/etc. IF withtags THEN ret &= just_markup(LEFT(text, curspos.charnum)) ret &= MID(text, 1 + curspos.charnum) 'curspos.charnum is 0-based RETURN ret END FUNCTION 'Replacement for LEFT: Return the left end of a string, trimming and (if ellipsis=YES) 'appending '...' if longer than wide pixels 'If withtags=YES: Aware of text markup; doesn't break them. '(Might sometimes want to handle this using text slices instead) FUNCTION text_left (text as string, wide as integer, ellipsis as bool = YES, withtags as bool = YES, fontnum as integer = fontPlain) as string DIM w as integer = textwidth(text, fontnum, withtags) IF w <= wide THEN RETURN text IF ellipsis THEN wide -= textwidth("...", fontnum) DIM curspos as StringCharPos find_point_in_text @curspos, XY(wide, 0), text, , , fontnum, withtags DIM ret as string = LEFT(text, curspos.charnum) IF withtags THEN ret &= "${K-1}${KB-1}${F-1}" 'Reset to original color and font IF ellipsis THEN ret &= "..." RETURN ret END FUNCTION '========================================================================================== ' Master palettes '========================================================================================== SUB loadpalette(pal() as RGBcolor, byval palnum as integer) IF palnum < 0 THEN debug "loadpalette: invalid palnum " & palnum palnum = 0 END IF DIM fh as integer IF OPENFILE(workingdir + SLASH + "palettes.bin", FOR_BINARY + ACCESS_READ, fh) <> fberrOK THEN '.MAS fallback, palnum ignored because it doesn't matter DIM oldpalbuf(767) as integer xbload game + ".mas", oldpalbuf(), "master palette missing from " + sourcerpg convertpalette oldpalbuf(), pal() ELSE DIM as short headsize, recsize DIM palbuf(767) as ubyte GET #fh, , headsize GET #fh, , recsize GET #fh, recsize * palnum + headsize + 1, palbuf() CLOSE #fh FOR i as integer = 0 TO 255 pal(i).r = palbuf(i * 3) pal(i).g = palbuf(i * 3 + 1) pal(i).b = palbuf(i * 3 + 2) pal(i).a = 255 NEXT END IF 'Uncomment the line below if you want the palette in text format for updating load_default_master_palette 'dump_master_palette_as_hex pal() END SUB SUB savepalette(pal() as RGBcolor, byval palnum as integer) DIM as short headsize = 4, recsize = 768 'Defaults DIM fh as integer OPENFILE(workingdir + SLASH + "palettes.bin", FOR_BINARY + ACCESS_READ_WRITE, fh) IF LOF(fh) >= 4 THEN GET #fh, 1, headsize GET #fh, 3, recsize ELSE PUT #fh, 1, headsize PUT #fh, 3, recsize END IF DIM palbuf(recsize - 1) as UBYTE FOR i as integer = 0 TO 255 palbuf(i * 3) = pal(i).r palbuf(i * 3 + 1) = pal(i).g palbuf(i * 3 + 2) = pal(i).b NEXT PUT #fh, recsize * palnum + headsize + 1, palbuf() CLOSE #fh 'This is not necessary in the slightest, but we copy the default master palette 'back to the .MAS lump, to give old graphics utilities some chance of working IF palnum = gen(genMasterPal) THEN unconvertpalette() END SUB SUB convertpalette(oldpal() as integer, newpal() as RGBcolor) 'takes a old QB style palette (as 768 ints), translates it to '8 bits per component and writes it to the provided RGBcolor array DIM r as integer DIM g as integer DIM b as integer FOR i as integer = 0 TO 255 r = oldpal(i * 3) g = oldpal(i * 3 + 1) b = oldpal(i * 3 + 2) 'newpal(i).r = r shl 2 or r shr 4 'newpal(i).g = g shl 2 or g shr 4 'newpal(i).b = b shl 2 or b shr 4 newpal(i).r = iif(r, r shl 2 + 3, 0) 'Mapping as Neo suggested newpal(i).g = iif(g, g shl 2 + 3, 0) newpal(i).b = iif(b, b shl 2 + 3, 0) newpal(i).a = 255 NEXT END SUB SUB unconvertpalette() 'Takes the default new format palette and saves it in the old QB style palette 'format. This is only here to help out old graphics tools DIM newpal(255) as RGBcolor, oldpal(767) as integer loadpalette newpal(), gen(genMasterPal) FOR i as integer = 0 TO 255 oldpal(i * 3) = newpal(i).r \ 4 oldpal(i * 3 + 1) = newpal(i).g \ 4 oldpal(i * 3 + 2) = newpal(i).b \ 4 NEXT xbsave game + ".mas", oldpal(), 1536 END SUB 'Load master(), uilook(), boxlook() SUB load_master_and_uicol(palnum as integer) loadpalette master(), palnum LoadUIColors uilook(), boxlook(), palnum, master() END SUB OPERATOR RGBColor.cast() as string RETURN rgb_to_string(this) END OPERATOR FUNCTION rgb_to_string(col as RGBcolor) as string IF col.a = 255 THEN RETURN strprintf("rgb(%d,%d,%d)", col.r, col.g, col.b) ELSE RETURN strprintf("rgba(%d,%d,%d,%d)", col.r, col.g, col.b, col.a) END IF END FUNCTION 'Decode a string like "rgb(0,255,0)" or "rgba(0,255,0,255)". Returns true on success FUNCTION string_to_rgb(text as string, byref col as RGBcolor) as bool DIM isrgb as bool = starts_with(LCASE(text), "rgb(") DIM isrgba as bool = starts_with(LCASE(text), "rgba(") IF isrgb = NO AND isrgba = NO THEN RETURN NO DIM pos as integer = IIF(isrgb, 5, 6) 'one-based 'Use VALINT because it ignores trailing garbage '(This is very lenient) col.r = VALINT(MID(text, pos)) pos = INSTR(pos, text, ",") IF pos = 0 THEN RETURN NO pos += 1 col.g = VALINT(MID(text, pos)) pos = INSTR(pos + 1, text, ",") IF pos = 0 THEN RETURN NO pos += 1 col.b = VALINT(MID(text, pos)) IF isrgba THEN pos = INSTR(pos + 1, text, ",") IF pos = 0 THEN RETURN NO pos += 1 col.a = VALINT(MID(text, pos)) ELSE col.a = 255 END IF pos = INSTR(pos, text, ")") IF pos = 0 THEN RETURN NO RETURN YES END FUNCTION 'Takes either a string like "rgb(0,255,0)" or "rgba(0,255,0,255)" (but alpha is 'ignored), and looks it up in the master palette (never maps to color 0) or a 'string containing a color index, eg "14". FUNCTION string_to_color(text as string, default as integer = -1) as integer DIM col as RGBcolor IF string_to_rgb(text, col) THEN RETURN nearcolor(master(), col.r, col.g, col.b, 1) END IF DIM ret as integer = str2int(text, -1) IF ret < 0 OR ret > 255 THEN debuginfo "invalid color string " & text : RETURN default RETURN ret END FUNCTION #IFDEF __FB_MAIN__ startTest(rgb) DIM col as RGBcolor IF rgb_to_string(col) <> "rgba(0,0,0,0)" THEN fail IF string_to_rgb("rgb(16,0,255)", col) <> YES THEN fail IF col.col <> &hff1000ff THEN fail 'BGRA IF string_to_rgb("rgb(16,0,255", col) THEN fail col.col = &hf0102030 IF STR(col) <> "rgba(16,32,48,240)" THEN fail col.a = 255 IF STR(col) <> "rgb(16,32,48)" THEN fail IF string_to_rgb("rgba(16,0,255,128)", col) <> YES THEN fail IF col.col <> &h801000ff THEN fail 'BGRA endTest #ENDIF '========================================================================================== ' Minimaps '========================================================================================== TYPE ReservoirBin value as integer count as integer END TYPE 'Try to pick the most common color in the original tile piece to use in the minimap. 'Only selected approximately, using a reservoir-style algorithm (a linear-time algorithm for 'determining a majority winner). Finding the actual most common color in the naive way would require counting 'number of occurrences of all colors, which would be very slow. 'Instead, do a single pass through all pixels while maintaining a 'reservoir' of candidates 'for most common color, kept approximately sorted by decreasing count. LOCAL FUNCTION minimap_pixel_reservoir(x as integer, y as integer, zoom as integer, composed_tile as Frame ptr) as ubyte '1 or 2 bins leads to a lot of artifacts. More bins is slower. CONST lastbin = 2 DIM res(lastbin) as ReservoirBin DIM decrement_idx as integer = 0 DIM pixel as ubyte DIM as integer ystart, yend ystart = 20 * y \ zoom yend = 20 * (y+1) \ zoom - 1 FOR xx as integer = 20 * x \ zoom TO 20 * (x+1) \ zoom - 1 FOR yy as integer = ystart TO yend pixel = composed_tile->image[yy * 20 + xx] DIM idx as integer 'Increment count, if already in res() FOR idx = 0 TO lastbin WITH res(idx) IF pixel = .value THEN .count += 1 EXIT FOR END IF END WITH NEXT IF idx > lastbin THEN 'Not found in res(), decrement a bin, eventually overwiting it WITH res(decrement_idx) .count -= 1 IF .count <= 0 THEN .value = pixel .count = 1 END IF END WITH decrement_idx += 1 IF decrement_idx > lastbin THEN decrement_idx = 0 END IF NEXT NEXT 'Find bin with highest count (fallback to last pixel if all counts are 0) DIM most as integer = 0 FOR idx as integer = 0 TO lastbin IF res(idx).count > most THEN pixel = res(idx).value most = res(idx).count END IF NEXT RETURN pixel END FUNCTION 'Pick a random pixel from the original tile piece to use in the minimap LOCAL FUNCTION minimap_pixel_scatter(x as integer, y as integer, fraction as single, byref prng_state as uinteger, composed_tile as Frame ptr) as ubyte DIM as integer i, j i = INT((x + simple_rand(prng_state)) * fraction) j = INT((y + simple_rand(prng_state)) * fraction) RETURN composed_tile->image[j * 20 + i] END FUNCTION 'quant: whether to return 8-bit Frame insteaad of 32-bit one. LOCAL FUNCTION minimap_tile_scaled(composed_tile as Frame ptr, zoom as integer, quant as bool) as Frame ptr DIM as Surface ptr composed_surf, scaled composed_surf = frame_to_surface32(composed_tile, master()) scaled = surface_scale(composed_surf, zoom, zoom) gfx_surfaceDestroy(@composed_surf) DIM scaledfr as Frame ptr IF quant THEN DIM opts as QuantizeOptions opts.to_master = YES 'Use nearcolor_fast scaledfr = quantize_surface(scaled, master(), opts) 'Frees scaled ELSE scaledfr = frame_with_surface(scaled) gfx_surfaceDestroy(@scaled) END IF RETURN scaledfr END FUNCTION FUNCTION minimap_zoom_amount(mapsize as XYPair, margin as XYPair = XY(0,0)) as integer DIM fraction as XYPair = ((vpages(vpage)->size - margin) \ mapsize) RETURN bound(small(fraction.w, fraction.h), 1, 20) END FUNCTION CONSTRUCTOR MinimapGenerator (tiles_arr() as TileMap, tilesets_arr() as TilesetData ptr, pmapptr_in as TileMap ptr = NULL, zoom_in as integer = -1, algorithm_in as MinimapAlgorithmEnum = minimapScaled) 'zoom = 1 is unzoomed, zoom = 20 is 1 pixel per tile. 'If zoom is -1, calculate and store it pmapptr = pmapptr_in algorithm = algorithm_in IF vpages_are_32bit = NO ANDALSO algorithm = minimapScaled THEN algorithm = minimapScaledQuant 'Currently, tilesets arrays are always dimmed to maplayerMax BUG_IF(UBOUND(tilesets_arr) < UBOUND(tiles_arr), "tilesets array short") v_new tiles, UBOUND(tiles_arr) + 1 FOR i as integer = 0 TO v_len(tiles) - 1 tiles[i] = @tiles_arr(i) NEXT v_new tilesets, UBOUND(tiles_arr) + 1 FOR i as integer = 0 TO v_len(tilesets) - 1 tilesets[i] = tilesets_arr(i) NEXT 'auto-detect best zoom zoom = zoom_in IF zoom = -1 THEN zoom = minimap_zoom_amount(tiles[0]->size) DIM with_surface32 as bool = (algorithm = minimapScaled) minimap = frame_new(zoom * tiles[0]->wide, zoom * tiles[0]->high, , , , with_surface32) frame_clear minimap, uilook(uiBackground) composed_tile = frame_new(20, 20, , YES) END CONSTRUCTOR DESTRUCTOR MinimapGenerator() frame_unload @minimap frame_unload @composed_tile v_free tiles v_free tilesets END DESTRUCTOR 'Compute more of the minimap, if not done yet, but stop after 'runtime' seconds. 'Returns the minimap, whether finished or not. If you want to keep the minimap 'after the MinimapGenerator is destructed, use frame_reference. FUNCTION MinimapGenerator.run(runtime as double) as Frame ptr DIM fraction as single = 20 / zoom DIM stoptime as double = TIMER + runtime 'DIM drawtime as double = TIMER FOR ty as integer = nextrow TO tiles[0]->high - 1 FOR tx as integer = 0 TO tiles[0]->wide - 1 'Clearing is only necessary if map layer 0 isn't in tiles(), so the maplayer stack may be transparent IF tiles[0]->layernum <> 0 THEN frame_clear(composed_tile, uilook(uiBackground)) END IF draw_layers_at_tile(composed_tile, tiles, tilesets, tx, ty, pmapptr) IF algorithm = minimapScaled ORELSE algorithm = minimapScaledQuant THEN DIM tile as Frame ptr = minimap_tile_scaled(composed_tile, zoom, (algorithm = minimapScaledQuant)) frame_draw tile, master(), NULL, tx * zoom, ty * zoom, NO, minimap 'master() not used frame_unload @tile ELSE FOR x as integer = 0 TO zoom - 1 FOR y as integer = 0 TO zoom - 1 DIM pixel as integer IF algorithm = minimapScatter THEN pixel = minimap_pixel_scatter(x, y, fraction, prng_state, composed_tile) ELSE pixel = minimap_pixel_reservoir(x, y, zoom, composed_tile) END IF minimap->image[(tx * zoom + x) + (ty * zoom + y) * minimap->w] = pixel NEXT NEXT END IF NEXT nextrow = ty + 1 IF TIMER > stoptime THEN EXIT FOR NEXT 'drawtime = (TIMER - drawtime) '? "createminimap (algorithm " & algorithm & ") in " & drawtime & " -- " & (1e6 * drawtime / minimap->w / minimap->h) & "us/pix" RETURN minimap END FUNCTION FUNCTION MinimapGenerator.finished() as bool RETURN nextrow >= tiles[0]->high END FUNCTION FUNCTION createminimap (tiles() as TileMap, tilesets() as TilesetData ptr, pmapptr as TileMap ptr = NULL, byref zoom as integer = -1, algorithm as MinimapAlgorithmEnum = minimapScaled) as Frame ptr DIM job as MinimapGenerator = MinimapGenerator(tiles(), tilesets(), pmapptr, zoom, algorithm) zoom = job.zoom 'I think it's better to return an unfinished minimap than to freeze for too long RETURN frame_reference(job.run(5)) END FUNCTION FUNCTION createminimap (layer as TileMap, tileset as TilesetData ptr, byref zoom as integer = -1, algorithm as MinimapAlgorithmEnum = minimapScaled) as Frame ptr DIM layers(0) as TileMap DIM tilesetsdata(0) as TilesetData ptr layers(0) = layer tilesetsdata(0) = tileset RETURN createminimap(layers(), tilesetsdata(), NULL, zoom, algorithm) END FUNCTION '========================================================================================== ' Read/write names '========================================================================================== FUNCTION readattackname (byval index as integer) as string RETURN readbadgenericname(index, game + ".dt6", 80, 24, 10, 1) END FUNCTION FUNCTION readattackcaption (byval index as integer) as string DIM buf(40 + dimbinsize(binATTACK)) as integer loadattackdata buf(), index RETURN readbinstring(buf(), 73, 38) END FUNCTION FUNCTION readenemyname (byval index as integer, byval altfile as bool = USE_DT1_TMP) as string DIM enemy as EnemyDef loadenemydata enemy, index, altfile RETURN enemy.name END FUNCTION SUB writeenemyname (byval index as integer, newname as string, byval altfile as bool = USE_DT1_TMP) 'If the enemy data hasn't been upgraded then saving+loading loses data. 'This SUB is only called by "set enemy name" for games updated since hróðvitnir, this this shouldn't happen BUG_IF(getfixbit(fixDefaultDissolveEnemy) = NO ORELSE getfixbit(fixEnemyElementals) = NO, "doesn't support obsolete .rpgs") DIM enemy as EnemyDef loadenemydata enemy, index, altfile enemy.name = newname saveenemydata enemy, index, altfile END SUB 'use_default: don't return a blank name FUNCTION getheroname (hero_id as integer, use_default as bool = YES) as string DIM her as HeroDef IF hero_id >= 0 THEN loadherodata her, hero_id IF LEN(her.name) THEN RETURN her.name END IF IF use_default THEN RETURN "Hero " & hero_id RETURN "" END FUNCTION FUNCTION readitemname (byval index as integer) as string RETURN readbadgenericname(index, game + ".itm", getbinsize(binITM), 0, 8, 0) END FUNCTION FUNCTION readitemdescription (byval index as integer) as string RETURN readbadgenericname(index, game + ".itm", getbinsize(binITM), 9, 36, 0) END FUNCTION FUNCTION getmapname (byval mapnum as integer) as string DIM nameread(39) as integer ' Ignore a missing .mn file, but allow partially missing records... IF loadrecord(nameread(), game + ".mn", 40, mapnum, NO, YES) THEN ' ...because the size of the record is twice the max size of the map name, which is a mistake. DIM a as string = STRING(small((nameread(0) AND 255), 39), " ") array2str nameread(), 1, a RETURN a END IF END FUNCTION FUNCTION readshopname (byval shopnum as integer) as string RETURN readbadgenericname(shopnum, game + ".sho", 40, 0, 15, 0) END FUNCTION FUNCTION getsongname (byval num as integer, byval prefixnum as bool = NO) as string DIM songd(dimbinsize(binSONGDATA)) as integer DIM s as string IF num <= -1 THEN RETURN "-none-" s = "" IF prefixnum THEN s = num & " " loadrecord songd(), workingdir + SLASH + "songdata.bin", curbinsize(binSONGDATA) \ 2, num s = s & readbinstring(songd(), 0, 30) RETURN s END FUNCTION FUNCTION getsfxname (byval num as integer) as string DIM sfxd(dimbinsize(binSFXDATA)) as integer loadrecord sfxd(), workingdir & SLASH & "sfxdata.bin", curbinsize(binSFXDATA) \ 2, num, NO 'expect_exists=NO RETURN readbinstring(sfxd(), 0, 30) END FUNCTION SUB getelementnames(elmtnames() as string) REDIM elmtnames(gen(genNumElements) - 1) FOR i as integer = 0 TO gen(genNumElements) - 1 DIM default as string default = "Element" & i+1 IF i < 8 THEN 'Original indices changed so maxlen could be expanded default = readglobalstring(17 + i, default, 10) ELSEIF i < 16 THEN 'Next 8 elements map to old enemytypes default = LEFT(readglobalstring(1 + i, "EnemyType" & i, 10) + "-killer", 14) END IF elmtnames(i) = readglobalstring(174 + i*2, default, 14) NEXT i END SUB '========================================================================================== ' Stats '========================================================================================== SUB getstatnames(statnames() as string) REDIM statnames(statLast) statnames(0) = readglobalstring(0, "HP", 10) statnames(1) = readglobalstring(1, "MP", 10) statnames(2) = readglobalstring(2, "Atk", 10) statnames(3) = readglobalstring(3, "Aim", 10) statnames(4) = readglobalstring(5, "Def", 10) statnames(5) = readglobalstring(6, "Dodge", 10) statnames(6) = readglobalstring(29, "Magic", 10) statnames(7) = readglobalstring(30, "Will", 10) statnames(8) = readglobalstring(8, "Speed", 10) statnames(9) = readglobalstring(7, "Ctr", 10) statnames(10) = readglobalstring(31, "MP~", 10) statnames(11) = readglobalstring(4, "Hits", 10) END SUB FUNCTION battle_statnames(statnum as integer) as string SELECT CASE statnum CASE 0 TO 11 RETURN statnames(statnum) CASE 12: RETURN "poison register" CASE 13: RETURN "regen register" CASE 14: RETURN "stun register" CASE 15: RETURN "mute register" CASE ELSE: showerror "battle_statnames: Invalid stat " & statnum END SELECT END FUNCTION FUNCTION should_hide_hero_stat(hero as HeroDef, byval statnum as integer) as bool RETURN NodeByPath(hero.reld, "/stat_options/stat[" & statnum & "]/hide") <> NULL END FUNCTION FUNCTION should_hide_hero_stat(byval hero_id as integer, byval statnum as integer) as bool DIM her as HeroDef loadherodata her, hero_id RETURN should_hide_hero_stat(her, statnum) END FUNCTION '========================================================================================== ' Input grabbers (datafield editing) '========================================================================================== 'Hook called when the selected menu item changes, so that any 'edit state stored in global variables can be reset. 'You can NOT rely on this always being called immediately! For 'example if you switch to a different menu it isn't called. 'Not called when scrolling a menu. SUB reset_menu_edit_state () 'show_overlay_message "RESET", 0.15 'Reset intgrabber negative_zero = NO 'Reset percent_grabber/format_percent editing_float_ptr = NULL editing_float_repr = "" END SUB 'Like "IIF(keyval(key) > 1, 1, 0)" except that it initially repeats slowly, and returns 'progressively larger values the longer the key is down, up to a maximum of maxspeed. 'startspeed = 0 means initially repeat slowly, startspeed = 1 is initially same repeat as normal, 'startspeed > 1 is same as startspeed = 1 but multiplies the return value. FUNCTION accelerating_keydown(key as KBScancode, maxspeed as integer, startspeed as integer = 0) as integer STATIC last_keydown_timestamp as double 'Timer STATIC key_momentum as integer 'Memory of effective milliseconds the key was down 'These are used only if startspeed=0: CONST START_REPEAT_WAIT = 350 'Delay in ms before initial key repeat CONST START_REPEAT_RATE = 180 'Delay in ms between initial key repeats CONST STARTSPEEDMS = 1700 'Delay before repeat accelerates (to 1 every tick) CONST MAXSPEEDMS = 5000 'Time before maxspeed reached IF keyval(key) > 0 THEN 'This function will be called multiple times with different scancodes, so 'mustn't do anything when the key is up. Instead, compare keypress_time with 'last_keydown_timestamp to see whether it's been down the whole time DIM t as double = TIMER DIM time_gap as integer = 1000 * (t - last_keydown_timestamp) 'milliseconds last_keydown_timestamp = t DIM ms as integer = keypress_time(key) VAR downtime = small(time_gap, ms) 'ms down since last call VAR uptime = time_gap - downtime 'ms up since last call key_momentum -= 3 * uptime 'Releasing the key slows down quickly IF uptime > 750 then key_momentum -= 1000 'Quickly reset momentum 'Use remembered key down time 'ms = large(key_momentum, ms) IF key_momentum > ms THEN 'If the user releases a key for a moment, it halves the acceleration 'rate until keypress_time catches back up to key_momentum. ms = key_momentum key_momentum += downtime \ 2 ELSE key_momentum += downtime END IF key_momentum = bound(key_momentum, 0, MAXSPEEDMS) IF ms < STARTSPEEDMS THEN 'RETURN IIF(keyval(key) > 1, 1, 0) but slower IF startspeed = 0 THEN RETURN IIF(player_keyval(key, , , START_REPEAT_WAIT, START_REPEAT_RATE) > 1, 1, 0) ELSE RETURN IIF(keyval(key) > 1, startspeed, 0) END IF END IF 'x goes from 0 to 1 at MAXSPEEDMS DIM x as double = small(1.0, (ms - STARTSPEEDMS) / (MAXSPEEDMS - STARTSPEEDMS)) 'Map interval [0,1] -> [0,1], slope going from 2/3 to 4/3 'x = 2*x/3 + x*x/3 'Always start with speed 1 IF startspeed = 0 THEN startspeed = 1 RETURN large(startspeed, maxspeed * (10^(x * 3) - 1) / 999.0) END IF END FUNCTION 'keygrabber is like intgrabber (or usemenu) except it only watches the two keys passed as arguments, not 'number keys, page up/down, copy/paste, minus, etc. FUNCTION keygrabber (byref n as integer, min as integer, max as integer, less as KBScancode=ccLeft, more as KBScancode=ccRight) as bool IF keyval(more) > 1 THEN loopvar n, min, max, 1 RETURN YES ELSEIF keyval(less) > 1 THEN loopvar n, min, max, -1 RETURN YES END IF RETURN NO END FUNCTION 'Modify an integer according to key input (less and more are scancodes for decrementing and incrementing) 'If returninput is true, returns whether the user tried to modify the int, 'otherwise returns true only if the int actually changed. 'autoclamp: If is false, n is clamped within allowable range only if a key is pressed 'moreless_step: ' The (minimum without acceleration) amount that the more/less keys step by. 'wrap: Whether less/more keys wrap around FUNCTION intgrabber (byref n as integer, min as integer, max as integer, less as KBScancode=ccLeft, more as KBScancode=ccRight, returninput as bool=NO, use_clipboard as bool=YES, autoclamp as bool=YES, scrollwheel as WheelHandlingEnum=wheelRightButton, moreless_step as integer=1, wrap as bool=YES) as bool DIM as longint temp = n intgrabber = intgrabber(temp, cast(longint, min), cast(longint, max), less, more, returninput, use_clipboard, autoclamp, scrollwheel, moreless_step, wrap) n = temp END FUNCTION 'See above for documentation FUNCTION intgrabber (byref n as longint, min as longint, max as longint, less as KBScancode=ccLeft, more as KBScancode=ccRight, returninput as bool=NO, use_clipboard as bool=YES, autoclamp as bool=YES, scrollwheel as WheelHandlingEnum=wheelRightButton, moreless_step as integer=1, wrap as bool=YES) as bool STATIC clip as longint DIM old as longint = n DIM typed as bool = NO ' Mapping from scNumpad7 and up to scNumpad0 to values STATIC numpad_nums(...) as integer = {7, 8, 9, -1, 4, 5, 6, -1, 1, 2, 3, 0} DIM updown as integer = 0 IF scrollwheel = wheelRightButton THEN IF readmouse().buttons AND mouseright THEN updown = readmouse().wheel_clicks ELSEIF scrollwheel = wheelAlways THEN updown = readmouse().wheel_clicks END IF DIM maxspeed as integer = small(1000, (max - min) \ 10 \ moreless_step) IF more <> scNone THEN updown += accelerating_keydown(more, maxspeed) IF less <> scNone THEN updown -= accelerating_keydown(less, maxspeed) IF updown THEN 'Don't wrap while acceleration is active, it's confusing IF wrap ANDALSO ABS(updown) = 1 THEN loopvar n, min, max, moreless_step * updown ELSE n = bound(n + moreless_step * updown, min, max) END IF typed = YES ELSEIF keyval(scDelete) > 1 THEN n = bound(0, min, max) typed = YES ELSE DIM sign as integer = SGN(n) n = ABS(n) IF keyval(scBackspace) > 1 THEN n \= 10: typed = YES ' Make sure you're not typing something else with shift IF keyval(scShift) = 0 THEN FOR i as integer = 1 TO 9 IF keyval(sc1 - 1 + i) > 1 THEN n = n * 10 + i typed = YES END IF NEXT IF keyval(sc0) > 1 THEN n = n * 10 typed = YES END IF END IF ' However, allow Shift while using numpad keys: under gfx_fb on X11, ' numpad keys aren't converted to Left, End, etc IF shift XOR numlock FOR i as integer = 0 TO UBOUND(numpad_nums) IF keyval(scNumpad7 + i) > 1 THEN IF numpad_nums(i) > -1 THEN n = n * 10 + numpad_nums(i) typed = YES END IF END IF NEXT ' Handle negatives IF old = 0 ANDALSO n <> 0 ANDALSO negative_zero THEN sign = -1 IF min < 0 AND max > 0 THEN IF keyval(scMinus) > 1 OR keyval(scNumpadMinus) > 1 THEN IF n = 0 THEN negative_zero = YES ELSE sign = sign * -1 typed = YES END IF END IF IF (keyval(scPlus) > 1 OR keyval(scNumpadPlus) > 1) AND sign < 0 THEN sign = sign * -1 typed = YES END IF END IF IF sign < 0 OR (min < 0 AND max = 0) THEN n = -n 'CLIPBOARD IF use_clipboard THEN IF copy_keychord() THEN clip = n IF paste_keychord() THEN n = clip typed = YES END IF END IF n = bound(n, min, max) END IF IF typed = NO AND autoclamp = NO THEN n = old IF typed = YES THEN negative_zero = NO IF returninput THEN RETURN typed ELSE RETURN (old <> n) END IF END FUNCTION FUNCTION zintgrabber (byref n as integer, min as integer, max as integer, less as KBScancode=ccLeft, more as KBScancode=ccRight) as bool '--adjust for entries that are offset by +1 '--what a hack! '--all entries <= 0 are special options not meant to be enumerated '--supply the min & max as visible, not actual range for n '--eg a menu with 'A' = -2, 'B' = -1, 'C' = 0, 'item 0 - item 99' = 1 - 100 would have min = -3, max = 99 DIM old as integer = n DIM temp as integer = n - 1 '--must adjust to always be able to type in a number IF temp < 0 THEN FOR i as KBScancode = sc1 TO sc0 IF keyval(i) > 1 THEN temp = 0 NEXT i END IF intgrabber temp, min, max, less, more n = temp + 1 'Pressing Backspace/Delete on '0' (n=1) goes to 'None' (n=0). Have to handle old=0 here too, or it alternates 0/-1. IF old <= 1 ANDALSO (keyval(scBackspace) > 1 ORELSE keyval(scDelete) > 1) THEN n = 0 RETURN (old <> n) END FUNCTION FUNCTION xintgrabber (byref n as integer, pmin as integer, pmax as integer, nmin as integer=1, nmax as integer=1, less as KBScancode=ccLeft, more as KBScancode=ccRight) as integer '--quite a bit of documentation required: '--like zintgrabber, but for cases where positive values mean one thing, negatives '--another, and 0 means none. 'Requirements: nmax <= nmin <= 0 <= pmin <= pmax 'Omit nmax and nmin for no negative range 'nmin to nmax is the visible range of negative values 'eg. nmin = -1 nmax = -100: negatives indicate a number between 1 and 100 'pmin to pmax is positive range 'eg. 2 - 50 means n==1 is '2', n==49 is '50', and 0 - 1 means n==1 is '0' and n==2 is '1' DIM old as integer = n 'calculate the range of n DIM as integer valmin, valmax IF nmin <> 1 THEN valmin = -1 + (nmax - nmin) END IF valmax = 1 + (pmax - pmin) 'calculate the visible value DIM as integer visval, oldvisval IF n > 0 THEN visval = n + pmin - 1 ELSEIF n < 0 THEN visval = n + nmin + 1 ELSE visval = 0 END IF oldvisval = visval IF more <> scNone ANDALSO keyval(more) > 1 THEN 'easy case loopvar n, valmin, valmax, 1 ELSEIF less <> scNone ANDALSO keyval(less) > 1 THEN 'easy case loopvar n, valmin, valmax, -1 /'--Why on earth do we want to support negation anyway? ELSEIF nmin < 0 AND pmax > 0 AND _ (keyval(scMinus) > 1 OR keyval(scNumpadMinus) > 1 OR _ ((keyval(scPlus) > 1 OR keyval(scNumpadPlus) > 1) AND s < 0)) THEN 'nasty case: negate n based on *displayed* value visval = bound(-visval, nmax, pmax) n = ... '/ ELSEIF keyval(scDelete) > 1 THEN n = 0 RETURN (old <> n) ELSE 'horrible case: change n based on *displayed* value visval = ABS(visval) IF keyval(scBackspace) > 1 THEN visval \= 10 'Special case for when backspace changes to None. Isolate this case to allow 'some sanity in the rest of the logic IF (oldvisval = 0) OR (n > 0 AND visval < pmin) OR (n < 0 AND -visval > nmin) THEN n = 0 RETURN (old <> n) END IF ELSE FOR i as integer = 1 TO 9 IF keyval(i - 1 + sc1) > 1 THEN visval = visval * 10 + i NEXT i IF keyval(sc0) > 1 THEN visval *= 10 END IF 'convert absolute visval back to n 'None can become positive, but positive remains positive and negative remains negative IF old = 0 THEN IF visval <> oldvisval THEN visval = bound(visval, pmin, pmax) n = visval - pmin + 1 END IF ELSEIF old > 0 THEN visval = bound(visval, pmin, pmax) n = visval - pmin + 1 ELSE visval = bound(-visval, nmax, nmin) n = visval - nmin - 1 END IF END IF RETURN (old <> n) END FUNCTION FUNCTION xy_grabber(byref pos as XYPair, speed as integer = 1, drag_button as MouseButton = mouseNone) as bool DIM oldpos as XYPair = pos DIM ms as integer = IIF(speed = 1, 90, 55) IF slowkey(ccLeft, ms) THEN pos.x -= speed IF slowkey(ccRight, ms) THEN pos.x += speed IF slowkey(ccUp, ms) THEN pos.y -= speed IF slowkey(ccDown, ms) THEN pos.y += speed IF drag_button AND readmouse.dragging THEN pos += readmouse.pos - readmouse.lastpos END IF RETURN oldpos <> pos END FUNCTION ' Handle all key combinations for deleting a character or word forward or backwards: ' Backspace, Delete, Alt/Ctrl-Backspace/Delete ' On Mac, Option- (which is Alt) Backspace/Delete are used instead of Ctrl-Backspace/Delete ' so we support that too. (Note Backspace and Delete are called Delete and Forward Delete on Mac). ' pre is the part of the text before the insert point, and post is after. LOCAL SUB stredit_delete_keys(pre as string, post as string) IF keyval(scCtrl) > 0 OR keyval(scAlt) > 0 THEN DIM spacepos as integer ' Delete prev word IF keyval(scBackspace) > 1 THEN ' First remove any whitespace at the end pre = RTRIM(pre, ANY !" \n") ' Find whitespace character before the last word, but don't delete it spacepos = INSTRREV(pre, ANY !" \n", -1) '-1: search from end pre = LEFT(pre, spacepos) END IF ' Delete next word IF keyval(scDelete) > 1 THEN ' First remove any whitespace post = LTRIM(post, ANY !" \n") ' Find whitespace character after the next word, but don't delete it spacepos = INSTR(post, ANY !" \n") post = MID(post, spacepos) END IF ELSE IF keyval(scBackspace) > 1 THEN pre = LEFT(pre, LEN(pre) - 1) END IF IF keyval(scDelete) > 1 THEN post = RIGHT(post, LEN(post) - 1) END IF END IF END SUB 'Handle copy/paste edits to 'text'. Attempt to use the OS clipboard if possible, 'otherwise use 'clip' as the clipboard. SUB handle_text_copy_paste (byref text as string, byref clip as string) IF copy_keychord() THEN clip = text io_set_clipboard_text(latin1_to_utf8(text)) END IF IF paste_keychord() THEN DIM osclip as zstring ptr 'ustring osclip = io_get_clipboard_text() #IFDEF __FB_WIN32__ 'On Windows text in the clipboard uses \r\n line ends, so 'io_set_clipboard_text() converts to that, but io_get_clipboard_text() 'doesn't automatically convert back. strip_carriage_returns osclip 'Modify in-place #ENDIF 'Intentionally using utf8_to_latin1 instead of utf8_to_ohr here, so that 'round trips of text from OHR -> clipboard/other programs -> OHR don't lose 'icon characters. IF LEN(*osclip) THEN clip = utf8_to_latin1(*osclip) DEALLOCATE osclip text = clip END IF END SUB 'Returns true if the string has changed FUNCTION strgrabber (text as string, maxl as integer = 9999999) as bool STATIC clip as string DIM original as string = text stredit_delete_keys text, "" #IFNDEF IS_GAME '--copy+paste support handle_text_copy_paste text, clip text = LEFT(text, maxl) #ENDIF '--adding chars IF LEN(text) < maxl THEN #IFDEF IS_CUSTOM IF keyval(scSpace) > 1 AND keyval(scCtrl) > 0 THEN '--charlist support text &= charpicker() END IF #ENDIF 'Note: never returns newlines; and we don't check either text = LEFT(text + getinputtext, maxl) END IF RETURN (text <> original) END FUNCTION FUNCTION stredit (s as string, byref insert as integer, maxl as integer = 9999999, numlines as integer = 1, line_length as integer = 1) as integer 'Return value is the line that the cursor is on, or 0 if numlines=1 'insert is the 0-based position of the cursor (range 0..LEN(s)-1), and is modified byref. Set to -1 to move automatically to end of string 'maxl is maximum length in characters. 'numlines is number of lines visible. If > 1 then wrapping and newlines are enabled. 'line_length is number of characters on a line (for wrapping) stredit = 0 STATIC clip as string '--copy+paste support handle_text_copy_paste s, clip s = LEFT(s, maxl) IF insert < 0 THEN insert = LEN(s) insert = bound(insert, 0, LEN(s)) '--insert cursor movement ' (Mac uses Option (ie ALT) instead of CTRL for moving by word, so accept that too. ' Doesn't use Option-Home/End though.) IF keyval(scCtrl) = 0 AND keyval(scAlt) = 0 THEN IF keyval(ccLeft) > 1 THEN insert = large(0, insert - 1) IF keyval(ccRight) > 1 THEN insert = small(LEN(s), insert + 1) ELSE 'CTRL IF keyval(ccLeft) > 1 THEN 'move by word IF insert > 0 THEN 'searching from position -1 searches from the end insert = INSTRREV(s, ANY !" \n", insert - 1) 'different argument order: the FB devs, they are so funny END IF END IF IF keyval(ccRight) > 1 THEN insert = INSTR(insert + 1, s, ANY !" \n") IF insert = 0 THEN insert = LEN(s) END IF IF keyval(scHome) > 1 THEN insert = 0 IF keyval(scEnd) > 1 THEN insert = LEN(s) END IF '--up and down arrow keys IF numlines > 1 THEN DIM wrapped as string wrapped = wordwrap(s, large(1, line_length)) DIM lines() as string split(wrapped, lines()) DIM line_starts() as integer split_line_positions s, lines(), line_starts() DIM insert_line as integer = -1 DIM offset_in_line as integer '0-based DIM move_lines as integer = 0 FOR linenum as integer = 0 TO UBOUND(lines) DIM next_line as integer = IIF(linenum = UBOUND(lines), len(s) + 1, line_starts(linenum + 1)) IF next_line > insert THEN insert_line = linenum offset_in_line = insert - line_starts(linenum) EXIT FOR END IF NEXT linenum IF insert_line = -1 THEN showbug "Ignorable engine bug: stredit couldn't find line" END IF IF keyval(ccUp) > 1 THEN move_lines = -1 IF keyval(ccDown) > 1 THEN move_lines = 1 IF keyval(scPageUp) > 1 THEN move_lines = -(numlines - 2) IF keyval(scPageDown) > 1 THEN move_lines = numlines - 2 move_lines += readmouse.wheel_clicks * 3 IF move_lines THEN insert_line = bound(insert_line + move_lines, 0, UBOUND(lines) + 1) IF insert_line = UBOUND(lines) + 1 THEN 'Trying to move past last line: move to its end instead insert = LEN(s) ELSE insert = line_starts(insert_line) + small(offset_in_line, LEN(lines(insert_line))) END IF END IF '--set return value stredit = insert_line '--end of special handling for up and down motion '--Home and end keys: go to previous/next newline, '--unless Ctrl is pressed, which is handled above IF keyval(scCtrl) = 0 THEN IF keyval(scHome) > 1 THEN IF insert > 0 THEN 'searching from position -1 searches from the end insert = INSTRREV(s, CHR(10), insert - 1) END IF END IF IF keyval(scEnd) > 1 THEN insert = INSTR(insert + 1, s, CHR(10)) IF insert = 0 THEN insert = LEN(s) ELSE insert -= 1 END IF END IF '--end of special keys that only work in multiline mode END IF DIM pre as string = LEFT(s, insert) DIM post as string = RIGHT(s, LEN(s) - insert) '--BACKSPACE, DELETE, ALT/CTRL+BACKSPACE/DELETE stredit_delete_keys pre, post '--adding chars IF LEN(pre) + LEN(post) < maxl THEN IF keyval(scSpace) > 1 AND keyval(scCtrl) > 0 THEN #IFDEF IS_CUSTOM '--charlist support pre &= charpicker() #ENDIF ELSEIF keyval(scAnyEnter) > 1 THEN IF numlines > 1 THEN pre &= CHR(10) END IF ELSE pre &= getinputtext END IF END IF insert = LEN(pre) s = LEFT(pre & post, maxl) END FUNCTION '========================================================================================== ' Pop-up/Modal menus and displays '========================================================================================== SUB pop_warning(msg as zstring ptr, byval autoquit as bool = NO) 'autoquit is specifically for cleanup_and_terminate and has no other use '--Construct the warning UI (This will be hella easier later when the Slice Editor can save/load) DIM root as Slice Ptr root = NewSliceOfType(slContainer) WITH *root .Fill = YES END WITH DIM outer_box as Slice Ptr outer_box = NewSliceOfType(slContainer, root) WITH *outer_box ' .paddingTop = 20 ' .paddingBottom = 20 ' .paddingLeft = 20 ' .paddingRight = 20 ' .Fill = YES .Y = 200 .AlignHoriz = alignCenter .AlignVert = alignCenter .AnchorHoriz = alignCenter .AnchorVert = alignCenter .Width = small(320 - 40, get_resolution().w) .Height = small(200 - 40, get_resolution().h) END WITH DIM inner_box as Slice Ptr inner_box = NewSliceOfType(slRectangle, outer_box) WITH *inner_box .paddingTop = 8 .paddingBottom = 8 .paddingLeft = 8 .paddingRight = 8 .Fill = YES ChangeRectangleSlice inner_box, 2 END WITH DIM text_area as Slice Ptr text_area = NewSliceOfType(slText, inner_box) WITH *text_area .Fill = YES ChangeTextSlice text_area, *msg, , , YES END WITH DIM animate as Slice Ptr animate = outer_box '--Preserve whatever screen was already showing as a background DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen copypage vpage, dpage DIM dat as TextSliceData Ptr dat = text_area->SliceData dat->line_limit = 15 DIM deadkeys as integer = 15 DIM mouse_moved as integer = 0 DIM scrollbar_state as MenuState scrollbar_state.size = 16 '--Now loop displaying text setkeys DO setwait 17 setkeys IF autoquit THEN 'Make it easy to dismiss the message by ignoring it DIM winstate as WindowState ptr = gfx_getwindowstate() IF winstate ANDALSO winstate->focused = NO THEN EXIT DO 'Because readmouse.moved_dist doesn't work when not on the window IF winstate ANDALSO winstate->mouse_over = NO THEN mouse_moved += 2 mouse_moved += readmouse.moved_dist IF mouse_moved > 150 THEN EXIT DO END IF IF deadkeys = 0 THEN IF keyval(ccCancel) > 1 OR enter_or_space() OR click_dismiss() THEN EXIT DO IF keyval(ccUp) > 1 THEN dat->first_line -= 1 IF keyval(ccDown) > 1 THEN dat->first_line += 1 dat->first_line = bound(dat->first_line, 0, large(0, dat->line_count - dat->line_limit)) END IF deadkeys = large(deadkeys - 1, 0) 'Animate the arrival of the pop-up animate->Y = large(animate->Y - vpages(vpage)->h \ 15, 0) DrawSlice root, dpage WITH scrollbar_state .top = dat->first_line .last = dat->line_count - 1 END WITH draw_fullscreen_scrollbar scrollbar_state, , dpage SWAP vpage, dpage setvispage vpage copypage holdscreen, dpage dowait LOOP '--Animate the removal of the screen DO setkeys setwait 17 animate->Y = animate->Y + vpages(vpage)->h \ 15 IF animate->Y > 200 THEN EXIT DO DrawSlice root, dpage SWAP vpage, dpage setvispage vpage copypage holdscreen, dpage dowait LOOP freepage holdscreen DeleteSlice @root END SUB ' Returns NO and doesn't modify s if user cancelled, otherwise YES. ' limit is the maximum length. FUNCTION prompt_for_string (byref retstring as string, caption as string, limit as integer = 40) as bool 'Load the slice collection DIM root as Slice Ptr root = NewSliceOfType(slContainer) SliceLoadFromFile root, finddatafile("prompt_for_string.slice") DIM caption_area as Slice Ptr caption_area = LookupSliceSafe(SL_EDITOR_PROMPT_FOR_STRING_CAPTION, root) ChangeTextSlice caption_area, caption DIM text_area as Slice Ptr text_area = LookupSliceSafe(SL_EDITOR_PROMPT_FOR_STRING_TEXT, root, slText) DIM editstr as string = retstring '--Preserve whatever screen was already showing as a background DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen '--Now loop while editing string setkeys YES DO setwait 40 setkeys YES 'The root slice has been set to horizontally centered instead of to fill parent (which is the screen slice) root->Width = bound(LEN(editstr) * 8 + 58, 300, get_resolution().w) IF keyval(scF6) > 1 THEN slice_editor root, SL_COLLECT_EDITOR, "prompt_for_string.slice", , YES IF keyval(ccCancel) > 1 THEN prompt_for_string = NO EXIT DO END IF IF keyval(scAnyEnter) > 1 THEN prompt_for_string = YES retstring = text_area->TextData->s EXIT DO END IF strgrabber editstr, limit ChangeTextSlice text_area, editstr copypage holdscreen, dpage DrawSlice root, dpage SWAP vpage, dpage setvispage vpage dowait LOOP setkeys freepage holdscreen DeleteSlice @root END FUNCTION LOCAL FUNCTION _highlight_text(original as string, arg as any ptr) as string DIM col as integer = *CAST(integer ptr, arg) RETURN bgtag(col, original) END FUNCTION 'Returns text with highlighting applied to all matches of searchstring FUNCTION highlight_for_incremental_search(text as string, searchstring as string, charnum as integer, byref search_num_matches as integer) as string IF LEN(searchstring) = 0 THEN RETURN text DIM ret as string = text DIM col as integer = findrgb(150, 150, 0) DIM at_cursor as string = MID(ret, charnum, LEN(searchstring)) IF LCASE(at_cursor) = LCASE(searchstring) THEN 'Highlight the selected match, so if you press Ctrl+S you can see it advance ret = MID(ret, 1, charnum - 1) + fgtag(uilook(uiSelectedItem), at_cursor) _ + MID(ret, charnum + LEN(at_cursor)) END IF search_num_matches = replacestr(ret, searchstring, @_highlight_text, @col, , YES) RETURN ret END FUNCTION 'Advances charnum (the cursor position) to a match of searchstring, and sets scroll_to_y. 'advance_dir is -1 or 1 to search backwards/forwards, or 0 to find next match 'but not advancing if already at match SUB advance_incremental_search(text as string, searchstring as string, byref charnum as integer, advance_dir as integer, byref scroll_to_y as integer, sl as Slice ptr) DIM match as integer IF advance_dir = -1 THEN 'First look backwards match = INSTRREV(LCASE(text), LCASE(searchstring), charnum + advance_dir) IF match = 0 THEN 'Otherwise from end match = INSTRREV(LCASE(text), LCASE(searchstring)) END IF ELSE 'First look forwards match = INSTR(charnum + advance_dir, LCASE(text), LCASE(searchstring)) IF match = 0 THEN 'Otherwise from start match = INSTR(LCASE(text), LCASE(searchstring)) END IF END IF IF match = 0 THEN EXIT SUB charnum = match 'DIM charpos as XYPair = TextSliceCharPos(sl, charnum) DIM charpos as StringCharPos find_text_char_position(@charpos, text, charnum, sl->Width, fontPlain) scroll_to_y = charpos.pos.y END SUB SUB show_help(helpkey as zstring ptr) 'Text without expansions or edits DIM original_text as string original_text = load_help_file(*helpkey) 'The displayed text: includes edits, and if not editing then it has expanded templates. DIM help_str as string = original_text expand_help(help_str, *helpkey) '--Construct the help UI (This will be hella easier later when the Slice Editor can save/load) DIM help_root as Slice Ptr help_root = NewSliceOfType(slContainer) WITH *help_root .Y = vpages(vpage)->h .Fill = NO END WITH DIM help_outer_box as Slice Ptr help_outer_box = NewSliceOfType(slContainer, help_root) WITH *help_outer_box .paddingTop = 4 .paddingBottom = 4 .paddingLeft = 4 .paddingRight = 4 .Fill = Yes END WITH DIM help_box as Slice Ptr help_box = NewSliceOfType(slRectangle, help_outer_box) WITH *help_box .paddingTop = 8 .paddingBottom = 8 .paddingLeft = 8 '.paddingRight = 8 .Fill = YES .Clip = YES ChangeRectangleSlice help_box, 1 END WITH DIM footer_text2 as Slice Ptr footer_text2 = NewSliceOfType(slText, help_outer_box) WITH *footer_text2 .AlignVert = alignBottom .AlignHoriz = alignRight .AnchorHoriz = alignRight .Y = -4 .X = -3 .TextData->use_render_text = YES .TextData->fontnum = fontBuiltinPlain END WITH ChangeTextSlice footer_text2, , uilook(uiMenuItem), NO, , boxlook(1).bgcol 'outline=NO DIM footer_text as Slice Ptr footer_text = NewSliceOfType(slText, help_outer_box) WITH *footer_text .AlignVert = alignBottom .X = 3 .Y = -4 .TextData->use_render_text = YES .TextData->fontnum = fontBuiltinPlain END WITH ChangeTextSlice footer_text, , uilook(uiMenuItem), NO, , boxlook(1).bgcol 'outline=NO footer_text->TextData->use_render_text = YES 'Fills the clipping area DIM clip_box as Slice Ptr clip_box = NewSliceOfType(slContainer, help_box) WITH *clip_box .paddingRight = 4 .Fill = YES END WITH DIM help_draw_area as Slice Ptr help_draw_area = NewSliceOfType(slScroll, clip_box) WITH *help_draw_area .paddingRight = 4 .Clip = NO .Fill = YES END WITH DIM help_text as Slice Ptr help_text = NewSliceOfType(slText, help_draw_area) WITH *help_text .Fill = YES .FillMode = sliceFillHoriz .TextData->use_render_text = YES .TextData->fontnum = fontBuiltinPlain ChangeTextSlice help_text, help_str, , , YES 'wrap=YES END WITH DIM animate as Slice Ptr animate = help_root '--Preserve whatever screen was already showing as a background DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen copypage vpage, dpage DIM dat as TextSliceData Ptr dat = help_text->SliceData dat->insert = 0 DIM editing as bool = NO DIM deadkeys as integer = 25 DIM cursor_line as integer = 0 DIM searchstring as string DIM default_footer as string = "Type to search" DIM footerstring as string = default_footer DIM footerstring2 as string DIM search_num_matches as integer '--Now loop displaying help push_and_reset_gfxio_state setkeys YES DO setwait 17 setkeys YES 'The necessity of this would be eliminated by using a root slice set to fill (filling the screen slice) UpdateRootSliceSize(help_root, vpage) DIM scroll_to_y as integer = -1 IF editing THEN DIM numlines as integer = help_draw_area->Height \ 10 + 1 cursor_line = stredit(help_str, dat->insert, , numlines, help_text->Width \ 8) 'The limit of 32767 chars is totally arbitrary and maybe not a good limit ChangeTextSlice help_text, help_str END IF IF deadkeys = 0 THEN IF keyval(ccCancel) > 1 AND (editing OR searchstring = "") THEN '--If there are any changes to the help screen, offer to save them IF editing = NO ORELSE original_text = help_str THEN EXIT DO ELSE 'Prevent attempt to quit the program, stop and wait for response first DIM quitting as bool = getquitflag() setquitflag NO DIM choice as integer = twochoice("Save changes to help for """ & *helpkey & """?", "Yes", "No", 0, -1) IF getquitflag() THEN choice = 1 'Second attempt to quit: discard IF choice <> -1 THEN IF quitting THEN setquitflag IF choice = 0 THEN save_help_file *helpkey, dat->s EXIT DO END IF END IF END IF IF editing THEN IF keyval(scCtrl) > 0 AND keyval(scS) > 1 THEN 'Previously we didn't use_render_text while editing so couldn't do text highlighting, 'so use this old search implementation. TODO: Ctrl-S to start incremental search. IF prompt_for_string(searchstring, "Search") THEN DIM idx as integer = INSTR(dat->insert + 2, LCASE(dat->s), LCASE(searchstring)) IF idx = 0 THEN 'wrap idx = INSTR(dat->s, searchstring) END IF IF idx THEN dat->insert = idx - 1 END IF END IF ELSE 'Fancy new incremental search DIM advance_dir as integer = -2 DIM update as bool = NO IF keyval(ccCancel) > 1 THEN searchstring = "" : advance_dir = 0 'Forward/backward search DIM temp as integer = find_next_or_prev_keychord() IF temp <> 0 THEN advance_dir = temp IF keyval(scCtrl) = 0 AND (keyval(scLeftCommand) OR keyval(scRightCommand)) = 0 THEN 'On input, advance to next match if not already at it IF strgrabber(searchstring, 60) THEN advance_dir = 0 END IF IF advance_dir <> -2 THEN 'ChangeTextSlice help_text, help_str 'So that TextSliceCharPos() returns the correct result advance_incremental_search(help_str, searchstring, dat->insert, advance_dir, scroll_to_y, help_text) DIM highlighted as string highlighted = highlight_for_incremental_search(help_str, searchstring, dat->insert, search_num_matches) ChangeTextSlice help_text, highlighted IF LEN(searchstring) THEN footerstring = "Search: " & fgtag(uilook(uiText), bgtag(findrgb(150, 150, 0), searchstring)) footerstring2 = "Ctrl+S: next ("& search_num_matches & " matches)" ELSE footerstring = default_footer footerstring2 = "" END IF END IF END IF IF keyval(scCtrl) > 0 AND keyval(scE) > 1 THEN 'Edit the help text without template expansion help_str = original_text IF diriswriteable(get_help_dir()) THEN editing = YES 'Hide footer help_outer_box->paddingBottom = 4 footer_text->Visible = NO footer_text2->Visible = NO 'Kludge: insert is actually 0-based offset, but incremental search use 1-based offset IF dat->insert THEN dat->insert -= 1 dat->show_insert = YES ChangeRectangleSlice help_box, , uilook(uiBackground), , 0 ELSE ' It would be possible to just automatically makedir($documents_dir/ohrhelp), and warn the user that it happened pop_warning "Your """ & get_help_dir() & """ folder is not writable. Try making a copy of it at """ & documents_dir & SLASH & "ohrhelp""" END IF END IF IF keyval(scF1) and *helpkey <> "share_helphelp" THEN show_help "share_helphelp" END IF IF keyval(scF6) THEN slice_editor help_root, SL_COLLECT_EDITOR 'Update scroll position (help_text->Y) 'Decreasing Y to scroll down is confusing... DIM top as integer = -help_text->Y DIM maxy as integer = large(0, (help_text->Height - help_draw_area->Height)) IF editing THEN 'Scroll to cursor_line 'TODO: use text_layout_dimensions to correctly calculate the Y position of a line. 'However stredit does its own word wrapping assuming a 8x8 font, no markup, etc, 'to calculate the text position, so will need rewriting in future :( scroll_to_y = cursor_line * 10 ' Move cursor to location of mouse click. IF readmouse.buttons AND (mouseLeft OR mouseRight) THEN DIM curspos as StringCharPos find_point_in_text @curspos, readmouse.pos, dat->s, help_text->Width, help_text->ScreenPos, fontPlain dat->insert = curspos.charnum END IF ELSE '--not editing, just browsing IF slowkey(ccUp, 30) THEN top -= 8 IF slowkey(ccDown, 30) THEN top += 8 IF keyval(scPageUp) > 1 THEN top -= help_draw_area->Height - 12 IF keyval(scPageDown) > 1 THEN top += help_draw_area->Height - 12 IF keyval(scHome) > 1 THEN top = 0 IF keyval(scEnd) > 1 THEN top = maxy top += readmouse.wheel_delta \ 4 END IF IF scroll_to_y <> -1 ANDALSO (readmouse.buttons AND (mouseLeft OR mouseRight)) = 0 THEN top = small(top, scroll_to_y - 20) top = large(top, scroll_to_y + 30 - help_draw_area->Height) END IF help_text->Y = -bound(top, 0, maxy) END IF deadkeys = large(deadkeys - 1, 0) 'Animate the arrival of the help screen animate->Y = large(animate->Y - vpages(vpage)->h \ 15, 0) copypage holdscreen, vpage ChangeTextSlice footer_text, footerstring ChangeTextSlice footer_text2, footerstring2 DrawSlice help_root, vpage setvispage vpage dowait LOOP '--Animate the removal of the help screen DO setkeys setwait 17 animate->Y = animate->Y + vpages(vpage)->h \ 15 IF animate->Y > vpages(vpage)->h THEN EXIT DO copypage holdscreen, vpage DrawSlice help_root, vpage setvispage vpage dowait LOOP pop_gfxio_state freepage holdscreen DeleteSlice @help_root END SUB FUNCTION multiline_string_editor(s as string, helpkey as string="", prompt_to_save as bool = YES) as string 'FIXME: this hasn't been updated for variable res, and has heaps of code duplication with 'show_help editing mode '--Construct the UI (loading a slice collection might be better here? but not from the RPG file!) DIM root as Slice Ptr root = NewSliceOfType(slContainer) WITH *root 'TODO: this doesn't handle changes to window size. Have a look at 'how pop_warning handles this instead. .Y = 200 .Fill = NO .Size = get_resolution() END WITH DIM outer_box as Slice Ptr outer_box = NewSliceOfType(slContainer, root) WITH *outer_box .paddingTop = 4 .paddingBottom = 4 .paddingLeft = 4 .paddingRight = 4 .Fill = YES END WITH DIM box as Slice Ptr box = NewSliceOfType(slRectangle, outer_box) WITH *box .paddingTop = 8 .paddingBottom = 8 .paddingLeft = 8 .paddingRight = 8 .Fill = YES ChangeRectangleSlice box, , uilook(uiBackground), , 0 END WITH DIM text as Slice Ptr text = NewSliceOfType(slText, box) WITH *text .Fill = YES ChangeTextSlice text, s, , , YES END WITH DIM animate as Slice Ptr animate = root '--Preserve whatever screen was already showing as a background DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen copypage vpage, dpage DIM dat as TextSliceData Ptr dat = text->SliceData dat->line_limit = 18 dat->insert = 0 dat->show_insert = YES DIM deadkeys as integer = 25 DIM cursor_line as integer = 0 DIM scrollbar_state as MenuState scrollbar_state.size = 17 '--Now loop displaying help setkeys YES DO setwait 30 setkeys YES DIM textstring as string = dat->s cursor_line = stredit(textstring, dat->insert, , dat->line_limit, text->Width \ 8) ChangeTextSlice text, textstring IF keyval(ccCancel) > 1 THEN '--If there are any changes to the help screen, offer to save them IF s = dat->s THEN EXIT DO ELSEIF prompt_to_save THEN DIM choice as integer = twochoice("Keep changes to this text?", "Yes", "No", 0, -1) IF choice = 1 THEN dat->s = s '--don't use changes! IF choice >= 0 THEN EXIT DO ELSE EXIT DO END IF END IF IF deadkeys = 0 THEN IF keyval(scF1) ANDALSO helpkey <> "" THEN show_help helpkey IF keyval(scF2) THEN export_string_to_file dat->s IF keyval(scF3) THEN import_string_from_file dat->s dat->first_line = small(dat->first_line, cursor_line - 1) dat->first_line = large(dat->first_line, cursor_line - (dat->line_limit - 2)) dat->first_line = bound(dat->first_line, 0, large(0, dat->line_count - dat->line_limit)) END IF deadkeys = large(deadkeys -1, 0) 'Animate the arrival of the help screen animate->Y = large(animate->Y - 20, 0) copypage holdscreen, vpage DrawSlice root, vpage WITH scrollbar_state .top = dat->first_line .last = dat->line_count - 1 END WITH draw_fullscreen_scrollbar scrollbar_state, , vpage setvispage vpage dowait LOOP '--Animate the removal of the multiline text editor DO setkeys setwait 17 animate->Y = animate->Y + 20 IF animate->Y > 200 THEN EXIT DO copypage holdscreen, vpage DrawSlice root, vpage setvispage vpage dowait LOOP DIM result as string result = dat->s freepage holdscreen DeleteSlice @root RETURN result END FUNCTION SUB export_string_to_file(s as string) DIM filename as string filename = inputfilename("Name of text file to export to?", ".txt", "", "export_string_to_file") IF filename = "" THEN RETURN filename &= ".txt" IF isfile(filename) THEN IF yesno("""" & decode_filename(filename) & """ already exists. Do you want to overwrite it?", NO, NO) = NO THEN RETURN END IF IF NOT fileiswriteable(filename) THEN visible_debug "File """ & decode_filename(filename) & """ is not writeable" : RETURN string_to_file s, filename visible_debug "Successfully wrote the text to """ & decode_filename(filename) & """" END SUB SUB import_string_from_file(s as string) DIM prefix as string = "" IF s <> "" THEN SELECT CASE twochoice("Do you want to append to the text or replace it?", "Append", "Replace", 0, -1, "import_string_from_file_append") CASE 0: 'append prefix = s & !"\n" CASE 1: 'replace CASE ELSE 'cancel RETURN END SELECT END IF DIM filename as string filename = browse(browseAny, "", "*.txt", "import_string_from_file") IF filename = "" THEN RETURN s = prefix & string_from_file(filename) END SUB 'Setup MenuDef and MenuState like multichoice(): centered by default, or at 'where', or 'at_top'. 'at_top: align to top of the screen. Set menu.offset.y to any space needed for a title. 'popup_style: make the menu look and behave like a popup menu SUB init_multichoice_menu(menu as MenuDef, state as MenuState, where as XYPair=XY(0,0), at_top as bool=NO, popup_style as bool=NO) IF where <> 0 THEN menu.anchorvert = alignTop menu.alignvert = alignTop menu.anchorhoriz = alignLeft menu.alignhoriz = alignLeft menu.offset = where menu.clamp_to_screen = YES ELSEIF at_top THEN menu.anchorvert = alignTop menu.alignvert = alignTop END IF menu.withtags = YES menu.suppress_borders = YES menu.itemspacing = 1 IF popup_style THEN 'FIXME: if there is a scrollbar, the menu text will overlap it menu.bordersize = -6 'Total border (+8) is 2px menu.textalign = alignLeft state.drag_selecting = readmouse.buttons END IF state.active = YES init_menu_state state, menu END SUB 'Show a message box and a multichoice menu below it, return option number. 'Preserves the contents of the screen. 'extra_message: shown at the bottom of the screen. 'popup_style: make the menu look and behave like a popup menu FUNCTION multichoice(capt as zstring ptr, choices() as string, defaultval as integer=0, escval as integer=-1, helpkey as zstring ptr=@"", extra_message as zstring ptr=@"", where as XYPair=XY(0,0), popup_style as bool=NO) as integer DIM state as MenuState DIM menu as MenuDef DIM result as integer FOR i as integer = 0 TO UBOUND(choices) append_menu_item menu, choices(i) NEXT init_multichoice_menu menu, state, where, LEN(*capt) <> 0, popup_style state.pt = defaultval 'Keep a copy of vpage at its original bitdepth, so we can restore it afterwards. We don't draw it 'since if it's 8-bit it would be drawn with the wrong master palette. DIM oldscreen as integer = duplicatepage(vpage) push_and_reset_gfxio_state 'Change to 32-bit and reset the master palette, before copying vpage 'Use whatever was on the screen already as a background (NOTE: this doesn't always work (not necessarily vpage)). 'This copy has 32-bit depth. DIM holdscreen as integer = duplicatepage(vpage) DIM have_help_file as bool = (LEN(*helpkey) > 0 ANDALSO isfile(*helpkey)) DO setwait 55 setkeys IF keyval(scF1) > 1 ANDALSO LEN(*helpkey) > 0 THEN show_help helpkey END IF result = default_menu_controls(state, escval) IF state.active = NO THEN EXIT DO copypage holdscreen, vpage IF LEN(*capt) THEN IF where <> 0 THEN 'The caption is displayed at a separate location to the menu (leave some room for extra_message at bottom) basic_textbox(capt, , vpage, IIF(where.y < 60, pBottom - 20, pTop + 2) + showTop) ELSE 'Draw the caption far enough above the center to leave room for the menu, 'then put directly below where the caption box actually ends menu.offset.y = 2 + basic_textbox(capt, , vpage, pCentered - 10 - UBOUND(choices) * 5 + showTop) END IF END IF menu.max_chars = get_resolution().w \ 8 - 2 draw_menu menu, state, vpage IF have_help_file THEN edgeprint "F1 Help", pRight, pBottom, uilook(uiMenuItem), vpage END IF wrapprintbg *extra_message, pLeft, pBottom, uilook(uiMenuItem), vpage, , , , fontBuiltinEdged setvispage vpage dowait LOOP pop_gfxio_state copypage oldscreen, vpage freepage oldscreen freepage holdscreen RETURN result END FUNCTION FUNCTION twochoice(capt as zstring ptr, strA as zstring ptr=@"Yes", strB as zstring ptr=@"No", byval defaultval as integer=0, byval escval as integer=-1, helpkey as zstring ptr=@"") as integer DIM choices(1) as string = {*strA, *strB} RETURN multichoice(capt, choices(), defaultval, escval, helpkey) END FUNCTION 'Asks a yes-or-no pop-up question. Less flexible than twochoice, since it only returns a bool. '(Not to be confused with yesorno(), which returns a yes/no string) FUNCTION yesno(capt as zstring ptr, byval defaultval as bool=YES, byval escval as bool=NO) as bool IF defaultval THEN defaultval = 0 ELSE defaultval = 1 IF escval THEN escval = 0 ELSE escval = 1 DIM result as integer result = twochoice(capt, "Yes", "No", defaultval, escval) IF result = 0 THEN RETURN YES IF result = 1 THEN RETURN NO END FUNCTION 'Same as multichoice, but if the user clicked or has button down, show a menu at the mouse cursor; 'capt appears at top/bottom of screen. 'You can call this on button-down and the user can drag the mouse and select an item on button release. FUNCTION popup_choice(capt as string="", choices() as string, defaultval as integer=0, escval as integer=-1, helpkey as zstring ptr=@"", extra_message as zstring ptr=@"") as integer DIM where as XYPair DIM popup_style as bool = NO IF (readmouse.buttons OR readmouse.release) AND (mouseLeft OR mouseRight) THEN where = readmouse.pos popup_style = YES END IF RETURN multichoice(capt, choices(), defaultval, escval, helpkey, extra_message, where, popup_style) END FUNCTION 'Figure out where to draw a tooltip when using the OS mouse cursor (so its size isn't obvious), 'clamping to screen. 'The size of the tooltip is optional. Pass the size to avoid the tooltip possibly covering the 'mouse position due to clamping to the screen. FUNCTION pick_tooltip_pos(size as XYPair = XY(0,0)) as RelPosXY DIM ret as XYPair = readmouse.pos DIM winstate as WindowState ptr = gfx_getwindowstate() DIM zoom as integer = IIF(winstate, winstate->zoom, 2) 'We assume the OS mouse cursor is about 12x12 unscaled pixels, with its top-left corner at the mouse position DIM offset as integer = 12 \ zoom DIM res as XYPair = get_resolution() IF ret.x + size.w > res.w THEN ret.x -= size.w ELSE ret.x += offset IF ret.y + size.h > res.h THEN ret.y -= size.h ELSE ret.y += offset ret.x += showLeft 'Clamp to screen ret.y += showTop RETURN ret END FUNCTION '========================================================================================== ' Run programs '========================================================================================== '(Alias: open_url) ' Open a file or URL using default system handler (URLs must start with a protocol like ' http:// or https://). ' Would return NO to indicate failure (e.g. no web browser installed), but we might ' not detect failure on some platforms. Definitely no error for a bad URL. FUNCTION open_document (file_or_url as string) as bool #IFDEF __FB_JS__ web_open_url file_or_url RETURN YES 'Don't bother trying to check if it worked #ELSE #IFDEF __FB_WIN32__ ' safe_shell "START """ & file_or_url & """" 'Alternative way to open file/URL using winapi call, which doesn't involve 'running cmd.exe, and returns whether it succeeds, but is untested DIM result as string = os_open_document(file_or_url) IF LEN(result) = 0 THEN RETURN YES visible_debug "Couldn't open " & file_or_url & ": " & result RETURN NO #ELSE DIM exitcode as integer #IFDEF __FB_DARWIN__ exitcode = safe_shell("open '" & file_or_url & "'") 'I don't know whether we can actually detect whether that worked #ELSE 'Unix. 'xdg-open is part of freedesktop.org so will be present on almost every Linux 'distro with a WM, and Exists on at least some BSDs too. exitcode = safe_shell("xdg-open '" & file_or_url & "'") 'End else Mac #ENDIF IF exitcode = 0 THEN RETURN YES visible_debug "Couldn't open " & file_or_url RETURN NO 'End else Windows #ENDIF 'End else JS #ENDIF END FUNCTION FUNCTION spawn_and_wait (app as string, args as string, expect_exitcode_0 as bool = YES, grab_stderr as bool = NO, wait_on_error as bool = YES) as string 'Run a commandline program in a terminal emulator and wait for it to finish. 'Returns "" on success, or an error message, or optionally (only Unix only!) both the 'stderr output and exitcode. 'NOTE: you should display the error with visible_debug, because this function doesn't write 'it to the debug log (TODO: change that) 'Use run_and_get_output() instead if stdout or stderr is needed. ' 'On Windows the program is run asynchronously and users are offered the option to kill it. 'On other platforms this is synchronous: we freeze. 'You can of course also kill the program on all platforms with Ctrl+C in the terminal. ' '-app: A path to an executable, not escaped '-args: Should be escaped as needed (with escape_filename) to be passed via a shell '-expect_exitcode_0: ' If true and the exitcode isn't 0, then returns a failure message, otherwise the ' exitcode is ignored. '-grab_stderr: ' (Not supported on Windows) Return stderr appended with the exitcode ' If nothing was printed, return "" according to expect_exitcode_0. '-wait_on_error: ' If the exitcode is nonzero then pause and wait for the user to press a key before ' closing the terminal. Not supported on Windows 9x. debuginfo "spawn_and_wait " + app + " " + args #IFDEF MINIMAL_OS RETURN "Can't run programs on this platform" #ELSE DIM appname as string = trimpath(app) IF gfxbackend = "console" THEN CLS DIM res as integer res = safe_shell(escape_filename(app) & " " & args) 'Sync actual and backend-internal screens CLS clearpage vpage setvispage vpage, NO 'res is < 0 if there was a problem running it, > 0 is an exit code from the program IF res < 0 THEN RETURN "Failed to run " & appname & ", errorcode " & res ELSEIF res > 0 ANDALSO expect_exitcode_0 THEN RETURN appname & " reported failure, errorcode " & res ELSE RETURN "" END IF END IF #IFDEF __FB_UNIX__ basic_textbox "Please wait, running " & appname, uilook(uiText), vpage setvispage vpage, NO DIM term_wrap as string #IFDEF __FB_DARWIN__ 'Wow that's a crazy amount of indirection! 'Running Terminal.app is the only way to get a terminal, but 'open' is for opening a file with an application only, 'so we use an AppleScript script embedded in Terminal_wrapper.sh to run HSpeak term_wrap = find_helper_app("Terminal_wrapper.sh") IF term_wrap = "" THEN RETURN missing_helper_message("Terminal_wrapper.sh") term_wrap = escape_filename(term_wrap) #ELSE 'Generic UNIX: xterm is nearly everywhere (but not installed by default in some linux distros) '(TODO: use 'which' to check for xterm and fallback to something else) 'open_process with show_output=true is only implemented on Windows, so we run sh (via 'system()), which runs xterm, which runs sh to run app_wrap, which runs app. That's a 'lot that can go wrong! IF LEN(find_helper_app("xterm")) = 0 THEN RETURN "Could not continue because xterm is not installed, please install it. For example run 'yum install xterm' or 'apt-get install xterm'." END IF term_wrap = "xterm -bg black -fg gray90 -e" #ENDIF waitforkeyrelease DIM randprefix as string = absolute_path(tmpdir) & "temp" & randint(10000) DIM app_wrap as string = randprefix & "_script.sh" DIM errfile as string = randprefix & "_err.txt" DIM esc_errfile as string = escape_filename(errfile) DIM cmd as string = escape_filename(app) + " " + args 'Produce a wrapper script which is run inside the terminal emulator DIM fh as integer = FREEFILE OPEN app_wrap FOR OUTPUT as #fh PRINT #fh, "#!/bin/sh" PRINT #fh, "cd " & escape_filename(curdir()) PRINT #fh, "clear" IF grab_stderr THEN 'Swap stdout and stderr so that (the original) stderr goes to tee '(unfortunately this adds buffering, could use 'stdbuf' to avoid but that 'isn't available everywhere, eg macOS), and stdout goes straight to the 'terminal, unbuffered. { } is needed to get the exitcode, otherwise $? reports 'the exitcode of the final command in the pipeline. PRINT #fh, "{ " + cmd + " 3>&2 2>&1 1>&3; EXITC=$?; echo exitcode=$EXITC >> " + esc_errfile + "; } | tee " + esc_errfile ELSE PRINT #fh, cmd PRINT #fh, "EXITC=$?" PRINT #fh, "echo exitcode=$EXITC > " & esc_errfile PRINT #fh, "echo exit $EXITC" END IF IF wait_on_error THEN 'read -p is a bashism PRINT #fh, "if [ ""$EXITC"" != 0 ]; then echo ""Press ENTER to continue...""; read; fi" END IF CLOSE #fh safe_shell "chmod +x " + escape_filename(app_wrap), , NO 'log_it = NO DIM res as integer = safe_shell(term_wrap + " " + escape_filename(app_wrap)) DIM ret as string 'res is < 0 if there was a problem forking/waiting, 127 if xterm/Terminal_wrapper.sh wasn't found '(in which case an error will probably be printed to our stderr), 'while > 0 are exitcodes returned from xterm/Terminal_wrapper.sh, NOT from app_wrap. 'xterm prints nothing and returns 0 even if it couldn't run the program! 'Likewise can't get anything from Terminal. IF res THEN ret = "Could not run a terminal emulator: exitcode " & res ELSE ret = RTRIM(string_from_file(errfile, NO), ANY !"\n\r ") 'expect_exists=NO IF ret = "" THEN 'errfile is missing or zero length ret = "Unknown failure to run " & appname ELSEIF starts_with(ret, "exitcode=") THEN 'No stderr output IF expect_exitcode_0 THEN IF ret = "exitcode=0" THEN ret = "" ELSE ret = appname & " failed with " & ret END IF ELSE 'Ignore exitcode ret = "" END IF ELSE 'stderr output. Return as-is, with the exitcode regardless of what it is. END IF END IF safekill errfile safekill app_wrap RETURN ret #ELSEIF defined(__FB_WIN32__) waitforkeyrelease IF wait_on_error ANDALSO is_windows_9x() = NO ANDALSO get_wine_version() = NULL THEN 'I've no clue why the "exit !ERRORLEVEL!" is necessary to get the exit code, it's 'not needed without the || pause even though that doesn't change the errorlevel! '& is a command separator like ; in Unix '/y:on turns on delayed variable expansion, for !ERRORLEVEL! 'This doesn't seem to work under Wine. It seems that regardless of the exitcode, 'it always pauses and it never returns a nonzero exitcode! Also it prints everything to 'stdout instead of in a new console window. args = "/y:on /c """ & escape_filename(app) & " " & args & " || pause & exit !ERRORLEVEL!""" app = "cmd.exe" END IF DIM handle as ProcessHandle handle = open_console_process(app, args) IF handle = 0 THEN RETURN "Could not run " & appname END IF DIM dots as integer = 0 DIM exitcode as integer DO setwait 400 setkeys IF process_running(handle, @exitcode) = NO THEN cleanup_process @handle IF expect_exitcode_0 ANDALSO exitcode <> 0 THEN 'Error, or the user might have killed the program some other way RETURN appname & " failed with exitcode=" & exitcode END IF RETURN "" END IF IF keyval(ccCancel) > 1 THEN kill_process handle cleanup_process @handle setkeys RETURN "User cancelled." END IF dots = (dots + 1) MOD 5 DIM msg as string msg = "Please wait, running " & appname & rpad(STRING(dots, "."), , 5) msg += fgcol_text(!"\nPress ESC to cancel", uilook(uiMenuItem)) basic_textbox msg, uilook(uiText), vpage setvispage vpage dowait LOOP #ENDIF #ENDIF 'MINIMAL_OS END FUNCTION '========================================================================================== ' Find and install helper programs '========================================================================================== FUNCTION get_support_dir (create_dir as bool = YES) as string 'Returns, creating if needed, the support directory path. 'The support dir is most commonly used on Windows and Mac (on Mac, hspeak lives there). 'On GNU/Linux or Android it (currently) won't pre-exist unless the OHR is compiled from source, 'and it is only used to hold utilities downloaded for distributing games (currently just 'rcedit.exe and butler). '(Downloaded versions of Game itself are stored in $settings_dir/_gameplayer instead) DIM as string suppdir, suppdir2 #IFDEF __FB_DARWIN__ 'Inside Mac .app bundles at .../Contents/MacoOS/support/ suppdir = exepath & SLASH "support" #ELSE 'On Linux ohrrpgce-custom/game may be in linux/$arch/, so look next to game.sh/custom.sh suppdir = app_dir & "support" #ENDIF IF isdir(suppdir) THEN RETURN suppdir '~/.ohrrpgce/support on Unix suppdir2 = settings_dir & SLASH "support" IF isdir(suppdir2) THEN RETURN suppdir2 IF create_dir THEN IF makedir(suppdir) = 0 THEN RETURN suppdir IF makedir(suppdir2) = 0 THEN RETURN suppdir2 showerror "Could not find or create a directory for support utilities" END IF RETURN "" ' not found. booo! :( END FUNCTION 'Some helper utilities have an -version.txt file (included in the download) containing: '-line 0: a numeric version code (returned) '-line 1: a textual version code (returned in version_text) '-rest: comments 'Returns 0 if the version file doesn't exist. 'apppath: path to the .exe FUNCTION get_helper_app_version(apppath as string, byref version_text as string = "") as integer DIM version_file as string = trimextension(apppath) & "-version.txt" DIM lines() as string version_text = "" IF NOT lines_from_file(lines(), version_file, NO) THEN RETURN 0 'expect_exists=NO IF UBOUND(lines) >= 1 THEN version_text = lines(1) RETURN str2int(lines(0), 0) END IF END FUNCTION #MACRO try_app_path(path) temp = path IF isfile(temp) THEN RETURN temp #ENDMACRO FUNCTION find_helper_app (appname as zstring ptr, try_install as bool=NO, download_url as zstring ptr=@"") as string 'Returns an empty string if the app is not found, or the full path if it is found 'try_install currently only works on Windows, and not for all possible apps 'download_url: only used if try_install is true, to override the default #IFDEF MINIMAL_OS RETURN "" #ELSE DIM temp as string 'Look in the installation directory... I think this is only to find hspeak on Windows and Unix. try_app_path(app_dir & *appname & DOTEXE) #IFDEF __FB_WIN32__ RETURN find_windows_helper_app(*appname, try_install, *download_url) #ELSE 'Look in support dir and then try $PATH... same as find_windows_helper_app. And then hardcoded paths. 'See get_support_dir() for explanation of programs that might be there. try_app_path(get_support_dir(NO) & SLASH & *appname) 'Don't create support dir 'Use the standard util "which" to search the path DIM where as string run_and_get_output("which " & *appname, where, , NO) 'disable debuginfo spam 'where is empty on failure where = RTRIM(where, !"\n") IF LEN(where) THEN RETURN where 'unlump and relump get installed here try_app_path(app_dir & "/../share/games/ohrrpgce/" & *appname) '/usr/share/games is optional in the Linux FHS standard, so try share/ohrrpgce too (Not seen in the wild) try_app_path(app_dir & "/../share/ohrrpgce/" & *appname) try_app_path("/usr/share/games/ohrrpgce/" & *appname) try_app_path("/usr/share/ohrrpgce/" & *appname) #ENDIF #ENDIF END FUNCTION FUNCTION find_windows_helper_app (appname as string, try_install as bool=NO, download_url as string="") as string 'Gets the windows version of the helper app, even when run on Linux or Mac (for utils to be run via wine) 'Returns an empty string if the app is not found or version is too old, or the full path if it is found 'TODO: this could be merged with find_helper_app. 'try_install: download it if not installed or too old 'download_url: only used if try_install is true, to override the default 'For windows, first look in the support subdirectory '(This is required so we can replace unusable utilities, eg create_tarball) DIM support as string = get_support_dir() DIM apppath as string = support & SLASH & appname & ".exe" 'Special case logic to force upgrade of certain utilities to a specified version DIM need_version as integer DIM need_version_text as string IF appname = "zip" THEN need_version = 300 'Not 2.3 need_version_text = "3.0" 'Previously the zip.exe version was indicated by presence of zip-version-3.0.txt, which we now ignore ELSEIF appname = "rcedit" THEN need_version = 10101 need_version_text = "1.1.1" ELSEIF appname = "gzip" THEN need_version = 10312 need_version_text = "1.3.12" 'Actually 1.3.12-1 END IF DIM have_version as integer IF isfile(apppath) THEN have_version = get_helper_app_version(apppath) IF have_version < need_version THEN 'Reject it; it must be redownloaded debuginfo strprintf("Ignoring %s which is version %d, need version %d", strptr(apppath), have_version, need_version) ELSE RETURN apppath END IF END IF DIM ret as string #IFDEF __FB_WIN32__ IF is_windows_9x() = NO ANDALSO need_version = 0 THEN ' Check whether appname.exe is in the $PATH (command.com doesn't seem to support this syntax) ' Don't do this if we require a specific version, because we won't know (presumably there won't be a version.txt) ' Prepend a _ because if its args are blank echo prints "ECHO ON." run_and_get_output "for %X in (" & appname & ".exe) do echo _%~$PATH:X", ret, , NO 'disable debuginfo spam ret = RTRIM(ret, ANY !"\n\r ") IF LEN(ret) > 1 THEN RETURN MID(ret, 2) ' Trim the _. END IF #ENDIF IF try_install THEN ret = install_windows_helper_app(appname, download_url) IF LEN(ret) THEN DIM version_text as string have_version = get_helper_app_version(ret, version_text) debuginfo strprintf("Downloaded %s version %s (%d)", strptr(ret), strptr(version_text), have_version) IF have_version < need_version THEN 'Someone forgot to put the version file in the download? But we'll proceed with whatever got downloaded showbug "Downloaded a fresh copy of " & appname & " but it was only version " & version_text & ", expected >= " & need_version_text END IF RETURN ret END IF END IF RETURN "" END FUNCTION 'Returns "" on failure, otherwise path to the executable '(This can get run on Unix too!) FUNCTION install_windows_helper_app (appname as string, download_url as string="") as string DIM support as string = get_support_dir() DIM apppath as string = support & SLASH & appname & ".exe" DIM extension as string IF appname = "unzip" THEN extension = "exe" ELSE extension = "zip" DIM dlfile as string = support & SLASH & appname & "." & extension IF LEN(download_url) = 0 THEN download_url = "http://HamsterRepublic.com/ohrrpgce/support/" & appname & "." & extension END IF DIM choice as integer choice = twochoice(appname & ".exe was not found (or incorrect version). Would you like to automatically download it from " _ & url_hostname(download_url) & "?", , , , , "download_win_support_util") IF choice = 0 THEN IF NOT download_file(download_url, dlfile) THEN visible_debug "Unable to download " & appname & "." & extension RETURN "" END IF IF appname <> "unzip" THEN 'Unzip all files from the .zip DIM unzip as string = find_helper_app("unzip", YES) IF unzip = "" THEN visible_debug "Can't find unzip tool" RETURN "" END IF safekill apppath safekill trimextension(apppath) & "-version.txt" ' -q quiet -o overwrite -C case-insenstive -L make lowercase -j junk directories DIM arglist as string arglist = " -qoCLj " & escape_filename(dlfile) & " -d " & escape_filename(support) DIM spawn_ret as string spawn_ret = spawn_and_wait(unzip, arglist) IF NOT isfile(apppath) THEN visible_debug "Unable to unzip " & appname & ".exe from " & appname & ".zip" RETURN "" END IF safekill dlfile END IF RETURN apppath END IF END FUNCTION FUNCTION download_file (url as string, destfile as string) as bool 'Returns True on success, false on failure. ' 'Downloads to destfile. 'Uses wget -N or curl -z options to avoid downloading when the file has not changed '(but still returns true). ' 'wget is the first choice because we include it with Windows packages, but curl 'is an important fallback because it is installed by default on Mac OS X (and 'recent Windows too), unlike wget. ' 'NOTE: On WinXP at least, wget no longer is able to establish a SSL connection 'to servers. We ship an old support/wget.exe, but a new build doesn't work either. 'However a new build takes the --no-check-certificate option, while our wget.exe 'doesn't seem to have any corresponding option. However, a recent wget build from 'https://eternallybored.org/misc/wget/ is 1.7MB zipped, so not switching to it. 'On Windows XP SP3 or later, could also use powershell to download files. DIM spawn_ret as string DIM args as string DIM wget as string = find_helper_app("wget") IF wget <> "" THEN DIM destdir as string = trimfilename(destfile) IF LEN(destdir) = 0 THEN destdir = CURDIR ' The file path that wget will actually write DIM wget_dest as string = destdir + SLASH + trimpath(url) DIM need_rename as bool = NOT paths_equal(destfile, wget_dest) IF need_rename THEN debuginfo " rename " & wget_dest & " from " & destfile ' Can't use -O (outfile filename) argument with -N arg, so temporarily rename ' the file to match URL and use -P (destination directory) so wget will find it. IF real_isfile(destfile) THEN renamefile(destfile, wget_dest) END IF args = "-N -P " & escape_filename(destdir) & " " & escape_filename(url) '--Do the download spawn_ret = spawn_and_wait(wget, args) '--Check to see if the download worked IF real_isfile(wget_dest) THEN IF need_rename THEN IF renamefile(wget_dest, destfile) = NO THEN spawn_ret &= !"\nrename " & wget_dest & " to " & destfile & " failed" END IF END IF IF LEN(spawn_ret) = 0 THEN RETURN YES END IF visible_debug "ERROR: wget download failed: " & spawn_ret END IF '--find curl to do the downloading DIM curl as string = find_helper_app("curl") IF curl <> "" THEN '-L (location) means follow redirects '-z means download only if newer than given file '--fail means return exitcode 22 if the server delivers a 404 or other error page, don't save it args = "-o " & escape_filename(destfile) & _ " -L --fail " & escape_filename(url) IF real_isfile(destfile) THEN 'Avoid a warning args &= " -z " & escape_filename(destfile) END IF '--Do the download spawn_ret = spawn_and_wait(curl, args) '--Check to see if the download worked IF LEN(spawn_ret) = 0 THEN RETURN isfile(destfile) visible_debug "ERROR: curl download failed: " & spawn_ret END IF visible_debug "Could not download (with neither 'wget' nor 'curl')" RETURN NO END FUNCTION 'Display message about missing utility FUNCTION missing_helper_message (appname as string) as string #IFDEF MINIMAL_OS RETURN "Can't run programs on this platform" #ELSE DIM ret as string DIM mult as integer = INSTR(appname, " and ") ret = appname + IIF(mult, " are both missing (only one required).", " is missing.") #IFDEF __FB_WIN32__ IF appname = "hspeak" & DOTEXE THEN 'support/hspeak.exe WILL work, but that's not where we package it ret += " (It should be in the same folder as custom.exe.)" ELSE ret += " (It should be in the support folder.)" END IF #ELSEIF DEFINED(__FB_DARWIN__) ret += " This ought to be included inside OHRRPGCE-Custom! Please report this bug." #ELSE ret += " You must install it on your system." #ENDIF #IF DEFINED(__FB_WIN32__) IF INSTR(appname, "oggenc") OR INSTR(appname, "madplay") THEN 'There's no reason to bother to telling this ret += " Alternatively, download madplay+oggenc.zip from the nightly ""alternative backends"" folder at http://hamsterrepublic.com/ohrrpgce/nightly/." END IF #ENDIF RETURN ret #ENDIF END FUNCTION '========================================================================================== SUB upgrade_message (s as string) ' Don't black out the screen to show upgrade messages if there aren't any IF show_upgrade_messages AND got_upgrade_messages = NO THEN got_upgrade_messages = YES console_reset 20 console_show_message("Auto-updating game") END IF DIM temptime as double IF time_rpg_upgrade THEN temptime = TIMER upgrade_overhead_time -= temptime IF last_upgrade_time <> 0.0 THEN debuginfo "...done in " & FORMAT((temptime - last_upgrade_time) * 1000, ".#") & "ms" END IF END IF debuginfo "rpgfix:" & s IF show_upgrade_messages THEN console_show_message(s) IF time_rpg_upgrade THEN temptime = TIMER last_upgrade_time = temptime upgrade_overhead_time += temptime END IF END SUB '========================================================================================== ' Emulated Console Display '========================================================================================== 'Display text which scrolls upwards as more text is added. 'A simple wrapprint may be a better solution that this old code, which 'only supports adding one line or part of a line at a time. 'Initialise and clear a fake console. Write to it with console_{show_message,append_message} 'top, bottom: ' Pixels of space to leave at the top and bottom of the screen; ' existing contents aren't cleared. SUB console_reset (top as integer = 0, bottom as integer = 0) WITH console .margin = 4 .top = top .h = vpages(vpage)->h - top - bottom .x = .margin .y = top + .margin .c = uilook(uiBackground) DIM tempfr as Frame ptr tempfr = frame_new_view(vpages(vpage), 0, .top, vpages(vpage)->w, .h) frame_clear tempfr, .c frame_unload @tempfr END WITH END SUB 'Write a line of text (does not wrap) on a new line SUB console_show_message (s as string) WITH console IF .x > .margin THEN .x = .margin : .y += 8 console_append_message s END WITH END SUB 'Write a string at the current cursor position, add a newline first if it won't fit SUB console_append_message (s as string) DIM display as bool = YES IF RIGHT(TRIM(s), 1) = "," THEN display = NO 'Kludge for script import... should just convert it to wrapprint WITH console IF .x > .margin AND textwidth(s) + .x > vpages(vpage)->w - .margin THEN .x = .margin .y += 8 display = YES END IF IF .y >= .top + .h - 8 - .margin THEN 'scroll page up 2 lines DIM as Frame ptr tempfr, copied tempfr = frame_new_view(vpages(vpage), 0, .top + 16, vpages(vpage)->w, .h - 16) copied = frame_duplicate(tempfr) frame_clear tempfr, .c frame_draw copied, , 0, .top, NO, vpage .y -= 16 frame_unload @copied frame_unload @tempfr END IF printstr s, .x, .y, vpage .x += textwidth(s) IF display THEN setvispage vpage END WITH END SUB '========================================================================================== ' Finding data files, directories '========================================================================================== LOCAL FUNCTION get_file_type_logged(path as string) as FileTypeEnum DIM ret as FileTypeEnum = get_file_type(path) #ifdef DEBUG_FILE_IO debuginfo "try_data_path(" & path & ") = " & ret #endif RETURN ret END FUNCTION #MACRO try_data_path(path) temp = path IF get_file_type_logged(temp) = searchtype THEN RETURN temp #ENDMACRO LOCAL FUNCTION finddatafile_internal(filename as string, searchtype as FileTypeEnum) as string DIM temp as string 'platform-specific relative data files path (Mac OS X bundles) IF LEN(app_resources_dir) THEN try_data_path(app_resources_dir & SLASH & filename) END IF 'same folder as executable: Windows, or when running from source tree try_data_path(app_dir & "data" SLASH & filename) try_data_path(app_dir & filename) 'Embedded in executable (we don't try this first, so that you don't have to 'recompile to see changes in the source tree) IF find_embedded_file(filename) THEN RETURN "res://" & filename END IF #IFDEF __FB_UNIX__ '~/.ohrrpgce/ try_data_path(settings_dir & SLASH & filename) ' Assuming the binary is in $prefix/games or $prefix/bin DIM datafiles as string datafiles = app_dir & "/../share/games/ohrrpgce/" ' In this case the packaging script could avoid putting anything in a subdirectory try_data_path(datafiles & "data/" & filename) try_data_path(datafiles & filename) '/usr/share/games is optional in the Linux FHS standard, so try share/ohrrpgce too (Not seen in the wild) datafiles = app_dir & "/../share/ohrrpgce/" try_data_path(datafiles & "data/" & filename) try_data_path(datafiles & filename) #ENDIF 'Current dir... shouldn't really ever be here try_data_path("data" & SLASH & filename) try_data_path(filename) RETURN "" END FUNCTION LOCAL FUNCTION finddatafile_internal2(filename as string, searchtype as FileTypeEnum, error_if_missing as bool) as string IF LEN(filename) = 0 THEN IF error_if_missing THEN showbug "finddatafile/dir: blank filename" RETURN "" END IF DIM ret as string = finddatafile_internal(filename, searchtype) IF LEN(ret) THEN RETURN ret IF error_if_missing THEN showerror "Data " & IIF(searchtype = fileTypeFile, "file", "directory") & " data/" & _ filename & " not found. The OHRRPGCE apparently isn't installed properly. Try reinstalling." END IF END FUNCTION ' Given a filename, search all the locations that data files for Game or Custom might ' be packages, and return its path if found. ' This can return embedded files, whose path begins with "res://". Embedded files can ' only be opened using vfopen() are aren't accepted by any other functions! FUNCTION finddatafile(filename as string, error_if_missing as bool = YES) as string RETURN finddatafile_internal2(filename, fileTypeFile, error_if_missing) END FUNCTION ' Like finddatafile, for subdirectories. Has a trailing slash only if dirname has one. ' Doesn't return res:// paths. FUNCTION finddatadir(dirname as string, error_if_missing as bool = YES) as string RETURN finddatafile_internal2(dirname, fileTypeDirectory, error_if_missing) END FUNCTION ' Return the location of the data/ dir, in case you want to create a new file there ' or browse for files. Otherwise, always use finddatafile or finddatadir instead! FUNCTION get_data_dir() as string DIM temp as string DIM searchtype as FileTypeEnum = fileTypeDirectory 'Unlike finddatafile, try app_dir first because we want to prefer writeable 'locations, and this is present if run from a source tree. try_data_path(app_dir & "data") try_data_path("data") 'Contents of data/ are copied into Resources dir in Mac OS X app bundles IF LEN(app_resources_dir) THEN try_data_path(app_resources_dir) END IF #IFDEF __FB_UNIX__ try_data_path(app_dir & "/../share/games/ohrrpgce/data") try_data_path(app_dir & "/../share/ohrrpgce/data") #ENDIF IF makedir("data") = 0 THEN RETURN "data" 'Success END FUNCTION ' Given a path to a file or subdir inside the data/ directory, return a portable ' relative path to it that can be passed to finddatafile, or "" if not possible. ' This function is only really intended for use for engine development, ' so we could assume data/ is next to the executable. ' (Also converts to Unix / path separators) FUNCTION filename_relative_to_datadir(filename as string) as string DIM ret as string ret = simplify_path_further(filename, get_data_dir()) replacestr(ret, "\", "/") IF is_absolute_path(ret) OR LEFT(ret, 2) = ".." THEN notification "Not a valid asset file: not inside " & get_data_dir() RETURN "" END IF RETURN ret END FUNCTION '========================================================================================== ' Passwords '========================================================================================== FUNCTION passwordhash (p as string) as ushort 'Just a simple stupid 9-bit hash. 'The idea is just to make the password unretrieveable, without using a cryptographic hash. IF p = "" THEN RETURN 0 DIM hash as ushort FOR i as integer = 0 TO LEN(p) - 1 hash = hash * 3 + p[i] * 31 NEXT RETURN (hash AND 511) OR 512 'Never return 0 END FUNCTION 'If someone forgets their password, call this function to generate a new one FUNCTION generatepassword(byval hash as integer) as string IF hash = 0 THEN RETURN "" IF hash - 512 < 0 OR hash - 512 > 511 THEN RETURN "" DO DIM p as string = "" FOR i as integer = 0 TO 3 p += CHR(ASC("a") + randint(25)) NEXT IF passwordhash(p) = hash THEN RETURN p LOOP END FUNCTION SUB writepassword (pass as string) gen(genPassVersion) = 257 gen(genPW4Hash) = passwordhash(pass) '--Provide limited back-compat for PW3 (not possible to open a passworded '--file with an older version of Custom even if you know the password) DIM dummypw as string IF pass = "" THEN '--Write empty 3rd-style password dummypw = STRING(17, 0) ELSE '--Write unguessable garbage 3rd-style password FOR i as integer = 1 TO 17 dummypw += CHR(randint(254)) NEXT i END IF gen(genPW3Rot) = 0 str2array dummypw, gen(), 14 END SUB 'Read old-old-old password (very similar to PW3) FUNCTION read_PW1_password () as string DIM rpas as string FOR i as integer = 1 TO gen(genPW1Length) IF gen(4 + i) >= 0 AND gen(4 + i) <= 255 THEN rpas &= CHR(POSMOD(gen(4 + i) - gen(genPW1Offset), 256)) END IF NEXT i RETURN rpas END FUNCTION 'Read old-old scattertable password format FUNCTION read_PW2_password () as string DIM stray(10) as integer DIM pass as string = STRING(20, "!") FOR i as integer = 0 TO gen(genPW2Length) setbit stray(), 0, i, readbit(gen(), 200 - 1, gen(200 + i)) NEXT i array2str stray(), 0, pass pass = LEFT(pass, INT((gen(genPW2Length) + 1) / 8)) RETURN rotascii(pass, gen(genPW2Offset) * -1) END FUNCTION FUNCTION read_PW3_password () as string '--read a 17-byte string from GEN at word offset 7 '--(Note that array2str uses the byte offset not the word offset) DIM pass as string pass = STRING(17, 0) array2str gen(), 14, pass '--reverse ascii rotation / weak obfuscation pass = rotascii(pass, gen(genPW3Rot) * -1) '-- discard ascii chars lower than 32 DIM pass2 as string = "" FOR i as integer = 1 TO 17 DIM c as string = MID(pass, i, 1) IF ASC(c) >= 32 THEN pass2 += c NEXT i RETURN pass2 END FUNCTION 'Return true if it passes. 'Supports all password formats, because this is called before upgrade FUNCTION checkpassword (pass as string) as integer IF gen(genPassVersion) > 257 THEN 'Please let this never happen RETURN NO ELSEIF gen(genPassVersion) = 257 THEN RETURN (passwordhash(pass) = gen(genPW4Hash)) ELSEIF gen(genPassVersion) = 256 THEN '--new format password RETURN (pass = read_PW3_password) ELSEIF gen(genVersion) >= 3 THEN '--old scattertable format RETURN (pass = read_PW2_password) ELSE '--ancient format RETURN (pass = read_PW1_password) END IF END FUNCTION 'Used for forgotten password retrieval. Move along. FUNCTION getpassword () as string IF gen(genPassVersion) = 257 THEN RETURN "Random password: " & generatepassword(gen(genPW4Hash)) ELSEIF gen(genPassVersion) = 256 THEN RETURN read_PW3_password ELSEIF gen(genVersion) >= 3 THEN RETURN read_PW2_password ELSE RETURN read_PW1_password END IF END FUNCTION '========================================================================================== ' Upgrade old games '========================================================================================== #IFNDEF NO_UPGRADE /' 'If you used r4109 (Zenzizenzic, 2011) or later to open a game last edited before 'r1651 (Ubersetzung, 2007), all "weak to/strong to/absorbs/is enemytype" bits were 'discarded instead of being upgraded to "takes X% damage from ..." 'This routine imports them from a 2011-or-earlier .dt1 lump. SUB import_enemy_elementals_from_dt1 (copy_enemytypes_from as string) 'r4109 was also the same commit that switched DT1 to binsize IF FILELEN(copy_enemytypes_from) MOD 320 THEN visible_debug copy_enemytypes_from & " is the wrong length. Probably not from before the corruption" EXIT SUB END IF REDIM old_dat(320) as integer DIM enemy as EnemyDef FOR enemynum as integer = 0 TO gen(genMaxEnemy) loadrecord old_dat(), copy_enemytypes_from, 160, enemynum loadenemydata enemy, enemynum, NO FOR j as integer = 0 TO UBOUND(enemy.elementals) DIM currentval as single = enemy.elementals(j) DIM oldval as single = loadoldenemyresist(old_dat(), j) IF currentval <> 1.0 AND (j < 16 OR currentval <> 0.) THEN visible_debug "Enemy " & enemynum & " element " & j & " is already set to " & _ format_percent(currentval) & ", skipping enemy" EXIT FOR ELSE enemy.elementals(j) = oldval END IF NEXT saveenemydata enemy, enemynum, NO NEXT END SUB '/ 'Wandering Hamster demo from 1997 stored map tilesets in GEN, as it had no MAP lump SUB upgrade_1997 () DIM gmap(dimbinsize(binMAP)) as integer FOR mapnum as integer = 0 TO gen(genMaxMap) gmap(0) = gen(1 + mapnum) gen(1 + mapnum) = 0 storerecord gmap(), game & ".map", getbinsize(binMAP) \ 2, mapnum 'NPCs didn't have facing direction stored, and just defaulted to south DIM npcl(299) as NPCInst LoadNPCL maplumpname(mapnum, "l"), npcl() FOR i as integer = 0 TO UBOUND(npcl) npcl(i).dir = dirSouth NEXT SaveNPCL maplumpname(mapnum, "l"), npcl() NEXT 'Also, had no title screen, so set "Skip title screen" setbit gen(), genBits, 11, 1 'Other stuff: textbox to add a hero has .hero_swap = 99 and .hero_lock = 99, 'global text strings diff END SUB #IFDEF IS_CUSTOM 'Check for some corruption caused by a bug that was fixed in r9931 'and mostly introduced in r9062 (actually, existed before that but 'virtually impossible to hit) SUB check_for_broken_textbox_after_chains (branch_revision as integer) IF branch_revision < 9062 THEN 'Didn't happen setfixbit(fixCheckForBrokenTBChains, 1) EXIT SUB END IF upgrade_message "Checking for broken After chains..." DIM box as TextBox DO DIM boxes() as string DIM boxids() as integer FOR i as integer = 0 TO gen(genMaxTextBox) LoadTextBox box, i IF box.after ANDALSO box.after_tag = 0 THEN a_append boxids(), i a_append boxes(), "Box " & i & ": " & textbox_preview_line(i) END IF NEXT IF UBOUND(boxes) = -1 THEN 'No broken boxes setfixbit(fixCheckForBrokenTBChains, 1) EXIT SUB END IF DIM choice as integer = 0 choice = multichoice("The following textboxes have an `After' chain set but the " _ "After conditional is set to `Never', so the chain does nothing. " _ "This might have been caused by a bug in Dwimmercrafty and Etheldreme, " _ "which set the After condition to Never but it falsely appeared to be " _ !"`Always' in the editor!\n" _ "Select a textbox to inspect it or ESC to ignore for now. ", _ boxes(), choice) IF choice = -1 THEN EXIT DO text_box_editor boxids(choice) LOOP IF yesno("Ask again next time? If No, will be ignored forever.", YES, YES) = NO THEN setfixbit(fixCheckForBrokenTBChains, 1) END IF END SUB #ENDIF SUB try_upgrade_pt(sprtype as SpriteType) IF NOT real_isfile(workingdir + SLASH + rgfx_lumpnames(sprtype)) THEN upgrade_message "Converting sprites to " & rgfx_lumpnames(sprtype) 'convert_pt_to_rgfx handles the sprTypeEnemy funny business convert_pt_to_rgfx sprtype END IF 'Delete the old .pt file too. Far too much bloat to keep. IF sprtype = sprTypeEnemy THEN safekill game + ".pt1" safekill game + ".pt2" safekill game + ".pt3" ELSE safekill game + ".pt" & sprtype END IF END SUB SUB upgrade (show_messages as bool) DIM fh as integer DIM master_temp(255) as RGBcolor show_upgrade_messages = show_messages got_upgrade_messages = NO last_upgrade_time = 0.0 upgrade_start_time = TIMER upgrade_overhead_time = 0.0 DIM original_genVersion as integer = gen(genVersion) 'Custom and Game should both have provided a writeable workingdir. Double check. '(This is partially in vain, as we could crash if any of the lumps are unwriteable) IF NOT diriswriteable(workingdir) THEN fatalerror "Upgrade failure: " + workingdir + " not writeable" IF full_upgrade THEN debuginfo "Full game data upgrade..." ELSE debuginfo "Partial game data upgrade..." END IF DIM general_reld as Node ptr = get_general_reld() DIM last_editor_version as EngineVersion = read_last_editor_version() DIM auto_upgrader_version as EngineVersion = read_engine_version_node(general_reld."automatic_upgrader_version".ptr) ' Note that creating a new .rpg file updates the archinym creation info, but not immediately last_editor_version IF last_editor_version.recorded THEN debuginfo "Last edited by: [[" & last_editor_version.long_version & "]] branch_rev " & last_editor_version.branch_revision ELSE debuginfo "No detailed editor version info." END IF IF auto_upgrader_version.recorded THEN debuginfo "Upgraded by: " & auto_upgrader_version.long_version END IF debuginfo "archinym creation info: " & read_archinym_version() 'Any graphics in the cache would cause lost graphics during rgfx upgrade! sprite_empty_cache DIM has_sfx as bool = isfile(workingdir & SLASH & "sfxdata.bin") '---------------------------------------- 'Update record-count for all fixed-length lumps. 'WARNING: we haven't done fixWipeGEN yet, so don't initialise anything in gen(199) and up! IF time_rpg_upgrade THEN upgrade_message "Updating record counts" FOR i as integer = 0 TO sprTypeLastLoadable fix_sprite_record_count i NEXT i IF real_isfile(workingdir & SLASH & "heroes.reld") THEN 'TODO: genMaxHero fix-up for heroes.reld is unimplemented ELSEIF real_isfile(game & ".dt0") THEN 'In old versions, games start with 60 heroes fix_record_count gen(genMaxHero), getbinsize(binDT0), game & ".dt0", "Heroes" END IF fix_record_count gen(genMaxEnemy), getbinsize(binDT1), game & ".dt1", "Enemies" fix_record_count gen(genMaxFormation), 80, game & ".for", "Battle Formations" IF gen(genVersion) >= 5 THEN ' Note: there is a second record count in the header, which is respected by Palette16_load, ' and may not match gen(genMaxPal)! TODO: should probably ignore it. fix_record_count gen(genMaxPal), 16, game & ".pal", "16-color Palettes", 16 ELSE ' The .pal file format changed in Format 5 (genMaxPal is computed below) gen(genMaxPal) = 99 END IF fix_record_count gen(genMaxTextbox), getbinsize(binSAY), game & ".say", "Text Boxes" '.veh may not exist yet fix_record_count gen(genMaxVehicle), 80, game & ".veh", "Vehicles" fix_record_count gen(genMaxTagname), 42, game & ".tmn", "Tag names" 'In older versions menus.bin is always 2 bytes short... except when it's zero length or missing. 'So silence that error message. 'In fact, it might be zero length even if menu 0 has been modified (menuitem.bin contains the modified items)!! DIM menuerrlvl as ErrorLevelEnum = IIF(getbinsize(binMENUS) <= 52, errInfo, errDebug) fix_record_count gen(genMaxMenu), getbinsize(binMENUS), workingdir & SLASH & "menus.bin", "Menus", , , menuerrlvl fix_record_count gen(genMaxMenuItem), getbinsize(binMENUITEM), workingdir & SLASH & "menuitem.bin", "Menu Items" fix_record_count gen(genMaxItem), getbinsize(binITM), game & ".itm", "Items" 'palettes.bin may not exist yet fix_record_count gen(genMaxMasterPal), 256 * 3, workingdir & SLASH & "palettes.bin", "Master Palettes", 4 fix_record_count gen(genMaxSong), getbinsize(binSONGDATA), workingdir & SLASH "songdata.bin", "Songs" 'Warning: don't deduce number of maps from length of .MAP or .MN: may be appended with garbage 'FIXME: Attack data is split over two lumps. Must handle mismatch. In the meantime, a quick fix (increase only) DIM dt6_records as integer = (filelen(game & ".dt6") + 79) \ 80 IF dt6_records > gen(genMaxAttack) + 1 THEN upgrade_message "Increasing number of attacks from " & (gen(genMaxAttack) + 1) & " to " & dt6_records gen(genMaxAttack) = dt6_records - 1 END IF IF gen(genVersion) = 0 ANDALSO isfile(game & ".map") = NO THEN upgrade_message "Wow! Upgrading .RPG file from 1997" upgrade_1997 END IF 'Check the number of maps, updating gen(genMaxMap), and check all lumps are present check_map_count '---------------------------------------- '--make sure binsize.bin is full. why are we doing this? Otherwise as lumps are upgraded '--and binsize.bin is extended, records in binsize which are meant to default '--because they don't exist would become undefined instead FOR i as integer = 0 TO binLASTENTRY setbinsize i, getbinsize(i) NEXT IF getfixbit(fixNumElements) = 0 THEN setfixbit(fixNumElements, 1) 'This has to be set before we start loading and saving heroes, enemies, and items gen(genNumElements) = 16 END IF IF gen(genNumElements) < 1 THEN visible_debug "genNumElements was invalid: " & gen(genNumElements) & ". Resetting to 64" 'Set to max to be safe, because the load/save code will zero out anything above it gen(genNumElements) = 64 END IF '---------------------------------------- IF gen(genVersion) = 0 THEN upgrade_message "Ancient Pre-1999 format (1)" gen(genVersion) = 1 upgrade_message "Flushing New Text Data..." DIM box as TextBox FOR o as integer = 0 TO gen(genMaxTextbox) LoadTextBox box, o 'Zero out the data members that contained random garbage before 1999 WITH box .money_tag = 0 .money = 0 .door_tag = 0 .door = 0 .item_tag = 0 .item = 0 .choice_enabled = NO .no_box = NO .opaque = NO .restore_music = NO .choice(0) = "" .choice_tag(0) = 0 .choice(1) = "" .choice_tag(1) = 0 .game_tag = 0 .game_delete = 0 .game_save = 0 .game_load = 0 .menu_tag = 0 .vertical_offset = 0 .shrink = 0 .textcolor = 0 .boxstyle = 0 .backdrop = 0 .music = 0 .menu = 0 END WITH SaveTextBox box, o NEXT o END IF IF gen(genVersion) = 1 THEN upgrade_message "June 18 1999 format (2)" gen(genVersion) = 2 upgrade_message "Updating Door Format..." ' Read 20 records, 600 bytes each DIM doorbuf(20 * 600 \ 2) as integer IF isfile(game + ".dor") THEN xbload game + ".dor", doorbuf(), "No doors" storerecord doorbuf(), game + ".dox", 20 * 600 \ 2, 0 upgrade_message "Enforcing default font" DIM fnt(1023) as integer getdefaultfont fnt() xbsave game + ".fnt", fnt(), 2048 upgrade_message "rpgfix: Upgrading to customisable tile animations" ' The last two tiles in the tileset used to auto-toggle (only tile 158, not 159). Add a default ' tile animation and replace those tiles with animated tiles. DIM tanim(1) as TileAnimPattern WITH tanim(0) .range_start = 112 '--wait 3-- .cmd(0).op = taopWait .cmd(0).arg = 3 '--right 1-- .cmd(1).op = taopRight .cmd(1).arg = 1 '--wait 3-- .cmd(2).op = taopWait .cmd(2).arg = 3 '--left 1-- .cmd(3).op = taopLeft .cmd(3).arg = 1 '--end-- END WITH FOR i as integer = 0 TO gen(genMaxTile) save_tile_anims i, tanim() NEXT i DIM tmap as TileMap FOR i as integer = 0 TO gen(genMaxMap) debuginfo "rpgfix: map " & i loadtilemap tmap, maplumpname(i, "t") FOR tx as integer = 0 TO tmap.wide - 1 FOR ty as integer = 0 TO tmap.high - 1 IF readblock(tmap, tx, ty) = 158 THEN writeblock tmap, tx, ty, 206 NEXT ty NEXT tx savetilemap tmap, maplumpname(i, "t") NEXT i unloadtilemap tmap END IF '---VERSION 3--- IF gen(genVersion) = 2 THEN upgrade_message "July 8 1999 format (3)" upgrade_message "Zero-out un-used data in .MAP records" 'This fix might be needed for games in later formats, especially ones ' that are already have gen(genVersion) = 3 but unfortunately this ' is the last place we can apply the fix in a safe way that does not ' risk data-loss (particularly map autorun script triggers) zero_out_pre_july_8_1999_general_map_data_garbage() gen(genVersion) = 3 writepassword read_PW1_password 'No need to remove the old password: we just overwrote it with 'a back-compat PW3 blank/garbage password /' This is should no longer be needed, since these are all set by fix_record_count '(Some of these are maximum possible values, some are off-by-one, others are correct) upgrade_message "Put record count defaults in GEN..." gen(genMaxHeroPic) = 40 gen(genMaxEnemy1Pic) = 149 gen(genMaxEnemy2Pic) = 79 gen(genMaxEnemy3Pic) = 29 gen(genMaxNPCPic) = 119 gen(genMaxWeaponPic) = 149 gen(genMaxAttackPic) = 99 gen(genMaxTile) = 14 gen(genMaxAttack) = 200 gen(genMaxHero) = 59 gen(genMaxEnemy) = 500 gen(genMaxFormation) = 1000 gen(genMaxPal) = 99 gen(genMaxTextbox) = 999 '/ END IF '--VERSION 4-- IF gen(genVersion) = 3 THEN upgrade_message "Sept 15 2000 format (4)" gen(genVersion) = 4 upgrade_message "Clearing New Attack Bitsets..." FOR o as integer = 0 TO gen(genMaxAttack) loadoldattackdata buffer(), o buffer(18) = 0 IF readbit(buffer(), 20, 60) THEN buffer(18) = 1 setbit buffer(), 20, 2, 0 FOR i as integer = 21 TO 58 setbit buffer(), 20, i, 0 NEXT i FOR i as integer = 60 TO 63 setbit buffer(), 20, i, 0 NEXT i saveoldattackdata buffer(), o NEXT o setbit gen(), genBits, 6, 0 'no hide readymeter setbit gen(), genBits, 7, 0 'no hide health meter END IF '--VERSION 5-- IF gen(genVersion) = 4 THEN upgrade_message "March 31 2001 format (5)" gen(genVersion) = 5 upgrade_message "Upgrading 16-color Palette Format..." ' Change the .pal header from a 7 byte BSAVE one to a custom 16 byte one. DIM temppal16(8 - 1) as integer xbload game + ".pal", buffer(), "16-color palettes missing from " + sourcerpg killfile game + ".pal" '--find last used palette DIM last as integer = gen(genMaxPal) FOR j as integer = gen(genMaxPal) TO 0 STEP -1 FOR i as integer = 0 TO 7 IF buffer(j * 8 + i) <> 0 THEN last = j EXIT FOR, FOR END IF NEXT i NEXT j upgrade_message "Last used palette is " & last gen(genMaxPal) = last '--write header temppal16(0) = 4444 temppal16(1) = last FOR i as integer = 2 TO 7 temppal16(i) = 0 NEXT i storerecord temppal16(), game + ".pal", 16 \ 2, 0 '--append palettes (really just replacing the header and keeping everything else the same) FOR j as integer = 0 TO last FOR i as integer = 0 TO 7 temppal16(i) = buffer(j * 8 + i) NEXT i storerecord temppal16(), game + ".pal", 16 \ 2, 1 + j NEXT j 'esperable (2003) introduced the bug where harm tiles no longer damage the 'whole active party if the caterpillar is disabled. Fixed for alectormancy. 'The best we can do is not emulating the bug for versions before March 2001 :( setprefbit 28 'Harm tiles harm non-caterpillar heroes END IF '--VERSION 6-- IF gen(genVersion) = 5 THEN upgrade_message "Serendipity format (6)" 'Shop stuff and song name formats changed, MIDI music added 'Sub version info also added 'Clear battle formation animation data FOR i as integer = 0 TO gen(genMaxFormation) loadrecord buffer(), game + ".for", 80 \ 2, i buffer(34) = 0 buffer(35) = 0 storerecord buffer(), game + ".for", 80 \ 2, i NEXT i gen(genVersion) = 6 END IF '--VERSION 7 and up! ' It is a good idea to increment this number each time a major feature ' has been added, if opening a new game in an old editor would cause data-loss ' Don't be afraid to increment this. Backcompat warnings are a good thing! IF gen(genVersion) < CURRENT_RPG_VERSION THEN upgrade_message "Bumping RPG format version number from " & gen(genVersion) & " to " & CURRENT_RPG_VERSION gen(genVersion) = CURRENT_RPG_VERSION '--update me in const.bi END IF IF gen(genPassVersion) = 256 THEN '--Update PW3 to PW4 upgrade_message "Updating PW3 password storage format" writepassword read_PW3_password ELSEIF gen(genPassVersion) < 256 THEN '--At this point we know the password format is PW2 (not PW1), scattertable upgrade_message "Updating PW2 password storage format" writepassword read_PW2_password END IF 'Zero out the PW2 scattertable (almost all games) as well as some other explained garbage (a few games) in gen() IF getfixbit(fixWipeGEN) = NO THEN upgrade_message "Wiping gen(199...)" setfixbit(fixWipeGEN, YES) FOR i as integer = 199 TO 499 gen(i) = 0 NEXT END IF IF NOT isfile(workingdir + SLASH + "archinym.lmp") THEN upgrade_message "generate default archinym.lmp" '--create archinym information lump OPENFILE(workingdir + SLASH + "archinym.lmp", FOR_OUTPUT, fh) PRINT #fh, RIGHT(game, LEN(game) - LEN(workingdir + SLASH)) PRINT #fh, short_version + "(previous)" CLOSE #fh END IF 'Initialise some data in general.reld and update either editor_version (Custom) 'or automatic_upgrader_version (Game) update_general_data 'This is corruption recovery, not upgrade, but Custom has always done this IF NOT isfile(game + ".fnt") THEN debug game + ".fnt missing (which should never happen)" DIM fnt(1023) as integer getdefaultfont fnt() xbsave game + ".fnt", fnt(), 2048 END IF IF NOT isfile(game + ".veh") THEN upgrade_message "add vehicle data" '--make sure vehicle lump is present DIM templatefile as string = finddatafile("ohrrpgce.new") IF templatefile <> "" THEN unlumpfile(templatefile, "ohrrpgce.veh", tmpdir) 'Recall it's best to avoid moving files across filesystems copyfile tmpdir & "ohrrpgce.veh", game & ".veh" safekill tmpdir & "ohrrpgce.veh" 'gen(genMaxVehicle) = 2 fix_record_count gen(genMaxVehicle), 80, game & ".veh", "Vehicles" END IF END IF IF NOT isfile(workingdir + SLASH + "attack.bin") THEN upgrade_message "Init extended attack data..." setbinsize binATTACK, curbinsize(binATTACK) flusharray buffer(), dimbinsize(binAttack), 0 FOR i as integer = 0 TO gen(genMaxAttack) savenewattackdata buffer(), i NEXT i '--and while we are at it, clear the old death-string from enemies upgrade_message "Re-init recycled enemy data..." FOR i as integer = 0 TO gen(genMaxEnemy) loadenemydata buffer(), i, NO FOR j as integer = 17 TO 52 buffer(j) = 0 NEXT j saveenemydata buffer(), i, NO NEXT i END IF IF NOT isfile(workingdir + SLASH + "songdata.bin") THEN upgrade_message "Upgrading Song Name format..." DIM song(99) as string DIM temp as integer = FILELEN(game + ".sng") IF temp > 0 THEN OPENFILE(game + ".sng", FOR_INPUT, fh) FOR i as integer = 0 TO 99 INPUT #fh, song(i) NEXT i CLOSE #fh END IF gen(genMaxSong) = 99 FOR i as integer = 99 TO 1 STEP -1 '-- check for midis as well 'cause some people might use a WIP custom or whatnot IF song(i) <> "" OR isfile(game + "." + STR(i)) OR isfile(workingdir + SLASH + "song" + STR(i) + ".mid") THEN gen(genMaxSong) = i EXIT FOR END IF NEXT setbinsize binSONGDATA, curbinsize(binSONGDATA) flusharray buffer(), dimbinsize(binSONGDATA), 0 FOR i as integer = 0 TO gen(genMaxSong) writebinstring song(i), buffer(), 0, 30 storerecord buffer(), workingdir + SLASH + "songdata.bin", curbinsize(binSONGDATA) \ 2, i NEXT ERASE song END IF IF NOT isfile(workingdir + SLASH + "palettes.bin") THEN upgrade_message "Upgrading Master Palette format..." IF NOT isfile(game + ".mas") THEN debug "Warning: " & game & ".mas does not exist (which should never happen)" load_default_master_palette master_temp() ELSE loadpalette master_temp(), 0 'Loads from .mas END IF gen(genMaxMasterPal) = 0 savepalette master_temp(), 0 'Saves to palettes.bin END IF 'Safety-check for negative gen(genMasterPal) because of one known game that somehow had -2 gen(genMasterPal) = bound(gen(genMasterPal), 0, gen(genMaxMasterPal)) IF gen(genHeroWeakHP) = 0 THEN gen(genHeroWeakHP) = 20 END IF IF gen(genEnemyWeakHP) = 0 THEN gen(genEnemyWeakHP) = 20 END IF '--If no stf lump exists, create an empty one. IF NOT isfile(game + ".stf") THEN touchfile game + ".stf" '--check variable record size lumps and reoutput them if records have been extended '--all of the files below should exist, be non zero length and have non zero record size by this point '--...except for menu lumps updaterecordlength workingdir + SLASH + "attack.bin", binATTACK updaterecordlength game + ".stf", binSTF updaterecordlength workingdir + SLASH + "songdata.bin", binSONGDATA updaterecordlength workingdir + SLASH + "sfxdata.bin", binSFXDATA updaterecordlength game + ".tap", binTAP updaterecordlength game + ".map", binMAP updaterecordlength workingdir + SLASH + "menus.bin", binMENUS updaterecordlength workingdir + SLASH + "menuitem.bin", binMENUITEM IF NOT isfile(workingdir + SLASH + "menuitem.bin") THEN upgrade_message "Creating default menu file..." DIM def_menu_set as MenuSet def_menu_set.menufile = workingdir + SLASH + "menus.bin" def_menu_set.itemfile = workingdir + SLASH + "menuitem.bin" DIM menu as MenuDef ' If we're playing an old game without sound effects, SFX volume option is pointless create_default_menu menu, has_sfx SaveMenuData def_menu_set, menu, 0 END IF updaterecordlength game & ".say", binSAY updaterecordlength game & ".dt0", binDT0 updaterecordlength game & ".dt1", binDT1 updaterecordlength game & ".itm", binITM 'Don't update .N binsize until all records have been stretched FOR i as integer = 0 TO gen(genMaxMap) updaterecordlength maplumpname(i, "n"), binN, 7, YES NEXT setbinsize binN, curbinsize(binN) 'If you want to add more colours to uicolors.bin, you'll want to record what the old 'record length was (one record per palette), then updaterecordlength, then fill in 'the new colours, which start zeroed out. 'However, if uicolors.bin is completely empty/missing, then just let the block below 'initialise the lump. updaterecordlength workingdir + SLASH + "uicolors.bin", binUICOLORS '--give each palette a default ui color set DIM uilook_temp(uiColorLast) as integer DIM boxlook_temp(uiBoxLast) as BoxStyle 'This step creates both the uicolors.bin file (obsolete, but kept for compat) 'And the uicolors node in general.reld DIM uirecords as integer = FILELEN(workingdir + SLASH + "uicolors.bin") \ getbinsize(binUICOLORS) IF uirecords < gen(genMaxMasterPal) + 1 THEN upgrade_message "Adding default UI colors..." FOR i as integer = uirecords TO gen(genMaxMasterPal) 'In old games (before uicolors.bin was added), use the old fixed color indices, for compatibility loadpalette master_temp(), i IF original_genVersion <= 7 THEN 'Before Ypsiliform WIPs OldDefaultUIColors master_temp(), uilook_temp(), boxlook_temp() SaveUIColors uilook_temp(), boxlook_temp(), i ELSE 'Otherwise, missing records is a bug. Do nearest match with default GuessDefaultUIColors master_temp(), uilook_temp() GuessDefaultBoxStyles master_temp(), boxlook_temp() SaveUIColors uilook_temp(), boxlook_temp(), i END IF NEXT END IF 'Work around a bug: vehicle shadow colour shouldn't be 0 FOR i as integer = 0 TO gen(genMaxMasterPal) loadpalette master_temp(), i LoadUIColors uilook_temp(), boxlook_temp(), i, master_temp() IF uilook_temp(uiShadow) = 0 THEN 'This is a hack. Unfortunately ellipse slice border and fill colors can't be 0 as that 'counts as transparent. This is a design mistake in ellipse slices, but is too much trouble to fix uilook_temp(uiShadow) = nearcolor(master_temp(), 0, 1) SaveUIColors uilook_temp(), boxlook_temp(), i END IF NEXT 'Create defpal#.bin if it doesn't already exist FOR sprtype as SpriteType = 0 TO sprTypeLastPT DIM maxset as integer = gen(sprite_sizes(sprtype).genmax) DIM defpals(maxset) as integer '(This calls guessdefaultpals if the lump is missing, so this needs to happen 'after updaterecordlength for NPC (and other?) data) loaddefaultpals sprtype, defpals() savedefaultpals sprtype, defpals(), maxset NEXT IF full_upgrade THEN try_upgrade_pt sprTypeHero try_upgrade_pt sprTypeEnemy 'Initialises gen(genMaxEnemyPic) try_upgrade_pt sprTypeWalkabout try_upgrade_pt sprTypeWeapon try_upgrade_pt sprTypeAttack try_upgrade_pt sprTypePortrait try_upgrade_pt sprTypeBoxBorder IF NOT isfile(workingdir + SLASH + "backdrops.rgfx") THEN upgrade_message "Converting backdrops to backdrops.rgfx" convert_mxs_to_rgfx game + ".mxs", workingdir + SLASH + "backdrops.rgfx", sprTypeBackdrop END IF safekill game + ".mxs" sprite_empty_cache END IF IF getfixbit(fixExtendedTileAnims) = 0 THEN upgrade_message "Extend tile animations..." 'load_tile_anims initializes the new data if the fixbit is off REDIM tanim(1) as TileAnimPattern FOR i as integer = 0 TO gen(genMaxTile) load_tile_anims i, tanim() save_tile_anims i, tanim() NEXT i setfixbit(fixExtendedTileAnims, 1) END IF 'Workaround bug #2013: Backdrops were drawn immediately above (instead of) spritelayer until 'r5437, which swapped the order. genVersion was increased to 18 in r5477 IF original_genVersion <= 17 THEN setprefbit 39 'Draw Backdrop slice above Script layer END IF 'Zero out new attack item cost (ammunition) data IF getfixbit(fixAttackitems) = 0 THEN upgrade_message "Zero new ammunition data..." setfixbit(fixAttackitems, 1) OPENFILE(workingdir + SLASH + "attack.bin", FOR_BINARY + ACCESS_READ_WRITE, fh) REDIM dat(dimbinsize(binATTACK)) as short DIM record_pos as integer = 1 FOR idx as integer = 0 to gen(genMaxAttack) GET #fh, record_pos, dat() FOR y as integer = 53 TO 59 dat(y) = 0 NEXT PUT #fh, record_pos, dat() record_pos += getbinsize(binATTACK) NEXT CLOSE #fh END IF IF getfixbit(fixWeapPoints) = 0 THEN upgrade_message "Reset hero hand points..." DO setfixbit(fixWeapPoints, 1) 'This fixbit is older than heroes.reld, so we can assume only need to upgrade .dt0 IF OPENFILE(game + ".dt0", FOR_BINARY + ACCESS_READ_WRITE, fh) THEN EXIT DO 'lump doesn't exist REDIM dat(dimbinsize(binDT0)) as short FOR i as integer = 0 to gen(genMaxHero) GET #fh, , dat() IF dat(297) <> 0 OR dat(298) <> 0 OR dat(299) <> 0 OR dat(300) <> 0 THEN CLOSE #fh EXIT DO 'they already use hand points, abort! END IF NEXT DIM record_pos as integer = 1 DIM recsize as integer = getbinsize(binDT0) FOR idx as integer = 0 to gen(genMaxHero) GET #fh, record_pos, dat() dat(297) = 24 dat(299) = -20 PUT #fh, record_pos, dat() record_pos += recsize NEXT CLOSE #fh EXIT DO LOOP END IF 'Upgrade attack data DIM fix_stun as integer = (getfixbit(fixStunCancelTarg) = 0) DIM fix_dam_mp as integer = (getfixbit(fixRemoveDamageMP) = 0) AND full_upgrade DIM fix_elem_fails as integer = (getfixbit(fixAttackElementFails) = 0) AND full_upgrade ' Temporarily disable upgrade to new damage/aim attack data, so that the format can still ' be changed if we desire, since the editor doesn't support it yet. ' (Instead, loadattackdata will perform these upgrades, since we don't set the fixbit.) 'DIM fix_multipliers as integer = (getfixbit(fixAttackMultipliers) = 0) AND full_upgrade DIM fix_multipliers as bool = NO IF fix_stun OR fix_dam_mp OR fix_elem_fails OR fix_multipliers THEN IF fix_stun THEN upgrade_message "Target disabling old stun attacks..." setfixbit(fixStunCancelTarg, 1) END IF IF fix_dam_mp THEN upgrade_message "Remove obsolete 'Damage MP' bit..." setfixbit(fixRemoveDamageMP, 1) END IF IF fix_elem_fails THEN upgrade_message "Init attack elemental failure conditions..." setfixbit(fixAttackElementFails, 1) END IF IF fix_multipliers THEN upgrade_message "Init new attack aim & damage data..." setfixbit(fixAttackMultipliers, 1) END IF REDIM dat(40 + dimbinsize(binATTACK)) as integer DIM cond as AttackElementCondition FOR i as integer = 0 to gen(genMaxAttack) DIM saveattack as bool = NO loadattackdata dat(), i IF fix_stun AND dat(18) = 14 THEN '--Target stat is stun register IF readbit(dat(), 20, 0) THEN GOTO skipfix '--cure instead of harm IF dat(5) = 5 OR dat(5) = 6 THEN '--set to percentage IF dat(11) >= 0 THEN GOTO skipfix '-- set to >= 100% END IF 'Turn on the disable target attack bit setbit dat(), 65, 12, YES saveattack = YES END IF skipfix: IF fix_dam_mp THEN IF readbit(dat(), 20, 60) THEN '--Damage MP setbit dat(), 20, 60, NO saveattack = YES IF dat(18) = statHP THEN dat(18) = statMP END IF END IF IF fix_elem_fails THEN FOR j as integer = 0 TO 63 'maxElements - 1 loadoldattackelementalfail cond, dat(), j SerAttackElementCond cond, dat(), 121 + j * 3 NEXT saveattack = YES END IF IF fix_multipliers THEN '.randomization = IIF(.do_not_randomize, 0, 20) dat(337) = IIF(readbit(dat(), 20, 61), 0, 20) setbit dat(), 20, 61, NO 'Clear "do not randomize" SerSingle(dat(), 325, 1.0) '.acc_mult SerSingle(dat(), 327, 1.0) '.dog_mult SerSingle(dat(), 329, 1.0) '.atk_mult SerSingle(dat(), 331, 1.0) '.def_mult SerSingle(dat(), 335, 1.0) '.absorb_rate saveattack = YES END IF IF saveattack THEN saveattackdata dat(), i NEXT END IF IF gen(genDefCounterProvoke) = 0 THEN gen(genDefCounterProvoke) = provokeAlways '------------------------------------------------------------------------------- ' Enemies '(There's also some code above that initialises some enemy data) IF getfixbit(fixDefaultDissolve) = 0 THEN upgrade_message "Initializing default enemy fade..." setfixbit(fixDefaultDissolve, 1) gen(genEnemyDissolve) = 0 END IF DIM as bool fixdissolves = (getfixbit(fixDefaultDissolveEnemy) = 0) DIM as bool fixelementals = (getfixbit(fixEnemyElementals) = 0) IF full_upgrade ANDALSO (fixdissolves OR fixelementals) THEN IF fixdissolves THEN upgrade_message "Initializing default enemy fade (per enemy)..." END IF IF fixelementals THEN upgrade_message "Initialising enemy elemental resists..." END IF ' loadenemydata will upgrade the data when loading. All we have to do is load and save again. DIM enemy as EnemyDef FOR i as integer = 0 TO gen(genMaxEnemy) loadenemydata enemy, i, NO saveenemydata enemy, i, NO NEXT setfixbit(fixDefaultDissolveEnemy, 1) setfixbit(fixEnemyElementals, 1) END IF '------------------------------------------------------------------------------- IF getfixbit(fixPushNPCBugCompat) = 0 THEN upgrade_message "Enabling 'Simulate pushable NPC bug' bitset..." setfixbit(fixPushNPCBugCompat, 1) setprefbit 16 '"Simulate Pushable NPC obstruction bug" END IF IF getfixbit(fixDefaultMaxItem) = 0 THEN setfixbit(fixDefaultMaxItem, 1) 'This is no longer done; genMaxItem has already been set above. 'gen(genMaxItem) = 254 END IF IF getfixbit(fixBlankDoorLinks) = 0 THEN upgrade_message "Disable redundant blank door links..." setfixbit(fixBlankDoorLinks, 1) DIM doorlink_temp(199) as DoorLink DIM found_first as integer FOR i as integer = 0 TO gen(genMaxMap) deserDoorLinks maplumpname(i, "d"), doorlink_temp() found_first = NO FOR j as integer = 0 TO UBOUND(doorlink_temp) WITH doorlink_temp(j) IF .source = 0 AND .tag1 = 0 AND .tag2 = 0 THEN IF found_first = NO THEN 'Ignore the first "always" link for door 0 found_first = YES ELSE IF .dest = 0 AND .dest_map = 0 THEN .source = -1 ' Mark redundant all-zero links as unused END IF END IF END IF END WITH NEXT j serDoorLinks maplumpname(i, "d"), doorlink_temp() NEXT i END IF IF getfixbit(fixShopSounds) = 0 THEN upgrade_message "Set default soundeffects..." setfixbit(fixShopSounds, 1) gen(genItemLearnSFX) = gen(genAcceptSFX) gen(genCantLearnSFX) = gen(genCancelSFX) gen(genBuySFX) = gen(genAcceptSFX) gen(genHireSFX) = gen(genAcceptSFX) gen(genSellSFX) = gen(genAcceptSFX) gen(genCantBuySFX) = gen(genCancelSFX) gen(genCantSellSFX) = gen(genCancelSFX) END IF IF getfixbit(fixExtendedNPCs) = 0 THEN upgrade_message "Initialize extended NPC data..." setfixbit(fixExtendedNPCs, 1) REDIM npctemp(0) as NPCType FOR i as integer = 0 TO gen(genMaxMap) ' These are the garbage data left over from somewhere in the late 90's when ' James decided to make the .N lumps big enough to hold 100 NPC definitions ' even though there was only enough memory available for 36 NPC sprites at a time LoadNPCD maplumpname(i, "n"), npctemp() REDIM PRESERVE npctemp(35) SaveNPCD maplumpname(i, "n"), npctemp() NEXT i END IF IF getfixbit(fixHeroPortrait) = 0 OR getfixbit(fixHeroElementals) = 0 THEN DIM as integer do_portraits = (getfixbit(fixHeroPortrait) = 0) DIM as integer do_elements = (getfixbit(fixHeroElementals) = 0) setfixbit(fixHeroPortrait, 1) setfixbit(fixHeroElementals, 1) DIM as string msgtemp = "Initialize hero " IF do_portraits THEN msgtemp += "portraits" IF do_portraits AND do_elements THEN msgtemp += " and " IF do_elements THEN msgtemp += "elemental resists" upgrade_message msgtemp DIM her as HeroDef FOR i as integer = 0 TO gen(genMaxHero) loadherodata her, i WITH her IF do_portraits THEN .portrait = -1 'Disable .portrait_pal = -1 'Default END IF IF do_elements THEN '.elementals() not initialised, load from old bits FOR i as integer = 0 TO small(7, gen(genNumElements) - 1) .elementals(i) = backcompat_element_dmg(xreadbit(.bits(), i), xreadbit(.bits(), 8 + i), xreadbit(.bits(), 16 + i)) NEXT 'gen(genNumElements) will be more than 8 even in old games after enemytypes are converted to elements FOR i as integer = 8 TO gen(genNumElements) - 1 .elementals(i) = 1 NEXT END IF END WITH saveherodata her, i NEXT i END IF 'This fixbit was introduced at the same time as textbox portraits, 'so if it's not on, then the game doesn't use portraits, so it doesn't 'need to be fixed for Game. IF full_upgrade AND getfixbit(fixTextBoxPortrait) = 0 THEN upgrade_message "Initialize text box portrait data..." setfixbit(fixTextBoxPortrait, 1) 'DIM box as TextBox DIM boxbuf(dimbinsize(binSAY)) as integer DIM recsize as integer = getbinsize(binSAY) \ 2 OPENFILE(game & ".say", FOR_BINARY + ACCESS_READ_WRITE, fh) FOR i as integer = 0 TO gen(genMaxTextBox) 'This was stupefying slow, by far the slowest of all upgrades 'LoadTextBox box, i 'box.portrait_pal = -1 'Default palette 'SaveTextBox box, i loadrecord boxbuf(), fh, recsize, i boxbuf(202) = -1 'Default palette storerecord boxbuf(), fh, recsize, i NEXT i CLOSE #fh END IF IF getfixbit(fixInitDamageDisplay) = 0 THEN upgrade_message "Initialize damage display time/distance data..." setfixbit(fixInitDamageDisplay, 1) gen(genDamageDisplayTicks) = 7 gen(genDamageDisplayRise) = 14 END IF IF getfixbit(fixDefaultLevelCap) = 0 THEN upgrade_message "Set level cap to 99..." setfixbit(fixDefaultLevelCap, 1) gen(genLevelCap) = 99 END IF IF getfixbit(fixDefaultMaxLevel) = 0 THEN upgrade_message "Set max level to 99..." setfixbit(fixDefaultMaxLevel, 1) gen(genMaxLevel) = 99 END IF IF gen(genResolutionX) < 10 THEN gen(genResolutionX) = 320 IF gen(genResolutionY) < 10 THEN gen(genResolutionY) = 200 IF gen(genWindowSize) <= 0 THEN gen(genWindowSize) = 8 '<= 80% of screen IF gen(genLivePreviewWindowSize) <= 0 THEN gen(genLivePreviewWindowSize) = 5 '<= 50% of screen IF getfixbit(fixUNUSED23) = 1 THEN 'James says: this bit was originally planned to initialise gen(192) 'with the maximum tag number 999, but then it was decided that it would 'be better to use a general bitset rather than storing the specific 'number of allowed tags. upgrade_message "Clear wasted fixbit 23" setfixbit(fixUNUSED23, 0) gen(192) = 0 END IF IF getfixbit(fixSetOldAttackPosBit) = 0 THEN upgrade_message "Enabling 'Old attack positioning at bottom-left of target' bit" setfixbit(fixSetOldAttackPosBit, 1) setprefbit 36 ' "Old attack positioning at bottom-left of target" END IF IF getfixbit(fixWrapCroppedMapsBit) = 0 THEN setfixbit(fixWrapCroppedMapsBit, 1) 'Since r6473 'Crop' maps no longer wrap IF last_editor_version.branch_revision < 6473 THEN upgrade_message "Enabling 'Wrap map layers over edge of Crop maps' bit" setprefbit 37 'Wrap map layers over edge of Crop maps END IF END IF IF getfixbit(fixOldElementalFailBit) = 0 THEN upgrade_message "Enabling 'Simulate old fail vs. element resist bit' bitset" setfixbit(fixOldElementalFailBit, 1) setprefbit 25 END IF IF gen(genItemStackSize) <= 0 OR gen(genItemStackSize) > 99 THEN gen(genItemStackSize) = 99 END IF IF gen(genMillisecPerFrame) = 0 THEN gen(genMillisecPerFrame) = 55 END IF IF getfixbit(fixInitDefaultVolumes) = 0 THEN upgrade_message "Initialising default volumes ..." setfixbit(fixInitDefaultVolumes, 1) gen(genMusicVolume) = 50 gen(genSFXVolume) = 75 END IF IF full_upgrade ANDALSO getfixbit(fixItemElementals) = 0 THEN upgrade_message "Initialising equipment elemental resists..." setfixbit(fixItemElementals, 1) REDIM dat(dimbinsize(binITM)) as integer FOR i as integer = 0 TO gen(genMaxItem) loaditemdata dat(), i FOR j as integer = 0 TO 63 'maxElements - 1 SerSingle(dat(), 82 + j*2, LoadOldItemElemental(dat(), j)) NEXT saveitemdata dat(), i NEXT END IF 'Initialize the non_elemental_for_spawning data IF getfixbit(fixInitNonElementalSpawning) = 0 THEN upgrade_message "Initializing elementals for non-elemental spawning..." setfixbit(fixInitNonElementalSpawning, 1) DIM elementals_node as NodePtr = GetOrCreateChild(general_reld, "elementals") DIM element_node as NodePtr DIM non_elemental_node as NodePtr DIM non_elemental_default as integer FOR i as integer = 0 to maxElements - 1 non_elemental_default = 0 IF original_genVersion <= 14 ANDALSO (i >= 8 ANDALSO i <= 15) THEN 'This is a type-killer elemental in a game that is being upgraded from RPG version 14 or older non_elemental_default = 1 END IF element_node = AppendChildNode(elementals_node, "element", i) non_elemental_node = AppendChildNode(element_node, "non_elemental", non_elemental_default) NEXT i END IF IF gen(genStartHero) < 0 OR gen(genStartHero) > gen(genMaxHero) THEN upgrade_message "genStartHero invalid: " & gen(genStartHero) gen(genStartHero) = 0 END IF IF gen(genStartTextbox) < 0 OR gen(genStartTextbox) > gen(genMaxTextbox) THEN upgrade_message "genStartTextbox invalid: " & gen(genStartTextbox) gen(genStartTextbox) = 0 END IF apply_script_fixups IF time_rpg_upgrade THEN upgrade_message "Upgrades complete." debuginfo "Total upgrade time = " & FORMAT(TIMER - upgrade_start_time, ".###") & "s, time wasted on messages = " & FORMAT(upgrade_overhead_time, ".###") & "s" END IF 'Not currently used gen(genErrorLevel) = serrIgnore 'Save changes to GEN lump (important when exiting to the title screen and loading a SAV) xbsave game + ".gen", gen(), 1000 'Save changes to the general.reld lump too! write_general_reld() #IFDEF IS_CUSTOM IF getfixbit(fixCheckForBrokenTBChains) = 0 THEN check_for_broken_textbox_after_chains last_editor_version.branch_revision END IF #ENDIF 'wow! this is quite a big and ugly routine! END SUB 'Called from upgrade LOCAL SUB apply_script_fixups load_script_triggers_and_names 'Check for use of https://rpg.hamsterrepublic.com/ohrrpgce/Scripts:Hero_will_move '(which is used by https://rpg.hamsterrepublic.com/ohrrpgce/Scripts:Fake_Parallax) IF getfixbit(fixCheckTryingToMoveDirection) = NO THEN setfixbit fixCheckTryingToMoveDirection, 1 IF a_find(script_names(), "tryingtomovedirection") > 0 THEN upgrade_message "Enabling 'Use old direction key tiebreaking' bit" setprefbit 57 '"Use old direction key tiebreaking"" END IF END IF END SUB SUB zero_out_pre_july_8_1999_general_map_data_garbage () 'Some lost-to-history version of custom.exe wrote garbage to the 'then-unused areas of the .MAP records for General Map Data. ' 'Unfortunately this garbage can only be safely zeroed out for games 'older than July 8 1999, which is the last identifiable version before 'more records were used in the .MAP lump starting with the unidentifiable 'November 9 1999 version that added map wrapping and script-autorun triggers. IF gen(genVersion) > 2 THEN debug "Sanity test: zero_out_pre_july_8_1999_general_map_data_garbage() is unsafe on games newer than July 8 1999" EXIT SUB END IF DIM gmaptmp(dimbinsize(binMAP)) as integer DIM resave as bool = NO FOR i as integer = 0 to gen(genMaxMap) resave = NO loadrecord gmaptmp(), game & ".map", getbinsize(binMAP) \ 2, i FOR j as integer = 4 TO 19 IF gmaptmp(j) <> 0 THEN resave = YES gmaptmp(j) = 0 END IF NEXT j IF resave THEN debug "general map data garbage found and cleared for map " & i storerecord gmaptmp(), game & ".map", getbinsize(binMAP) \ 2, i END IF NEXT i END SUB '========================================================================================== ' Data upgrades '========================================================================================== SUB updaterecordlength (lumpf as string, byval bindex as integer, byval headersize as integer = 0, byval repeating as bool = NO) 'If the length of records in this lump has changed (increased) according to binsize.bin, stretch it, padding records with zeroes. 'Note: does not create a lump if it doesn't exist. 'Pass 'repeating' as true when more than one lump with this bindex exists. ''headersize' is the number of bytes before the first record. IF getbinsize(bindex) < curbinsize(bindex) THEN DIM oldsize as integer = getbinsize(bindex) DIM newsize as integer = curbinsize(bindex) upgrade_message trimpath(lumpf) & " record size = " & newsize 'Only bother to do this for records of nonzero size (this implies the file doesn't exist, right?) IF oldsize > 0 ANDALSO isfile(lumpf) THEN DIM tempf as string = lumpf & ".resize.tmp" IF renamefile(lumpf, tempf) = NO THEN fatalerror "Impossible to upgrade game: Could not move " & lumpf END IF DIM inputf as integer DIM outputf as integer IF OPENFILE(tempf, FOR_BINARY + ACCESS_READ, inputf) ORELSE _ OPENFILE(lumpf, FOR_BINARY + ACCESS_WRITE, outputf) THEN fatalerror "Impossible to upgrade game: Could not open " & lumpf & "[.resize.tmp]" END IF 'Round up record count. Due to various bugs a record might be short. Will be zero-extended. '(Note that if a partial record is not extended here, then fix_record_count will do so) DIM total_bytes as integer = LOF(inputf) - headersize DIM records as integer = total_bytes \ oldsize IF total_bytes MOD oldsize THEN debuginfo "updaterecordslength: last record of " & trimpath(lumpf) & " is " & (total_bytes MOD oldsize) & " bytes, expected " & oldsize & ". Extending." records += 1 END IF IF headersize > 0 THEN DIM headerbuf(headersize - 1) as BYTE GET #inputf, , headerbuf() PUT #outputf, , headerbuf() END IF DIM buf(newsize \ 2 - 1) as integer FOR i as integer = 0 TO records - 1 loadrecord buf(), inputf, oldsize \ 2 storerecord buf(), outputf, newsize \ 2 NEXT CLOSE inputf CLOSE outputf killfile tempf END IF 'If we are repeating, we need to keep the old binsize intact IF repeating = NO THEN setbinsize bindex, newsize END IF END SUB '(For fixed-length record lumps only) 'Initialise, if needed, a lump that is missing or has length <= headersize by padding the file with zeros so that 'it has a header if any and one record. SUB fix_recordless_lump(lumpname as string, record_byte_size as integer, byval header_bytes as integer=0) DIM fh as integer IF OPENFILE(lumpname, FOR_BINARY + ACCESS_READ_WRITE, fh) THEN debugerror "Error while opening " & lumpname EXIT SUB END IF DIM total_bytes as integer = LOF(fh) - header_bytes IF total_bytes <= 0 THEN debuginfo "fix_recordless_lump: " & lumpname & " didn't exist or was length " & LOF(fh) extendfile fh, header_bytes + record_byte_size END IF CLOSE #fh END SUB 'Correct a variable holding the number of records (last_rec_index + 1 + count_offset) 'to the real amount ('records') if necessary, showing an upgrade message. SUB adjust_record_count(byref last_rec_index as integer, records as integer, lumpname as string, info as string, count_offset as integer=0) DIM rec_count as integer = last_rec_index + 1 + count_offset IF records <= 0 THEN debuginfo "fix*_record_count: " & trimpath(lumpname) & " (" & info & ") has no records/doesn't exist" 'Setting the record count to 0 is likely to cause a crash, set it to 1 instead '(generally this will cause the relevant editor to fix the file (quite by accident)) records = 1 END IF IF records <> rec_count THEN upgrade_message "Adjusting record count for " & info & " lump, " & rec_count & " -> " & records & " (diff " & records - rec_count & ")" last_rec_index = records - 1 - count_offset END IF END SUB 'Correct a variable holding number of fixed-length-records (last_rec_index + 1 + count_offset) 'to the real amount in a file, and check that the file doesn't have any partial records. 'NOTE: This doesn't fix a lump which is missing or zero length; use fix_recordless_lump for that. SUB fix_record_count(byref last_rec_index as integer, record_byte_size as integer, lumpname as string, info as string, skip_header_bytes as integer=0, count_offset as integer=0, errlvl as ErrorLevelEnum=errError) DIM rec_count as integer = last_rec_index + 1 + count_offset IF NOT isfile(lumpname) THEN debuginfo "fix_record_count: " & info & " lump " & trimpath(lumpname) & " does not exist." 'Setting the record count to 1; see below last_rec_index = 0 - count_offset EXIT SUB END IF IF record_byte_size <= 0 THEN showerror "Game seems to be corrupt, " & info & " lump has invalid/no binsize" EXIT SUB END IF DIM total_bytes as integer = filelen(lumpname) - skip_header_bytes IF total_bytes <= 0 THEN 'No records! adjust_record_count last_rec_index, 0, lumpname, info, count_offset EXIT SUB END IF IF total_bytes MOD record_byte_size <> 0 THEN DIM diffsize as integer diffsize = total_bytes - record_byte_size * rec_count DIM mismatch as string IF diffsize < 0 THEN mismatch = "file short by " & diffsize & " bytes" ELSE mismatch = "file long by " & diffsize & " bytes" END IF debugc errlvl, "fix_record_count mismatch for " & info & " lump, " & total_bytes & " is not evenly divisible by " & record_byte_size & " (" & mismatch & ")" '--expand the lump to have a valid total size DIM fh as integer OPENFILE(lumpname, FOR_BINARY + ACCESS_READ_WRITE, fh) DO WHILE total_bytes MOD record_byte_size <> 0 total_bytes += 1 PUT #fh, skip_header_bytes + total_bytes, CHR(0) LOOP CLOSE #fh debugc errlvl, "Expanded " & info & " lump to " & total_bytes & " bytes" END IF DIM records as integer = total_bytes \ record_byte_size adjust_record_count last_rec_index, records, lumpname, info, count_offset END SUB LOCAL SUB adjust_spriteset_record_count(sprtype as SpriteType, records as integer) WITH sprite_sizes(sprtype) adjust_record_count gen(.genmax), records, rgfx_lumpnames(sprtype), .name & " sprites", .genmax_offset END WITH END SUB 'Check a gen() entry for number of spritesets is correct, for spritesets in .pt# format LOCAL SUB fix_pt_record_count(pt_num as SpriteType) WITH sprite_sizes(pt_num) DIM bytes as integer = .size.x * .size.y * .frames \ 2 '--we divide by 2 because there are 2 pixels per byte DIM lump as string = game & ".pt" & pt_num '.pt7 and .pt8 don't exist in old games fix_recordless_lump lump, bytes fix_record_count gen(.genmax), bytes, lump, .name & " sprites" END WITH END SUB 'Check a gen() entry for number of spritesets is correct, for spritesets in .rgfx format LOCAL SUB fix_rgfx_record_count(rgfxdoc as DocPtr, sprtype as SpriteType) adjust_spriteset_record_count sprtype, rgfx_num_spritesets(rgfxdoc, sprtype) END SUB 'Check a gen() entry for number of spritesets is correct SUB fix_sprite_record_count(sprtype as SpriteType) IF sprtype = sprTypeTilesetStrip THEN EXIT SUB 'Only process tilesets once 'If there's an .rgfx lump, prefer that IF isfile(workingdir + SLASH + rgfx_lumpnames(sprtype)) THEN 'For efficiency, handle all enemy types at once when called with sprTypeEnemy IF sprtype >= sprTypeSmallEnemy AND sprtype <= sprTypeLargeEnemy THEN EXIT SUB DIM rgfxdoc as DocPtr = rgfx_open(sprtype) 'If rgfxdoc is NULL continue anyway: number of records is 0 fix_rgfx_record_count rgfxdoc, sprtype IF sprtype = sprTypeEnemy THEN fix_rgfx_record_count rgfxdoc, sprTypeSmallEnemy fix_rgfx_record_count rgfxdoc, sprTypeMediumEnemy fix_rgfx_record_count rgfxdoc, sprTypeLargeEnemy END IF FreeDocument rgfxdoc ELSE 'Check old .pt# or mxs lump, if there was one IF sprtype <= sprTypeLastPT THEN fix_pt_record_count sprtype ELSEIF sprtype = sprTypeBackdrop THEN fix_record_count gen(genNumBackdrops), 320 * 200, game & ".mxs", "Backdrops", , -1 ELSEIF sprtype = sprTypeTileset THEN fix_record_count gen(genMaxTile), 320 * 200, game & ".til", "Tilesets" ELSE 'This sprite type never used anything but .rgfx, and there's no .rgfx file '(This is going to show a message about enemies.rgfx when upgrading old games, because 'we haven't created it yet) adjust_spriteset_record_count sprtype, 0 END IF END IF END SUB #ENDIF '#IFNDEF NO_UPGRADE '========================================================================================== ' Data sanity checks '========================================================================================== SUB future_rpg_warning () 'This sub displays forward-compat warnings when a new RPG file is loaded in 'an old copy of game, or an old version of custom (ypsiliform or newer) 'Note that if this happens while live-previewing it might be before 'the versions of Game and Custom don't match (we've already shown a warning 'about that), or the game is too new for Custom as well. 'future_rpg_warning can get called multiple times per game STATIC warned_sourcerpg as string IF sourcerpg = warned_sourcerpg THEN EXIT SUB warned_sourcerpg = sourcerpg debug "Unsupported RPG file!" DIM hlcol as integer = uilook(uiText) DIM msg as string msg = hilite("Unsupported RPG File", hlcol) msg += !"\n\nThis game has features that are not supported in this version of the OHRRPGCE. Download the latest version at http://HamsterRepublic.com\n" msg += "Press any key to continue, but " #IFDEF IS_GAME msg += "be aware that some things might not work right..." #ELSE msg += hilite("DO NOT SAVE the game", hlcol) & ", as this will lead to almost certain data corruption!!" #ENDIF clearpage 0 basic_textbox msg, uilook(uiMenuItem), 0 setvispage 0 fadein waitforanykey #IFDEF IS_GAME ' fadeout 0, 0, 0 #ENDIF END SUB SUB check_map_count DIM maplumps(...) as string = {"t", "p", "e", "l", "n", "d"} DIM maplumptypes(...) as string = {"tilemap", "passmap", "foemap", "NPC instances", "NPC definitions", "door links"} 'Zonemaps are optional due to being added later DIM oldmapmax as integer = gen(genMaxMap) gen(genMaxMap) = 0 DO DIM havelump(UBOUND(maplumps)) as bool DIM lumpcount as integer = 0 FOR i as integer = 0 TO UBOUND(maplumps) havelump(i) = isfile(maplumpname(gen(genMaxMap), maplumps(i))) IF havelump(i) THEN lumpcount += 1 NEXT IF lumpcount = 0 THEN gen(genMaxMap) -= 1 EXIT DO END IF IF lumpcount < UBOUND(maplumps) + 1 THEN 'Game actually runs just fine when anything except the foemap is missing; Custom 'has some (crappy) map lump fix code in the map editor FOR i as integer = 0 TO UBOUND(havelump) IF havelump(i) = NO THEN showerror "map " & gen(genMaxMap) & " " & maplumptypes(i) & " is missing!" NEXT 'Continue even if lumps missing, as following maps may be alright END IF gen(genMaxMap) += 1 LOOP 'Note we don't check/fix number of records in .map and .mn IF gen(genMaxMap) < 0 THEN fatalerror "Game has no maps!" IF gen(genMaxMap) <> oldmapmax THEN upgrade_message "Fixed number of maps from " & (oldmapmax + 1) & " to " & (gen(genMaxMap) + 1) END SUB 'Check for corruption and unsupported RPG features (maybe someone forgot to update CURRENT_RPG_VERSION) SUB rpg_sanity_checks 'Check binsize.bin is not from future DIM flen as integer = filelen(workingdir + SLASH + "binsize.bin") IF flen > 2 * (binLASTENTRY + 1) THEN debug "binsize.bin length " & flen future_rpg_warning ELSEIF flen = 0 ANDALSO gen(genVersion) >= 6 THEN showerror "This game is corrupt: binsize.bin lump is missing. Contact the OHRRPGCE developers for help" ELSE FOR bindex as integer = 0 TO binLASTENTRY IF curbinsize(bindex) MOD 2 <> 0 THEN 'curbinsize is INSANE, scream bloody murder to prevent data corruption! fatalbug "Oh noes! curbinsize(" & bindex & ")=" & curbinsize(bindex) END IF DIM binsize as integer = getbinsize(bindex) IF binsize > curbinsize(bindex) THEN debug "getbinsize(" & bindex & ") = " & binsize & ", but curbinsize = " & curbinsize(bindex) future_rpg_warning END IF NEXT END IF 'Check fixbits.bin is not from future DIM maxbits as integer = filelen(workingdir + SLASH + "fixbits.bin") * 8 FOR i as integer = sizeFixBits TO maxbits - 1 IF getfixbit(i) THEN debug "Unknown fixbit " & i & " set" future_rpg_warning END IF NEXT 'Should this be in upgrade? I can't make up my mind! IF gen(genNumElements) > 64 THEN future_rpg_warning 'We would definitely crash if we didn't cap this gen(genNumElements) = 64 END IF 'Check script file formats IF isfile(game + ".hsp") THEN unlumpfile game + ".hsp", "hs", tmpdir DIM hs_header as HSHeader load_hsp_header tmpdir & "hs", hs_header WITH hs_header IF .valid = NO THEN pop_warning "The scripts in this game appear to be corrupt." ELSEIF .hsp_format > CURRENT_HSP_VERSION OR .script_format > CURRENT_HSZ_VERSION OR .max_function_id > maxScriptCmdID THEN debug "Future HS format: hspeak ver='" & .hspeak_version & "' plotscr ver='" & .plotscr_version _ & "' hsp ver=" & .hsp_format & " (supported=" & CURRENT_HSP_VERSION & ") hsz ver=" & .script_format & " (supported=" _ & CURRENT_HSZ_VERSION & ") max func=" & .max_function_id & " (supported=" & maxScriptCmdID & ")" pop_warning "This game has scripts that are not supported in this version of the OHRRPGCE. Download the latest version at http://HamsterRepublic.com" END IF END WITH END IF END SUB 'Check that this game really has been upgraded. This is intended for NO_UPGRADE builds. SUB rpg_post_upgrade_sanity_checks() IF gen(genVersion) <> CURRENT_RPG_VERSION THEN fatalerror "Game needs to be upgraded, not supported by this engine build. (Failed genVersion)" END IF DIM flen as integer = filelen(workingdir + SLASH + "binsize.bin") IF flen <> 2 * (binLASTENTRY + 1) THEN fatalerror "Game needs to be upgraded, not supported by this engine build. (Failed binsize)" END IF END SUB '========================================================================================== ' Global strings '========================================================================================== SUB loadglobalstrings 'we load the whole lump into memory because readglobalstring can be called 'hunderds of times a second. It's stored in a raw format; good enough. DIM fh as integer IF OPENFILE(game + ".stt", FOR_BINARY + ACCESS_READ, fh) = fberrOK THEN IF LOF(fh) > 0 THEN global_strings_buffer = STRING(LOF(fh), 0) GET #fh, 1, global_strings_buffer END IF CLOSE #fh END IF END SUB FUNCTION readglobalstring (byval index as integer, default as zstring ptr, byval maxlen as integer=10) as string IF index * 11 + 2 > LEN(global_strings_buffer) THEN RETURN *default ELSE DIM namelen as UBYTE = global_strings_buffer[index * 11] IF maxlen < namelen THEN namelen = maxlen RETURN MID(global_strings_buffer, index * 11 + 2, namelen) END IF END FUNCTION LOCAL FUNCTION _price_string(cost as string) as string DIM as string ret, default default = "# " & readglobalstring(32, "$") IF default = "# $" THEN default = "$#" 'Special case magic! ret = readglobalstring(330, default, 16) replacestr ret, "#", cost RETURN ret END FUNCTION 'Format a price, like "10 gold", "$10" FUNCTION price_string(cost as integer) as string RETURN _price_string(STR(cost)) END FUNCTION 'Name of the currency, like "Gold", "$" FUNCTION money_name() as string RETURN titlecase(TRIM(_price_string(""))) END FUNCTION '========================================================================================== ' Default menus '========================================================================================== PRIVATE SUB add_item_to_(menu as MenuDef, subtype as integer, hide_if_disabled as bool = NO) append_menu_item(menu, "", mtypeSpecial, subtype) menu.last->hide_if_disabled = hide_if_disabled END SUB ' Initialise the default main menu used for old games. ' The passed in MenuDef should be blank SUB create_default_menu(menu as MenuDef, add_sfx_volume as bool = YES) add_item_to_ menu, spItems add_item_to_ menu, spSpells add_item_to_ menu, spStatus add_item_to_ menu, spEquip add_item_to_ menu, spTeamOrOrder add_item_to_ menu, spMapMaybe, YES add_item_to_ menu, spSaveMaybe, YES add_item_to_ menu, spWindowed, YES add_item_to_ menu, spFullscreen, YES IF add_sfx_volume THEN add_item_to_ menu, spMusicVolume add_item_to_ menu, spSoundVolume ELSE ' (When playing old games without sfx) ' Don't need sfx volume, so don't need the Volume menu either, ' but use the caption set for the old Volume option. add_item_to_ menu, spMusicVolume menu.last->caption = readglobalstring(69, "Volume", 10) END IF add_item_to_ menu, spQuit menu.translucent = YES menu.min_chars = 14 END SUB ' Initialise the volume menu used in old games ' menu should be blank. SUB create_volume_menu(menu as MenuDef) DIM mainmenu as MenuDef IF LEN(game) THEN ' Load the main menu and copy some of the styling DIM menu_set as MenuSet menu_set.menufile = workingdir + SLASH + "menus.bin" menu_set.itemfile = workingdir + SLASH + "menuitem.bin" LoadMenuData menu_set, mainmenu, 0, YES ELSE menu.translucent = YES END IF add_item_to_ menu, spMusicVolume add_item_to_ menu, spSoundVolume menu.min_chars = 10 menu.boxstyle = mainmenu.boxstyle menu.textcolor = mainmenu.textcolor menu.translucent = mainmenu.translucent menu.bordersize = mainmenu.bordersize menu.textalign = mainmenu.textalign ClearMenuData mainmenu END SUB SUB init_battle_menu (menu as MenuDef, byval menu_id as integer=-1) IF menu_id > gen(genMaxMenu) THEN debug "Bad battle menu " & menu_id menu_id = -1 END IF IF menu_id < 0 THEN 'Default hero battle menu ClearMenuData menu WITH menu 'If the resolution is <= 320x200 the default menu is placed as if the align 'point were -8,+5 from Top-Right, otherwise it's positioned relative to the 'center, next to the HP/ready bars. '(Have to use center-alignment because we might draw to a compatpage.) .offset.x = small(320, gen(genResolutionX)) \ 2 - 8 .offset.y = -small(200, gen(genResolutionY)) \ 2 + 5 .alignhoriz = alignCenter .alignvert = alignCenter .anchorhoriz = alignRight .anchorvert = alignTop .textalign = alignLeft .bordersize = -5 .itemspacing = -2 .highlight_selection = YES .min_chars = 10 .maxrows = 23 END WITH ELSE DIM def_menu_set as MenuSet def_menu_set.menufile = workingdir + SLASH + "menus.bin" def_menu_set.itemfile = workingdir + SLASH + "menuitem.bin" LoadMenuData def_menu_set, menu, menu_id, YES END IF END SUB '========================================================================================== ' Generalised script errors '========================================================================================== 'These routines are for when an error should possibly show a script error. 'Check whether 'n' is within bounds. 'See reporterr below. FUNCTION bound_arg(n as integer, min as integer, max as integer, argname as zstring ptr, context as zstring ptr = NULL, errlvl as scriptErrEnum = serrBound) as bool 'This function takes zstring ptr arguments because passing strings is actually really expensive '(it performs an allocation, copy, delete), and would be easily noticeable by scripts. IF n < min ORELSE n > max THEN reporterr strprintf("invalid %s %d (range %d to %d)", *argname, n, min, max), errlvl, context RETURN NO END IF RETURN YES END FUNCTION 'This is a drop-in replacement for scripterr which can be called from outside 'the script interpreter. It hides some errors when playing a game in release mode, 'just like scripterr. 'context overrides the name of the current script command, if any. It does not override 'the context_string global, which is also reported. 'context_slice is passed on to scripterr and thence the slice debugger, but currently not used in Custom. SUB reporterr(msg as zstring ptr, errlvl as scriptErrEnum = serrBadOp, context as zstring ptr = NULL, context_slice as Slice ptr = NULL) 'It's possible to be currently executing a script command, and for 'context_string to be set, eg "advance textbox" calls advance_text_box, which 'can cause an error. If we have both contexts, then the script command is 'the outer, and context_string the inner, eg "advancetextbox: Textbox 1: invalid hero ID" 'But 'context' is always the innermost DIM full_msg as string = *msg IF context THEN full_msg = *context & ": " & full_msg END IF IF LEN(context_string) THEN full_msg = context_string & ": " & full_msg END IF #IFDEF IS_GAME IF insideinterpreter ORELSE context_slice <> NULL THEN IF insideinterpreter ANDALSO context = NULL THEN full_msg = interpreter_context_name() & full_msg END IF 'Let scripterr deal with whether to show the error scripterr full_msg, errlvl, context_slice EXIT SUB END IF IF should_display_error_to_user(errlvl) = NO THEN debug full_msg EXIT SUB END IF #ENDIF IF errlvl >= serrMajor THEN 'errlvl = serrError: Corrupt, unsupported, or unreadable data or interpreter state 'errlvl = serrMajor: A script error that can't be ignored showerror full_msg ELSEIF errlvl >= serrWarn THEN 'errlvl >= serrWarn: Likely something like out-of-bounds data DIM header as string IF errlvl >= serrBound THEN 'serrBound, serrBadOp header = "Error:" ELSE 'serrWarn, serrSuspicious header = "Warning:" END IF #IFDEF IS_GAME header &= " (Hidden in Release Mode)" #ENDIF visible_debug header & !"\n" & full_msg ELSE 'Info or ignore debuginfo full_msg END IF END SUB '========================================================================================== ' Extra data arrays '========================================================================================== 'Access extra data vectors, while throwing script errors in the script interpreter or visible_debugs 'outside it. SUB extra_index_error(index as integer, length as integer) reporterr "Out of range index " & index & " for length " & length & " 'extra' array", serrBadOp END SUB FUNCTION get_extra(byref extra as integer vector, index as integer) as integer DIM length as integer = IIF(extra, v_len(extra), 3) IF index < 0 THEN index += length IF index < 0 ORELSE index > length - 1 THEN extra_index_error index, length ELSE IF extra THEN RETURN extra[index] END IF RETURN 0 END FUNCTION SUB set_extra(byref extra as integer vector, index as integer, value as integer) IF extra = NULL THEN v_new extra, 3 END IF DIM length as integer = v_len(extra) IF index < 0 THEN index += length IF index < 0 ORELSE index > length - 1 THEN extra_index_error index, length ELSE extra[index] = value END IF END SUB SUB resize_extra(byref extra as integer vector, length as integer) IF bound_arg(length, 0, maxExtraLength, "'extra' array length", , serrBadOp) THEN IF extra THEN v_resize extra, length ELSE v_new extra, length END IF END IF END SUB SUB insert_extra(byref extra as integer vector, index as integer, value as integer) IF extra = NULL THEN v_new extra, 3 END IF DIM length as integer = v_len(extra) IF index < 0 THEN index += length IF index < 0 ORELSE index > length - 1 THEN extra_index_error index, length ELSE v_insert extra, index, value END IF END SUB 'Delete part of an extra vector. 'If the range is valid and nonempty returns extra[first_index]. Returns 0 otherwise. FUNCTION delete_extra_range(byref extra as integer vector, first_index as integer, end_index as integer) as integer IF extra = NULL THEN v_new extra, 3 END IF DIM length as integer = v_len(extra) IF first_index < 0 THEN first_index += length IF end_index < 0 THEN end_index += length IF first_index = end_index THEN 'Allow empty range even if out of bounds. v_delete_slice requires 0 <= first <= end <= length 'but we throw an error if first = length unless the range is empty, otherwise deleting [length,length+1) 'would throw an error about end=length+1 instead of first=length ELSEIF first_index < 0 ORELSE first_index > length - 1 THEN extra_index_error first_index, length ELSEIF end_index < 0 ORELSE end_index > length THEN extra_index_error end_index, length ELSEIF first_index > end_index THEN reporterr "Can't delete negative-sized range of array from " & first_index & " to " & end_index, serrBadOp ELSE IF first_index < length THEN delete_extra_range = extra[first_index] v_delete_slice extra, first_index, end_index END IF END FUNCTION FUNCTION find_extra(byref extra as integer vector, value as integer, startindex as integer = 0) as integer IF extra = NULL THEN IF dummy_000_extravec = NULL THEN v_new dummy_000_extravec, 3 extra = dummy_000_extravec END IF DIM length as integer = v_len(extra) DIM index as integer = startindex IF index < 0 THEN index += length IF index < 0 THEN index = 0 WHILE index < length IF extra[index] = value THEN RETURN index index += 1 WEND RETURN -1 END FUNCTION '========================================================================================== ' Tags '========================================================================================== FUNCTION max_tag() as integer IF prefbit(32) THEN 'Don't limit maximum tags to 999 RETURN 15999 ELSE RETURN 999 END IF END FUNCTION FUNCTION load_tag_name (byval index as integer) as string IF index = 0 THEN RETURN "" IF index = 1 THEN RETURN "Never" IF index = -1 THEN RETURN "Always" IF index > gen(genMaxTagName) THEN RETURN "" RETURN readbadgenericname(ABS(index), game + ".tmn", 42, 0, 20, , NO) END FUNCTION SUB save_tag_name (tagname as string, byval index as integer) DIM buf(20) as integer writebadbinstring tagname, buf(), 0, 20 storerecord buf(), game + ".tmn", 42 \ 2, index END SUB Constructor HeroTagsCache() v_new this.checks End Constructor Destructor HeroTagsCache() v_free this.checks End Destructor SUB load_special_tag_caches() DIM her as HeroDef REDIM herotags(gen(genMaxHero)) FOR i as integer = 0 TO gen(genMaxHero) WITH herotags(i) loadherodata her, i .have_tag = her.have_tag .alive_tag = her.alive_tag .leader_tag = her.leader_tag .active_tag = her.active_tag v_resize .checks, 0 FOR j as integer = 0 to UBOUND(her.checks) v_append .checks, her.checks(j) NEXT j END WITH NEXT i REDIM item_data(dimbinsize(binITM)) as integer REDIM itemtags(gen(genMaxItem)) FOR i as integer = 0 TO gen(genMaxItem) loaditemdata item_data(), i item_tags_from_buf itemtags(i), item_data() NEXT i END SUB 'Return whether a tag is automatically set by consulting the 'herotags() and itemtags() arrays and the hero level checks FUNCTION tag_is_autoset(byval tag_id as integer) as bool DIM count as integer = 0 tag_id = ABS(tag_id) IF tag_id <= 1 THEN RETURN NO FOR i as integer = 0 TO small(gen(genMaxHero), UBOUND(herotags)) WITH herotags(i) IF tag_id = .have_tag THEN count += 1 IF tag_id = .alive_tag THEN count += 1 IF tag_id = .leader_tag THEN count += 1 IF tag_id = .active_tag THEN count += 1 FOR j as integer = 0 TO v_len(.checks) - 1 IF tag_id = .checks[j].tag THEN count += 1 NEXT j END WITH NEXT i FOR i as integer = 0 TO small(gen(genMaxItem), UBOUND(itemtags)) WITH itemtags(i) IF tag_id = .have_tag THEN count += 1 IF tag_id = .in_inventory_tag THEN count += 1 IF tag_id = .is_equipped_tag THEN count += 1 IF tag_id = .is_actively_equipped_tag THEN count += 1 END WITH NEXT i RETURN count > 0 END FUNCTION 'Returns one line per place where this tag is autoset. Empty if none. FUNCTION describe_tag_autoset_places(byval tag_id as integer) as string DIM ret as string tag_id = ABS(tag_id) IF tag_id <= 1 THEN RETURN "" DIM kind_name as string FOR i as integer = 0 TO small(gen(genMaxHero), UBOUND(herotags)) '--for each available hero WITH herotags(i) IF tag_id = .have_tag THEN ret += "Hero " & i & !" in party tag\n" IF tag_id = .alive_tag THEN ret += "Hero " & i & !" is alive tag\n" IF tag_id = .leader_tag THEN ret += "Hero " & i & !" is leader tag\n" IF tag_id = .active_tag THEN ret += "Hero " & i & !" in active party tag\n" FOR j as integer = 0 TO v_len(.checks) - 1 WITH .checks[j] SELECT CASE .kind CASE TagRangeCheckKind.level kind_name = "level" CASE ELSE kind_name = "???(" & .kind & ")" END SELECT IF tag_id = .tag THEN ret += "Hero " & i & " " & kind_name & " check " & j & !"\n" END WITH NEXT j END WITH NEXT i FOR i as integer = 0 TO small(gen(genMaxItem), UBOUND(itemtags)) WITH itemtags(i) IF tag_id = .have_tag THEN ret += "Item " & i & !" have tag\n" IF tag_id = .in_inventory_tag THEN ret += "Item " & i & !" in inventory tag\n" IF tag_id = .is_equipped_tag THEN ret += "Item " & i & !" is equipped tag\n" IF tag_id = .is_actively_equipped_tag THEN ret += "Item " & i & !" equipped by active hero tag\n" END WITH NEXT i RETURN ret END FUNCTION 'This is for *tag conditions*! It makes no sense for bools! Use yesorno or IIF instead. FUNCTION onoroff (byval n as integer) as string IF n >= 0 THEN RETURN "ON" RETURN "OFF" END FUNCTION 'Return a description of a tag condition: ALWAYS/NEVER/IF TAG #=ON/OFF (Name...) 'In Custom consider tag_condition_caption, tag_set_caption, etc. 'zerocap: What zero means. Usually either Always or Never 'maxwidth: Limit string to this many pixels wide FUNCTION describe_tag_condition(tag as integer, zerocap as string, maxwidth as integer = 320) as string IF tag = 0 THEN RETURN zerocap IF tag = 1 THEN RETURN "NEVER" IF tag = -1 THEN RETURN "ALWAYS" DIM ret as string ret = "IF TAG " & ABS(tag) & "=" + onoroff(tag) IF ABS(tag) > 1 THEN ret &= " (" & load_tag_name(ABS(tag)) ret = text_left(ret, maxwidth - textwidth(")"), NO, NO) 'ellipsis=NO, withtags=NO ret &= ")" END IF RETURN ret END FUNCTION 'Returns a YES/NO string. Not to be confused with yesno() (in this file) 'which asks an interactive yes/no question. 'If you want to override the defaults, why not use IIF() instead, which is identical? FUNCTION yesorno (byval n as integer, yes_cap as zstring ptr=@"YES", no_cap as zstring ptr=@"NO") as string IF n THEN RETURN *yes_cap RETURN *no_cap END FUNCTION '========================================================================================== ' Float display & editing '========================================================================================== 'The problem with strformat("%.Xg", ...) is that it displays values larger than 10^X 'in scientific form, even though that may be much longer than displaying it directly, 'eg. "%.3g" % 2212.13123 == "2.21e+03" 'This function doesn't show exponents so easily FUNCTION _format_float(byval float as double, byval sigfigs as integer = 5) as string DIM deciplaces as integer = sigfigs - (INT(LOG(ABS(float)) / LOG(10)) + 1) IF deciplaces < -4 THEN RETURN strprintf("%." & sigfigs & "g", float) IF deciplaces > sigfigs THEN deciplaces = sigfigs DIM repr as string = FORMAT(float, "0." & STRING(deciplaces, "#")) 'Unlike STR, FORMAT will add a trailing point (which might be . , or ٫). Note also 'https://sourceforge.net/p/fbc/bugs/915/ which causes FORMAT to add a single malformed UTF8 byte. RETURN RTRIM(repr, ANY ".,٫") 'Future proof for utf8: ٫ is two bytes END FUNCTION FUNCTION format_float(byref float as single, byval sigfigs as integer = 5) as string IF @float = editing_float_ptr THEN RETURN editing_float_repr RETURN _format_float(float, sigfigs) END FUNCTION FUNCTION format_float(byref float as double, byval sigfigs as integer = 5) as string IF @float = editing_float_ptr THEN RETURN editing_float_repr RETURN _format_float(float, sigfigs) END FUNCTION 'This is mostly equivalent to '(float * 100) & "%"', however it doesn't show 'exponentials, and it rounds to some number of significant places FUNCTION _format_percent(byval float as double, byval sigfigs as integer = 5) as string RETURN _format_float(float * 100, sigfigs) & "%" END FUNCTION FUNCTION format_percent(byref float as single, byval sigfigs as integer = 5) as string IF @float = editing_float_ptr THEN RETURN editing_float_repr RETURN _format_percent(float, sigfigs) END FUNCTION FUNCTION format_percent(byref float as double, byval sigfigs as integer = 5) as string IF @float = editing_float_ptr THEN RETURN editing_float_repr RETURN _format_percent(float, sigfigs) END FUNCTION 'Format a float showing a fixed number of decimal places, and never use scientific notation. 'Internal to percent_grabber. FUNCTION _format_float_decimals(byval float as double, byval decimal_places as integer) as string 'Avoid FORMAT due to locale specific nastiness, see _format_float. DIM num as longint = float * 10 ^ decimal_places DIM digits as string = STR(ABS(num)) digits = lpad(digits, "0", decimal_places + 1) IF decimal_places <> 0 THEN digits = LEFT(digits, LEN(digits) - decimal_places) & "." & RIGHT(digits, decimal_places) END IF IF num < 0 THEN RETURN "-" & digits RETURN digits END FUNCTION 'Edit a floating point value (displayed as a percentage if is_percent) and its string 'representation simultaneously (repr stores the editing state). You can either: '-initialise repr with "" (or format_percent(float)/format_float(float)) and then ' pass that in '-or just ignore the repr arg (pass ""), then the repr state is stored in a global ' variable and will be returned by format_percent(float)/format_float(float) 'Returns true if float or repr changed 'sigfigs: the max number of digits for fractional values, not enforced for whole ' values (e.g. if sigfigs=2, this acts like intgrabber for values >= 100). ' No more than 7. 'cyclic: wrap from from max straight to min, without a hitch. Mainly for angles. ' (Even when false, still wraps on a new keypress) 'Note: min and max are not in percent: max=1 is 100% FUNCTION percent_grabber(byref float as double, byref repr as string = "", min as double, max as double, sigfigs as integer = 4, ret_if_repr_changed as bool = YES, is_percent as bool = YES, cyclic as bool = NO) as bool STATIC clip as double DIM oldfloat as double = float DIM mult as double = IIF(is_percent, 100.0, 1.0) 'Use cached repr if repr is "" IF @float <> editing_float_ptr THEN editing_float_repr = "" IF LEN(repr) = 0 THEN repr = editing_float_repr 'What counts as a real change DIM epsilon as double = 0.5 * (0.1 ^ (sigfigs - 1)) 'In case we're editing a single precision and there are several digits in front of the decimal epsilon = large(epsilon, float * mult * 1e-7) DIM oldrepr as string = repr 'In case we forget to initialise repr (e.g. maybe we got called before a ''need_update' block), we don't want to overwrite float with garbage. 'So for safety if repr is bad, throw it away. IF LEN(repr) = 0 ORELSE ABS(VAL(repr) - float * mult) > epsilon THEN IF is_percent THEN repr = _format_percent(float, sigfigs) ELSE repr = _format_float(float, sigfigs) END IF 'debug "percent_grabber: resetting " & oldrepr & " to " & repr END IF 'Remove negative (because we trim leading 0's later) and percentage signs repr = RTRIM(repr, "%") DIM sign as integer = 1 IF LEFT(repr, 1) = "-" THEN sign = -1: repr = MID(repr, 2) '--Textual editing. The following is very similar to strgrabber IF copy_keychord() THEN clip = float IF paste_keychord() THEN float = clip IF keyval(scBackspace) > 1 AND LEN(repr) > 0 THEN repr = LEFT(repr, LEN(repr) - 1) repr += exclusive(getinputtext, "0123456789.") 'Exclude all but first period DIM period as integer = INSTR(repr, ".") repr = LEFT(repr, period) + exclude(MID(repr, period + 1), ".") 'Enforce sig. figs limit IF period THEN repr = LEFT(repr, large(period, sigfigs + 1)) 'Trim leading 0's repr = LTRIM(repr, "0") IF LEN(repr) = 0 ORELSE repr[0] = ASC(".") THEN repr = "0" + repr IF sign = -1 THEN repr = "-" + repr '--Numerical editing. float = VAL(repr) / mult IF float = 0.0 ANDALSO sign = -1 THEN repr = MID(repr, 2) 'Convert -0 to 0 DIM increment as double = 1.0 / mult period = INSTR(repr, ".") DIM edit_decimals as integer = 0 'Current number of decimals in repr IF period THEN edit_decimals = LEN(repr) - period increment *= 0.1 ^ edit_decimals END IF DIM changed as bool = NO 'Whether to replace repr DIM updown as integer = 0 IF readmouse().buttons AND mouseright THEN updown = readmouse().wheel_clicks DIM maxspeed as integer = small(1000, 0.1 * (max - min) / increment) updown -= accelerating_keydown(ccLeft, maxspeed) updown += accelerating_keydown(ccRight, maxspeed) float += updown * increment IF updown THEN changed = YES IF (keyval(scMinus) > 1 OR keyval(scNumpadMinus) > 1) THEN IF float = 0.0 THEN negative_zero = YES ELSE float = -float END IF changed = YES END IF IF (keyval(scPlus) > 1 OR keyval(scNumpadPlus) > 1) THEN float = ABS(float) changed = YES END IF DIM unclamped as double = float IF ABS(updown) > 1 ANDALSO cyclic = NO THEN float = bound(float, min, max) ELSEIF ABS(float - max) < 1e-7 THEN 'Don't allow reaching max, instead it wraps around IF cyclic THEN float = min ELSE 'Bound to min/max, with wrapping DIM remain as double = fmod(float - min, max - min) IF remain < 0 THEN remain += max - min float = min + remain END IF 'Update repr IF changed OR float <> unclamped THEN IF is_percent THEN repr = _format_float_decimals(float * 100, edit_decimals) ELSE repr = _format_float_decimals(float, edit_decimals) END IF IF negative_zero THEN repr = "-" & repr END IF IF is_percent THEN repr += "%" editing_float_ptr = @float editing_float_repr = repr DIM ret as bool = ABS(oldfloat - float) * mult > epsilon IF ret THEN negative_zero = NO IF ret_if_repr_changed THEN ret OR= (oldrepr <> repr) RETURN ret END FUNCTION FUNCTION percent_grabber(byref float as single, byref repr as string = "", min as double, max as double, sigfigs as integer = 4, ret_if_repr_changed as bool = YES, is_percent as bool = YES, cyclic as bool = NO) as bool DIM temp as double = float 'percent_grabber needs to know whether it's called with the same float as previously IF @float = editing_float_ptr THEN editing_float_ptr = @temp DIM ret as bool = percent_grabber(temp, repr, min, max, sigfigs, ret_if_repr_changed, is_percent, cyclic) float = temp editing_float_ptr = @float RETURN ret END FUNCTION '========================================================================================= ' Default font and palette '========================================================================================= /' SUB dump_integer_array_as_hex (arraydim as string, byval start as uinteger ptr, byval _ubound as integer, byval nibbles as integer = 8) DIM hexstring as string = " DIM " & arraydim & " = {" FOR i as integer = 0 TO _ubound hexstring = hexstring & "&h" & hex(start[i], nibbles) IF i <> _ubound THEN hexstring = hexstring & "," IF LEN(hexstring) > 88 THEN hexstring = hexstring & "_" debug hexstring hexstring = " " END IF NEXT i hexstring = hexstring & "}" debug hexstring END SUB SUB dump_master_palette_as_hex (master_palette() as RGBColor) dump_integer_array_as_hex("colorcodes(255) as integer", @master_palette(0).col, 255, 6) END SUB 'dump_integer_array_as_hex "default_font(1023) as ushort", @current_font(0), 1023, 4 '/ SUB load_default_master_palette (master_palette() as RGBColor) 'To regenerate this if the default master palette changes, use dump_master_palette_as_hex DIM colorcodes(255) as integer = {&h000000,&h232222,&h312F2B,&h3F3B34,&h4C483C,&h5D5747,_ &h716A54,&h857C61,&h9A8F6D,&hAFA277,&hC4B581,&hD8C68B,&hEAD694,&hFDBC3B,&hFC9D47,_ &hFA7D53,&h0D0F0D,&h121111,&h2A2426,&h41323B,&h583D51,&h6F456D,&h81577B,&h916684,_ &hA2778D,&hB28997,&hC39CA3,&hD3B0B0,&hE3C9C4,&hEEDCD6,&hF4E7E4,&hFAF3F3,&h1F221E,_ &h0C0E1C,&h1C203E,&h2A305E,&h39407D,&h495198,&h5962B1,&h6975C4,&h8084D0,&h9793DD,_ &hAEA2EA,&hC1B8F1,&hD3CEF7,&hE2DFFC,&hECEBFF,&hF6F6FF,&h2F342E,&h15091C,&h2B1239,_ &h411B56,&h562473,&h6C2D90,&h8236AC,&h9740C9,&hAD49E6,&hC154FF,&hCB68FF,&hD57CFF,_ &hDF90FF,&hE9A4FF,&hF2B8FF,&hFCCCFF,&h40463E,&h060E27,&h0E2059,&h153289,&h1B45AE,_ &h1E5DC0,&h2179D3,&h2294DD,&h24B0E6,&h25CEF0,&h27EEF9,&h3DFFFA,&h75FFFB,&hA3FFFC,_ &hC4FFFD,&hE4FFFE,&h4F595A,&h170000,&h340000,&h500000,&h6B0000,&h870000,&hA30000,_ &hBF0000,&hDC2D2D,&hFA5F5F,&hFF7F7F,&hFF9D9D,&hFFB9B9,&hFFD0D0,&hFFE1E1,&hFFF1F1,_ &h5F6B75,&h140F00,&h2D2200,&h463400,&h5E4600,&h765800,&h8E6B00,&hA67D00,&hBF8F00,_ &hD7A100,&hEFB300,&hFFC70D,&hFFDD30,&hFFEF4D,&hFFFC62,&hFFFFB4,&h707D8F,&h140614,_ &h2E0F2E,&h471747,&h5F1F5F,&h782878,&h913091,&hAB3CA2,&hC74AB0,&hE358BE,&hFF67CC,_ &hFF8AD8,&hFFACE3,&hFFC7EC,&hFFDBF3,&hFFEFF9,&h898CA0,&h1B0904,&h3D150A,&h5A2419,_ &h76352C,&h91463F,&hAC5752,&hBF6666,&hD17579,&hE4848C,&hF693A0,&hFFA8B5,&hFFC2CB,_ &hFFD7DD,&hFFE7EA,&hFFF6F7,&hA19CB0,&h080B0E,&h121921,&h1B2733,&h363B45,&h4D484B,_ &h61504B,&h75584B,&h89614B,&h9E694B,&hB1774F,&hC38C56,&hD3A560,&hDFC171,&hE8D67D,_ &hF1EA89,&hBAABC1,&h091207,&h162911,&h20411C,&h285B2A,&h45692A,&h647729,&h7B8639,_ &h90964E,&hA2A860,&hAFBE6C,&hBDD379,&hC9E784,&hD3F88E,&hDFFFA7,&hF1FFD8,&hCCBDD0,_ &h0F0F0F,&h232221,&h363331,&h494D3C,&h436443,&h4F7A54,&h5A8F67,&h64A57D,&h6DBA96,_ &h76CFB1,&h7DE5D0,&h84F9F1,&hA4FFFB,&hC4FFFC,&hE5FFFE,&hDAD0DD,&h161010,&h322524,_ &h4D3836,&h6A4C44,&h836052,&h9A7360,&hAF846C,&hC29478,&hD4A484,&hE1B494,&hEDC2A2,_ &hF6D2B6,&hF9E2CF,&hFBECE1,&hFDF7F2,&hE6E0E8,&h0B230B,&h0E300E,&h123D12,&h154C15,_ &h196119,&h1E771E,&h228B22,&h379F37,&h3CB23A,&h44C53D,&h65D95D,&h6BEB61,&h98FA90,_ &hCCFFCA,&hE5FFE9,&hEFEBF0,&h180B09,&h371916,&h52281E,&h6B3824,&h84492A,&h9E5A30,_ &hB56E24,&hCD8316,&hDF9814,&hE6AD33,&hECC253,&hF3D773,&hF7E69A,&hFAEFBE,&hFCF7E2,_ &hFFFFFF,&h000000,&h001D48,&h002C6F,&h003B95,&h004BBC,&h005AE2,&h076DFF,&h258BFF,_ &h43A9FF,&h61C7FF,&h85D6FF,&hA8E2FF,&hC5EBFF,&hDAF2FF,&hEEF9FF} FOR i as integer = 0 TO 255 master_palette(i).col = colorcodes(i) NEXT i END SUB #include "fontdata.bi" 'Embedded copy of import/fonts/OHRRPGCE Default.ohf 'Latin-1 font, plus icons in the 127-160 free space, and icons for Custom in characters 1-31 '(most but not all of which will also be in the game's font) SUB getdefaultfont(fnt() as integer) FOR i as integer = 0 TO 1023 fnt(i) = default_font(i) NEXT END SUB 'Embedded copy of misc/browser font.ohf 'Almost identical to the default font, except placement of ©, heart, spades and hamster icons in the free 'space matching original font - some old games used these in the game longname or description. SUB getbrowserfont(fnt() as integer) FOR i as integer = 0 TO 1023 fnt(i) = browser_font(i) NEXT END SUB 'Loads master(), uilook(), boxlook(), current_font() SUB load_gfx_defaults () load_default_master_palette master() setpal master() DefaultUIColors master(), uilook(), boxlook() getdefaultfont current_font() setfont current_font() set_builtin_font current_font() textcolor uilook(uiText), 0 END SUB '========================================================================================= ' Mouse and key input helpers '========================================================================================= 'Normally, clicking on a menu item selects it on mouse down and then menu_click returns 'true on release. But if state.select_by_mouse_release then menu_click returns false 'if the item isn't selected yet: you need to click twice. 'You should probably be calling enter_space_click() instead of calling this directly 'You should call usemenu before calling this, to ensure state.pt & state.hover are correct! FUNCTION menu_click (state as MenuState) as bool DIM use_mouse as bool = YES #IFDEF IS_GAME use_mouse = get_gen_bool("/mouse/mouse_menus") OR (force_use_mouse > 0) #ENDIF IF use_mouse THEN 'Don't activate while dragging, because dragging might be used 'for scrolling (if mouse_drag_menu called) IF ((readmouse.release AND mouseleft) ANDALSO readmouse.drag_dist < 10) _ ORELSE (readmouse.release AND state.drag_selecting) THEN IF overlay_message_visible() THEN 'If an allmodex overlay message is visible, dismiss it instead. 'NOTE: because code tends to keep a copy of MouseInfo returned from readmouse, 'the following clearclick() may not have an effect show_overlay_message "", 0. /' readmouse().clearclick(mouseLeft) RETURN NO '/ END IF 'If you click off the menu then .hover = .first - 1, and if you click on an 'unselectable item then also .pt <> .hover. 'Also handle the case where the menu is empty, so .pt = .first - 1 IF state.pt = state.hover AND state.pt >= state.first THEN RETURN YES END IF END IF RETURN NO END FUNCTION FUNCTION menu_click_outside(menurect as RectType, menu_age as integer = 30) as bool DIM use_mouse as bool = YES #IFDEF IS_GAME use_mouse = get_gen_bool("/mouse/mouse_menus") OR (force_use_mouse > 0) #ENDIF IF use_mouse THEN IF (readmouse.release AND mouseLeft) ANDALSO readmouse.drag_dist < 10 THEN IF readmouse.left_click_age > menu_age THEN RETURN NO IF NOT rect_collide_point(menurect, readmouse().pos) THEN RETURN YES END IF END IF RETURN NO END FUNCTION FUNCTION menu_click_outside(m as MenuDef) as bool RETURN menu_click_outside(m.rect, m.age) END FUNCTION FUNCTION menu_click_outside_with_page(m as MenuDef, viewport_page as integer) as bool DIM offset as XYPair = vpages(vpage)->size - vpages(viewport_page)->size m.rect.topleft += offset DIM result as bool = menu_click_outside(m) m.rect.topleft -= offset RETURN result END FUNCTION FUNCTION menu_right_click_close(menurect as RectType) as bool DIM use_mouse as bool = YES #IFDEF IS_GAME use_mouse = get_gen_bool("/mouse/mouse_menus") OR (force_use_mouse > 0) #ENDIF IF use_mouse THEN IF (readmouse.release AND mouseRight) ANDALSO readmouse.drag_dist < 10 THEN IF NOT rect_collide_point(menurect, readmouse().pos) THEN RETURN YES END IF END IF RETURN NO END FUNCTION FUNCTION menu_right_click_close(m as MenuDef) as bool RETURN menu_right_click_close(m.rect) END FUNCTION 'Whether a mouse click should dismiss a modal message box FUNCTION click_dismiss () as bool IF readmouse.release AND (mouseLeft OR mouseRight) THEN readmouse.clearclick(mouseLeft) readmouse.clearclick(mouseRight) RETURN YES END IF END FUNCTION 'Sometimes space should be used for text input FUNCTION enter_click_but_not_space (state as MenuState) as bool IF menu_click(state) THEN RETURN YES RETURN keyval(scAnyEnter) > 1 ORELSE (keyval(ccUse) > 1 ANDALSO keyval(scSpace) = 0) END FUNCTION 'You should call usemenu before calling this, to ensure state.pt is correct! 'Note: This also includes Ctrl in Game! (And in future, any custom Use key mappings) ' To avoid that, call push_and_reset_gfxio_state FUNCTION enter_space_click (state as MenuState) as bool IF menu_click(state) THEN RETURN YES RETURN keyval(ccUse) > 1 ORELSE keyval(scAnyEnter) > 1 ORELSE keyval(scSpace) > 1 END FUNCTION 'NOTE: This also includes Ctrl in Game (see above)! FUNCTION enter_or_space () as bool RETURN keyval(ccUse) > 1 ORELSE keyval(scAnyEnter) > 1 ORELSE keyval(scSpace) > 1 END FUNCTION FUNCTION toggle_item (state as MenuState) as bool RETURN keyval(ccLeft) > 1 ORELSE keyval(ccRight) > 1 ORELSE enter_space_click(state) END FUNCTION ' Pressed Shift+Backspace, or Delete on the "<- Record # ->" line FUNCTION cropafter_keycombo(index_selected as bool = NO) as bool IF index_selected AND keyval(scDelete) > 1 THEN RETURN YES RETURN keyval(scShift) > 0 AND keyval(scBackspace) > 1 END FUNCTION 'Edit a bit in an integer - Note: whichbit is a mask, not a bit number! 'Automatically sets state.need_update FUNCTION bitgrabber (byref bitsets as integer, whichbit as integer, byref state as MenuState) as bool IF toggle_item(state) THEN bitsets XOR= whichbit state.need_update = YES RETURN YES END IF END FUNCTION 'Edit a bit in an integer array (ie, data record) 'Automatically sets state.need_update FUNCTION bitsetgrabber (bitwords() as integer, wordnum as integer, bitnum as integer, byref state as MenuState) as bool IF toggle_item(state) THEN setbit bitwords(), wordnum, bitnum, (readbit(bitwords(), wordnum, bitnum) XOR 1) state.need_update = YES RETURN YES END IF END FUNCTION 'Automatically sets state.need_update FUNCTION boolgrabber (byref thebool as bool, byref state as MenuState) as bool IF thebool <> 0 ANDALSO thebool <> -1 THEN 'Safety check, to make sure we really act like we're toggling a bool debug "boolgrabber: fixed badness" thebool = YES END IF IF toggle_item(state) THEN thebool XOR= YES state.need_update = YES RETURN YES END IF END FUNCTION 'Automatically sets state.need_update 'TODO: bool should be redefined as an alias to boolean so this can be deleted FUNCTION booleangrabber (byref thebool as boolean, byref state as MenuState) as bool IF toggle_item(state) THEN thebool XOR= true state.need_update = YES RETURN YES END IF END FUNCTION FUNCTION copy_keychord () as bool RETURN (keyval(scCtrl) > 0 AND keyval(scInsert) > 1) OR (keyval(scShift) > 0 AND keyval(scDelete) > 0) OR (keyval(scCtrl) > 0 AND keyval(scC) > 1) END FUNCTION FUNCTION paste_keychord () as bool RETURN (keyval(scShift) > 0 AND keyval(scInsert) > 1) OR (keyval(scCtrl) > 0 AND keyval(scV) > 1) END FUNCTION 'Returns -1 for jump to previous 'find' match, 1 for jump to next match, and 0 for neither FUNCTION find_next_or_prev_keychord () as integer 'Emacs: C-s/C-r IF keyval(scCtrl) > 0 AND keyval(scS) > 1 THEN RETURN 1 IF keyval(scCtrl) > 0 AND keyval(scR) > 1 THEN RETURN -1 'Windows and many other editors: F3/Shift-F3 IF keyval(scF3) > 1 THEN RETURN IIF(keyval(scShift), -1, 1) 'Mac: Cmd-G/Shift-Cmd-G IF (keyval(scLeftCommand) OR keyval(scRightCommand)) > 0 AND keyval(scG) > 1 THEN RETURN IIF(keyval(scShift), -1, 1) END IF RETURN 0 END FUNCTION '========================================================================================== ' Tile animations '========================================================================================== SUB animatetilesets (tilesets() as TilesetData ptr) FOR i as integer = 0 TO UBOUND(tilesets) 'Animate each tileset... FOR j as integer = 0 TO i - 1 '--unless of course we already animated it for this frame ' because the same tileset can be used on more than one layer... IF tilesets(i) = tilesets(j) THEN CONTINUE FOR, FOR NEXT animatetileset *tilesets(i) NEXT END SUB SUB animatetileset (tileset as TilesetData) STATIC seen_unknown as bool = NO DIM notstuck as integer FOR pattern as integer = 0 TO 1 #IFDEF IS_GAME IF istag(tileset.tanim(pattern).disable_tag, 0) THEN CONTINUE FOR #ENDIF WITH tileset.tanim_state(pattern) .skip = large(.skip - 1, 0) IF .skip = 0 THEN CONST lastcmd = UBOUND(tileset.tanim(pattern).cmd) notstuck = 10 DO DIM byref cmd as TileAnimCmd = tileset.tanim(pattern).cmd(.pt) SELECT CASE cmd.op CASE taopEnd 'Don't reset if the pattern is empty (.pt = 0), so tile animation 'script commands can set .cycle IF .pt <> 0 THEN .cycle = 0 .pt = 0 CASE taopReset .cycle = 0 loopvar .pt, 0, lastcmd CASE taopLoop .pt = 0 CASE taopUp .cycle -= cmd.arg * 16 loopvar .pt, 0, lastcmd CASE taopDown .cycle += cmd.arg * 16 loopvar .pt, 0, lastcmd CASE taopRight .cycle += cmd.arg loopvar .pt, 0, lastcmd CASE taopLeft .cycle -= cmd.arg loopvar .pt, 0, lastcmd CASE taopWait .skip = cmd.arg loopvar .pt, 0, lastcmd #IFDEF IS_GAME CASE taopCheckTag 'Or else stop IF istag(cmd.arg, 0) THEN loopvar .pt, 0, lastcmd ELSE .pt = 0 .cycle = 0 END IF #ENDIF CASE taopShiftTile .drawoffset.x = cmd.arg .drawoffset.y = cmd.arg2 loopvar .pt, 0, lastcmd CASE ELSE 'Invalid/Unknown IF seen_unknown = NO THEN debug "Unknown tile animation op " & cmd.op & " in tileset " & tileset.num seen_unknown = YES END IF loopvar .pt, 0, lastcmd END SELECT notstuck -= 1 LOOP WHILE notstuck > 0 AND .skip = 0 END IF END WITH NEXT pattern END SUB 'Reset state of all animations to beginning SUB reset_tile_anims(tileset as TilesetData) FOR pattern as integer = 0 TO UBOUND(tileset.tanim_state) WITH tileset.tanim_state(pattern) .cycle = 0 .pt = 0 .skip = 0 END WITH NEXT END SUB SUB lockstep_tile_animation (tilesets() as TilesetData ptr, byval layer as integer) 'Called after changing a layer's tileset to make sure its tile animation is in phase with other layers of the same tileset FOR i as integer = 0 TO UBOUND(tilesets) IF i <> layer ANDALSO tilesets(i) ANDALSO tilesets(i)->num = tilesets(layer)->num THEN tilesets(layer)->tanim_state(0) = tilesets(i)->tanim_state(0) tilesets(layer)->tanim_state(1) = tilesets(i)->tanim_state(1) EXIT SUB END IF NEXT END SUB '========================================================================================= ' Tilesets '========================================================================================= SUB unloadtilesetdata (byref tileset as TilesetData ptr) IF tileset <> NULL THEN 'debug "unloading tileset " & tileset->num frame_unload @tileset->spr DELETE tileset tileset = NULL END IF END SUB SUB maptilesetsprint (tilesets() as TilesetData ptr) FOR i as integer = 0 TO UBOUND(tilesets) IF tilesets(i) = NULL THEN debug i & ": NULL" ELSE debug i & ": " & tilesets(i)->num END IF NEXT END SUB SUB loadtilesetdata (tilesets() as TilesetData ptr, byval layer as integer, byval tilesetnum as integer) 'Loads a tileset into tilesets(layer), and sets animation state appropriately 'No effect if the tileset is already set. IF tilesets(layer) <> NULL ANDALSO tilesets(layer)->num = tilesetnum THEN EXIT SUB unloadtilesetdata tilesets(layer) tilesets(layer) = NEW TilesetData WITH *tilesets(layer) .num = tilesetnum .spr = frame_load(sprTypeTilesetStrip, tilesetnum) load_tile_anims tilesetnum, .tanim() END WITH reset_tile_anims *tilesets(layer) lockstep_tile_animation tilesets(), layer END SUB FUNCTION layer_tileset_index(byval layer as integer) as integer 'return the gmap() index containing a layer's tileset IF layer <= 2 THEN RETURN 22 + layer ELSEIF layer <= 7 THEN RETURN 26 + (layer - 3) ELSEIF layer <= 15 THEN RETURN 370 + (layer - 8) ELSE showbug "layer_tileset_index: Bad map layer " & layer END IF 'Update gmap_index_affects_tiles if this function changes END FUNCTION 'Whether a change to an element of gmap() should cause tilemap slices to be updated. 'gmap is a mess; some of it is data that belongs in a replacement lump .T (eg. tileset stuff). 'So several functions segregate the data. FUNCTION gmap_index_affects_tiles(byval index as integer) as bool SELECT CASE index CASE 0, 22 TO 24, 26 TO 30, 370 TO 377 'Default tileset, tilesets for layers 0-15 RETURN YES CASE 19 'Enabled layers bitset RETURN YES CASE 31 'Position of walkabouts layer RETURN YES CASE ELSE RETURN NO END SELECT END FUNCTION 'Tileset ID for a map layer. FUNCTION get_layer_tileset(layer as integer, gmap() as integer) as integer DIM as integer index = layer_tileset_index(layer) DIM as integer tileset = gmap(index) IF tileset > 0 THEN tileset -= 1 ELSEIF tileset = 0 THEN tileset = gmap(0) END IF IF tileset < 0 THEN showerror "Map corruption: a layer tileset set to " & tileset gmap(index) = 0 'It was either already 0, or invalid IF gmap(0) < 0 THEN gmap(0) = 0 tileset = 0 END IF RETURN tileset END FUNCTION SUB loadmaptilesets (tilesets() as TilesetData ptr, gmap() as integer, resetanimations as bool = YES) 'tilesets() may contain already loaded tilesets. In this case, we can reuse them '(Actually, whether they get reused, and therefore whether the animation state is preserved, depends on 'their order -- eww. But noone will ever notice) 'resetanimations: if true, reset animation state unconditionally (will be reset regardless if had ' to load a new tileset). DIM tileset as integer FOR i as integer = 0 TO UBOUND(tilesets) tileset = get_layer_tileset(i, gmap()) loadtilesetdata tilesets(), i, tileset IF resetanimations THEN reset_tile_anims *tilesets(i) NEXT END SUB SUB reloadtileanimations (tilesets() as TilesetData ptr, gmap() as integer) DIM tileset as integer FOR i as integer = 0 TO UBOUND(tilesets) tileset = get_layer_tileset(i, gmap()) load_tile_anims tileset, tilesets(i)->tanim() reset_tile_anims *tilesets(i) NEXT END SUB SUB unloadmaptilesets (tilesets() as TilesetData ptr) FOR i as integer = 0 TO UBOUND(tilesets) unloadtilesetdata tilesets(i) NEXT END SUB SUB set_map_edge_draw_mode(gmap() as integer, wrap_layers_over_edge_of_crop_maps as bool = NO) SELECT CASE gmap(5) CASE mapEdgeCrop IF wrap_layers_over_edge_of_crop_maps THEN setoutside -1 ELSE 'We set an edge tile on crop maps in case the map is smaller than the screen setoutside gmap(6) END IF CASE mapEdgeWrap setoutside -1 CASE mapEdgeDefaultTile setoutside gmap(6) END SELECT END SUB '========================================================================================= FUNCTION last_inv_slot() as integer '--If genMaxInventory is 0, return the default inventory size IF gen(genMaxInventory) = 0 THEN RETURN inventoryMax '--Otherwise round genMaxInventory up to the nearest '-- multiple of three (counting the zero-slot) and return it. DIM ret as integer = ((gen(genMaxInventory) + 3) \ 3) * 3 - 1 IF NOT in_bound(ret, 0, inventoryMax) THEN ret = inventoryMax IF ret <> gen(genMaxInventory) THEN debug "Invalid max inventory slot " & gen(genMaxInventory) & ", changing to " & ret gen(genMaxInventory) = ret END IF RETURN ret END FUNCTION '========================================================================================= ' Spriteset load helpers '========================================================================================= FUNCTION SpriteSize.lastrec() as integer RETURN gen(genmax) + genmax_offset END FUNCTION SUB setup_sprite_sizes () 'Populates the global sprite_sizes WITH sprite_sizes(sprTypeFrame) '-1 .name = "Frame or Asset" .size.x = 16 .size.y = 16 .frames = 1 .directions = 1 .paletted = YES 'Note this doesn't apply when using SetSpriteToFrame .genmax = -1 END WITH WITH sprite_sizes(sprTypeHero) '0 .name = "Hero" .size.x = 32 .size.y = 40 .frames = 8 .fixed_framecount = YES .directions = 4 .paletted = YES .genmax = genMaxHeroPic END WITH WITH sprite_sizes(sprTypeSmallEnemy) '1 .name = "Small Enemy" .size.x = 34 .size.y = 34 .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxEnemy1Pic END WITH WITH sprite_sizes(sprTypeMediumEnemy) '2 .name = "Medium Enemy" .size.x = 50 .size.y = 50 .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxEnemy2Pic END WITH WITH sprite_sizes(sprTypeLargeEnemy) '3 .name = "Large Enemy" .size.x = 80 .size.y = 80 .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxEnemy3Pic END WITH WITH sprite_sizes(sprTypeWalkabout) '4 .name = "Walkabout" .size.x = 20 .size.y = 20 .frames = 8 .directions = 4 .paletted = YES .genmax = genMaxNPCPic END WITH WITH sprite_sizes(sprTypeWeapon) '5 .name = "Weapon" .size.x = 24 .size.y = 24 .frames = 2 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxWeaponPic END WITH WITH sprite_sizes(sprTypeAttack) '6 .name = "Attack" .size.x = 50 .size.y = 50 .frames = 3 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxAttackPic END WITH WITH sprite_sizes(sprTypeBoxBorder) '7 .name = "Box Border" .size.x = 16 .size.y = 16 .fixed_size = YES .frames = 16 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxBoxBorder END WITH WITH sprite_sizes(sprTypePortrait) '8 .name = "Portrait" .size.x = 50 .size.y = 50 .frames = 1 .directions = 1 .paletted = YES .genmax = genMaxPortrait END WITH WITH sprite_sizes(sprTypeBackdrop) '9 .name = "Backdrop" .size.x = 320 .size.y = 200 .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = NO .genmax = genNumBackdrops .genmax_offset = -1 END WITH WITH sprite_sizes(sprTypeEnemy) '10 .name = "Enemy" .size.x = 50 'This is the default size when adding a new Enemy .size.y = 50 .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = YES .genmax = genMaxEnemyPic END WITH WITH sprite_sizes(sprTypeTileset) '11 .name = "Tileset" .size.w = 320 .size.h = 200 .fixed_size = YES .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = NO .genmax = genMaxTile END WITH WITH sprite_sizes(sprTypeTilesetStrip) '12 .name = "Tileset (tilestrip)" .size.w = 20 .size.h = 160 * 20 .fixed_size = YES .frames = 1 .fixed_framecount = YES .directions = 1 .paletted = NO .genmax = genMaxTile END WITH END SUB SUB load_sprite_and_pal (byref img as GraphicPair, byval spritetype as SpriteType, byval index as integer, byval palnum as integer=-1) unload_sprite_and_pal img IF spritetype >= sprTypeFirstLoadable ANDALSO spritetype <= sprTypeLastLoadable THEN img.sprite = frame_load(spritetype, index) IF sprite_sizes(spritetype).paletted THEN IF palnum = -1 THEN palnum = img.sprite->defpal 'sprite->defpal might be missing (-1) img.pal = palette16_load(palnum, spritetype, index) ELSEIF palnum <> -1 THEN debug "load_sprite_and_pal: spritetype " & spritetype & " with pal " & palnum END IF ELSE debug "load_sprite_and_pal: bad spritetype " & spritetype & " (index " & index & " pal " & palnum & ")" END IF END SUB SUB unload_sprite_and_pal (byref img as GraphicPair) frame_unload @img.sprite palette16_unload @img.pal END SUB '========================================================================================= ' String encoding and sanitization '========================================================================================= ' Convert a UTF8 string to the encoding used for the current game (Latin-1 or ASCII) ' Any codepoints not in Latin-1/ASCII get converted to '?' FUNCTION utf8_to_OHR(utf8string as ustring) as string DIM ret as string = utf8_to_latin1(utf8string) DIM as integer icons_low, icons_high IF get_font_type(current_font()) = ftypeLatin1 THEN icons_low = 127 icons_high = 160 ELSE icons_low = 127 icons_high = 255 END IF FOR idx as integer = 0 TO LEN(ret) - 1 IF icons_low <= ret[idx] AND ret[idx] <= icons_high THEN ret[idx] = ASC("?") END IF NEXT RETURN ret END FUNCTION 'context describes the string string (eg line number) 'If show_warnings is true, then warnings about the text encoding 'related to icons in the font are displayed. You only want those 'warnings displayed for imported text files, not for internal file 'formats like slicelookup.txt though, because they may occur if the 'user changes the font type. FUNCTION decode_backslash_codes(s as string, context as string = "", byref show_warnings as bool = NO) as string DIM result as string = "" DIM ch as string DIM mode as integer = 0 DIM nstr as string DIM num as integer DIM as integer icons_low, icons_high DIM encoding_name as string IF get_font_type(current_font()) = ftypeLatin1 THEN icons_low = 127 icons_high = 160 encoding_name = "Latin-1" ELSE icons_low = 127 icons_high = 255 encoding_name = "7-bit ASCII" END IF DIM icon_warn as bool = NO FOR i as integer = 1 TO LEN(s) ch = MID(s, i, 1) SELECT CASE mode CASE 0'--normal IF ch = "\" THEN mode = 1 nstr = "" ELSEIF ch = !"\t" THEN 'Spaces to pad to column number that's a multiple of 4 result &= SPACE(4 - POSMOD(LEN(result), 4)) ELSE IF (ASC(ch) < 32 AND ASC(ch) <> 10) OR (ASC(ch) >= icons_low AND ASC(ch) <= icons_high) THEN debuginfo "decode_backslash_codes: found nonprintable char " & ASC(ch) icon_warn = YES END IF result &= ch END IF CASE 1'--parsing backslash SELECT CASE ch CASE "\" '--an escaped backslash result &= "\" mode = 0 CASE "n" '-- a newline result &= CHR(10) mode = 0 CASE "r" '-- a carriage return result &= CHR(13) mode = 0 CASE "t" '-- a tab result &= CHR(9) mode = 0 CASE "0", "1", "2" nstr &= ch mode = 2 CASE ELSE '--not a valid backslash code, resume without discarding the backslash result &= "\" & ch mode = 0 END SELECT CASE 2'--parsing ascii code number SELECT CASE ch CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9" nstr &= ch CASE ELSE 'busted backslash code, print warning visible_debug context & " Bogus backslash ascii escape code in string """ & s & """" mode = 0 END SELECT IF LEN(nstr) >= 3 THEN num = str2int(nstr) IF num > 255 THEN visible_debug context & " Bogus backslash ascii escape code (larger than 255) in string """ & s & """" ELSE result &= CHR(num) END IF mode = 0 END IF END SELECT NEXT IF mode <> 0 THEN visible_debug context & " Bogus backslash code (mode=" & mode & ") at end of string """ & s & """" END IF IF icon_warn AND show_warnings THEN visible_debug context & " This string contains characters which apparently aren't in your font. Maybe your text editor saved the file using the wrong encoding? Expected " & encoding_name & !". (Press ESC to skip warnings)\n\n" & s IF keyval(ccCancel) THEN show_warnings = NO END IF RETURN result END FUNCTION 'The name is not totally correct, actually escapes non-printable characters and icons in the font, 'which those are depends on the font type FUNCTION escape_nonprintable_ascii(istr as string) as string DIM result as string = "" DIM as integer icons_low, icons_high IF get_font_type(current_font()) = ftypeLatin1 THEN icons_low = 127 icons_high = 160 ELSE icons_low = 127 icons_high = 255 END IF FOR idx as integer = 1 TO LEN(istr) DIM ch as string = MID(istr, idx, 1) SELECT CASE CAST(integer, ASC(ch)) CASE 92 '--Backslash result &= "\\" CASE 10 result &= "\n" CASE 13 result &= "\r" CASE 9 result &= "\t" CASE 0 TO 31, icons_low TO icons_high DIM nstr as string = STR(ASC(ch)) WHILE LEN(nstr) < 3 nstr = "0" & nstr WEND result &= "\" & nstr 'CASE 32 TO 91, 93 TO 126, latin_low TO latin_high CASE ELSE result &= ch END SELECT NEXT idx RETURN result END FUNCTION 'This is like escape_nonprintable_ascii except that it replaced non printable characters and icons 'with something else or removes them. 'See also fixfilename FUNCTION remove_nonprintable_ascii(s as string, replacement as string = "") as string DIM as integer icons_low, icons_high IF get_font_type(current_font()) = ftypeLatin1 THEN icons_low = 127 icons_high = 160 ELSE icons_low = 127 icons_high = 255 END IF DIM ret as string FOR i as integer = 0 TO LEN(s) - 1 SELECT CASE s[i] CASE IS < 32 'Tabs ignored because OHR strings shouldn't contain them CASE icons_low TO icons_high CASE ELSE ret &= CHR(s[i]) END SELECT NEXT RETURN ret END FUNCTION FUNCTION sanitize_script_identifier (ident as string, allow_whitespace as bool = YES) as string ' :'_~? are allowed DIM to_exclude as string = "`!@#$%^&*()-+=[]{}\|<>,.;/""" IF allow_whitespace = NO THEN to_exclude &= " " DIM tmp as string = exclude(ident, to_exclude) RETURN remove_nonprintable_ascii(tmp) END FUNCTION '========================================================================================= 'Prompts the user for a file (or directory) path 'ext: The file extension; must start with '.' 'directory: If blank, default to curdir. Is set to the directory used, even if canceled. 'The filename entered by the user is restricted to ASCII, meaning it doesn't have to 'be encoded before being used, but the whole path return still needs to be run through 'decode_filename() before being displayed. FUNCTION inputfilename (query as zstring ptr, ext as zstring ptr, byref directory as string, helpkey as zstring ptr, default as zstring ptr=@"", allow_overwrite as bool=YES, ask_overwrite as bool=YES) as string DIM filename as string = *default DIM tog as integer DIM foldermode as bool = NO 'Can get passed a filename maybe because it's shared with browse() (as it is in import_export_tilesets) IF LEN(directory) ANDALSO real_isfile(directory) THEN directory = trimfilename(directory) IF directory = "" THEN directory = CURDIR setkeys YES DO setwait 55 setkeys YES tog = tog XOR 1 IF keyval(ccCancel) > 1 THEN setkeys RETURN "" END IF IF keyval(scF1) > 1 THEN show_help helpkey IF keyval(ccUp) > 1 ORELSE keyval(ccDown) > 1 THEN foldermode = NOT foldermode IF (foldermode AND enter_or_space()) OR keyval(scTAB) > 1 THEN DIM newdir as string newdir = browse(browseDir, directory, "", "browse_for_folder") IF LEN(newdir) ANDALSO isdir(newdir) ANDALSO diriswriteable(newdir) THEN directory = newdir foldermode = NO END IF setkeys YES 'clear ENTER END IF IF foldermode = NO THEN strgrabber filename, 40 IF keyval(scDelete) > 1 THEN filename = "" filename = fixfilename(filename) IF keyval(scAnyEnter) > 1 THEN filename = TRIM(filename) IF filename <> "" THEN IF is_not_file(directory + SLASH + filename + *ext) THEN RETURN directory + SLASH + filename ELSE If allow_overwrite THEN IF ask_overwrite = NO ORELSE yesno("That already exists, overwrite?") THEN RETURN directory + SLASH + filename END IF ELSE notification filename & *ext & " already exists" END IF END IF END IF END IF END IF clearpage dpage textcolor uilook(uiText), 0 printstr *query, pCentered, 20, dpage printstr "Output directory (TAB to select):", pCentered, 35, dpage IF foldermode THEN textcolor uilook(uiSelectedItem + tog), uilook(uiHighlight) ELSE textcolor uilook(uiMenuItem), uilook(uiHighlight) END IF DIM display_dir as string = decode_filename(directory) printstr display_dir, pCenteredRight, 45, dpage IF foldermode THEN textcolor uilook(uiMenuItem), uilook(uiHighlight) ELSE textcolor uilook(uiSelectedItem + tog), uilook(uiHighlight) END IF DIM display_fname as string = IIF(LEN(filename), filename, "") printstr display_fname + fgtag(uilook(uiText)) + *ext, pCenteredRight, 60, dpage, YES SWAP vpage, dpage setvispage vpage dowait LOOP END FUNCTION '========================================================================================= ' Read/write binstrings '========================================================================================= 'See WriteByteStr for the straight-to-file version SUB writebinstring (savestr as string, array() as integer, byval offset as integer, byval maxlen as integer) DIM s as string '--pad savestr to (at least) the right length s = savestr + STRING(maxlen - LEN(s), CHR(0)) '--odd lengths would result in (harmless) garbage IF maxlen AND 1 THEN s += CHR(0): maxlen += 1 '--write length (current not max) array(offset) = small(LEN(savestr), maxlen) FOR i as integer = 1 TO maxlen \ 2 array(offset + i) = s[2 * i - 2] OR (s[2 * i - 1] SHL 8) NEXT END SUB SUB writebinstring (savestr as string, array() as short, byval offset as integer, byval maxlen as integer) DIM s as string '--pad savestr to (at least) the right length s = savestr + STRING(maxlen - LEN(s), CHR(0)) '--odd lengths would result in (harmless) garbage IF maxlen AND 1 THEN s += CHR(0): maxlen += 1 '--write length (current not max) array(offset) = small(LEN(savestr), maxlen) memcpy(@array(offset + 1), @s[0], maxlen) END SUB 'See WriteVStr for the straight-to-file version SUB writebadbinstring (savestr as string, array() as integer, byval offset as integer, byval maxlen as integer, byval skipword as integer=0) '--write current length DIM stringlen as integer = small(LEN(savestr), maxlen) array(offset) = stringlen FOR i as integer = 1 TO stringlen array(offset + skipword + i) = savestr[i - 1] NEXT i FOR i as integer = stringlen + 1 TO maxlen array(offset + skipword + i) = 0 NEXT i END SUB 'Read a string which has been packed one character per byte, with length as one word (INT), 'starting at array(offset). 'See ReadByteStr for the straight-from-file version FUNCTION readbinstring (array() as integer, byval offset as integer, byval maxlen as integer) as string DIM stringlen as integer = bound(array(offset), 0, maxlen) DIM result as string = STRING(stringlen, 0) 'The following is equivalent to 'array2str array(), offset * 2 + 2, maxlen DIM toggle as integer = 0 DIM index as integer = offset + 1 FOR i as integer = 0 TO stringlen - 1 IF toggle = 0 THEN result[i] = array(index) AND &hff ELSE result[i] = (array(index) SHR 8) AND &hff index += 1 END IF toggle XOR= 1 NEXT RETURN result END FUNCTION 'See the overload above. FUNCTION readbinstring (array() as short, byval offset as integer, byval maxlen as integer) as string DIM stringlen as integer = bound(array(offset), 0, maxlen) DIM result as string = STRING(stringlen, 0) memcpy(@result[0], @array(offset + 1), stringlen) RETURN result END FUNCTION 'Read a string which has been packed one character per word (INT), with length as one word 'and 'skipword' many wasted words after the length. 'See ReadVStr for the straight-from-file version FUNCTION readbadbinstring (array() as integer, byval offset as integer, byval maxlen as integer, byval skipword as integer=0) as string DIM result as string = "" DIM stringlen as integer = bound(array(offset), 0, maxlen) DIM n as integer FOR i as integer = 1 TO stringlen '--read an int n = array(offset + skipword + i) '--if the int is a char use it. IF n >= 0 AND n <= 255 THEN '--use it result = result & CHR(n) END IF NEXT i RETURN result END FUNCTION FUNCTION read32bitstring (stringptr as integer ptr) as string IF stringptr[0] < 0 THEN showerror "Corrupt data: read invalid 32b string with negative length" RETURN "" END IF DIM as string result = SPACE(stringptr[0]) memcpy(STRPTR(result), @stringptr[1], stringptr[0]) RETURN result END FUNCTION FUNCTION readbadgenericname (byval index as integer, filename as string, byval recsize as integer, byval offset as integer, byval size as integer, byval skip as integer = 0, byval expect_exists as bool=YES) as string 'recsize is in BYTES! 'TODO: there isn't any good reason to load the whole record ' just to get the string field IF index >= 0 THEN DIM buf(recsize \ 2 - 1) as integer IF loadrecord(buf(), filename, recsize \ 2, index, expect_exists) THEN RETURN readbadbinstring(buf(), offset, size, skip) END IF END IF RETURN "" 'failure END FUNCTION '========================================================================================= ' Special directories '========================================================================================= SUB set_app_dir() app_dir = add_trailing_slash(EXEPATH) 'FreeBasic builtin #IFDEF __FB_DARWIN__ 'Bundled apps have starting current directory equal to the location of the bundle, but exepath points inside IF ends_with(LCASE(app_dir), ".app/contents/macos/") THEN app_resources_dir = parentdir(app_dir, 1) + "Resources" app_dir = parentdir(app_dir, 3) END IF #ELSEIF DEFINED(__FB_ANDROID__) 'On Android EXENAME is "sdl" and EXEPATH is "/system/bin" (or "" in ancient Android?), 'while orig_dir is where the .app contents are. app_dir = add_trailing_slash(orig_dir) #ENDIF '-appdir is a special commandline arg, it needs to be processed early (although 'maybe the others should be processed earlier). So must be first one, to simplify. 'It's set by game.sh/custom.sh, probably won't be used otherwise. IF COMMAND(1) = "-appdir" THEN IF isdir(COMMAND(2)) THEN app_dir = add_trailing_slash(COMMAND(2)) END IF END SUB FUNCTION get_settings_dir () as string 'This is for application-wide settings, and prefsdir for games will be a subdirectory of it. 'Also, Custom uses settings_dir as tmpdir (FIXME: should use a temp dir in a proper place. 'And sharing the same tmpdir for all instances of Custom may cause problems.) DIM settings_dir as string #IFDEF __FB_ANDROID__ settings_dir = app_dir & "settings" #ELSEIF defined(__FB_BLACKBOX__) settings_dir = "/saves/settings" #ELSEIF defined(__FB_DARWIN__) 'FIXME: on OSX we should not use ~/.ohrrpgce, but instead ~/Library/Application Support/OHRRPGCE (settings and data), 'or ~/Library/Caches/OHRRPGCE (temp files). See 'https://developer.apple.com/library/mac/documentation/FileManagement/Conceptual/FileSystemProgrammingGuide/FileSystemOverview/FileSystemOverview.html#//apple_ref/doc/uid/TP40010672-CH2-SW1 'However, we can't just switch away from using .ohrrpgce; have to move existing files over settings_dir = ENVIRON("HOME") & "/.ohrrpgce" IF isdir(settings_dir) = NO THEN settings_dir = ENVIRON("HOME") & "/Library/Application Support/OHRRPGCE" END IF #ELSEIF DEFINED(__FB_UNIX__) settings_dir = ENVIRON("HOME") & "/.ohrrpgce" #ELSEIF DEFINED(__FB_WIN32__) 'Note, this is duplicated in find_and_load_crashrpt() IF LEN(ENVIRON("APPDATA")) THEN settings_dir = ENVIRON("APPDATA") & SLASH & "OHRRPGCE" ELSE 'APPDATA enviroment variable doesn't exist in Windows 98 so we need a fallback settings_dir = app_dir & SLASH & "OHRRPGCE-settings" END IF #ELSE #ERROR "Unknown OS" #ENDIF IF NOT isdir(settings_dir) THEN makedir(settings_dir) RETURN settings_dir END FUNCTION 'May return "". FUNCTION get_home_dir() as string #IFDEF __FB_WIN32__ 'USERPROFILE only exists in Windows NT. 98 and ME store most directories like 'My Documents under C:\. Win95 lacks those, but does have %windir%\Desktop. RETURN ENVIRON("USERPROFILE") #ELSE RETURN ENVIRON("HOME") #ENDIF END FUNCTION 'Returns location of user's Documents dir or some fallback, which is the default 'directory for saving user files like new .rpg files 'if there is no more 'appropriate place available. Therefore it must be writable. FUNCTION get_documents_dir() as string DIM ret as string #IF defined(__FB_ANDROID__) 'FIXME: $HOME is (usually) empty on Android; there is no home directory 'This should be set to the user documents directory: 'Environment.getExternalStoragePublicDirectory(Environment.DIRECTORY_DOCUMENTS) #ELSEIF defined(__FB_DARWIN__) 'OSX does not change the standard user directory paths depending on the language, 'instead it only changes the "display name" of these directories. We don't support this. 'See https://developer.apple.com/library/mac/documentation/FileManagement/Conceptual/FileSystemProgrammingGuide/FileSystemOverview/FileSystemOverview.html#//apple_ref/doc/uid/TP40010672-CH2-SW10 ret = ENVIRON("HOME") & "/Documents" #ELSEIF defined(__FB_UNIX__) ' FIXME: I don't know how true this is ret = ENVIRON("HOME") & "/Documents" #ELSEIF defined(__FB_WIN32__) 'Localised and customisable; need to call winapi ret = os_get_documents_dir() #ELSE #ERROR "Unknown OS" #ENDIF IF diriswriteable(ret) = NO THEN ret = get_home_dir() & SLASH "Desktop" IF diriswriteable(ret) = NO THEN ret = CURDIR IF diriswriteable(ret) = NO THEN ret = app_dir 'Give up... END IF END IF END IF RETURN ret END FUNCTION '========================================================================================= ' ohrhelp files '========================================================================================= PRIVATE FUNCTION help_dir_helper(dirname as string, fname as string) as integer IF LEN(fname) THEN RETURN isfile(dirname + SLASH + fname) ELSE RETURN isdir(dirname) END FUNCTION FUNCTION get_help_dir(helpfile as string="") as string IF help_dir_helper(documents_dir & SLASH & "ohrhelp", helpfile) THEN RETURN documents_dir & SLASH & "ohrhelp" IF help_dir_helper(app_dir & SLASH & "ohrhelp", helpfile) THEN RETURN app_dir & SLASH & "ohrhelp" IF LEN(app_resources_dir) THEN 'platform-specific relative data files path (Mac OS X bundles) IF help_dir_helper(app_resources_dir & SLASH & "ohrhelp", helpfile) THEN RETURN app_resources_dir & SLASH & "ohrhelp" END IF #IFDEF __FB_UNIX__ DIM datafiles as string datafiles = app_dir & "/../share/games/ohrrpgce/ohrhelp" IF help_dir_helper(datafiles, helpfile) THEN RETURN datafiles datafiles = app_dir & "/../share/ohrrpgce/ohrhelp" IF help_dir_helper(datafiles, helpfile) THEN RETURN datafiles #ENDIF '-- if all else fails, place next to executable even if invalid RETURN app_dir & "ohrhelp" END FUNCTION FUNCTION load_help_file(helpkey as string, byref success as bool = NO) as string DIM help_dir as string help_dir = get_help_dir(helpkey & ".txt") IF isdir(help_dir) THEN DIM helpfile as string helpfile = help_dir & SLASH & helpkey & ".txt" DIM helptext as string = string_from_file(helpfile, NO, success) IF success THEN RETURN helptext END IF success = NO RETURN "No help found for """ & helpkey & """" END FUNCTION SUB save_help_file(helpkey as string, text as string) DIM help_dir as string help_dir = get_help_dir() IF NOT isdir(help_dir) THEN IF makedir(help_dir) THEN visible_debug """" & help_dir & """ does not exist and could not be created." EXIT SUB END IF END IF DIM helpfile as string helpfile = help_dir & SLASH & helpkey & ".txt" DIM fh as integer IF OPENFILE(helpfile, FOR_OUTPUT, fh) = 0 THEN DIM trimmed_text as string trimmed_text = RTRIM(text, ANY " " & CHR(13) & CHR(10)) PRINT #fh, trimmed_text CLOSE #fh ELSE visible_debug "help file """ & helpfile & """ is not writeable." END IF END SUB 'Expand ohrhelp templates, recursely replacing {{pagename}} with the contents of template_pagename.txt. 'Modifies helptext in-place. 'helpkey is the name of the help page, for error messages only. SUB expand_help(byref helptext as string, helpkey as string) DIM as integer searchstart = 1, tagstart, tagend DIM count as integer 'Number of replacements performed DO tagstart = INSTR(searchstart, helptext, "{{") IF tagstart = 0 THEN EXIT DO tagend = INSTR(tagstart, helptext, "}}") IF tagend = 0 THEN EXIT DO DIM taginner as string = MID(helptext, tagstart + 2, tagend - tagstart - 2) IF taginner <> exclusive(taginner, "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 -.:_+%:;?=&'") THEN 'Invalid, don't replace searchstart = tagend + 2 ELSE DIM success as bool DIM replacement as string = load_help_file("template_" + taginner, success) IF success = NO THEN 'Template missing, don't replace searchstart = tagend + 2 ELSE helptext = MID(helptext, 1, tagstart - 1) & RTRIM(replacement, !"\n") & MID(helptext, tagend + 2) searchstart = tagstart count += 1 IF count = 50 ORELSE LEN(helptext) > 1000000 THEN debug "Excessive replacements or length expanding help file " & helpkey EXIT DO END IF END IF END IF LOOP END SUB '========================================================================================== ' Color picker '========================================================================================== 'OK, NOW it supports negative n too FUNCTION xy_from_int(byval n as integer, byval wide as integer, byval high as integer) as XYPair DIM pair as XYPair n = POSMOD(n, wide * high) 'Mathematical modulo wide*high pair.x = n MOD wide pair.y = n \ wide RETURN pair END FUNCTION FUNCTION int_from_xy(pair as XYPair, byval wide as integer, byval high as integer) as integer RETURN bound(pair.y * wide + pair.x, 0, wide * high - 1) END FUNCTION FUNCTION color_browser_256(byval start_color as integer=0) as integer DIM ret as integer = start_color DIM cycle_idx as integer = 0 DIM gridpos as XYPair = (64, 0) DIM tilesize as XYPair = (12, 12) DIM spot as XYPair DIM cursor as XYPair cursor = xy_from_int(start_color, 16, 16) DIM mouse as MouseInfo DIM mouse_active as bool = NO 'Whether the color under the mouse is the one displayed at bottom DIM prev_mouse_vis as CursorVisibility = getcursorvisibility() hidemousecursor setkeys DO setwait 17, 55 setkeys mouse = readmouse IF mouse.moved THEN mouse_active = YES IF keyval(scF1) > 1 THEN show_help "color_browser" DIM mousecursor as XYPair mousecursor = (mouse.pos - gridpos) \ tilesize DIM mouse_over_grid as bool = in_bound(mousecursor.x, 0, 15) AND in_bound(mousecursor.y, 0, 15) DIM mouse_hover_col as integer = int_from_xy(mousecursor, 16, 16) IF keyval(ccUp) > 1 THEN mouse_active = NO : loopvar(cursor.y, 0, 15, -1) IF keyval(ccDown) > 1 THEN mouse_active = NO : loopvar(cursor.y, 0, 15, 1) IF keyval(ccLeft) > 1 THEN mouse_active = NO : loopvar(cursor.x, 0, 15, -1) IF keyval(ccRight) > 1 THEN mouse_active = NO : loopvar(cursor.x, 0, 15, 1) ret = int_from_xy(cursor, 16, 16) IF mouse_over_grid THEN IF mouse.buttons THEN cursor = mousecursor IF mouse.release AND mouseLeft THEN ret = mouse_hover_col EXIT DO END IF END IF IF enter_or_space() THEN EXIT DO 'The highlighted color, shown at the bottom DIM showcol as integer = IIF(mouse_over_grid AND mouse_active, mouse_hover_col, ret) 'ESC or right click outside to go back IF keyval(ccCancel) > 1 ORELSE (mouse_over_grid = NO ANDALSO (mouse.release AND mouseRight)) THEN ret = start_color EXIT DO END IF clearpage dpage DIM cycle_col as integer = uilook(cycle_idx) 'Draw the grid FOR i as integer = 0 TO 255 spot = xy_from_int(i, 16, 16) DIM where as XYPair = gridpos + spot * tilesize rectangle(vpages(dpage), XY_WH(where, tilesize), i) IF i = showcol THEN drawbox where.x, where.y, tilesize.x, tilesize.y, cycle_col, 1, dpage ELSEIF spot = cursor THEN drawants vpages(dpage), where.x, where.y, tilesize.x, tilesize.y, cycle_col END IF NEXT i textcolor cycle_col, 0 'Mouse cursor tip is offset in the font printstr CHR(2), mouse.x - 2, mouse.y - 2, dpage 'Draw color info textcolor uilook(uiMenuItem), 0 printstr "Color " & showcol, 320 + ancRight, 192, dpage WITH master(showcol) printstr "RGB" & lpad(STR(.r), , 4) & lpad(STR(.g), , 4) & lpad(STR(.b), , 4), 0, 192, dpage END WITH SWAP vpage, dpage setvispage vpage 'Only increment tog every 55ms (secondary setwait timer) IF dowait THEN loopvar cycle_idx, 0, uiColorOldLast LOOP setcursorvisibility prev_mouse_vis RETURN ret END FUNCTION '========================================================================================== ' Levelling-up '========================================================================================== FUNCTION exptolevel (byval level as integer, byval curve as double = 0.2) as integer ' HINT: Customisation goes here :) IF level = 0 THEN RETURN 0 DIM exper as integer = 30 FOR o as integer = 2 TO level exper = exper * (1 + curve) + 5 'FIXME: arbitrary experience cap should be removable IF exper > 1000000 THEN exper = 1000000 NEXT RETURN exper END FUNCTION FUNCTION total_exp_to_level (byval level as integer, byval curve as double = 0.2) as integer DIM total as integer = 0 FOR i as integer = 1 TO level total += exptolevel(i, curve) NEXT RETURN total END FUNCTION FUNCTION current_max_level() as integer RETURN small(gen(genLevelCap), gen(genMaxLevel)) END FUNCTION FUNCTION atlevel (byval lev as integer, byval a0 as integer, byval aMax as integer) as integer 'Stat at a given level, according to an arbitrary curve between two points. IF lev < 0 THEN RETURN 0 RETURN (.8 + lev / 50) * lev * ((aMax - a0) / 275.222) + a0 + .1 END FUNCTION FUNCTION atlevel_quadratic (byval lev as double, byval a0 as double, byval aMax as double, byval midpercent as double) as double 'Stat at a given level, according to an arbitrary curve between two points. 'CHECKME: Is it actually alright to return a double? IF lev < 0 THEN RETURN 0 IF gen(genMaxLevel) <= 0 THEN RETURN aMax DIM as double a, b 'quadratic coefficients (c=0 fixed) b = 4 * midpercent - 1 a = 1 - b DIM as double x = lev / gen(genMaxLevel) RETURN (a * x^2 + b * x) * (aMax - a0) + a0 + .1 END FUNCTION '========================================================================================== ' Animation rate '========================================================================================== FUNCTION ideal_ticks_per_second() as double 'This is an idealized estimate, NOT a measurment of actual FPS 'This is fixed for now, but will be customizable later. RETURN 18.3 END FUNCTION 'Ticks per walk frame, including walk-in-place. 'This is temporary until walking animations are handled by the animation system. FUNCTION wtog_ticks() as integer DIM ret as integer = gen(genTicksPerWalkFrame) IF ret <= 0 THEN ret = 55 * 2 / gen(genMillisecPerFrame) IF ret = 0 THEN ret = 1 END IF RETURN ret END FUNCTION 'Number of frames a walkabout set has for a direction FUNCTION walkabout_walk_frames(fr as Frame ptr, direction as DirNum) as integer RETURN num_frames_in_group(fr, direction) END FUNCTION 'Value that wtog (for walking animation) loops up to: 'ticks to complete a walking animation loop minus 1. 'This is temporary until walking animations are handled by the animation system. FUNCTION max_wtog(fr as Frame ptr, direction as DirNum) as integer RETURN large(0, walkabout_walk_frames(fr, direction) * wtog_ticks() - 1) END FUNCTION 'Wrapper for the walkabout container slice FUNCTION max_wtog(walkabout_sl as Slice ptr, direction as DirNum) as integer DIM sprsl as Slice ptr sprsl = LookupSlice(SL_WALKABOUT_SPRITE_COMPONENT, walkabout_sl, slSprite) IF sprsl ANDALSO sprsl->SpriteData->loaded THEN RETURN max_wtog(sprsl->SpriteData->img.sprite, direction) END IF END FUNCTION FUNCTION wtog_to_frame(wtog as integer) as integer 'The reason for this wrapper was to ensure frame numbers don't go out of bounds 'but it no longer matters RETURN wtog \ wtog_ticks() END FUNCTION '========================================================================================== ' global_reload_doc '========================================================================================== SUB setup_global_reload_doc () global_reload_doc = reload.CreateDocument() reload.SetRootNode(global_reload_doc, reload.CreateNode(global_reload_doc, "")) END SUB SUB cleanup_global_reload_doc () DIM rnod as reload.NodePtr = reload.DocumentRoot(global_reload_doc) DIM num as integer = reload.NumChildren(rnod) IF num > 0 THEN debug "===WARNING: Leaked " & num & " global reload nodes===" DIM n as reload.NodePtr = reload.FirstChild(rnod) DO WHILE n debug "node: """ & reload.NodeName(n) & """ " & reload.GetString(n) n = reload.NextSibling(n) LOOP END IF FreeChildren rnod END SUB 'Copy a reload node from wherever into the global_reload_doc FUNCTION get_reload_copy (byval n as NodePtr) as NodePtr DIM result as NodePtr result = CloneNodeTree(n, global_reload_doc) AddChild DocumentRoot(global_reload_doc), result RETURN result END FUNCTION 'Return an empty reload node attached to the global_reload_doc FUNCTION get_reload_empty (nodename as string = "") as NodePtr DIM result as NodePtr result = CreateNode(global_reload_doc, nodename) AddChild DocumentRoot(global_reload_doc), result RETURN result END FUNCTION '========================================================================================= ' Arrowsets & Virtual keyboard '========================================================================================= FUNCTION keyval_arrowset_up(arr as ArrowSet) as bool IF arr.U THEN IF keyval(arr.U) > 1 THEN RETURN YES RETURN NO END FUNCTION FUNCTION keyval_arrowset_right(arr as ArrowSet) as bool IF arr.R THEN IF keyval(arr.R) > 1 THEN RETURN YES RETURN NO END FUNCTION FUNCTION keyval_arrowset_down(arr as ArrowSet) as bool IF arr.D THEN IF keyval(arr.D) > 1 THEN RETURN YES RETURN NO END FUNCTION FUNCTION keyval_arrowset_left(arr as ArrowSet) as bool IF arr.L THEN IF keyval(arr.L) > 1 THEN RETURN YES RETURN NO END FUNCTION FUNCTION keyval_arrowset_confirm(arr as ArrowSet) as bool WITH arr IF .confirm THEN IF keyval(.confirm) > 1 THEN RETURN YES IF .confirm2 THEN IF keyval(.confirm2) > 1 THEN RETURN YES IF .confirm3 THEN IF keyval(.confirm3) > 1 THEN RETURN YES END WITH RETURN NO END FUNCTION FUNCTION keyval_arrowset_cancel(arr as ArrowSet) as bool WITH arr IF .cancel THEN IF keyval(.cancel) > 1 THEN RETURN YES IF .cancel2 THEN IF keyval(.cancel2) > 1 THEN RETURN YES END WITH RETURN NO END FUNCTION FUNCTION default_arrowset() as ArrowSet DIM arr as ArrowSet WITH arr .U = scUp .R = scRight .D = scDown .L = scLeft .confirm = scEnter .confirm2 = scSpace .confirm3 = scCTRL .cancel = scESC .cancel2 = scALT END WITH RETURN arr END FUNCTION FUNCTION arrowset_for_multiplayer_gamepad(byval player as integer) as ArrowSet DIM gamepad_node as NodePtr = 0 DIM gen_root as NodePtr gen_root = get_general_reld() IF player = 0 THEN gamepad_node = gen_root."gamepad".ptr ELSEIF player >= 1 ANDALSO player <= 3 THEN gamepad_node = NodeByPath(gen_root, "/multiplayer_gamepads/player[" & player & "]") END IF IF gamepad_node <> 0 THEN RETURN arrowset_from_reload(gamepad_node) ELSE debug "arrowset_for_multiplayer_gamepad: failed to find node for player " & player & ". using default arrowset instead" RETURN default_arrowset() END IF END FUNCTION FUNCTION arrowset_from_reload(gamepad as NodePtr) as ArrowSet DIM defarr as ArrowSet = default_arrowset() DIM arr as ArrowSet arr.U = gamepad."UP".default(defarr.U) arr.R = gamepad."RIGHT".default(defarr.R) arr.D = gamepad."DOWN".default(defarr.D) arr.L = gamepad."LEFT".default(defarr.L) arr.confirm = gamepad."A" IF arr.confirm = 0 THEN debug "WARNING: gamepad node has no confirm, using default" arr.confirm = defarr.confirm END IF arr.cancel = gamepad."B" arr.cancel2 = gamepad."X" IF arr.cancel = 0 ANDALSO arr.cancel2 = 0 THEN debug "WARNING: gamepad node has no cancel, using default" arr.cancel = defarr.cancel END IF RETURN arr END FUNCTION FUNCTION gamepad_virtual_keyboard (default_str as string, max_length as integer=-1, byval multi_player as integer=-1) as string 'multi_player argument determines which set of keys is used. '-1 means default keyboard keys '0-3 means the keys defined for multiplayer gamepad support. DIM arr as ArrowSet SELECT CASE multi_player CASE -1 arr = default_arrowset() CASE 0 TO 3 arr = arrowset_for_multiplayer_gamepad(multi_player) CASE ELSE debug "WARNING: gamepad_virtual_keyboard: can't get arrowset for multi_player " & multi_player arr = default_arrowset() END SELECT debuginfo "gamepad_virtual_keyboard player=" & multi_player RETURN gamepad_virtual_keyboard(arr, default_str, max_length) END FUNCTION FUNCTION gamepad_virtual_keyboard (arr as ArrowSet, default_str as string, max_length as integer=-1) as string 'This is intended for OUYA where the Android virtual keyboard seems to 'be partly broken. It might prove to be useful for other purposes too. debuginfo "ArrowSet " & arr.U & "," & arr.R & "," & arr.D & "," & arr.L & " confirm=" & arr.confirm & " cancel=" & arr.cancel DIM alphabet as string = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz 1234567890',.;:?!@#$%^&*~_+-=()[]{}<>/" DIM result as string = default_str '--Preserve whatever screen was already showing as a background DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen copypage vpage, dpage DIM root as Slice Ptr root = NewSliceOfType(slSpecial) root->Fill = YES DIM box as Slice Ptr box = NewSliceOfType(slRectangle, root) WITH *box .x = 0 .y = 10 .width = 210 .height = 80 .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignTop .AlignVert = alignCenter END WITH ChangeRectangleSlice box, 0 DIM keybox as Slice Ptr keybox = NewSliceOfType(slRectangle, box) WITH *keybox .x = 20 .y = 5 .width = 130 .height = 70 END WITH ChangeRectangleSlice keybox, , uilook(uiBackground), , borderNone DIM curs as Slice Ptr curs = NewSliceofType(slRectangle, keybox) WITH *curs .width = 10 .height = 10 END WITH ChangeRectangleSlice curs, , uilook(uiHighlight), , borderNone DIM ch as Slice Ptr FOR i as integer = 0 TO LEN(alphabet) - 1 ch = NewSliceOfType(sltext, keybox) ChangeTextSlice ch, MID(alphabet, i+1, 1), uilook(uiMenuItem), YES ch->x = (i MOD 13) * 10 ch->y = INT(i / 13) * 10 NEXT i DIM buttonbox as Slice Ptr buttonbox = NewSliceOfType(slContainer, box) WITH *buttonbox .x = -10 .y = 15 .width = 48 .AnchorHoriz = alignRight .AlignHoriz = alignRight END WITH DIM del as Slice Ptr del = NewSliceOfType(slRectangle, buttonbox) WITH *del .width = 40 .height = 12 .AnchorHoriz = alignCenter .AlignHoriz = alignCenter END WITH ChangeRectangleSlice del, , uilook(uiBackground), , borderNone DIM deltxt as Slice Ptr deltxt = NewSliceOfType(slText, del) WITH *deltxt .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignCenter .AlignVert = alignCenter END WITH ChangeTextSlice deltxt, "DEL", uilook(uiMenuItem), YES DIM confirm as Slice Ptr confirm = NewSliceOfType(slRectangle, buttonbox) WITH *confirm .y = 20 .width = 40 .height = 12 .AnchorHoriz = alignCenter .AlignHoriz = alignCenter END WITH ChangeRectangleSlice confirm, , uilook(uiBackground), , borderNone DIM confirmtxt as Slice Ptr confirmtxt = NewSliceOfType(slText, confirm) WITH *confirmtxt .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignCenter .AlignVert = alignCenter END WITH ChangeTextSlice confirmtxt, "DONE", uilook(uiMenuItem), YES DIM typingbox as Slice Ptr typingbox = NewSliceOfType(slRectangle, root) WITH *typingbox .y = -4 IF max_length = -1 THEN .width = 320 ELSE .width = small(320, max_length * 8 + 20) END IF .height = 20 .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignCenter .AlignVert = alignCenter END WITH ChangeRectangleSlice typingbox, 0 DIM typing as Slice Ptr typing = NewSliceOfType(sltext, typingbox) WITH *typing .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignCenter .AlignVert = alignCenter END WITH DIM p as XYPair DIM pt as integer DIM need_update as bool = YES DIM tog as integer DIM delflash as integer = 0 setkeys DO setwait 17 setkeys tog XOR= 1 IF getquitflag() THEN EXIT DO ' want to close the program! IF keyval_arrowset_cancel(arr) THEN delflash = 5 IF LEN(result) > 0 THEN result = LEFT(result, LEN(result) - 1) need_update = YES END IF END IF IF keyval_arrowset_confirm(arr) THEN IF p.x = -1 THEN SELECT CASE pt CASE 0: IF LEN(result) > 0 THEN result = LEFT(result, LEN(result) - 1) need_update = YES END IF CASE 1: EXIT DO END SELECT ELSE IF LEN(result) < max_length ORELSE max_length = -1 THEN result &= MID(alphabet, 1 + p.y * 13 + p.x, 1) need_update = YES END IF END IF END IF IF p.x = -1 THEN IF keyval_arrowset_up(arr) ORELSE keyval_arrowset_down(arr) THEN pt XOR= 1 need_update = YES END IF IF keyval_arrowset_right(arr) THEN p.x = 0 need_update = YES END IF IF keyval_arrowset_left(arr) THEN p.x = 12 need_update = YES END IF ELSE IF keyval_arrowset_up(arr) THEN loopvar p.y, 0, 6, -1 need_update = YES END IF IF keyval_arrowset_down(arr) THEN loopvar p.y, 0, 6, 1 need_update = YES END IF IF keyval_arrowset_left(arr) THEN loopvar p.x, -1, 12, -1 need_update = YES END IF IF keyval_arrowset_right(arr) THEN loopvar p.x, -1, 12, 1 need_update = YES END IF END IF IF need_update THEN need_update = NO IF p.x = -1 THEN SliceSetVisibility curs, NO ELSE SliceSetVisibility curs, YES curs->x = p.x * 10 curs->y = p.y * 10 END IF ChangeRectangleSlice del, , uilook(uiBackground) ChangeRectangleSlice confirm, , uilook(uiBackground) ChangeTextSlice typing, result, , YES END IF ChangeRectangleSlice curs, , uilook(uiHighlight + tog) IF p.x = -1 THEN SELECT CASE pt CASE 0: ChangeRectangleSlice del, , uilook(uiHighlight + tog) CASE 1: ChangeRectangleSlice confirm, , uilook(uiHighlight + tog) END SELECT END IF IF delflash > 0 THEN delflash -= 1 ChangeRectangleSlice del, , uilook(uiHighlight + tog) need_update = YES END IF DrawSlice root, dpage SWAP vpage, dpage setvispage vpage copypage holdscreen, dpage dowait LOOP freepage holdscreen DeleteSlice @root RETURN result END FUNCTION '========================================================================================= FUNCTION progress_spinner (byval exit_condition_func as FnNoArgsBool, caption as string, byval timeout_seconds as double) as bool 'In contrast to a progress meter, a progress spinner has no idea how long this will take 'so it just needs to animate until it succeeds or times out. 'Returns YES if didn't time out 'exit_condition_func should take no arguments and return YES when the progress is complete. DIM t as double = TIMER DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen DIM root as Slice Ptr root = NewSliceOfType(slSpecial) WITH *root .Fill = YES END WITH DrawSlice root, vpage DIM rect_sl as Slice Ptr rect_sl = NewSliceOfType(slRectangle, root) WITH *rect_sl .Width = 280 .Height = 50 ' updated again after the text is wrapped .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignCenter .AlignVert = alignCenter END WITH ChangeRectangleSlice rect_sl, 0 DIM text_sl as Slice Ptr text_sl = NewSliceOfType(slText, rect_sl) WITH *text_sl .Y = 8 .Width = rect_sl->Width - 16 .AnchorHoriz = alignCenter .AlignHoriz = alignCenter END WITH ChangeTextSlice text_sl, caption, uiLook(uiText), YES, YES DIM bubbles(7) as Slice Ptr FOR i as integer = 0 TO 7 bubbles(i) = NewSliceOfType(slEllipse, rect_sl) WITH *bubbles(i) .X = rect_sl->Width / 9 * (i+1) .Y = -23 .Width = 10 .Height = 10 .AnchorHoriz = alignCenter .AlignVert = alignCenter .AnchorVert = alignCenter .AlignVert = alignBottom END WITH ChangeEllipseSlice bubbles(i), uilook(uiHealthBar), uilook(uiHealthBarFlash) NEXT i rect_sl->Height = 8 + text_sl->Height + 8 + 30 + 8 DIM oscil as integer = 0 DIM bub_size as integer = 0 DIM ret as bool = YES '--Display the spinner animation while waiting for the action to succeed (or time-out) ' Spinner is displayed as a row of oscilating bubbles setkeys YES DO WHILE NOT exit_condition_func() IF TIMER - t > timeout_seconds THEN ret = NO : EXIT DO setwait 55 setkeys YES loopvar oscil, 0, 29 FOR i as integer = 0 TO 7 bub_size = ABS((oscil + i) MOD 30 - 15) + 5 bubbles(i)->Width = bub_size bubbles(i)->Height = bub_size NEXT i copypage holdscreen, vpage DrawSlice root, vpage setvispage vpage dowait LOOP freepage holdscreen DeleteSlice @root RETURN ret END FUNCTION '========================================================================================= ' general.reld helpers '========================================================================================= '--Wrapper functions for getting and setting values from general.reld FUNCTION default_gen_bool(nodepath as string) as bool 'This function supplies a centralized place to manage defaults for 'boolean keys in the general.reld lump. This way it is easy to change 'defaults without having to update every get_gen_bool() call. SELECT CASE nodepath CASE "/mouse/move_hero": RETURN NO CASE "/mouse/move_hero/display_dest": RETURN NO CASE "/mouse/move_hero/cancel_on_battle": RETURN YES CASE "/mouse/move_hero/cancel_on_textbox": RETURN YES CASE "/mouse/move_hero/cancel_on_menu": RETURN YES CASE "/mouse/menu_right_click": RETURN NO CASE "/mouse/mouse_menus": RETURN NO CASE "/mouse/mouse_battles": RETURN NO CASE "/mouse/click_textboxes": RETURN NO CASE "/mouse/click_keys": RETURN NO CASE "/mouse/show_cursor": RETURN NO CASE "/mobile_options/touch_textboxes/enabled": RETURN YES CASE ELSE debuginfo "default_gen_bool: no default for nodepath """ & nodepath & """ falling back to NO" RETURN NO END SELECT END FUNCTION FUNCTION default_gen_int(nodepath as string) as integer 'This function supplies a centralized place to manage defaults for 'integers in the general.reld lump. This way it is easy to change 'defaults without having to update every get_gen_int() call. SELECT CASE nodepath CASE "/mouse/move_hero/max_path_length": RETURN 0 CASE ELSE debuginfo "default_gen_int: no default for nodepath """ & nodepath & """ falling back to 0" RETURN 0 END SELECT END FUNCTION FUNCTION gen_int_limits(nodepath as string, warn as bool = NO) as XYPair 'This function supplies a centralized place to manage 'minimum and maximum values for integers in general.reld SELECT CASE nodepath CASE "/mouse/move_hero/max_path_length": RETURN XY(0, 100000) CASE ELSE IF warn THEN debug "gen_int_limits: no limits for """ & nodepath & """" RETURN XY(INT_MIN, INT_MAX) END SELECT END FUNCTION FUNCTION enforce_gen_int_limits(nodepath as string, byval v as integer) as integer DIM limits as XYPair = gen_int_limits(nodepath) IF v < limits.x THEN debug nodepath & " " & v & " is less than " & limits.x & " (correcting)" RETURN limits.x END IF IF v > limits.y THEN debug nodepath & " " & v & " is greater than " & limits.y & " (correcting)" RETURN limits.y END IF RETURN v END FUNCTION 'Read a string from general.reld. FUNCTION get_gen_str(nodepath as zstring ptr, default as zstring ptr = @"") as string DIM gen_root as NodePtr = get_general_reld() DIM node as NodePtr = NodeByPath(gen_root, nodepath) IF node THEN RETURN GetString(node) RETURN *default END FUNCTION 'Read a bool from general.reld. ''default' can be omitted to use the default in default_gen_bool. 'Putting the default in default_gen_bool is better if required in more than one place. FUNCTION get_gen_bool(nodepath as zstring ptr, byref default as bool = default_arg) as bool DIM gen_root as NodePtr = get_general_reld() DIM node as NodePtr = NodeByPath(gen_root, nodepath) IF node THEN RETURN IIF(GetInteger(node), YES, NO) IF @default <> @default_arg THEN return default RETURN default_gen_bool(*nodepath) END FUNCTION 'Read an int from general.reld, enforcing any limits in gen_int_limits. ''default' can be omitted to use the default in default_gen_int. 'Putting the default in default_gen_int is better if required in more than one place. FUNCTION get_gen_int(nodepath as zstring ptr, byref default as integer = default_arg) as integer DIM gen_root as NodePtr = get_general_reld() DIM node as NodePtr = NodeByPath(gen_root, nodepath) IF node THEN RETURN enforce_gen_int_limits(*nodepath, GetInteger(node)) IF @default <> @default_arg THEN RETURN default RETURN default_gen_int(*nodepath) END FUNCTION SUB set_gen_bool(nodepath as zstring ptr, byval v as bool) 'This changes the node, but does not call write_general_reld() DIM gen_root as NodePtr = get_general_reld() DIM node as NodePtr = NodeByPath(gen_root, nodepath, YES) SetContentBool(node, v) END SUB SUB set_gen_int(nodepath as zstring ptr, byval v as integer) 'This changes the node, but does not call write_general_reld() DIM gen_root as NodePtr = get_general_reld() DIM node as NodePtr = NodeByPath(gen_root, nodepath, YES) SetContent(node, enforce_gen_int_limits(*nodepath, v)) END SUB SUB toggle_gen_bool(nodepath as zstring ptr) 'This changes the node, but does not call write_general_reld() set_gen_bool(nodepath, NOT get_gen_bool(nodepath)) END SUB FUNCTION gen_intgrabber(nodepath as string) as bool 'This changes the node, but does not call write_general_reld() DIM v as integer = get_gen_int(nodepath) DIM limits as XYPair = gen_int_limits(nodepath, YES) IF intgrabber(v, limits.x, limits.y) THEN set_gen_int(nodepath, v) RETURN YES END IF RETURN NO END FUNCTION '========================================================================================== ' Reading/writing ohrrpgce_config.ini / gameconfig.ini '========================================================================================== ' Called on startup to set up config-related globals (excluding savedir) SUB set_game_config_globals(sourcerpg as string) game_fname = trimpath(trimextension(sourcerpg)) prefsdir = settings_dir & SLASH & game_fname 'Custom doesn't save anything in prefsdir, don't bother creating it #IFDEF IS_GAME IF NOT isdir(prefsdir) THEN makedir prefsdir #IFDEF __FB_JS__ web_mount_persistent_storage(prefsdir) #ENDIF #ENDIF IF LEN(app_resources_dir) ANDALSO trimfilename(sourcerpg) = app_resources_dir THEN 'On Mac, if running a game bundled in the .app look next to the .app '(app_dir has trailing slash) game_config_file = app_dir & game_fname & "_config.ini" ELSE 'Check next to the .rpg first: the engine never creates the file here, but the user might game_config_file = trimfilename(sourcerpg) & SLASH & game_fname & "_config.ini" END IF IF NOT isfile(game_config_file) THEN game_config_file = prefsdir & SLASH & "gameconfig.ini" END IF END SUB SUB set_global_config_file() 'Check next to Game/Custom first: the engine never creates the file here, but the user might global_config_file = app_dir & "ohrrpgce_config.ini" IF NOT isfile(global_config_file) THEN global_config_file = settings_dir & SLASH & "ohrrpgce_config.ini" END IF END SUB 'Try to read the value of a key first from game_config_file then from global_config_file, 'checking whether there's an app-specific setting prefixed by exe_prefix. '(Do NOT manually prepend exe_prefix/"game."/"edit.".) 'For example if key is "gfx.fullscreen" and exe_prefix is "edit.", then try '"edit.gfx.fullscreen" and "gfx.fullscreen" in order. FUNCTION read_config_str (key as zstring ptr, default as zstring ptr=@"") as string IF game_config_file <> "" THEN 'Settings in the game's .ini file override others DIM ret as string = read_ini_prefixed_str(game_config_file, key, @CHR(1)) IF ret <> CHR(1) THEN RETURN ret END IF IF global_config_file = "" THEN RETURN *default 'Too early in startup? RETURN read_ini_prefixed_str(global_config_file, key, default) END FUNCTION 'See read_config_str 'Optionally returns the line number (0-indexed) on which the match was found in linenum, or else -1. FUNCTION read_ini_prefixed_str (filename as string, key as zstring ptr, default as zstring ptr=@"", byref linenum as integer=0) as string REDIM ini(-1 TO -1) as string linenum = -1 IF real_isfile(filename) = NO THEN RETURN *default lines_from_file ini(), filename RETURN read_ini_prefixed_str(ini(), key, default, linenum) END FUNCTION FUNCTION read_ini_prefixed_str (ini() as string, key as zstring ptr, default as zstring ptr=@"", byref linenum as integer=0) as string 'First check for setting prefixed with game. or edit. '(Normally you wouldn't prepend exe_prefix, but it does happen when called 'from write_ini_prefixed_str. No harm if we double-prefix it here.) DIM ret as string = read_ini_str(ini(), exe_prefix & *key, *default, linenum) IF linenum <> -1 THEN RETURN ret 'Otherwise check for key exactly as specified RETURN read_ini_str(ini(), *key, *default, linenum) END FUNCTION FUNCTION read_config_int (key as zstring ptr, default as integer=0) as integer RETURN str2int(read_config_str(key), default) END FUNCTION FUNCTION read_config_bool (key as zstring ptr, default as bool=NO) as bool RETURN str2bool(read_config_str(key), default) END FUNCTION 'Overwrite or (only if force_write) append a line to an .ini file. Returns true if wrote. '(If shuffle_to_end is true, moves the modified line to the end.) 'Almost-drop-in replacement for write_ini_value which is compatible with read_config_*: 'if there's more-specific setting prefixed with game. or edit., it gets overwritten. 'If there is a less-specific setting (e.g. gfx.fullscreen if we're writing game.gfx.fullscreen, 'or gfx.foo when we're writing gfx.gfx_sdl.foo) then it isn't replaced, but gets shadowed by 'the value we write. '(One difference from write_ini_value: only replaces the first match, not all of them) 'uses the same prefix-matching FUNCTION write_ini_prefixed_str(filename as string, key as zstring ptr, value as zstring ptr, force_write as bool = YES, shuffle_to_end as bool = NO) as bool REDIM ini(-1 TO -1) as string IF real_isfile(filename) THEN lines_from_file ini(), filename ELSEIF force_write = NO THEN RETURN NO END IF DIM ret as bool = NO DIM linenum as integer read_ini_prefixed_str(ini(), key, , linenum) IF linenum <> -1 THEN 'Matched IF shuffle_to_end THEN a_shuffle_to_end ini(), linenum linenum = UBOUND(ini) END IF ini(linenum) = LEFT(ini(linenum), INSTR(ini(linenum), "=")) + " " + *value 'debug filename & ": overwriting " & ini(linenum) ret = YES ELSEIF force_write THEN a_append ini(), *key + " = " + *value 'debug filename & ": appending " & ini(ubound(ini)) ret = YES END IF IF ret THEN lines_to_file ini(), filename, LINE_END RETURN ret END FUNCTION 'Remove all lines from an .ini file matching key, including prefixed matched like read_config_str finds. 'Returns true if removed at least one line. FUNCTION remove_ini_prefixed_str(filename as string, key as zstring ptr) as bool REDIM ini(-1 TO -1) as string IF lines_from_file(ini(), filename, NO) = NO THEN RETURN NO 'expect_exists=NO DIM linenum as integer DIM ret as bool DO read_ini_prefixed_str(ini(), key, , linenum) IF linenum = -1 THEN EXIT DO a_pop ini(), linenum ret = YES LOOP IF ret THEN lines_to_file ini(), filename, LINE_END RETURN ret END FUNCTION 'Write a config setting to either global_config_file (in general) or 'game_config_file: '-If the setting already exists in either file, possibly with an additional ' game. or edit. prefix, overwrite it, preserving whatever prefix it had, ' so read_config will return 'value' after doing its search. '-Otherwise add a new setting to global_config_file ' 'If you want a setting to be game-specific, use write_game_config. 'If you want it to be specific to Game/Custom, prepend exe_prefix or "game." 'or "edit.". ' 'Here are some guidelines for naming a key, not nailed down: '-Something specific to an editor, shared between all games should look like ' "mapedit.show_overhead" (eg "sliceedit." can be shared by Game + Custom) '-Shared gfx backend options go under "gfx." '-Backend-specific options go under eg. "gfx.gfx_sdl." '-Prepend game./edit. if it's not obvious that it only affects one of ' Game/Custom, but mostly these aren't added SUB write_config (key as zstring ptr, value as string) IF game_config_file <> "" THEN 'Settings in the game's .ini file override others. If there's a match there, 'overwrite it. IF write_ini_prefixed_str(game_config_file, *key, value, NO) THEN EXIT SUB END IF 'Overwrite any match in ohrrpgce_config.ini, otherwise append to it. write_ini_prefixed_str(global_config_file, *key, value, YES) END SUB SUB write_config (key as zstring ptr, value as integer) write_config key, STR(value) END SUB SUB write_config (key as zstring ptr, value as double) write_config key, FORMAT(value, "0.000") END SUB 'Same as write_config, except this only writes to game_config_file to write 'game-specific settings. key can optionally be prefixed with "game." or "edit." SUB write_game_config (key as zstring ptr, value as string) BUG_IF(LEN(game_config_file) = 0, "No game loaded, can't write " & *key) write_ini_prefixed_str(game_config_file, *key, value, YES) END SUB SUB write_game_config (key as zstring ptr, value as integer) write_game_config key, STR(value) END SUB SUB write_game_config (key as zstring ptr, value as double) write_game_config key, FORMAT(value, "0.000") END SUB '========================================================================================== ' Textboxes '========================================================================================== 'Index of last non-blank line, or -1 if none FUNCTION text_box_last_line(byref box as TextBox) as integer FOR i as integer = UBOUND(box.text) TO 0 STEP -1 IF LEN(TRIM(box.text(i))) > 0 THEN RETURN i NEXT RETURN -1 END FUNCTION FUNCTION get_text_box_height(byref box as TextBox) as integer IF box.shrink >= 0 THEN RETURN 88 - box.shrink * 4 DIM lastline as integer = text_box_last_line(box) IF lastline = -1 THEN RETURN 88 'Instead of 90 for a full box, why? DIM vsize as integer = 20 + lastline * 10 IF vsize < 32 AND vsize > 24 THEN RETURN 32 IF vsize <= 24 THEN RETURN 16 RETURN vsize END FUNCTION 'Creates the slices for a textbox, returning them in the txtsl variable. 'revealed: if false, the text isn't revealed yet SUB init_text_box_slices(byref txtsl as Slice ptr, box as TextBox, parent as Slice ptr, revealed as bool) IF txtsl THEN '--free any already-loaded textbox DeleteSlice @txtsl END IF 'The textbox root slice is parent to the box and choicebox txtsl = NewSliceOfType(slContainer, parent, SL_TEXTBOX_ROOT) WITH *txtsl IF .Parent THEN 'Should not be set to fill, as scripts may expect to be able to move it around. 'Set the width and height according to parent's (which is SliceTable.TextBox) size and padding. .Fill = YES .Parent->ChildRefresh(.Parent, txtsl) .Fill = NO END IF END WITH '--Create a new slice for the text box DIM text_box as Slice Ptr '--set up box style text_box = NewSliceOfType(slRectangle, txtsl, SL_TEXTBOX_BOX) IF box.no_box THEN 'Invisible box (for the benefit of scripts) ChangeRectangleSlice text_box, , , , borderNone, transHollow ELSE ChangeRectangleSlice text_box, box.boxstyle, , , , iif(box.opaque, transOpaque, transFuzzy) END IF '--position and size the text box WITH *text_box .X = 0 .Y = 4 + box.vertical_offset * 4 .Width = 312 .Height = get_text_box_height(box) .PaddingLeft = 4 .PaddingRight = 4 .PaddingTop = 3 .PaddingBottom = 3 'Horizontal centering .AlignHoriz = alignCenter .AnchorHoriz = alignCenter .AnchorVert = alignTop .AlignVert = alignTop END WITH '--Set up the actual text DIM col as integer col = uilook(uiText) IF box.textcolor > 0 THEN col = box.textcolor DIM s as string = "" FOR i as integer = 0 TO UBOUND(box.text) s &= box.text(i) & CHR(10) NEXT i DIM text_sl as Slice Ptr text_sl = NewSliceOfType(slText, text_box, SL_TEXTBOX_TEXT) text_sl->Fill = YES ChangeTextSlice text_sl, s, col, YES, YES IF revealed = NO THEN '--start the displayed lines as all hidden. They will be revealed in update_textbox text_sl->TextData->line_limit = 0 END IF '--figure out which portrait to load DIM img_id as integer = -1 DIM pal_id as integer = -1 DIM hero_slot as integer = -1 DIM hero_id as integer = -1 SELECT CASE box.portrait_type CASE portraitSPRITESET 'Fixed ID number img_id = box.portrait_id pal_id = box.portrait_pal CASE portraitPARTYRANK 'Hero by caterpillar #IFDEF IS_GAME hero_slot = rank_to_party_slot(box.portrait_id) #ELSE 'In Custom, no party exists, so preview using the first hero hero_id = 0 #ENDIF CASE portraitPARTYSLOT 'Hero by party slot #IFDEF IS_GAME hero_slot = box.portrait_id #ELSE 'In Custom, no party exists, so preview using the first hero hero_id = 0 #ENDIF CASE portraitHEROID 'Hero by ID hero_id = box.portrait_id #IFDEF IS_GAME 'If the hero is in the party, use their current state. 'if there are multiple copies, use the first. hero_slot = findhero(hero_id) IF hero_slot = -1 THEN 'The hero is not in the party right now, use their default DIM her as HeroDef loadherodata her, hero_id img_id = her.portrait pal_id = her.portrait_pal END IF #ENDIF END SELECT #IFDEF IS_GAME IF hero_slot >= 0 ANDALSO hero_slot <= UBOUND(gam.hero) THEN IF gam.hero(hero_slot).id >= 0 THEN img_id = gam.hero(hero_slot).portrait_pic pal_id = gam.hero(hero_slot).portrait_pal END IF END IF #ELSE IF hero_id >= 0 THEN DIM her as HeroDef loadherodata her, hero_id img_id = her.portrait pal_id = her.portrait_pal END IF #ENDIF IF img_id >= 0 THEN '--First set up the box that holds the portrait DIM img_box as Slice Ptr img_box = NewSliceOfType(slRectangle, text_box, SL_TEXTBOX_PORTRAIT_BOX) IF box.portrait_box THEN ChangeRectangleSlice img_box, box.boxstyle, , , , transFuzzy ELSE 'Invisible box ChangeRectangleSlice img_box, , , , borderNone, transHollow END IF img_box->X = box.portrait_pos.x - 4 img_box->Y = box.portrait_pos.y - 3 '--Then load the portrait DIM img_sl as Slice Ptr img_sl = NewSliceOfType(slSprite, img_box, SL_TEXTBOX_PORTRAIT) ChangeSpriteSlice img_sl, sprTypePortrait, img_id, pal_id img_box->Width = img_sl->width img_box->Height = img_sl->height END IF '--set up the choice-box (if any) IF box.choice_enabled THEN DIM choice_box as Slice Ptr choice_box = NewSliceOfType(slRectangle, txtsl, SL_TEXTBOX_CHOICE_BOX) WITH *choice_box '--center the box .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .AnchorVert = alignTop .AlignVert = alignTop '--set box size .Width = 10 + large(LEN(box.choice(0)) * 8, LEN(box.choice(1)) * 8) .Height = 24 '--FIXME: This hackyness just reproduces the old method of positioning the choicebox. '--FIXME: eventually the game author should have control over this. '(Note that a variant on this is in textbox_edit_preview) .Y = text_box->Y + text_box->Height + 12 IF .Y > txtsl->Height - (.Height + 4) THEN .Y = 32 END WITH 'The choicebox isn't affected by box.opaque or box.no_box ChangeRectangleSlice choice_box, box.boxstyle REDIM choice_sl(1) as Slice Ptr FOR i as integer = 0 TO 1 choice_sl(i) = NewSliceOfType(slText, choice_box) ChangeTextSlice choice_sl(i), box.choice(i), uilook(uiMenuItem), YES WITH *(choice_sl(i)) .AnchorHoriz = alignCenter .AlignHoriz = alignCenter .Y = 2 + i * 10 END WITH NEXT i choice_sl(0)->Lookup = SL_TEXTBOX_CHOICE0 choice_sl(1)->Lookup = SL_TEXTBOX_CHOICE1 END IF END SUB '---------------------------------------------------------------------- #IFDEF __FB_MAIN__ print "All passed." #ENDIF