'OHRRPGCE - Some fundamental routines for major data structures, especially loading & saving them
'(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.
#include "config.bi"
#include "udts.bi"
#include "const.bi"
#include "common.bi"
#include "loading.bi"
#include "allmodex.bi"
#include "reload.bi"
#include "reloadext.bi"
#include "os.bi"
#include "slices.bi"
#include "battle_udts.bi"
#include "crt.bi"
USING RELOAD
USING RELOAD.EXT
'==========================================================================================
' Globals
'==========================================================================================
#IFDEF IS_CUSTOM
EXTERN channel_to_Game as IPCChannel
#ENDIF
'Script triggers and names
REDIM lookup1_bin_cache(-1 TO -1) as TriggerData
REDIM script_names() as IntStrPair
'==========================================================================================
' Local Functions
'==========================================================================================
declare sub save_hero_as_reload(hero as HeroDef, byval parent as NodePtr)
declare Sub load_hero_from_old_dt0(filename as string, hero as HeroDef, byval record as integer)
declare Sub save_hero_as_old_dt0(filename as string, hero as HeroDef, byval record as integer)
declare sub create_blank_hero_reld(hero as HeroDef, byval id as integer = -1)
declare sub general_reld_init_buttonnames(root_node as NodePtr)
declare sub append_trade_node (byval par as NodePtr, byval itnum as integer, byval itqty as integer)
declare sub InternalDefaultUIColors (masterpal() as RGBcolor, colarray() as integer, uidef() as integer, boxarray() as BoxStyle, boxdef() as integer)
declare sub SaveUIColorsNode (byval node as NodePtr, colarray() as integer, boxarray() as BoxStyle)
declare sub LoadUIColorsNode (byval node as NodePtr, colarray() as integer, boxarray() as BoxStyle, masterpal() as RGBcolor)
declare function FillMissingUIColor(byval index as integer, colarray() as integer, masterpal() as RGBcolor) as integer
'==========================================================================================
' Helper Functions
'==========================================================================================
FUNCTION DeSerSingle (buf() as integer, byval index as integer) as single
DIM ret as single
CAST(short ptr, @ret)[0] = buf(index)
CAST(short ptr, @ret)[1] = buf(index + 1)
RETURN ret
END FUNCTION
SUB SerSingle (buf() as integer, byval index as integer, byval sing as single)
buf(index) = CAST(short ptr, @sing)[0]
buf(index + 1) = CAST(short ptr, @sing)[1]
END SUB
/' Not used yet
SUB LoadCondition (byref cond as Condition, buf() as integer, offset as integer)
cond.comp = buf(offset)
cond.varnum = buf(offset + 1)
cond.value = buf(offset + 2)
cond.editstate = 0
cond.lastinput = 0
IF cond.comp < 0 ORELSE cond.comp > compLAST ORELSE _
(cond.comp = compTag ANDALSO (cond.tag < -max_tag ORELSE cond.tag > max_tag)) ORELSE _
(cond.comp <> compTag ANDALSO (cond.varnum < 0 ORELSE cond.varnum > maxScriptGlobals)) THEN
debugerror strprintf("LoadCondition: Invalid cond (%d,%d,%d) at off=%d", cond.comp, cond.varnum, cond.value, offset)
cond.comp = compNone
cond.varnum = 0
cond.value = 0
END IF
END SUB
SUB SaveCondition (cond as Condition, buf() as integer, offset as integer)
buf(offset) = cond.comp
buf(offset + 1) = cond.varnum
buf(offset + 2) = cond.value
END SUB
'/
'Save extravec, a variable-length extra data array, as a child of 'parent' named 'nodename'.
'This is the current RELOAD extra data encoding (e.g. slices, zones), but there were formerly two
'other encodings used.
'Only creates a node if the extra vector is not default.
SUB SaveExtraVector(parent as Node ptr, nodename as zstring ptr, extravec as integer vector)
IF extravec THEN
DIM length as integer = v_len(extravec)
'Check whether still the default value, [0,0,0].
IF length = 3 ANDALSO (extravec[0] OR extravec[1] OR extravec[2]) = 0 THEN EXIT SUB
DIM ex_node as Node ptr = SetChildNode(parent, nodename, length)
DIM last as integer = 0 'Previous value, defaulting to 0
DIM repeats as integer = 0 'Length of current run of repeats
FOR idx as integer = 0 TO length - 1
DIM value as integer = extravec[idx]
IF value = last THEN
repeats += 1
ELSE
IF repeats THEN AppendChildNode(ex_node, "repeat", repeats)
repeats = 0
AppendChildNode(ex_node, "int", value)
last = value
END IF
NEXT
IF repeats THEN AppendChildNode(ex_node, "repeat", repeats)
END IF
END SUB
'Load a variable-length extra data array into extravec.
'This is the current RELOAD extra data encoding (e.g. for slices, zones), but there
'were formerly two other encodings used.
'ex_node is a Node created by SaveExtraVector.
FUNCTION LoadExtraVector(ex_node as Node ptr, byref extravec as integer vector, thing_or_file as zstring ptr = @"") as bool
v_free extravec
IF ex_node = NULL THEN RETURN NO
DIM length as integer = GetInteger(ex_node)
IF length < 0 ORELSE length > maxExtraLength THEN
reporterr strprintf("Error loading %s: extra data length %d out of range", thing_or_file, length), serrError
RETURN NO
ELSE
v_new extravec, length
DIM ch as Reload.NodePtr = FirstChild(ex_node)
DIM last as integer = 0
DIM idx as integer = 0
WHILE ch 'Would use READNODE if it could declare an ELSE case
DIM repeats as integer
SELECT CASE NodeName(ch)
CASE "int"
last = GetInteger(ch)
repeats = 1
CASE "repeat"
repeats = GetInteger(ch)
CASE ELSE
reporterr strprintf("Error loading %s: unknown extra data type %s", thing_or_file, ch->Name), serrError
RETURN NO
END SELECT
FOR idx = idx TO idx + repeats - 1
IF idx >= maxExtraLength THEN
reporterr strprintf("Error loading %s: max extra data length exceeded", thing_or_file), serrError
RETURN NO
ELSE
extravec[idx] = last
END IF
NEXT
ch = NextSibling(ch)
WEND
'It's permitted for there to be fewer than 'length' children, the rest are 0
END IF
RETURN YES
END FUNCTION
'Obsolete format for saving zone extra data 0-2, which used SetKeyValueNode
'for non-zero extra data.
SUB LoadExtraKeyValueNodes(parent as Node ptr, byref extravec as integer vector, thing_or_file as zstring ptr = @"")
v_free extravec
DIM subnode as Node ptr
subnode = FirstChild(parent, "extra")
WHILE subnode
DIM extranum as integer = GetInteger(subnode)
IF extranum >= 0 ANDALSO extranum <= 2 THEN
set_extra extravec, extranum, subnode."int"
ELSE
reporterr strprintf("Can't load %s: bad extra %d", thing_or_file, extranum), serrError
END IF
subnode = NextSibling(subnode, "extra")
WEND
END SUB
'==========================================================================================
' NPC Definitions
'==========================================================================================
FUNCTION global_npcdef_filename (byval pool_id as integer=1) as string
RETURN workingdir & SLASH & "globalnpcs" & pool_id & ".n"
END FUNCTION
FUNCTION npc_pool_name(pool as integer) as string
IF pool = 0 THEN RETURN "Local"
IF pool = 1 THEN RETURN "Global"
RETURN "Pool " & pool
END FUNCTION
' Read NPC definitions from file. Resizes dat().
SUB LoadNPCD(file as string, dat() as NPCType, expect_exists as bool = YES)
DIM as integer i, j, f
DIM as integer arraylen
IF OPENFILE(file, FOR_BINARY + ACCESS_READ, f) = 0 THEN
SEEK #f, 8
arraylen = (LOF(f) - 7) \ getbinsize(binN)
END IF
IF arraylen < 1 THEN
REDIM dat(0)
IF expect_exists THEN showerror "NPC data is corrupt or missing, " & trimpath(file) & " is length " & LOF(f)
EXIT SUB
END IF
REDIM dat(arraylen - 1)
DIM as integer recordlen = getbinsize(binN) \ 2
DIM as integer buf(recordlen - 1)
BUG_IF(recordlen <> maxNPCDataField + 1, "maxNPCDataField not updated")
FOR i = 0 TO arraylen - 1
loadrecord buf(), f, recordlen
FOR j = 0 TO recordlen - 1
SetNPCD(dat(i), j, buf(j))
NEXT
IF dat(i).speed = 3 THEN dat(i).speed = 10
NEXT
CLOSE #f
END SUB
SUB SaveNPCD(file as string, dat() as NPCType)
DIM as integer i, j, f
OPENFILE(file, FOR_BINARY + ACCESS_WRITE, f) 'Truncate to zero
SEEK #f, 8 'Skip garbage bsave header
DIM as integer recordlen = getbinsize(binN) \ 2
DIM as integer buf(recordlen - 1)
BUG_IF(recordlen <> maxNPCDataField + 1, "maxNPCDataField not updated")
FOR i = 0 TO UBOUND(dat)
FOR j = 0 TO recordlen - 1
IF j = 3 AND dat(i).speed = 10 THEN
'--Special case for speed = 10 (gets stored as 3)
buf(j) = 3
ELSE
buf(j) = GetNPCD(dat(i), j)
END IF
NEXT
storerecord buf(), f, recordlen
NEXT
CLOSE #f
END SUB
SUB SetNPCD (npcdata as NPCType, intoffset as integer, value as integer)
'--intoffset is the integer offset, same as appears in the .N lump documentation
WITH npcdata
SELECT CASE intoffset
CASE 0: .picture = value
CASE 1: .palette = value
CASE 2: .movetype = value
CASE 3: .speed = value
CASE 4: .textbox = value
CASE 5: .facetype = value
CASE 6: .item = value
CASE 7: .pushtype = value
CASE 8: .activation = value
CASE 9: .tag1 = value
CASE 10: .tag2 = value
CASE 11: .usetag = value
CASE 12: .script = value
CASE 13: .scriptarg = value
CASE 14: .vehicle = value
CASE 15: .defaultzone = value
CASE 16: .defaultwallzone = value
CASE 17: .ignore_passmap = value
CASE 18: .pathfinding_obstruction_mode = value
CASE ELSE
showbug "SetNPCD: " & intoffset & " is an invalid integer offset"
END SELECT
END WITH
END SUB
FUNCTION GetNPCD (npcdata as NPCType, intoffset as integer) as integer
'--intoffset is the integer offset, same as appears in the .N lump documentation
WITH npcdata
SELECT CASE intoffset
CASE 0: RETURN .picture
CASE 1: RETURN .palette
CASE 2: RETURN .movetype
CASE 3: RETURN .speed
CASE 4: RETURN .textbox
CASE 5: RETURN .facetype
CASE 6: RETURN .item
CASE 7: RETURN .pushtype
CASE 8: RETURN .activation
CASE 9: RETURN .tag1
CASE 10: RETURN .tag2
CASE 11: RETURN .usetag
CASE 12: RETURN .script
CASE 13: RETURN .scriptarg
CASE 14: RETURN .vehicle
CASE 15: RETURN .defaultzone
CASE 16: RETURN .defaultwallzone
CASE 17: RETURN .ignore_passmap
CASE 18: RETURN .pathfinding_obstruction_mode
CASE ELSE
showbug "GetNPCD: " & intoffset & " is an invalid integer offset"
END SELECT
END WITH
RETURN 0
END FUNCTION
'==========================================================================================
' NPC Instances
'==========================================================================================
'Legacy (used for .L); not kept up to date with changes to NPCInst
SUB LoadNPCL(file as string, dat() as NPCInst)
DIM i as NPCIndex
DIM f as integer
OPENFILE(file, FOR_BINARY + ACCESS_READ, f)
SEEK #f, 8
CleanNPCL dat()
FOR i = 0 to 299
dat(i).x = ReadShort(f,-1) * 20
NEXT
FOR i = 0 to 299
dat(i).y = (ReadShort(f,-1) - 1) * 20
NEXT
FOR i = 0 to 299
dat(i).id = ReadShort(f,-1)
NEXT
FOR i = 0 to 299
dat(i).dir = ReadShort(f,-1)
NEXT
FOR i = 0 to 299
dat(i).wtog = ReadShort(f,-1)
NEXT
FOR i = 0 to 299
'Check NPC pool number as a precaution against corruption and future rpg files
DIM pool_id as integer = ReadShort(f,-1)
IF pool_id < 0 ORELSE pool_id > 1 THEN
debug "Invalid pool_id " & pool_id & " for NPC instance " & i & " in npc location file " & file
pool_id = 0
dat(i).id = 0 'Also clear the ID
END IF
dat(i).pool = pool_id
NEXT
CLOSE #f
END SUB
'Legacy (used for .L); not kept up to date with changes to NPCInst
SUB SaveNPCL(file as string, dat() as NPCInst)
DIM i as NPCIndex
DIM f as integer
OPENFILE(file, FOR_BINARY + ACCESS_WRITE, f) 'truncates
SEEK #f, 8
FOR i = 0 to 299
WriteShort f, -1, dat(i).x / 20
NEXT
FOR i = 0 to 299
WriteShort f, -1, dat(i).y / 20 + 1
NEXT
FOR i = 0 to 299
WriteShort f, -1, dat(i).id
NEXT
FOR i = 0 to 299
WriteShort f, -1, dat(i).dir
NEXT
FOR i = 0 to 299
WriteShort f, -1, dat(i).wtog
NEXT
FOR i = 0 to 299
WriteShort f, -1, dat(i).pool
NEXT
CLOSE #f
END SUB
'Legacy (used in .SAV); not kept up to date with changes to NPCInst
'num is always 300.
SUB DeserNPCL(npc() as NPCInst, byref z as integer, buffer() as integer, byval num as integer, byval xoffset as integer, byval yoffset as integer)
DIM i as NPCIndex
CleanNPCL npc()
FOR i = 0 to num - 1
npc(i).x = buffer(z) + xoffset: z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).y = buffer(z) + yoffset: z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).id = buffer(z): z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).dir = buffer(z): z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).wtog = buffer(z): z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).xgo = buffer(z): z = z + 1
NEXT
FOR i = 0 to num - 1
npc(i).ygo = buffer(z): z = z + 1
NEXT
END SUB
SUB CleanNPCInst(byref inst as NPCInst)
v_free inst.curzones
v_free inst.extravec
DeleteSlice @inst.sl
memset @inst, 0, sizeof(NPCInst)
END SUB
SUB CleanNPCL(dat() as NPCInst)
FOR i as integer = 0 TO UBOUND(dat)
CleanNPCInst dat(i)
NEXT
END SUB
SUB save_npc_instances(filename as string, npc() as NPCInst)
DIM doc as DocPtr
doc = CreateDocument()
DIM node as NodePtr
node = CreateNode(doc, "npcs")
SetRootNode(doc, node)
save_npc_instances node, npc()
SerializeBin filename, doc
FreeDocument doc
END SUB
SUB save_npc_instances(byval npcs_node as NodePtr, npc() as NPCInst)
IF NumChildren(npcs_node) <> 0 THEN
debug "WARNING: saving NPC instances to a Reload node that already has " & NumChildren(npcs_node) & " children!"
END IF
FOR i as NPCIndex = 0 TO UBOUND(npc)
WITH npc(i)
IF .id <> 0 THEN 'FIXME: When the "save" node is fully supported it will be main the criteria that determines if a node is written
save_npc_instance npcs_node, i, npc(i)
END IF
END WITH
NEXT i
END SUB
'map_offset does not need to be used when saving temporary npc states
SUB save_npc_instance (byval parent as NodePtr, byval index as NPCIndex, npc as NPCInst, map_offset as XYPair = XY(0,0))
DIM n as NodePtr
n = AppendChildNode(parent, "npc", index)
WITH npc
SetChildNode(n, "id", ABS(.id) - 1)
SetChildNode(n, "pool", .pool)
SetChildNode(n, "x", .x - map_offset.x * 20)
SetChildNode(n, "y", .y - map_offset.y * 20)
SetChildNode(n, "z", .z)
SetChildNode(n, "d", .dir)
SetChildNode(n, "fr", .wtog)
IF .xgo THEN SetChildNode(n, "xgo", .xgo)
IF .ygo THEN SetChildNode(n, "ygo", .ygo)
SaveExtraVector n, "extravec", .extravec
IF .ignore_walls THEN SetChildNode(n, "ignore_walls")
IF .not_obstruction THEN SetChildNode(n, "not_obstruction")
IF .suspend_use THEN SetChildNode(n, "suspend_use")
IF .suspend_ai THEN SetChildNode(n, "suspend_move")
SetChildNode(n, "edit", 0) 'FIXME: this is a placeholder. Real edits will start with 1
END WITH
END SUB
SUB load_npc_instances (filename as string, npc() as NPCInst)
DIM doc as DocPtr
doc = LoadDocument(filename, optNoDelay)
FAIL_IF(doc = NULL, "load failed") 'LoadDocument logs the real error
DIM node as NodePtr
node = DocumentRoot(doc)
load_npc_instances node, npc()
FreeDocument doc
END SUB
SUB load_npc_instances (byval npcs_node as NodePtr, npc() as NPCInst)
IF NodeName(npcs_node) <> "npcs" THEN
debug "WARNING: load_npc_instances expected a node named 'npcs' but found '" & NodeName(npcs_node) & "' instead."
END IF
FOR i as integer = 0 TO UBOUND(npc)
'--disable/hide this NPC by default
CleanNPCInst npc(i)
DIM n as NodePtr
n = NodeByPath(npcs_node, "/npc[" & i & "]")
IF n THEN
load_npc_instance n, npc(i)
END IF
NEXT i
END SUB
'map_offset does not need to be used when loading temporary npc states
SUB load_npc_instance (byval n as NodePtr, npc as NPCInst, map_offset as XYPair = XY(0,0))
IF NodeName(n) <> "npc" THEN
debug "load_npc_instance: loading npc data into a node misnamed """ & NodeName(n) & """"
END IF
IF GetChildNodeExists(n, "id") THEN
'FIXME: this would be a good place to read the edit count property
WITH npc
.id = GetChildNodeInt(n, "id") + 1
.pool = GetChildNodeInt(n, "pool")
.x = GetChildNodeInt(n, "x") + map_offset.x * 20
.y = GetChildNodeInt(n, "y") + map_offset.y * 20
.z = GetChildNodeInt(n, "z")
.dir = GetChildNodeInt(n, "d")
.wtog = GetChildNodeInt(n, "fr")
.xgo = GetChildNodeInt(n, "xgo")
.ygo = GetChildNodeInt(n, "ygo")
LoadExtraVector n."extravec".ptr, npc.extravec, "NPC instance"
.ignore_walls = GetChildNodeExists(n, "ignore_walls")
.not_obstruction = GetChildNodeExists(n, "not_obstruction")
.suspend_use = GetChildNodeExists(n, "suspend_use")
.suspend_ai = GetChildNodeExists(n, "suspend_move")
END WITH
ELSE
npc.id = 0
END IF
END SUB
'==========================================================================================
' Inventories
'==========================================================================================
SUB SerInventory8Bit(invent() as InventSlot, byref z as integer, buf() as integer)
DIM i as integer, j as integer
buf(z) = 1 'Instruct new versions of game to ignore all this junk and use the 16-bit data instead
'...but go ahead and write the 8-bit data so that loading a new SAV in an old version of game
' will not result in a nuked inventory
z += 3 ' disregard some jibba jabba
FOR i = 0 to 197 ' hard code old inventoryMax
IF invent(i).used THEN
buf(z) = (invent(i).num AND 255) shl 8 OR ((invent(i).id + 1) AND 255)
ELSE
buf(z) = 0
END IF
z += 1
NEXT
z += 2 'slots 198 and 199 not useable
z += 3 * 12
FOR i = 0 to 197 ' hard code old inventoryMax
IF invent(i).used = 0 THEN invent(i).text = SPACE(11)
'unfortunately, this isn't exactly the badbinstring format
FOR j = 0 TO 11
'actually max length is 11, last byte always wasted
IF j < LEN(invent(i).text) THEN buf(z) = invent(i).text[j] ELSE buf(z) = 0
z += 1
NEXT
NEXT
z += 2 * 12
END SUB
SUB DeserInventory8Bit(invent() as InventSlot, byref z as integer, buf() as integer)
DIM i as integer, j as integer, temp as string
z += 3
FOR i = 0 TO 197 ' hard code old inventoryMax
invent(i).num = buf(z) shr 8
invent(i).id = (buf(z) and 255) - 1
invent(i).used = invent(i).id >= 0
z += 1
NEXT
z += 2
z += 3 * 12
FOR i = 0 TO 197 ' hard code old inventoryMax
temp = ""
FOR j = 0 TO 11
IF buf(z) > 0 AND buf(z) <= 255 THEN temp = temp + CHR(buf(z))
z += 1
NEXT j
'--Don't bother actually using the stored string. it is rebuilt later with rebuild_inventory_captions()
'invent(i).text = temp
NEXT
z += 2 * 12
END SUB
SUB CleanInventory(invent() as InventSlot)
DIM i as integer
FOR i = 0 TO inventoryMax
invent(i).used = 0
invent(i).text = SPACE(11)
NEXT
END SUB
SUB SaveInventory16bit(invent() as InventSlot, byref z as integer, buf() as integer, byval first as integer=0, byval last as integer=-1)
IF last = -1 THEN last = UBOUND(invent)
DIM i as integer
FOR i = first TO small(inventoryMax, last)
WITH invent(i)
IF .used THEN
buf(z) = .id
buf(z+1) = .num
ELSE
buf(z) = -1
buf(z+1) = 0
END IF
END WITH
z += 2
NEXT i
END SUB
SUB LoadInventory16Bit(invent() as InventSlot, byref z as integer, buf() as integer, byval first as integer=0, byval last as integer=-1)
IF last = -1 THEN last = UBOUND(invent)
DIM i as integer
FOR i = first TO small(inventoryMax, last)
WITH invent(i)
.num = buf(z+1)
IF .num > 0 THEN
.used = YES
.id = buf(z)
ELSE
'empty slot
.used = NO
.id = buf(z)
.num = 0
END IF
END WITH
z += 2
NEXT i
END SUB
'==========================================================================================
' Maps
'==========================================================================================
CONSTRUCTOR MapData()
REDIM gmap(dimbinsize(binMAP))
id = -1
END CONSTRUCTOR
DESTRUCTOR MapData()
UnloadTilemaps tiles()
UnloadTilemap pass
UnloadTilemap foemap
DeleteZoneMap zmap
id = -1
END DESTRUCTOR
'Only loads what is needed in order to generate a minimap of a map
SUB MapData.load_for_minimap(map_id as integer)
id = map_id
'gmap is needed for the tilesets
loadrecord gmap(), game & ".map", getbinsize(binMAP) \ 2, id
IF gmap(31) = 0 THEN gmap(31) = 2 'Num layers below walkabouts layer
LoadTilemaps tiles(), maplumpname(id, "t")
size = tiles(0).size
LoadTilemap pass, maplumpname(id, "p")
END SUB
SUB MapData.load(map_id as integer)
load_for_minimap(map_id)
name = getmapname(id)
LoadTilemap foemap, maplumpname(id, "e")
IF isfile(maplumpname(id, "z")) THEN
LoadZoneMap zmap, maplumpname(id, "z")
ELSE
' Old games
CleanZoneMap zmap, wide, high
END IF
LoadNPCL maplumpname(id, "l"), npc()
LoadNPCD maplumpname(id, "n"), npc_def()
DeSerDoors game & ".dox", door(), id
DeSerDoorLinks maplumpname(id, "d"), doorlink()
END SUB
FUNCTION maplumpname (byval map_id as integer, oldext as string) as string
IF map_id < 0 THEN showbug "maplumpname: Bad map " & map_id
IF map_id < 100 THEN
return game & "." & oldext & RIGHT("0" & map_id, 2)
ELSE
return workingdir & SLASH & map_id & "." & oldext
END IF
END FUNCTION
FUNCTION read_map_layer_name(gmap() as integer, layernum as integer) as string
IF layernum > 15 THEN
showbug "read_map_layer_name: layernum too high"
ELSE
RETURN readbinstring(gmap(), 34 + layernum * 21, 40)
END IF
END FUNCTION
SUB write_map_layer_name(gmap() as integer, layernum as integer, newname as string)
IF layernum > 15 THEN
showbug "write_map_layer_name: layernum too high"
ELSE
writebinstring(newname, gmap(), 34 + layernum * 21, 40)
END IF
END SUB
'==========================================================================================
' Tilemaps
'==========================================================================================
SUB UnloadTilemap(map as TileMap)
DEALLOCATE map.data
map.data = NULL
END SUB
SUB UnloadTilemaps(layers() as TileMap)
FOR i as integer = 0 TO UBOUND(layers)
UnloadTilemap layers(i)
NEXT
END SUB
SUB TilemapInfo.seterr(filename as string, errmsg as string)
this.err = errmsg
debuginfo filename & ": " & errmsg
END SUB
'Get size of a tilemap file; returns false if badly formed
FUNCTION GetTilemapInfo(filename as string, info as TilemapInfo) as bool
info.err = ""
DIM as integer fh
IF OPENFILE(filename, FOR_BINARY + ACCESS_READ, fh) <> 0 THEN
info.seterr filename, "Couldn't open file"
RETURN NO
END IF
WITH info
.wide = readshort(fh, 8) 'skip over BSAVE header
.high = readshort(fh, 10)
IF in_bound(.wide, 16, 32678) = NO ORELSE in_bound(.high, 10, 32678) = NO THEN
info.seterr filename, "Bad map size " & .size.wh
CLOSE #fh
RETURN NO
END IF
.layers = (LOF(fh) - 11) \ (.wide * .high)
'Because of bug 829 (.T not truncated when map resized), and old 32000 byte tilemaps,
'tilemaps with bad lengths are common; only do a simple length check
IF .layers = 0 THEN
info.seterr filename, "Bad file length or map size; " & .size.wh & ", " & LOF(fh) & " bytes"
CLOSE #fh
RETURN NO
END IF
'.layers = small(.layers, maplayerMax + 1)
CLOSE #fh
IF .layers > maplayerMax + 1 THEN
info.seterr filename, "Too many layers: " & info.layers
RETURN NO
END IF
END WITH
RETURN YES
END FUNCTION
SUB LoadTilemap(map as TileMap, filename as string)
IF map.data THEN DEALLOCATE map.data
map.data = NULL
DIM as integer fh
OPENFILE(filename, FOR_BINARY + ACCESS_READ, fh)
map.wide = bound(readshort(fh, 8), 16, 32678)
map.high = bound(readshort(fh, 10), 10, 32678)
map.layernum = 0
IF map.wide * map.high + 11 <> LOF(fh) THEN
'PROBLEM: early versions always saved 32000 bytes of tile data (ie, 32011 total)!
'Because of bug 829 (.T not truncated when map resized), tilemaps with bad lengths are common; better not to spam this message
'debug "tilemap " & filename & " (" & map.wide & "x" & map.high & ") bad length or size; " & LOF(fh) & " bytes"
'show the user their garbled mess, always interesting
END IF
map.data = ALLOCATE(map.wide * map.high)
GET #fh, 12, *map.data, map.wide * map.high
CLOSE #fh
END SUB
'When allowfail is true, returns false if the data looks dubious instead of loading
'FIXME: early versions always saved 32000 bytes of tile data (ie, 32011 total)!
'This will cause extra spurious map layers to be loaded!
FUNCTION LoadTilemaps(layers() as TileMap, filename as string, allowfail as bool = NO) as bool
DIM as integer fh, numlayers, i, wide, high
UnloadTilemaps layers()
IF OPENFILE(filename, FOR_BINARY + ACCESS_READ, fh) THEN
IF allowfail = NO THEN showerror "Couldn't open tilemaps file " & filename
RETURN NO
END IF
DIM as integer tempw = readshort(fh, 8)
DIM as integer temph = readshort(fh, 10)
wide = bound(tempw, 16, 32678)
high = bound(temph, 10, 32678)
IF allowfail ANDALSO (tempw <> wide OR temph <> high) THEN RETURN NO
numlayers = (LOF(fh) - 11) \ (wide * high)
IF numlayers > maplayerMax + 1 OR numlayers * wide * high + 11 <> LOF(fh) OR numlayers < 1 THEN
'Because of bug 829 (.T not truncated when map resized), tilemaps with bad lengths are common; better not to spam this message
'debug "tilemap " & filename & " (" & wide & "x" & high & ") bad length or size; " & LOF(fh) & " bytes"
IF allowfail THEN RETURN NO
'show the user their garbled mess, always interesting
numlayers = bound(numlayers, 1, maplayerMax + 1)
END IF
REDIM layers(numlayers - 1)
SEEK fh, 12
FOR i = 0 TO numlayers - 1
WITH layers(i)
.data = ALLOCATE(wide * high)
.wide = wide
.high = high
.layernum = i
GET #fh, , *.data, wide * high
END WITH
NEXT
CLOSE #fh
RETURN YES
END FUNCTION
SUB SaveTilemap(tmap as TileMap, filename as string)
DIM fh as integer
OPENFILE(filename, FOR_BINARY + ACCESS_WRITE, fh) 'Truncate to zero
writeshort fh, 8, tmap.wide
writeshort fh, 10, tmap.high
PUT #fh, 12, *tmap.data, tmap.wide * tmap.high
CLOSE #fh
END SUB
SUB SaveTilemaps(tmaps() as TileMap, filename as string)
DIM fh as integer
OPENFILE(filename, FOR_BINARY + ACCESS_WRITE, fh) 'Truncate to zero
writeshort fh, 8, tmaps(0).wide
writeshort fh, 10, tmaps(0).high
SEEK #fh, 12
FOR i as integer = 0 TO UBOUND(tmaps)
PUT #fh, , *tmaps(i).data, tmaps(i).wide * tmaps(i).high
NEXT
CLOSE #fh
END SUB
SUB CleanTilemap(map as TileMap, byval wide as integer, byval high as integer, byval layernum as integer = 0)
'two purposes: allocate a new tilemap, or blank an existing one
UnloadTilemap(map)
map.wide = wide
map.high = high
map.data = CALLOCATE(wide * high)
map.layernum = layernum
END SUB
SUB CleanTilemaps(layers() as TileMap, byval wide as integer, byval high as integer, byval numlayers as integer)
'two purposes: allocate a new tilemap, or blank an existing one
UnloadTilemaps layers()
REDIM layers(numlayers - 1)
FOR i as integer = 0 TO numlayers - 1
WITH layers(i)
.wide = wide
.high = high
.data = CALLOCATE(wide * high)
.layernum = i
END WITH
NEXT
END SUB
SUB CopyTilemap(dest as TileMap, src as TileMap)
'Copies the tiles from one TileMap to another, but not the layer number
WITH dest
.wide = src.wide
.high = src.high
.data = REALLOCATE(.data, .wide * .high)
memcpy(.data, src.data, sizeof(.data[0]) * .wide * .high)
END WITH
END SUB
LOCAL SUB MergeTileMapData(mine as TileMap, theirs as TileMap, tmbase as TileMap)
FOR i as integer = 0 TO mine.wide * mine.high - 1
IF theirs.data[i] <> tmbase.data[i] THEN
mine.data[i] = theirs.data[i]
END IF
NEXT
END SUB
SUB MergeTileMap(mine as TileMap, theirs_file as string, base_file as string)
'Do a three-way merge of changes to a TileMap
DIM as TileMap tmbase, theirs
LoadTileMap tmbase, base_file
LoadTileMap theirs, theirs_file
IF theirs.wide <> mine.wide OR theirs.high <> mine.high OR _
theirs.wide <> tmbase.wide OR theirs.high <> tmbase.high THEN
'We we could actually continue...
debug "MergeTilemap: nonmatching map sizes!"
UnloadTilemap tmbase
UnloadTilemap theirs
EXIT SUB
END IF
MergeTileMapData mine, theirs, tmbase
UnloadTilemap tmbase
UnloadTilemap theirs
END SUB
SUB MergeTileMaps(mine() as TileMap, theirs_file as string, base_file as string)
'Do a three-way merge of changes to an array of TileMap
REDIM as TileMap tmbase(0), theirs(0)
LoadTileMaps tmbase(), base_file
LoadTileMaps theirs(), theirs_file
IF theirs(0).wide <> mine(0).wide OR theirs(0).high <> mine(0).high OR _
theirs(0).wide <> tmbase(0).wide OR theirs(0).high <> tmbase(0).high OR _
UBOUND(theirs) <> UBOUND(mine) THEN
'We we could actually continue...
debug "MergeTilemap: nonmatching map sizes/num layers!"
UnloadTilemaps tmbase()
UnloadTilemaps theirs()
EXIT SUB
END IF
FOR i as integer = 0 TO UBOUND(mine)
MergeTileMapData mine(i), theirs(i), tmbase(i)
NEXT
UnloadTilemaps tmbase()
UnloadTilemaps theirs()
END SUB
'==========================================================================================
' Zone maps
'==========================================================================================
'Implementation:
'In .bitmap (which is an array of [high][wide] ushorts) each tile has a ushort (array of 16
'bits) and an associated 'IDmap', an array of 15 distinct or zero (empty) zone ids (stored
'as an array of 16 ushorts, the 16th is unused). The lower 15 bits indicate whether the tile
'is in each of the zones given in the IDmap (if a bit is set, then that entry in the IDmap
'will be nonzero). The 16th bit tells where to get the IDmap. If 0 (the default), it is the
'IDmap for the tile's segment in .zoneIDmap:
' The map is split into 4x4 "segments", and each gets an IDmap in .zoneIDmap, which is a
' pointer to a ushort array of dimension [high_segments][wide_segments][16].
' Segments along the right and bottom map edges may be less than 4x4.
'If 1, the tile is "crowded" because weren't enough empty "slots" in the default IDmap, so
'the tile gets its own IDmap, which is retrieved by indexing .extraID_hash with key
'(x SHL 16) + y. Private IDmaps contain exactly those zone IDs which that tile is in.
'
'Zone IDs within each IDmap are completely unordered, but the unused slots (value 0)
'must be sorted to the end. This allows early-exiting rather than iterating over all 15 slots.
'In order to allow preserving this invariant easily, ID 65535 (DELETED) can be also used to
'mark unused slots; these markers are not sorted to the end.
'
'There's therefore a limit of 15 zones per tile, which could be overcome by replacing
'extra IDmaps with arbitrary length lists of zone IDs, but that's a lot of added complexity
'(and things are complex enough already, aren't they?)
'And the limit on number of zones is really 65534, not 9999; that's just a rounder number.
'Maybe we'll find some use for an extra couple bits per ID?
CONST DELETED = 65535
DESTRUCTOR ZoneInfo()
v_free extravec
END DESTRUCTOR
'Used both to blank out an existing ZoneMap, or initialise it from zeroed-out memory
SUB CleanZoneMap(zmap as ZoneMap, byval wide as integer, byval high as integer)
WITH zmap
IF .bitmap THEN DeleteZoneMap(zmap)
.wide = wide
.high = high
.numzones = 0
.zones = NULL
.bitmap = CALLOCATE(2 * wide * high)
.wide_segments = (wide + 3) \ 4
.high_segments = (high + 3) \ 4
.zoneIDmap = CALLOCATE(2 * 16 * .wide_segments * .high_segments)
.extraID_hash.construct(64)
.extraID_hash.value_delete = @DEALLOCATE
END WITH
END SUB
'ZoneMaps must be destructed
SUB DeleteZoneMap(zmap as ZoneMap)
WITH zmap
FOR i as integer = 0 TO .numzones - 1
(@.zones[i])->Destructor()
NEXT
.numzones = 0
DEALLOCATE(.zones)
.zones = NULL
.extraID_hash.destruct()
DEALLOCATE(.bitmap)
.bitmap = NULL
DEALLOCATE(.zoneIDmap)
.zoneIDmap = NULL
END WITH
END SUB
'Fills zones() with the IDs of all the zones which this tile is a part of.
'zones() should be a dynamic array, it's filled with unsorted ID numbers in zones(0) onwards
'zones() is REDIMed to start at -1, for fake zero-length arrays.
'maxid must be less than 65535 (DELETED)
SUB GetZonesAtTile(zmap as ZoneMap, zones() as integer, x as integer, y as integer, maxid as integer = 65534)
WITH zmap
IF x < 0 ORELSE x >= .wide ORELSE y < 0 ORELSE y >= .high THEN
REDIM zones(-1 TO -1)
EXIT SUB
END IF
DIM bitvector as ushort = .bitmap[x + y * .wide]
DIM IDmap as ushort ptr = @.zoneIDmap[(x \ 4 + (y \ 4) * .wide_segments) * 16]
IF bitvector AND (1 SHL 15) THEN
'This 4x4 segment is overcrowded, fall back to looking up the tile
IDmap = .extraID_hash.get((x SHL 16) OR y)
END IF
REDIM zones(-1 TO 15)
DIM nextindex as integer = 0
FOR slot as integer = 0 TO 14
IF bitvector AND (1 SHL slot) THEN
IF IDmap[slot] <= maxid THEN
zones(nextindex) = IDmap[slot]
nextindex += 1
END IF
END IF
NEXT
REDIM PRESERVE zones(-1 TO nextindex - 1)
END WITH
END SUB
'Returns zones at a tile, in a sorted vector
FUNCTION GetZonesAtTile(zmap as ZoneMap, x as integer, y as integer, maxid as integer = 65534) as integer vector
REDIM tmparray() as integer
GetZonesAtTile zmap, tmparray(), x, y, maxid
DIM zonesvec as integer vector
array_to_vector zonesvec, tmparray()
v_sort zonesvec
RETURN v_ret(zonesvec)
END FUNCTION
'Is a tile in a zone? Returns a bool, not 0/1!
FUNCTION CheckZoneAtTile(zmap as ZoneMap, id as integer, x as integer, y as integer) as bool
'Could call CheckZoneAtTile, but this is more efficient
WITH zmap
IF x < 0 ORELSE x >= .wide ORELSE y < 0 ORELSE y >= .high THEN RETURN NO
DIM bitvector as ushort = .bitmap[x + y * .wide]
DIM IDmap as ushort ptr = @.zoneIDmap[(x \ 4 + (y \ 4) * .wide_segments) * 16]
IF bitvector AND (1 SHL 15) THEN
'This 4x4 segment is overcrowded, fall back to looking up the tile
IDmap = .extraID_hash.get((x SHL 16) OR y)
END IF
FOR slot as integer = 0 TO 14
IF IDmap[slot] = id THEN
RETURN iif(bitvector AND (1 SHL slot), YES, NO)
ELSEIF IDmap[slot] = 0 THEN
RETURN NO
END IF
NEXT
END WITH
RETURN NO
END FUNCTION
'Print ZoneMap debug info, including data about a specific tile if specified
SUB DebugZoneMap(zmap as ZoneMap, byval x as integer = -1, byval y as integer = -1)
WITH zmap
DIM memusage as integer
memusage = .wide * .high * 2 + .wide_segments * .high_segments * 32 + .extraID_hash.numitems * SIZEOF(ZoneHashedSegment) + .extraID_hash.tablesize * SIZEOF(any ptr)
debug "ZoneMap dump: " & .size.wh & ", " & .numzones & " zones, " & .extraID_hash.numitems & " crowded tiles, " & memusage & "B memory used"
IF x <> -1 AND y <> -1 THEN
DIM bitvector as ushort = .bitmap[x + y * .wide]
debug " tile " & XY(x,y) & ": " & BIN(bitvector)
DIM IDmap as ushort ptr = @.zoneIDmap[(x \ 4 + (y \ 4) * .wide_segments) * 16]
IF bitvector AND (1 SHL 15) THEN
'This 4x4 segment is overcrowded, fall back to looking up the tile
IDmap = .extraID_hash.get((x SHL 16) OR y)
debug " (crowded tile)"
END IF
DIM temp as string
FOR i as integer = 0 TO 14
temp &= " " & i & ":" & IDmap[i]
NEXT
debug temp
END IF
END WITH
END SUB
LOCAL FUNCTION ZoneMapAddZoneInfo(zmap as ZoneMap) as ZoneInfo ptr
'ZoneInfo contains a FB string, so have to use this function to properly zero out new records
DIM info as ZoneInfo ptr
WITH zmap
.numzones += 1
.zones = REALLOCATE(.zones, SIZEOF(ZoneInfo) * .numzones)
info = @.zones[.numzones - 1]
'memset(info, 0, SIZEOF(ZoneInfo))
info = NEW (info) ZoneInfo 'placement new, proof that FB is actually a wrapper around C++
END WITH
RETURN info
END FUNCTION
'Return ptr to the ZoneInfo for a certain zone, creating it if it doesn't yet exist.
'(It doesn't matter if we create a lot of extra ZoneInfo's, they won't be saved)
FUNCTION GetZoneInfo(zmap as ZoneMap, byval id as integer) as ZoneInfo ptr
WITH zmap
FOR i as integer = 0 TO .numzones - 1
IF .zones[i].id = id THEN RETURN @.zones[i]
NEXT
DIM info as ZoneInfo ptr = ZoneMapAddZoneInfo(zmap)
info->id = id
RETURN info
END WITH
END FUNCTION
LOCAL SUB ZoneInfoBookkeeping(zmap as ZoneMap, byval id as integer, byval delta as integer = 0)
DIM info as ZoneInfo ptr
info = GetZoneInfo(zmap, id)
info->numtiles += delta
END SUB
LOCAL FUNCTION ZoneMapAddExtraSegment(zmap as ZoneMap, byval x as integer, byval y as integer) as ZoneHashedSegment ptr
DIM tiledescriptor as ZoneHashedSegment ptr = CALLOCATE(SIZEOF(ZoneHashedSegment))
zmap.extraID_hash.add((x SHL 16) OR y, tiledescriptor)
RETURN tiledescriptor
END FUNCTION
'Add tile to zone.
'Returns success, or NO if there are already too many overlapping zones there
FUNCTION SetZoneTile(zmap as ZoneMap, byval id as integer, byval x as integer, byval y as integer) as bool
WITH zmap
IF x < 0 ORELSE x >= .wide ORELSE y < 0 ORELSE y >= .high THEN RETURN NO
IF CheckZoneAtTile(zmap, id, x, y) THEN RETURN YES
ZoneInfoBookkeeping zmap, id, 1
DIM bitvector as ushort ptr = @.bitmap[x + y * .wide]
DIM IDmap as ushort ptr = @.zoneIDmap[(x \ 4 + (y \ 4) * .wide_segments) * 16]
IF *bitvector AND (1 SHL 15) THEN
'This 4x4 segment is overcrowded, fall back to looking up the tile
IDmap = .extraID_hash.get((x SHL 16) OR y)
END IF
IF (*bitvector AND &h7fff) = &h7fff THEN debug "SetZoneTile: tile too full": RETURN NO
tryagain:
'Now add the zone ID to IDmap.
'If it's already set, stop. When we reach an empty slot we know we've checked them all, so stop
DIM deletedslot as integer = -1
FOR i as integer = 0 TO 14
IF IDmap[i] = id THEN
*bitvector OR= 1 SHL i
RETURN YES
ELSEIF IDmap[i] = 0 THEN
*bitvector OR= 1 SHL i
IDmap[i] = id
RETURN YES
ELSEIF IDmap[i] = DELETED THEN
deletedslot = i
END IF
NEXT
'Only once we've checked all slots to make sure it's not already in IDmap can we overwrite
'a DELETED slot.
IF deletedslot > -1 THEN
*bitvector OR= 1 SHL deletedslot
IDmap[deletedslot] = id
RETURN YES
END IF
'debug "SetZoneTile: IDmap full"
'Segment ID array is full, add a new ID array
DIM oldbitvector as integer = *bitvector
*bitvector = 1 SHL 15 ' Set crowded bit, erase others
DIM IDmapnew as ushort ptr = cast(ushort ptr, ZoneMapAddExtraSegment(zmap, x, y))
DIM newidx as integer = 0
FOR i as integer = 0 TO 14
IF oldbitvector AND (1 SHL i) THEN
' Shuffle the used IDs to the front of IDmapnew
IDmapnew[newidx] = IDmap[i]
newidx += 1
END IF
NEXT
*bitvector OR= (1 SHL newidx) - 1 'Set all bits up to newidx
IDmap = IDmapnew
'This GOTO will be reached at most once
GOTO tryagain
END WITH
END FUNCTION
'Remove tile from zone.
SUB UnsetZoneTile(zmap as ZoneMap, byval id as integer, byval x as integer, byval y as integer)
WITH zmap
IF x < 0 ORELSE x >= .wide ORELSE y < 0 ORELSE y >= .high THEN EXIT SUB
DIM bitvector as ushort ptr = @.bitmap[x + y * .wide]
DIM IDmap as ushort ptr = @.zoneIDmap[(x \ 4 + (y \ 4) * .wide_segments) * 16]
IF *bitvector AND (1 SHL 15) THEN
'This 4x4 segment is overcrowded, fall back to looking up the tile
IDmap = .extraID_hash.get((x SHL 16) OR y)
END IF
DIM slot as integer = -1
FOR i as integer = 0 TO 14
IF IDmap[i] = id THEN
slot = i
EXIT FOR
END IF
NEXT
IF slot = -1 ORELSE (*bitvector AND (1 SHL slot)) = 0 THEN EXIT SUB 'This tile is not even part of this zone!
ZoneInfoBookkeeping zmap, id, -1
DIM usecount as integer = 0
IF *bitvector AND (1 SHL 15) THEN
'overcrowded tiles recieve their own ID maps
'FIXME: there's no way for an overcrowded tile to revert to nonovercrowded
usecount = 1
ELSE
FOR x2 as integer = (x AND NOT 3) TO small(x OR 3, .wide - 1)
FOR y2 as integer = (y AND NOT 3) TO small(y OR 3, .high - 1)
IF .bitmap[x2 + y2 * .wide] AND (1 SHL slot) THEN usecount += 1
NEXT
NEXT
END IF
IF usecount = 1 THEN
' Last use of this ID, so remove IDmap[slot].
IDmap[slot] = DELETED
' To mark it with ID 0 rather than DELETED we would have to keep the empty slots
' sorted to the end; the following is an incomplete attempt to do so, because it
' doesn't update the bitmaps for the tiles in the block which use IDmap[i].
/'
FOR i as integer = 14 TO 0 STEP -1
IF IDmap[i] <> 0 THEN
IDmap[slot] = IDmap[i]
IDmap[i] = 0
slot = i
EXIT FOR
END IF
NEXT
'/
END IF
*bitvector -= 1 SHL slot
END WITH
END SUB
' Writes the value (0 or nonzero) of a zone on a tile. Returns whether succeeded;
' fails if more than 15 zones set
FUNCTION WriteZoneTile(zmap as ZoneMap, id as integer, x as integer, y as integer, value as integer) as bool
IF value THEN RETURN SetZoneTile(zmap, id, x, y)
UnsetZoneTile(zmap, id, x, y)
RETURN YES
END FUNCTION
LOCAL FUNCTION ZoneBitmaskFromIDMap(byval IDmap as ushort ptr, byval id as integer) as uinteger
FOR i as integer = 0 TO 14
IF IDmap[i] = id THEN RETURN 1 SHL i
NEXT
RETURN 0
END FUNCTION
'Sets a certain bit in each tile to 1 or 0 depending on whether that tile is in a certain zone
SUB ZoneToTileMap(zmap as ZoneMap, tmap as TileMap, byval id as integer, byval bitnum as integer)
'static accum as double=0.0, samples as integer = 0
'DIM t as double = timer
WITH zmap
IF tmap.data = NULL THEN CleanTilemap tmap, .wide, .high
DIM as integer segmentx, segmenty, x, y, bitmask, tilemask
tilemask = 1 SHL bitnum
FOR segmenty = 0 TO .high_segments - 1
FOR segmentx = 0 TO .wide_segments - 1
bitmask = ZoneBitmaskFromIDMap(@.zoneIDmap[(segmentx + segmenty * .wide_segments) * 16], id)
FOR y = segmenty * 4 TO small(.high, segmenty * 4 + 4) - 1
DIM bitvectors as ushort ptr = @.bitmap[y * .wide]
DIM tileptr as ubyte ptr = @tmap.data[y * .wide]
FOR x = segmentx * 4 TO small(.wide, segmentx * 4 + 4) - 1
IF bitvectors[x] AND (1 SHL 15) THEN
DIM IDmap as ushort ptr = .extraID_hash.get((x SHL 16) OR y)
IF bitvectors[x] AND ZoneBitmaskFromIDMap(IDmap, id) THEN
tileptr[x] OR= (1 SHL bitnum)
ELSE
tileptr[x] AND= NOT (1 SHL bitnum)
END IF
ELSE
IF bitvectors[x] AND bitmask THEN
tileptr[x] OR= (1 SHL bitnum)
ELSE
tileptr[x] AND= NOT (1 SHL bitnum)
END IF
END IF
NEXT
NEXT
NEXT
NEXT
END WITH
'accum += (timer - t)
'samples += 1
'debug "ZoneToTileMap in " & (timer - t) * 1000 & "ms, average=" & (accum * 1000 / samples)
END SUB
'Append a span to spanbuf, increment spanoff
LOCAL SUB AppendSpan(spanbuf as ubyte ptr, byref spanoff as integer, spanlen as integer)
WHILE spanlen >= 256
'span too long, overflows a ubyte, break in two
spanbuf[spanoff] = 255
spanbuf[spanoff + 1] = 0
spanoff += 2
spanlen -= 255
WEND
spanbuf[spanoff] = spanlen
spanoff += 1
END SUB
'Adds 'rows' node to a .Z## root RELOAD node describing the tile data.
'rect.x/y give an offset, and rect.w/h a size to trim to; used for resizing a map.
LOCAL SUB SerializeZoneTiles(zmap as ZoneMap, byval root as NodePtr, rect as RectType)
'DIM t as double = TIMER
DIM as NodePtr rowsnode, rownode, idnode, spannode
rowsnode = AppendChildNode(root, "rows")
DIM as integer x, xstart, y, i, id, spanlen, spanoff
DIM as ubyte ptr spanbuf
WITH zmap
spanbuf = ALLOCATE(sizeof(ubyte) * (.wide + 4))
FOR y = 0 TO .high - 1
IF y < rect.y OR y >= rect.y + rect.high THEN CONTINUE FOR
rownode = AppendChildNode(rowsnode, "y", y - rect.y)
REDIM seen_this_line(0) as integer
REDIM zoneshere() as integer
FOR xstart = large(0, rect.x) TO small(.wide - 1, rect.x + rect.wide - 1)
'Go along each row, looking for new zones that we haven't seen yet this row
GetZonesAtTile zmap, zoneshere(), xstart, y
FOR i = 0 TO UBOUND(zoneshere)
id = zoneshere(i)
IF a_find(seen_this_line(), id) <> -1 THEN CONTINUE FOR
a_append seen_this_line(), id
DIM spantype as bool = NO 'Start as a span of 0's
spanoff = 0
spanlen = large(xstart - rect.x, 0)
FOR x = large(xstart, rect.x) TO small(.wide - 1, rect.x + rect.wide - 1)
IF CheckZoneAtTile(zmap, id, x, y) = spantype THEN
spanlen += 1
ELSE
spantype = spantype XOR YES
AppendSpan(spanbuf, spanoff, spanlen)
spanlen = 1
END IF
NEXT
'Write last span, but we can skip a span of 0's
IF spanlen <> 0 ANDALSO spantype THEN
AppendSpan(spanbuf, spanoff, spanlen)
END IF
'Write it out
idnode = AppendChildNode(rownode, "zone", id)
spannode = AppendChildNode(idnode, "spans")
SetContent(spannode, cast(zstring ptr, spanbuf), spanoff)
NEXT
NEXT
NEXT
END WITH
DEALLOCATE(spanbuf)
'debug "SerializeZoneTiles in " & (timer - t) * 1000 & "ms"
END SUB
'Set zone tiles according to a .Z document ('rows' node)
LOCAL SUB DeserializeZoneTiles(zmap as ZoneMap, byval root as NodePtr)
DIM as NodePtr rowsnode, rownode, idnode
DIM seterror as bool
rowsnode = GetChildByName(root, "rows")
IF rowsnode = NULL THEN
debug "DeserializeZoneTiles: No 'rows' node!"
EXIT SUB
END IF
rownode = FirstChild(rowsnode)
WHILE rownode
IF NodeName(rownode) = "y" THEN
DIM as integer id, y, x, i, j
y = GetInteger(rownode)
idnode = FirstChild(rownode)
WHILE idnode
IF NodeName(idnode) = "zone" THEN
id = GetInteger(idnode)
IF id <= 0 THEN
debug "DeserializeZoneTiles: bad zone id " & id
ELSE
'Everything else is RELOAD parsing, here's the actual spans decoding (see lump documentation)
'spans gives the length of alternating sequence of 0's or 1's, starting with 0's
DIM spans as string = GetChildNodeStr(idnode, "spans")
x = 0
'Note that we only process an even number of spans; if there's an odd number then
'the last span is a span of 0's so can be ignored.
FOR i = 0 TO (LEN(spans) \ 2) * 2 - 1 STEP 2
x += spans[i]
FOR j = 0 TO spans[i + 1] - 1
IF SetZoneTile(zmap, id, x + j, y) = 0 THEN
debug strprintf("DeserializeZoneTiles: Couldn't set zone %d at %d,%d", id, x + j, y)
seterror = YES
END IF
NEXT
x += spans[i + 1]
NEXT
END IF
END IF
idnode = NextSibling(idnode)
WEND
END IF
rownode = NextSibling(rownode)
WEND
IF seterror THEN notification "Zone data seems corrupt, there was an error loading it (see error log with Ctrl-F8)"
END SUB
'rsrect: resize/shift the zonemap to this size as it's saved. rect.x/y is the offset.
SUB SaveZoneMap(zmap as ZoneMap, filename as string, rsrect as RectType ptr = NULL)
'DIM as double t = TIMER
DIM doc as DocPtr
DIM as NodePtr root, zonesnode, node, subnode
doc = CreateDocument()
root = CreateNode(doc, "zonemap")
SetRootNode doc, root
WITH zmap
AppendChildNode root, "w", iif(rsrect, rsrect->wide, .wide)
AppendChildNode root, "h", iif(rsrect, rsrect->high, .high)
zonesnode = AppendChildNode(root, "zones")
FOR i as integer = 0 TO .numzones - 1
WITH .zones[i]
node = AppendChildNode(zonesnode, "zone", .id)
'Note that the the node will be pruned unless it has children, so we should only
'add children when there's non-default data.
IF .numtiles = 0 THEN MarkProvisional(node)
IF .name <> "" THEN AppendChildNode(node, "name", .name)
IF .extravec THEN SaveExtraVector node, "extravec", .extravec
END WITH
NEXT
'Add 'rows' node
DIM as RectType rect = Type(0, 0, .wide, .high)
IF rsrect THEN rect = *rsrect
SerializeZoneTiles zmap, root, rect
SerializeBin filename, doc
FreeDocument doc
END WITH
'debug "SaveZoneMap " & trimpath(filename) & " in " & (TIMER - t) * 1000 & "ms, " & zmap.numzones & " zones"
END SUB
SUB LoadZoneMap(zmap as ZoneMap, filename as string)
'DIM as double t = TIMER
DIM as DocPtr doc
DIM as NodePtr root, zonesnode, node
DIM as integer w, h
doc = LoadDocument(filename, optNoDelay)
IF doc = NULL THEN EXIT SUB
root = DocumentRoot(doc)
IF NodeName(root) <> "zonemap" THEN
debug filename & " does not appear to be a zonemap: root is named " & NodeName(root)
FreeDocument doc
EXIT SUB
END IF
w = GetChildNodeInt(root, "w")
h = GetChildNodeInt(root, "h")
IF w <= 0 OR h <= 0 THEN
debug "LoadZoneMap: " & filename & " - bad size " & XY(w,h).wh
FreeDocument doc
EXIT SUB
END IF
zonesnode = GetChildByName(root, "zones")
IF zonesnode = 0 THEN
debug "LoadZoneMap: 'zones' missing"
FreeDocument doc
EXIT SUB
END IF
CleanZoneMap zmap, w, h
WITH zmap
.numzones = 0
node = FirstChild(zonesnode)
WHILE node
IF NodeName(node) = "zone" THEN
DIM info as ZoneInfo ptr = ZoneMapAddZoneInfo(zmap)
WITH *info
.id = GetInteger(node)
IF .id <= 0 THEN
debug "LoadZoneMap: " & filename & " - bad zone id"
FreeDocument doc
EXIT SUB
END IF
.name = GetChildNodeStr(node, "name")
'--extra data
DIM extra_node as NodePtr = node."extravec".ptr
IF extra_node THEN
LoadExtraVector extra_node, .extravec, filename
ELSE
'Obsolete format for saving extra data 0-2, which used SetKeyValueNode
'for non-zero extra data.
LoadExtraKeyValueNodes node, .extravec, filename
END IF
END WITH
END IF
node = NextSibling(node)
WEND
DeserializeZoneTiles zmap, root
'debug "LoadZoneMap " & trimpath(filename) & " in " & (TIMER - t) * 1000 & "ms, " & .numzones & " zones"
END WITH
FreeDocument doc
END SUB
'==========================================================================================
' Doors & Doorlinks
'==========================================================================================
'Read a .D## doorlink lump
SUB DeserDoorLinks(filename as string, array() as doorlink)
dim as integer hasheader = -1, f, i
'when we strip the header, we can check for its presence here
if not fileisreadable(filename) then
debug "couldn't load " & filename
exit sub
end if
openfile(filename, for_binary + access_read, f)
if hasheader then
dim stupid(6) as ubyte
get #f,, stupid()
end if
for i = 0 to 199
array(i).source = ReadShort(f)
next
for i = 0 to 199
array(i).dest = ReadShort(f)
next
for i = 0 to 199
array(i).dest_map = ReadShort(f)
next
for i = 0 to 199
array(i).tag1 = ReadShort(f)
next
for i = 0 to 199
array(i).tag2 = ReadShort(f)
next
close #f
End SUB
'Write a .D## doorlink lump
Sub SerDoorLinks(filename as string, array() as doorlink, byval withhead as bool = YES)
dim as integer f, i
if openfile(filename, for_output, f) <> fberrOK then 'truncates
showerror "Couldn't save " & filename
exit sub
end if
if withhead then
dim stupid as ubyte = 253
put #f, , stupid
writeshort f, -1, -26215 '&h9999, signed
writeshort f, -1, 0
writeshort f, -1, 2000
end if
for i = 0 to 199
WriteShort f, -1, array(i).source
next
for i = 0 to 199
WriteShort f, -1, array(i).dest
next
for i = 0 to 199
WriteShort f, -1, array(i).dest_map
next
for i = 0 to 199
WriteShort f, -1, array(i).tag1
next
for i = 0 to 199
WriteShort f, -1, array(i).tag2
next
close #f
end sub
sub CleanDoorLinks(array() as doorlink)
dim i as integer
for i = lbound(array) to ubound(array)
array(i).source = -1
array(i).dest = 0
array(i).dest_map = 0
array(i).tag1 = 0
array(i).tag2 = 0
next
end sub
'Read a single door from a .DOX lump
Function read_one_door(byref thisdoor as door, byval map_id as integer, byval door_id as integer) as bool
'Returns NO if unable to read the file.
'Still succeeds for doors that don't happen to be defined. (undefined doors can be identified by checking the .bits())
if door_id < 0 or door_id > MaxDoorsPerMap then return NO
if map_id < 0 or map_id > gen(genMaxMap) then return NO
dim as integer f
if openfile(game & ".dox", for_binary + access_read, f) <> fberrOK then
return NO
end if
'Get the offset of the beginning of the desired map
dim recstart as integer = 1 + map_id * 600
'Get the size of a section of the same type of data
dim sectionbytes as integer = (MaxDoorsPerMap + 1) * 2
seek #f, recstart + door_id * 2
thisdoor.pos.x = readshort(f)
seek #f, recstart + sectionbytes + door_id * 2
'Amusingly DOX contains y + 1 instead of y
thisdoor.pos.y = readshort(f) - 1
seek #f, recstart + sectionbytes * 2 + door_id * 2
dim doorbits as ushort = readshort(f)
thisdoor.exists = (doorbits AND 1) <> 0
close #f
return YES
End function
'Read a .DOX door lump
Sub DeSerDoors(filename as string, array() as door, byval record as integer)
dim as integer f, i
if openfile(filename, for_binary + access_read, f) <> fberrOK then
exit sub
end if
'Jump to the beginning of the desired map
seek #f, record * 600 + 1
for i = 0 to maxDoorsPerMap
array(i).pos.x = readshort(f)
next
for i = 0 to maxDoorsPerMap
array(i).pos.y = readshort(f) - 1
next
static showederror as bool
for i = 0 to maxDoorsPerMap
dim doorbits as ushort = readshort(f)
if doorbits > 1 andalso showederror = NO then
showerror "A door has unknown bits " & doorbits & ". Game data is corrupt or unsupported"
showederror = YES
end if
array(i).exists = (doorbits AND 1) = 1
next
close #f
End Sub
'Write a .DOX door lump
Sub SerDoors(filename as string, array() as door, byval record as integer)
dim as integer f, i
if openfile(filename, for_binary + access_read_write, f) <> fberrOK then
showerror "Couldn't save " & filename
exit sub
end if
seek #f, record * 600 + 1
for i = 0 to maxDoorsPerMap
writeshort f, -1, array(i).pos.x
next
for i = 0 to maxDoorsPerMap
writeshort f, -1, array(i).pos.y + 1
next
for i = 0 to maxDoorsPerMap
dim doorbits as ushort
if array(i).exists then doorbits += 1
writeshort f, -1, doorbits
next
close #f
End Sub
Sub CleanDoors(array() as door)
dim i as integer
for i = lbound(array) to ubound(array)
array(i).pos.x = 0
array(i).pos.y = 0
array(i).exists = NO
next
end sub
'==========================================================================================
' Heroes
'==========================================================================================
'loads a standard block of stats from a file handle.
Sub LoadStats(byval fh as integer, sta as Stats ptr)
if sta = 0 then exit sub
with *sta
for i as integer = 0 to 11
.sta(i) = readShort(fh)
next i
end with
end sub
'saves a stat block to a file handle
Sub SaveStats(byval fh as integer, sta as Stats ptr)
if sta = 0 then exit sub
with *sta
for i as integer = 0 to 11
writeShort(fh, -1, .sta(i))
next i
end with
end sub
'this differs from the above because it loads two interleaved blocks of stats,
'such as those found in the hero definitions.
Sub LoadStats2(byval fh as integer, lev0 as Stats ptr, levMax as Stats ptr)
if lev0 = 0 or levMax = 0 then exit sub
for i as integer = 0 to 11
lev0->sta(i) = readShort(fh)
levMax->sta(i) = readShort(fh)
next i
end sub
'save interleaved stat blocks
Sub SaveStats2(byval fh as integer, lev0 as Stats ptr, levMax as Stats ptr)
if lev0 = 0 or levMax = 0 then exit sub
for i as integer = 0 to 11
writeShort(fh,-1,lev0->sta(i))
writeShort(fh,-1,levMax->sta(i))
next i
end sub
Sub load_hero_from_old_dt0(filename as string, hero as HeroDef, byval record as integer)
'WARNING: this is the loader for the old-style binary hero data lump. See loadherodata
dim as integer f, i, j
'We rely on ClearHeroData to set correct defaults for everything,
'because dt0 does not contain all hero data!
ClearHeroData hero, record
if record < 0 or record > gen(genMaxHero) then debug "load_hero_from_old_dt0: out of bounds record " & record : exit sub
'Currently .dt0 always exists, but in future we might delete it
if openfile(filename, for_binary + access_read, f) then exit sub
dim recordsize as integer = getbinsize(binDT0) 'in BYTES
seek #f, record * recordsize + 1
with hero
.name = readvstr(f, 16)
.sprite = readshort(f)
.sprite_pal = readshort(f)
.walk_sprite = readshort(f)
.walk_sprite_pal = readshort(f)
.def_level = readshort(f)
.def_weapon = readshort(f)
LoadStats2(f, @.Lev0, @.LevMax)
'get #f,, .spell_lists()
for i = 0 to 3
for j = 0 to 23
.spell_lists(i,j).attack = readshort(f)
.spell_lists(i,j).learned = readshort(f)
next
next
.portrait = readshort(f)
for i = 0 to 2
.bits(i) = readShort(f)
next
for i = 0 to 3
.list_name(i) = ReadVStr(f,10)
next
.portrait_pal = readshort(f)
for i = 0 to 3
.list_type(i) = readshort(f)
next
.have_tag = readshort(f)
.alive_tag = readshort(f)
.leader_tag = readshort(f)
.active_tag = readshort(f)
.max_name_len = readshort(f)
for i = 0 to 1
.hand_pos(i).x = readshort(f)
.hand_pos(i).y = readshort(f)
next i
for i as integer = 0 to gen(genNumElements) - 1
get #f, , .elementals(i)
next
'WARNING: skip past rest of the elements if you add more to this file
end with
close #f
end sub
Sub save_hero_as_old_dt0(filename as string, hero as HeroDef, byval record as integer)
'WARNING: this is the saver for the old-style binary hero data lump. See saveherodata
'TODO: this sub is deprecated, and will eventually be removed.
dim as integer f, i, j
if openfile(filename, for_binary, f) then exit sub
seek #f, record * getbinsize(binDT0) + 1
with hero
writevstr(f,16,.name)
writeshort(f,-1,.sprite)
writeshort(f,-1,.sprite_pal)
writeshort(f,-1,.walk_sprite)
writeshort(f,-1,.walk_sprite_pal)
writeshort(f,-1,.def_level)
writeshort(f,-1,.def_weapon)
SaveStats2(f, @.Lev0, @.LevMax)
'get #f,, .spell_lists()
for i = 0 to 3
for j = 0 to 23
writeshort(f,-1,.spell_lists(i,j).attack)
writeshort(f,-1,.spell_lists(i,j).learned)
next
next
writeshort(f,-1,.portrait)
for i = 0 to 2
writeshort(f,-1,.bits(i))
next
for i = 0 to 3
WriteVStr(f,10, .list_name(i))
next
writeshort(f,-1,.portrait_pal)
for i = 0 to 3
writeshort(f,-1,.list_type(i))
next
writeshort(f,-1,.have_tag)
writeshort(f,-1,.alive_tag)
writeshort(f,-1,.leader_tag)
writeshort(f,-1,.active_tag)
writeshort(f,-1,.max_name_len)
for i = 0 to 1
writeshort(f,-1,.hand_pos(i).x)
writeshort(f,-1,.hand_pos(i).y)
next i
if getfixbit(fixHeroElementals) = NO then
showbug "possible corruption: tried to save hero data with fixHeroElementals=0"
end if
for i as integer = 0 to gen(genNumElements) - 1
put #f, , .elementals(i)
next
'always write 1.0 for all unused elements
dim default as single = 1.0
for i as integer = gen(genNumElements) to 63 'maxElements - 1
put #f, , default
next
end with
close #f
end sub
SUB loadherodata (hero as HeroDef, byval index as integer)
'First try to load the data from heroes.reld and then fall back on the .DT0
'lump if that hero wasn't in heroes.reld. Do this because we don't upgrade
'.DT0 -> heroes.reld in one go, they get upgraded as individual records are
'loaded and saved, during upgrade() or in hero_editor, so the upgrade may be
'partial!
DIM loaded as bool = NO
DIM doc as DocPtr
doc = LoadDocument(workingdir & SLASH & "heroes.reld", optIgnoreMissing)
IF doc THEN 'file present
DIM heronode as NodePtr = NodeByPath(doc, "/hero[" & index & "]")
IF heronode THEN
load_hero_from_reload hero, heronode, index
loaded = YES
END IF
FreeDocument doc
END IF
IF NOT loaded THEN
'debuginfo "falling back to " & game & ".dt0" & " slot " & index
load_hero_from_old_dt0 game & ".dt0", hero, index
END IF
END SUB
'id is only used for debugging
SUB load_hero_from_reload(hero as HeroDef, byval parent as NodePtr, byval id as integer = -1)
ClearHeroData hero, id 'Sets some defaults, but we don't rely on that; everything below should use correct defaults
LoadNode parent 'Efficiency
DIM check_index as integer = 0
READNODE parent, default
WITHNODE parent."name" as heroname
hero.name = GetString(heroname)
hero.max_name_len = heroname."maxlen".default(0).integer
END WITHNODE
READNODE parent."appearance" as appearance
WITHNODE appearance."walkabout" as sprite
hero.walk_sprite = sprite."pic".integer
hero.walk_sprite_pal = sprite."pal".default(-1).integer
END WITHNODE
WITHNODE appearance."battle" as sprite
hero.sprite = sprite."pic".integer
hero.sprite_pal = sprite."pal".default(-1).integer
WITHNODE sprite."hand_a" as hand
hero.hand_pos(0).x = hand."x"
hero.hand_pos(0).y = hand."y"
END WITHNODE
WITHNODE sprite."hand_b" as hand
hero.hand_pos(1).x = hand."x"
hero.hand_pos(1).y = hand."y"
END WITHNODE
END WITHNODE
WITHNODE appearance."portrait" as sprite
hero.portrait = sprite."pic".integer
hero.portrait_pal = sprite."pal".default(-1).integer
END WITHNODE
hero.skip_victory_dance = appearance."skipvicdance".bool
END READNODE
hero.def_level = parent."default_level".default(-1).integer
hero.def_weapon = parent."default_weapon".integer
hero.default_auto_battle = parent."default_auto_battle".bool
hero.exp_mult = parent."exp_mult".default(0.2).double
ReadStatsNode parent."stats_at_zero".ptr, hero.Lev0
ReadStatsNode parent."stats_at_max".ptr, hero.LevMax
READNODE parent."spell_lists" as spell_lists
WITHNODE spell_lists."list" as list
DIM i as integer = GetInteger(list)
SELECT CASE i
CASE 0 TO UBOUND(hero.spell_lists, 1)
hero.list_name(i) = list."name".string
IF list."use_lmp".exists THEN hero.list_type(i) = 1
IF list."random".exists THEN hero.list_type(i) = 2
READNODE list."spells" as spells
WITHNODE spells."spell" as spell
DIM slot as integer = GetInteger(spell)
IF slot > UBOUND(hero.spell_lists, 2) THEN
debug "out-of-bounds spell slot " & slot
ELSE
WITH hero.spell_lists(i, slot)
.attack = spell."attack".integer + 1
IF spell."itemlearn".exists THEN
.learned = 0
ELSE
.learned = spell."learnlev".integer + 1
END IF
'spell."tag"
END WITH
END IF
END WITHNODE
END READNODE
CASE ELSE
debug "out-of-bounds spell list " & i & " for hero " & hero.name
END SELECT
END WITHNODE
END READNODE
READNODE parent."elements" as elements
WITHNODE elements."element" as element
DIM i as integer = GetInteger(element)
SELECT CASE i
CASE 0 TO maxElements - 1
hero.elementals(i) = CAST(single, element."damage".default(1.0).double)
CASE ELSE
debug "out-of-bounds elemental " & i & " for hero " & hero.name
END SELECT
END WITHNODE
END READNODE
IF parent."rename_on_add".exists THEN setbit hero.bits(), 0, 24, YES
IF parent."rename_on_status".exists THEN setbit hero.bits(), 0, 25, YES
IF parent."hide_empty_lists".exists THEN setbit hero.bits(), 0, 26, YES
READNODE parent."tags" as tags, default
hero.have_tag = tags."have_hero".integer
hero.alive_tag = tags."is_alive".integer
hero.leader_tag = tags."is_leader".integer
hero.active_tag = tags."is_active".integer
READNODE tags."checks" as checks
WITHNODE checks."range" as range_node
SELECT CASE range_node."kind".string
CASE "level":
REDIM PRESERVE hero.checks(check_index)
WITH hero.checks(check_index)
.kind = TagRangeCheckKind.level
.tag = range_node."tag".integer
.min = range_node."min".integer
.max = range_node."max".integer
END WITH
check_index += 1
CASE ELSE
debug "load_hero_from_reload: Unsupported hero tag check range kind """ & range_node."kind".string & """ for " & hero.name
END SELECT
END WITHNODE
END READNODE
END READNODE
READNODE parent."counterattacks" as counterattacks
READNODE counterattacks."nonelemental" as nonelemental
hero.non_elem_counter_attack = nonelemental."attack".integer + 1
END READNODE
READNODE counterattacks."elemental" as elemental
WITHNODE elemental."element" as element
DIM i as integer = GetInteger(element)
SELECT CASE i
CASE 0 TO maxElements - 1
hero.elem_counter_attack(i) = element."attack".integer + 1
CASE ELSE
debug "out-of-bounds elemental " & i & " for hero " & hero.name & " counter attacks"
END SELECT
END WITHNODE
END READNODE
READNODE counterattacks."statdamage" as statdamage
WITHNODE statdamage."stat" as stat
DIM i as integer = GetInteger(stat)
SELECT CASE i
CASE 0 TO statLast
hero.stat_counter_attack(i) = stat."attack".integer + 1
CASE ELSE
debug "out-of-bounds stat " & i & " for hero " & hero.name & " counter attacks"
END SELECT
END WITHNODE
END READNODE
END READNODE
'-- Ignore the following because they are kept as Nodes
parent."battle_menus".ignore
parent."stat_options".ignore
END READNODE
IF hero.reld THEN FreeNode(hero.reld) 'This should never be NULL
hero.reld = get_reload_copy(parent)
'debuginfo "Loaded hero " & id & " from reload: " & hero.name
END SUB
SUB saveherodata (hero as HeroDef, byval index as integer)
'--save the old way
'WARNING: this is lossy, and serves no purpose other than
'allowing people to downgrade to older versions WITH DATA LOSS
save_hero_as_old_dt0 game & ".dt0", hero, index
'--save the new way
DIM filename as string = workingdir & SLASH & "heroes.reld"
DIM doc as DocPtr
doc = LoadDocument(filename, optNoDelay OR optIgnoreMissing)
IF doc = 0 THEN
debuginfo "heroes doc not found, create it"
doc = CreateDocument()
END IF
DIM heroes as NodePtr
heroes = DocumentRoot(doc)
IF heroes = 0 THEN
heroes = CreateNode(doc, "heroes")
SetRootNode(doc, heroes)
END IF
'Create a new hero node if it doesn't already exist, otherwise we replace it
DIM heronode as NodePtr
heronode = NodeByPath(heroes, "/hero[" & index & "]", YES)
save_hero_as_reload hero, heronode
SerializeBin filename, doc
FreeDocument doc
END SUB
SUB save_hero_as_reload(hero as HeroDef, byval parent as NodePtr)
FreeChildren parent
DIM ch as NodePtr
ch = SetChildNode(parent, "name", hero.name)
IF hero.max_name_len > 0 THEN
SetChildNode ch, "maxlen", hero.max_name_len
END IF
DIM appear as NodePtr
appear = SetChildNode(parent, "appearance")
WritePicPalNode appear, "walkabout", hero.walk_sprite, hero.walk_sprite_pal
WritePicPalNode appear, "portrait", hero.portrait, hero.portrait_pal
ch = WritePicPalNode(appear, "battle", hero.sprite, hero.sprite_pal)
WriteXYPairNode ch, "hand_a", hero.hand_pos(0)
WriteXYPairNode ch, "hand_b", hero.hand_pos(1)
SetChildNodeBool appear, "skipvicdance", hero.skip_victory_dance
IF hero.def_level >= 0 THEN SetChildNode parent, "default_level", hero.def_level
SetChildNode parent, "default_weapon", hero.def_weapon
SetChildNodeBool parent, "default_auto_battle", hero.default_auto_battle
SetChildNode parent, "exp_mult", hero.exp_mult
WriteStatsNode(parent, "stats_at_zero", hero.Lev0)
WriteStatsNode(parent, "stats_at_max", hero.LevMax)
DIM reld as NodePtr = hero.reld
AddChild(parent, CloneNodeTree(reld."battle_menus".ptr, GetDocument(parent)))
DIM splists as NodePtr
DIM splist as NodePtr
DIM spells as NodePtr
DIM sp as NodePtr
splists = SetChildNode(parent, "spell_lists")
FOR i as integer = 0 TO 3
splist = AppendChildNode(splists, "list", i)
SetChildNode splist, "name", hero.list_name(i)
spells = SetChildNode(splist, "spells")
FOR j as integer = 0 to 23
WITH hero.spell_lists(i, j)
IF .attack > 0 THEN
sp = AppendChildNode(spells, "spell", j)
SetChildNode sp, "attack", .attack - 1
IF .learned > 0 THEN
SetChildNode sp, "learnlev", .learned - 1
ELSE
SetChildNode sp, "itemlearn"
END IF
'FIXME: tag goes here when supported
END IF
END WITH
NEXT j
IF hero.list_type(i) = 1 THEN
SetChildNode splist, "use_lmp"
END IF
IF hero.list_type(i) = 2 THEN
SetChildNode splist, "random"
END IF
NEXT i
DIM elements as NodePtr
elements = SetChildNode(parent, "elements")
FOR i as integer = 0 to gen(genNumElements) - 1
IF INT(hero.elementals(i) * 10000) <> 10000 THEN
ch = AppendChildNode(elements, "element", i)
SetChildNode ch, "damage", cast(double, hero.elementals(i))
END IF
NEXT i
IF xreadbit(hero.bits(), 24) THEN SetChildNode parent, "rename_on_add"
IF xreadbit(hero.bits(), 25) THEN SetChildNode parent, "rename_on_status"
IF xreadbit(hero.bits(), 26) THEN SetChildNode parent, "hide_empty_lists"
DIM tagnode as NodePtr
tagnode = SetChildNode(parent, "tags")
IF hero.have_tag > 0 THEN SetChildNode tagnode, "have_hero", hero.have_tag
IF hero.alive_tag > 0 THEN SetChildNode tagnode, "is_alive", hero.alive_tag
IF hero.leader_tag > 0 THEN SetChildNode tagnode, "is_leader", hero.leader_tag
IF hero.active_tag > 0 THEN SetChildNode tagnode, "is_active", hero.active_tag
'Now save the checks list
DIM checks as NodePtr = SetChildNode(tagnode, "checks") ' Makes a new checks node that will contain the range checks list
FOR i as integer = 0 TO UBOUND(hero.checks)
WITH hero.checks(i)
SELECT CASE .kind
CASE TagRangeCheckKind.level
DIM range_node as NodePtr
range_node = AppendChildNode(checks, "range") 'Makes a new node named range under the "checks" node
'-- Copy the members of the check data into reload nodes
SetChildNode range_node, "kind", "level"
SetChildNode range_node, "tag", .tag
SetChildNode range_node, "min", .min
SetChildNode range_node, "max", .max
CASE ELSE
debug "save_hero_as_reload: Unsupported hero tag check range kind """ & .kind & """ for " & hero.name
END SELECT
END WITH
NEXT i
IF reld."stat_options".exists THEN
AddChild(parent, CloneNodeTree(reld."stat_options".ptr, GetDocument(parent)))
ELSE
'-empty node if not found
SetChildNode(parent, "stat_options")
END IF
'--Create the node containing counterattack data
DIM counterattacks as NodePtr = SetChildNode(parent, "counterattacks")
'Non-elemental counterattack goes in its own container node
IF hero.non_elem_counter_attack > 0 THEN
DIM ca_nonelemental as NodePtr = SetChildNode(counterattacks, "nonelemental")
SetChildNode ca_nonelemental, "attack", hero.non_elem_counter_attack - 1
END IF
'Store the elemental counterattacks
DIM ca_elemental as NodePtr = SetChildNode(counterattacks, "elemental")
FOR i as integer = 0 to gen(genNumElements) - 1
IF hero.elem_counter_attack(i) > 0 THEN
ch = AppendChildNode(ca_elemental, "element", i)
SetChildNode ch, "attack", hero.elem_counter_attack(i) - 1
END IF
NEXT i
'Store the stat-damage counterattacks
DIM ca_statdamage as NodePtr = SetChildNode(counterattacks, "statdamage")
FOR i as integer = 0 to statLast
IF hero.stat_counter_attack(i) > 0 THEN
ch = AppendChildNode(ca_statdamage, "stat", i)
SetChildNode ch, "attack", hero.stat_counter_attack(i) - 1
END IF
NEXT i
END SUB
SUB ReadStatsNode (byval stats as NodePtr, statobj as Stats)
READNODE stats
WITHNODE stats."stat" as stat
DIM i as integer = GetInteger(stat)
SELECT CASE i
CASE 0 to statLast
statobj.sta(i) = stat."value".integer
CASE ELSE
debuginfo "ReadStatsNode: unknown stat id " & i
END SELECT
END WITHNODE
END READNODE
END SUB
FUNCTION WriteStatsNode (byval parent as NodePtr, nodename as string, statobj as Stats) as NodePtr
DIM node as NodePtr
node = AppendChildNode(parent, nodename)
DIM ch as NodePtr
FOR i as integer = 0 TO UBOUND(statobj.sta)
ch = AppendChildNode(node, "stat", i)
SetChildNode(ch, "value", statobj.sta(i))
NEXT i
RETURN node
END FUNCTION
FUNCTION WriteXYPairNode (byval parent as NodePtr, nodename as string, pair as XYPair) as NodePtr
DIM node as NodePtr
node = SetChildNode(parent, nodename)
SetChildNode node, "x", pair.x
SetChildNode node, "y", pair.y
RETURN node
END FUNCTION
FUNCTION WritePicPalNode (byval parent as NodePtr, nodename as string, byval pic as integer, byval pal as integer=-1) as NodePtr
DIM node as NodePtr
node = SetChildNode(parent, nodename)
SetChildNode node, "pic", pic
IF pal >= 0 THEN
SetChildNode node, "pal", pal
END IF
RETURN node
END FUNCTION
' This adds any new properties to an existing Node for a hero battle menu
' (and is also used to help create in the first place)
SUB upgrade_hero_battle_menu_item(bmenu as NodePtr)
IF bmenu."caption".exists = NO THEN SetChildNode(bmenu, "caption", "")
IF bmenu."color".exists = NO THEN SetChildNode(bmenu, "color", 0)
IF bmenu."enable_tag1".exists = NO THEN SetChildNode(bmenu, "enable_tag1", 0)
IF bmenu."enable_tag2".exists = NO THEN SetChildNode(bmenu, "enable_tag2", 0)
IF bmenu."hide_disabled".exists = NO THEN SetChildNode(bmenu, "hide_disabled", NO)
IF bmenu."exclude_auto_battle".exists = NO THEN SetChildNode(bmenu, "exclude_auto_battle", NO)
END SUB
FUNCTION add_hero_battle_menu_item(byval parent as NodePtr, kind as string, byval value as integer = 0) as NodePtr
DIM bmenu as NodePtr
bmenu = AppendChildNode(parent, "menu")
DIM kindnode as NodePtr
kindnode = SetChildNode(bmenu, "kind")
SELECT CASE kind
CASE "weapon", "items":
SetChildNode(kindnode, kind)
CASE "attack", "spells":
SetChildNode(kindnode, kind, value)
END SELECT
' Initialise other data to defaults
upgrade_hero_battle_menu_item bmenu
RETURN bmenu
END FUNCTION
'id is only used for debugging
CONSTRUCTOR HeroDef(id as integer = -1)
sprite_pal = -1 'default battle palette
walk_sprite_pal = -1 'default walkabout palette
portrait_pal = -1
exp_mult = 0.2
FOR i as integer = 0 TO maxElements - 1
elementals(i) = 1.0f
NEXT
create_blank_hero_reld this, id
END CONSTRUCTOR
DESTRUCTOR HeroDef()
IF reld THEN
'debuginfo "Freeing a HeroDef's reload node in the destructor!"
FreeNode reld
reld = NULL
ELSE
'debuginfo "HeroDef didn't bother freeing reload node because it was never loaded"
END IF
END DESTRUCTOR
'id is only used for debugging
SUB ClearHeroData (hero as HeroDef, id as integer = -1)
hero.Destructor()
hero.Constructor()
END SUB
SUB create_blank_hero_reld(hero as HeroDef, byval id as integer = -1)
'Construct any reload nodes that we need in memory.
'id is only used for debugging
IF hero.reld THEN FreeNode(hero.reld) 'Currently never happens
hero.reld = get_reload_empty("hero")
SetContent(hero.reld, id) 'For debugging only, is not used
DIM batmenus as NodePtr
batmenus = SetChildNode(hero.reld, "battle_menus")
add_hero_battle_menu_item batmenus, "weapon"
for i as integer = 0 to 3
add_hero_battle_menu_item batmenus, "spells", i
next
add_hero_battle_menu_item batmenus, "items"
SetChildNode(hero.reld, "stat_options")
END SUB
FUNCTION GetHeroHandPos(byval hero_id as integer, byval which_frame as integer) as XYPair
'which-frame is 0 for attack A and 1 for attack B
DIM her as HeroDef
loadherodata her, hero_id
RETURN her.hand_pos(which_frame)
/' The following code only loads the hand data, nothing else, but the heroes.reld
' code hasn't been tested. I don't think the risk of bugs and maintenance burden
' is worth the very minor efficiency gain.
DIM ret as XYPair
'First try new heroes.reld lump
DIM filename as string = workingdir & SLASH & "heroes.reld"
DIM doc as DocPtr
IF isfile(filename) THEN
doc = LoadDocument(filename)
IF doc THEN
DIM path as string
path = "/hero[" & hero_id & "]/appearance/battle/" & IIF(which_frame = 0, "hand_a", "hand_b")
DIM handnode as NodePtr = NodeByPath(doc, path)
IF handnode THEN
ret.x = handnode."x"
ret.y = handnode."y"
END IF
FreeDocument doc
RETURN ret
END IF
END IF
'If the hero doesn't exist in heroes.reld fallback to .DT0 (loadherodata does the same)
DIM fh as integer
OPENFILE(game & ".dt0", FOR_BINARY, fh)
DIM off as integer = hero_id * getbinsize(binDT0) + 595 + which_frame * 4
ret = XY(ReadShort(fh, off), ReadShort(fh, off + 2))
CLOSE #FH
RETURN ret
'/
END FUNCTION
'==========================================================================================
' Vehicles
'==========================================================================================
SUB LoadVehicle (file as string, vehicle as VehicleData, byval record as integer)
DIM buf(39) as integer
LoadVehicle file, buf(), vehicle.name, record
WITH vehicle
.speed = buf(8)
.random_battles = buf(11)
.use_button = buf(12)
.menu_button = buf(13)
.riding_tag = buf(14)
.on_mount = buf(15)
.on_dismount = buf(16)
.override_walls = buf(17)
.blocked_by = buf(18)
.mount_from = buf(19)
.dismount_to = buf(20)
.elevation = buf(21)
.pass_walls = xreadbit(buf(), 0, 9)
.pass_npcs = xreadbit(buf(), 1, 9)
.enable_npc_activation = xreadbit(buf(), 2, 9)
.enable_door_use = xreadbit(buf(), 3, 9)
.do_not_hide_leader = xreadbit(buf(), 4, 9)
.do_not_hide_party = xreadbit(buf(), 5, 9)
.dismount_ahead = xreadbit(buf(), 6, 9)
.pass_walls_while_dismounting = xreadbit(buf(), 7, 9)
.disable_flying_shadow = xreadbit(buf(), 8, 9)
.ignore_harmtiles = xreadbit(buf(), 9, 9)
END WITH
END SUB
SUB LoadVehicle (file as string, veh() as integer, vehname as string, byval record as integer)
loadrecord veh(), file, 40, record
vehname = STRING(bound(veh(0) AND 255, 0, 15), 0)
array2str veh(), 1, vehname
END SUB
SUB SaveVehicle (file as string, byref vehicle as VehicleData, byval record as integer)
DIM buf(39) as integer
WITH vehicle
buf(39) = .speed
buf(11) = .random_battles
buf(12) = .use_button
buf(13) = .menu_button
buf(14) = .riding_tag
buf(15) = .on_mount
buf(16) = .on_dismount
buf(17) = .override_walls
buf(18) = .blocked_by
buf(19) = .mount_from
buf(20) = .dismount_to
buf(21) = .elevation
setbit buf(), 9, 0, .pass_walls
setbit buf(), 9, 1, .pass_npcs
setbit buf(), 9, 2, .enable_npc_activation
setbit buf(), 9, 3, .enable_door_use
setbit buf(), 9, 4, .do_not_hide_leader
setbit buf(), 9, 5, .do_not_hide_party
setbit buf(), 9, 6, .dismount_ahead
setbit buf(), 9, 7, .pass_walls_while_dismounting
setbit buf(), 9, 8, .disable_flying_shadow
setbit buf(), 9, 9, .ignore_harmtiles
END WITH
SaveVehicle file, buf(), vehicle.name, record
END SUB
SUB SaveVehicle (file as string, veh() as integer, vehname as string, byval record as integer)
veh(0) = bound(LEN(vehname), 0, 15)
str2array vehname, veh(), 1
storerecord veh(), file, 40, record
END SUB
'==========================================================================================
' UI Colors
'==========================================================================================
LOCAL SUB InternalDefaultUIColors (masterpal() as RGBcolor, colarray() as integer, uidef() as integer, boxarray() as BoxStyle, boxdef() as integer)
'Fill colarray() and boxarray() using masterpal(), uidef(), boxdef()
'This sub just exists because I didn't want to copy-and-paste to implement
'OldDefaultUIColors() and DefaultUIColors()
'First we call GuessDefaultUIColors to initialise any colours above uiColorOldLast, which aren't in uidef()
GuessDefaultUIColors masterpal(), colarray()
GuessDefaultBoxStyles masterpal(), boxarray()
FOR i as integer = 0 TO uiColorOldLast
colarray(i) = uidef(i)
NEXT i
FOR i as integer = 0 TO uiBoxLast
boxarray(i).bgcol = boxdef(i * 2)
boxarray(i).edgecol = boxdef(i * 2 + 1)
#IFDEF IS_GAME
boxarray(i).border = 0 'No borders, because data/ isn't shipped with Game
#ELSE
boxarray(i).border = 1 'Use border 0 (loaded from data/defaultgfx/ohrrpgce.pt7)
#ENDIF
NEXT i
END SUB
SUB OldDefaultUIColors (masterpal() as RGBcolor, colarray() as integer, boxarray() as BoxStyle)
'Default UI for Classic OHR master palette
'for upgrading old games that lack an uicolors.bin file
'Boxstyle borders all set to line only.
DIM uidef(uiColorOldLast) as integer = _
{0,7,8,14,15,6,7,1,2,18,21,35,37,15,240,10,14,240}
DIM boxdef(uiBoxLast * 2 + 1) as integer = _
{18,28,34,44,50,60,66,76,82,92,98,108,114,124,130,140, _
146,156,162,172,178,188,194,204,210,220,226,236,242,252}
InternalDefaultUIColors masterpal(), colarray(), uidef(), boxarray(), boxdef()
END SUB
SUB DefaultUIColors (masterpal() as RGBcolor, colarray() as integer, boxarray() as BoxStyle)
'Default UI for NeoTA's new Master palette
'for the filepicker and other menus before a game is loaded.
'Boxstyle borders all set to line only.
DIM uidef(uiColorLast) as integer = _
{0,144,80,110,240,102,144,244,215,242,67,212,215,240,0,220,110,0}
DIM boxdef(uiBoxLast * 2 + 1) as integer = _
{242,40,211,221,83,90,182,173,100,159,115,60,132,156,98,105, _
195,204,70,66,217,210,87,82,108,232,54,116,48,160}
InternalDefaultUIColors masterpal(), colarray(), uidef(), boxarray(), boxdef()
END SUB
SUB GuessDefaultUIColors (masterpal() as RGBcolor, colarray() as integer)
'This is used for resetting default colors in the editor, and for when
'the uicolor data is completely missing.
'See also FillMissingUIColor which is used in different situations
DIM as integer fixeddefaults(uiColorLast)
' &hRRGGBB
fixeddefaults(uiBackground) = &h000000
fixeddefaults(uiMenuItem) = &hA19CB0
fixeddefaults(uiDisabledItem) = &h4F595A
fixeddefaults(uiSelectedItem) = &hFFFC62
fixeddefaults(uiSelectedItem2) = &hFFFFFF
fixeddefaults(uiSelectedDisabled) = &h8E6B00
fixeddefaults(uiSelectedDisabled2) = &hA19CB0
fixeddefaults(uiHighlight) = &h003B95
fixeddefaults(uiHighlight2) = &h228B22
fixeddefaults(uiTimeBar) = &h001D48
fixeddefaults(uiTimeBarFull) = &h153289
fixeddefaults(uiHealthBar) = &h154C15
fixeddefaults(uiHealthBarFlash) = &h228B22
fixeddefaults(uiText) = &hFFFFFF
fixeddefaults(uiOutline) = &h000000
fixeddefaults(uiDescription) = &h6BEB61
fixeddefaults(uiGold) = &hFFFC62
fixeddefaults(uiShadow) = &h000000
fixeddefaults(uiSpecialItem) = &h8E6B00
fixeddefaults(uiSelectedSpecial) = &hFFFFFF
fixeddefaults(uiSelectedSpecial2) = &hFFFC62
fixeddefaults(uiItemScreenSwap) = &hFFFFFF
fixeddefaults(uiItemScreenSwapDisabled) = &hA19CB0
fixeddefaults(uiItemScreenSwapSpecial) = &hFFFC62
fixeddefaults(uiItemScreenItem) = &hA19CB0
fixeddefaults(uiItemScreenDisabled) = &h4F595A
fixeddefaults(uiItemScreenSpecial) = &h8E6B00
fixeddefaults(uiItemScreenSelected) = &hFFFFFF
fixeddefaults(uiItemScreenSelected2) = &hFFFFFF
fixeddefaults(uiItemScreenSelectedDisabled) = &hA19CB0
fixeddefaults(uiItemScreenSelectedDisabled2) = &hA19CB0
fixeddefaults(uiItemScreenSelectedSpecial) = &hFFFC62
fixeddefaults(uiItemScreenSelectedSpecial2) = &hFFFC62
fixeddefaults(uiItemScreenHighlight) = &h228B22
fixeddefaults(uiItemScreenHighlight2) = &h228B22
fixeddefaults(uiItemScreenSwapHighlight) = &h003B95
fixeddefaults(uiItemScreenSwapHighlight2) = &h228B22
fixeddefaults(uiMouseHoverItem) = &h8C8C8C
fixeddefaults(uiBattleDamage) = &hFFFFFF
fixeddefaults(uiBattleHeal) = &hFFFFFF
fixeddefaults(uiBattleAbsorb) = &hFF5757
fixeddefaults(uiBattlePoison) = &hFFFFFF
fixeddefaults(uiBattleRegen) = &hFFFFFF
fixeddefaults(uiFadeOutNewGame) = &h000000
fixeddefaults(uiFadeOutLoadGame) = &h000000
fixeddefaults(uiFadeOutDeath) = &hFF0000
fixeddefaults(uiFadeOutQuit) = &h000000
fixeddefaults(uiFadeOutDoor) = &h000000
fixeddefaults(uiFadeOutInn) = &h000050
fixeddefaults(uiFadeOutEnterBattle) = &hF0F0F0
fixeddefaults(uiFadeOutWonBattle) = &h000000
fixeddefaults(uiFadeOutExitBattle) = &h000000
fixeddefaults(uiMPBar) = &h00E0E0
fixeddefaults(uiMPBarFlash) = &h80FFFF
DIM c as RGBcolor
FOR i as integer = 0 TO uiColorLast
c.col = fixeddefaults(i)
DIM firstindex as integer = IIF(i = uiShadow, 1, 0) 'Shadow color can't be 0
DIM avoidcol as integer = -1
'Text colors used in Custom shouldn't be same as background
IF i >= uiMenuItem ANDALSO i <= uiHighlight2 THEN avoidcol = uilook(uiBackground)
colarray(i) = nearcolor(masterpal(), c.r, c.g, c.b, firstindex, , avoidcol)
NEXT i
END SUB
SUB GuessDefaultBoxStyles (masterpal() as RGBcolor, boxarray() as BoxStyle, colors_only as bool = NO)
'This is used for resetting box styles in the editor, and for when
'the styles are completely missing.
'colors_only=YES: reset style data other than border colors
DIM boxdefaults(uiBoxLast * 2 + 1) as integer = _
{&h001D48,&h8084D0,&h123D12,&h98FA90,&h500000,&hFF7F7F,&h4F7A54,&hD3F88E,&h5E4600,&hF1EA89,&h471747,_
&hDF90FF,&h76352C,&hD3A560,&h2D2200,&hD7A100,&h4D3836,&hF6D2B6,&h2179D3,&h0E2059,&h3CB23A,&h0E300E,_
&hBF0000,&h340000,&hFFDD30,&hCD8316,&h8236AC,&h5F1F5F,&h2F342E,&hBAABC1}
DIM c as RGBcolor
FOR i as integer = 0 TO uiBoxLast
c.col = boxdefaults(i * 2)
boxarray(i).bgcol = nearcolor(masterpal(), c.r, c.g, c.b)
c.col = boxdefaults(i * 2 + 1)
boxarray(i).edgecol = nearcolor(masterpal(), c.r, c.g, c.b)
IF colors_only = NO THEN
'Box border pictures default to zero (none)
boxarray(i).border = 0
END IF
NEXT
END SUB
FUNCTION FillMissingUIColor(byval index as integer, colarray() as integer, masterpal() as RGBcolor) as integer
'This returns a missing uilook color. Some of these may be hard-coded, and others
'may rely on the values already present in colarray(). This is used for filling gaps in
'the uilook array for old games that have uicolor data, but lack new uilook slots
'that have been added in more recent versions.
'Don't confuse it with GuessDefaultUIColors, which is used for different situations
IF index <= uiColorOldLast THEN
'Normally this function should not be called for old colors that predate the
'uicolors node in general.reld, however if it is called for one of those colors,
'we just want to log a warning and then return a sane result
debug "FillMissingUIColor was called for old ui color " & index
END IF
SELECT CASE index
'Some colors are defaulted based on existing color entries.
'This is generally the case when a single color that was being used for
'two unrelated purposes is split apart into two color entries
CASE uiSpecialItem: RETURN colarray(uiSelectedDisabled)
CASE uiSelectedSpecial: RETURN colarray(uiSelectedItem)
CASE uiSelectedSpecial2: RETURN colarray(uiSelectedItem2)
CASE uiItemScreenSwap: RETURN colarray(uiText)
CASE uiItemScreenSwapDisabled: RETURN colarray(uiMenuItem)
CASE uiItemScreenSwapSpecial: RETURN colarray(uiGold)
CASE uiItemScreenItem: RETURN colarray(uiMenuItem)
CASE uiItemScreenDisabled: RETURN colarray(uiDisabledItem)
CASE uiItemScreenSpecial: RETURN colarray(uiSpecialItem)
CASE uiItemScreenSelected: RETURN colarray(uiSelectedItem2)
CASE uiItemScreenSelected2: RETURN colarray(uiSelectedItem2)
CASE uiItemScreenSelectedDisabled: RETURN colarray(uiSelectedDisabled2)
CASE uiItemScreenSelectedDisabled2: RETURN colarray(uiSelectedDisabled2)
CASE uiItemScreenSelectedSpecial: RETURN colarray(uiSelectedSpecial)
CASE uiItemScreenSelectedSpecial2: RETURN colarray(uiSelectedSpecial)
CASE uiItemScreenHighlight: RETURN colarray(uiHighlight2)
CASE uiItemScreenHighlight2: RETURN colarray(uiHighlight2)
CASE uiItemScreenSwapHighlight: RETURN colarray(uiHighlight)
CASE uiItemScreenSwapHighlight2: RETURN colarray(uiHighlight2)
CASE uiBattleDamage: RETURN colarray(uiText)
CASE uiBattleHeal: RETURN colarray(uiText)
CASE uiBattlePoison: RETURN colarray(uiText)
CASE uiBattleRegen: RETURN colarray(uiText)
CASE ELSE
'Return defaults for all other colors
DIM defaults(uiColorLast) as integer
GuessDefaultUIColors masterpal(), defaults()
RETURN defaults(index)
END SELECT
END FUNCTION
FUNCTION UiColorCaption(byval n as integer) as string
SELECT CASE n
CASE uiBackground: RETURN "Background"
CASE uiMenuItem: RETURN "Menu item"
CASE uiDisabledItem: RETURN "Disabled menu item"
CASE uiSelectedItem: RETURN "Selected"
CASE uiSelectedItem2: RETURN "Selected (Flash)"
CASE uiSelectedDisabled: RETURN "Selected disabled"
CASE uiSelectedDisabled2: RETURN "Selected disabled (Flash)"
CASE uiHighlight: RETURN "Highlight A"
CASE uiHighlight2: RETURN "Highlight B"
CASE uiTimeBar: RETURN "Time bar"
CASE uiTimeBarFull: RETURN "Time bar full"
CASE uiHealthBar: RETURN "Health bar"
CASE uiHealthBarFlash: RETURN "Health bar overfull"
CASE uiText: RETURN "Text"
CASE uiOutline: RETURN "Text outline"
CASE uiDescription: RETURN "Spell description"
CASE uiGold: RETURN "Money"
CASE uiShadow: RETURN "Vehicle shadow"
CASE uiSpecialItem: RETURN "Special menu item"
CASE uiSelectedSpecial: RETURN "Selected special item"
CASE uiSelectedSpecial2: RETURN "Selected special item (Flash)"
CASE uiItemScreenSwap: RETURN "Items: swapping usable"
CASE uiItemScreenSwapDisabled: RETURN "Items: swapping unusable"
CASE uiItemScreenSwapSpecial: RETURN "Items: swapping undroppable"
CASE uiItemScreenItem: RETURN "Items: usable item"
CASE uiItemScreenDisabled: RETURN "Items: unusable item"
CASE uiItemScreenSpecial: RETURN "Items: undroppable item"
CASE uiItemScreenSelected: RETURN "Items: selected item"
CASE uiItemScreenSelected2: RETURN "Items: selected item (Flash)"
CASE uiItemScreenSelectedDisabled: RETURN "Items: selected unusable"
CASE uiItemScreenSelectedDisabled2: RETURN "Items: selected unusable (Flash)"
CASE uiItemScreenSelectedSpecial: RETURN "Items: selected undroppable"
CASE uiItemScreenSelectedSpecial2: RETURN "Items: selected undroppable (Flash)"
CASE uiItemScreenHighlight: RETURN "Items: highlight selected"
CASE uiItemScreenHighlight2: RETURN "Items: highlight selected (Flash)"
CASE uiItemScreenSwapHighlight: RETURN "Items: highlight swapping"
CASE uiItemScreenSwapHighlight2: RETURN "Items: highlight swapping (Flash)"
CASE uiMouseHoverItem: RETURN "Mouse hover over menu item"
CASE uiBattleDamage: RETURN "Battle damage"
CASE uiBattleHeal: RETURN "Battle healing"
CASE uiBattleAbsorb: RETURN "Battle absorb (drain)"
CASE uiBattlePoison: RETURN "Battle poison damage"
CASE uiBattleRegen: RETURN "Battle regen healing"
CASE uiFadeOutNewGame: RETURN "Fadeout: new game"
CASE uiFadeOutLoadGame: RETURN "Fadeout: load game"
CASE uiFadeOutDeath: RETURN "Fadeout: on death"
CASE uiFadeOutQuit: RETURN "Fadeout: quitting game"
CASE uiFadeOutDoor: RETURN "Fadeout: door"
CASE uiFadeOutInn: RETURN "Fadeout: stay at inn"
CASE uiFadeOutEnterBattle: RETURN "Fadeout: enter battle"
CASE uiFadeOutWonBattle: RETURN "Fadeout: won battle"
CASE uiFadeOutExitBattle: RETURN "Fadeout: exit/flee battle"
CASE uiMPBar: RETURN "MP bar"
CASE uiMPBarFlash: RETURN "MP bar overfull"
END SELECT
'Invalid values still print, but !?
RETURN n & "(!?)"
END FUNCTION
'Minimum valid color code (as used in scripts or slice data)
FUNCTION LowColorCode () as integer
RETURN uiColorLast * -1 - 1
END FUNCTION
'Decode a color code (as used in scripts or slice data) to a master palette index
FUNCTION ColorIndex(n as integer, autotoggle as bool = YES) as integer
if n >= 0 andalso n <= 255 then return n
if n <= -1 andalso n >= (uiColorLast*-1 - 1) then
dim uiC as integer = (n * -1) - 1
if autotoggle then
select case uiC
case uiSelectedItem2, uiSelectedDisabled2, uiSelectedSpecial2, _
uiItemScreenSelected2, uiItemScreenSelectedDisabled2, _
uiItemScreenSelectedSpecial2, uiItemScreenHighlight2, _
uiItemScreenSwapHighlight2:
'Some colors auto-animate
if get_tickcount() mod 2 = 0 then uiC = uiC - 1
end select
end if
return uilook(uiC)
end if
debugerror "Invalid slice color " & n
END FUNCTION
'Given the base color of a menu item, return which color should be used as the
'mouse hover color. Computed by tinting the base color with uiMouseHoverItem.
FUNCTION mouse_hover_tinted_color(text_col as integer = -1) as integer
IF text_col = -1 OR text_col = uilook(uiMenuItem) THEN
RETURN uilook(uiMouseHoverItem) 'No need to search for the color; we know it
END IF
DIM as RGBcolor col = master(text_col)
DIM as RGBcolor menuitem = master(uilook(uiMenuItem)), hover = master(uilook(uiMouseHoverItem))
DIM as integer r, g, b, ret
r = col.r + hover.r - menuitem.r
g = col.g + hover.g - menuitem.g
b = col.b + hover.b - menuitem.b
ret = nearcolor(master(), r, g, b, , , text_col) 'Find nearest color not the same as text_col
IF ret = uilook(uiBackground) THEN ret = uilook(uiMouseHoverItem) 'Never return the background
RETURN ret
END FUNCTION
SUB LoadUIColors (colarray() as integer, boxarray() as BoxStyle, byval palnum as integer=-1, masterpal() as RGBcolor)
'--Prefer to load ui colors from general.reld
DIM gen_root as NodePtr = get_general_reld()
DIM uic as NodePtr
IF gen_root."uicolors".exists THEN
uic = gen_root."uicolors".ptr
READNODE uic
WITHNODE uic."forpalette" as forpal
IF palnum = GetInteger(forpal) THEN
LoadUIColorsNode forpal, colarray(), boxarray(), masterpal()
EXIT SUB
END IF
END WITHNODE
END READNODE
END IF
'--Only if we failed to find the uicolors node should we
' resort to load ui colors from the old uicolors.bin lump
DIM filename as string
filename = workingdir & SLASH & "uicolors.bin"
IF palnum < 0 OR palnum > gen(genMaxMasterPal) OR NOT isfile(filename) THEN
DefaultUIColors masterpal(), colarray(), boxarray()
EXIT SUB
END IF
DIM f as integer
OPENFILE(filename, FOR_BINARY + ACCESS_READ, f)
SEEK #f, palnum * getbinsize(binUIColors) + 1
FOR i as integer = 0 TO uiColorOldLast
colarray(i) = ReadShort(f)
NEXT i
FOR i as integer = 0 TO uiBoxOldLast
boxarray(i).bgcol = ReadShort(f)
boxarray(i).edgecol = ReadShort(f)
NEXT i
FOR i as integer = 0 TO uiBoxOldLast
boxarray(i).border = ReadShort(f)
NEXT i
CLOSE f
'If we have fallen back to uicolors.bin then we need to fill the missing
'values for colors that were added after uicolors.bin was obsoleted
FOR i as integer = uiColorOldLast + 1 TO uiColorLast
colarray(i) = FillMissingUIColor(i, colarray(), masterpal())
NEXT i
END SUB
SUB LoadUIColorsNode (byval node as NodePtr, colarray() as integer, boxarray() as BoxStyle, masterpal() as RGBcolor)
DIM foundui(uiColorLast) as bool
READNODE node
WITHNODE node."uilook" as n
DIM i as integer = GetInteger(n)
SELECT CASE i
CASE 0 TO uiColorLast
colarray(i) = n."col".integer
foundui(i) = YES
CASE ELSE
debug "uilook out of range (" & i & ")"
END SELECT
END WITHNODE
WITHNODE node."boxlook" as n
DIM i as integer = GetInteger(n)
SELECT CASE i
CASE 0 TO uiBoxLast
boxarray(i).bgcol = n."bgcol".integer
boxarray(i).edgecol = n."edgecol".integer
boxarray(i).border = n."border".integer
CASE ELSE
debug "boxlook out of range (" & i & ")"
END SELECT
END WITHNODE
END READNODE
FOR i as integer = 0 TO uiColorLast
IF NOT foundui(i) THEN
colarray(i) = FillMissingUIColor(i, colarray(), masterpal())
END IF
NEXT i
END SUB
SUB SaveUIColors (colarray() as integer, boxarray() as BoxStyle, byval palnum as integer)
BUG_IF(palnum < 0 OR palnum > gen(genMaxMasterPal), "attempt to save UIcols for nonexistent palette " & palnum)
DIM gen_root as NodePtr = get_general_reld()
'Create if doesn't exist
DIM uic as NodePtr = GetOrCreateChild(gen_root, "uicolors")
DIM found as bool = NO
READNODE uic
WITHNODE uic."forpalette" as forpal
IF palnum = GetInteger(forpal) THEN
found = YES
SaveUIColorsNode forpal, colarray(), boxarray()
END IF
END WITHNODE
END READNODE
IF NOT found THEN
DIM newpal as NodePtr
newpal = AppendChildNode(uic, "forpalette", palnum)
SaveUIColorsNode newpal, colarray(), boxarray()
END IF
write_general_reld()
'---Also save the old uicolors.bin for downgrade compatibility
DIM filename as string
filename = workingdir & SLASH & "uicolors.bin"
DIM f as integer
OPENFILE(filename, FOR_BINARY, f)
SEEK #f, palnum * getbinsize(binUICOLORS) + 1
FOR i as integer = 0 TO uiColorOldLast
WriteShort f, -1, colarray(i)
NEXT i
FOR i as integer = 0 TO uiBoxOldLast
WriteShort f, -1, boxarray(i).bgcol
WriteShort f, -1, boxarray(i).edgecol
NEXT i
FOR i as integer = 0 TO uiBoxOldLast
WriteShort f, -1, boxarray(i).border
NEXT i
CLOSE f
END SUB
SUB SaveUIColorsNode (byval node as NodePtr, colarray() as integer, boxarray() as BoxStyle)
FreeChildren node
DIM n as NodePtr
FOR i as integer = 0 to uiColorLast
n = AppendChildNode(node, "uilook", i)
AppendChildNode(n, "col", colarray(i))
NEXT i
FOR i as integer = 0 to uiBoxLast
n = AppendChildNode(node, "boxlook", i)
AppendChildNode(n, "bgcol", boxarray(i).bgcol)
AppendChildNode(n, "edgecol", boxarray(i).edgecol)
AppendChildNode(n, "border", boxarray(i).border)
NEXT i
END SUB
'==========================================================================================
' Textboxes
'==========================================================================================
SUB LoadTextBox (byref box as TextBox, byval record as integer)
DIM boxbuf(dimbinsize(binSAY)) as integer
IF record < 0 OR record > gen(genMaxTextBox) THEN
debug "LoadTextBox: invalid record: " & record
IF record <> 0 THEN LoadTextBox box, 0
EXIT SUB
END IF
DIM filename as string
filename = game & ".say"
loadrecord boxbuf(), filename, getbinsize(binSAY) \ 2, record
DIM i as integer
'--Populate TextBox object
WITH box
'--Load lines of text
REDIM .text(7) 'maxTextboxLines - 1
FOR i = 0 TO 7
.text(i) = STRING(38, 0)
array2str boxbuf(), i * 38, .text(i)
.text(i) = RTRIM(.text(i), CHR(0)) '--Trim off any trailing ASCII zeroes
NEXT i
'--Gather conditional data
'--transpose conditional data from its dumb-as-toast non-int-aligned location
DIM condtemp as string
DIM condbuf(20) as integer
condtemp = STRING(42, 0)
array2str boxbuf(), 305, condtemp
str2array condtemp, condbuf(), 0
'--Get conditional data
DIM maxhero as integer = gen(genMaxHero)
.instead_tag = bound(condbuf(0), -max_tag(), max_tag())
.instead = bound(condbuf(1), -32767, gen(genMaxTextbox))
.settag_tag = bound(condbuf(2), -max_tag(), max_tag())
.settag1 = bound(condbuf(3), -max_tag(), max_tag())
.settag2 = bound(condbuf(4), -max_tag(), max_tag())
.battle_tag = bound(condbuf(5), -max_tag(), max_tag())
.battle = bound(condbuf(6), 0, gen(genMaxFormation))
.shop_tag = bound(condbuf(7), -max_tag(), max_tag())
.shop = bound(condbuf(8), -32000, gen(genMaxShop) + 1)
.hero_tag = bound(condbuf(9), -max_tag(), max_tag())
.hero_addrem = bound(condbuf(10), -maxhero - 1, maxhero + 1)
.after_tag = bound(condbuf(11), -max_tag(), max_tag())
.after = bound(condbuf(12), -32767, gen(genMaxTextbox))
.money_tag = bound(condbuf(13), -max_tag(), max_tag())
.money = bound(condbuf(14), -32000, 32000)
.door_tag = bound(condbuf(15), -max_tag(), max_tag())
.door = bound(condbuf(16), 0, maxDoorsPerMap)
.item_tag = bound(condbuf(17), -max_tag(), max_tag())
.item = bound(condbuf(18), -gen(genMaxItem) - 1, gen(genMaxItem) + 1)
.hero_swap = bound(condbuf(19), -maxhero - 1, maxhero + 1)
.hero_lock = bound(condbuf(20), -maxhero - 1, maxhero + 1)
.menu_tag = bound(boxbuf(192), -max_tag(), max_tag())
.menu = bound(boxbuf(199), 0, gen(genMaxMenu))
.game_tag = bound(boxbuf(207), -max_tag(), max_tag())
.game_delete = bound(boxbuf(208), -1, maxSaveSlotCount)
.game_save = bound(boxbuf(209), -2, maxSaveSlotCount)
.game_load = bound(boxbuf(210), -3, maxSaveSlotCount)
'--Get box bitsets
.choice_enabled = xreadbit(boxbuf(), 0, 174)
.no_box = xreadbit(boxbuf(), 1, 174)
.opaque = xreadbit(boxbuf(), 2, 174)
.restore_music = xreadbit(boxbuf(), 3, 174)
.portrait_box = xreadbit(boxbuf(), 4, 174)
.stop_sound_after = xreadbit(boxbuf(), 5, 174)
.backdrop_trans = xreadbit(boxbuf(), 6, 174)
'--Get choicebox data
FOR i = 0 TO 1
.choice(i) = STRING(15, 0)
array2str boxbuf(), 349 + (i * 18), .choice(i)
.choice(i) = RTRIM(.choice(i), CHR(0)) 'Trim off trailing ASCII zeroes
.choice_tag(i) = boxbuf(182 + (i * 9))
NEXT i
'--Get box appearance
.vertical_offset = boxbuf(193)
.shrink = boxbuf(194)
.textcolor = boxbuf(195) ' 0=default
.boxstyle = boxbuf(196)
.backdrop = boxbuf(197) ' +1
.music = boxbuf(198) ' +1
.sound_effect = boxbuf(205) ' +1
.line_sound = boxbuf(206) ' +1, 0=default, -1=none
'--Get portrait data
.portrait_type = boxbuf(200)
.portrait_id = boxbuf(201)
.portrait_pal = boxbuf(202)
.portrait_pos.x = boxbuf(203)
.portrait_pos.y = boxbuf(204)
END WITH
END SUB
SUB SaveTextBox (byref box as TextBox, byval record as integer)
DIM boxbuf(dimbinsize(binSAY)) as integer
IF record < 0 OR record > gen(genMaxTextBox) THEN debug "SaveTextBox: invalid record: " & record : EXIT SUB
DIM filename as string
filename = game & ".say"
DIM i as integer
WITH box
'--Transcribe lines of text into the buffer
IF UBOUND(.text) > 7 THEN showbug "Can't save all textbox lines"
FOR i = 0 TO 7
DIM tline as string = IIF(i <= UBOUND(.text), .text(i), "")
str2array rpad(tline, CHR(0), 38, clipRight), boxbuf(), i * 38
NEXT i
'--Transcribe conditional data
DIM condbuf(20) as integer
condbuf(0) = .instead_tag
condbuf(1) = .instead
condbuf(2) = .settag_tag
condbuf(3) = .settag1
condbuf(4) = .settag2
condbuf(5) = .battle_tag
condbuf(6) = .battle
condbuf(7) = .shop_tag
condbuf(8) = .shop
condbuf(9) = .hero_tag
condbuf(10) = .hero_addrem
condbuf(11) = .after_tag
condbuf(12) = .after
condbuf(13) = .money_tag
condbuf(14) = .money
condbuf(15) = .door_tag
condbuf(16) = .door
condbuf(17) = .item_tag
condbuf(18) = .item
condbuf(19) = .hero_swap
condbuf(20) = .hero_lock
DIM condtemp as string
condtemp = STRING(42, 0)
array2str condbuf(), 0, condtemp
str2array condtemp, boxbuf(), 305
boxbuf(192) = .menu_tag
boxbuf(199) = .menu
boxbuf(207) = .game_tag
boxbuf(208) = .game_delete
boxbuf(209) = .game_save
boxbuf(210) = .game_load
'--Save bitsets
setbit boxbuf(), 174, 0, .choice_enabled
setbit boxbuf(), 174, 1, .no_box
setbit boxbuf(), 174, 2, .opaque
setbit boxbuf(), 174, 3, .restore_music
setbit boxbuf(), 174, 4, .portrait_box
setbit boxbuf(), 174, 5, .stop_sound_after
setbit boxbuf(), 174, 6, .backdrop_trans
setbit boxbuf(), 174, 7, NO 'Unused
'--Transcribe choice text
FOR i = 0 TO 1
str2array rpad(.choice(i), CHR(0), 15, clipRight), boxbuf(), 349 + (i * 18)
'Also save choice tags
boxbuf(182 + (i * 9)) = .choice_tag(i)
NEXT i
'--Save box appearance
boxbuf(193) = .vertical_offset
boxbuf(194) = .shrink
boxbuf(195) = .textcolor ' 0=default
boxbuf(196) = .boxstyle
boxbuf(197) = .backdrop ' +1
boxbuf(198) = .music ' +1
boxbuf(205) = .sound_effect ' +1
boxbuf(206) = .line_sound ' +1, 0=default, -1=none
'--Save portrait data
boxbuf(200) = .portrait_type
boxbuf(201) = .portrait_id
boxbuf(202) = .portrait_pal
boxbuf(203) = .portrait_pos.x
boxbuf(204) = .portrait_pos.y
END WITH
storerecord boxbuf(), filename, getbinsize(binSAY) \ 2, record
END SUB
SUB ClearTextBox (byref box as TextBox)
box.Destructor()
box.Constructor()
END SUB
'Concatenate textbox lines into a string. Preserves all whitespace.
FUNCTION textbox_lines_to_string(byref box as TextBox, join_char as string = !"\n") as string
DIM ret as string
FOR idx as integer = 0 TO text_box_last_line(box)
IF idx > 0 THEN ret &= join_char
ret &= box.text(idx)
NEXT
RETURN ret
END FUNCTION
'Concatenate textbox lines into a string, removing whitespace and truncating.
' maxwidth is in pixels
FUNCTION textbox_preview_line(boxnum as integer, maxwidth as integer = 700) as string
IF boxnum <= 0 OR boxnum > gen(genMaxTextBox) THEN RETURN ""
DIM box as TextBox
LoadTextBox box, boxnum
RETURN textbox_preview_line(box, maxwidth)
END FUNCTION
FUNCTION textbox_preview_line(box as TextBox, maxwidth as integer = 700) as string
DIM ret as string
FOR i as integer = 0 TO UBOUND(box.text)
IF LEN(ret) THEN ret &= " "
ret &= TRIM(box.text(i))
'IF textwidth(ret) >= maxwidth THEN EXIT FOR 'FIXME: disabled for now because textwidth is slow
IF LEN(ret) * 8 >= maxwidth THEN EXIT FOR
NEXT i
ret = RTRIM(ret) ' Remove spaces due to trailing blank lines
RETURN text_left(ret, maxwidth, YES, NO) 'ellipsis=YES, withtags=NO
END FUNCTION
'==========================================================================================
' Attacks
'==========================================================================================
SUB initattackdata OVERLOAD (recbuf() as integer)
flusharray recbuf(), UBOUND(recbuf)
recbuf(1) = -1 '.pal = -1 (AtkDatPal)
recbuf(314) = -1 '.wep_pal = -1 (AtkDatWepPal)
IF getfixbit(fixAttackMultipliers) = 1 THEN
'Only initialise these data fields if we are using the new format!
recbuf(337) = 20 '.randomization = 20
SerSingle(recbuf(), 325, 1.0) '.acc_mult = 1.0
SerSingle(recbuf(), 327, 1.0) '.dog_mult = 1.0
SerSingle(recbuf(), 329, 1.0) '.atk_mult = 1.0
SerSingle(recbuf(), 331, 1.0) '.def_mult = 1.0
SerSingle(recbuf(), 335, 1.0) '.absorb_rate = 1.0
END IF
END SUB
SUB initattackdata OVERLOAD (byref atkdat as AttackData)
DIM buf(40 + dimbinsize(binATTACK)) as integer
initattackdata buf()
convertattackdata buf(), atkdat
END SUB
SUB loadoldattackdata (array() as integer, byval index as integer)
loadrecord array(), game & ".dt6", 40, index
END SUB
SUB saveoldattackdata (array() as integer, byval index as integer)
storerecord array(), game & ".dt6", 40, index
END SUB
SUB loadnewattackdata (array() as integer, byval index as integer)
DIM size as integer = getbinsize(binATTACK) \ 2
IF size > 0 THEN
loadrecord array(), workingdir + SLASH + "attack.bin", size, index
END IF
END SUB
SUB savenewattackdata (array() as integer, byval index as integer)
DIM size as integer = getbinsize(binATTACK) \ 2
IF size > 0 THEN
storerecord array(), workingdir + SLASH + "attack.bin", size, index
END IF
END SUB
SUB loadattackdata (array() as integer, byval index as integer)
loadoldattackdata array(), index
DIM size as integer = getbinsize(binATTACK) \ 2 'size of record in RPG file
IF size > 0 THEN
DIM buf(size - 1) as integer
loadnewattackdata buf(), index
FOR i as integer = 0 TO size - 1
array(40 + i) = buf(i)
NEXT i
END IF
END SUB
SUB loadattackchain (byref ch as AttackDataChain, buf() as integer, byval id_offset as integer, byval rate_offset as integer, byval mode_offset as integer, byval val1_offset as integer, byval val2_offset as integer, byval bits_offset as integer)
ch.atk_id = buf(id_offset)
ch.rate = buf(rate_offset)
ch.mode = buf(mode_offset)
ch.val1 = buf(val1_offset)
ch.val2 = buf(val2_offset)
ch.must_know = xreadbit(buf(), 0, bits_offset)
ch.no_delay = xreadbit(buf(), 1, bits_offset)
ch.nonblocking = xreadbit(buf(), 2, bits_offset)
ch.dont_retarget = xreadbit(buf(), 3, bits_offset)
ch.invert_condition = xreadbit(buf(), 4, bits_offset)
END SUB
SUB loadoldattackelementalfail (byref cond as AttackElementCondition, buf() as integer, byval element as integer)
WITH cond
IF element < 8 THEN
IF xreadbit(buf(), 21+element, 20) THEN 'atkdat.fail_vs_elemental_resistance(element)
.comp = compLt '< 100% damage
.value = 1.00
ELSE
.comp = compNone
END IF
ELSEIF element < 16 THEN
IF xreadbit(buf(), 21+element, 20) THEN 'atkdat.fail_vs_monster_type(element - 8)
.comp = compGt '> 100% damage from "enemytype#-killer"
.value = 1.00
ELSE
.comp = compNone
END IF
ELSE
.comp = compNone
END IF
END WITH
END SUB
SUB SerAttackElementCond (cond as AttackElementCondition, buf() as integer, byval index as integer)
buf(index) = cond.comp
SerSingle buf(), index + 1, cond.value
END SUB
SUB DeSerAttackElementCond (cond as AttackElementCondition, buf() as integer, byval index as integer)
cond.comp = buf(index)
cond.value = DeSerSingle(buf(), index + 1)
END SUB
SUB loadattackdata (byref atkdat as AttackData, byval index as integer)
DIM buf(40 + dimbinsize(binATTACK)) as integer
loadattackdata buf(), index
convertattackdata buf(), atkdat
atkdat.id = index
END SUB
SUB convertattackdata(buf() as integer, byref atkdat as AttackData)
WITH atkdat
.name = readbadbinstring(buf(), 24, 10, 1)
.description = readbinstring(buf(), 73, 38)
.picture = buf(0)
.pal = buf(1)
.anim_pattern = buf(2)
.targ_class = buf(3)
.targ_set = buf(4)
.damage_math = buf(5)
.aim_math = buf(6)
.base_atk_stat = buf(7)
.base_def_stat = buf(58)
.mp_cost = buf(8)
.hp_cost = buf(9)
.money_cost = buf(10)
.extra_damage = buf(11)
.attacker_anim = buf(14)
.attack_anim = buf(15)
.attack_delay = buf(16)
.turn_delay = buf(319)
.dramatic_pause = buf(320)
.hits = buf(17)
.targ_stat = buf(18)
.prefer_targ = buf(19)
.prefer_targ_stat = buf(100)
.caption_time = buf(36)
.caption = readbinstring(buf(), 37, 38)
.caption_delay = buf(57)
FOR i as integer = 0 TO 1
WITH .tagset(i)
.tag = buf(59 + i*3)
.condition = buf(60 + i*3)
.tagcheck = buf(61 + i*3)
END WITH
NEXT i
FOR i as integer = 0 TO 2
WITH .item(i)
.id = buf(93 + i*2)
.number = buf(94 + i*2)
END WITH
NEXT i
IF getfixbit(fixAttackElementFails) THEN
FOR i as integer = 0 TO gen(genNumElements) - 1
DeSerAttackElementCond .elemental_fail_conds(i), buf(), 121 + i * 3
NEXT
ELSE
FOR i as integer = 0 TO gen(genNumElements) - 1
loadoldattackelementalfail .elemental_fail_conds(i), buf(), i
NEXT
END IF
.sound_effect = buf(99)
.learn_sound_effect = buf(117)
.transmog.enemy = buf(118) - 1
.transmog.hp_rule = buf(119)
.transmog.other_stats_rule = buf(120)
.transmog.rewards_rule = buf(339)
.override_wep_pic = NO
.wep_picture = -1
.wep_pal = -1
IF buf(313) > 0 THEN
.override_wep_pic = YES
.wep_picture = buf(313) - 1
.wep_pal = buf(314)
FOR i as integer = 0 TO 1
.wep_handle(i).x = buf(315 + i * 2)
.wep_handle(i).y = buf(316 + i * 2)
NEXT i
END IF
.base_acc_stat = buf(323)
.base_dog_stat = buf(324)
.acc_mult = DeSerSingle(buf(), 325)
.dog_mult = DeSerSingle(buf(), 327)
.atk_mult = DeSerSingle(buf(), 329)
.def_mult = DeSerSingle(buf(), 331)
.aim_extra = DeSerSingle(buf(), 333)
.absorb_rate = DeSerSingle(buf(), 335)
.randomization = buf(337)
.damage_color = buf(338) '0 for default ot master palette index+1
.counterattack_provoke = buf(340)
.targ_offset_x = buf(344)
.targ_offset_y = buf(345)
.targ_halign = buf(346)
.targ_valign = buf(347)
.change_control = buf(348)
.change_turncoat = buf(349)
.change_defector = buf(350)
.change_flipped = buf(351)
.spawn_enemy = buf(352)
.extra(0) = buf(353)
.extra(1) = buf(354)
.extra(2) = buf(355)
'----Chaining----
loadattackchain .chain, buf(), 12, 13, 101, 102, 103, 104
loadattackchain .elsechain, buf(), 105, 107, 106, 108, 109, 110
loadattackchain .instead, buf(), 111, 113, 112, 114, 115, 116
'----Bitsets----
.cure_instead_of_harm = xreadbit(buf(), 0, 20)
.divide_spread_damage = xreadbit(buf(), 1, 20)
.absorb_damage = xreadbit(buf(), 2, 20)
.unreversable_picture = xreadbit(buf(), 3, 20)
.can_steal_item = xreadbit(buf(), 4, 20)
FOR i as integer = 0 TO small(15, gen(genNumElements) - 1)
.elemental_damage(i) = xreadbit(buf(), 5+i, 20)
NEXT
FOR i as integer = 16 TO gen(genNumElements) - 1
.elemental_damage(i) = xreadbit(buf(), 80+(i-16), 65)
NEXT
'Obsolete:
'FOR i as integer = 0 TO 7
' .fail_vs_elemental_resistance(i) = xreadbit(buf(), 21+i, 20)
' .fail_vs_monster_type(i) = xreadbit(buf(), 29+i, 20)
'NEXT i
FOR i as integer = 0 TO 7
.cannot_target_enemy_slot(i) = xreadbit(buf(), 37+i, 20)
NEXT i
FOR i as integer = 0 TO 3
.cannot_target_hero_slot(i) = xreadbit(buf(), 45+i, 20)
NEXT i
.ignore_extra_hits = xreadbit(buf(), 49, 20)
.erase_rewards = xreadbit(buf(), 50, 20)
.show_damage_without_inflicting = xreadbit(buf(), 51, 20)
.add_store_targ = xreadbit(buf(), 52, 20)
.delete_stored_targs = xreadbit(buf(), 53, 20)
.automatic_targ = xreadbit(buf(), 54, 20)
.show_name = xreadbit(buf(), 55, 20)
.dont_display_damage = xreadbit(buf(), 56, 20)
.reset_targ_stat_before_hit = xreadbit(buf(), 57, 20)
.allow_cure_to_exceed_maximum = xreadbit(buf(), 58, 20)
.useable_outside_battle = xreadbit(buf(), 59, 20)
.obsolete_damage_mp = xreadbit(buf(), 60, 20)
.do_not_randomize = xreadbit(buf(), 61, 20)
.damage_can_be_zero = xreadbit(buf(), 62, 20)
.force_run = xreadbit(buf(), 63, 20)
.mutable = xreadbit(buf(), 0, 65)
.fail_if_targ_poison = xreadbit(buf(), 1, 65)
.fail_if_targ_regen = xreadbit(buf(), 2, 65)
.fail_if_targ_stun = xreadbit(buf(), 3, 65)
.fail_if_targ_mute = xreadbit(buf(), 4, 65)
.percent_damage_not_set = xreadbit(buf(), 5, 65)
.check_costs_as_weapon = xreadbit(buf(), 6, 65)
.no_chain_on_failure = xreadbit(buf(), 7, 65)
.reset_poison = xreadbit(buf(), 8, 65)
.reset_regen = xreadbit(buf(), 9, 65)
.reset_stun = xreadbit(buf(), 10, 65)
.reset_mute = xreadbit(buf(), 11, 65)
.cancel_targets_attack = xreadbit(buf(), 12, 65)
.not_cancellable_by_attacks = xreadbit(buf(), 13, 65)
.no_spawn_on_attack = xreadbit(buf(), 14, 65)
.no_spawn_on_kill = xreadbit(buf(), 15, 65)
.check_costs_as_item = xreadbit(buf(), 16, 65)
.recheck_costs_after_delay = xreadbit(buf(), 17, 65)
.targ_does_not_flinch = xreadbit(buf(), 18, 65)
.do_not_exceed_targ_stat = xreadbit(buf(), 19, 65)
.nonblocking = xreadbit(buf(), 20, 65)
.force_victory = xreadbit(buf(), 21, 65)
.force_battle_exit = xreadbit(buf(), 22, 65)
.never_trigger_elemental_counterattacks = xreadbit(buf(), 23, 65)
.poison_is_negative_regen = xreadbit(buf(), 24, 65)
.useable_inside_battle = NOT xreadbit(buf(), 25, 65)
.dont_display_miss = xreadbit(buf(), 26, 65)
.dont_display_fail = xreadbit(buf(), 27, 65)
.always_hide_attacker = xreadbit(buf(), 28, 65)
.always_unhide_attacker = xreadbit(buf(), 29, 65)
.blocking_counterattack = xreadbit(buf(), 30, 65)
.empty_target_ready_meter = xreadbit(buf(), 31, 65)
.fill_target_ready_meter = xreadbit(buf(), 32, 65)
.exclude_from_hero_auto_battle = xreadbit(buf(), 33, 65)
.ignore_damage_cap = xreadbit(buf(), 34, 65)
.replace_store_targ = xreadbit(buf(), 35, 65)
' If didn't do a full upgrade, then these aren't initialised
IF getfixbit(fixAttackMultipliers) = 0 THEN
.randomization = IIF(.do_not_randomize, 0, 20)
.acc_mult = 1.0
.dog_mult = 1.0
.atk_mult = 1.0
.def_mult = 1.0
.absorb_rate = 1.0
END IF
END WITH
END SUB
SUB saveattackdata (array() as integer, byval index as integer)
saveoldattackdata array(), index
DIM size as integer = curbinsize(binATTACK) \ 2
DIM buf(size - 1) as integer
FOR i as integer = 0 TO size - 1
buf(i) = array(40 + i)
NEXT i
savenewattackdata buf(), index
END SUB
'==========================================================================================
' Tile animation patterns
'==========================================================================================
' Other functions for working with tile animations are in common.rbas
SUB load_tile_anims (byval tileset_num as integer, tanim() as TileAnimPattern)
IF tileset_num < 0 THEN
onetime_debug errShowError, "Corrupt map data: invalid tileset " & tileset_num & " loading animations"
EXIT SUB
END IF
'binTAP is the size of a single animation pattern, not of both patterns for a tileset
DIM tapbuf(dimbinsize(binTAP)) as integer
FOR pattern as integer = 0 TO 1
'It's normal for not all tilesets to have .tap records (short lump) if they weren't edited
loadrecord tapbuf(), game & ".tap", getbinsize(binTAP) \ 2, 2 * tileset_num + pattern, NO
WITH tanim(pattern)
.range_start = tapbuf(0)
.disable_tag = tapbuf(1)
FOR idx as integer = 0 TO 8
.cmd(idx).op = tapbuf(2 + idx)
.cmd(idx).arg = tapbuf(11 + idx)
.cmd(idx).arg2 = tapbuf(20 + idx)
NEXT
.tileset_num = tapbuf(29)
.range_length = tapbuf(30)
.range_stride = tapbuf(31)
'offsets 32-33 reserved
FOR idx as integer = 9 TO maxTileAnimCmds
DIM offset as integer = 34 + 3 * (idx - 9)
.cmd(idx).op = tapbuf(offset)
.cmd(idx).arg = tapbuf(offset + 1)
.cmd(idx).arg2 = tapbuf(offset + 2)
NEXT
IF getfixbit(fixExtendedTileAnims) = 0 THEN
'tapbuf(20) and up are uninitialised
.tileset_num = tileset_num
.range_length = 48
.range_stride = 1
'Previously-full patterns looped without resetting
.cmd(9).op = taopLoop
END IF
END WITH
NEXT
END SUB
SUB save_tile_anims (byval tileset_num as integer, tanim() as TileAnimPattern)
DIM tapbuf(dimbinsize(binTAP)) as integer
FOR pattern as integer = 0 TO 1
WITH tanim(pattern)
'In future these are intended for supporting a variable number of animation
'patterns per tileset, in the same way as menu item records, and maybe shared
'patterns between tilesets, without having to replace .TAP.
'For now it's saved but ignored.
.tileset_num = tileset_num
.range_length = 48
.range_stride = 1
tapbuf(0) = .range_start
tapbuf(1) = .disable_tag
FOR idx as integer = 0 TO 8
tapbuf(2 + idx) = .cmd(idx).op
tapbuf(11 + idx) = .cmd(idx).arg
tapbuf(20 + idx) = .cmd(idx).arg2
NEXT
tapbuf(29) = .tileset_num
tapbuf(30) = .range_length
tapbuf(31) = .range_stride
'offsets 32-33 reserved
FOR idx as integer = 9 TO maxTileAnimCmds
DIM offset as integer = 34 + 3 * (idx - 9)
tapbuf(offset) = .cmd(idx).op
tapbuf(offset + 1) = .cmd(idx).arg
tapbuf(offset + 2) = .cmd(idx).arg2
NEXT
END WITH
storerecord tapbuf(), game & ".tap", getbinsize(binTAP) \ 2, 2 * tileset_num + pattern
NEXT
END SUB
'Returns -1 if not animated, or the pattern number (0 or 1)
FUNCTION tile_anim_pattern_number(tileid as integer) as integer
IF tileid < 160 THEN RETURN -1
RETURN (tileid - 160) \ 48
END FUNCTION
'Given a tile ID which may or may not be animated, return the tile number for the
'non-animated version of the tile (which is the initial tile in the animation)
FUNCTION tile_anim_deanimate_tile (tileid as integer, tanim() as TileAnimPattern) as integer
IF tileid >= 208 THEN tileid = (tileid - 208) + tanim(1).range_start
IF tileid >= 160 THEN tileid = (tileid - 160) + tanim(0).range_start
RETURN tileid
END FUNCTION
'Given a tile ID which may or may not be animated, return the tile number for the
'animated version in one of the animation patterns 0 or 1, or -1 for no animation.
'Returns -1 if the tile can't be animated.
FUNCTION tile_anim_animate_tile (tileid as integer, pattern_num as integer, tanim() as TileAnimPattern) as integer
IF tileid >= 160 THEN
tileid = tile_anim_deanimate_tile(tileid, tanim())
END IF
IF pattern_num = -1 THEN
RETURN tileid
END IF
DIM idoffset as integer
idoffset = tileid - tanim(pattern_num).range_start
IF idoffset < 0 OR idoffset >= 48 THEN
RETURN -1
END IF
RETURN 160 + 48 * pattern_num + idoffset
END FUNCTION
'Which tile a tileid (animated or not) is currently displayed as
FUNCTION tile_anim_current_display_tile(tileid as integer, tileset as TilesetData ptr) as integer
IF tileid < 160 THEN RETURN tileid
RETURN POSMOD(tile_anim_deanimate_tile(tileid, tileset->tanim()) _
+ tileset->tanim_state(tile_anim_pattern_number(tileid)).cycle, 160)
END FUNCTION
'Returns whether one of the tile animation patterns is unused (0 length)
FUNCTION tile_anim_is_empty(pattern_num as integer, tanim() as TileAnimPattern) as bool
'IF first command is 'End of animation'
RETURN tanim(pattern_num).cmd(0).op = 0
END FUNCTION
'==========================================================================================
' 16-color palettes
'==========================================================================================
' Save palette to .pal lump
LOCAL SUB Palette16_save_to_PAL(pal as Palette16 ptr, fname as string, pal_num as integer)
DIM buf(8) as integer
loadrecord buf(), fname, 8, 0
IF buf(0) <> 4444 THEN
showerror "Did not save 16-color palette: pal file appears corrupt"
EXIT SUB
END IF
DIM last as integer = buf(1)
IF pal_num > last THEN
'--blank out palettes before extending file
FOR i as integer = last + 1 TO pal_num
flusharray buf(), 8, 0
storerecord buf(), fname, 8, 1 + i
NEXT i
'--update header
buf(0) = 4444
buf(1) = pal_num
storerecord buf(), fname, 8, 0
END IF
IF pal_num >= 0 THEN '--never write a negative file offset
'Write palette to buffer
flusharray buf(), 8, 0
FOR i as integer = 0 TO 15 STEP 2
buf(i \ 2) = (pal->col(i + 1) SHL 8) + pal->col(i)
NEXT
storerecord buf(), fname, 8, 1 + pal_num
END IF
END SUB
SUB Palette16_save(pal as Palette16 ptr, pal_num as integer)
Palette16_save_to_PAL pal, game & ".pal", pal_num
Palette16_update_cache pal_num
#IF DEFINED(IS_CUSTOM) AND NOT DEFINED(NO_TEST_GAME)
IF channel_to_Game THEN
channel_write_line channel_to_Game, "PAL " & pal_num
END IF
#ENDIF
END SUB
'==========================================================================================
' Spritesheet loading/saving
'==========================================================================================
'Concatenate all the frames of a Frame array end-to-end.
'This is the original spriteset import/export format. Ignores frame ids!
FUNCTION spriteset_to_basic_spritesheet(ss as Frame ptr) as Frame ptr
DIM spritesheet as Frame ptr
spritesheet = frame_new(ss->w * ss->arraylen, ss->h, , YES)
FOR fridx as integer = 0 TO ss->arraylen - 1
frame_draw @ss[fridx], , fridx * ss->w, 0, NO, spritesheet
NEXT
RETURN spritesheet
END FUNCTION
'Cut up a sheet Frame into an Frame array. The sheet may be too large or small and is trimmed/expanded.
FUNCTION split_spritesheet(sheet as Frame ptr, framesize as XYPair, numframes as integer) as Frame ptr
DIM ss as Frame ptr
'IF numframes = -1 THEN numframes = sheet->w \ framesize.w
ss = frame_new(framesize.w, framesize.h, numframes, YES)
FOR fridx as integer = 0 TO ss->arraylen - 1
frame_draw sheet, , -fridx * ss->w, 0, NO, @ss[fridx]
NEXT
RETURN ss
END FUNCTION
'Split up a spriteset in the original import/export format.
FUNCTION spriteset_from_basic_spritesheet(sheet as Frame ptr, sprtype as SpriteType, numframes as integer) as Frame ptr
DIM ss as Frame ptr = split_spritesheet(sheet, XY(large(1, sheet->w \ numframes), sheet->h), numframes)
initialise_backcompat_pt_frameids ss, sprtype
RETURN ss
END FUNCTION
'Load a Frame array from a file
FUNCTION load_spriteset_from_file(file as string, framesize as XYPair, numframes as integer) as Frame ptr
DIM sheet as Frame ptr = image_import_as_frame_8bit(file, master())
DIM ret as Frame ptr
IF sheet THEN
ret = split_spritesheet(sheet, framesize, numframes)
frame_unload @sheet
END IF
RETURN ret
END FUNCTION
'==========================================================================================
' New Graphics Format
'==========================================================================================
'fr must have a number of frames equal to the sprite_sizes(sprtype).frames default
SUB initialise_backcompat_pt_frameids(fr as Frame ptr, sprtype as SpriteType)
' For heroes
STATIC default_pt0_frameids(7) as integer = {0, 1, 100, 101, 200, 300, 400, 500}
' For walkabouts
STATIC default_pt4_frameids(7) as integer = {0, 1, 100, 101, 200, 201, 300, 301}
IF sprtype = sprTypeHero THEN
FOR i as integer = 0 TO 7
fr[i].frameid = default_pt0_frameids(i)
NEXT
ELSEIF sprtype = sprTypeWalkabout THEN
FOR i as integer = 0 TO 7
fr[i].frameid = default_pt4_frameids(i)
NEXT
END IF
END SUB
DIM SHARED box_border_captions(15) as zstring ptr = { _
@"Top Left Corner", @"Top Edge Left", @"Top Edge", @"Top Edge Right", _
@"Top Right Corner", @"Left Edge Top", @"Right Edge Top", @"Left Edge", _
@"Right Edge", @"Left Edge Bottom", @"Right Edge Bottom", @"Bottom Left Corner", _
@"Bottom Edge Left", @"Bottom Edge", @"Bottom Edge Right", @"Bottom Right Corner" _
}
'Initialises info() with the default names of the different frame groups
'(Not used)
SUB default_frame_group_info(sprtype as SpriteType, info() as FrameGroupInfo)
SELECT CASE sprtype
CASE sprTypeHero
REDIM info(5)
info(0).set(0, "Stand/Walk", 2)
info(1).set(100, "Attack", 2)
info(2).set(200, "Cast/Use", 1)
info(3).set(300, "Hurt", 1)
info(4).set(400, "Weak", 1)
info(5).set(500, "Dead", 1)
CASE sprTypeWalkabout
REDIM info(3)
info(0).set(0, "Up", 2)
info(1).set(100, "Right", 2)
info(2).set(200, "Down", 2)
info(3).set(300, "Left", 2)
CASE sprTypeWeapon
REDIM info(0)
info(0).set(0, "", 2)
CASE sprTypeAttack
REDIM info(0)
info(0).set(0, "", 3)
CASE sprTypeBoxBorder
REDIM info(15)
FOR i as integer = 0 TO 15
info(i).set(i, *box_border_captions(i), 1)
NEXT
CASE ELSE
REDIM info(0)
info(0).set(0, "", 1)
END SELECT
END SUB
'==================================== Animations ==========================================
' Appends an "anim" node to parent
SUB save_animation_node(parent as Node ptr, anim as Animation)
DIM anode as Node ptr = AppendChildNode(parent, "anim")
AppendChildNode(anode, "name", anim.name)
IF LEN(anim.variant) THEN AppendChildNode(anode, "variant", anim.variant)
' Add copy of ops
BUG_IF(NodeName(anim.opsnode) <> "ops", "bad opsnode")
DIM ops as Node ptr = CloneNodeTree(anim.opsnode, GetDocument(anode))
AddChild(anode, ops)
' Delete the integer value of each operator node, which was cached there in load_animation_node.
DIM op as Node ptr = FirstChild(ops)
WHILE op
SetContent(op)
op = NextSibling(op)
WEND
END SUB
' Append a new animation, from a "anim" node
SUB load_animation_node(animnode as Node ptr, animset as AnimationSet ptr)
IF animnode."name".exists = NO THEN reporterr "Bad animation data: name missing", serrError : EXIT SUB
IF animnode."ops".exists = NO THEN reporterr "Unsupported animation data: 'ops' missing", serrError : EXIT SUB
DIM anim as Animation ptr
anim = animset->new_animation(animnode."name".string, animnode."variant".string.default(""))
anim->replace_ops(animnode."ops".ptr)
' Lookup each op name, cache it as the integer value of the node
DIM op as Node ptr = FirstChild(anim->opsnode)
WHILE op
DIM optype as AnimOpType = a_find(anim_op_node_names(), NodeName(op))
IF optype = -1 THEN
reporterr "Unsupported animation data: unknown anim op " & NodeName(op), serrError
END IF
SetContent(op, optype)
op = NextSibling(op)
WEND
END SUB
' Add an "animations" child to parent
SUB save_animations_node(parent as Node ptr, animset as AnimationSet ptr)
DIM anims as Node ptr
anims = AppendChildNode(parent, "_animations") 'FIXME: temporary location
FOR idx as integer = 0 TO v_len(animset->animations) - 1
save_animation_node anims, *animset->animations[idx]
NEXT idx
END SUB
' Load from the "animations" node
SUB load_animations_node(parent as Node ptr, animset as AnimationSet ptr)
DIM anims as Node ptr = parent."_animations".ptr 'FIXME: temporary location
animset->delete_all_animations() 'In case called from sprite cache to reload inplace
' May be missing, eg for box borders, older files, (or just no animations?)
IF anims = NULL THEN EXIT SUB
READNODE anims
load_animation_node anims."anim".ptr, animset
END READNODE
END SUB
'==================================== .rgfx Container =====================================
' Note: any .rgfx loading code dealing with the internals of Frame or SpriteSet
' or caching is in allmodex. Utility functions are here.
' Maps from SpriteType to lump name
REDIM rgfx_lumpnames(sprTypeLast) as string
rgfx_lumpnames(sprTypeHero) = "heroes.rgfx"
rgfx_lumpnames(sprTypeEnemy) = "enemies.rgfx"
rgfx_lumpnames(sprTypeSmallEnemy) = "enemies.rgfx"
rgfx_lumpnames(sprTypeMediumEnemy) = "enemies.rgfx"
rgfx_lumpnames(sprTypeLargeEnemy) = "enemies.rgfx"
rgfx_lumpnames(sprTypeWalkabout) = "walkabouts.rgfx"
rgfx_lumpnames(sprTypeAttack) = "attacks.rgfx"
rgfx_lumpnames(sprTypeWeapon) = "weapons.rgfx"
rgfx_lumpnames(sprTypePortrait) = "portraits.rgfx"
rgfx_lumpnames(sprTypeBoxBorder) = "boxborders.rgfx"
rgfx_lumpnames(sprTypeBackdrop) = "backdrops.rgfx"
rgfx_lumpnames(sprTypeTileset) = "tilesets.rgfx" 'Not created or used yet!
rgfx_lumpnames(sprTypeTilesetStrip)= "tilesets.rgfx" 'Not created or used yet!
'Create a blank rgfx document
FUNCTION rgfx_create_doc() as DocPtr
DIM doc as DocPtr
doc = CreateDocument()
DIM as NodePtr root_node, spritesets, sprset
root_node = CreateNode(doc, "rgfx")
SetRootNode(doc, root_node)
AppendChildNode(root_node, "version", CURRENT_RGFX_VERSION)
spritesets = AppendChildNode(root_node, "spritesets")
RETURN doc
END FUNCTION
SUB convert_mxs_to_rgfx(infile as string, outfile as string, sprtype as SpriteType)
DIM as double readstart = TIMER, writestart
DIM num_images as integer = filelen(infile) / 64000 'Round up if at least half a backdrop
'infile might not actually exist - for example in ancient SAMPLE.RPG
num_images = large(1, num_images)
DIM doc as DocPtr
doc = rgfx_create_doc()
FOR imnum as integer = 0 TO num_images - 1
DIM fr as Frame ptr
'frame_load_mxs is uncached
fr = frame_load_mxs(infile, imnum)
IF fr = NULL THEN fr = frame_new(320, 200) 'If .mxs doesn't exist
rgfx_save_spriteset(doc, fr, sprtype, imnum)
frame_unload @fr
NEXT
writestart = TIMER
SerializeBin outfile, doc
FreeDocument doc
debuginfo "Read and converted " & infile & " in " & CINT((writestart - readstart) * 1000) _
& "ms, wrote in " & CINT((TIMER - writestart) * 1000) & "ms"
END SUB
'Convert a .pt# lump to .rgfx. In case of sprTypeEnemy, combines the three .pt# files
SUB convert_pt_to_rgfx(dest_type as SpriteType)
DIM as double readstart = TIMER, writestart
DIM doc as DocPtr
doc = rgfx_create_doc()
DIM as SpriteType first_pt = dest_type, last_pt = dest_type
IF dest_type = sprTypeEnemy THEN
first_pt = sprTypeSmallEnemy
last_pt = sprTypeLargeEnemy
'So that the first appended spriteset is number 0
gen(genMaxEnemyPic) = -1
END IF
FOR sprtype as SpriteType = first_pt to last_pt
IF isfile(graphics_file(rgfx_lumpnames(sprtype))) THEN
showbug "Can't convert PT" & sprtype & ": already done"
EXIT SUB
END IF
DIM lastset as integer = gen(sprite_sizes(sprtype).genmax)
DIM defpals(lastset) as integer
loaddefaultpals sprtype, defpals()
FOR setnum as integer = 0 TO lastset
DIM fr as Frame ptr
'We can use frame_load_uncached here because we haven't saved the .rgfx file yet and it shouldn't exist
fr = frame_load_uncached(sprtype, setnum)
'For sprType{Small,Medium,Large}Enemy rgfx_save_spriteset converts to enemies.rgfx
rgfx_save_spriteset(doc, fr, sprtype, setnum, defpals(setnum))
frame_unload @fr
NEXT
NEXT sprtype
writestart = TIMER
SerializeBin graphics_file(rgfx_lumpnames(dest_type)), doc
FreeDocument doc
debuginfo "Read and converted .pt" & first_pt & "-.pt" & last_pt & " in " & CINT((writestart - readstart) * 1000) _
& "ms, wrote in " & CINT((TIMER - writestart) * 1000) & "ms"
END SUB
'Opens a rgfx document and checks it's in order
FUNCTION rgfx_open(filename as string, expect_exists as bool = NO, options as Reload.LoadOptions = optNone) as DocPtr
IF real_isfile(filename) = NO THEN
IF expect_exists THEN reporterr filename & " not found", serrError
RETURN NULL
END IF
DIM doc as DocPtr
doc = LoadDocument(filename, options)
IF doc = NULL THEN
reporterr "Couldn't open graphics file " & filename, serrError
RETURN NULL
END IF
'Check the file looks OK
DIM errmsg as string
DIM root_node as NodePtr = DocumentRoot(doc)
IF NodeName(root_node) <> "rgfx" THEN
errmsg = "Unexpected root '" & NodeName(root_node) & "' (Not an rgfx file!)"
ELSE 'Can't use nodespec on an ELSEIF line :(
IF root_node."version".default(999) > CURRENT_RGFX_VERSION THEN
errmsg = "Unsupported version " & root_node."version".string & " (Upgrade to a newer OHRRPGCE version)"
ELSE
IF root_node."spritesets".exists = NO THEN
errmsg = "'spritesets' missing"
ELSE
RETURN doc
END IF
END IF
END IF
reporterr "Unsupported graphics file " & trimpath(filename) & " - " & errmsg, serrError
FreeDocument doc
RETURN NULL
END FUNCTION
FUNCTION rgfx_open(sprtype as SpriteType, expect_exists as bool = NO, options as Reload.LoadOptions = optNone) as DocPtr
RETURN rgfx_open(graphics_file(rgfx_lumpnames(sprtype)), expect_exists, options)
END FUNCTION
CONST TRANSLATION_MULT = 1000000
#DEFINE TRANSLATION_KEY(sprtype, setnum) (setnum + (sprtype) * TRANSLATION_MULT)
'Backcompat: all enemy sprites are in one file, this translates from old spriteset num to new one
'Returns -1 if none
FUNCTION read_sprite_idx_backcompat_translation(rgfxdoc as DocPtr, sprtype as SpriteType, oldidx as integer) as integer
DIM ids as Node ptr = GetChildByName(DocumentRoot(rgfxdoc), "backcompat_ids")
IF ids = NULL THEN RETURN -1
'Not an error if it's missing
RETURN ReadKeyValueNode(ids, "key", TRANSLATION_KEY(sprtype, oldidx), -1, "idx")
END FUNCTION
'Backcompat: add a translation from old enemy spriteset num to new one
SUB add_sprite_idx_backcompat_translation(rgfxdoc as DocPtr, sprtype as SpriteType, oldidx as integer, newidx as integer)
DIM ids as Node ptr = GetOrCreateChild(DocumentRoot(rgfxdoc), "backcompat_ids")
SetKeyValueNode(ids, "key", TRANSLATION_KEY(sprtype, oldidx), newidx, "idx")
END SUB
'Returns NULL if animations missing.
'Otherwise, returns loadinto with the animations replaced, or if loadinto=NULL, a new AnimationSet with .refcount=1
FUNCTION rgfx_load_global_animations(rgfxdoc as Doc ptr, loadinto as AnimationSet ptr = NULL) as AnimationSet ptr
DIM root as Node ptr = DocumentRoot(rgfxdoc)
'Global animations may be missing because this sprite type doesn't have animations
IF GetChildByName(root, "_animations") = NULL THEN RETURN NULL 'FIXME: temporary location
IF loadinto = NULL THEN
loadinto = NEW AnimationSet()
'This name will be overridden by spriteset_load_global_animations_uncached, unless these are the
'global animations for some external .rgfx we're reading without caching.
loadinto->name = "Global animations for this .rgfx"
loadinto->reference()
END IF
load_animations_node(root, loadinto)
RETURN loadinto
END FUNCTION
'Number of spriteset nodes (or relevant spriteset nodes, in case of enemy backcompat)
'Needed only for SUB upgrade
FUNCTION rgfx_num_spritesets(rgfxdoc as DocPtr, sprtype as SpriteType) as integer
DIM as NodePtr root_node, spritesets, mappings
IF rgfxdoc = NULL THEN RETURN 0
root_node = DocumentRoot(rgfxdoc)
IF sprtype >= sprTypeSmallEnemy AND sprtype <= sprTypeLargeEnemy THEN
'Look at the backcompat ID mapping to find only spritesets of this type
mappings = root_node."backcompat_ids".ptr
IF mappings = NULL THEN debug "backcompat_ids missing" : RETURN 0 'Maybe we ditched these?
DIM lastrec as integer = -1
DIM ch as NodePtr = FirstChild(mappings, "key")
WHILE ch
DIM key as integer = GetInteger(ch)
IF key \ TRANSLATION_MULT = sprtype THEN
lastrec = large(lastrec, key MOD TRANSLATION_MULT)
END IF
ch = NextSibling(ch, "key")
WEND
RETURN lastrec + 1
ELSE
RETURN NumChildren(root_node."spritesets".ptr)
END IF
END FUNCTION
'Find a "spriteset" node in an .rgfx file, returns NULL if not present
FUNCTION rgfx_find_spriteset(rgfxdoc as DocPtr, sprtype as SpriteType, setnum as integer) as Node ptr
DIM as NodePtr root_node, sprset
IF rgfxdoc = NULL THEN RETURN NULL
root_node = DocumentRoot(rgfxdoc)
'Backcompat: translate to real spriteset id
IF sprtype >= sprTypeSmallEnemy AND sprtype <= sprTypeLargeEnemy THEN
setnum = read_sprite_idx_backcompat_translation(rgfxdoc, sprtype, setnum)
IF setnum < 0 THEN RETURN NULL
END IF
'The spritesets are allowed to be out of order (we can't seek quickly to the right
'one anyway), and we take the last matching one to possible allow appending updated
'versions to end of file
sprset = GetChildByContent(root_node."spritesets".ptr, setnum, "spriteset", YES) 'reverse=YES
RETURN sprset
END FUNCTION
'Uncached load of a SpriteSet/Frame from any .rgfx doc.
'(It is however still refcounted)
'Default palette is not loaded yet.
'cache_def_anims should be NO when loading from an .rgfx file outside of the
'current .rpg and YES otherwise
FUNCTION rgfx_load_spriteset(rgfxdoc as DocPtr, sprtype as SpriteType, setnum as integer, cache_def_anims as bool = YES) as Frame ptr
DIM as Node ptr ss_node, frameset_node
ss_node = rgfx_find_spriteset(rgfxdoc, sprtype, setnum)
IF ss_node = NULL THEN
'Not really an error, yet
debuginfo "rgfx spriteset " & sprtype & "/" & setnum & " missing"
RETURN NULL
END IF
' Frames (only part that isn't optional)
frameset_node = GetChildByName(ss_node, "frameset")
IF frameset_node = NULL THEN
reporterr "Can't load sprite " & setnum & ": missing frameset data", serrError
RETURN NULL
END IF
DIM fr as Frame ptr
fr = frameset_from_node(frameset_node)
IF fr = NULL THEN RETURN fr
'Create SpriteSet & AnimationSet
DIM animset as AnimationSet ptr
animset = spriteset_for_frame(fr)->get_animset()
'Default palette
fr->defpal = ss_node."defpal".default(-1)
animset->name = sprite_sizes(sprtype).name & " spriteset " & setnum & " animations"
'Animations, if they exist
load_animations_node(ss_node, animset)
'Global animations
IF cache_def_anims THEN
'Get from/add to cache
animset->fallback_set = spriteset_load_global_animations(sprtype, rgfxdoc)
ELSE
animset->fallback_set = rgfx_load_global_animations(rgfxdoc)
END IF
RETURN fr
END FUNCTION
'Uncached load of a SpriteSet/Frame from a standard .rgfx lump
'(It is however still refcounted)
FUNCTION rgfx_load_spriteset(sprtype as SpriteType, setnum as integer, expect_exists as bool = YES) as Frame ptr
DIM rgfxdoc as Doc ptr = rgfx_open(sprtype, expect_exists)
IF rgfxdoc = NULL THEN RETURN NULL
DIM ret as Frame ptr
ret = rgfx_load_spriteset(rgfxdoc, sprtype, setnum, YES)
FreeDocument rgfxdoc
RETURN ret
END FUNCTION
'defpal overrides fr->defpal
SUB rgfx_save_spriteset(rgfxdoc as DocPtr, fr as Frame ptr, sprtype as SpriteType, setnum as integer, defpal as integer = -1)
DIM as Node ptr ss_node, root_node, frameset_node
root_node = DocumentRoot(rgfxdoc)
'Find/create "spriteset" node
ss_node = rgfx_find_spriteset(rgfxdoc, sprtype, setnum)
if ss_node then
FreeChildren ss_node
ELSE
IF sprtype >= sprTypeSmallEnemy AND sprtype <= sprTypeLargeEnemy THEN
'Append a new enemy sprite
gen(genMaxEnemyPic) += 1
DIM real_setnum as integer = gen(genMaxEnemyPic)
add_sprite_idx_backcompat_translation(rgfxdoc, sprtype, setnum, real_setnum)
setnum = real_setnum
END IF
ss_node = AppendChildNode(root_node."spritesets".ptr, "spriteset", setnum)
END IF
'Frames
frameset_to_node fr, ss_node
'Default palette
IF defpal = -1 THEN defpal = fr->defpal 'This might also be -1
IF defpal > -1 THEN
AppendChildNode(ss_node, "defpal", defpal)
END IF
'Animations
IF fr->sprset THEN
DIM animset as AnimationSet ptr = fr->sprset->animset
IF animset THEN
IF v_len(animset->animations) > 0 THEN
save_animations_node ss_node, animset
END IF
END IF
ELSE
'This happens because SpriteSetBrowser needs fixing; it currently wipes animations in some cases
debug "suspicious rgfx_save_spriteset with no SpriteSet"
END IF
'Extra info
IF sprtype >= sprTypeSmallEnemy AND sprtype <= sprTypeLargeEnemy THEN
AppendChildNode(ss_node, "info", sprite_sizes(sprtype).name & " " & setnum)
END IF
'fr is likely in the sprite cache, and may have been modified. Now's a good time to mark it modified.
fr->generation += 1
END SUB
SUB rgfx_save_spriteset(fr as Frame ptr, sprtype as SpriteType, setnum as integer, defpal as integer = -1)
DIM rgfxdoc as Doc ptr = rgfx_open(sprtype, YES, optNoDelay)
IF rgfxdoc = NULL THEN EXIT SUB
rgfx_save_spriteset(rgfxdoc, fr, sprtype, setnum, defpal)
SerializeBin graphics_file(rgfx_lumpnames(sprtype)), rgfxdoc
FreeDocument rgfxdoc
END SUB
'Save the cached global animations (accessed via any loaded SpriteSet)
SUB rgfx_save_global_animations(sprtype as SpriteType)
DIM rgfxdoc as Doc ptr = rgfx_open(sprtype, YES, optNoDelay)
IF rgfxdoc = NULL THEN EXIT SUB
'If no sprtype sprite has ever been loaded, this would load from rgfxdoc or generate defaults
DIM animset as AnimationSet ptr = spriteset_load_global_animations(sprtype, rgfxdoc)
rgfx_save_global_animations(rgfxdoc, animset)
animset_unload @animset
SerializeBin graphics_file(rgfx_lumpnames(sprtype)), rgfxdoc
FreeDocument rgfxdoc
END SUB
SUB rgfx_save_global_animations(rgfxdoc as DocPtr, animset as AnimationSet ptr)
DIM root_node as Node ptr = DocumentRoot(rgfxdoc)
FreeChildNode root_node, "_animations" 'If it exists FIXME: temporary location
save_animations_node root_node, animset
END SUB
'==========================================================================================
' Items
'==========================================================================================
SUB loaditemdata (array() as integer, byval index as integer)
flusharray array(), dimbinsize(binITM), 0
IF index > gen(genMaxItem) THEN debug "loaditemdata:" & index & " out of range" : EXIT SUB
IF loadrecord(array(), game & ".itm", getbinsize(binITM) \ 2, index) = NO THEN
debug "loaditemdata:" & index & " loadrecord failed"
EXIT SUB
END IF
'Auto-update equipability bits if needed
IF NOT xreadbit(array(), 15, 239) THEN
IF array(49) > 0 ANDALSO array(49) <= 5 THEN
setbit array(), 239, array(49) - 1, 1
END IF
'Mark the bits as being initialized
setbit array(), 239, 15, 1
END IF
END SUB
'Fill in a ItemDefTags from an ITM record
SUB item_tags_from_buf(tags as ItemDefTags, itembuf() as integer)
tags.have_tag = itembuf(74)
tags.in_inventory_tag = itembuf(75)
tags.is_equipped_tag = itembuf(76)
tags.is_actively_equipped_tag = itembuf(77)
END SUB
FUNCTION item_is_equippable(itembuf() as integer) as bool
FOR i as integer = 0 TO 4
IF item_is_equippable_in_slot(itembuf(), i) THEN RETURN YES
NEXT i
RETURN NO
END FUNCTION
FUNCTION item_is_equippable_in_slot(itembuf() as integer, byval slot as integer) as bool
RETURN xreadbit(itembuf(), slot, 239)
END FUNCTION
SUB loaditemdata (item as ItemDef, item_id as integer)
DIM itembuf(dimbinsize(binITM)) as integer
loaditemdata itembuf(), item_id
WITH item
.name = readbadbinstring(itembuf(), 0, 8)
.info = readbadbinstring(itembuf(), 9, 36)
.stacksize = itembuf(210)
.wep_pic = itembuf(52)
.wep_pal = itembuf(53)
FOR i as integer = 0 TO 1
'Second handle point is before the first one!
.wep_handle(i).x = itembuf(80 - i * 2)
.wep_handle(i).y = itembuf(81 - i * 2)
NEXT
item_tags_from_buf .tags, itembuf()
FOR i as integer = 0 TO 4
.eqslots(i) = xreadbit(itembuf(), 239, i)
NEXT i
'TODO: very incomplete!
END WITH
END SUB
SUB saveitemdata (array() as integer, byval index as integer)
'Back-port the first equip slot
'We do not support downgrading, but it does not hurt to minimize the damage of downgrading
IF xreadbit(array(), 15, 239) THEN
array(49) = 0
FOR i as integer = 0 TO 4
IF xreadbit(array(), i, 239) THEN
array(49) = i + 1
EXIT FOR
END IF
NEXT i
END IF
'Actually write the itm lump
storerecord array(), game & ".itm", getbinsize(binITM) \ 2, index
END SUB
FUNCTION LoadOldItemElemental (itembuf() as integer, byval element as integer) as single
IF element < 8 THEN
RETURN backcompat_element_dmg(readbit(itembuf(), 70, element), readbit(itembuf(), 70, 8 + element), readbit(itembuf(), 70, 16 + element))
ELSE
RETURN 1.0f
END IF
END FUNCTION
SUB LoadItemElementals (byval index as integer, itemresists() as single)
DIM itembuf(dimbinsize(binITM)) as integer
loaditemdata itembuf(), index
REDIM itemresists(gen(genNumElements) - 1)
IF getfixbit(fixItemElementals) THEN
FOR i as integer = 0 TO gen(genNumElements) - 1
itemresists(i) = DeSerSingle(itembuf(), 82 + i * 2)
NEXT
ELSE
FOR i as integer = 0 TO gen(genNumElements) - 1
itemresists(i) = LoadOldItemElemental(itembuf(), i)
NEXT
END IF
END SUB
FUNCTION get_item_stack_size (byval item_id as integer) as integer
DIM item as ItemDef
loaditemdata item, item_id
RETURN IIF(item.stacksize, item.stacksize, gen(genItemStackSize))
END FUNCTION
' Read one of the 'Equippable by' bits
FUNCTION item_read_equipbit(itembuf() as integer, hero_id as integer) as bool
IF hero_id < 64 THEN
RETURN xreadbit(itembuf(), hero_id, 66)
ELSE
RETURN xreadbit(itembuf(), hero_id - 64, 211)
END IF
END FUNCTION
' Write one of the 'Equippable by' bits
SUB item_write_equipbit(itembuf() as integer, hero_id as integer, value as bool)
IF hero_id < 64 THEN
setbit itembuf(), 66, hero_id, value
ELSE
setbit itembuf(), 211, hero_id - 64, value
END IF
END SUB
'==========================================================================================
' Enemies
'==========================================================================================
FUNCTION backcompat_element_dmg(byval weak as integer, byval strong as integer, byval absorb as integer) as double
DIM dmg as double = 1.0
IF weak THEN dmg *= 2
IF strong THEN dmg *= 0.12
IF absorb THEN dmg = -dmg
RETURN dmg
END FUNCTION
FUNCTION loadoldenemyresist(array() as integer, byval element as integer) as single
IF element < 8 THEN
DIM as integer weak, strong, absorb
weak = xreadbit(array(), 0 + element, 74)
strong = xreadbit(array(), 8 + element, 74)
absorb = xreadbit(array(), 16 + element, 74)
RETURN backcompat_element_dmg(weak, strong, absorb)
ELSEIF element < 16 THEN
DIM as integer enemytype
enemytype = xreadbit(array(), 24 + (element - 8), 74)
RETURN IIF(enemytype, 1.8f, 1.0f)
ELSE
RETURN 1.0f
END IF
END FUNCTION
CONSTRUCTOR EnemyDef()
pal = -1 'default palette
spawn.how_many = 1
'--elemental resists
FOR i as integer = 0 TO maxElements - 1
elementals(i) = 1.0f
NEXT
END CONSTRUCTOR
SUB clearenemydata (enemy as EnemyDef)
enemy.Destructor()
enemy.Constructor()
END SUB
SUB clearenemydata (buf() as integer)
flusharray buf(), dimbinsize(binDT1)
buf(54) = -1 'default palette
buf(91) = 1 'how many to spawn
'--elemental resists
FOR i as integer = 0 TO 63 'maxElements - 1
SerSingle buf(), 239 + i*2, 1.0f
NEXT
END SUB
'Game makes a temp copy of the .dt1 file to allow modifications. `altfile` can
'be used to override the default behaviour of whether to read this file, but
'should be left as its default nearly always.
'Note that this form of loadenemydata does not do fixEnemyElementals fixes!
'Don't use this anywhere in Game where those need to be applied! (Of course,
'you probably would never use this in Game... except "read enemy data")
SUB loadenemydata (array() as integer, byval index as integer, byval altfile as bool = USE_DT1_TMP)
#IFDEF IS_CUSTOM
IF altfile THEN showbug "loadenemydata: no .dt1.tmp in Custom"
altfile = NO
#ENDIF
DIM filename as string
IF altfile THEN
filename = tmpdir & "dt1.tmp"
ELSE
filename = game & ".dt1"
END IF
loadrecord array(), filename, getbinsize(binDT1) \ 2, index
END SUB
SUB loadenemydata (enemy as EnemyDef, byval index as integer, byval altfile as bool = USE_DT1_TMP)
DIM buf(dimbinsize(binDT1)) as integer
loadenemydata buf(), index, altfile
convertenemydata buf(), enemy
END SUB
SUB convertenemydata (buf() as integer, enemy as EnemyDef)
WITH enemy
.name = readbadbinstring(buf(), 0, 16)
.steal.thievability = buf(17)
.steal.item = buf(18)
.steal.item_rate = buf(19)
.steal.rare_item = buf(20)
.steal.rare_item_rate = buf(21)
IF getfixbit(fixDefaultDissolveEnemy) THEN
.dissolve = buf(22)
.dissolve_length = buf(23)
ELSE
' Initialise. (Used by upgrade())
.dissolve = 0
.dissolve_length = 0
END IF
.dissolve_in = buf(369)
.dissolve_in_length = buf(370)
.death_sound = buf(24)
.cursor_offset.x = buf(25)
.cursor_offset.y = buf(26)
.pic = buf(53)
.pal = buf(54)
.size = buf(55)
.reward.gold = buf(56)
.reward.exper = buf(57)
.reward.item = buf(58)
.reward.item_rate = buf(59)
.reward.rare_item = buf(60)
.reward.rare_item_rate = buf(61)
FOR i as integer = 0 TO UBOUND(.stat.sta)
.stat.sta(i) = buf(62 + i)
NEXT i
'--bitsets
.harmed_by_cure = xreadbit(buf(), 54, 74)
.mp_idiot = xreadbit(buf(), 55, 74)
.is_boss = xreadbit(buf(), 56, 74)
.unescapable = xreadbit(buf(), 57, 74)
.die_without_boss = xreadbit(buf(), 58, 74)
.flee_instead_of_die = xreadbit(buf(), 59, 74)
.enemy_untargetable = xreadbit(buf(), 60, 74)
.hero_untargetable = xreadbit(buf(), 61, 74)
.death_unneeded = xreadbit(buf(), 62, 74)
.never_flinch = xreadbit(buf(), 63, 74)
.ignore_for_alone = xreadbit(buf(), 64, 74)
.give_rewards_even_if_alive = xreadbit(buf(), 65, 74)
.controlled_by_player = xreadbit(buf(), 66, 74)
.turncoat_attacker = xreadbit(buf(), 67, 74)
.defector_target = xreadbit(buf(), 68, 74)
'--elementals
IF getfixbit(fixEnemyElementals) THEN
FOR i as integer = 0 TO gen(genNumElements) - 1
.elementals(i) = DeSerSingle(buf(), 239 + i*2)
NEXT
ELSE
' Perform upgrade of old weak/strong/absorb/enemytype bits (Used by upgrade())
' The old bits will NOT be written by saveenemydata and will be lost,
' the fixbit must be set after writing!
FOR i as integer = 0 TO gen(genNumElements) - 1
.elementals(i) = loadoldenemyresist(buf(), i)
NEXT
END IF
'--spawning
.spawn.on_death = buf(79)
.spawn.non_elemental_death = buf(80)
.spawn.when_alone = buf(81)
.spawn.non_elemental_hit = buf(82)
FOR i as integer = 0 TO gen(genNumElements) - 1
IF i <= 7 THEN
.spawn.elemental_hit(i) = buf(83 + i)
ELSE
.spawn.elemental_hit(i) = buf(183 + (i - 8))
END IF
NEXT i
.spawn.how_many = buf(91)
.spawn.all_elements_on_hit = buf(371) <> 0 'Lossy if this field is expanded later!
'--attacks
FOR i as integer = 0 TO 4
.regular_ai(i) = buf(92 + i)
.desperation_ai(i) = buf(97 + i)
.alone_ai(i) = buf(102 + i)
NEXT i
'--counter-attacks
FOR i as integer = 0 TO gen(genNumElements) - 1
IF i <= 7 THEN
.elem_counter_attack(i) = buf(107 + i)
ELSE
.elem_counter_attack(i) = buf(127 + (i - 8))
END IF
NEXT i
FOR i as integer = 0 TO 11
.stat_counter_attack(i) = buf(115 + i)
NEXT i
.bequest_attack = buf(367)
.non_elem_counter_attack = buf(368)
''Print bequest attacks and non-elemental counters to the debug log for James's
''convenience when repairing people's games after the dwimmercrafty dataloss bug
'if .bequest_attack > 0 then
' debug index & " " & .name & " bequest = " & .bequest_attack - 1 & " " & readattackname(.bequest_attack - 1)
'end if
'if .non_elem_counter_attack > 0 then
' debug index & " " & .name & " non-elem = " & .non_elem_counter_attack - 1 & " " & readattackname(.non_elem_counter_attack - 1)
'end if
END WITH
END SUB
'Game makes a temp copy of the .dt1 file to allow modifications. `altfile` can
'be used to override the default behaviour of whether to read this file, but
'should be left as its default nearly always.
SUB saveenemydata (array() as integer, byval index as integer, byval altfile as bool = USE_DT1_TMP)
#IFDEF IS_CUSTOM
IF altfile THEN showbug "saveenemydata: no .dt1.tmp in Custom"
altfile = NO
#ENDIF
DIM filename as string
IF altfile THEN
filename = tmpdir & "dt1.tmp"
ELSE
filename = game & ".dt1"
END IF
storerecord array(), filename, getbinsize(binDT1) \ 2, index
END SUB
SUB saveenemydata (enemy as EnemyDef, byval index as integer, byval altfile as bool = USE_DT1_TMP)
DIM buf(dimbinsize(binDT1)) as integer
WITH enemy
writebadbinstring(.name, buf(), 0, 16)
buf(17) = .steal.thievability
buf(18) = .steal.item
buf(19) = .steal.item_rate
buf(20) = .steal.rare_item
buf(21) = .steal.rare_item_rate
buf(22) = .dissolve
buf(23) = .dissolve_length
buf(369) = .dissolve_in
buf(370) = .dissolve_in_length
buf(24) = .death_sound
buf(25) = .cursor_offset.x
buf(26) = .cursor_offset.y
buf(53) = .pic
buf(54) = .pal
buf(55) = .size
buf(56) = .reward.gold
buf(57) = .reward.exper
buf(58) = .reward.item
buf(59) = .reward.item_rate
buf(60) = .reward.rare_item
buf(61) = .reward.rare_item_rate
FOR i as integer = 0 TO UBOUND(.stat.sta)
buf(62 + i) = .stat.sta(i)
NEXT i
'--bitsets
setbit buf(), 74, 54, .harmed_by_cure
setbit buf(), 74, 55, .mp_idiot
setbit buf(), 74, 56, .is_boss
setbit buf(), 74, 57, .unescapable
setbit buf(), 74, 58, .die_without_boss
setbit buf(), 74, 59, .flee_instead_of_die
setbit buf(), 74, 60, .enemy_untargetable
setbit buf(), 74, 61, .hero_untargetable
setbit buf(), 74, 62, .death_unneeded
setbit buf(), 74, 63, .never_flinch
setbit buf(), 74, 64, .ignore_for_alone
setbit buf(), 74, 65, .give_rewards_even_if_alive
setbit buf(), 74, 66, .controlled_by_player
setbit buf(), 74, 67, .turncoat_attacker
setbit buf(), 74, 68, .defector_target
'--spawning
buf(79) = .spawn.on_death
buf(80) = .spawn.non_elemental_death
buf(81) = .spawn.when_alone
buf(82) = .spawn.non_elemental_hit
'Blank out unused spawns to be save: don't want to have to zero stuff out
'if gen(genNumElements) increases
FOR i as integer = gen(genNumElements) TO maxElements - 1
.spawn.elemental_hit(i) = 0
NEXT
FOR i as integer = 0 TO 7
buf(83 + i) = .spawn.elemental_hit(i)
NEXT i
FOR i as integer = 8 TO 63
buf(183 + (i - 8)) = .spawn.elemental_hit(i)
NEXT i
buf(91) = .spawn.how_many
buf(371) = IIF(.spawn.all_elements_on_hit, 1, 0)
'--attacks
FOR i as integer = 0 TO 4
buf(92 + i) = .regular_ai(i)
buf(97 + i) = .desperation_ai(i)
buf(102 + i) = .alone_ai(i)
NEXT i
'--counter attacks
FOR i as integer = gen(genNumElements) TO 63
.elem_counter_attack(i) = 0
NEXT
FOR i as integer = 0 TO 7
buf(107 + i) = .elem_counter_attack(i)
NEXT
FOR i as integer = 8 TO 63
buf(127 + (i - 8)) = .elem_counter_attack(i)
NEXT i
FOR i as integer = 0 TO 11
buf(115 + i) = .stat_counter_attack(i)
NEXT i
'--elemental resists
FOR i as integer = 0 TO 63
DIM outval as single = 1.0f
IF i < gen(genNumElements) THEN
outval = .elementals(i)
END IF
SerSingle buf(), 239 + i*2, outval
NEXT
buf(367) = .bequest_attack
buf(368) = .non_elem_counter_attack
END WITH
saveenemydata buf(), index, altfile
END SUB
'==========================================================================================
' Formations & Formation Sets
'==========================================================================================
CONSTRUCTOR Formation()
music = gen(genBatMus) - 1
END CONSTRUCTOR
'This stub exists only so noone forgets to update ClearFormation if Formation gains a destructor later
DESTRUCTOR Formation()
END DESTRUCTOR
SUB ClearFormation (form as Formation)
form.Destructor()
form.Constructor()
END SUB
SUB LoadFormation (form as Formation, byval index as integer)
#IFDEF IS_GAME
LoadFormation form, tmpdir & "for.tmp", index
#ELSE
LoadFormation form, game & ".for", index
#ENDIF
END SUB
SUB LoadFormation (form as Formation, filename as string, byval index as integer)
DIM formdata(39) as integer
IF loadrecord(formdata(), filename, 40, index) = NO THEN
debug "LoadFormation: invalid index " & index
ClearFormation form
EXIT SUB
END IF
WITH form
FOR i as integer = 0 TO 7
.slots(i).id = formdata(i * 4) - 1
.slots(i).pos.x = formdata(i * 4 + 1)
.slots(i).pos.y = formdata(i * 4 + 2)
NEXT
.background = formdata(32)
.music = formdata(33) - 1
.background_frames = bound(formdata(34) + 1, 1, gen(genNumBackdrops))
.background_ticks = formdata(35)
.victory_tag = formdata(36)
.death_action = formdata(37)
.hero_form = formdata(38)
END WITH
END SUB
SUB SaveFormation (form as Formation, byval index as integer)
#IFDEF IS_GAME
SaveFormation form, tmpdir & "for.tmp", index
#ELSE
SaveFormation form, game & ".for", index
#ENDIF
END SUB
SUB SaveFormation (form as Formation, filename as string, byval index as integer)
DIM formdata(39) as integer
WITH form
FOR i as integer = 0 TO 7
formdata(i * 4) = .slots(i).id + 1
formdata(i * 4 + 1) = .slots(i).pos.x
formdata(i * 4 + 2) = .slots(i).pos.y
NEXT
formdata(32) = .background
formdata(33) = .music + 1
formdata(34) = .background_frames - 1
formdata(35) = .background_ticks
formdata(36) = .victory_tag
formdata(37) = .death_action
formdata(38) = .hero_form
END WITH
storerecord(formdata(), filename, 40, index)
END SUB
'index is formation set number, starting from 1!
SUB LoadFormationSet (formset as FormationSet, byval index as integer)
BUG_IF(index < 1 ORELSE index > maxFormationSet, "invalid formation set " & index)
'Not an error to load a nonexistent formation set; happens when
'editing for first time and can be used before it is created
DIM formsetdata(24) as integer
loadrecord formsetdata(), game & ".efs", 25, index - 1, NO 'expect_exists=NO
formset.frequency = formsetdata(0)
FOR i as integer = 0 TO 19
formset.formations(i) = formsetdata(1 + i) - 1
NEXT
formset.tag = formsetdata(21)
END SUB
SUB SaveFormationSet (formset as FormationSet, byval index as integer)
BUG_IF(index < 1 ORELSE index > maxFormationSet, "invalid formation set " & index)
DIM formsetdata(24) as integer
formsetdata(0) = formset.frequency
FOR i as integer = 0 TO 19
formsetdata(1 + i) = formset.formations(i) + 1
NEXT
formsetdata(21) = formset.tag
storerecord(formsetdata(), game & ".efs", 25, index - 1)
END SUB
'==========================================================================================
' Scripts
'==========================================================================================
' Most loading code is in scripting.bas
'reads ths HS/HSS header lump of a .hs/.hsp file
SUB load_hsp_header(filename as string, header as HSHeader)
WITH header
.valid = NO
DIM fh as integer
IF OPENFILE(filename, FOR_INPUT, fh) THEN
debug "load_hsp_header: Could not open " & filename
EXIT SUB
END IF
DIM buf as string
LINE INPUT #fh, buf
IF MID(buf, 1, 12) <> "HamsterSpeak" THEN
debug "load_hsp_header: bad header '" & buf & "'"
CLOSE fh
EXIT SUB
END IF
.valid = YES
IF buf = "HamsterSpeak" THEN
'New header format
INPUT #fh, .hspeak_version
INPUT #fh, .hsp_format
INPUT #fh, .plotscr_version
INPUT #fh, .script_format
INPUT #fh, .max_function_id
ELSE
'Old format
'Next two characters are major version as a short: take one byte, skip the next
'Then append minor version (as a string)
'(Note, the minor version is only written by 3H and newer, so the version code is either 1 or 3 characters
.hspeak_version = CAST(integer, buf[12]) & MID(buf, 15)
.plotscr_version = ""
.script_format = 0
.hsp_format = 0
.max_function_id = 0
END IF
'debug "HS header: hspeak ver='" & .hspeak_version & "' plotscr ver='" & .plotscr_version & "' hsp ver=" & .hsp_format & " hsz ver=" & .script_format & " max func=" & .max_function_id
CLOSE fh
END WITH
END SUB
'Load script triggers and script names lookup tables
'There's a lot of similar loading code in importscripts. Maybe it could be moved here
SUB load_script_triggers_and_names()
DIM buf(19) as integer
REDIM script_names(0)
' Load lookup1.bin (script trigger -> script ID and name)
DIM fh as integer
IF OPENFILE(workingdir + SLASH + "lookup1.bin", FOR_BINARY + ACCESS_READ, fh) THEN
debuginfo "lookup1.bin missing" 'The game might have no scripts.
REDIM lookup1_bin_cache(-1 TO -1)
ELSE
DIM as integer records = LOF(fh) \ 40
REDIM lookup1_bin_cache(-1 TO records - 1)
DIM idx as integer = 0
WHILE loadrecord(buf(), fh, 20, idx, NO)
DIM script_id as integer = buf(0)
DIM trigger_id as integer = idx + 16384
DIM scrname as string = readbinstring(buf(), 1, 36)
'debug "lookup1: trigger " & trigger_id & " script " & id & " " & scrname
lookup1_bin_cache(idx).id = script_id
lookup1_bin_cache(idx).name = scrname
IF script_id = 0 THEN
' Previously defined, but no longer exists
scrname = "[" & scrname & "]"
END IF
a_append script_names(), trigger_id, scrname
idx += 1
WEND
CLOSE fh
END IF
' Load plotscr.lst (ID -> script name)
IF OPENFILE(workingdir & SLASH & "plotscr.lst", FOR_BINARY + ACCESS_READ, fh) THEN
debuginfo "plotscr.lst missing" 'Never imported any scripts
ELSE
DIM idx as integer = 0
WHILE loadrecord(buf(), fh, 20, idx, NO)
DIM script_id as integer = buf(0)
DIM scrname as string = readbinstring(buf(), 1, 38)
'debug "plotscr.lst: script " & id & " " & scrname
a_append script_names(), script_id, scrname
idx += 1
WEND
CLOSE fh
END IF
END SUB
'==========================================================================================
' Misc
'==========================================================================================
SUB save_string_list(array() as string, filename as string)
DIM fh as integer
OPENFILE(filename, FOR_BINARY + ACCESS_WRITE, fh)
DIM s as string
FOR i as integer = 0 TO UBOUND(array)
s = escape_nonprintable_ascii(array(i)) & CHR(10)
PUT #fh, , s
NEXT i
CLOSE #fh
END SUB
SUB load_string_list(array() as string, filename as string)
DIM lines as integer = 0
IF isfile(filename) THEN
DIM fh as integer
OPENFILE(filename, FOR_INPUT, fh)
DIM s as string
DO WHILE NOT EOF(fh)
'--get the next line
LINE INPUT #fh, s
'--if the array is not big enough to hold the new line, make it bigger
IF lines > UBOUND(array) THEN
REDIM PRESERVE array(lines) as string
END IF
'--store the string in the array
array(lines) = decode_backslash_codes(s, trimpath(filename))
'--ready for the next line
lines += 1
LOOP
lazyclose fh
END IF
IF lines = 0 THEN
'--special case for no file/lines: REDIM arr(-1) is illegal
REDIM array(0)
ELSE
'--resize the array to fit the number of lines loaded
REDIM PRESERVE array(lines - 1) as string
END IF
END SUB
FUNCTION load_map_pos_save_offset(byval mapnum as integer) as XYPair
DIM offset as XYPair
DIM gmaptmp(dimbinsize(binMAP)) as integer
loadrecord gmaptmp(), game & ".map", getbinsize(binMAP) \ 2, mapnum
offset.x = gmaptmp(20)
offset.y = gmaptmp(21)
RETURN offset
END FUNCTION
'==========================================================================================
' .rpg metadata
'==========================================================================================
LOCAL FUNCTION load_browse_record(filename as string, record as integer) as string
DIM f as string
f = IIF(LEN(filename), filename, workingdir & SLASH & "browse.txt")
DIM tempbuf(19) as integer
IF loadrecord(tempbuf(), f, 20, record, NO) THEN 'expect_exists=NO
RETURN readbinstring(tempbuf(), 0, 38)
END IF
RETURN ""
END FUNCTION
LOCAL SUB store_browse_record(filename as string, record as integer, newstr as string)
DIM f as string
f = IIF(LEN(filename), filename, workingdir & SLASH & "browse.txt")
DIM tempbuf(19) as integer
writebinstring newstr, tempbuf(), 0, 38
storerecord tempbuf(), f, 20, record
END SUB
FUNCTION getdisplayname (default as string) as string
'--Get game's display name
DIM n as string = load_gamename()
IF n = "" THEN RETURN default
RETURN n
END FUNCTION
FUNCTION load_gamename (filename as string="") as string
RETURN load_browse_record(filename, 0)
END FUNCTION
FUNCTION load_aboutline (filename as string="") as string
RETURN load_browse_record(filename, 1)
END FUNCTION
SUB save_gamename (s as string, filename as string="")
store_browse_record(filename, 0, s)
END SUB
SUB save_aboutline (s as string, filename as string="")
store_browse_record(filename, 1, s)
END SUB
FUNCTION load_titletext () as string
DIM root_node as NodePtr
root_node = get_general_reld()
RETURN GetString(NodeByPath(root_node, "/title_options/titletext", YES))
END FUNCTION
SUB save_titletext (s as string)
DIM root_node as NodePtr
root_node = get_general_reld()
DIM n as NodePtr = NodeByPath(root_node, "/title_options/titletext", YES)
SetContent(n, s)
write_general_reld()
END SUB
'Normally gamedir will be workingdir, and sourcefile will be sourcerpg
FUNCTION readarchinym (gamedir as string, sourcefile as string) as string
DIM iname as string
DIM fh as integer
IF isfile(gamedir + SLASH + "archinym.lmp") THEN
OPENFILE(gamedir + SLASH + "archinym.lmp", FOR_INPUT, fh)
LINE INPUT #fh, iname
CLOSE #fh
iname = LCASE(iname)
'IF isfile(gamedir + SLASH + iname + ".gen") THEN
RETURN iname
'ELSE
' debug gamedir + SLASH + "archinym.lmp" + " invalid, ignored"
'END IF
ELSE
debuginfo gamedir + SLASH + "archinym.lmp" + " unreadable"
END IF
' for backwards compatibility with ancient games that lack archinym.lmp
'iname = LCASE(trimextension(trimpath(sourcefile)))
'IF isfile(gamedir + SLASH + iname + ".gen") THEN RETURN iname
' Otherwise just scan the directory for a .GEN lump
' (findfiles is case-insensitive)
DIM listing() as string
findfiles gamedir, "*.gen", , , listing()
IF UBOUND(listing) = 0 THEN
debuginfo "But found " & listing(0)
RETURN LCASE(trimextension(listing(0)))
END IF
fatalerror sourcefile & " doesn't appear to be an OHRRPGCE game: doesn't contain crucial data files"
END FUNCTION
'Return the second line of archinym.lmp for the current game, which is the version
'of Custom or the tool that first created it.
FUNCTION read_archinym_version () as string
DIM lines() as string
lines_from_file lines(), workingdir & SLASH & "archinym.lmp", NO
IF UBOUND(lines) >= 1 THEN RETURN lines(1)
END FUNCTION
'==========================================================================================
' general.reld
'==========================================================================================
'Create the editor_version (general.reld) or game_client (RSAV) node.
'If if already exists, only modify it if the previous version wasn't newer.
SUB write_engine_version_node(byval parent as NodePtr, nodename as string)
DIM ch as NodePtr
ch = SetChildNode(parent, nodename, "OHRRPGCE")
IF version_branch_revision THEN
'In wip from r11886 until r13056 branch_revision was incorrectly set to 12220
DIM old_branch_revision as integer = ch."branch_revision"
IF old_branch_revision = 12220 THEN old_branch_revision = ch."revision"
IF old_branch_revision > version_branch_revision THEN EXIT SUB
IF old_branch_revision = version_branch_revision AND ch."revision" > version_revision THEN EXIT SUB
END IF
SetChildNode(ch, "long_version", long_version & build_info)
SetChildNode(ch, "branch_name", version_branch)
SetChildNode(ch, "build_date", version_date)
'version_revision is 0 if verprint could not determine it
IF version_revision <> 0 THEN SetChildNode(ch, "revision", version_revision)
IF version_branch_revision <> 0 THEN SetChildNode(ch, "branch_revision", version_branch_revision)
END SUB
'vernode is a reload node holding version info like general_reld."editor_version" or rsav."client_version"
FUNCTION read_engine_version_node(vernode as Node ptr) as EngineVersion
DIM ret as EngineVersion
IF vernode THEN
ret.recorded = YES
ret.name = GetString(vernode)
ret.long_version = vernode."long_version".string
ret.branch_name = vernode."branch_name".string
ret.revision = vernode."revision"
ret.branch_revision = vernode."branch_revision"
'In wip from r11886 until r13056 branch_revision was incorrectly set to 12220
IF ret.branch_revision = 12220 THEN ret.branch_revision = ret.revision
END IF
RETURN ret
END FUNCTION
'Get last version of Custom that the current game was edited with.
FUNCTION read_last_editor_version() as EngineVersion
DIM root as Node ptr
root = get_general_reld()
RETURN read_engine_version_node(root."editor_version".ptr)
END FUNCTION
FUNCTION get_general_reld() as NodePtr
'Returns the root node of the general.reld lump.
'Opens it up if it is not already open.
IF gen_reld_doc = 0 THEN
'First run, we must open the doc
DIM filename as string = workingdir & SLASH & "general.reld"
IF isfile(filename) THEN gen_reld_doc = LoadDocument(filename, optNoDelay)
IF gen_reld_doc = 0 THEN
debuginfo "general.reld not present, creating"
gen_reld_doc = CreateDocument()
END IF
END IF
DIM root_node as NodePtr
root_node = DocumentRoot(gen_reld_doc)
IF root_node = 0 THEN
root_node = CreateNode(gen_reld_doc, "general_data")
SetRootNode(gen_reld_doc, root_node)
END IF
RETURN root_node
END FUNCTION
CONST LAST_PREDEFINED_BUTTON_NAME_ID = 2
FUNCTION default_button_name_for_platform(platform_key as string, byval button_name_id as integer) as string
IF button_name_id < 0 ORELSE button_name_id > LAST_PREDEFINED_BUTTON_NAME_ID THEN
'Unknown button name id
RETURN ""
END IF
DIM bn_keyboard(LAST_PREDEFINED_BUTTON_NAME_ID) as string = {"Arrow Keys", "ENTER", "ESC"}
DIM bn_touchscreen(LAST_PREDEFINED_BUTTON_NAME_ID) as string = {"D-Pad", "(A)", "(B)"}
DIM bn_console(LAST_PREDEFINED_BUTTON_NAME_ID) as string = {"D-Pad", "(A)", "(B)"}
DIM bn_ouya(LAST_PREDEFINED_BUTTON_NAME_ID) as string = {"D-Pad", "(O)", "(A)"}
SELECT CASE platform_key
CASE "keyboard": RETURN bn_keyboard(button_name_id)
CASE "touchscreen": RETURN bn_touchscreen(button_name_id)
CASE "ouya": RETURN bn_ouya(button_name_id)
CASE "console": RETURN bn_console(button_name_id)
END SELECT
'Unknown platform key
debuginfo "default_button_name_for_platform: Unknown platform key " & platform_key & " " & button_name_id
RETURN ""
END FUNCTION
SUB general_reld_init_buttonnames(root_node as NodePtr)
DIM bn as NodePtr = SetChildNode(root_node, "buttonnames")
DIM bcode as NodePtr
FOR i as integer = 0 to LAST_PREDEFINED_BUTTON_NAME_ID
bcode = AppendChildNode(bn, "code", i)
'Don't create any child nodes. They should take default values if they do not exist
NEXT i
END SUB
SUB write_general_reld()
IF gen_reld_doc THEN
DIM filename as string = workingdir & SLASH & "general.reld"
SerializeBin filename, gen_reld_doc
END IF
END SUB
SUB close_general_reld()
#IFNDEF IS_GAME
' Don't write changes, in case we're live-previewing or playing an .rpgdir
write_general_reld()
#ENDIF
IF gen_reld_doc THEN
FreeDocument gen_reld_doc
gen_reld_doc = 0
END IF
END SUB
'Perform upgrades on general.reld including updating "editor_version".
SUB update_general_data ()
DIM root_node as NodePtr
root_node = get_general_reld()
'' Editor and automatic upgrader versions
#IFDEF IS_CUSTOM
'Don't update version info in Game in case we're running with usepreunlump = YES (upgrading an .rpgdir in-place)
DIM vernode as NodePtr
vernode = root_node."editor_version".ptr
IF vernode THEN
IF vernode."revision" <> version_revision OR vernode."branch_name".string <> version_branch THEN
'Archive previously used editor version (appending to end), and then replace it.
DIM prevvernode as NodePtr
prevvernode = GetOrCreateChild(root_node, "prev_editor_versions")
AddChild(prevvernode, vernode)
vernode = NULL
END IF
END IF
IF vernode = NULL THEN
write_engine_version_node(root_node, "editor_version")
END IF
#ELSE
'However it's still useful to know if Game modified an .rpgdir, so record it separately
'Don't keep a history, instead track the newest version to edit it (this only updates the info if newer)
write_engine_version_node(root_node, "automatic_upgrader_version")
#ENDIF
'' Buttonnames
IF NOT root_node."buttonnames".exists THEN
general_reld_init_buttonnames root_node
END IF
write_general_reld()
END SUB
FUNCTION get_buttonname_code(byval n as integer) as string
DIM root_node as NodePtr
root_node = get_general_reld()
DIM num as integer
DIM plat_key as string = ""
READNODE root_node."buttonnames" as bn
WITHNODE bn."code" as bcode
num = GetInteger(bcode)
IF num = n THEN
'Other consoles might possibly need more specific platform checks here
IF running_on_console() THEN
IF running_on_ouya() THEN
plat_key = "ouya"
ELSE
plat_key = "console"
END IF
ELSEIF running_on_mobile() THEN
plat_key = "touchscreen"
ELSE
plat_key = "keyboard"
END IF
RETURN GetChildNodeStr(bcode, plat_key, default_button_name_for_platform(plat_key, num))
END IF
END WITHNODE
END READNODE
IF n <= LAST_PREDEFINED_BUTTON_NAME_ID THEN
debug "get_buttonname_code: no code node exists for ${B" & n & "}"
END IF
RETURN ""
END FUNCTION
'==========================================================================================
' Distrib data
'==========================================================================================
SUB load_distrib_state(byref distinfo as DistribState)
DIM filename as string = workingdir & SLASH & "distrib.reld"
load_distrib_state distinfo, filename
END SUB
SUB load_distrib_state(byref distinfo as DistribState, filename as string)
DIM doc as DocPtr
doc = LoadDocument(filename, optNoDelay or optIgnoreMissing)
IF doc = 0 THEN
debuginfo "distrib doc not found, create it"
doc = CreateDocument()
END IF
DIM root_node as NodePtr
root_node = DocumentRoot(doc)
IF root_node = 0 THEN
root_node = CreateNode(doc, "distrib")
SetRootNode(doc, root_node)
END IF
load_distrib_state distinfo, root_node
FreeDocument doc
END SUB
SUB load_distrib_state(byref distinfo as DistribState, byval node as Reload.NodePtr)
IF NodeName(node) <> "distrib" THEN debug "root node is not distrib"
ERASE distinfo.extra_files
READNODE node, default
distinfo.pkgname = node."pkgname".string
distinfo.gamename = node."gamename".string
distinfo.author = node."author".string
distinfo.email = node."email".string
distinfo.website = node."website".string
distinfo.description = node."description".string
distinfo.more_description = node."more_description".string
distinfo.license = node."license".string
distinfo.copyright_year = node."copyright_year".string
distinfo.itch_user = node."itch_user".string
distinfo.itch_gamename = node."itch_gamename".string
distinfo.itch_upload_web = node."itch_upload_web".bool
distinfo.steam_appid = node."steam_appid".integer
distinfo.omit_readme = node."omit_readme".exists
distinfo.omit_license = node."omit_license".exists
node."extra_file".ignore
END READNODE
READNODE node, ignoreall
a_append distinfo.extra_files(), node."extra_file".string
END READNODE
'--Set up defaults
IF distinfo.pkgname = "" THEN distinfo.pkgname = game_fname
IF distinfo.gamename = "" THEN
distinfo.gamename = special_char_sanitize(load_gamename)
IF distinfo.gamename = "" THEN distinfo.gamename = distinfo.pkgname
END IF
IF distinfo.copyright_year = "" THEN distinfo.copyright_year = MID(DATE, 7, 4)
IF distinfo.license = "" THEN distinfo.license = "COPYRIGHT"
END SUB
SUB save_distrib_state(byref distinfo as DistribState)
DIM filename as string = workingdir & SLASH & "distrib.reld"
save_distrib_state distinfo, filename
END SUB
SUB save_distrib_state(byref distinfo as DistribState, filename as string)
DIM doc as DocPtr
doc = CreateDocument()
DIM root_node as NodePtr
root_node = CreateNode(doc, "distrib")
SetRootNode(doc, root_node)
save_distrib_state distinfo, root_node
SerializeBin filename, doc
FreeDocument doc
END SUB
SUB save_distrib_state(byref distinfo as DistribState, byval node as Reload.NodePtr)
IF distinfo.pkgname <> game_fname THEN
SetChildNode node, "pkgname", distinfo.pkgname
END IF
IF distinfo.gamename <> special_char_sanitize(load_gamename) THEN
SetChildNode node, "gamename", distinfo.gamename
END IF
SetChildNode node, "author", distinfo.author
SetChildNode node, "email", distinfo.email
SetChildNode node, "website", distinfo.website
SetChildNode node, "description", distinfo.description
SetChildNode node, "more_description", distinfo.more_description
SetChildNode node, "license", distinfo.license
SetChildNode node, "copyright_year", distinfo.copyright_year
SetChildNode node, "itch_user", distinfo.itch_user
SetChildNode node, "itch_gamename", distinfo.itch_gamename
SetChildNodeBool node, "itch_upload_web", distinfo.itch_upload_web
SetChildNode node, "steam_appid", distinfo.steam_appid
IF distinfo.omit_readme THEN SetChildNode node, "omit_readme", 1
IF distinfo.omit_license THEN SetChildNode node, "omit_license", 1
FOR idx as integer = 0 TO UBOUND(distinfo.extra_files)
AppendChildNode node, "extra_file", distinfo.extra_files(idx)
NEXT
END SUB
'==========================================================================================
' Shops
'==========================================================================================
SUB load_shop_stuff(byval shop_id as integer, byval stuff_list as NodePtr)
'Load shop stuff from the binary .STF lump into a bunch of reload nodes.
IF NumChildren(stuff_list) > 0 THEN
debug "WARNING: load_shop_stuff, stuff_list node should start empty"
END IF
'First find out how many stuff records this shop actually uses
DIM shop_buf(19) as integer
loadrecord shop_buf(), game & ".sho", 40 \ 2, shop_id
DIM last_stuff as integer = shop_buf(16)
'Create a buffer for loading STF records.
DIM stufbuf(dimbinsize(binSTF)) as integer
FOR slot as integer = 0 TO last_stuff
'Load the data for this stuff slot
loadrecord stufbuf(), game & ".stf", getbinsize(binSTF) \ 2, shop_id * 50 + slot
DIM slotnode as NodePtr
slotnode = AppendChildNode(stuff_list, "stuff_slot", slot)
DIM n as NodePtr
DIM buy as NodePtr
DIM sell as NodePtr
IF stufbuf(17) = 1 THEN
n = SetChildNode(slotnode, "hero", stufbuf(18))
IF stufbuf(26) >= 0 THEN
SetChildNode(n, "level", stufbuf(26))
END IF
buy = SetChildNode(n, "hire")
sell = 0
ELSE
n = SetChildNode(slotnode, "item", stufbuf(18))
buy = SetChildNode(n, "buy")
sell = SetChildNode(n, "sell")
END IF
DIM sname as string
sname = readbadbinstring(stufbuf(), 0, 16)
SetChildNode(n, "name", sname)
IF stufbuf(19) = -1 THEN
SetChildNode(n, "infinite")
ELSEIF stufbuf(19) >= 0 THEN
SetChildNode(n, "stock", stufbuf(19))
END IF
IF stufbuf(37) = 0 THEN stufbuf(37) = slot + 1 'Initialise stockidx
SetChildNode(n, "stockidx", stufbuf(37) - 1)
SetChildNode(buy, "require_tag", stufbuf(20))
SetChildNode(buy, "set_tag", stufbuf(22))
SetChildNode(buy, "price", stufbuf(24))
append_trade_node buy, stufbuf(25), stufbuf(30)
append_trade_node buy, stufbuf(31), stufbuf(32)
append_trade_node buy, stufbuf(33), stufbuf(34)
append_trade_node buy, stufbuf(35), stufbuf(36)
IF sell THEN
SetChildNode(sell, "require_tag", stufbuf(21))
SetChildNode(sell, "set_tag", stufbuf(23))
append_trade_node sell, stufbuf(28), stufbuf(29)
SELECT CASE stufbuf(26)
CASE 0: SetChildNode(sell, "sell_type", "normal")
CASE 1: SetChildNode(sell, "sell_type", "acquire")
CASE 2: SetChildNode(sell, "sell_type", "increment")
CASE 3: SetChildNode(sell, "sell_type", "refuse")
END SELECT
END IF
NEXT slot
END SUB
SUB append_trade_node (byval par as NodePtr, byval itnum as integer, byval itqty as integer)
'itnum is offset +1 and 0 means none
'itqty is offset -1 so 0 means 1
IF itnum < 1 THEN EXIT SUB
DIM n as NodePtr
n = AppendChildNode(par, "trade", itnum - 1)
SetChildNode(n, "count", itqty + 1)
END SUB
'==========================================================================================
' Hero Formations
'==========================================================================================
SUB write_hero_formation(byval par as NodePtr, byref hform as HeroFormation)
FreeChildren(par)
DIM slot_node as NodePtr
DIM stance as NodePtr
FOR i as integer = 0 TO 3
slot_node = AppendChildNode(par, "slot", i)
stance = AppendChildNode(slot_node, "stance", 0)
SetChildNode(stance, "x", hform.slots(i).pos.x)
SetChildNode(stance, "y", hform.slots(i).pos.y)
NEXT i
END SUB
SUB save_hero_formation(byref hform as HeroFormation, byval form_num as integer)
DIM filename as string = workingdir & SLASH & "heroform.reld"
DIM doc as DocPtr
doc = LoadDocument(filename, optNoDelay or optIgnoreMissing)
IF doc = 0 THEN
debuginfo "heroform doc not found, create it"
doc = CreateDocument()
END IF
DIM heroforms as NodePtr
heroforms = DocumentRoot(doc)
IF heroforms = 0 THEN
heroforms = CreateNode(doc, "heroforms")
SetRootNode(doc, heroforms)
END IF
'Equivalent (not tested):
'DIM form as Nodeptr = NodeByPath(heroforms, "/form[" & form_num & "]", YES) 'create=YES
'write_hero_formation form, hform
DIM found as bool = NO
READNODE heroforms
WITHNODE heroforms."form" as form
DIM i as integer = GetInteger(form)
IF form_num = i THEN
write_hero_formation form, hform
found = YES
END IF
END WITHNODE
END READNODE
IF NOT found THEN
DIM form as Node Ptr
form = AppendChildNode(heroforms, "form", form_num)
write_hero_formation form, hform
END IF
SerializeBin filename, doc
FreeDocument doc
END SUB
SUB default_hero_formation(byref hform as HeroFormation)
FOR i as integer = 0 TO 3
WITH hform.slots(i)
.id = i
.pos.x = i * 8 + 16
.pos.y = i * 20 + 40
END WITH
NEXT i
END SUB
SUB load_hero_formation(byref hform as HeroFormation, byval form_num as integer)
default_hero_formation hform
DIM doc as DocPtr
doc = LoadDocument(workingdir & SLASH & "heroform.reld", optIgnoreMissing)
'Either missing (which is common in older games) or it was corrupt (already
'showed an error). Return defaults.
IF doc = 0 THEN EXIT SUB
DIM heroforms as NodePtr
heroforms = DocumentRoot(doc)
IF heroforms = 0 THEN
heroforms = CreateNode(doc, "heroforms")
SetRootNode(doc, heroforms)
END IF
READNODE heroforms
WITHNODE heroforms."form" as form
DIM i as integer = GetInteger(form)
IF form_num = i THEN
READNODE form
WITHNODE form."slot" as slot
DIM j as integer = GetInteger(slot)
SELECT CASE j
CASE 0 TO 3
READNODE slot
WITHNODE slot."stance" as stance
IF GetInteger(stance) <> 0 THEN
debug "form " & i & " slot " & j & " nonzero stance is not allowed (" & GetInteger(stance) & ")"
ELSE
WITH hform.slots(j)
.id = -1
.pos.x = stance."x".default(.pos.x).integer
.pos.y = stance."y".default(.pos.y).integer
END WITH
END IF
END WITHNODE
END READNODE
CASE ELSE
debug "form " & i & " slot " & j & " is invalid"
END SELECT
END WITHNODE
END READNODE
END IF
END WITHNODE
END READNODE
FreeDocument doc
END SUB
FUNCTION last_hero_formation_id() as integer
DIM doc as DocPtr
doc = LoadDocument(workingdir & SLASH & "heroform.reld", optIgnoreMissing)
'Either missing (common in older games) or it was corrupt (already showed an error)
IF doc = 0 THEN RETURN 0
DIM heroforms as NodePtr
heroforms = DocumentRoot(doc)
IF heroforms = 0 THEN
heroforms = CreateNode(doc, "heroforms")
SetRootNode(doc, heroforms)
END IF
DIM result as integer = 0
READNODE heroforms
WITHNODE heroforms."form" as form
DIM i as integer = GetInteger(form)
result = large(result, i)
END WITHNODE
END READNODE
FreeDocument doc
RETURN result
END FUNCTION
'==========================================================================================
' Translations
'==========================================================================================
DIM translations as StrHashTable
LOCAL SUB TranslationString_delete CDECL (p as TranslationString ptr)
DELETE p
END SUB
'I don't like running code before main()
SUB init_translations()
translations.construct(64, type_table(any_ptr), NO)
translations.value_delete = CAST(FnDelete, @TranslationString_delete) 'We want it to auto-delete but not copy
END SUB
'Split up a string (the translation of a textbox) into the multiple lines of the textbox
'This is a variant on textbox_string_to_lines() in textboxedit.bas,
'but does not enforce the textbox line limit!
SUB textbox_translation_to_lines(box as TextBox, text as string)
DIM lines() as string
'TODO: wrap around portraits
DIM wrappedtext as string = wordwrap(text, 38)
split(wrappedtext, lines())
a_copy lines(), box.text()
END SUB
FUNCTION translation_produce_scan_template(embed_template as string) as string
DIM ret as string = embed_template
replacestr(ret, "#", "%d")
replacestr(ret, "X", "%9[^ }0-9-]")
RETURN ret & "%n"
END FUNCTION
'Remove extra spaces that appear in ${X#} embed codes (because an automated translator
'might have added them) and convert ${*##} to CHR(##).
'Also supports using other markup formatting instead. scan_template should be produced
'by translation_produce_scan_template().
FUNCTION unescape_str_for_web_translation(text as string, scan_template as zstring ptr = @"$ { %9[^ }0-9-] %d }%n", chcode_indic as zstring ptr = @"*") as string
DIM where as integer = 1
DIM ret as string = text
DO
where = INSTR(where, ret, "$")
IF where = 0 THEN EXIT DO
DIM embedtype as zstring * 10
DIM arg as integer
DIM bytesparsed as integer = -1
sscanf(@ret[where - 1], scan_template, strptr(embedtype), @arg, @bytesparsed)
IF bytesparsed > 0 THEN
'Successful match (return value of sscanf can't tell you that - must use %n)
DIM replacement as string
IF embedtype = *chcode_indic THEN
replacement = CHR(arg)
ELSE
replacement = "${" & embedtype & arg & "}"
END IF
ret = LEFT(ret, where - 1) & replacement & MID(ret, where + bytesparsed)
where += LEN(replacement)
ELSE
'Not an embed code, skip
where += 1
END IF
LOOP
RETURN ret
END FUNCTION
'Testcases, but don't have a way to run automatically currently
'if unescape_str_for_web_translation("${*65}-$ {*65}$ {*65}-$ { * 65 }") <> "A-AA-A" then fail
'if unescape_str_for_web_translation("$ {H 0} ${ H1} $ { LM-1 }$$#") <> "${H0} ${H1} ${LM-1}$$#" then fail
SUB add_translation(code as string, text as string, description as string = "", deduplicate as bool = NO)
DIM trans as TranslationString ptr = NEW TranslationString
trans->text = text
trans->description = description
trans->deduplicate = deduplicate
trans->sortorder = translations.numitems
translations.add(code, trans)
END SUB
PRIVATE SUB skip_to_translation_start(text as string, byref where as integer, tok as zstring ptr, ws as integer)
'A lot of these neural translators will increase the number of |'s or <'s, eg to ||||.
'So skip to whitespace.
skip_over(text, where, tok)
IF ws THEN
'Skip over leading whitespace, because its preservation is very unreliable: a WS token
'should be used instead.
skip_over(text, where, " ")
ELSE
'Preserve leading whitespace if no WS token used
skip_over(text, where, " ", 1)
END IF
END SUB
SUB load_translations(fname as string) ', byref errmsg as string, byref warnings as integer = 0)
init_translations()
dim as string errmsg = ""
dim warnings as integer
DIM fh as integer
IF OPENFILE(fname, FOR_INPUT + OR_ERROR, fh) THEN EXIT SUB
'TODO: read these templates from the file header
DIM scan_template as string = translation_produce_scan_template("$ { X # }")
DIM chcode_indic as string = "*"
#DEFINE _unescape(x) unescape_str_for_web_translation(x, scan_template, chcode_indic)
DIM linenum as integer = 0
DO UNTIL EOF(fh)
DIM linein as string
LINE INPUT #fh, linein
DIM lcaselinein as string = LCASE(linein)
linenum += 1
linein = TRIM(linein)
IF LEN(linein) = 0 ORELSE LEFT(LTRIM(linein), 1) = "#" THEN
'Comment/blank. Maybe we should preserve comments, if we export the translations again?
'Very easy to do, just add a translation with a dummy code.
CONTINUE DO
END IF
DIM codeend as integer
DIM where as integer
where = INSTR(linein, " ")
IF where THEN
DIM code as string = LEFT(lcaselinein, where - 1)
'Check for a leading whitespace token, like WS3
DIM ws as integer = 0
skip_over(linein, where, " ")
IF skip_over(lcaselinein, where, "ws", 1) THEN
'ws = VALINT(MID(linein, where))
scanf(@"%d", @ws)
END IF
'Single-line translation
where = INSTR(linein, "|")
IF where THEN
skip_to_translation_start(linein, where, "|", ws)
add_translation(code, _unescape(SPACE(ws) & MID(linein, where)))
CONTINUE DO
END IF
'Multi-line translation
where = INSTR(linein, "<")
IF where THEN
skip_to_translation_start(linein, where, "<", ws)
DIM trans as string
DIM firstline as bool = YES
'As exported, there will be a newline after <, but that might get removed.
IF where < LEN(linein) THEN
trans = MID(linein, where)
firstline = NO
END IF
'Append more lines
DO
IF EOF(fh) THEN
errmsg = "End token '" & code & " >' is missing, hit the end of the file"
EXIT DO
END IF
LINE INPUT #fh, linein
lcaselinein = LCASE(linein)
linenum += 1
'Look for end of block: code '>'
'However the previous newline might get lost instead of this appearing on a line
'by itself.
DIM endtok as integer = INSTR(lcaselinein, code)
IF endtok THEN
where = INSTR(endtok, linein, " ")
skip_over(linein, where, " ")
DIM trailing as string = RTRIM(MID(linein, where))
IF trailing <> ">" THEN
warnings += 1
debug fname & " line " & linenum & ": expected to see >, instead found (and will ignore): " & trailing
END IF
linein = RTRIM(LEFT(linein, endtok - 1))
END IF
IF firstline = NO THEN trans &= CHR(10)
firstline = NO
trans &= linein
IF endtok THEN EXIT DO
LOOP
IF ws THEN
'Replace leading whitespace (because its preservation is very unreliable) with what the
'WS token specifies.
trans = SPACE(ws) & LTRIM(trans)
END IF
add_translation(code, _unescape(trans))
CONTINUE DO
END IF
END IF
warnings += 1
debug fname & " line " & linenum & " malformed, ignored: " & linein
LOOP
CLOSE fh
END SUB
'translate(text, "TB", txt.id)
'Call translate() instead unless you want to know whether you're getting a translation
FUNCTION get_translation(code as zstring ptr) as TranslationString ptr
IF translations.tablesize = 0 THEN RETURN NULL 'Hasn't been constructed
DIM trans as TranslationString ptr = translations.get(*code)
IF trans ANDALSO LEN(trans->text) THEN RETURN trans
RETURN NULL
END FUNCTION
FUNCTION translate(original as string, code as zstring ptr) as string
DIM trans as TranslationString ptr = get_translation(code)
'debug "translate " & *code
IF trans THEN /' debug "found '''" & trans->text & "'''" : '/ RETURN trans->text
RETURN original
END FUNCTION
'==========================================================================================
SUB load_non_elemental_elements (elem() as bool)
flusharray elem(), NO
DIM g as NodePtr = get_general_reld()
DIM elementals as NodePtr = GetOrCreateChild(g, "elementals")
READNODE elementals
WITHNODE elementals."element" as e
DIM eid as integer = GetInteger(e)
IF eid >= 0 ANDALSO eid < maxElements THEN
DIM non_elemental as NodePtr
non_elemental = GetOrCreateChild(e, "non_elemental")
IF GetInteger(non_elemental) THEN elem(eid) = YES
END IF
END WITHNODE
END READNODE
END SUB
'After prompting user, crop a file of fixed-sized records after record 'index'
'and update 'limit' (max valid record ID). Returns true if not cancelled.
FUNCTION cropafter (index as integer, byref limit as integer, lump as string, bytes as integer, prompt as bool=YES) as bool
DIM i as integer
IF prompt THEN
DIM menu(1) as string
menu(0) = "No, do not delete anything"
menu(1) = "Yes, DELETE!"
IF multichoice("Do you want to delete ALL records AFTER this one?", menu()) < 1 _
ORELSE yesno("Are you SURE?", NO, NO) = NO THEN
setkeys
RETURN NO
ELSE
setkeys
END IF
END IF
'TODO: FB 1.08 (2020) adds SetFileEof, eventually should use that instead
DIM buf(bytes \ 2 - 1) as integer
FOR i = 0 TO index
loadrecord buf(), lump, bytes \ 2, i
storerecord buf(), tmpdir & "_cropped.tmp", bytes \ 2, i
NEXT i
limit = index
copyfile tmpdir & "_cropped.tmp", lump
safekill tmpdir & "_cropped.tmp"
RETURN YES
END FUNCTION