'OHRRPGCE - Slices
'(C) Copyright 1997-2022 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.
' ==== Explanation of how slice refreshing & drawing works ====
'DrawSlice simply calls DrawSliceRecurse, which is the central drawing function.
'
'DrawSliceRecurse(sl):
'
' attach->ChildRefresh(attach, sl)
' (attach == parent of sl, except for the root slice, then attach == ScreenSlice.
' sl->Attached is currently unused.)
' Calls RefreshChild() to recomputes sl->ScreenPos from sl->Pos.
' (Can also adjust sl->Size (if sl->Fill) and sl->Visible, see ChildRefresh details below.)
'
' If sl->Visible:
'
' If sl->CoverChildren: UpdateCoverSize(sl)
'
' If sl->Context: push onto context_stack
'
' sl->Draw(): (eg DrawSpriteSlice) [if present]
' -Type-specific drawing of a single slice
' (If something has to be drawn over the children instead, done in sl->ChildDraw)
'
' AutoSortChildren(sl)
'
' sl->ChildDraw() (eg GridChildDraw, DefaultChildDraw):
' (Called once to draw all children.)
' sl->ChildrenRefresh() [if present]
' (Recomputes Pos, Size and ScreenPos for each child)
' For each child:
' Skip if a template slice (and template_slices_shown=NO)
' shrinkclip if clipping; usually done once for all children
' (clip to parent size minus padding, or to child's support for Grid/Panel)
' If the cliprect isn't zero-size (but do continue if the child is totally clipped off):
' DrawSliceRecurse(child, page, childindex)
' ...draw the child recursively...
' Restore cliprect
' Possibly draw something over all children (Scroll slices)
'
' Pop context_stack
'
'
'So unrolling that, each slice `sl` is processed in this order:
'Before DrawSlice called:
' -[NPC, hero, etc, slices] - positions & visibility updated based on in-game logic (done separately)
' -AdvanceSlice() - update position based on movement (done separately - in-game wandering on map only!)
'Before parent is drawn:
' -If parent->CoverChildren sl->Size/sl->Pos are used to update the parent's size
'After parent is drawn:
' -AutoSortChildren() modifies order amongst siblings
' -parent->ChildrenRefresh() [if present] updates sl->ScreenPos/sl->Size
' -Skip sl if it's a template or parent sets a zero-size cliprect
' -parent->ChildRefresh() & RefreshChild() update sl->ScreenPos/sl->Size/sl->Visible
' -If sl->Visible:
' -If sl->CoverChildren, update sl->Size
' -push sl->Context onto context_stack
' -sl->Draw()
' -children autosorted
' -sl->ChildDraw():
' -sl->ChildrenRefresh()
' -For each child:
' -Skip if a template slice (and template_slices_shown=NO)
' -shrinkclip if clipping; usually done once for all children
' (clip to parent size minus padding, or to child's support for Grid/Panel)
' -If the cliprect isn't zero-size:
' -DrawSliceRecurse(child)
' -sl->ChildRefresh(child)
' -draw scrollbars/etc over children
' -pop context_stack
'
'[[FIXME: the above reveals several problems
' -parent->CoverChildren happens before most updates to children
' -CoverChildren updates Size after Size has already been used to update ScreenPos
' -it's really hard to see the order things happen from the code
']]
'
' ==== Slice refreshing details ====
'
'sl->ChildRefresh (called by the slice refresh functions like RefreshSliceScreenPos,
'and called directly or indirectly in lots of places) is responsible for translating a slice's
'.Pos to its .ScreenPos (including effects of clamping), and also applying .Fill (which
'modifies .Size) -- this is probably in the wrong place!
'As an exception, SelectChildRefresh also modifies .Visible. (Although this leads to unnecessary
'refreshes there doesn't seem to a better place for it. See r7792.)
'All sl->ChildRefresh methods calculate the 'support' rect for a child then call RefreshChild()
'to do the actual update. Grid and Panel slices have non-standard supports (each child
'gets its own instead of all sharing the same one).
'As an exception, if sl->ChildrenRefresh is defined, sl->ChildRefresh isn't (this may be
'a mistake, which should be changed). So Layout slices don't have a ChildRefresh and are
'the only slices that don't call RefreshChild.
'
'sl->ChildrenRefresh is used for recomputing child X,Y positions if they are determined
'by the parent slice. Currently only LayoutChildrenRefresh exists. There are no
'Panel/GridChildrenRefresh subs because X,Y positions of children of those aren't relative
'to a certain point.
'sl->ChildrenRefresh is called by slice refresh functions but not by collision detection
'functions!
#include "config.bi"
#include "allmodex.bi"
#include "common.bi"
#include "const.bi"
#include "scrconst.bi"
#include "uiconst.bi"
#include "reloadext.bi"
#include "loading.bi"
#include "slices.bi"
#include "sliceedit.bi"
#include "surface.bi"
#ifdef IS_GAME
'For plotslices(), next_slice_table_slot, num_reusable_slice_table_slots
#include "gglobals.bi"
'For restore_saved_plotslice_handle
#include "scriptcommands.bi"
#endif
'==============================================================================
'Reload helper functions used by saving/loading
DECLARE Sub SavePropBool OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as boolean)
DECLARE Sub SaveProp OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as integer)
DECLARE Sub SaveProp OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as double)
DECLARE Sub SaveProp OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, s as string)
DECLARE Sub SavePropBoolAlways OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as boolean)
DECLARE Sub SavePropAlways OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as integer)
DECLARE Sub SavePropAlways OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, byval value as double)
DECLARE Sub SavePropAlways OVERLOAD (node as Reload.Nodeptr, propname as zstring ptr, s as string)
EXTERN "C"
DECLARE Function LoadPropStr(node as Reload.Nodeptr, propname as zstring ptr, defaultval as string="") as string
DECLARE Function LoadProp(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as integer=0) as integer
DECLARE Function LoadPropBool(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as bool=NO) as bool
DECLARE Function LoadPropFloat(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as double=0.0) as double
DECLARE Sub SaveDrawOpts(drawopts as DrawOptions, node as Reload.Nodeptr)
DECLARE Sub LoadDrawOpts(drawopts as DrawOptions, node as Reload.Nodeptr)
'Other local subs and functions
DECLARE Sub DrawSliceRecurse(byval s as Slice ptr, byval page as integer, childindex as integer = -1)
DECLARE Function SliceXAlign(sl as Slice Ptr, supportw as integer) as integer
DECLARE Function SliceYAlign(sl as Slice Ptr, supporth as integer) as integer
DECLARE Sub RefreshChild(ch as Slice ptr, support as RectType)
DECLARE Sub RefreshChildClamp(ch as Slice ptr, support as RectType)
DECLARE Sub ApplySliceVelocity(byval s as Slice ptr)
DECLARE Sub SeekSliceTarg(byval s as Slice ptr)
DECLARE Sub report_slice_type_err(sl as Slice ptr, expected as SliceTypes)
#macro ASSERT_SLTYPE(sl, expected, retwhat...)
if sl->SliceType <> expected then
report_slice_type_err sl, expected
return retwhat 'If retwhat isn't given, just "return"
end if
#endmacro
END EXTERN
'==============================================================================
ReDim Shared SliceDebug(50) as Slice Ptr
'Number of non-trivial drawn slices (Container, Special, Root and invisible excluded)
DIM NumDrawnSlices as integer
DIM benchmarking_slice as Slice ptr 'Which slice's Draw() to time with benchmarking_draw_timer
DIM benchmarking_draw_timer as SmoothedTimer
'Whether template slices should be reveal - used in the slice editor
DIM template_slices_shown as boolean
'ScreenSlice is used by other slices with ->Attach = slScreen
DIM SHARED ScreenSlice as Slice Ptr
ScreenSlice = NewSlice()
#ifdef ENABLE_SLICE_DEBUG
SliceDebugForget ScreenSlice '--screen slice is magical, ignore it for debugging purposes
#endif
WITH *ScreenSlice
'Note that .Attach is NOT set to slScreen here. slScreen uses this, not the other way around
.SliceType = slSpecial
.X = 0
.Y = 0
.ScreenX = 0
.ScreenY = 0
.Width = get_resolution().w
.Height = get_resolution().h
END WITH
DEFINE_VECTOR_OF_POD_TYPE(Slice ptr, Slice_ptr)
DEFINE_VECTOR_OF_POD_TYPE(SliceContext ptr, SliceContext_ptr)
'Built up while inside DrawSlice, otherwise NULL.
'A stack of all the non-NULL .Context ptrs for all the ancestors of the current slice.
Dim Shared context_stack as SliceContext ptr vector
EXTERN "C"
'==General slice code==========================================================
Function Slice.IsShown() as boolean
return this.Visible andalso (this.Template = false orelse template_slices_shown)
End Function
'Whether this slice should be skipped for certain purposes (e.g. slice collisions, laying out or
'covering children) because it's not visible (if visibleonly=YES), or it's a template.
Private Function ShouldSkipSlice(sl as Slice ptr, visibleonly as bool = NO) as bool
if sl->Template andalso template_slices_shown = NO then return YES
return visibleonly andalso sl->Visible = NO
end function
'Stub functions.
'These Null functions are used by Container, Root, and Special slices.
Sub DisposeNullSlice(byval s as Slice ptr) : end sub
Sub CloneNullSlice(byval s as Slice ptr, byval cl as Slice ptr) : end sub
Sub SaveNullSlice(byval s as Slice ptr, byval node as Reload.Nodeptr) : end sub
Sub LoadNullSlice(byval s as Slice ptr, byval node as Reload.Nodeptr) : end sub
'And this is used if ChildrenRefresh is provided instead
Sub NullChildRefresh(byval par as Slice ptr, byval ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES) : end sub
'Computes ScreenX/Y, and also sets the width/height if filling (which is basically an implementation mistake).
'childindex is index of ch among its siblings, ignoring templates. Pass -1 if not known,
'which saves computing it if it's not needed. (Not used by DefaultChildRefresh)
Sub DefaultChildRefresh(byval par as Slice ptr, byval ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
if ch = 0 then debug "DefaultChildRefresh null ptr": exit sub
if visibleonly andalso ch->Visible = NO then exit sub 'Don't need to exclude template slices
dim support as RectType = any
support.xy = par->ScreenPos + XY(par->paddingLeft, par->paddingTop)
support.wide = par->Width - par->paddingLeft - par->paddingRight
support.high = par->Height - par->paddingTop - par->paddingBottom
RefreshChild ch, support
End Sub
'Support is the box (in screen coordinates) which the child is aligned relative to,
'and which it would fill if ch->Fill is true.
'By default it is the size of the parent minus padding.
Sub RefreshChild(ch as Slice ptr, support as RectType)
with *ch
.ScreenX = .X + support.x + SliceXAlign(ch, support.wide) - SliceXAnchor(ch)
.ScreenY = .Y + support.y + SliceYAlign(ch, support.high) - SliceYAnchor(ch)
if .ClampHoriz <> alignNone orelse .ClampVert <> alignNone then
if .ClampToScreen then
dim scr_rect as RectType = any
dim root_sl as slice Ptr = FindRootSlice(ch)
scr_rect.xy = root_sl->ScreenPos + XY(root_sl->paddingLeft, root_sl->paddingTop)
scr_rect.wide = root_sl->Width - root_sl->paddingLeft - root_sl->paddingRight
scr_rect.high = root_sl->Height - root_sl->paddingTop - root_sl->paddingBottom
RefreshChildClamp ch, scr_rect
else
'Clamp to parent
RefreshChildClamp ch, support
end if
end if
if .Fill then
if .FillMode = sliceFillFull ORELSE .FillMode = sliceFillHoriz then
.ScreenX = support.x
.Width = support.wide
end if
if .FillMode = sliceFillFull ORELSE .FillMode = sliceFillVert then
.ScreenY = support.y
.Height = support.high
end if
end if
end with
End sub
Sub RefreshChildClamp(ch as Slice ptr, support as RectType)
with *ch
select case .ClampHoriz
case alignLeft: .ScreenX = large(.ScreenX, support.x)
case alignRight: .ScreenX = small(.ScreenX, support.x + support.wide - .Width)
case alignBoth:
if .Width > support.wide then
select case .AnchorHoriz
case alignLeft:
.ScreenX = small(.ScreenX, support.x + support.wide - .Width)
.ScreenX = large(.ScreenX, support.x)
case alignRight:
.ScreenX = large(.ScreenX, support.x)
.ScreenX = small(.ScreenX, support.x + support.wide - .Width)
case alignCenter:
.ScreenX = support.x + (support.wide - .Width) \ 2
end select
else
.ScreenX = large(.ScreenX, support.x)
.ScreenX = small(.ScreenX, support.x + support.wide - .Width)
end if
end select
select case .ClampVert
case alignTop: .ScreenY = large(.ScreenY, support.y)
case alignBottom: .ScreenY = small(.ScreenY, support.y + support.high - .Height)
case alignBoth:
if .Height > support.high then
select case .AnchorVert
case alignTop:
.ScreenY = small(.ScreenY, support.y + support.high - .Height)
.ScreenY = large(.ScreenY, support.y)
case alignBottom:
.ScreenY = large(.ScreenY, support.y)
.ScreenY = small(.ScreenY, support.y + support.high - .Height)
case alignCenter:
.ScreenY = support.y + (support.high - .Height) \ 2
end select
else
.ScreenY = large(.ScreenY, support.y)
.ScreenY = small(.ScreenY, support.y + support.high - .Height)
end if
end select
end with
End Sub
Sub DefaultChildDraw(byval s as Slice Ptr, byval page as integer)
'NOTE: we don't bother to null check s here because this sub is only
' ever called from DrawSliceRecurse which does null check it.
dim rememclip as ClipState = any
with *s
if .ChildrenRefresh then .ChildrenRefresh(s)
if .Clip then
rememclip = get_cliprect()
if shrinkclip(.ScreenX + .paddingLeft, _
.ScreenY + .paddingTop, _
.ScreenX + .Width - .paddingRight - 1, _
.ScreenY + .Height - .paddingBottom - 1, _
vpages(page)) = NO then
'cliprect size is zero, all children are clipped
get_cliprect() = rememclip
exit sub
end if
end if
'draw the slice's children
dim ch as Slice ptr = .FirstChild
dim childindex as integer = 0 'Index amongst not-template-skipped siblings
do while ch <> 0
if ch->Template = NO orelse template_slices_shown then 'equiv to ShouldSkipSlice(ch) = NO
DrawSliceRecurse(ch, page, childindex)
childindex += 1
end if
ch = ch->NextSibling
loop
if .Clip then get_cliprect() = rememclip
end with
End sub
FUNCTION SliceTypeByName (s as string) as SliceTypes
SELECT CASE s
CASE "Root": RETURN slSpecial 'Root slices removed
CASE "Special": RETURN slSpecial
CASE "Container": RETURN slContainer
CASE "Rectangle": RETURN slRectangle
CASE "Line": RETURN slLine
CASE "Sprite": RETURN slSprite
CASE "Text": RETURN slText
CASE "Map": RETURN slMap
CASE "Grid": RETURN slGrid
CASE "Ellipse": RETURN slEllipse
CASE "Scroll": RETURN slScroll
CASE "Select": RETURN slSelect
CASE "Panel": RETURN slPanel
CASE "Layout": RETURN slLayout
END SELECT
debugerror "Unrecognized slice name """ & s & """"
RETURN slInvalid
END FUNCTION
END EXTERN
FUNCTION SliceTypeName (sl as Slice Ptr) as string
IF sl = 0 THEN debug "SliceTypeName null ptr": RETURN "<null ptr>"
RETURN SliceTypeName(sl->SliceType)
END FUNCTION
FUNCTION SliceTypeName (t as SliceTypes) as string
SELECT CASE t
CASE slSpecial: RETURN "Special"
CASE slContainer: RETURN "Container"
CASE slRectangle: RETURN "Rectangle"
CASE slLine: RETURN "Line"
CASE slSprite: RETURN "Sprite"
CASE slText: RETURN "Text"
CASE slMap: RETURN "Map"
CASE slGrid: RETURN "Grid"
CASE slEllipse: RETURN "Ellipse"
CASE slScroll: RETURN "Scroll"
CASE slSelect: RETURN "Select"
CASE slPanel: RETURN "Panel"
CASE slLayout: RETURN "Layout"
END SELECT
RETURN "Unknown"
END FUNCTION
DIM SHARED SliceShortTypeName(...) as zstring ptr = { _
@"", _
@"Specl", _
@"Cont", _
@"Rect", _
@"Sprite", _
@"Text", _
@"Map", _
@"Grid", _
@"Ellps", _
@"Scrol", _
@"Selct", _
@"Panel", _
@"Layout", _
@"Line" _
}
'Called from sliceedit.
FUNCTION SliceLookupCodename (code as integer, slicelookup() as string, use_default as bool = YES) as string
IF code > 0 ANDALSO code <= UBOUND(slicelookup) ANDALSO LEN(TRIM(slicelookup(code))) THEN
RETURN slicelookup(code)
ELSE
RETURN SliceLookupCodeName(code, use_default) 'Special lookup codes
END IF
END FUNCTION
FUNCTION SliceLookupCodename (sl as Slice Ptr, use_default as bool = YES) as string
IF sl = 0 THEN RETURN "[nullptr]"
RETURN SliceLookupCodename(sl->Lookup, use_default)
END FUNCTION
'use_default: if the code is unnamed, return "Lookup###" instead of ""
FUNCTION SliceLookupCodename (byval code as integer, use_default as bool = YES) as string
SELECT CASE code
CASE 0: RETURN ""
'--the following is updated from slices.bi using the misc/sl_lookup.py script
'<SLICE LOOKUP NAMES>
CASE SL_EDITOR_SPLASH_MENU: RETURN "editor splash menu"
CASE SL_EDITOR_THINGBROWSER_THINGLIST: RETURN "editor thingbrowser thinglist"
CASE SL_EDITOR_THINGBROWSER_PLANK_SPRITE: RETURN "editor thingbrowser plank sprite"
CASE SL_EDITOR_THINGBROWSER_BACK_HOLDER: RETURN "editor thingbrowser back holder"
CASE SL_EDITOR_THINGBROWSER_MODE_INDICATOR: RETURN "editor thingbrowser mode indicator"
CASE SL_EDITOR_THINGBROWSER_NEW_HOLDER: RETURN "editor thingbrowser new holder"
CASE SL_EDITOR_THINGBROWSER_NOSCROLL_AREA: RETURN "editor thingbrowser noscroll area"
CASE SL_EDITOR_THINGBROWSER_FILTER_HOLDER: RETURN "editor thingbrowser filter holder"
CASE SL_EDITOR_THINGBROWSER_TYPE_QUERY: RETURN "editor thingbrowser type query"
CASE SL_EDITOR_THINGBROWSER_FILTER_TEXT: RETURN "editor thingbrowser filter text"
CASE SL_EDITOR_PROMPT_FOR_STRING_TEXT: RETURN "editor prompt for string text"
CASE SL_EDITOR_PROMPT_FOR_STRING_CAPTION: RETURN "editor prompt for string caption"
CASE SL_EDITOR_SSED_LIST: RETURN "editor ssed list"
CASE SL_EDITOR_SSED_SET_TEMPL: RETURN "editor ssed set templ"
CASE SL_EDITOR_SSED_FRAME_HOLDER: RETURN "editor ssed frame holder"
CASE SL_EDITOR_SSED_FRAME_TEMPL: RETURN "editor ssed frame templ"
CASE SL_EDITOR_SSED_FRAME_SPRITE: RETURN "editor ssed frame sprite"
CASE SL_EDITOR_SSED_INFO_TEXT: RETURN "editor ssed info text"
CASE SL_EDITOR_SSED_PALETTE_GRID: RETURN "editor ssed palette grid"
CASE SL_EDITOR_SSED_PALETTE_TEXT: RETURN "editor ssed palette text"
CASE SL_EDITOR_SSED_SET_INFO: RETURN "editor ssed set info"
CASE SL_EDITOR_SSED_SET: RETURN "editor ssed set"
CASE SL_EDITOR_SSED_PALETTE_ROOT: RETURN "editor ssed palette root"
CASE SL_EDITOR_SSED_TOOLTIP_TEXT: RETURN "editor ssed tooltip text"
CASE SL_EDITOR_SSED_CAPTION_TEXT: RETURN "editor ssed caption text"
CASE SL_EDITOR_SSED_FRAME_SEPARATOR_TEMPL: RETURN "editor ssed frame separator templ"
CASE SL_EDITOR_ENEMY_SPRITE: RETURN "editor enemy sprite"
CASE SL_ROOT: RETURN "root"
CASE SL_TEXTBOX_TEXT: RETURN "textbox text"
CASE SL_TEXTBOX_PORTRAIT: RETURN "textbox portrait"
CASE SL_TEXTBOX_CHOICE0: RETURN "textbox choice0"
CASE SL_TEXTBOX_CHOICE1: RETURN "textbox choice1"
CASE SL_TEXTBOX_BOX: RETURN "textbox box"
CASE SL_TEXTBOX_PORTRAIT_BOX: RETURN "textbox portrait box"
CASE SL_TEXTBOX_CHOICE_BOX: RETURN "textbox choice box"
CASE SL_TEXTBOX_ROOT: RETURN "textbox root"
CASE SL_SCRIPT_LAYER: RETURN "script layer"
CASE SL_TEXTBOX_LAYER: RETURN "textbox layer"
CASE SL_STRING_LAYER: RETURN "string layer"
CASE SL_RESERVE: RETURN "reserve"
CASE SL_MAPROOT: RETURN "maproot"
CASE SL_OBSOLETE_OVERHEAD: RETURN "obsolete overhead"
CASE SL_MAP_OVERLAY: RETURN "map overlay"
CASE SL_WALKABOUT_LAYER: RETURN "walkabout layer"
CASE SL_HERO_LAYER: RETURN "hero layer"
CASE SL_NPC_LAYER: RETURN "npc layer"
CASE SL_WALKABOUT_SPRITE: RETURN "walkabout sprite"
CASE SL_WALKABOUT_SHADOW: RETURN "walkabout shadow"
CASE SL_BACKDROP: RETURN "backdrop"
CASE SL_MAP_LAYER0: RETURN "map layer0"
CASE SL_MAP_LAYER1: RETURN "map layer1"
CASE SL_MAP_LAYER2: RETURN "map layer2"
CASE SL_MAP_LAYER3: RETURN "map layer3"
CASE SL_MAP_LAYER4: RETURN "map layer4"
CASE SL_MAP_LAYER5: RETURN "map layer5"
CASE SL_MAP_LAYER6: RETURN "map layer6"
CASE SL_MAP_LAYER7: RETURN "map layer7"
CASE SL_MAP_LAYER8: RETURN "map layer8"
CASE SL_MAP_LAYER9: RETURN "map layer9"
CASE SL_MAP_LAYER10: RETURN "map layer10"
CASE SL_MAP_LAYER11: RETURN "map layer11"
CASE SL_MAP_LAYER12: RETURN "map layer12"
CASE SL_MAP_LAYER13: RETURN "map layer13"
CASE SL_MAP_LAYER14: RETURN "map layer14"
CASE SL_MAP_LAYER15: RETURN "map layer15"
CASE SL_STATUS_PORTRAIT: RETURN "status portrait"
CASE SL_STATUS_WALKABOUT: RETURN "status walkabout"
CASE SL_STATUS_BATTLESPRITE: RETURN "status battlesprite"
CASE SL_STATUS_PAGE_SELECT: RETURN "status page select"
CASE SL_STATUS_STATLIST: RETURN "status statlist"
CASE SL_STATUS_HIDE_IF_NO_MP: RETURN "status hide if no mp"
CASE SL_STATUS_HIDE_IF_NO_LMP: RETURN "status hide if no lmp"
CASE SL_STATUS_HIDE_IF_MAX_LEV: RETURN "status hide if max lev"
CASE SL_PLANK_HOLDER: RETURN "plank holder"
CASE SL_STATUS_HIDE_IF_NO_PORTRAIT: RETURN "status hide if no portrait"
CASE SL_ITEM_ITEMLIST: RETURN "item itemlist"
CASE SL_ITEM_EXITBUTTON: RETURN "item exitbutton"
CASE SL_ITEM_SORTBUTTON: RETURN "item sortbutton"
CASE SL_ITEM_TRASHBUTTON: RETURN "item trashbutton"
CASE SL_PLANK_MENU_SELECTABLE: RETURN "plank menu selectable"
CASE SL_SPELL_LISTLIST: RETURN "spell listlist"
CASE SL_SPELL_SPELLLIST: RETURN "spell spelllist"
CASE SL_SPELL_HIDE_IF_NO_LIST: RETURN "spell hide if no list"
CASE SL_SPELL_CANCELBUTTON: RETURN "spell cancelbutton"
CASE SL_VIRTUAL_KEYBOARD_BUTTON: RETURN "virtual keyboard button"
CASE SL_VIRTUAL_KEYBOARD_BUTTONTEXT: RETURN "virtual keyboard buttontext"
CASE SL_VIRTUAL_KEYBOARD_SHIFT: RETURN "virtual keyboard shift"
CASE SL_VIRTUAL_KEYBOARD_SYMBOLS: RETURN "virtual keyboard symbols"
CASE SL_VIRTUAL_KEYBOARD_SELECT: RETURN "virtual keyboard select"
CASE SL_VIRTUAL_KEYBOARD_ENTRYTEXT: RETURN "virtual keyboard entrytext"
CASE SL_VIRTUAL_KEYBOARD_DEL: RETURN "virtual keyboard del"
CASE SL_VIRTUAL_KEYBOARD_ENTER: RETURN "virtual keyboard enter"
CASE SL_SHOP_BUY_INFO_PANEL: RETURN "shop buy info panel"
CASE SL_STATUS_HIDE_IF_NO_HP: RETURN "status hide if no hp"
CASE SL_PATHFIND_DEST_DISPLAY: RETURN "pathfind dest display"
CASE SL_SINGLE_CAPTION_TEXT: RETURN "single caption text"
CASE SL_BATTLE_UI_LAYER: RETURN "battle ui layer"
CASE SL_BATTLE_HERO_INFO_AREA: RETURN "battle hero info area"
CASE SL_BATTLE_HERO_INFO_TEMPLATE: RETURN "battle hero info template"
CASE SL_BATTLE_READY_METER: RETURN "battle ready meter"
CASE SL_BATTLE_READY_METER_PANEL: RETURN "battle ready meter panel"
CASE SL_BATTLE_HP_METER: RETURN "battle hp meter"
CASE SL_BATTLE_HP_METER_PANEL: RETURN "battle hp meter panel"
CASE SL_BATTLE_TEXT_SELECTED_PLAYER: RETURN "battle text selected player"
CASE SL_BATTLE_MP_METER: RETURN "battle mp meter"
CASE SL_BATTLE_MP_METER_PANEL: RETURN "battle mp meter panel"
CASE SL_BATTLE_HERO_INFO_INSTANCE: RETURN "battle hero info instance"
CASE SL_BATTLE_INDICATOR_AREA: RETURN "battle indicator area"
CASE SL_BATTLE_POISON_INDICATOR: RETURN "battle poison indicator"
CASE SL_BATTLE_REGEN_INDICATOR: RETURN "battle regen indicator"
CASE SL_BATTLE_STUN_INDICATOR: RETURN "battle stun indicator"
CASE SL_BATTLE_MUTE_INDICATOR: RETURN "battle mute indicator"
CASE SL_BATTLE_CAPTION_AREA: RETURN "battle caption area"
CASE SL_BATTLE_PLAYER_TURN_OVERLAY: RETURN "battle player turn overlay"
CASE SL_BATTLE_TOGGLE_BOUNCE: RETURN "battle toggle bounce"
CASE SL_BATTLE_TARGETTING_LAYER: RETURN "battle targetting layer"
CASE SL_BATTLE_TARGETTING_TEMPLATE: RETURN "battle targetting template"
CASE SL_BATTLE_TARGETTING_OVERLAY: RETURN "battle targetting overlay"
CASE SL_BATTLE_TARG_HOVER_LAYER: RETURN "battle targ hover layer"
CASE SL_BATTLE_TARG_HOVER_TEMPLATE: RETURN "battle targ hover template"
CASE SL_BATTLE_TARG_HOVER_OVERLAY: RETURN "battle targ hover overlay"
CASE SL_BATTLE_TARG_HOVER_SELECT: RETURN "battle targ hover select"
CASE SL_BATTLE_TARGETTING_CURSOR: RETURN "battle targetting cursor"
CASE SL_BATTLE_TARG_HOVER_CURSOR: RETURN "battle targ hover cursor"
CASE SL_BATTLE_MENU_AREA: RETURN "battle menu area"
'</SLICE LOOKUP NAMES>
CASE IS > 0
'TODO: cache slicelookup() in memory.
'This codepath currently only gets called from debug and error reporting code, so it's not much of a problem.
DIM slicelookup() as string
load_string_list slicelookup(), workingdir & SLASH & "slicelookup.txt"
IF code <= UBOUND(slicelookup) ANDALSO LEN(TRIM(slicelookup(code))) THEN
RETURN slicelookup(code)
END IF
END SELECT
IF use_default THEN RETURN "Lookup" & code
RETURN ""
END FUNCTION
EXTERN "C"
'Warning/TODO: one reason to call this instead of NewRectangleSlice, etc directly is that those
'constructors overwrite some data with defaults. To fix that, just set the defaults in the UDT directly.
FUNCTION NewSliceOfType (byval t as SliceTypes, byval parent as Slice Ptr=0, byval lookup_code as integer=0) as Slice Ptr
DIM newsl as Slice Ptr
SELECT CASE t
CASE slSpecial:
newsl = NewSlice(parent)
newsl->SliceType = slSpecial
newsl->Protect = YES
CASE slContainer:
newsl = NewSlice(parent)
CASE slRectangle:
DIM dat as RectangleSliceData
newsl = NewRectangleSlice(parent, dat)
CASE slLine:
DIM dat as LineSliceData
newsl = NewLineSlice(parent, dat)
CASE slSprite:
DIM dat as SpriteSliceData
newsl = NewSpriteSlice(parent, dat)
CASE slText
DIM dat as TextSliceData
newsl = NewTextSlice(parent, dat)
CASE slMap:
DIM dat as MapSliceData
newsl = NewMapSlice(parent, dat)
newsl->Protect = YES
CASE slGrid:
DIM dat as GridSliceData
newsl = NewGridSlice(parent, dat)
CASE slEllipse:
DIM dat as EllipseSliceData
newsl = NewEllipseSlice(parent, dat)
CASE slScroll:
DIM dat as ScrollSliceData
newsl = NewScrollSlice(parent, dat)
CASE slSelect:
DIM dat as SelectSliceData
newsl = NewSelectSlice(parent, dat)
CASE slPanel:
DIM dat as PanelSliceData
newsl = NewPanelSlice(parent, dat)
CASE slLayout:
DIM dat as LayoutSliceData
newsl = NewLayoutSlice(parent, dat)
CASE ELSE
showbug "NewSliceByType: type " & t & " is invalid"
newsl = NewSlice(parent)
END SELECT
newsl->Lookup = lookup_code
RETURN newsl
END FUNCTION
'Creates a new Container Slice (which can be changed to Special) and optionally, adds it to the heirarchy somewhere
Function NewSlice(byval parent as Slice ptr = 0) as Slice ptr
dim ret as Slice Ptr
ret = new Slice
if ret = 0 then return 0
setSliceParent(ret, parent)
ret->SliceType = slContainer
ret->Visible = YES
ret->Attached = 0
ret->Attach = slSlice
ret->ClampHoriz = alignNone
ret->ClampVert = alignNone
ret->Draw = NULL
ret->Dispose = @DisposeNullSlice
ret->Clone = @CloneNullSlice
ret->Save = @SaveNullSlice
ret->Load = @LoadNullSlice
ret->ChildRefresh = @DefaultChildRefresh
ret->ChildrenRefresh = NULL
ret->ChildDraw = @DefaultChildDraw
#ifdef ENABLE_SLICE_DEBUG
SliceDebugRemember ret
#endif
return ret
End Function
#ifdef IS_GAME
'This shows an error and returns false if a slice has a bad TableSlot
Function CheckTableSlotOK(sl as Slice ptr) as bool
if sl = 0 then return NO
if sl->TableSlot > 0 then
if sl->TableSlot <= ubound(plotslices) then
if plotslices(sl->TableSlot).sl = sl then
return YES
else
showbug "TableSlot mismatch! Slice " & SlicePath(sl) & " slot is " & sl->TableSlot & " which has " & plotslices(sl->TableSlot).sl
end if
else
showbug "TableSlot for " & SlicePath(sl) & " is invalid: " & sl->TableSlot
end if
end if
return NO
End Function
#else
Function CheckTableSlotOK(sl as Slice ptr) as bool
return sl <> 0
End Function
#endif
'Deletes a slice and any descendents, and zeros out *s.
'If debugme is YES, dump some debug info about the slice being freed and all its children
'(debugme > 0 is indentation depth)
Sub DeleteSlice(byval s as Slice ptr ptr, byval debugme as integer=0)
if s = 0 then exit sub 'can't do anything
if *s = 0 then exit sub 'already freed
dim sl as slice ptr = *s
if debugme = -1 then debugme = 1
if debugme > 0 then
debug string(debugme - 1, " ") & DescribeSlice(sl)
'SliceDebugLinks sl, NO, "deleting", debugme - 1
debugme += 1
end if
#ifdef IS_GAME
'unlink this slice from the table of handles if it has an assigned slice handle
if CheckTableSlotOK(sl) then
'Zero out the reference to this slice from the table, but leave .handle alone so
'it will be incremented next time.
plotslices(sl->TableSlot).sl = 0
if sl->TableSlot < next_slice_table_slot then
num_reusable_slice_table_slots += 1
end if
end if
#endif
'Call the slice's type-specific Dispose function
if sl->Dispose <> 0 then sl->Dispose(sl)
OrphanSlice sl
DeleteSliceChildren sl, debugme
#ifdef ENABLE_SLICE_DEBUG
SliceDebugForget sl
#endif
delete sl->Context
v_free sl->ExtraVec
delete sl->AnimState
animset_unload @sl->Animations
delete sl
*s = 0
End Sub
'Deletes a slice's children but not itself
'If debugme is YES, log debug info about the slices.
Sub DeleteSliceChildren(byval sl as Slice ptr, byval debugme as integer = 0)
if sl = 0 then debug "DeleteSliceChildren null ptr": exit sub
dim ch as slice ptr
ch = sl->FirstChild
do while ch
DeleteSlice @ch, debugme
ch = sl->FirstChild
loop
End Sub
Sub OrphanSlice(byval sl as Slice ptr)
'-- Remove a slice from its current parent cleanly,
'-- adjusting siblings, and leaving itself parentless.
if sl = 0 then debug "OrphanSlice null ptr": exit sub
dim as Slice ptr nxt, prv, par
nxt = sl->NextSibling
prv = sl->PrevSibling
par = sl->Parent
if nxt then
nxt->PrevSibling = prv
end if
if prv then
prv->NextSibling = nxt
end if
if par then
if par->FirstChild = sl then
par->FirstChild = nxt
end if
if par->LastChild = sl then
par->LastChild = prv
end if
par->NumChildren -= 1
end if
sl->NextSibling = 0
sl->PrevSibling = 0
sl->Parent = 0
end sub
Sub SetSliceParent(byval sl as Slice ptr, byval parent as Slice ptr)
'Note: might be reparenting a slice to its parent, to make it the last child
if sl = 0 then debug "SetSliceParent null ptr": exit sub
if parent andalso verifySliceLineage(sl, parent) = 0 then
reporterr "Attempted to parent a slice to itself or descendents!", serrBadOp
exit sub
end if
'first, remove the slice from its existing parent
OrphanSlice sl
'then, add ourselves to the new parent
if parent then
if parent->FirstChild = 0 then
parent->FirstChild = sl
end if
if parent->LastChild then
parent->LastChild->NextSibling = sl
sl->PrevSibling = parent->LastChild
end if
parent->LastChild = sl
parent->NumChildren += 1
sl->parent = parent
end if
end sub
Sub AutoSortChildren(byval s as Slice Ptr)
if s = 0 then debug "AutoSortChildren: null ptr": exit sub
select case s->AutoSort
case slAutoSortCustom:
CustomSortChildSlices s, NO
case slAutoSortY:
YSortChildSlices s
case slAutoSortTopY:
EdgeYSortChildSlices s, alignTop
case slAutoSortCenterY:
EdgeYSortChildSlices s, alignCenter
case slAutoSortBottomY:
EdgeYSortChildSlices s, alignBottom
end select
End sub
'Orphan all the children of a slice, and insert pointer to them in slice_list(),
'which must have length equal to number of children!
Sub UnlinkChildren(byval parent as Slice Ptr, slice_list() as Slice ptr)
if parent = 0 then debug "UnlinkChildren: null ptr"
dim temp_sl as Slice ptr = parent->FirstChild
parent->FirstChild = 0
parent->LastChild = 0
parent->NumChildren = 0
dim i as integer
'Convert the children into an unlinked list
for i = 0 to ubound(slice_list)
slice_list(i) = temp_sl
temp_sl = temp_sl->NextSibling
slice_list(i)->PrevSibling = 0
slice_list(i)->NextSibling = 0
slice_list(i)->Parent = 0
next i
end sub
'Set the children of a slice with no children to be equal to
'contents of array of orphaned child slice pointers.
'NOTE: children need to be orphans, and that's not checked.
Sub RelinkChildren(byval parent as Slice Ptr, slice_list() as Slice ptr)
BUG_IF(parent = 0, "null ptr")
BUG_IF(parent->NumChildren <> 0, "Already has children")
dim i as integer
parent->FirstChild = slice_list(0)
parent->LastChild = slice_list(ubound(slice_list))
parent->NumChildren = ubound(slice_list) + 1
'Convert back to a doubly linked list
slice_list(0)->Parent = parent
for i = 1 to ubound(slice_list)
slice_list(i - 1)->NextSibling = slice_list(i)
slice_list(i)->PrevSibling = slice_list(i - 1)
slice_list(i)->Parent = parent
next i
end sub
Sub SwapSiblingSlices(byval sl1 as Slice ptr, byval sl2 as Slice ptr)
'Only intended for use by siblings of the same parent.
'This is slow, but isn't yet used anywhere where that might be a problem.
if sl1 = 0 or sl2 = 0 then EXIT SUB ' Exit quietly when an arg is null. Valid use case for attempted swap at the beginning or end of a list
if sl1 = sl2 then EXIT SUB ' Ignore attempts to swap a slice with itself
if sl1->Parent <> sl2->Parent then reporterr "SwapSiblingSlices: slices are not siblings": EXIT SUB
dim parent as Slice ptr = sl1->Parent
dim slice_list(parent->NumChildren - 1) as Slice ptr
UnlinkChildren parent, slice_list()
'Swap the two siblings
for i as integer = 0 to ubound(slice_list)
if slice_list(i) = sl1 then
slice_list(i) = sl2
elseif slice_list(i) = sl2 then
slice_list(i) = sl1
end if
next i
RelinkChildren parent, slice_list()
end sub
Sub YSortChildSlices(byval parent as Slice ptr)
if parent = 0 then debug "YSortChildSlices: null ptr" : exit sub
if parent->NumChildren = 0 then exit sub
dim slice_list(parent->NumChildren - 1) as Slice ptr
UnlinkChildren parent, slice_list()
'Sort the siblings by Y
dim temp as Slice ptr
dim i as integer
for j as integer = 1 to ubound(slice_list)
temp = slice_list(j)
for i = j - 1 to 0 step -1
if slice_list(i)->Y <= temp->Y then exit for
slice_list(i + 1) = slice_list(i)
next i
slice_list(i + 1) = temp
next j
RelinkChildren parent, slice_list()
end sub
Sub CustomSortChildSlices(byval parent as Slice ptr, byval wipevals as bool)
if parent = 0 then debug "CustomSortChildSlices: null ptr" : exit sub
if parent->NumChildren = 0 then exit sub
dim slice_list(parent->NumChildren - 1) as Slice ptr
UnlinkChildren parent, slice_list()
'Sort the siblings by Sorter
dim temp as Slice ptr
dim i as integer
for j as integer = 1 to ubound(slice_list)
temp = slice_list(j)
for i = j - 1 to 0 step -1
if slice_list(i)->Sorter <= temp->Sorter then exit for
slice_list(i + 1) = slice_list(i)
next i
slice_list(i + 1) = temp
next j
if wipevals then
for j as integer = 0 to ubound(slice_list)
slice_list(j)->Sorter = 0
next
end if
RelinkChildren parent, slice_list()
End sub
Sub EdgeYSortChildSlices(byval parent as Slice ptr, byval edge as AlignType)
if parent = 0 then debug "EdgeYSortChildSlices: null ptr" : exit sub
if parent->NumChildren = 0 then exit sub
dim slice_list(parent->NumChildren - 1) as Slice ptr
UnlinkChildren parent, slice_list()
'Sort the siblings all by the same edge/corner
dim temp as Slice ptr
dim i as integer
for j as integer = 1 to ubound(slice_list)
temp = slice_list(j)
for i = j - 1 to 0 step -1
if slice_list(i)->Y - SliceYAnchor(slice_list(i)) + SliceEdgeY(slice_list(i), edge) <= temp->Y - SliceYAnchor(temp) + SliceEdgeY(temp, edge) then exit for
slice_list(i + 1) = slice_list(i)
next i
slice_list(i + 1) = temp
next j
RelinkChildren parent, slice_list()
end sub
Sub InsertSliceBefore(byval sl as Slice ptr, byval newsl as Slice ptr)
'newsl will be removed from its current parent (if any) and parented to the same
'parent as sl as the child before sl
if sl = 0 then debug "InsertSliceBefore: null sl": EXIT SUB
if newsl = 0 then debug "InsertSliceBefore: null newsl": EXIT SUB
if sl = newsl then EXIT SUB ' Fail quietly when trying to insert a slice as a sibling
' of itself because this is normal if you are using this function
' to move a slice to the beginning of its sibling list when it is
' already the first sibling
if sl->PrevSibling = newsl then EXIT SUB 'already done
if sl->Parent = 0 then reporterr "InsertSliceBefore: Root shouldn't have siblings" : EXIT SUB
'Verify the family
if verifySliceLineage(newsl, sl->Parent) = NO then
reporterr "InsertSliceBefore: attempted to parent a slice to itself or descendents"
EXIT SUB
end if
if newsl->Parent <> 0 then OrphanSlice newsl
'Tell the new sibling about its parent
newsl->Parent = sl->Parent
'If this new sibling is an eldest child, tell the parent
'(not possible to be LastChild)
if sl->Parent->FirstChild = sl then
sl->Parent->FirstChild = newsl
end if
'Tell previous siblings that it has a new sibling.
if sl->PrevSibling <> 0 then
sl->PrevSibling->NextSibling = newsl
end if
'Tell new sibling about its adjacent siblings
newsl->PrevSibling = sl->PrevSibling
newsl->NextSibling = sl
'Tell the supplanted sibling that the new one precedes it
sl->PrevSibling = newsl
'One more mouth to feed...
newsl->Parent->NumChildren += 1
end sub
Sub InsertSliceAfter(byval sl as Slice ptr, byval newsl as Slice ptr)
'newsl will be removed from its current parent (if any) and parented to the same
'parent as sl as the child after sl.
if sl = 0 then debug "InsertSliceAfter: null sl": exit sub
if newsl = 0 then debug "InsertSliceAfter: null newsl": exit sub
if sl = newsl then exit sub ' Fail quietly when trying to insert a slice as a sibling
' of itself because this is normal if you are using this function
' to move a slice to the end of its sibling list
if sl->NextSibling = newsl then exit sub 'already done
if sl->Parent = 0 then reporterr "InsertSliceAfter: Root shouldn't have siblings" : exit sub
if sl->NextSibling then
InsertSliceBefore sl->NextSibling, newsl
else
SetSliceParent newsl, sl->Parent
end if
end sub
Sub ReplaceSliceType(byval sl as Slice ptr, byref newsl as Slice ptr)
'This takes a new slice (normally from one of the New*Slice functions)
'and copies its type and type-specific data over an existing tree member.
'This is rather bizarre, but does make it possible to change into a Class slice.
'Newsl gets Deleted to prevent it from being used afterwards!
'Also, this fails if newsl is part of a tree. It must be parentless
if sl = 0 then debug "ReplaceSliceType null ptr": exit sub
if newsl = 0 then debug "ReplaceSliceType newsl null ptr": exit sub
WITH *newsl
'Make sure that newsl is an orphan already
BUG_IF(.Parent, "Only works with orphaned slices")
'Dispose of any old Slice Type specific data that is about to be replaced
IF sl->SliceData <> 0 THEN sl->Dispose(sl)
'Copy over slice identity
sl->SliceType = .SliceType
sl->Draw = .Draw
sl->Dispose = .Dispose
sl->Clone = .Clone
sl->Save = .Save
sl->Load = .Load
sl->ChildRefresh = .ChildRefresh
sl->ChildrenRefresh = .ChildrenRefresh
sl->ChildDraw = .ChildDraw
sl->SliceData = .SliceData
'Break slice connection to data
.SliceData = 0
'Now destroy newsl
DeleteSlice @newsl
END WITH
End Sub
'If start_sl = NULL: Find first descendent of root_sl (including root_sl itself) which matches lookup and onlytype.
'If start_sl <> NULL: Find next descendent (in depth-first order), after start_sl, of root_sl.
'onlytype: if slInvalid, any type allowed.
Function LookupSlice(byval lookup_code as integer, byval root_sl as Slice ptr, byval onlytype as SliceTypes=slInvalid, start_sl as Slice ptr = NULL) as Slice ptr
IF root_sl = 0 THEN debug "LookupSlice null root slice": RETURN 0
IF lookup_code = 0 THEN RETURN 0 '--fail searching for a zero lookup code
DIM desc as Slice ptr
IF start_sl = 0 THEN
desc = root_sl
ELSE
desc = NextDescendent(start_sl, root_sl)
END IF
WHILE desc
IF desc->Lookup = lookup_code THEN
IF onlytype = slInvalid ORELSE onlytype = desc->SliceType THEN
'If onlytype is invalid (default) then we don't care which type the slice is.
'If onlytype is set, only match lookup codes on slices of the desired type.
RETURN desc '--found it!
END IF
END IF
desc = NextDescendent(desc, root_sl)
WEND
RETURN 0
End Function
'This is intended for built-in menus, to allow continuing gracefully instead of
'crashing, by creating a dummy slice if the slice is missing, and printing a more
'informative error message; if onlytype isn't specified, you get a container.
Function LookupSliceSafe(lookup_code as integer, root_sl as Slice ptr, onlytype as SliceTypes=slInvalid) as Slice ptr
dim ret as Slice ptr = LookupSlice(lookup_code, root_sl, onlytype)
if ret then return ret
debug "Builtin slice collection missing " & iif(onlytype = slInvalid, "any", SliceTypeName(onlytype)) & _
" slice with lookup code " & lookup_code
if onlytype = slInvalid then onlytype = slContainer
return NewSliceOfType(onlytype, root_sl, lookup_code)
End Function
'Calls showerror if the slice is missing, and if you press F6 at the error message enters the slice editor!
Function LookupSliceOrError(lookup_code as integer, root_sl as Slice ptr, onlytype as SliceTypes = slInvalid, slice_description as zstring ptr = @"slice", errlvl as ErrorLevelEnum = errShowError) as Slice ptr
dim ret as Slice ptr = LookupSlice(lookup_code, root_sl, onlytype)
if ret then return ret
'Use the lookup code & message as the "call site" used for ignoring this error message
debugc_internal canyptr(lookup_code + slice_description), errlvl, _
"Couldn't find " & *slice_description & " with lookup '" & SliceLookupCodename(lookup_code) & "'"
if keyval(scF6) then
slice_editor root_sl, SL_COLLECT_EDITOR
end if
return NULL
End Function
'Return the root of the tree by going up.
Function FindRootSlice(slc as Slice ptr) as Slice ptr
dim root as Slice ptr
while slc <> 0
root = slc
slc = root->parent
wend
return root
End Function
' Implements depth-first pre-order traversal of a slice subtree rooted at root_sl
' (pre-order meaning a parent is visited before its childen).
' Initialise desc to root_sl (or root_sl->FirstChild to skip the root),
' and then call NextDescendent repeatedly to get the next descendent.
' Returns NULL after the last one.
' Pass visit_children=NO if you want to skip over the children of the current slice.
Function NextDescendent(desc as Slice ptr, root_sl as Slice ptr, visit_children as bool = YES) as Slice ptr
if desc = NULL then return NULL
' First try to go down, then across, otherwise up as far as needed.
if desc->FirstChild andalso visit_children then return desc->FirstChild
if desc = root_sl then return NULL 'Only for case root_sl has no children
while desc->NextSibling = NULL
desc = desc->Parent
if desc = root_sl or desc = NULL then return NULL
wend
return desc->NextSibling
End Function
'This function returns true if the ancestor slice is a parent or grandparent or great(*) grandparent...
'Returns NO if sl = ancestor.
Function IsAncestor(byval sl as Slice ptr, byval ancestor as Slice ptr) as bool
if sl = 0 THEN debug "IsAncestor null slice": RETURN NO
dim parent as Slice ptr = sl->parent
do while parent
if parent = ancestor then return YES
parent = parent->Parent
loop
return NO
End Function
'this function ensures that we can't set a slice to be a child of itself (or, a child of a child of itself, etc)
'TODO: This should be deleted and replaced with IsAncestor
Function VerifySliceLineage(byval sl as Slice ptr, parent as Slice ptr) as bool
dim s as Slice ptr
if sl = 0 then return NO
s = parent
do while s <> 0
if s = sl then return NO
s = s->parent
loop
return YES
end function
'Returns the 0-based index of this slice among is siblings.
'If including_templates=NO then doesn't count template slices, but beware that if
'called on a template slice it'll share its index with the next sibling.
Function SliceIndexAmongSiblings(sl as Slice Ptr, include_templates as bool = YES) as integer
if sl = 0 then return 0
if sl->parent = 0 then return 0 'The root slice
dim sib as Slice Ptr = sl->parent->FirstChild
dim index as integer = 0
while sib
if sib = sl then return index
if include_templates orelse sib->Template = NO then
index += 1
end if
sib = sib->NextSibling
wend
showbug "slice not a child of its parent"
return 0
End function
'Returns a path like "/Container[1]/Sprite", similiar to an RELOAD node path, from the root slice to this one.
Function SlicePath(sl as Slice ptr) as string
dim ret as string
if sl->Parent then
ret = SlicePath(sl->Parent) & "[" & SliceIndexAmongSiblings(sl) & "]"
end if
ret &= "/" & SliceTypeName(sl)
if sl->Lookup then ret &= "(" & SliceLookupCodename(sl->Lookup) & ")"
return ret
end function
'slice accessors
Function SliceGetParent( byval s as Slice ptr ) as Slice ptr
return s->Parent
End Function
Function SliceGetFirstChild( byval s as Slice ptr ) as Slice ptr
return s->FirstChild
End Function
Function SliceGetLastChild( byval s as Slice ptr ) as Slice ptr
return s->LastChild
End Function
Function SliceGetNextSibling( byval s as Slice ptr ) as Slice ptr
return s->NextSibling
End Function
Function SliceGetPrevSibling( byval s as Slice ptr ) as Slice ptr
return s->PrevSibling
End Function
Function SliceGetNumChildren( byval s as Slice ptr ) as integer
return s->NumChildren
End Function
Function SliceGetX( byval s as Slice ptr ) as integer
return s->X
End Function
Function SliceGetY( byval s as Slice ptr ) as integer
return s->Y
End Function
Function SliceGetScreenX( byval s as Slice ptr ) as integer
return s->ScreenX
End Function
Function SliceGetScreenY( byval s as Slice ptr ) as integer
return s->ScreenY
End Function
Function SliceGetWidth( byval s as Slice ptr ) as integer
return s->Width
End Function
Function SliceGetHeight( byval s as Slice ptr ) as integer
return s->Height
End Function
Function SliceIsVisible( byval s as Slice ptr ) as bool
return s->Visible
End Function
Function SliceIsPaused( byval s as Slice ptr ) as bool
return s->Paused
End Function
Function SliceIsClipping( byval s as Slice ptr ) as bool
return s->Clip
End Function
'slice mutators
Sub SliceSetX( byval s as Slice ptr, byval x as integer )
s->X = x
End Sub
Sub SliceSetY( byval s as Slice ptr, byval y as integer )
s->Y = y
End Sub
Sub SliceSetWidth( byval s as Slice ptr, byval w as integer )
s->Width = w
End Sub
Sub SliceSetHeight( byval s as Slice ptr, byval h as integer )
s->Height = h
End Sub
Sub SliceSetVisibility( byval s as Slice ptr, byval b as bool )
s->Visible = b
End Sub
Sub SliceSetPaused( byval s as Slice ptr, byval b as bool )
s->Paused = b
End Sub
Sub SliceSetClipping( byval s as Slice ptr, byval b as bool )
s->Clip = b
End Sub
'FillMode is so painful to deal with that we need these
'TODO: find a proper solution
Function Slice.FillHoriz() as boolean
return this.Fill andalso this.FillMode <> sliceFillVert
End Function
Function Slice.FillVert() as boolean
return this.Fill andalso this.FillMode <> sliceFillHoriz
End Function
Property Slice.Extra(index as integer) as integer
return get_extra(ExtraVec, index)
End Property
Property Slice.Extra(index as integer, newval as integer)
set_extra(ExtraVec, index, newval)
End Property
'=============================================================================
' Slice contexts
End Extern
Destructor SliceContext()
End Destructor
Sub SliceContext.save(node as Reload.Nodeptr)
End Sub
Sub SliceContext.load(node as Reload.Nodeptr)
End Sub
Sub SliceCollectionContext.load(node as Reload.Nodeptr)
name = LoadPropStr(node, "collection_name")
End Sub
Sub SliceCollectionContext.save(node as Reload.Nodeptr)
if dont_save then exit sub
SaveProp node, "collection_name", name
'id not saved
End Sub
Function SliceCollectionContext.description() as string
dim ret as string = "Collection"
if id > -1 then ret &= " " & id
if len(name) then ret &= " " & name
'Try to indicate that no link with the original collection remains
if dont_save then ret = "From " & ret
return ret
End Function
Extern "C"
'=============================================================================
' Slice types
'--Class-based Slice wrapper--------------------------------------------------
'These wrappers will no longer be needed once we switch to a true polymorphic Slice class
Declare Sub InitClassSlicePtrs(sl as Slice ptr)
Function NewClassSlice(parent as Slice ptr, inst as ClassSlice ptr) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
ret->SliceType = slSpecial
ret->ClassInst = inst
InitClassSlicePtrs ret
inst->initialize(ret)
return ret
End Function
'This is called only from SliceLoadFromNode
Local Function InitClassSliceByName(sl as Slice ptr, classname as string) as bool
if sl->SliceData <> 0 then sl->Dispose(sl)
dim inst as ClassSlice ptr
'if classname = "thing" then
' inst = new ThingClass()
'else
return NO
'end if
sl->SliceType = slSpecial
sl->ClassInst = inst
InitClassSlicePtrs sl
inst->initialize(sl)
return YES
End Function
Sub DisposeClassSlice(sl as Slice ptr)
if sl = 0 orelse sl->ClassInst = 0 then exit sub
delete sl->ClassInst
sl->ClassInst = NULL
End Sub
Sub DrawClassSlice(sl as Slice ptr, page as integer)
if sl = 0 orelse sl->ClassInst = 0 then debug "DrawClassSlice null ptr": exit sub
sl->ClassInst->Draw(sl, page)
End Sub
Sub CloneClassSlice(sl as Slice ptr, cl as Slice ptr)
if sl = 0 orelse sl->ClassInst = 0 then debug "CloneClassSlice null ptr": exit sub
sl->ClassInst->Clone(sl, cl)
End Sub
Sub SaveClassSlice(sl as Slice ptr, node as Reload.Nodeptr)
if sl = 0 orelse sl->ClassInst = 0 orelse node = 0 then debug "SaveClassSlice null ptr": exit sub
sl->ClassInst->Save(sl, node)
End Sub
Sub LoadClassSlice(sl as Slice ptr, node as Reload.Nodeptr)
if sl = 0 orelse sl->ClassInst = 0 orelse node = 0 then debug "LoadClassSlice null ptr": exit sub
sl->ClassInst->Load(sl, node)
End Sub
Sub ClassChildRefresh(sl as Slice ptr, ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
if sl = 0 orelse sl->ClassInst = 0 then debug "ClassSliceChildRefresh null ptr": exit sub
sl->ClassInst->ChildRefresh sl, ch, childindex, visibleonly
End Sub
Sub ClassChildrenRefresh(sl as Slice ptr)
if sl = 0 orelse sl->ClassInst = 0 then debug "ClassSliceChildrenRefresh null ptr": exit sub
sl->ClassInst->ChildrenRefresh sl
End Sub
Sub ClassChildDraw(sl as Slice ptr, page as integer)
if sl = 0 orelse sl->ClassInst = 0 then debug "ClassSliceChildDraw null ptr": exit sub
sl->ClassInst->ChildDraw sl, page
End Sub
Local Sub InitClassSlicePtrs(sl as Slice ptr)
sl->Draw = @DrawClassSlice
sl->Dispose = @DisposeClassSlice
sl->Clone = @CloneClassSlice
sl->Save = @SaveClassSlice
sl->Load = @LoadClassSlice
sl->ChildRefresh = @ClassChildRefresh
sl->ChildrenRefresh = @ClassChildrenRefresh
sl->ChildDraw = @ClassChildDraw
End Sub
'--ClassSlice default methods---------------------------------------------
End Extern
'If part of the initialisation needs the Slice ptr, it can be delayed until this is called
Sub ClassSlice.Initialize(sl as Slice ptr)
End Sub
Destructor ClassSlice()
End Destructor
Sub ClassSlice.Draw(sl as Slice ptr, page as integer)
End Sub
Sub ClassSlice.Clone(sl as Slice ptr, cl as Slice ptr)
showerror "This ClassSlice can't be cloned"
End Sub
Sub ClassSlice.Save(sl as Slice ptr, node as Reload.Nodeptr)
showerror "This ClassSlice can't be saved"
End Sub
'Should never be called
Sub ClassSlice.Load(sl as Slice ptr, node as Reload.Nodeptr)
showerror "This ClassSlice can't be loaded"
End Sub
Sub ClassSlice.ChildRefresh(sl as Slice ptr, ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
DefaultChildRefresh sl, ch, childindex, visibleonly
End Sub
Sub ClassSlice.ChildrenRefresh(sl as Slice ptr)
'Is NULL by default
End Sub
Sub ClassSlice.ChildDraw(sl as Slice ptr, page as integer)
DefaultChildDraw sl, page
End Sub
Extern "C"
'--Rectangle--------------------------------------------------------------
Sub DisposeRectangleSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->RectData = 0 then exit sub
delete sl->RectData
sl->RectData = 0
end sub
Sub UpdateRectangleSliceStyle(byval dat as RectangleSliceData ptr)
IF dat->style >= 0 ANDALSO dat->style <= UBOUND(boxlook) THEN
dat->bgcol = boxlook(dat->style).bgcol
dat->fgcol = boxlook(dat->style).edgecol
dat->border = dat->style
dat->use_raw_box_border = NO
ELSE
debug "bad rect style " & dat->style
END IF
dat->style_loaded = YES
end sub
Sub DrawRectangleSlice(byval sl as Slice ptr, byval p as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
with *sl->RectData
if .style >= 0 and .style_loaded = NO then
UpdateRectangleSliceStyle sl->RectData
end if
dim borderindex as RectBorderTypes
if .use_raw_box_border then
borderindex = .raw_box_border
else
borderindex = lookup_box_border(.border)
end if
draw_box_back vpages(p), sl->ScreenPos, sl->Size, ColorIndex(.bgcol), .translucent, _
.fuzzfactor, .fuzz_stationary, .fuzz_zoom
draw_box_border vpages(p), sl->ScreenPos, sl->Size, ColorIndex(.fgcol), borderindex, .translucent
end with
end sub
Sub CloneRectangleSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneRectangleSlice null ptr": exit sub
dim dat as RectangleSliceData Ptr
dat = sl->RectData
with *cl->RectData
.style = dat->style
.style_loaded= dat->style_loaded 'Doesn't matter
.fgcol = dat->fgcol
.bgcol = dat->bgcol
.translucent = dat->translucent
.border = dat->border
.fuzzfactor = dat->fuzzfactor
.fuzz_stationary = dat->fuzz_stationary
.fuzz_zoom = dat->fuzz_zoom
.use_raw_box_border = dat->use_raw_box_border
.raw_box_border = dat->raw_box_border
end with
end sub
Sub SaveRectangleSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveRectangleSlice null ptr": exit sub
dim dat as RectangleSliceData Ptr
dat = sl->SliceData
if dat->style >= 0 then
SavePropAlways node, "style", dat->style
else
SaveProp node, "fg", dat->fgcol
SaveProp node, "bg", dat->bgcol
if dat->use_raw_box_border then
SavePropAlways node, "raw_box_border", dat->raw_box_border
else
SavePropAlways node, "border", dat->border
end if
end if
SaveProp node, "trans", dat->translucent
if dat->fuzzfactor <> 50 then
SavePropAlways node, "fuzzfactor", dat->fuzzfactor
end if
SaveProp node, "fz_stationary", cint(dat->fuzz_stationary)
if dat->fuzz_zoom <> 1 then
SavePropAlways node, "fz_zoom", dat->fuzz_zoom
end if
End Sub
Sub LoadRectangleSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadRectangleSlice null ptr": exit sub
dim dat as RectangleSliceData Ptr
dat = sl->SliceData
dat->translucent = LoadProp(node, "trans")
dat->fuzzfactor = LoadProp(node, "fuzzfactor", 50)
dat->fuzz_stationary = LoadPropBool(node, "fz_stationary")
dat->fuzz_zoom = LoadProp(node, "fz_zoom", 1)
dat->style = LoadProp(node, "style", -1)
if dat->style >= 0 then
dat->style_loaded = NO
UpdateRectangleSliceStyle dat
else
dat->fgcol = LoadProp(node, "fg")
dat->bgcol = LoadProp(node, "bg")
dat->border = LoadProp(node, "border", borderLine)
dat->raw_box_border = LoadProp(node, "raw_box_border", -1)
dat->use_raw_box_border = (dat->raw_box_border > -1)
if dat->raw_box_border = -1 then dat->raw_box_border = 0
end if
End Sub
Function NewRectangleSlice(byval parent as Slice ptr, byref dat as RectangleSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as RectangleSliceData ptr = new RectangleSliceData
*d = dat
ret->SliceType = slRectangle
ret->SliceData = d
ret->Draw = @DrawRectangleSlice
ret->Dispose = @DisposeRectangleSlice
ret->Clone = @CloneRectangleSlice
ret->Save = @SaveRectangleSlice
ret->Load = @LoadRectangleSlice
return ret
end function
Function GetRectangleSliceData(byval sl as Slice ptr) as RectangleSliceData ptr
if sl = 0 then debug "GetRectangleSliceData null ptr": return 0
return sl->SliceData
End Function
'All arguments default to no-change
Sub ChangeRectangleSlice(byval sl as Slice ptr,_
byval style as integer=-2,_
byval bgcol as integer=colInvalid,_
byval fgcol as integer=colInvalid,_
byval border as RectBorderTypes=borderUndef,_
byval translucent as RectTransTypes=transUndef,_
byval fuzzfactor as integer=0,_
byval raw_box_border as RectBorderTypes=borderUndef)
if sl = 0 then debug "ChangeRectangleSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slRectangle)
with *sl->RectData
'First load the style, if any
if style > -2 then
.use_raw_box_border = NO
.style = style
.style_loaded = NO
end if
if .style >= 0 andalso .style_loaded = NO then
UpdateRectangleSliceStyle sl->RectData
end if
'Then consider all other data as style overrides
if bgcol <> colInvalid then
.bgcol = bgcol
.style = -1
.style_loaded = NO
end if
if fgcol <> colInvalid then
.fgcol = fgcol
.style = -1
.style_loaded = NO
end if
if raw_box_border >= 0 then
.use_raw_box_border = YES
.raw_box_border = raw_box_border
.style = -1
.style_loaded = NO
elseif raw_box_border > borderUndef then
'This is a convenience (and to make this behave the same as the script commands)
border = raw_box_border
end if
if border > borderUndef then
.use_raw_box_border = NO
.border = border
.style = -1
.style_loaded = NO
end if
if translucent <> transUndef then .translucent = translucent
if fuzzfactor > 0 then
.fuzzfactor = fuzzfactor
end if
end with
end sub
'--Line-------------------------------------------------------------------
Sub DisposeLineSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->LineData = 0 then exit sub
delete sl->LineData
sl->LineData = 0
end sub
Sub DrawLineSlice(byval sl as Slice ptr, byval p as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim point2 as XYPair = sl->ScreenPos + sl->Size
dim col as integer = ColorIndex(sl->LineData->col)
'if sl->LineData->flipped then
' drawline sl->ScreenX, point2.y, point2.x, sl->ScreenY, col, p
'else
drawline sl->ScreenX, sl->ScreenY, point2.x, point2.y, col, p
'end if
end sub
Function GetLineSliceData(byval sl as Slice ptr) as LineSliceData ptr
if sl = 0 then return 0
return sl->LineData
End Function
Sub LineSliceData.SetColor(color as integer)
this.col = color
End Sub
Sub CloneLineSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneLineSlice null ptr": exit sub
dim dat as LineSliceData Ptr
dat = sl->LineData
with *cl->LineData
.col = dat->col
'.flipped = dat->flipped
end with
End Sub
Sub SaveLineSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveLineSlice null ptr": exit sub
dim dat as LineSliceData ptr = sl->SliceData
SavePropAlways node, "col", dat->col
'SaveProp node, "flipped", dat->flipped
End Sub
Sub LoadLineSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadLineSlice null ptr": exit sub
dim dat as LineSliceData ptr = sl->SliceData
dat->col = LoadProp(node, "col")
'dat->flipped = LoadPropBool(node, "flipped")
End Sub
Function NewLineSlice(byval parent as Slice ptr, byref dat as LineSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as LineSliceData ptr = new LineSliceData
*d = dat
ret->SliceType = slLine
ret->SliceData = d
ret->Draw = @DrawLineSlice
ret->Dispose = @DisposeLineSlice
ret->Clone = @CloneLineSlice
ret->Save = @SaveLineSlice
ret->Load = @LoadLineSlice
return ret
end function
'--Text-------------------------------------------------------------------
Declare Sub UpdateTextSliceHeight(byval sl as Slice ptr, lines() as string)
Declare Sub NewUpdateTextSlice(byval sl as Slice ptr)
Sub DisposeTextSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim dat as TextSliceData ptr = sl->SliceData
delete dat
sl->SliceData = 0
end sub
Sub WrapTextSlice(byval sl as Slice ptr, lines() as string)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim dat as TextSliceData ptr = sl->SliceData
dim d as string
if dat->wrap then
dim wide as integer
if sl->Width > 7 then
wide = sl->Width \ 8
else
wide = large(1, (get_resolution().w - sl->ScreenX) \ 8)
end if
d = wordwrap(dat->s, wide)
else
d = dat->s
end if
split(d, lines())
'--set line count based on the current wrapped size
dat->line_count = UBOUND(lines) + 1
End sub
'Get the 'wide' parameter to render_text, etc
Local Function TextSliceRenderTextWide(sl as Slice ptr, dat as TextSliceData ptr) as integer
if dat->Wrap then
if sl->Width > 7 then 'FIXME: this should be reduced for smaller fonts
return sl->Width
else
return large(1, get_resolution().w - sl->ScreenX)
end if
else
return 999999999
end if
end function
'New render_text-based drawing of Text slices. Only used when dat->use_render_text
Sub NewDrawTextSlice(byval sl as Slice ptr, byval p as integer, col as integer)
dim dat as TextSliceData ptr = sl->SliceData
'dat->line_limit is not yet supported (render_text ought to be extended for it)
'If the slice wraps, then its height changes any time that its width does
'FIXME: we should update the size in ChildRefresh/ChildrenRefresh() instead,
'but that's a more difficult fix; this is better than nothing
'TODO: since this is expensive, don't call this every time we draw, but just when
'when the size might have changed.
NewUpdateTextSlice sl
dim text as string = dat->s
dim wide as integer = TextSliceRenderTextWide(sl, dat)
dim fontnum as integer = iif(dat->fontnum, dat->fontnum, iif(dat->outline, fontEdged, fontPlain))
if fontnum > ubound(fonts) then fontnum = 0 'Silent failure; might have loaded slices from a different game
dat->insert_tog = dat->insert_tog xor 1
if dat->show_insert then
'Figure out where the insert cursor is and draw it
dim charpos as StringCharPos
find_text_char_position(@charpos, text, dat->insert, wide, fontnum)
dim insert_pos as XYPair = sl->ScreenPos + charpos.pos
rectangle(vpages(p), XY_WH(insert_pos, charpos.size), uilook(eduiTextCursor + dat->insert_tog))
end if
textcolor col, ColorIndex(dat->bgcol)
wrapprint text, sl->ScreenX, sl->ScreenY, , p, wide, YES, fontnum
end sub
Sub DrawTextSlice(byval sl as Slice ptr, byval p as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim subtimer as TimerIDs
if gfx_slice_timer.enabled then
subtimer = gfx_slice_timer.substart(TimerIDs.Text)
end if
dim dat as TextSliceData ptr = sl->SliceData
dim col as integer = dat->col
if col = 0 then col = uilook(uiText) '--This is backcompat for before it was possible to choose uiText directly using ColorIndex
col = ColorIndex(col)
if dat->use_render_text then
NewDrawTextSlice sl, p, col
if subtimer then gfx_slice_timer.substop subtimer
exit sub
end if
dim lines() as string
WrapTextSlice sl, lines()
dim line_starts() as integer
split_line_positions dat->s, lines(), line_starts()
'If the slice wraps, then its height changes any time that its width does
'FIXME: we should update the size in ChildRefresh/ChildrenRefresh() instead,
'but that's a more difficult fix; this is better than nothing
UpdateTextSliceHeight sl, lines()
dat->insert_tog = dat->insert_tog xor 1
dim insert_size as integer = 8
if dat->outline then insert_size = 9
dat->first_line = large(0, dat->first_line)
dim last_line as integer = ubound(lines)
if dat->line_limit <> -1 then last_line = small(last_line, dat->first_line + dat->line_limit - 1)
for linenum as integer = dat->first_line to last_line
dim ypos as integer
ypos = (linenum - dat->first_line) * 10
if dat->show_insert then
dim offset_in_line as integer '0-based offset
offset_in_line = dat->insert - line_starts(linenum)
dim next_line as integer = iif(linenum = last_line, len(dat->s) + 1, line_starts(linenum + 1))
'The insert cursor might point to a space or newline after the end of the line or end of text
if offset_in_line >= 0 and dat->insert < next_line then
rectangle sl->screenx + offset_in_line * 8, sl->screeny + ypos, insert_size, insert_size, uilook(uiHighlight + dat->insert_tog), p
end if
end if
if dat->outline then
edgeprint lines(linenum), sl->screenx, sl->screeny + ypos, col, p
else
textcolor col, ColorIndex(dat->bgcol)
printstr lines(linenum), sl->screenx, sl->screeny + ypos, p
end if
next
if subtimer then gfx_slice_timer.substop subtimer
end sub
'New render_text-based updating of Text slice size. Only used when dat->use_render_text
Sub NewUpdateTextSlice(byval sl as Slice ptr)
dim dat as TextSliceData ptr = sl->SliceData
'dat->line_limit not supported yet
dim fontnum as integer = iif(dat->outline, fontEdged, fontPlain)
dim wide as integer = TextSliceRenderTextWide(sl, dat)
dim size as XYPair = textsize(dat->s, wide, fontnum, YES)
sl->Height = size.h
if dat->Wrap = NO then sl->Width = size.w
end sub
'Update the size of text slice. This only happens when you call ChangeTextSlice.
'(Note: this must be called after WrapTextSlice() has set dat->line_count)
Sub UpdateTextSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim dat as TextSliceData ptr = sl->SliceData
if dat->use_render_text then
NewUpdateTextSlice sl
exit sub
end if
'--Note that automatic setting of wrapped text height doesn't matter if this slice is set ->Fill = YES the parent fill height will override
dim lines() as string
WrapTextSlice sl, lines()
UpdateTextSliceHeight sl, lines()
'Update width
if dat->Wrap = NO then
sl->Width = textWidth(dat->s)
else
'--Wrapped text does not change the slice width. Do that manually (or by setting ->Fill = YES)
end if
end sub
'Return the position, relative to the slice position, of character in the string
'(Note: this assumes use_render_text; text wrapping may not be identical otherwise)
Function TextSliceCharPos(sl as Slice ptr, charnum as integer) as XYPair
if sl = 0 orelse sl->SliceData = 0 then return XY(0, 0)
dim dat as TextSliceData ptr = sl->SliceData
dim wide as integer = TextSliceRenderTextWide(sl, dat)
dim fontnum as integer = iif(dat->outline, fontEdged, fontPlain)
dim charpos as StringCharPos
find_text_char_position(@charpos, dat->s, charnum, wide, fontnum)
return charpos.pos
end function
Local Sub UpdateTextSliceHeight(byval sl as Slice ptr, lines() as string)
dim dat as TextSliceData ptr = sl->SliceData
dim high as integer
high = dat->line_count
if dat->line_limit > -1 then 'If not unlimited
high = small(high, dat->line_limit)
end if
sl->Height = high * 10
end sub
Function GetTextSliceData(byval sl as Slice ptr) as TextSliceData ptr
if sl = 0 then debug "GetTextSliceData null ptr": return 0
return sl->SliceData
End Function
Sub CloneTextSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneTextSlice null ptr": exit sub
dim dat as TextSliceData Ptr
dat = sl->TextData
with *cl->TextData
.s = dat->s
.col = dat->col
.outline = dat->outline
.wrap = dat->wrap
.bgcol = dat->bgcol
end with
end sub
Sub SaveTextSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveTextSlice null ptr": exit sub
DIM dat as TextSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "s", dat->s
SaveProp node, "col", dat->col
SaveProp node, "outline", dat->outline
SaveProp node, "wrap", dat->wrap
SaveProp node, "bgcol", dat->bgcol
End Sub
Sub LoadTextSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadTextSlice null ptr": exit sub
dim dat as TextSliceData Ptr
dat = sl->SliceData
dat->s = LoadPropStr(node, "s")
dat->col = LoadProp(node, "col")
dat->outline = LoadPropBool(node, "outline")
dat->wrap = LoadPropBool(node, "wrap")
dat->bgcol = LoadProp(node, "bgcol")
'Ensure that width is correct, because it's currently only set when something changes,
'and I have seen it saved wrong (e.g. due to a bug in etheldreme)
UpdateTextSlice sl
End Sub
Function NewTextSlice(byval parent as Slice ptr, byref dat as TextSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as TextSliceData ptr = new TextSliceData
*d = dat
ret->SliceType = slText
ret->SliceData = d
ret->Draw = @DrawTextSlice
ret->Dispose = @DisposeTextSlice
ret->Clone = @CloneTextSlice
ret->Save = @SaveTextSlice
ret->Load = @LoadTextSlice
ret->Width = textwidth(d->s)
'split(d->s, d->lines())
return ret
end function
'All arguments default to no-change
Sub ChangeTextSlice(byval sl as Slice ptr,_
s as string=CHR(1) & CHR(255),_
byval col as integer=colInvalid,_
byval outline as optbool=NONBOOL,_
byval wrap as optbool=NONBOOL,_
byval bgcol as integer=colInvalid)
if sl = 0 then debug "ChangeTextSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slText)
with *sl->TextData
if s <> CHR(1) & CHR(255) then
.s = s
end if
if col <> colInvalid then
.col = col
end if
if bgcol <> colInvalid then
.bgcol = bgcol
end if
if outline <> NONBOOL then
.outline = outline <> 0
end if
if wrap <> NONBOOL then
.wrap = wrap <> 0
end if
end with
UpdateTextSlice sl
end sub
'--Sprite-----------------------------------------------------------------
Declare Sub LoadAssetSprite(sl as Slice ptr, warn_if_missing as bool = YES)
' Frees any memory held by a sprite, leaving in a consistent state, but does not reset its type and other data
Sub UnloadSpriteSlice(byval sl as Slice ptr)
with *sl->SpriteData
unload_sprite_and_pal .img
frame_unload @.original_img
if .assetfile then
*.assetfile = "" ' Frees the string contents
deallocate .assetfile ' Free the string descriptor
.assetfile = NULL
end if
.loaded = NO
end with
End Sub
Sub DisposeSpriteSlice(byval sl as Slice ptr)
if sl = 0 orelse sl->SpriteData = 0 then exit sub
UnloadSpriteSlice sl
delete sl->SpriteData
sl->SpriteData = 0
end sub
'Draw an X
Local Function frame_load_dummy(size as XYPair) as Frame ptr
dim ret as Frame ptr = frame_new(size.w, size.h, , YES)
drawline ret, 0, 0, size.w - 1, size.h - 1, uilook(uiSelectedItem)
drawline ret, size.w - 1, 0, 0, size.h - 1, uilook(uiSelectedItem)
return ret
end Function
' Load a sprite's Frame and Palette16, so that its size is known
' Afterwards, the Frame ptr won't be NULL, unless sl->SliceData doesn't exist.
Sub LoadSpriteSliceImage(byval sl as Slice ptr, warn_if_missing as bool = NO)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
with *sl->SpriteData
if .img.sprite then
'.loaded is true
if .img_gen <> .original_img->generation then .loaded = NO
'Check whether need to reload the graphic because it needs to be re-scaled (.scaled),
if .scaled then
if .img.sprite->Size <> sl->Size then .loaded = NO
else
'You can't resize a sprite slice, except by using Fill (for backcompat,
'yuck). (CoverChildren isn't allowed on sprites.) But a spriteset's size can
'change, or fill mode might change, so we need to reset its size. It's too
'hard to tell whether a spriteset changed size without storing the old size,
'so we just unconditionally reset the size here, which happens on every
'DrawSpriteSlice call.
'This may not be the ideal place to put this code.
'NOTE: it's this code alone that prevents a Sprite slice's size from being changed
'in the slice editor. That's pretty ugly.
if sl->Fill /'orelse sl->CoverChildren <> coverNone'/ then
if sl->FillHoriz() = NO /'andalso (sl->CoverChildren and coverHoriz) = 0'/ then
sl->Width = .img.sprite->w
end if
if sl->FillVert() = NO /'andalso (sl->CoverChildren and coverVert) = 0'/ then
sl->Height = .img.sprite->h
end if
else 'sl->CoverChildren = coverNone and sl->Fill = NO and .scaled = NO and zoom = 1.
sl->Size = .img.sprite->size
end if
end if
end if
if .loaded then exit sub
'Load the sprite
if .spritetype = sprTypeFrame then
'Either an asset sprite, or SetSpriteToFrame was used in which case this just
'reverts to .original_img
LoadAssetSprite sl, warn_if_missing
else
load_sprite_and_pal .img, .spritetype, .record, .pal 'Unloads old sprite/pal
end if
.loaded = YES 'Set YES even if loading failed, so we don't try again
if .img.sprite = NULL then
' Draw an X (the actual width and height were hopefully loaded from a .slice file)
if sl->Width <= 0 or sl->Height <= 0 then sl->Size = XY(16,16)
.img.sprite = frame_load_dummy(sl->Size)
end if
frame_assign @.original_img, frame_reference(.img.sprite)
.img_gen = .original_img->generation
.frame = bound(.frame, 0, .img.sprite->arraylen - 1)
'Update slice size and possibly scale the sprite
if .scaled then
if .img.sprite->size <> sl->Size then
'Becomes a 32-bit sprite
frame_assign @.img.sprite, frame_scaled32(@.img.sprite[.frame], sl->Width, sl->Height, master(), .img.pal)
palette16_unload @.img.pal
'Should set .paletted = NO? But the removal of the palette is reversible
end if
else
sl->Size = .img.sprite->size
end if
end with
end sub
Sub DrawSpriteSlice(byval sl as Slice ptr, byval page as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
with *sl->SpriteData
dim subtimer as TimerIDs
if gfx_op_timer.enabled then
if .dissolving then
subtimer = TimerIDs.Dissolve
elseif .rotate or .zoom <> 1. or .flipHoriz or .flipVert then
'Though surfaces don't support DrawOptions.scale yet
subtimer = TimerIDs.Rotozoom
elseif .drawopts.with_blending then
subtimer = TimerIDs.Blend
end if
if subtimer then subtimer = gfx_op_timer.substart(subtimer)
end if
LoadSpriteSliceImage sl
dim spr as Frame ptr
dim have_copy as bool = NO
spr = .img.sprite
if spr = 0 then
if subtimer then gfx_op_timer.substop subtimer
showbug "null slice .sprite ptr"
sl->Visible = NO 'prevent error loop
exit sub
end if
if .frame >= spr->arraylen or .frame < 0 then
'Shouldn't happen, as LoadSpriteSliceImage, ChangeSpriteSlice, LoadSpriteSlice, set_frame[id] all ensure validity
debugc errBug, "out of range frame " & .frame & " for slice " & SlicePath(sl)
.frame = 0
end if
'Only a single frame is scaled and cached
if .scaled = NO then
spr = @spr[.frame]
end if
if spr->image = NULL then
'This is a Surface-backed slice, and flipping and dissolving aren't supported yet.
.flipHoriz = NO
.flipVert = NO
.dissolving = NO
end if
'some redesign needed to prevent this continous flipping
if .flipHoriz then
if have_copy = NO THEN spr = frame_duplicate(spr)
have_copy = YES
frame_flip_horiz(spr)
end if
if .flipVert then
if have_copy = NO THEN spr = frame_duplicate(spr)
have_copy = YES
frame_flip_vert(spr)
end if
'Rotozooming
if .rotate orelse .zoom <> 1. then
'FIXME: have_copy leak! (Ought to add h/v flip options to the rotozoomer to avoid copies)
'Negate rotation so angle is clockwise
spr = frame_rotozoom(spr, .img.pal, -.rotate, .zoom, .zoom, .rz_smooth)
if spr = 0 then exit sub
have_copy = YES
if .dissolving then
'Kludge: frame_rotozoom returns an 8-bit Surface-backed Frame, which frame_dissolved doesn't yet support.
'Convert into a normal Frame, but only if needed, because it does a copy.
frame_drop_surface spr
end if
end if
dim drew as bool = NO
if .dissolving then
dim dtime as integer = .d_time
if dtime = -1 then dtime = (sl->Width + sl->Height) / 10
if dtime > 0 then
dim dtick as integer
if .d_back then
dtick = dtime - .d_tick
else
dtick = .d_tick
end if
frame_draw_dissolved spr, .img.pal, sl->ScreenX, sl->ScreenY, .trans, vpages(page), .drawopts, dtime, dtick, .d_type
drew = YES
'FIXME: d_auto shouldn't take effect here, but when the slice is 'advanced'
if .d_auto then
.d_tick += 1
if .d_tick > dtime then
.dissolving = NO
.d_auto = NO
end if
end if
end if
end if
'static watch as SmoothedTimer
'if .drawopts.with_blending then watch.start()
if drew = NO then
frame_draw spr, .img.pal, sl->ScreenX, sl->ScreenY, .trans, page, .drawopts
end if
'if .drawopts.with_blending then watch.stop_and_print()
if have_copy then
frame_unload(@spr)
end if
if subtimer then gfx_op_timer.substop subtimer
end with
end sub
' Load .img.sprite for an asset sprite slice. If the assetfile is "", unloads .img with no warning.
' This sub doesn't update .original_img, assumes the caller does.
Local Sub LoadAssetSprite(sl as Slice ptr, warn_if_missing as bool = YES)
BUG_IF(sl = 0, "null ptr")
with *sl->SpriteData
unload_sprite_and_pal .img
dim assetfile as string
if .assetfile then
assetfile = *.assetfile
else
'SetSpriteToFrame was used. We can't load an image, but we can revert to the original (pre-scaling)
.img.sprite = frame_reference(.original_img)
exit sub
end if
dim filename as string = finddatafile(assetfile, NO) 'Handle missing file ourselves
if len(filename) then
if .load_asset_as_32bit then
.img.sprite = image_import_as_frame_32bit(filename)
else
dim transp_color as RGBcolor 'Black. TODO: this should be stored in dat and customisabled
.img.sprite = image_import_as_frame_8bit(filename, master(), , transp_color)
end if
end if
if .img.sprite = NULL then
if warn_if_missing andalso len(assetfile) then
visible_debug "Data file " & iif(len(filename), "corrupt", "missing") _
& !":\n" & assetfile _
& !"\nThe OHRRPGCE apparently isn't installed properly. Try reinstalling, or report this error."
end if
end if
end with
End Sub
' Turn a sprite slice into an 'asset' sprite, meaning it is loaded from an image in the data/ dir.
' assetname should be the name of a file in data/, or can be blank if that isn't decided yet (in slice editor).
' Warning: once a Sprite is an asset sprite it can't turn back into a normal sprite using ChangeSpriteSlice, etc,
' as sl->assetfile is only reset by UnloadSpriteSlice
Sub SetSpriteToAsset(sl as Slice ptr, assetfile as string, warn_if_missing as bool = YES)
BUG_IF(sl = 0, "null ptr")
UnloadSpriteSlice sl
with *sl->SpriteData
.spritetype = sprTypeFrame
.assetfile = callocate(sizeof(string))
*.assetfile = assetfile
.record = 0
.frame = 0
.paletted = NO
.pal = -1
end with
LoadSpriteSliceImage sl, warn_if_missing
End Sub
' Provide an external image for this sprite slice, instead of one of the game's sprites.
' fr will be unloaded when the sprite is deleted. Use frame_reference() to avoid this.
' Either pass pal16: an already loaded Palette16 (which will be freed when the slice is deleted),
' or pal: a palette number, or neither if the Frame is not paletted (indexes the master palette directly).
Sub SetSpriteToFrame(sl as Slice ptr, fr as Frame ptr, pal16 as Palette16 ptr = NULL, pal as integer = -2)
if sl = 0 then debug "SetSpriteToFrame null ptr": exit sub
if pal = -1 then showbug "SetSpriteToFrame: a default palette can't be used" : pal = 0
UnloadSpriteSlice sl
with *sl->SpriteData
.spritetype = sprTypeFrame
.img.sprite = fr
.original_img = frame_reference(fr)
.img_gen = fr->generation
.record = -1
.frame = 0
'.trans preserved
if pal16 then
.img.pal = pal16
.paletted = YES
elseif pal <> -2 then
.img.pal = palette16_load(pal)
.paletted = YES
else
.paletted = NO
end if
.pal = pal
if fr then
sl->Width = fr->w
sl->Height = fr->h
.loaded = YES
end if
end with
End Sub
'Zoom and rotate settings aren't cloned!
Sub CloneSpriteSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneSpriteSlice null ptr": exit sub
dim dat as SpriteSliceData Ptr = sl->SpriteData
with *cl->SpriteData
.spritetype = dat->spritetype
if dat->assetfile then
.assetfile = callocate(sizeof(string))
*.assetfile = *dat->assetfile
end if
.load_asset_as_32bit = dat->load_asset_as_32bit
.record = dat->record
.paletted = dat->paletted
.pal = dat->pal
.frame = dat->frame
.flipHoriz = dat->flipHoriz
.flipVert = dat->flipVert
.scaled = dat->scaled
.trans = dat->trans
.dissolving = dat->dissolving
.d_type = dat->d_type
.d_time = dat->d_time
.d_tick = dat->d_tick
.d_back = dat->d_back
.d_auto = dat->d_auto
.drawopts = dat->drawopts
if .spritetype = sprTypeFrame then
.img.sprite = frame_reference(dat->img.sprite)
.img.pal = palette16_reference(dat->img.pal)
.original_img = frame_reference(dat->original_img)
.loaded = dat->loaded
.img_gen = dat->img_gen
else
'.img and .loaded remain NULLs, NO
end if
end with
end sub
Local Sub SaveDrawOpts(drawopts as DrawOptions, node as Reload.Nodeptr)
with drawopts
SaveProp node, "blend", cast(bool, .with_blending)
SaveProp node, "blend_mode", .blend_mode
if .opacity < 1. then SavePropAlways node, "opacity", .opacity
'scale: not saved yet
end with
end sub
Sub SaveSpriteSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
BUG_IF(sl = 0 or node = 0, "null ptr")
dim dat as SpriteSliceData Ptr
dat = sl->SpriteData
SavePropAlways node, "sprtype", dat->spritetype
if dat->spritetype = sprTypeFrame then
' If it's not an asset sprite, then the Frame came from an unknown source and can't be saved
BUG_IF(dat->assetfile = NULL, "tried to save Frame sprite")
SavePropAlways node, "asset", *dat->assetfile
SaveProp node, "32bit_asset", dat->load_asset_as_32bit
else
SavePropAlways node, "rec", dat->record
if dat->paletted then
SavePropAlways node, "pal", dat->pal
end if
'We prefer to load frameid, but still save frame for older versions
SaveProp node, "frameid", dat->get_frameid(sl)
SaveProp node, "frame", dat->frame
end if
SaveProp node, "fliph", dat->flipHoriz
SaveProp node, "flipv", dat->flipVert
SaveProp node, "scaled", dat->scaled
SavePropAlways node, "trans", dat->trans
SavePropBool node, "dissolving", dat->dissolving
SaveProp node, "d_type", dat->d_type
SaveProp node, "d_time", dat->d_time
SaveProp node, "d_tick", dat->d_tick
SaveProp node, "d_back", cint(dat->d_back)
SaveProp node, "d_auto", cint(dat->d_auto)
SaveDrawOpts dat->drawopts, node
end sub
Local Sub LoadDrawOpts(drawopts as DrawOptions, node as Reload.Nodeptr)
with drawopts
.with_blending = LoadProp(node, "blend")
.blend_mode = bound(LoadProp(node, "blend_mode"), 0, blendModeLAST)
.opacity = bound(LoadPropFloat(node, "opacity", 1.0), 0., 1.)
'scale: not loaded yet
end with
end sub
Sub LoadSpriteSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadSpriteSlice null ptr": exit sub
dim dat as SpriteSliceData Ptr
dat = sl->SliceData
dat->spritetype = LoadProp(node, "sprtype")
if dat->spritetype < sprTypeFirst orelse dat->spritetype > sprTypeLastPickable then
reporterr "LoadSpriteSlice: Unknown type " & dat->spritetype, serrError
dat->spritetype = sprTypeFirst
elseif dat->spritetype >= sprTypeFirstLoadable then 'not sprTypeFrame
dat->record = LoadProp(node, "rec")
with sprite_sizes(dat->spritetype)
if dat->record < 0 orelse dat->record > .lastrec then
reporterr "LoadSpriteSlice: Invalid " & .name & " spriteset " & dat->record, serrError
dat->record = 0
end if
end with
end if
dat->paletted = sprite_sizes(dat->spritetype).paletted
dat->pal = LoadProp(node, "pal", -1)
dat->flipHoriz = LoadPropBool(node, "fliph")
dat->flipVert = LoadPropBool(node, "flipv")
dat->trans = LoadPropBool(node, "trans", YES)
dat->scaled = LoadPropBool(node, "scaled")
dat->dissolving = LoadPropBool(node, "dissolving")
dat->d_type = bound(LoadProp(node, "d_type"), 0, dissolveTypeMax)
dat->d_time = large(LoadProp(node, "d_time"), -1)
dat->d_tick = bound(LoadProp(node, "d_tick"), -1, large(dat->d_time + 1, 0))
dat->d_back = LoadPropBool(node, "d_back")
dat->d_auto = LoadPropBool(node, "d_auto")
LoadDrawOpts dat->drawopts, node
'Load frameid if it exists, or fallback to frame in old files
'(If the frameid doesn't exist, we shouldn't fallback to loading "frame")
dim frameid as integer = LoadProp(node, "frameid", -1)
if frameid <> -1 then
dat->set_frameid(sl, frameid)
else
dat->set_frame(sl, LoadProp(node, "frame"))
end if
if dat->spritetype = sprTypeFrame then
dat->load_asset_as_32bit = LoadPropBool(node, "32bit_asset")
SetSpriteToAsset sl, LoadPropStr(node, "asset")
elseif dat->loaded = NO then 'set_frame[id] already loads it
'Load the sprite already in order to ensure the size is correct
LoadSpriteSliceImage sl
end if
End Sub
Function NewSpriteSlice(byval parent as Slice ptr, byref dat as SpriteSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as SpriteSliceData ptr = new SpriteSliceData
*d = dat
'Set non-zero defaults
d->pal = -1
d->trans = YES
d->paletted = YES
d->zoom = 1.
ret->SliceType = slSprite
ret->SliceData = d
ret->Draw = @DrawSpriteSlice
ret->Dispose = @DisposeSpriteSlice
ret->Clone = @CloneSpriteSlice
ret->Save = @SaveSpriteSlice
ret->Load = @LoadSpriteSlice
return ret
end function
'All arguments default to no-change
Sub ChangeSpriteSlice(byval sl as Slice ptr,_
byval spritetype as SpriteType = sprTypeInvalid,_
byval record as integer=-1,_
byval pal as integer = -2,_
byval frame as integer = -1,_
byval fliph as optbool = NONBOOL,_
byval flipv as optbool = NONBOOL,_
byval trans as optbool = NONBOOL)
if sl = 0 then debug "ChangeSpriteSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slSprite)
with *sl->SpriteData
if spritetype <> sprTypeInvalid then
BUG_IF(spritetype < sprTypeFirstLoadable orelse spritetype > sprTypeLastLoadable, "Invalid type " & spritetype)
.spritetype = spritetype
.loaded = NO
.paletted = sprite_sizes(spritetype).paletted
end if
if record >= 0 then
.record = record
.loaded = NO
end if
if pal >= -1 then
if .paletted = NO then
reporterr "Attempt to set a palette (" & pal & ") on an unpaletted " & sprite_sizes(.spritetype).name & " sprite slice"
else
.pal = pal
.loaded = NO
end if
end if
if frame >= 0 andalso .frame <> frame then
if .loaded then
.set_frame(sl, frame)
else
'LoadSpriteSliceImage will check it
.frame = frame
end if
'Only a single frame is scaled and cached, so need to reload when it changes
if .scaled then .loaded = NO
end if
if fliph <> NONBOOL then .flipHoriz = (fliph <> 0)
if flipv <> NONBOOL then .flipVert = (flipv <> 0)
if trans <> NONBOOL then .trans = (trans <> 0)
if .loaded = NO then
unload_sprite_and_pal .img
frame_unload @.original_img
SpriteSliceUpdate sl
end if
end with
end sub
'Called after .spritetype, .record, .palette or .assetfile, or .frame when .scaled=YES, is changed...
'however for .palette or .assetfile I think you can call LoadSpriteSliceImage directly instead?
'Internal use only - normally you should call ChangeSpriteSlice instead
Sub SpriteSliceUpdate(sl as Slice ptr)
BUG_IF(sl = 0 orelse sl->SliceType <> slSprite, "invalid ptr")
with *sl->SpriteData
.paletted = sprite_sizes(.spritetype).paletted 'Note this doesn't apply when using SetSpriteToFrame
if .spritetype = sprTypeFrame then
' Aside from reloading if edited, .assetfile is initially NULL
' when switching to sprTypeFrame, so needs to be initialised to "".
' Note that if you change to a different sprite type, .assetfile
' will still be there, but won't be used or saved
dim assetfile as string = iif(.assetfile, *.assetfile, "")
SetSpriteToAsset sl, assetfile, NO
'If it's a 32-bit sprite (is converted to 32-bit when scaled)...
if .load_asset_as_32bit orelse .scaled then
'Transparent 32 bit Surfaces not yet supported
.trans = NO
'frame_flip_* and frame_dissolved don't support Surfaces either
.dissolving = NO
.flipHoriz = NO
.flipVert = NO
end if
else
.record = bound(.record, 0, sprite_sizes(.spritetype).lastrec)
'Reload the sprite image (and palette) immediately, so that the size of the slice
'and number of frames are correct. This will bound .frame
.loaded = NO 'Force reload
LoadSpriteSliceImage sl
end if
end with
end sub
Function SpriteSliceData.get_num_frames(sl as Slice ptr) as integer
if this.loaded = NO then LoadSpriteSliceImage sl
'Use original_img because it has the full set of frames, if scaled=YES then .img.sprite is just one frame
return this.original_img->arraylen
end function
'If group = -1, returns num frames in current group
Function SpriteSliceData.get_num_frames_in_group(sl as Slice ptr, group as integer = -1) as integer
if this.loaded = NO then LoadSpriteSliceImage sl
if group < 0 then group = this.frame \ 100
'Use original_img because it has the full set of frames, if scaled=YES then .img.sprite is just one frame
return num_frames_in_group(this.original_img, group)
end function
'Public. Far more efficient than ChangeSpriteSlice
Sub SpriteSliceData.set_frame(sl as Slice ptr, frameidx as integer)
if frameidx < 0 then exit sub
if this.loaded = NO orelse this.scaled then
this.frame = frameidx
'Clamps this.frame
SpriteSliceUpdate sl
else
if frameidx < this.img.sprite->arraylen then this.frame = frameidx
end if
end sub
Function SpriteSliceData.get_frameid(sl as Slice ptr) as integer
if this.loaded = NO then LoadSpriteSliceImage sl
'Use original_img in case scaled=YES, as above
return this.original_img[this.frame].frameid
end function
'Returns new frame index, or -1 on failure.
'If exact=NO, switch to the last frame in the frame group if frameid is out of range.
Function SpriteSliceData.set_frameid(sl as Slice ptr, frameid as integer, exact as bool = NO) as integer
if this.loaded = NO then LoadSpriteSliceImage sl
dim frameidx as integer
'Use original_img in case scaled=YES, as above
frameidx = frameid_to_frame(this.original_img, frameid, exact)
if frameidx > -1 then set_frame sl, frameidx
return frameidx
end function
'Returns frame index, or -1 if not found
Function SpriteSliceData.find_frameid(sl as Slice ptr, frameid as integer, exact as bool = NO) as integer
if this.loaded = NO then LoadSpriteSliceImage sl
'Use original_img in case scaled=YES, as above
return frameid_to_frame(this.original_img, frameid, exact)
end function
'Cause the sprite to be scaled/stretched to a certain size.
'TODO: once scaled sprites are available in games, uncomment the relevant code in valid_resizeable_slice.
'Size can't be negative (Maybe handle negatives by setting flipVert and flipHoriz?)
Sub ScaleSpriteSlice(sl as Slice ptr, size as XYPair)
if sl = 0 then debug "ScaleSpriteSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slSprite)
with *sl->SpriteData
.loaded = NO
unload_sprite_and_pal .img
frame_unload @.original_img
.scaled = YES
sl->Size = size
'Reload so that number of frames is known
LoadSpriteSliceImage sl
end with
end sub
Sub DissolveSpriteSlice(byval sl as Slice ptr, byval dissolve_type as integer, byval over_ticks as integer=-1, byval start_tick as integer=0, byval backwards as bool=NO, byval auto_animate as bool=YES)
if sl = 0 then debug "DissolveSpriteSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slSprite)
with *sl->SpriteData
.dissolving = YES
'(Note that the bounds checking here and in LoadSpriteSlice is bypassed by the slice editor)
.d_type = bound(dissolve_type, 0, dissolveTypeMax)
.d_time = over_ticks
'Allow -1 (for when backwards) and length+1 so that can you set Vaporize animation to a totally blank state:
'it takes one tick longer than the others. (The slice editor allows larger values...)
.d_tick = bound(start_tick, -1, large(over_ticks + 1, 0))
.d_back = backwards <> 0
.d_auto = auto_animate <> 0
end with
end sub
Sub CancelSpriteSliceDissolve(sl as Slice ptr)
if sl = 0 then debug "CancelSpriteSliceDissolve null ptr" : exit sub
ASSERT_SLTYPE(sl, slSprite)
with *sl->SpriteData
.dissolving = NO
.d_auto = NO
end with
end sub
Function SpriteSliceIsDissolving(byval sl as Slice ptr, byval only_auto as bool=YES) as bool
if sl = 0 then debug "SpriteSliceIsDissolving null ptr" : return NO
if sl->SliceType <> slSprite then return NO 'Not an error
with *sl->SpriteData
if only_auto <> NO andalso not .d_auto then return NO
return .dissolving
end with
end function
'--Map-----------------------------------------------------------------
Sub DisposeMapSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
delete sl->MapData
sl->MapData = 0
end sub
Sub DrawMapSlice(byval sl as Slice ptr, byval page as integer)
' MapSlices are sadly exceptions to the slice system. Their size is ignored.
' Instead, they are drawn to cover the whole current clipping region.
' Their position corresponds to the camera offset.
' Map layer 0 acts as if its size is actually infinitely large, including extending
' up/left of 0. The map edge tile is drawn outside the map if the map is set to 'Crop',
' despite it appearing as 'N/A' in the map editor.
' Higher map layers are actually drawn to match their nominal size, unless the map
' is set to 'Wrap', in which case they fill the whole clipping region.
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
with *sl->MapData
if .tiles = 0 then exit sub 'tilemap ptr null if the layer doesn't exist. This slice probably shouldn't either.
if .tileset = 0 then exit sub 'quit silently on a null tileset ptr
'2nd, 3rd arguments to drawmap are "camera position" of upper left of the screen.
'static watch as SmoothedTimer
'if .drawopts.with_blending then watch.start()
var subtimer = gfx_slice_timer.substart(TimerIDs.Map)
drawmap *.tiles, sl->ScreenX * -1, sl->ScreenY * -1, .tileset, page, .transparent, .overlay, .pass, , , , .drawopts
'if .drawopts.with_blending then watch.stop_and_print()
gfx_slice_timer.substop subtimer
end with
end sub
Sub SaveMapSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveMapSlice null ptr": exit sub
'FIXME: current MapSlice impl. has no savable properties
end sub
Sub LoadMapSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadMapSlice null ptr": exit sub
'FIXME: current MapSlice impl. has no savable properties
End Sub
Function NewMapSlice(byval parent as Slice ptr, byref dat as MapSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as MapSliceData ptr = new MapSliceData
*d = dat
ret->SliceType = slMap
ret->SliceData = d
ret->Draw = @DrawMapSlice
ret->Dispose = @DisposeMapSlice
'--No cloning support for Map slice yet
'ret->Clone = @CloneMapSlice
ret->Save = @SaveMapSlice
ret->Load = @LoadMapSlice
return ret
end function
Sub ChangeMapSliceTileset(byval sl as Slice ptr, byval tileset as TilesetData ptr)
if sl = 0 then debug "ChangeMapSliceTileset null ptr" : exit sub
ASSERT_SLTYPE(sl, slMap)
sl->MapData->tileset = tileset
end sub
Sub ChangeMapSlice(byval sl as Slice ptr,_
byval tiles as TileMap ptr = cast(TileMap ptr, 1),_
byval pass as TileMap ptr = cast(TileMap ptr, 1),_
byval transparent as optbool=NONBOOL,_
byval overlay as integer=-1)
if sl = 0 then debug "ChangeMapSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slMap)
with *sl->MapData
if tiles <> cast(TileMap ptr, 1) then
.tiles = tiles
if tiles = NULL then
sl->Width = 0
sl->Height = 0
else
sl->Size = tiles->size * 20
end if
end if
if tiles <> cast(TileMap ptr, 1) then
'--passmap. If this slice doesn't draw overhead tiles, can set this to NULL
.pass = pass
end if
if transparent <> NONBOOL then
.transparent = (transparent <> 0)
end if
if overlay >= 0 and overlay <= 2 then
'--used for backcompat with overhead tiles on layer 0
.overlay = overlay 'valid values 0, 1, 2
end if
end with
end sub
'--Grid-------------------------------------------------------------------
Sub DisposeGridSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->GridData = 0 then exit sub
delete sl->GridData
sl->GridData = 0
end sub
Sub DrawGridSlice(byval sl as Slice ptr, byval p as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim dat as GridSliceData ptr = sl->SliceData
if dat->show then
drawbox sl->screenx, sl->screeny, sl->width, sl->height, uilook(uiText), 1, p
dim w as integer = sl->width \ large(1, dat->cols)
dim h as integer = sl->height \ large(1, dat->rows)
for row as integer = 0 to dat->rows - 1
for col as integer = 0 to dat->cols - 1
'drawbox sl->screenx + col * w, sl->screeny + row * h, w, h, uilook(uiText), 1, p
rectangle sl->screenx + col * w, sl->screeny + row * h, w, 1, uilook(uiText), p
rectangle sl->screenx + col * w, sl->screeny + row * h, 1, h, uilook(uiText), p
next col
next row
end if
end sub
Sub CloneGridSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneGridSlice null ptr": exit sub
dim dat as GridSliceData ptr = sl->GridData
with *cl->GridData
.cols = dat->cols
.rows = dat->rows
.show = dat->show
end with
end sub
Sub SaveGridSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveGridSlice null ptr": exit sub
DIM dat as GridSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "cols", dat->cols
SavePropAlways node, "rows", dat->rows
SavePropAlways node, "show", dat->show
End Sub
Sub LoadGridSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadGridSlice null ptr": exit sub
dim dat as GridSliceData Ptr
dat = sl->SliceData
dat->cols = large(1, LoadProp(node, "cols", 1))
dat->rows = large(1, LoadProp(node, "rows", 1))
dat->show = LoadPropBool(node, "show")
End Sub
'Computes ScreenX/Y, and also sets the width/height if filling
Sub GridChildRefresh(byval par as Slice ptr, byval ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
if ch = 0 then debug "GridChildRefresh null ptr": exit sub
if visibleonly andalso ch->Visible = NO then exit sub 'Don't need to exclude template slices
dim dat as GridSliceData ptr = par->GridData
dim w as integer = par->Width \ large(1, dat->cols)
dim h as integer = par->Height \ large(1, dat->rows)
'--Figure out which child this is
if childindex < 0 then childindex = SliceIndexAmongSiblings(ch, template_slices_shown)
dim xslot as integer = childindex mod large(1, dat->cols)
dim yslot as integer = childindex \ large(1, dat->cols)
dim support as RectType = any
support.xy = par->ScreenPos + XY(par->paddingLeft + xslot * w, par->paddingTop + yslot * h)
support.wide = w - par->paddingLeft - par->paddingRight
support.high = h - par->paddingTop - par->paddingBottom
RefreshChild ch, support
End sub
Sub GridChildDraw(byval s as Slice Ptr, byval page as integer)
'NOTE: this Sub only handles the clipping of the children of a Grid slice which
' is set to clip. It might seem the logical place to position the children
' too, but that's in GridChildRefresh. Drawing
' and calculating position are independent.
'NOTE: we don't bother to null check s here because this sub is only
' ever called from DrawSliceRecurse which does null check it.
if s->SliceType <> slGrid then debug "GridChildDraw illegal slice type": exit sub
if s->Clip = NO then
'no special behaviour
'TODO: it would be better to call DefaultChildDraw in all cases, which we could do
'if it called a method to get the support of each child.
DefaultChildDraw s, page
exit sub
end if
with *s
'if .ChildrenRefresh then .ChildrenRefresh(s) 'Always NULL
dim dat as GridSliceData ptr = .GridData
dim w as integer = .Width \ large(1, dat->cols)
dim h as integer = .Height \ large(1, dat->rows)
'draw the slice's children
dim ch as Slice ptr = .FirstChild
dim childindex as integer = 0
for yslot as integer = 0 to dat->rows - 1
for xslot as integer = 0 to dat->cols - 1
while ch andalso ShouldSkipSlice(ch) 'Skip templates
ch = ch->NextSibling
wend
if ch = 0 then exit for, for
dim clippos as XYPair
clippos.x = .ScreenX + xslot * w
clippos.y = .ScreenY + yslot * h
dim rememclip as ClipState = get_cliprect()
if shrinkclip(clippos.x + .paddingLeft, _
clippos.y + .paddingTop, _
clippos.x + w - .paddingRight - 1, _
clippos.y + h - .paddingBottom - 1, _
vpages(page)) then
'This child isn't clipped
DrawSliceRecurse(ch, page, childindex)
end if
get_cliprect() = rememclip
ch = ch->NextSibling
childindex += 1
next
next
end with
End Sub
Function NewGridSlice(byval parent as Slice ptr, byref dat as GridSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as GridSliceData ptr = new GridSliceData
*d = dat
'--Set non-zero defaults here
d->cols = 1
d->rows = 1
ret->SliceType = slGrid
ret->SliceData = d
ret->Draw = @DrawGridSlice
ret->Dispose = @DisposeGridSlice
ret->Clone = @CloneGridSlice
ret->Save = @SaveGridSlice
ret->Load = @LoadGridSlice
ret->ChildRefresh = @GridChildRefresh
ret->ChildDraw = @GridChildDraw
return ret
end function
Function GetGridSliceData(byval sl as Slice ptr) as GridSliceData ptr
if sl = 0 then debug "GetGridSliceData null ptr": return 0
return sl->SliceData
End Function
'All arguments default to no-change
Sub ChangeGridSlice(byval sl as Slice ptr,_
byval rows as integer=0,_
byval cols as integer=0,_
byval show as optbool=NONBOOL)
if sl = 0 then debug "ChangeGridSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slGrid)
dim dat as GridSliceData Ptr = sl->SliceData
if rows > 0 then
dat->rows = rows
end if
if cols > 0 then
dat->cols = cols
end if
if show <> NONBOOL then
dat->show = (show <> 0)
end if
end sub
'--Layout-----------------------------------------------------------------
Sub DisposeLayoutSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
dim dat as LayoutSliceData ptr = sl->SliceData
delete dat
sl->SliceData = 0
end sub
'Skip over hidden slices as needed
Function LayoutSliceData.SkipForward(ch as Slice ptr) as Slice ptr
' ch = ch->NextSibling
while ch andalso ShouldSkipSlice(ch, skip_hidden)
ch = ch->NextSibling
wend
return ch
end Function
'Calculate offsets of children in a row along axis0, and the breadth of the row.
'Offsets don't including parent's padding.
Sub LayoutSliceData.SpaceRow(par as Slice ptr, first as Slice ptr, axis0 as integer, dir0 as integer, byref offsets as integer vector, byref breadth as integer)
v_resize offsets, 0 'clear
dim available_size as integer 'Max length of a row
available_size = par->Size.n(axis0)
if axis0 = 0 then
available_size -= par->PaddingLeft + par->PaddingRight
else
available_size -= par->PaddingTop + par->PaddingBottom
end if
dim offset as integer = 0 ' along axis 0
breadth = this.min_row_breadth ' in axis 1
first = SkipForward(first)
dim as Slice ptr ch = first, last
'Should never happen
if ch = 0 then showbug "SpaceRow: no children" : exit sub
while ch
'Always place at least one child on each row
if ch <> first then
if offset + ch->Size.n(axis0) > available_size then
'Can't fit any more on this row
exit while
end if
end if
dim temp as integer = dir0 * offset
if dir0 = -1 then temp += available_size - ch->Size.n(axis0)
v_append offsets, temp
offset += ch->Size.n(axis0) + this.primary_padding
breadth = large(breadth, ch->Size.n(1 xor axis0))
ch = SkipForward(ch->NextSibling)
wend
dim is_last_row as bool = (ch = NULL)
dim row_length as integer = offset - this.primary_padding 'We added the padding once too many
dim extra_space as integer = available_size - row_length 'at the end of the row
dim shift as integer = 0 'To add to each offset
if v_len(offsets) > 1 andalso justified then
'(This implies extra_space >= 0.)
'Add extra spacing to cause the children to be spaced out across the row.
dim spacing as double = extra_space / (v_len(offsets) - 1)
if is_last_row and last_row_justified = NO then
'Try to use the same amount of spacing as the row above
spacing = small(spacing, _previous_row_spacing)
end if
_previous_row_spacing = spacing
for idx as integer = 1 to v_len(offsets) - 1
offsets[idx] += dir0 * int(idx * spacing)
next
else
'Handle row_alignment, possibly shifting the whole row
if dir0 = -1 then shift = -extra_space
select case this.row_alignment
case alignLeft:
case alignMiddle: shift += extra_space \ 2
case alignRight: shift += extra_space
end select
end if
'Handle parent padding in the primary dir
select case this.primary_dir
case dirUp, dirDown: shift += par->PaddingTop
case dirLeft, dirRight: shift += par->PaddingLeft
end select
if shift <> 0 then
for idx as integer = 0 to v_len(offsets) - 1
offsets[idx] += shift
next
end if
end Sub
Sub LayoutSliceData.Validate()
if (this.primary_dir and 1) = (this.secondary_dir and 1) then
'The directions aren't orthogonal
this.secondary_dir = (this.primary_dir and 1) xor 1
end if
'Could do everything else too...
end Sub
'Layout slices work
Sub LayoutChildrenRefresh(byval par as Slice ptr)
if par = 0 then debug "LayoutChildrenRefresh null ptr": exit sub
dim dat as LayoutSliceData ptr
dat = par->SliceData
dat->Validate()
dim as integer axis0, axis1 'primary and secondary axes: 0 or 1 for x or y
dim as integer dir0, dir1 '1 if offsets are measured from top or left, -1 otherwise
select case dat->primary_dir
case dirLeft: axis0 = 0 : axis1 = 1 : dir0 = -1
case dirRight: axis0 = 0 : axis1 = 1 : dir0 = 1
case dirUp: axis0 = 1 : axis1 = 0 : dir0 = -1
case dirDown: axis0 = 1 : axis1 = 0 : dir0 = 1
end select
select case dat->secondary_dir
case dirLeft: dir1 = -1
case dirRight: dir1 = 1
case dirUp: dir1 = -1
case dirDown: dir1 = 1
end select
dim offsets as integer vector
v_new offsets
dim offset as XYPair 'Offset of the next child, relative to par
dim breadth as integer
select case dat->secondary_dir
case dirDown: offset.Y = par->PaddingTop
case dirUp: offset.Y = par->Height - par->PaddingBottom
case dirRight: offset.X = par->PaddingLeft
case dirLeft: offset.X = par->Width - par->PaddingRight
end select
dat->_previous_row_spacing = 0
'Initial loop over children to process Fill (TODO: maybe clamp should be handled here as well)
'(Unlike normal Fill, we don't ignore the .X/.Y members of a filling child)
dim support as RectType = any
support.wide = par->Width - par->paddingLeft - par->paddingRight
support.high = par->Height - par->paddingTop - par->paddingBottom
dim as Slice ptr ch = par->FirstChild
while ch
if ch->Fill andalso ch->IsShown then
if ch->FillMode = sliceFillFull ORELSE ch->FillMode = sliceFillHoriz then
ch->Width = support.wide
end if
if ch->FillMode = sliceFillFull ORELSE ch->FillMode = sliceFillVert then
ch->Height = support.high
end if
end if
ch = ch->NextSibling
wend
'Now calculate positions of each visible child
ch = dat->SkipForward(par->FirstChild)
while ch
dat->SpaceRow(par, ch, axis0, dir0, offsets, breadth)
'Iterate over each child on this row and set the final position
for idx as integer = 0 to v_len(offsets) - 1
with *ch
offset.n(axis0) = offsets[idx]
' offset.n(axis0) = dir0 * offsets[idx]
' if dir0 = -1 then offset.n(axis0) += par->Size.n(axis0) - .Size.n(axis0)
'The child's X/Y offsets it from its computed position,
'but doesn't affect the positioning out of anything else.
'Anchor, align points, clamping and Fill are ignored. Probably none of these make sense.
.ScreenX = par->ScreenX + offset.x + .X
.ScreenY = par->ScreenY + offset.y + .Y
dim within_cell_space as integer = breadth - .Size.n(axis1) 'Always positive if Size is non-negative
if dir1 = -1 then .ScreenPos.n(axis1) -= .Size.n(axis1) + within_cell_space
select case dat->cell_alignment
case alignLeft:
case alignMiddle: .ScreenPos.n(axis1) += within_cell_space \ 2
case alignRight: .ScreenPos.n(axis1) += within_cell_space
end select
end with
ch = dat->SkipForward(ch->NextSibling)
' ch = ch->NextSibling
' if skip_hidden then
' while ch andalso ch->IsShown = NO
' ch->ScreenPos = par->ScreenPos
' ch = ch->NextSibling
' wend
' end if
next
offset.n(axis1) += dir1 * (breadth + dat->secondary_padding)
wend
v_free offsets
end sub
Function GetLayoutSliceData(byval sl as Slice ptr) as LayoutSliceData ptr
if sl = 0 then return 0
return sl->SliceData
End Function
Sub CloneLayoutSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneLayoutSlice null ptr": exit sub
*cl->LayoutData = *sl->LayoutData
end sub
Sub SaveLayoutSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveLayoutSlice null ptr": exit sub
dim dat as LayoutSliceData ptr
dat = sl->SliceData
SavePropAlways node, "dir0", dat->primary_dir
SavePropAlways node, "dir1", dat->secondary_dir
SaveProp node, "padding0", dat->primary_padding
SaveProp node, "padding1", dat->secondary_padding
SaveProp node, "skip_hidden", dat->skip_hidden
SaveProp node, "min_breadth", dat->min_row_breadth
SaveProp node, "justified", dat->justified
if dat->justified then
SaveProp node, "last_row_justified", dat->last_row_justified
else
SaveProp node, "row_align", dat->row_alignment
end if
SaveProp node, "cell_align", dat->cell_alignment
End Sub
Sub LoadLayoutSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadLayoutSlice null ptr": exit sub
dim dat as LayoutSliceData Ptr
dat = sl->SliceData
dat->primary_dir = LoadProp(node, "dir0")
dat->secondary_dir = LoadProp(node, "dir1")
dat->primary_padding = LoadProp(node, "padding0")
dat->secondary_padding = LoadProp(node, "padding1")
dat->skip_hidden = LoadPropBool(node, "skip_hidden")
dat->justified = LoadPropBool(node, "justified")
dat->last_row_justified = LoadPropBool(node, "last_row_justified")
dat->min_row_breadth = LoadProp(node, "min_breadth")
dat->cell_alignment = LoadProp(node, "cell_align")
dat->row_alignment = LoadProp(node, "row_align")
dat->Validate()
End Sub
Function NewLayoutSlice(byval parent as Slice ptr, byref dat as LayoutSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as LayoutSliceData ptr = new LayoutSliceData
*d = dat
ret->SliceType = slLayout
ret->SliceData = d
ret->Draw = NULL
ret->Dispose = @DisposeLayoutSlice
ret->Clone = @CloneLayoutSlice
ret->Save = @SaveLayoutSlice
ret->Load = @LoadLayoutSlice
ret->ChildRefresh = @NullChildRefresh
ret->ChildrenRefresh = @LayoutChildrenRefresh
return ret
end function
'--Ellipse----------------------------------------------------------------
Sub DisposeEllipseSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->EllipseData = 0 then exit sub
frame_unload @sl->EllipseData->frame
delete sl->EllipseData
sl->EllipseData = 0
end sub
Sub DrawEllipseSlice(byval sl as Slice ptr, byval p as integer)
if sl = 0 then exit sub
if sl->SliceData = 0 then exit sub
with *sl->EllipseData
dim w as integer = ABS(sl->Width)
dim h as integer = ABS(sl->Height)
if .frame = 0 _
ORELSE .last_draw_size.X <> w _
ORELSE .last_draw_size.Y <> h _
ORELSE .last_draw_bordercol <> .bordercol _
ORELSE .last_draw_fillcol <> .fillcol then
if sl->Width = 0 ORELSE sl->Height = 0 then exit sub
frame_unload @.frame
'debug "create new ellipse frame " & w & "x" & h
.frame = frame_new(w, h, , YES)
'fuzzyrect .frame, 0, 0, w, h, .fillcol, 37
dim fillcol as integer = .fillcol
'EllipseSliceData.fillcol 0 means transparent, while ellipse() uses -1 to mean transparent
'NOTE: Drawing bordercol or fillcol 0 will be transparent anyway, because when .frame
'gets drawn to the videopage, colour 0 counts as transparent. So fillcol=-1 is just an optimisation.
if fillcol = 0 then fillcol = -1 else fillcol = ColorIndex(fillcol)
dim saveclip as ClipState = get_cliprect()
ellipse .frame, w / 2 - 0.5, h / 2 - 0.5 , w / 2 - 0.5, ColorIndex(.bordercol), fillcol, h / 2 - 0.5
get_cliprect() = saveclip
.last_draw_size.X = w
.last_draw_size.Y = h
.last_draw_bordercol = .bordercol
.last_draw_fillcol = .fillcol
end if
BUG_IF(.frame = 0, "null frame ptr")
frame_draw .frame, , small(sl->screenX, sl->screenX + sl->Width), small(sl->screenY, sl->screenY + sl->Height), , p
' ellipse vpages(p), small(sl->screenX, sl->screenX + sl->Width) + w / 2 - 0.5, small(sl->screenY, sl->screenY + sl->Height) + h / 2 - 0.5 , w / 2 - 0.5, .bordercol, fillcol, h / 2 - 0.5
end with
end sub
Sub CloneEllipseSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneEllipseSlice null ptr": exit sub
dim dat as EllipseSliceData Ptr
dat = sl->EllipseData
with *cl->EllipseData
.bordercol = dat->bordercol
.fillcol = dat->fillcol
'.last_draw_* left at zero to force a redraw
'.frame will be populated on next draw
end with
end sub
Sub SaveEllipseSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveEllipseSlice null ptr": exit sub
DIM dat as EllipseSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "bordercol", dat->bordercol
SavePropAlways node, "fillcol", dat->fillcol
end sub
Sub LoadEllipseSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadEllipseSlice null ptr": exit sub
dim dat as EllipseSliceData Ptr
dat = sl->SliceData
dat->bordercol = LoadProp(node, "bordercol")
dat->fillcol = LoadProp(node, "fillcol")
End Sub
Function NewEllipseSlice(byval parent as Slice ptr, byref dat as EllipseSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as EllipseSliceData ptr = new EllipseSliceData
*d = dat
'Set defaults
d->bordercol = 0
d->fillcol = 0
ret->SliceType = slEllipse
ret->SliceData = d
ret->Draw = @DrawEllipseSlice
ret->Dispose = @DisposeEllipseSlice
ret->Clone = @CloneEllipseSlice
ret->Save = @SaveEllipseSlice
ret->Load = @LoadEllipseSlice
return ret
end function
'All arguments default to no-change
Sub ChangeEllipseSlice(byval sl as Slice ptr,_
byval bordercol as integer=colInvalid,_
byval fillcol as integer=colInvalid)
if sl = 0 then debug "ChangeEllipseSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slEllipse)
with *sl->EllipseData
if bordercol <> colInvalid then
.bordercol = bordercol
end if
if fillcol <> colInvalid then
.fillcol = fillcol
end if
end with
end sub
'--Scroll--------------------------------------------------------------
Sub DisposeScrollSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->ScrollData = 0 then exit sub
delete sl->ScrollData
sl->ScrollData = 0
end sub
'Computes the bounding box of all visible descendents of a slice, up to a maximum
'check_depth (1 means just children, 2 is grandchildren, etc, 0 is infinite).
'This function works for any type of slice
Sub CalcSliceContentsSize(sl as Slice ptr, byref min as XYPair, byref max as XYPair, check_depth as integer, cur_depth as integer=0)
if cur_depth = 0 then
'0,0 might not be in the min-max range of the contents, so initialise
min = sl->ScreenPos
max = sl->ScreenPos + sl->Size
else
min.x = small(min.x, sl->ScreenX)
min.y = small(min.y, sl->ScreenY)
max.x = large(max.x, sl->ScreenX + sl->Width)
max.y = large(max.y, sl->ScreenY + sl->Height)
end if
if not (check_depth = 0 orelse cur_depth < check_depth) then exit sub
dim ch as Slice ptr = sl->FirstChild
do while ch
if ch->IsShown then
CalcSliceContentsSize ch, min, max, check_depth, cur_depth + 1
end if
ch = ch->NextSibling
Loop
End Sub
Sub ScrollChildDraw(byval sl as Slice ptr, byval p as integer)
'NOTE: draws the scrollbars *after* all children have drawn, which is in
' stark contrast to how most other slices are drawn.
'NOTE: we don't bother to null check s here because this sub is only
' ever called from DrawSliceRecurse which does null check it.
'First draw the children normally
DefaultChildDraw sl, p
'Then proceed with the scrollbars
if benchmarking_slice = sl then benchmarking_draw_timer.start()
dim dat as ScrollSliceData ptr = sl->SliceData
dim min as XYPair
dim max as XYPair
CalcSliceContentsSize(sl, min, max, dat->check_depth)
dim axis as integer
dim other as integer
for axis = 0 to 1 '0=Horiz 1=Vert
other = axis XOR 1
dim off as integer = sl->ScreenPos.n(axis) - min.n(axis)
dim total as integer = max.n(axis) - min.n(axis)
if total > sl->Size.n(axis) then
dim sbar as RectType
dim slider as RectType
with sbar
.topleft.n(axis) = sl->ScreenPos.n(axis)
.topleft.n(other) = sl->ScreenPos.n(other) + sl->Size.n(other)
.size.n(axis) = sl->Size.n(axis)
.size.n(other) = 4
end with
rectangle vpages(p), sbar, boxlook(dat->style).bgcol
with slider
.topleft = sbar.topleft
.topleft.n(axis) += sbar.size.n(axis) / total * off
.size.n(axis) = sbar.size.n(axis) / total * (sl->Size.n(axis) + 1)
.size.n(other) = 4
end with
rectangle vpages(p), slider, boxlook(dat->style).edgecol
end if
next axis
if benchmarking_slice = sl then benchmarking_draw_timer.stop()
end sub
Sub CloneScrollSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneScrollSlice null ptr": exit sub
dim dat as ScrollSliceData Ptr
dat = sl->ScrollData
with *cl->ScrollData
.style = dat->style
.check_depth = dat->check_depth
end with
end sub
Sub SaveScrollSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveScrollSlice null ptr": exit sub
DIM dat as ScrollSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "style", dat->style
SaveProp node, "check_depth", dat->check_depth
End Sub
Sub LoadScrollSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadScrollSlice null ptr": exit sub
dim dat as ScrollSliceData Ptr
dat = sl->SliceData
dat->style = LoadProp(node, "style", 0)
dat->check_depth = LoadProp(node, "check_depth")
End Sub
Function NewScrollSlice(byval parent as Slice ptr, byref dat as ScrollSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
'--override the default value of Clip
ret->Clip = YES
dim d as ScrollSliceData ptr = new ScrollSliceData
*d = dat
'--Set non-zero defaults here
'if there were any
ret->SliceType = slScroll
ret->SliceData = d
ret->ChildDraw = @ScrollChildDraw
ret->Dispose = @DisposeScrollSlice
ret->Clone = @CloneScrollSlice
ret->Save = @SaveScrollSlice
ret->Load = @LoadScrollSlice
return ret
end function
'All arguments default to no-change
Sub ChangeScrollSlice(byval sl as Slice ptr,_
byval style as integer=-1,_
byval check_depth as integer=-1)
if sl = 0 then debug "ChangeScrollSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slScroll)
with *sl->ScrollData
if style >= 0 then
.style = style
end if
if check_depth >= 0 then
.check_depth = check_depth
end if
end with
end sub
Sub ScrollAllChildren(byval sl as Slice ptr, byval xmove as integer, byval ymove as integer)
'Shift all children's X/Y by an offset.
'Doesn't work on Grid slices, which ignore X/Y, but should work on Layout.
'This is intended for ScrollSlice, but can actually work on any type.
if sl = 0 then debug "ScrollAllChildren: null scroll slice ptr": exit sub
if sl->SliceType = slGrid then reporterr "ScrollAllChildren: can't scroll a Grid slice": exit sub
dim ch as Slice ptr = sl->FirstChild
do while ch
'Filling slices ignore X/Y, so don't cause X/Y to go crazy
if ch->FillHoriz = NO then ch->X += xmove
if ch->FillVert = NO then ch->Y += ymove
ch = ch->NextSibling
loop
end sub
Sub ScrollToChild(byval sl as Slice ptr, byval desc as Slice ptr, byval apply_padding as bool = YES)
'Similar to SliceClamp, but shifts all children of sl so that desc (which is any desendent
'of sl) is within the bounds of sl. Ignores padding if apply_padding=NO.
'This is intended for ScrollSlice, but can actually work on any type except Grid.
if sl = 0 then debug "ScrollToChild: null scroll slice ptr": exit sub
if desc = 0 then debug "ScrollToChild: null descendent slice ptr": exit sub
if not IsAncestor(desc, sl) then reporterr "ScrollToChild: can't scroll to a slice that's not a descendant": exit sub
'If the child of sl which desc is a descendent of is set to Fill, then
'this function won't work. Too much trouble to check for though.
RefreshSliceScreenPos desc
dim support as RectType = XY_WH(sl->ScreenPos, sl->Size)
if apply_padding then
support.x += sl->paddingLeft
support.y += sl->paddingTop
support.wide -= sl->paddingLeft + sl->paddingRight
support.high -= sl->paddingTop + sl->paddingBottom
end if
dim xmove as integer = 0
dim ymove as integer = 0
dim diff as integer
diff = (support.y + support.high) - (desc->ScreenY + desc->Height)
if diff < 0 then ymove = diff
diff = support.y - desc->ScreenY
if diff > 0 then ymove = diff
diff = (support.x + support.wide) - (desc->ScreenX + desc->Width)
if diff < 0 then xmove = diff
diff = support.x - desc->ScreenX
if diff > 0 then xmove = diff
if xmove <> 0 orelse ymove <> 0 then
ScrollAllChildren(sl, xmove, ymove)
end if
end sub
'--Select--------------------------------------------------------------
Sub DisposeSelectSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->SelectData = 0 then exit sub
delete sl->SelectData
sl->SelectData = 0
end sub
'Updates the Visible property of a child, and then does the default refreshing of
'size and screen position.
Sub SelectChildRefresh(par as Slice ptr, ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
if ch = 0 then debug "SelectChildRefresh null ptr": exit sub
dim dat as SelectSliceData ptr = par->SliceData
if dat = 0 then exit sub
'Skip templates usually. Can't use childindex to do so, nor ShouldSkipSlice
if ch->Template andalso template_slices_shown = NO then exit sub
if childindex < 0 then 'Not known by the caller
childindex = SliceIndexAmongSiblings(ch, template_slices_shown)
end if
if dat->override >= 0 then
ch->Visible = (childindex = dat->override)
else
ch->Visible = (childindex = dat->index)
end if
'DefaultChildRefresh will check visibleonly, so we don't have to bother.
DefaultChildRefresh(par, ch, childindex, visibleonly)
end sub
Sub CloneSelectSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "CloneScrollSlice null ptr": exit sub
dim dat as SelectSliceData Ptr
dat = sl->SelectData
with *cl->SelectData
.index = dat->index
end with
end sub
Sub SaveSelectSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SaveSelectSlice null ptr": exit sub
DIM dat as SelectSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "index", dat->index
'override property is never saved. Only used by the Slice Collection Editor
End Sub
Sub LoadSelectSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadSelectSlice null ptr": exit sub
dim dat as SelectSliceData Ptr
dat = sl->SliceData
dat->index = LoadProp(node, "index", 0)
dat->override = -1
'override property is never loaded. Only used by the Slice Collection Editor
End Sub
Function NewSelectSlice(byval parent as Slice ptr, byref dat as SelectSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as SelectSliceData ptr = new SelectSliceData
*d = dat
'--Set non-zero defaults here
d->override = -1
ret->SliceType = slSelect
ret->SliceData = d
ret->Dispose = @DisposeSelectSlice
ret->Clone = @CloneSelectSlice
ret->Save = @SaveSelectSlice
ret->Load = @LoadSelectSlice
ret->ChildRefresh = @SelectChildRefresh
return ret
end function
'All arguments default to no-change
Sub ChangeSelectSlice(byval sl as Slice ptr,_
byval index as integer=-2,_
byval override as integer=-2)
if sl = 0 then debug "ChangeSelectSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slSelect)
with *sl->SelectData
if index >= -1 then
.index = index
end if
if override >= -1 then
.override = override
end if
end with
end sub
Sub SelectSliceNext(byval sl as Slice ptr, byval can_loop as bool=YES)
if sl = 0 then debug "SelectSliceNext null ptr" : exit sub
ASSERT_SLTYPE(sl, slSelect)
with *sl->SelectData
.index += 1
if .index >= sl->NumChildren then
if can_loop then
.index = 0
else
.index = sl->NumChildren - 1
end if
end if
end with
end sub
'--Panel-------------------------------------------------------------------
Sub DisposePanelSlice(byval sl as Slice ptr)
if sl = 0 then exit sub
if sl->PanelData = 0 then exit sub
delete sl->PanelData
sl->PanelData = 0
end sub
Sub ClonePanelSlice(byval sl as Slice ptr, byval cl as Slice ptr)
if sl = 0 or cl = 0 then debug "ClonePanelSlice null ptr": exit sub
dim dat as PanelSliceData Ptr
dat = sl->PanelData
with *cl->PanelData
.vertical = dat->vertical
.primary = dat->primary
.pixels = dat->pixels
.percent = dat->percent
.padding = dat->padding
end with
end sub
Sub SavePanelSlice(byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "SavePanelSlice null ptr": exit sub
DIM dat as PanelSliceData Ptr
dat = sl->SliceData
SavePropAlways node, "vertical", dat->vertical
SavePropAlways node, "primary", dat->primary
SaveProp node, "pixels", dat->pixels
'We MUST always save percent, as it gets loaded with wrong default if it's missing
SavePropAlways node, "percent", dat->percent
SaveProp node, "padding", dat->padding
End Sub
Sub LoadPanelSlice (byval sl as Slice ptr, byval node as Reload.Nodeptr)
if sl = 0 or node = 0 then debug "LoadPanelSlice null ptr": exit sub
dim dat as PanelSliceData Ptr
dat = sl->SliceData
dat->vertical = LoadPropBool(node, "vertical")
dat->primary = bound(LoadProp(node, "primary"), 0, 1)
dat->pixels = LoadProp(node, "pixels")
'The default percent value is actually 0.5, but to work around a bug introduced
'in r9509 which omitted 'percent' if equal to 0, we must it load as 0 if omitted.
dat->percent = LoadPropFloat(node, "percent")
dat->padding = LoadProp(node, "padding")
End Sub
'Calculate support (size and position relative to screen) of child 'index' of panel slice 'par'.
Sub CalcPanelSupport (byref support as RectType, byval par as Slice ptr, byval index as integer)
if par = 0 then debug "CalcPanelArea null par ptr": exit sub
if index > 1 then
'Panel only expects 2 children
support = XY_WH(par->ScreenPos, XY(0, 0))
exit sub
end if
dim dat as PanelSliceData ptr = par->PanelData
dim axis as integer = 0
if dat->vertical then axis = 1
dim other as integer = axis XOR 1
dim innersize as XYPair = par->Size 'Total space available for both children with all padding subtracted
dim prsize as integer
dim prepad as XYPair
dim postpad as XYPair
prepad.x = par->paddingLeft
postpad.x = par->paddingRight
prepad.y = par->paddingTop
postpad.y = par->paddingBottom
innersize.n(axis) -= prepad.n(axis) + postpad.n(axis) + dat->padding
innersize.n(other) -= prepad.n(other) + postpad.n(other)
support.wh.n(other) = innersize.n(other)
support.xy.n(other) = prepad.n(other)
prsize = int(innersize.n(axis) * dat->percent) + dat->pixels
if index = dat->primary then
support.wh.n(axis) = prsize
else
support.wh.n(axis) = innersize.n(axis) - prsize
end if
if index = 0 then
support.xy.n(axis) = prepad.n(axis)
else
if index = dat->primary then
support.xy.n(axis) = prepad.n(axis) + (innersize.n(axis) - prsize) + dat->padding
else
support.xy.n(axis) = prepad.n(axis) + prsize + dat->padding
end if
end if
support.xy += par->ScreenPos
End Sub
Sub PanelChildRefresh(byval par as Slice ptr, byval ch as Slice ptr, childindex as integer = -1, visibleonly as bool = YES)
if ch = 0 then debug "PanelChildRefresh null ptr": exit sub
if visibleonly andalso ch->Visible = NO then exit sub 'Don't need to exclude template slices
if childindex < 0 then childindex = SliceIndexAmongSiblings(ch, template_slices_shown)
if childindex > 1 then exit sub 'Panel only expects 2 children
dim support as RectType = any
CalcPanelSupport support, par, childindex
RefreshChild ch, support
End sub
Sub PanelChildDraw(byval s as Slice Ptr, byval page as integer)
'NOTE: we don't bother to null check s here because this sub is only
' ever called from DrawSliceRecurse which does null check it.
with *s
'if .ChildrenRefresh then .ChildrenRefresh(s) 'Always NULL
dim cliprect as RectType = any
dim rememclip as ClipState = any
'draw the slice's children
dim index as integer = 0
dim ch as Slice ptr = .FirstChild
do while ch <> 0
if ShouldSkipSlice(ch) then 'Skip template slices
ch = ch->NextSibling
continue do
end if
dim needdraw as bool = YES
if .Clip then
CalcPanelSupport cliprect, s, index
rememclip = get_cliprect()
needdraw = shrinkclip(cliprect.x, cliprect.y, _
cliprect.x + cliprect.wide - 1, _
cliprect.y + cliprect.high - 1, vpages(page))
end if
if needdraw then DrawSliceRecurse(ch, page, index)
if .Clip then get_cliprect() = rememclip
index += 1
if index > 1 then exit do ' Only ever draw the first 2 non-template children!
ch = ch->NextSibling
Loop
end with
End Sub
Function NewPanelSlice(byval parent as Slice ptr, byref dat as PanelSliceData) as Slice ptr
dim ret as Slice ptr
ret = NewSlice(parent)
if ret = 0 then return 0
dim d as PanelSliceData ptr = new PanelSliceData
*d = dat
'--Set non-zero defaults here
d->percent = 0.5
ret->SliceType = slPanel
ret->SliceData = d
ret->Dispose = @DisposePanelSlice
ret->Clone = @ClonePanelSlice
ret->Save = @SavePanelSlice
ret->Load = @LoadPanelSlice
ret->ChildRefresh = @PanelChildRefresh
ret->ChildDraw = @PanelChildDraw
return ret
end function
'All arguments default to no-change
Sub ChangePanelSlice(byval sl as Slice ptr,_
byval vertical as optbool=NONBOOL,_
byval primary as integer=-1,_
byval pixels as integer=-1,_
byval percent as double=-1.0,_
byval padding as integer=-1)
if sl = 0 then debug "ChangePanelSlice null ptr" : exit sub
ASSERT_SLTYPE(sl, slPanel)
with *sl->PanelData
if vertical <> NONBOOL then
.vertical = vertical <> 0
end if
if primary >= 0 then
.primary = small(primary, 1)
end if
if pixels >= 0 then
.pixels = pixels
end if
if percent <> -1.0 then
.percent = percent
end if
if padding >= 0 then
.padding = padding
end if
end with
end sub
'=============================================================================
' Slice alignment & position helpers
'Returns the slice which provides the ChildRefresh method, in other words
'the one that determines the screen position.
Function GetSliceRefreshAttachParent(byval sl as Slice Ptr) as Slice Ptr
if sl = 0 then debug "GetSliceRefreshAttachParent null ptr": return 0
WITH *sl
SELECT CASE .Attach
case slSlice
if .Attached then
RETURN .Attached
elseif .parent then
RETURN .parent
else
'Fall through, use screen
end if
case slScreen
'Fall through, use screen
END SELECT
END WITH
'--When no attached slice is found (or when we are explicitly attached to the screen)
RETURN ScreenSlice
End Function
Function SliceXAlign(sl as Slice Ptr, supportw as integer) as integer
if sl = 0 then debug "SliceXAlign null ptr": Return 0
SELECT CASE sl->AlignHoriz
CASE alignLeft: RETURN 0
CASE alignMiddle: RETURN supportw \ 2
CASE alignRight: RETURN supportw
END SELECT
End Function
Function SliceYAlign(sl as Slice Ptr, supporth as integer) as integer
if sl = 0 then debug "SliceYAlign null ptr": Return 0
SELECT CASE sl->AlignVert
CASE alignTop: RETURN 0
CASE alignMiddle: RETURN supporth \ 2
CASE alignBottom: RETURN supporth
END SELECT
End Function
Function SliceXAnchor(byval sl as Slice Ptr) as integer
if sl = 0 then debug "SliceXAnchor null ptr": Return 0
SELECT CASE sl->AnchorHoriz
CASE alignLeft: RETURN 0
CASE alignMiddle: RETURN sl->Width \ 2
CASE alignRight: RETURN sl->Width
END SELECT
End Function
Function SliceYAnchor(byval sl as Slice Ptr) as integer
if sl = 0 then debug "SliceYAnchor null ptr": Return 0
SELECT CASE sl->AnchorVert
CASE alignTop: RETURN 0
CASE alignMiddle: RETURN sl->Height \ 2
CASE alignBottom: RETURN sl->Height
END SELECT
End Function
'Like the "realign slice" script command
Sub RealignSlice(sl as Slice ptr, halign as AlignType = alignINVALID, valign as AlignType = alignINVALID, hanchor as AlignType = alignINVALID, vanchor as AlignType = alignINVALID)
if sl = 0 then debug "SliceRealign null ptr" : exit sub
if halign <> alignINVALID then sl->AlignHoriz = halign
if valign <> alignINVALID then sl->AlignVert = valign
if hanchor <> alignINVALID then sl->AnchorHoriz = hanchor
if vanchor <> alignINVALID then sl->AnchorVert = vanchor
End Sub
'Like "center slice" command
Sub CenterSlice(sl as Slice ptr)
RealignSlice sl, alignCenter, alignCenter, alignCenter, alignCenter
End Sub
Function SliceEdgeX(byval sl as Slice Ptr, byval edge as AlignType) as integer
if sl = 0 then debug "SliceEdgeX null ptr": Return 0
SELECT CASE edge
CASE alignLeft: RETURN 0
CASE alignMiddle: RETURN sl->Width \ 2
CASE alignRight: RETURN sl->Width
END SELECT
End Function
Function SliceEdgeY(byval sl as Slice Ptr, byval edge as AlignType) as integer
if sl = 0 then debug "SliceEdgeY null ptr": Return 0
SELECT CASE edge
CASE alignTop: RETURN 0
CASE alignMiddle: RETURN sl->Height \ 2
CASE alignBottom: RETURN sl->Height
END SELECT
End Function
'How wide/high does a parent slice have to be to cover a child slice with this position,
'size and alignment?
'position is the X or Y of the top-left corner of the slice relative to its align point,
'size is the width or height, align is AlignHoriz or AlignVert.
Local Function SliceExtent(position as integer, size as integer, align as AlignType) as integer
if align = alignLeft then
return position + size
elseif align = alignRight then
return -position
else
return large(-position * 2, (position + size) * 2)
end if
end Function
'Called on slices which CoverChildren, in order to update their size.
'If a child is aligned to the left, we only care about it going over the right
'edge, etc. Children center-aligned on the parent matter for both edges.
'And the padding acts as a min size.
Local Sub UpdateCoverSize(par as Slice ptr)
'Don't bother checking whether we're filling. You shouldn't be able to set a slice
'to both fill and cover.
'Panel, grid, layout are special, and will have to implement covering in their own way if at all.
'They will probably do so in ChildRefresh or ChildrenRefresh, where Fill Parent is also handled.
if par->SliceType = slPanel orelse par->SliceType = slGrid orelse par->SliceType = slLayout then exit sub
dim size as XYPair
dim ch as Slice ptr = par->FirstChild
while ch
with *ch
if .IsShown then
dim filling_horiz as bool = .Fill andalso .FillMode <> sliceFillVert
dim filling_vert as bool = .Fill andalso .FillMode <> sliceFillHoriz
'Position of the top-left corner of the slice relative to is align point
dim pos as XYPair = .Pos - XY(SliceXAnchor(ch), SliceYAnchor(ch))
if not filling_horiz then
size.w = large(size.w, SliceExtent(pos.X, .Width, .AlignHoriz))
end if
if not filling_vert then
size.h = large(size.h, SliceExtent(pos.Y, .Height, .AlignVert))
end if
end if
end with
ch = ch->NextSibling
wend
with *par
if .CoverChildren and coverHoriz then
.Width = large(0, size.w + .PaddingLeft + .PaddingRight)
end if
if .CoverChildren and coverVert then
.Height = large(0, size.h + .PaddingTop + .PaddingBottom)
end if
end with
end Sub
'Returns whether it's legal to set this slice to cover its children horizontally or vertically.
Function SliceLegalCoverModes(sl as Slice ptr) as CoverModes
with *sl
if .SliceType = slPanel orelse .SliceType = slGrid then return coverNone 'Not implemented
if .SliceType = slScroll then return coverNone 'That would be daft
if SlicePossiblyResizable(sl) = NO then return coverNone
'TODO: once zooming sprites by resizing them is implemented, allow a Sprite to Cover.
dim ret as CoverModes = coverFull
if .Fill andalso .FillMode <> sliceFillVert then ret -= coverHoriz 'filling_horiz
if .Fill andalso .FillMode <> sliceFillHoriz then ret -= coverVert
return ret
end with
end Function
'This function does not consider fill or cover mode! A slice set to fill/cover is not resizable either.
Function SlicePossiblyResizable(sl as Slice ptr) as bool
if sl = 0 then return NO
select case sl->SliceType
case slSpecial, slRectangle, slLine, slContainer, slGrid, slEllipse, _
slSelect, slScroll, slPanel, slLayout
return YES
case slText
if sl->TextData = 0 then return NO
'Text slices are never resizable vertically (they autoset their height),
'and resizable horizontally if wrapping.
return sl->TextData->wrap
case slSprite
if sl->SpriteData = 0 then return NO
return sl->SpriteData->scaled
' If you add any more special cases like slText, please also add special case
' error messages to valid_resizeable_slice.
case slMap
' Resizing map slices isn't implemented.
return NO
case else
showbug "SliceResizable needs to be updated for type " & sl->SliceType
return NO
end select
end Function
'=============================================================================
' Slice Velocity
'Slice has velocity. Note: returns true if it's paused.
'Warning: inconsistently returns false if VelTicks>0 but Velocity=0, but true if TargTicks>0 but Targ=Pos.
'Returns false without error if sl=0.
Function SliceIsMoving(byval sl as Slice ptr) as bool
if sl = 0 then return NO
return sl->Velocity <> 0 orelse sl->TargTicks > 0
end function
Sub SetSliceTarg(byval s as Slice ptr, byval x as integer, byval y as integer, byval ticks as integer)
if s = 0 then debug "SetSliceTarg null ptr": exit sub
with *s
.TargResidue.X = 0.0
.TargResidue.Y = 0.0
.Targ.X = x
.Targ.Y = y
.TargTicks = ticks
'cancel velocity
.Velocity.X = 0
.Velocity.Y = 0
.VelTicks.X = 0
.VelTicks.Y = 0
end with
end sub
' Apply slice movement to this slice and descendants
' TODO: dissolves should also be applied here (but for backcompat, not to hidden slices)
Sub AdvanceSlice(byval s as Slice ptr)
if s = 0 then debug "AdvanceSlice null ptr": exit sub
if s->Paused = NO andalso ShouldSkipSlice(s) = NO then
if s->AnimState then
s->AnimState->animate
end if
SeekSliceTarg s
ApplySliceVelocity s
'advance the slice's children
dim ch as Slice ptr = s->FirstChild
do while ch <> 0
AdvanceSlice(ch)
ch = ch->NextSibling
Loop
end if
end sub
'Initialise as needed and then return sl->Animations.
'Only initialise slice-specific animations if they are explicitly requested.
Function Slice.GetAnimations(slice_specific as bool = NO) as AnimationSet ptr
if this.Animations = NULL then
if this.SliceType = slSprite then
'Animations are loaded from rgfx into a SpriteSet object, but the pointer isn't
'copied to this.Animations until requested.
'(In future, animations can also be saved to .slice files)
if this.SpriteData->loaded = NO then LoadSpriteSliceImage @this
'Use original_img since if scaled=YES, animations won't be copied to img.sprite
this.Animations = spriteset_for_frame(this.SpriteData->original_img)->get_animset()->reference()
end if
end if
if this.Animations = NULL orelse (slice_specific andalso this.Animations->slice_specific = NO) then
dim fallback as AnimationSet ptr = this.Animations
this.Animations = new AnimationSet
this.Animations->reference()
this.Animations->name = "Animations for this specific slice"
this.Animations->fallback_set = fallback
this.Animations->slice_specific = YES
end if
return this.Animations
end function
'Initialise as needed and return AnimState
Function Slice.GetAnimState() as AnimationState ptr
if this.AnimState = NULL then
this.GetAnimations()
this.AnimState = new AnimationState(@this)
end if
return this.AnimState
end function
/'
Sub StartSliceAnimation(byval sl as Slice ptr, name as string, loopcount as integer = 0)
sl->GetAnimState()->start_animation name, loopcount
end sub
'/
' Apply slice .Targ movement
Local Sub SeekSliceTarg(byval s as Slice ptr)
'no null check because this is only called from AdvanceSlice
with *s
if .TargTicks > 0 then
dim as double temp
dim as integer movestep
temp = s->TargResidue.X + (s->Targ.X - .X) / s->TargTicks
movestep = temp
s->TargResidue.X = temp - movestep
.X += movestep
temp = s->TargResidue.Y + (s->Targ.Y - .Y) / s->TargTicks
movestep = temp
s->TargResidue.Y = temp - movestep
.Y += movestep
.TargTicks -= 1
if .TargTicks = 0 then
.X = .Targ.X
.Y = .Targ.Y
end if
end if
end with
end sub
Local Sub ApplySliceVelocity(byval s as Slice ptr)
'no null check because this is only called from AdvanceSlice
if s->VelTicks.X <> 0 then s->X += s->Velocity.X
if s->VelTicks.X > 0 then
s->VelTicks.X -= 1
if s->VelTicks.X = 0 then s->Velocity.X = 0
end if
if s->VelTicks.Y <> 0 then s->Y += s->Velocity.Y
if s->VelTicks.Y > 0 then
s->VelTicks.Y -= 1
if s->VelTicks.Y = 0 then s->Velocity.Y = 0
end if
end sub
'=============================================================================
'The context_stack global is built up during a DrawSlice call.
'Use this function to compute the stack if you need it outside of DrawSlice.
'The returned vector must be freed.
Function CalcContextStack(byval sl as Slice ptr) as SliceContext ptr vector
dim ret as SliceContext ptr vector
v_new ret
while sl
if sl->Context then v_append ret, sl->Context
sl = sl->Parent
wend
v_reverse ret
return ret
end function
'The central slice drawing function, called regardless of what slice-specific methods have been set.
'(See comments at the top of this file for an overview of slice drawing.)
'childindex is index of s among its siblings, ignoring templates (unless shown). Pass
'childindex = -1 if not known which saves computing it if it's not needed.
Local Sub DrawSliceRecurse(byval s as Slice ptr, byval page as integer, childindex as integer = -1)
if s = 0 then debug "DrawSliceRecurse null ptr": exit sub
'This function isn't called if s is a template (unless template_slices_shown),
'so don't need to check that here.
'Refresh the slice: calc the size and screen X,Y and possibly visibility (select slices)
'or other attributes. Refreshing is skipped if the slice isn't visible.
'(Note: if ChildrenRefresh is set, it was already called from the parent's
'ChildDraw, and ChildRefresh will do nothing.)
DIM attach as Slice Ptr
attach = GetSliceRefreshAttachParent(s)
if attach then attach->ChildRefresh(attach, s, childindex, YES)
if s->Visible then
if s->CoverChildren then UpdateCoverSize(s)
if s->Context then v_append context_stack, s->Context
if s->Draw then
NumDrawnSlices += 1
if s = benchmarking_slice then
benchmarking_draw_timer.start()
s->Draw(s, page)
benchmarking_draw_timer.stop()
else
s->Draw(s, page)
end if
end if
AutoSortChildren(s)
'ChildDraw normally calls ChildrenRefresh, if it exists, draws children by
'calling DrawSliceRecurse, and may also draw anything that appears above all
'children (eg scroll bars).
s->ChildDraw(s, page)
if s->Context then v_shrink context_stack
end if
end sub
'Draw a slice tree
Sub DrawSlice(byval s as Slice ptr, byval page as integer)
blend_algo = gen(gen8bitBlendAlgo) 'Bit kludgy, but easiest to set this here
benchmarking_draw_timer.ran = NO
v_new context_stack
DrawSliceRecurse s, page
v_free context_stack
if benchmarking_draw_timer.ran = NO then benchmarking_draw_timer.add_time(0.0)
end sub
'Draw a slice tree (usually a subtree of the full tree) as if it were parented
'to a container slice with given position and size.
'ignore_offset causes the slice's offset from its parent to be ignored
Sub DrawSliceAt(byval sl as Slice ptr, byval x as integer, byval y as integer, byval w as integer = 100, byval h as integer = 100, byval page as integer, byval ignore_offset as bool = NO)
BUG_IF(sl = 0, "null ptr")
dim as Slice ptr dummyparent, prevparent = sl->Parent, prevnextsibling = sl->NextSibling
dummyparent = NewSliceOfType(slContainer)
dummyparent->Pos = XY(x, y)
dummyparent->Size = XY(w, h)
dummyparent->Visible = YES
SetSliceParent sl, dummyparent
dim oldpos as XYPair
if ignore_offset then
oldpos = sl->Pos
sl->Pos = 0
end if
DrawSlice dummyparent, page
'Restore sl
if prevnextsibling then
InsertSliceBefore prevnextsibling, sl
else
'Was the last child, can use SetSliceParent
SetSliceParent sl, prevparent
end if
if ignore_offset then sl->Pos = oldpos
DeleteSlice @dummyparent
end sub
Function UpdateRootSliceSize(sl as Slice ptr, page as integer) as bool
'Update the size of a slice to match the size of a video page.
'Normally the root slice is set to fill; calling this function is only needed
'when it isn't.
'Returns true if the size changed.
if sl = 0 then return NO
dim changed as bool
with *sl
changed = vpages(page)->size <> .Size
.Size = vpages(page)->size
end with
return changed
end function
Function UpdateScreenSlice(clear_changed_flag as bool = YES) as bool
'Match ScreenSlice size to window size; returns true if the size changed
'since the last call with clear_changed_flag=YES.
static changed as bool = NO
if UpdateRootSliceSize(ScreenSlice, vpage) then changed = yes
if clear_changed_flag and changed then
changed = NO
return YES
end if
return changed
end function
Sub RefreshSliceScreenPos(slc as Slice ptr)
'This sub quickly updates ScreenX, ScreenY, plus Width and Height when filling,
'of a slice and its ancestors without needing to do a full refresh of the whole tree
'and without respect to .Visible (however templates may not be fully updated by their parents)
if slc = 0 then exit sub
dim attach as Slice ptr
attach = GetSliceRefreshAttachParent(slc)
if attach = 0 then exit sub
if attach <> ScreenSlice then
RefreshSliceScreenPos attach
end if
dim par as Slice ptr = slc->Parent
if par andalso par->ChildrenRefresh then par->ChildrenRefresh(par)
attach->ChildRefresh(attach, slc, -1, NO) 'visibleonly=NO
end sub
'Refresh all descendents of slc, even if not visible
'(however templates won't normally be positioned/resized by Layout/Panel/etc parents)
Local Sub SliceRefreshRecurse(slc as Slice ptr)
if slc->ChildrenRefresh then slc->ChildrenRefresh(slc)
dim attach as Slice Ptr
dim ch as Slice ptr = slc->FirstChild
dim childindex as integer = 0
do while ch <> 0
attach = GetSliceRefreshAttachParent(ch)
'Note that normally ChildRefresh isn't called on template slices, but make a best effort to update them.
attach->ChildRefresh(attach, ch, childindex, NO) 'visibleonly=NO
SliceRefreshRecurse ch
if ShouldSkipSlice(ch) = NO then
childindex += 1
end if
ch = ch->NextSibling
loop
end sub
Sub RefreshSliceTreeScreenPos(slc as Slice ptr)
'Updates ScreenX, ScreenY, plus Width and Height when filling,
'of a slice tree (specially, all its ancestors and descendents but not siblings)
'while ignoring .Visible (however templates may not be fully updated by their parents)
'DrawSliceRecurse skips refreshing nonvisible slices.
if slc = 0 then exit sub
'Update slc and ancestors
RefreshSliceScreenPos slc
'Update descendents
SliceRefreshRecurse slc
end sub
Function SliceCollide(byval sl1 as Slice Ptr, sl2 as Slice Ptr) as bool
'Check for a screen-position collision between slice 1 and slice 2 (regardless of parentage)
'Note RefreshSliceScreenPos not called here
if sl1 = 0 or sl2 = 0 then return NO
'AABB collision test
if sl1->Width + sl2->Width <= abs(2 * sl1->ScreenX + sl1->Width - 2 * sl2->ScreenX - sl2->Width) then return NO
if sl1->Height + sl2->Height <= abs(2 * sl1->ScreenY + sl1->Height - 2 * sl2->ScreenY - sl2->Height) then return NO
return YES
end function
Function SliceCollidePoint(byval sl as Slice Ptr, byval point as XYPair) as bool
'Check if a point collides with a slice's screen position
'Note RefreshSliceScreenPos not called here
if sl = 0 then return NO
if point.x >= sl->ScreenX andalso point.x < sl->ScreenX + sl->Width andalso _
point.y >= sl->ScreenY andalso point.y < sl->ScreenY + sl->Height then
return YES
end if
return NO
end function
Function SliceContains(byval sl1 as Slice Ptr, byval sl2 as Slice Ptr) as bool
'Check if sl2 is completely contained inside sl1
if sl1 = 0 or sl2 = 0 then return NO
RefreshSliceScreenPos(sl1)
RefreshSliceScreenPos(sl2)
if SliceCollidePoint(sl1, sl2->ScreenPos) then
if SliceCollidePoint(sl1, sl2->ScreenPos + sl2->Size - 1) then
'no nonrectangular slices (yet)
'if SliceCollidePoint(sl1, XY(sl2->ScreenX + sl2->Width-1, sl2->ScreenY)) then
'if SliceCollidePoint(sl1, XY(sl2->ScreenX, sl2->ScreenY + sl2->Height-1)) then
'end if
'end if
return YES
end if
end if
return NO
end function
Function FindSliceCollision(parent as Slice Ptr, sl as Slice Ptr, byref num as integer, descend as bool, visibleonly as bool = NO, allowspecial as bool = NO) as Slice Ptr
'Find a child or descendant of parent which overlaps with sl (never returns sl itself).
'descend: Whether to recurse to decendents of parent.
' Note: except for clipping (and maybe invisible) slices, we always check all descendents!
'visibleonly: Whether to restrict to visible slices (treats parent as visible).
'allowspecial: Don't ignore Special slices
'num: 0 to return bottommost matching slice, 1 for next, etc.
' Is decremented by the number of matching slices.
'We don't call RefreshSliceScreenPos for efficiency; we expect the calling code to do that
'and we handle refreshing the descendents of parent (calling ChildRefresh on every slice we visit).
'Warning: RefreshSliceScreenPos doesn't get called on invisible slices in DrawSlice!!
if parent = 0 or sl = 0 then debug "FindSliceCollision null ptr": return 0
dim as Slice ptr s, temp
dim childindex as integer = 0
s = parent->FirstChild
while s
while s->Template andalso template_slices_shown = NO
s = s->NextSibling
if s = NULL then return NULL
wend
if s <> sl then
with *s
'First refresh to update child visibility, in case the parent is a Select slice.
'But we unconditionally refresh the child even if not visible for... no well
'justified reason (see r7792)
'We don't call ChildrenRefresh if applicable, because we need (and should)
'only update the screen positions, not do complex positioning recalc.
parent->ChildRefresh(parent, s, childindex, NO) 'visibleonly=NO
if visibleonly = NO orelse .Visible then
dim recurse as bool = descend
if SliceCollide(s, sl) then
if .SliceType <> slSpecial orelse allowspecial then
if num = 0 then return s
num -= 1
end if
elseif s->Clip then
'Clipping slices reduce the effective sizes of their descendents, so don't
'recurse if point not inside
recurse = NO
end if
if recurse then
temp = FindSliceCollision(s, sl, num, YES, visibleonly)
if temp then return temp
end if
end if
end with
end if
s = s->NextSibling
childindex += 1
wend
return NULL
end function
Function FindSliceAtPoint(parent as Slice Ptr, point as XYPair, byref num as integer, descend as bool, visibleonly as bool = NO, allowspecial as bool = NO) as Slice Ptr
'Find a child or descendant of parent which contains a certain screen position.
'descend: Whether to recurse.
' Note: except for clipping (and maybe invisible) slices, we always check all descendents!
'visibleonly: Whether to restrict to visible slices (treats parent as visible).
'allowspecial: Don't ignore Special slices
'num: 0 for bottommost matching slice, 1 for next, etc. Is decremented by the number of matching slices.
'We don't call RefreshSliceScreenPos for efficiency; we expect the calling code to do that,
'(because DrawSliceRecurse doesn't call ChildRefresh or recurse on invisible slices)
'and we handle refreshing the descendents of parent (calling ChildRefresh on every slice we visit).
if parent = 0 then debug "FindSliceAtPoint null ptr": return 0
dim as Slice ptr s, temp
dim childindex as integer = 0
s = parent->FirstChild
while s
while s->Template andalso template_slices_shown = NO
s = s->NextSibling
if s = NULL then return NULL
wend
with *s
'First refresh to update child visibility, in case the parent is a Select slice.
'But we unconditionally refresh the child even if not visible for... no well
'justified reason (see r7792)
'We don't call ChildrenRefresh if applicable, because we need (and should)
'only update the screen positions, not do complex positioning recalc.
parent->ChildRefresh(parent, s, childindex, NO) 'visibleonly=NO
if visibleonly = NO orelse .Visible then
dim recurse as bool = descend
if SliceCollidePoint(s, point) then
if .SliceType <> slSpecial orelse allowspecial then
if num = 0 then return s
num -= 1
end if
elseif s->Clip then
'Clipping slices reduce the effective sizes of their descendents, so don't
'recurse if point not inside
recurse = NO
end if
if recurse then
temp = FindSliceAtPoint(s, point, num, YES, visibleonly)
if temp then return temp
end if
end if
end with
s = s->NextSibling
childindex += 1
wend
return NULL
end function
Function SliceIsInvisible(byval sl as Slice Ptr) as bool
if sl = 0 then debug "SliceIsInvisible: null slice": return YES 'Treating a null slice as invisible is probably safest here
'First check the slice itself
if sl->IsShown = NO then return YES
'Then check for any invisible parents
dim parent as Slice Ptr
parent = sl->Parent
do while parent
if parent->IsShown = NO then return YES
parent = parent->Parent
loop
return NO
End Function
'Check whether a slice is *actually* visible.
'FIXME: this is incorrect: clipping is done from the padded slice bounds, ignored by SliceCollide.
Function SliceIsInvisibleOrClipped(byval sl as Slice Ptr) as bool
if SliceIsInvisible(sl) then return YES
'Check for any parents that are clipping this slice
dim parent as Slice Ptr
parent = sl->Parent
do while parent
if parent->Clip then
if not SliceCollide(sl, parent) then return YES
end if
parent = parent->Parent
loop
return NO
End Function
'Get a slice's DrawOptions, or NULL if it doesn't have any.
'required: whether to throw an error on wrong type.
Function SliceDrawOpts(sl as Slice ptr, required as bool = YES) as DrawOptions ptr
BUG_IF(sl = NULL, "null ptr", NULL)
if sl->SliceType = slSprite then
return @sl->SpriteData->drawopts
elseif sl->SliceType = slMap then
return @sl->MapData->drawopts
elseif required then
slice_bad_op sl, "doesn't have blending settings. Only Sprite or Map layer slices do."
end if
return NULL
End Function
Sub SliceClamp(byval sl1 as Slice Ptr, byval sl2 as Slice Ptr)
'Don't confuse this with a slice's .Fill member. This is a one-shot attempt
'to fit sl2 inside sl1 without doing any resizing.
'(TODO: swap arg order, as it's needlessly the opposite to "clamp slice")
'NOTE: ignores padding. And doesn't work for Grid slices.
if sl1 = 0 or sl2 = 0 then exit sub
if sl2->Fill then reporterr "SliceClamp cannot move slices with .Fill=ON" : exit sub
RefreshSliceScreenPos(sl1)
RefreshSliceScreenPos(sl2)
dim diff as integer
diff = sl2->ScreenX - sl1->ScreenX
'--Horizontal clamp
if diff < 0 then
sl2->X += abs(diff)
else
diff = (sl2->ScreenX + sl2->Width) - (sl1->ScreenX + sl1->Width)
if diff > 0 then sl2->X -= abs(diff)
end if
'--Verical clamp
diff = sl2->ScreenY - sl1->ScreenY
if diff < 0 then
sl2->Y += abs(diff)
else
diff = (sl2->ScreenY + sl2->Height) - (sl1->ScreenY + sl1->Height)
if diff > 0 then sl2->Y -= abs(diff)
end if
end sub
Function SliceChildByIndex(byval sl as Slice ptr, byval index as integer) as Slice Ptr
if sl = 0 then debug "SliceChildByIndex null ptr": return 0
dim ch as Slice ptr = sl->FirstChild
for i as integer = 0 to sl->NumChildren
if ch = NULL then exit for
if i = index THEN return ch
ch = ch->NextSibling
next i
return 0
End Function
Function FindTextSliceStringRecursively(sl as slice ptr, query as string) as Slice Ptr
'Search this slice, and all its children recursively.
'Check to see if query is a substring inside any TextString values.
'Returns the first TextSlice where a match is found, or 0 if no march is found.
'Compares strings case-insensitively
'If there is no query, exit immediately
if query = "" then return 0
if sl->SliceType = slText then
'If this slice is text, and the text includes the filter string, Success!
if instr(lcase(sl->TextData->s), lcase(query)) then return sl
end if
'Check all children recursively too until we find one that succeeds
dim ch as Slice Ptr = sl->FirstChild
dim result as Slice Ptr
do while ch
result = FindTextSliceStringRecursively(ch, query)
if result <> 0 then return result
ch = ch->NextSibling
loop
'No text was found that matches the query text
return 0
End Function
Sub RecursivelyUpdateColor(sl as Slice Ptr, newcol as integer, oldcol1 as integer, oldcol2 as integer, oldcol3 as integer=-9999999, lookup_code as integer=0)
'Recursively replace any color codes that match specific old values
'Normally this would be used for the negative ui constants, not for positive palette indexes
'The optional lookup code restricts the changes only to slices that have that code
if lookup_code = 0 orelse sl->Lookup = lookup_code then
UpdateColor sl, newcol, oldcol1, oldcol2, oldcol3
end if
dim ch as Slice Ptr = sl->FirstChild
do while ch
if not ShouldSkipSlice(ch, YES) then
'Only bother with visible non-template slices
RecursivelyUpdateColor ch, newcol, oldcol1, oldcol2, oldcol3, lookup_code
end if
ch = ch->NextSibling
loop
End Sub
Sub UpdateColor (sl as Slice Ptr, newcol as integer, oldcol1 as integer, oldcol2 as integer, oldcol3 as integer=-9999999)
if sl->SliceType = slRectangle then
with *sl->RectData
if .fgcol = oldcol1 or .fgcol = oldcol2 or .fgcol = oldcol3 then .fgcol = newcol
if .bgcol = oldcol1 or .bgcol = oldcol2 or .bgcol = oldcol3 then .bgcol = newcol
end with
end if
if sl->SliceType = slLine then
with *sl->LineData
if .col = oldcol1 or .col = oldcol2 or .col = oldcol3 then .col = newcol
end with
end if
if sl->SliceType = slText then
with *sl->TextData
if .col = oldcol1 or .col = oldcol2 or .col = oldcol3 then .col = newcol
if .bgcol = oldcol1 or .bgcol = oldcol2 or .bgcol = oldcol3 then .bgcol = newcol
end with
end if
if sl->SliceType = slEllipse then
with *sl->EllipseData
if .bordercol = oldcol1 or .bordercol = oldcol2 or .bordercol = oldcol3 then .bordercol = newcol
if .fillcol = oldcol1 or .fillcol = oldcol2 or .fillcol = oldcol3 then .fillcol = newcol
end with
end if
End Sub
'==Slice cloning===============================================================
'Duplicate a slice and, if recurse=YES, the whole tree. The resulting clone is parentless.
'copy_special: copy Special slices and lookup codes. .Protect bit not copied.
'find_slice: if find_slice is cloned, this variable is replaced with the new Slice ptr.
'duplicate_animations: perform a deep copy of slice-specific Animations. This is normally
' unwanted unless the animations of the clone will be edited independently.
Function CloneSliceTree(byval sl as Slice ptr, recurse as bool = YES, copy_special as bool = YES, byref find_slice as Slice ptr = NULL, duplicate_animations as bool = NO) as Slice ptr
if sl = NULL orelse sl->SliceType = slMap then return NULL
dim clone as Slice Ptr
'--Create another slice of the same type
dim newtype as SliceTypes = sl->SliceType
if copy_special = NO then
if newtype = slSpecial then newtype = slContainer
end if
clone = NewSliceOfType(newtype)
'--Clone all standard properties
with *clone
'Parent, siblings, etc. not copied
'Function ptrs not copied.
'.Attach and .Attached not copied
'.TableSlot not copied
if copy_special then .Protect = sl->Protect 'Otherwise, the copy won't have any special role
.Lookup = sl->Lookup
if copy_special = NO and .Lookup < 0 then .Lookup = 0
.X = sl->X
.Y = sl->Y
'.ScreenPos not copied
.Width = sl->Width
.Height = sl->Height
.Visible = sl->Visible
.Template = sl->Template
.Paused = sl->Paused
'.EditorColor not copied
.EditorHideChildren = sl->EditorHideChildren
.Clip = sl->Clip
.Velocity.X = sl->Velocity.X
.Velocity.Y = sl->Velocity.Y
.VelTicks.X = sl->VelTicks.X
.VelTicks.Y = sl->VelTicks.Y
.Targ.X = sl->Targ.X
.Targ.Y = sl->Targ.Y
.TargResidue.X = sl->TargResidue.Y
.TargResidue.Y = sl->TargResidue.Y
.TargTicks = sl->TargTicks
.AlignHoriz = sl->AlignHoriz
.AlignVert = sl->AlignVert
.AnchorHoriz = sl->AnchorHoriz
.AnchorVert = sl->AnchorVert
.PaddingTop = sl->PaddingTop
.PaddingLeft = sl->PaddingLeft
.PaddingRight = sl->PaddingRight
.PaddingBottom = sl->PaddingBottom
.CoverChildren = sl->CoverChildren
.ClampHoriz = sl->ClampHoriz
.ClampVert = sl->ClampVert
.ClampToScreen = sl->ClampToScreen
.Fill = sl->Fill
.FillMode = sl->FillMode
.AutoSort = sl->AutoSort
.Sorter = sl->Sorter
if sl->ExtraVec then
v_copy .ExtraVec, sl->ExtraVec
end if
if sl->Animations then
if duplicate_animations andalso sl->Animations->slice_specific then
.Animations = sl->Animations->duplicate()
else
.Animations = sl->Animations->reference()
end if
end if
if sl->AnimState then
.AnimState = new AnimationState(*sl->AnimState)
.AnimState->sl = clone
end if
end with
'--clone special properties for this slice type
sl->Clone(sl, clone)
if recurse = NO then return clone
'--Now clone all the children
dim ch_slice as Slice Ptr = sl->FirstChild
dim ch_clone as Slice Ptr
do while ch_slice <> 0
ch_clone = CloneSliceTree(ch_slice, YES, copy_special, find_slice, duplicate_animations)
if ch_clone then SetSliceParent ch_clone, clone
ch_slice = ch_slice->NextSibling
loop
'--return the clone
if find_slice andalso sl = find_slice then find_slice = clone
return clone
end function
'A variant on CloneSliceTree which is intended to be used on Template slices already
'in a slice tree, for instantiating them, but doesn't need to be.
'The cloned slice is placed before the template and any adjacent template siblings it has,
'so you can create a set of clones which end up in the order you cloned them.
Function CloneTemplate(byval templatesl as Slice ptr) as Slice ptr
dim sl as Slice ptr
sl = CloneSliceTree(templatesl)
BUG_IF(sl = NULL, "unclonable", NULL)
sl->Template = NO 'Descendents which are Templates stay that way
if templatesl->Parent then
'Move before the group of templates
var insertbefore = templatesl
while insertbefore->PrevSibling <> NULL andalso insertbefore->PrevSibling->Template
insertbefore = insertbefore->PrevSibling
wend
InsertSliceBefore insertbefore, sl
end if
return sl
end function
'==Slice saving and loading====================================================
'--saving----------------------------------------------------------------------
End Extern
Sub SavePropAlways(node as Reload.Nodeptr, propname as zstring ptr, byval value as integer)
if node = 0 then debug "SaveProp null node ptr": Exit Sub
Reload.SetChildNode(node, propname, CLNGINT(value))
End Sub
'Doesn't save anything = 0
Sub SaveProp(node as Reload.Nodeptr, propname as zstring ptr, byval value as integer)
if value <> 0 then SavePropAlways node, propname, value
End Sub
'This function only exists because of FB bug sf#826 "Weird overload resolution with booleans", fixed in FB 1.10
Sub SavePropBoolAlways(node as Reload.Nodeptr, propname as zstring ptr, byval value as boolean)
if node = 0 then debug "SaveProp null node ptr": Exit Sub
Reload.SetChildNode(node, propname, CLNGINT(value))
END Sub
'Ditto
Sub SavePropBool(node as Reload.Nodeptr, propname as zstring ptr, byval value as boolean)
if value then SavePropBoolAlways node, propname, value
End Sub
Sub SavePropAlways(node as Reload.Nodeptr, propname as zstring ptr, byval value as double)
if node = 0 then debug "SaveProp null node ptr": Exit Sub
Reload.SetChildNode(node, propname, value)
End Sub
Sub SaveProp(node as Reload.Nodeptr, propname as zstring ptr, byval value as double)
if value <> 0. then SavePropAlways node, propname, value
End Sub
Sub SavePropAlways(node as Reload.Nodeptr, propname as zstring ptr, s as string)
if node = 0 then debug "SaveProp null node ptr": Exit Sub
Reload.SetChildNode(node, propname, s)
End Sub
Sub SaveProp(node as Reload.Nodeptr, propname as zstring ptr, s as string)
if len(s) then SavePropAlways node, propname, s
End Sub
Extern "C"
Sub SliceSaveToNode(byval sl as Slice Ptr, node as Reload.Nodeptr, save_handles as bool=NO)
if sl = 0 then debug "SliceSaveToNode null slice ptr": Exit Sub
if node = 0 then debug "SliceSaveToNode null node ptr": Exit Sub
if Reload.NumChildren(node) <> 0 then debug "SliceSaveToNode non-empty node has " & Reload.NumChildren(node) & " children"
'--Save standard slice properties
'NOTE: if something has a non-zero default load value, then you must use SavePropAlways
SaveProp node, "type", SliceTypeName(sl)
SavePropBool node, "template", sl->template
SaveProp node, "lookup", sl->lookup
SaveProp node, "x", sl->x
SaveProp node, "y", sl->Y
'Have to save size even if set to fill
SavePropAlways node, "w", sl->Width
SavePropAlways node, "h", sl->Height
SavePropBoolAlways node, "vis", sl->Visible
SavePropBool node, "editorhidechildren", sl->EditorHideChildren
SavePropBool node, "paused", sl->Paused
SavePropBool node, "clip", sl->Clip
SaveProp node, "vx", sl->Velocity.X
SaveProp node, "vy", sl->Velocity.Y
SaveProp node, "vtickx", sl->VelTicks.X
SaveProp node, "vticky", sl->VelTicks.Y
if sl->TargTicks > 0 then
SaveProp node, "tx", sl->Targ.X
SaveProp node, "ty", sl->Targ.Y
SaveProp node, "ttick", sl->TargTicks
'No need to save TargResidue
end if
SaveProp node, "alignh", sl->AlignHoriz
SaveProp node, "alignv", sl->AlignVert
SaveProp node, "anchorh", sl->AnchorHoriz
SaveProp node, "anchorv", sl->AnchorVert
if sl->ClampHoriz <> alignNone then SavePropAlways node, "clamph", sl->ClampHoriz
if sl->ClampVert <> alignNone then SavePropAlways node, "clampv", sl->ClampVert
SavePropBool node, "clamptoscreen", sl->ClampToScreen
SaveProp node, "padt", sl->PaddingTop
SaveProp node, "padl", sl->PaddingLeft
SaveProp node, "padr", sl->PaddingRight
SaveProp node, "padb", sl->PaddingBottom
SaveProp node, "cover", sl->CoverChildren
SavePropBool node, "fill", sl->Fill
SaveProp node, "fillmode", sl->FillMode
SaveProp node, "sort", sl->Sorter
SaveProp node, "autosort", sl->AutoSort
SaveExtraVector node, "extra", sl->ExtraVec
#IFDEF IS_GAME
if save_handles then
' This only occurs when saving a game.
if sl->TableSlot then
SaveProp node, "tableslot_handle", plotslices(sl->TableSlot).handle
end if
end if
#ENDIF
'--Save properties specific to this slice type
sl->Save(sl, node)
'--Contexts may or may not be savable
if sl->Context then sl->Context->save(node)
if sl->Animations andalso sl->Animations->slice_specific then
'Empty AnimationSets will be created if entering the animation editor in the
'slice editor. They don't need to be saved.
if v_len(sl->Animations->animations) then
save_animations_node node, sl->Animations
end if
end if
'FIXME: save AnimState
if sl->AnimState then
end if
'--Now save all the children
if sl->NumChildren > 0 then
'--make a container node for all the child nodes
dim children as Reload.NodePtr
children = Reload.CreateNode(node, "children")
Reload.AddChild(node, children)
'now loop through the children of this slice and create a new node for each one
dim ch_node as Reload.NodePtr
dim ch_slice as Slice Ptr = sl->FirstChild
do while ch_slice <> 0
ch_node = Reload.CreateNode(children, "")
Reload.AddChild(children, ch_node)
SliceSaveToNode ch_slice, ch_node, save_handles
ch_slice = ch_slice->NextSibling
loop
end if
End sub
Sub SliceSaveToFile(byval sl as Slice Ptr, filename as string, save_handles as bool=NO)
'First create a reload document
dim doc as Reload.DocPtr
doc = Reload.CreateDocument()
if doc = NULL then exit sub 'Already showed a BUG message
'Create a node, and save the slice tree into it
dim node as Reload.Nodeptr
node = Reload.CreateNode(doc, "")
Reload.SetRootNode(doc, node)
SliceSaveToNode sl, node, save_handles
'Write the reload document to the file
Reload.SerializeBin filename, doc
Reload.FreeDocument(doc)
End sub
'--loading---------------------------------------------------------------------
Function LoadPropStr(node as Reload.Nodeptr, propname as zstring ptr, defaultval as string="") as string
if node = 0 then debug "LoadPropStr null node ptr": return defaultval
return Reload.GetChildNodeStr(node, propname, defaultval)
End function
Function LoadProp(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as integer=0) as integer
if node = 0 then debug "LoadProp null node ptr": return defaultval
return Reload.GetChildNodeInt(node, propname, CLNGINT(defaultval))
End function
Function LoadPropBool(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as bool=NO) as bool
if node = 0 then debug "LoadPropBool null node ptr": return defaultval
return Reload.GetChildNodeBool(node, propname, defaultval)
End function
Function LoadPropFloat(node as Reload.Nodeptr, propname as zstring ptr, byval defaultval as double=0.0) as double
if node = 0 then debug "LoadPropFloat null node ptr": return defaultval
return Reload.GetChildNodeFloat(node, propname, defaultval)
End function
'Note that this mutates an existing slice, which should be a new slice with no children
'Returns true on (apparent) success; when returning false may be partially
'loaded, such as when there's an unknown slice type.
Function SliceLoadFromNode(byval sl as Slice Ptr, node as Reload.Nodeptr, load_handles as bool=NO) as bool
BUG_IF(sl = 0, "null slice ptr", NO)
BUG_IF(node = 0, "null node ptr", NO)
BUG_IF(sl->NumChildren > 0, "slice already has children", NO)
dim ret as bool = YES
'--Load standard slice properties
'NOTE: if something has a non-zero default value, then you must use SavePropAlways
sl->Template = LoadPropBool(node, "template")
sl->Lookup = LoadProp(node, "lookup")
sl->x = LoadProp(node, "x")
sl->y = LoadProp(node, "y")
sl->Width = LoadProp(node, "w")
sl->Height = LoadProp(node, "h")
sl->Visible = LoadPropBool(node, "vis")
sl->EditorHideChildren = LoadPropBool(node, "editorhidechildren")
sl->Paused = LoadPropBool(node, "paused")
sl->Clip = LoadPropBool(node, "clip")
sl->Velocity.X = LoadProp(node, "vx")
sl->Velocity.Y = LoadProp(node, "vy")
sl->VelTicks.X = LoadProp(node, "vtickx")
sl->VelTicks.Y = LoadProp(node, "vticky")
sl->Targ.X = LoadProp(node, "tx")
sl->Targ.Y = LoadProp(node, "ty")
sl->TargTicks = LoadProp(node, "ttick")
sl->AlignHoriz = LoadProp(node, "alignh")
sl->AlignVert = LoadProp(node, "alignv")
sl->AnchorHoriz = LoadProp(node, "anchorh")
sl->AnchorVert = LoadProp(node, "anchorv")
sl->ClampHoriz = LoadProp(node, "clamph", alignNone)
sl->ClampVert = LoadProp(node, "clampv", alignNone)
sl->ClampToScreen = LoadPropBool(node, "clamptoscreen")
sl->PaddingTop = LoadProp(node, "padt")
sl->PaddingLeft = LoadProp(node, "padl")
sl->PaddingRight = LoadProp(node, "padr")
sl->PaddingBottom = LoadProp(node, "padb")
sl->CoverChildren = LoadProp(node, "cover")
sl->Fill = LoadPropBool(node, "fill")
sl->FillMode = LoadProp(node, "fillmode")
sl->Sorter = LoadProp(node, "sort")
sl->AutoSort = LoadProp(node, "autosort")
'Load extra data
dim ex_node as Reload.NodePtr = GetChildByName(node, "extra")
if ex_node then
if LoadExtraVector(ex_node, sl->ExtraVec, "slice") = NO then ret = NO
else
'Load from old serialization format for extra data
dim extra as integer vector
v_new extra, 3
extra[0] = LoadProp(node, "extra0")
extra[1] = LoadProp(node, "extra1")
extra[2] = LoadProp(node, "extra2")
if extra[0] or extra[1] or extra[2] then
sl->ExtraVec = extra
else
v_free extra
end if
end if
#IFDEF IS_GAME
if load_handles then
' This only occurs when loading a saved game.
' Slice handles should never be loaded from a collection in the middle of a game!
dim tableslot as integer = LoadProp(node, "tableslot_handle")
if tableslot then restore_saved_plotslice_handle(sl, tableslot)
end if
#ENDIF
'TODO: create a SliceContext so it can load itself. For now, SliceLoadFromFile gives
'the root slice a SliceCollectionContext.
'dim contextstr as string = LoadPropStr(node, "context")
if sl->Context then sl->Context->load(node)
'now update the type
dim typestr as string = LoadPropStr(node, "type")
dim typenum as SliceTypes = SliceTypeByName(typestr)
if typenum = slInvalid then
reporterr "Could not load slice: unknown type " & typestr, serrError
typenum = slContainer
ret = NO
end if
dim classname as string = LoadPropStr(node, "class")
if len(classname) then
'ClassSlice. Currently, Class slices are always of subtype slSpecial, but might not be true in future?
if InitClassSliceByName(sl, classname) = NO then
reporterr "Could not load slice: unknown class " & classname, serrError
typenum = slContainer
ret = NO
end if
end if
if typenum <> sl->SliceType then
dim newsl as Slice Ptr = NewSliceOfType(typenum)
ReplaceSliceType sl, newsl
end if
'--Load properties specific to this slice type
sl->Load(sl, node)
'After we know the spriteset record we can call GetAnimations. Load any slice-specific animations
if GetChildByName(node, "_animations") then 'FIXME: temporary location
load_animations_node(node, sl->GetAnimations(YES)) 'slice_specific=YES
end if
'--Now load all the children
dim children as Reload.NodePtr
children = Reload.GetChildByName(node, "children")
if children then
'now loop through the children of this node and create a new slice for each one
dim ch_slice as Slice Ptr
dim ch_node as Reload.NodePtr = Reload.FirstChild(children)
do while ch_node <> 0
ch_slice = NewSlice(sl)
'If there's a problem loading a child try to keep going
if SliceLoadFromNode(ch_slice, ch_node, load_handles) = NO then ret = NO
ch_node = Reload.NextSibling(ch_node)
loop
end if
return ret
End function
'collection_num is used only in-game
'Returns true on (apparent) success; when returning false may be partially
'loaded, such as when there's an unknown slice type.
Function SliceLoadFromFile(byval sl as Slice Ptr, filename as string, load_handles as bool=NO, collection_id as integer=-1) as bool
var prev_subtimer = main_timer.switch(TimerIDs.FileIO)
dim doc as Reload.DocPtr
doc = Reload.LoadDocument(filename, optNoDelay)
if doc = null then
main_timer.switch(prev_subtimer)
return NO 'Already showed an error
end if
'Always give the root slice a context. The context is used to hold the name of
'the slice collection, if there is one, and other shared data in future
BUG_IF(sl->Context, "sl has Context", NO)
var context = new SliceCollectionContext
context->id = collection_id
sl->Context = context
'Populate the slice tree with data from the reload tree
dim node as Reload.Nodeptr
node = Reload.DocumentRoot(doc)
dim ret as bool = SliceLoadFromNode(sl, node, load_handles)
Reload.FreeDocument(doc)
main_timer.switch(prev_subtimer)
return ret
End function
'==============================================================================
' Slice Collections
'Load a slice collection, either a user or special one, e.g. the Status menu,
'either from the game or falling back to a default.
'Returns null if the collection is missing or couldn't be loaded.
'However if the collection was partially loaded (contains unsupported slice types/data)
'then return_partially_loaded tells whether to return it or NULL.
'A missing user collection is not an error, all other failures call showbug or showerror.
Function LoadSliceCollection(collection_kind as integer, collection_num as integer=0, return_partially_loaded as bool=YES) as Slice ptr
' Look in game data
dim srcfile as string
if collection_kind = SL_COLLECT_USERDEFINED then
srcfile = workingdir & SLASH & "slicetree_" & collection_kind & "_" & collection_num & ".reld"
if isfile(srcfile) = NO then return null 'Silent failure
else
' Otherwise look for a default (usually from an embedded file, but can be an external file)
dim collname as string
select case collection_kind
case SL_COLLECT_STATUSSCREEN: collname = "status_screen"
case SL_COLLECT_ITEMSCREEN: collname = "item_screen"
case SL_COLLECT_SPELLSCREEN: collname = "spell_screen"
case SL_COLLECT_VIRTUALKEYBOARDSCREEN: collname = "virtual_keyboard_screen"
case else
showbug "Unknown slice collection kind " & collection_kind
return null
end select
srcfile = finddatafile("sourceslices" SLASH "default_" & collname & ".slice", NO) 'error_if_missing=NO
if len(srcfile) = 0 then
showbug "Missing embedded default_" & collname
return null
end if
end if
' Load the collection
'The SliceCollectionContext.id
dim collection_id as integer = IIF(collection_kind = SL_COLLECT_USERDEFINED, collection_num, -1)
dim sl as Slice ptr = NewSlice()
if SliceLoadFromFile(sl, srcfile, , collection_id) = NO then 'showerror's on failure
if return_partially_loaded = NO then
DeleteSlice @sl
end if
end if
return sl
End function
'==============================================================================
' Slice Debugging
'Return a string like "Sprite slice 11" or "Container slice" or "Rectangle slice 7 (textbox box)",
'or if 'succinct', "Sprite sl 11", "Cont", "textbox box sl 7"
FUNCTION DescribeSlice(sl as Slice ptr, succinct as bool = NO) as string
IF sl THEN
DIM sliceinfo as string
IF succinct THEN
sliceinfo = *SliceShortTypeName(sl->SliceType)
IF sl->TableSlot THEN sliceinfo &= " " & sl->TableSlot
IF sl->Lookup THEN sliceinfo &= ":" & LEFT(SliceLookupCodename(sl), 12)
ELSE
sliceinfo &= SliceTypeName(sl) & " slice"
IF sl->TableSlot THEN sliceinfo &= " " & sl->TableSlot
IF sl->Lookup THEN sliceinfo &= " (" & SliceLookupCodename(sl) & ")"
END IF
RETURN sliceinfo
ELSE
'Normally this sub shouldn't be called with a null ptr
RETURN "(invalid slice)"
END IF
END FUNCTION
'For script commands to raise slice errors with information about the slice.
'message can contain $SL which is replaced with e.g. "Sprite slice 11". If $SL isn't used,
'the slice is instead prepended
SUB slice_bad_op(sl as Slice ptr, message as zstring ptr, errlev as scriptErrEnum = serrBadOp)
DIM sliceinfo as string = DescribeSlice(sl)
DIM fullmsg as string = *message
IF replacestr(fullmsg, "$SL", sliceinfo) = 0 THEN
fullmsg = sliceinfo & " " & fullmsg
END IF
reporterr fullmsg, errlev, , sl
END SUB
Sub report_slice_type_err(sl as Slice ptr, expected as SliceTypes)
reporterr "Attempt to treat " & DescribeSlice(sl) & " (at " & SlicePath(sl) & ") as a " & SliceTypeName(expected)
End Sub
#ifdef ENABLE_SLICE_DEBUG
SUB SliceDebugRemember(sl as Slice Ptr)
if sl = 0 then debug "SliceDebugRemember null ptr": exit sub
for i as integer = 0 to ubound(SliceDebug)
if SliceDebug(i) = 0 then
'--found an empty slot in the slice debug table...
SliceDebug(i) = sl
exit sub
end if
next i
'--no more room in the slice debug table
dim newsize as integer = ubound(SliceDebug) + 50
debuginfo "enlarge slice debug table to " & newsize
redim preserve SliceDebug(newsize) as Slice Ptr
SliceDebugRemember sl
END SUB
SUB SliceDebugForget(sl as Slice Ptr)
if sl = 0 then debug "SliceDebugForget null ptr": exit sub
for i as integer = 0 to ubound(SliceDebug)
if SliceDebug(i) = sl then
'--found the slice to forget
SliceDebug(i) = 0
exit sub
end if
next i
debug "WARNING: tried to delete slice " & SlicePath(sl) & " without any record of creating it!"
END SUB
'This is used for hunting down leaked slices
SUB SliceDebugDump(byval noisy as bool = NO)
debug "===SLICE DEBUG DUMP==="
dim count as integer = 0
dim sl as Slice Ptr
for i as integer = 0 to ubound(SliceDebug)
if SliceDebug(i) <> 0 then
sl = SliceDebug(i)
debug "[" & i & " Slice " & sl & " " & DescribeSlice(sl) & "]"
if noisy then
debug "parent " & sl->parent
SliceDebugDumpTree sl
end if
count += 1
end if
next i
debug count & " slices found in the slice debug table"
END SUB
FUNCTION SliceDebugCheck(sl as Slice Ptr) as integer
if sl = 0 then RETURN NO
for i as integer = 0 to ubound(SliceDebug)
if SliceDebug(i) = sl then RETURN YES
next i
RETURN NO
END FUNCTION
#endif
'Number of slices in a subtree (including sl)
FUNCTION count_slices(sl as Slice ptr) as integer
DIM count as integer = 1
sl = sl->FirstChild
WHILE sl
count += count_slices(sl)
sl = sl->NextSibling
WEND
RETURN count
END FUNCTION
'This is the dump function accessible by an in-game debug key,
'and is intended for seeing the slice tree, not debugging code
SUB SliceDebugDumpTree(sl as Slice Ptr, byval indent as integer = 0)
if sl = 0 then exit sub
CheckTableSlotOK(sl)
dim s as string
s = string(indent, " ") & SliceTypeName(sl)
if sl->Protect then
s &= " (P)"
end if
s &= " lookup:" & SliceLookupCodename(sl) & " tableslot:" & sl->TableSlot & " pos:" & sl->Pos & " size:" & sl->Size.wh
#ifdef IS_GAME
if sl->TableSlot then s &= " handle:" & plotslices(sl->TableSlot).handle
#endif
if sl->Template then s &= " template"
if sl->Visible = NO then s &= " visible:false"
if sl->ExtraVec then
s &= " extra(len=" & v_len(sl->ExtraVec) & "): "
for idx as integer = 0 to small(10, v_len(sl->ExtraVec)) - 1
s &= " " & idx & ":" & sl->ExtraVec[idx]
next
end if
debug s
SliceDebugDumpTree sl->FirstChild, indent + 1
SliceDebugDumpTree sl->NextSibling, indent
END SUB
'For debugging the pointers between slices. Not used anywhere
/'
Sub SliceDebugLinks(sl as Slice Ptr, recurse as bool = NO, prefix as string = "", indent as integer = 0)
if sl = 0 then exit sub
debug prefix & string(indent + 1, " ") & SliceTypeName(sl) & " " & SliceLookupCodename(sl) & " sl=" & sl & " par=" & sl->Parent & " prev=" & sl->PrevSibling & " next=" & sl->NextSibling
debug prefix & string(indent + 6, " ") & sl->NumChildren & " children, first=" & sl->FirstChild & " last=" & sl->LastChild
if sl->FirstChild then
BUG_IF(sl->FirstChild->Parent <> sl, "bad FirstChild")
end if
if sl->LastChild then
BUG_IF(sl->LastChild->Parent <> sl, "bad LastChild")
end if
if recurse then
SliceDebugLinks sl->FirstChild, recurse, prefix, indent + 1
SliceDebugLinks sl->NextSibling, recurse, prefix, indent
end if
End Sub
'/
End Extern