aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Several code cleanups 

- Fixed TArt.RefreshBuffer using the wrong variable (j <> i)
- Suppressed some hints
This commit is contained in:
Andreas Schneider 2009-12-17 15:41:54 +01:00
parent 13264d3251
commit c41fd3be95
17 changed files with 4091 additions and 4105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

638
Client/Tools/UfrmFilter.lfm
View File

@ -1,319 +1,319 @@
object frmFilter: TfrmFilter
Left = 290
Height = 492
Top = 171
Width = 232
ActiveControl = rgFilterType.RadioButton0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow
Caption = 'Filter'
ClientHeight = 492
ClientWidth = 232
Font.Height = -11
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '0.9.27'
object rgFilterType: TRadioGroup
Left = 4
Height = 40
Top = 4
Width = 224
Align = alTop
AutoFill = True
BorderSpacing.Around = 4
Caption = 'Filter rule'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 26
ClientWidth = 222
Columns = 2
ItemIndex = 0
Items.Strings = (
'Exclusive'
'Inclusive'
)
OnClick = rgFilterTypeClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 4
Height = 259
Top = 48
Width = 224
Align = alClient
BorderSpacing.Around = 4
Caption = 'Tile filter'
ClientHeight = 245
ClientWidth = 222
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = cbTileFilter
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 30
Top = 30
Width = 214
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
ParentColor = False
WordWrap = True
end
object btnClear: TSpeedButton
AnchorSideLeft.Control = btnDelete
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrCenter
AnchorSideBottom.Control = btnDelete
AnchorSideBottom.Side = asrBottom
Left = 30
Height = 22
Hint = 'Clear'
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000003ADCFE004800
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
DF000000000000000000000000002070DF000000000000000000
}
NumGlyphs = 0
OnClick = btnClearClick
ShowHint = True
ParentShowHint = False
end
object btnDelete: TSpeedButton
AnchorSideLeft.Control = GroupBox1
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 22
Hint = 'Delete'
Top = 219
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000004F91AB005588
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
0200F2000200080104000E040200F8040400F200040009010500
}
NumGlyphs = 0
OnClick = btnDeleteClick
ShowHint = True
ParentShowHint = False
end
object vdtFilter: TVirtualDrawTree
Tag = 1
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDelete
Cursor = 63
Left = 4
Height = 151
Top = 64
Width = 214
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultNodeHeight = 44
DragType = dtVCL
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'ID'
end
item
Position = 1
Text = 'Tile'
Width = 44
end
item
Position = 2
Text = 'Name'
Width = 100
end>
Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
OnDragOver = vdtFilterDragOver
OnDragDrop = vdtFilterDragDrop
OnDrawNode = vdtFilterDrawNode
end
object cbTileFilter: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 4
Height = 22
Top = 4
Width = 85
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbTileFilterChange
TabOrder = 1
end
end
object GroupBox2: TGroupBox
Left = 4
Height = 168
Top = 320
Width = 224
Align = alBottom
BorderSpacing.Around = 4
Caption = 'Hue filter'
ClientHeight = 154
ClientWidth = 222
TabOrder = 2
object cbHueFilter: TCheckBox
Left = 4
Height = 22
Top = 4
Width = 214
Align = alTop
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbHueFilterChange
TabOrder = 0
end
object vdtHues: TVirtualDrawTree
Cursor = 63
Left = 4
Height = 120
Top = 30
Width = 214
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
Header.AutoSizeIndex = 2
Header.Columns = <
item
Position = 0
Width = 20
end
item
Position = 1
Text = 'Hue'
Width = 38
end
item
Position = 2
Text = 'Name'
Width = 154
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
PopupMenu = pmHues
TabOrder = 1
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChecked = vdtHuesChecked
OnDrawNode = vdtHuesDrawNode
end
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 311
Width = 232
Align = alBottom
ResizeAnchor = akBottom
end
object pmHues: TPopupMenu
left = 148
top = 404
object mnuCheckHues: TMenuItem
Caption = 'Check all hues'
OnClick = mnuCheckHuesClick
end
object mnuUncheckHues: TMenuItem
Caption = 'Uncheck all hues'
OnClick = mnuUncheckHuesClick
end
end
end
object frmFilter: TfrmFilter
Left = 290
Height = 492
Top = 171
Width = 232
ActiveControl = rgFilterType.RadioButton0
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow
Caption = 'Filter'
ClientHeight = 492
ClientWidth = 232
Font.Height = -11
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
LCLVersion = '0.9.29'
object rgFilterType: TRadioGroup
Left = 4
Height = 40
Top = 4
Width = 224
Align = alTop
AutoFill = True
BorderSpacing.Around = 4
Caption = 'Filter rule'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
ClientHeight = 22
ClientWidth = 220
Columns = 2
ItemIndex = 0
Items.Strings = (
'Exclusive'
'Inclusive'
)
OnClick = rgFilterTypeClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 4
Height = 259
Top = 48
Width = 224
Align = alClient
BorderSpacing.Around = 4
Caption = 'Tile filter'
ClientHeight = 241
ClientWidth = 220
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = cbTileFilter
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 4
Height = 27
Top = 27
Width = 212
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.'
ParentColor = False
WordWrap = True
end
object btnClear: TSpeedButton
AnchorSideLeft.Control = btnDelete
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrCenter
AnchorSideBottom.Control = btnDelete
AnchorSideBottom.Side = asrBottom
Left = 30
Height = 22
Hint = 'Clear'
Top = 215
Width = 22
Anchors = [akLeft, akBottom]
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000003ADCFE004800
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB
9B000000000000000000000000000000000000000000000000000EECFF00B2FC
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70
DF000000000000000000000000002070DF000000000000000000
}
NumGlyphs = 0
OnClick = btnClearClick
ShowHint = True
ParentShowHint = False
end
object btnDelete: TSpeedButton
AnchorSideLeft.Control = GroupBox1
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 22
Hint = 'Delete'
Top = 215
Width = 22
Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000004F91AB005588
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804
0200F2000200080104000E040200F8040400F200040009010500
}
NumGlyphs = 0
OnClick = btnDeleteClick
ShowHint = True
ParentShowHint = False
end
object vdtFilter: TVirtualDrawTree
Tag = 1
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDelete
Cursor = 63
Left = 4
Height = 153
Top = 58
Width = 212
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
DefaultNodeHeight = 44
DragType = dtVCL
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'ID'
end
item
Position = 1
Text = 'Tile'
Width = 44
end
item
Position = 2
Text = 'Name'
Width = 100
end>
Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
OnDragOver = vdtFilterDragOver
OnDragDrop = vdtFilterDragDrop
OnDrawNode = vdtFilterDrawNode
end
object cbTileFilter: TCheckBox
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1
Left = 4
Height = 19
Top = 4
Width = 78
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbTileFilterChange
TabOrder = 1
end
end
object GroupBox2: TGroupBox
Left = 4
Height = 168
Top = 320
Width = 224
Align = alBottom
BorderSpacing.Around = 4
Caption = 'Hue filter'
ClientHeight = 150
ClientWidth = 220
TabOrder = 2
object cbHueFilter: TCheckBox
Left = 4
Height = 19
Top = 4
Width = 212
Align = alTop
BorderSpacing.Around = 4
Caption = 'Filter active'
OnChange = cbHueFilterChange
TabOrder = 0
end
object vdtHues: TVirtualDrawTree
Cursor = 63
Left = 4
Height = 119
Top = 27
Width = 212
Align = alClient
BorderSpacing.Around = 4
BorderStyle = bsSingle
Header.AutoSizeIndex = 2
Header.Columns = <
item
Position = 0
Width = 20
end
item
Position = 1
Text = 'Hue'
Width = 38
end
item
Position = 2
Text = 'Name'
Width = 150
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
PopupMenu = pmHues
TabOrder = 1
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnChecked = vdtHuesChecked
OnDrawNode = vdtHuesDrawNode
end
end
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 311
Width = 232
Align = alBottom
ResizeAnchor = akBottom
end
object pmHues: TPopupMenu
left = 148
top = 404
object mnuCheckHues: TMenuItem
Caption = 'Check all hues'
OnClick = mnuCheckHuesClick
end
object mnuUncheckHues: TMenuItem
Caption = 'Uncheck all hues'
OnClick = mnuUncheckHuesClick
end
end
end

706
Client/Tools/UfrmFilter.pas
View File

@ -1,353 +1,353 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmFilter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
PairSplitter, Menus;
type
{ TfrmFilter }
TfrmFilter = class(TForm)
btnClear: TSpeedButton;
btnDelete: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbTileFilter: TCheckBox;
cbHueFilter: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
mnuUncheckHues: TMenuItem;
mnuCheckHues: TMenuItem;
pnlRandomPreset: TPanel;
pmHues: TPopupMenu;
rgFilterType: TRadioGroup;
Splitter1: TSplitter;
vdtFilter: TVirtualDrawTree;
vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
protected
FLocked: Boolean;
FCheckedHues: TBits;
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word);
end;
var
frmFilter: TfrmFilter;
implementation
uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
end;
PHueInfo = ^THueInfo;
THueInfo = record
ID: Word;
Hue: THue;
end;
{ TfrmFilter }
procedure TfrmFilter.FormShow(Sender: TObject);
var
upperLeft, lowerLeft: TPoint;
begin
upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
frmMain.pcLeft.Height));
Left := upperLeft.x - 4;
Top := upperLeft.y - 4;
Height := lowerLeft.y - upperLeft.y;
SetWindowParent(Handle, frmMain.Handle);
end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
begin
vdtHues.ClearChecked;
end;
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
var
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
vdtHues.CheckState[node] := csCheckedNormal;
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
sourceTree: TVirtualDrawTree;
selected, node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
sourceTree := Source as TVirtualDrawTree;
if (sourceTree <> Sender) and (sourceTree <> nil) and
(sourceTree.Tag = 1) then
begin
Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := sourceTree.GetNodeData(selected);
if sourceTileInfo^.ID > $3FFF then
begin
node := Sender.AddChild(nil);
targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID;
cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end;
selected := sourceTree.GetNextSelected(selected);
end;
Sender.EndUpdate;
end;
end;
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and
(TVirtualDrawTree(Source).Tag = 1) then
begin
Accept := True;
end;
end;
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
begin
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
hueInfo: PHueInfo;
begin
hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
hueInfo: PHueInfo;
hueColor: TColor;
i: Integer;
textStyle: TTextStyle;
begin
hueInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taLeftJustify;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
1:
begin
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
PaintInfo.Canvas.Pen.Color := hueColor;
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
end;
end;
2:
begin
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
end;
end;
end;
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
begin
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
Close;}
end;
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var
found: Boolean;
tileInfo: PTileInfo;
node: PVirtualNode;
id: Word;
begin
if cbTileFilter.Checked then
begin
id := AStatic.TileID + $4000;
found := False;
node := vdtFilter.GetFirst;
while (node <> nil) and (not found) do
begin
tileInfo := vdtFilter.GetNodeData(node);
if tileInfo^.ID = id then
found := True
else
node := vdtFilter.GetNext(node);
end;
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
((rgFilterType.ItemIndex = 1) and found);
end else
Result := True;
if cbHueFilter.Checked then
begin
Result := Result and (
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
);
end;
end;
procedure TfrmFilter.JumpToHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject);
var
i: Integer;
hueInfo: PHueInfo;
node: PVirtualNode;
begin
FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo);
vdtHues.BeginUpdate;
vdtHues.Clear;
for i := 0 to ResMan.Hue.Count - 1 do
begin
node := vdtHues.AddChild(nil);
hueInfo := vdtHues.GetNodeData(node);
hueInfo^.ID := i + 1;
hueInfo^.Hue := ResMan.Hue.Hues[i];
vdtHues.CheckType[node] := ctCheckBox;
end;
vdtHues.EndUpdate;
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
//FCheckedHues.Bits[0] := True;
end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin
vdtFilter.DeleteSelectedNodes;
end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject);
begin
vdtFilter.Clear;
end;
initialization
{$I UfrmFilter.lrs}
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmFilter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics,
Menus;
type
{ TfrmFilter }
TfrmFilter = class(TForm)
btnClear: TSpeedButton;
btnDelete: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
cbRandomPreset: TComboBox;
cbTileFilter: TCheckBox;
cbHueFilter: TCheckBox;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label1: TLabel;
mnuUncheckHues: TMenuItem;
mnuCheckHues: TMenuItem;
pnlRandomPreset: TPanel;
pmHues: TPopupMenu;
rgFilterType: TRadioGroup;
Splitter1: TSplitter;
vdtFilter: TVirtualDrawTree;
vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure cbHueFilterChange(Sender: TObject);
procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure vdtFilterDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
protected
FLocked: Boolean;
FCheckedHues: TBits;
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word);
end;
var
frmFilter: TfrmFilter;
implementation
uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: Word;
end;
PHueInfo = ^THueInfo;
THueInfo = record
ID: Word;
Hue: THue;
end;
{ TfrmFilter }
procedure TfrmFilter.FormShow(Sender: TObject);
var
upperLeft, lowerLeft: TPoint;
begin
upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
frmMain.pcLeft.Height));
Left := upperLeft.x - 4;
Top := upperLeft.y - 4;
Height := lowerLeft.y - upperLeft.y;
SetWindowParent(Handle, frmMain.Handle);
end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
begin
vdtHues.ClearChecked;
end;
procedure TfrmFilter.mnuCheckHuesClick(Sender: TObject);
var
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
vdtHues.CheckState[node] := csCheckedNormal;
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.rgFilterTypeClick(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
sourceTree: TVirtualDrawTree;
selected, node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo;
begin
sourceTree := Source as TVirtualDrawTree;
if (sourceTree <> Sender) and (sourceTree <> nil) and
(sourceTree.Tag = 1) then
begin
Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected;
while selected <> nil do
begin
sourceTileInfo := sourceTree.GetNodeData(selected);
if sourceTileInfo^.ID > $3FFF then
begin
node := Sender.AddChild(nil);
targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID;
cbTileFilter.Checked := True;
frmMain.InvalidateFilter;
end;
selected := sourceTree.GetNextSelected(selected);
end;
Sender.EndUpdate;
end;
end;
procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and
(TVirtualDrawTree(Source).Tag = 1) then
begin
Accept := True;
end;
end;
procedure TfrmFilter.vdtFilterDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
begin
frmMain.vdtTilesDrawNode(Sender, PaintInfo);
end;
procedure TfrmFilter.vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
hueInfo: PHueInfo;
begin
hueInfo := Sender.GetNodeData(Node);
FCheckedHues.Bits[hueInfo^.ID] := (Sender.CheckState[node] = csCheckedNormal);
cbHueFilter.Checked := True;
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
hueInfo: PHueInfo;
hueColor: TColor;
i: Integer;
textStyle: TTextStyle;
begin
hueInfo := Sender.GetNodeData(PaintInfo.Node);
textStyle := PaintInfo.Canvas.TextStyle;
textStyle.Alignment := taLeftJustify;
textStyle.Layout := tlCenter;
textStyle.Wordbreak := True;
case PaintInfo.Column of
1:
begin
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(hueInfo^.Hue.ColorTable[i]);
PaintInfo.Canvas.Pen.Color := hueColor;
PaintInfo.Canvas.MoveTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Top + 1);
PaintInfo.Canvas.LineTo(PaintInfo.CellRect.Left + 2 + i, PaintInfo.CellRect.Bottom - 1);
end;
end;
2:
begin
PaintInfo.Canvas.TextRect(PaintInfo.CellRect, PaintInfo.CellRect.Left, PaintInfo.CellRect.Top, Format('$%x (%s)', [hueInfo^.ID, hueInfo^.Hue.Name]), textStyle);
end;
end;
end;
procedure TfrmFilter.MouseLeave(var msg: TLMessage);
begin
{if Active and (not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos))) then
Close;}
end;
function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var
found: Boolean;
tileInfo: PTileInfo;
node: PVirtualNode;
id: Word;
begin
if cbTileFilter.Checked then
begin
id := AStatic.TileID + $4000;
found := False;
node := vdtFilter.GetFirst;
while (node <> nil) and (not found) do
begin
tileInfo := vdtFilter.GetNodeData(node);
if tileInfo^.ID = id then
found := True
else
node := vdtFilter.GetNext(node);
end;
Result := ((rgFilterType.ItemIndex = 0) and (not found)) or
((rgFilterType.ItemIndex = 1) and found);
end else
Result := True;
if cbHueFilter.Checked then
begin
Result := Result and (
((rgFilterType.ItemIndex = 0) and (not FCheckedHues.Bits[AStatic.Hue])) or
((rgFilterType.ItemIndex = 1) and (FCheckedHues.Bits[AStatic.Hue]))
);
end;
end;
procedure TfrmFilter.JumpToHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject);
var
i: Integer;
hueInfo: PHueInfo;
node: PVirtualNode;
begin
FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo);
vdtHues.BeginUpdate;
vdtHues.Clear;
for i := 0 to ResMan.Hue.Count - 1 do
begin
node := vdtHues.AddChild(nil);
hueInfo := vdtHues.GetNodeData(node);
hueInfo^.ID := i + 1;
hueInfo^.Hue := ResMan.Hue.Hues[i];
vdtHues.CheckType[node] := ctCheckBox;
end;
vdtHues.EndUpdate;
FCheckedHues := TBits.Create(ResMan.Hue.Count + 1);
//FCheckedHues.Bits[0] := True;
end;
procedure TfrmFilter.FormDestroy(Sender: TObject);
begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin
vdtFilter.DeleteSelectedNodes;
end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.cbTileFilterChange(Sender: TObject);
begin
frmMain.InvalidateFilter;
end;
procedure TfrmFilter.btnClearClick(Sender: TObject);
begin
vdtFilter.Clear;
end;
initialization
{$I UfrmFilter.lrs}
end.

3413
Client/ULandscape.pas
View File

File diff suppressed because it is too large Load Diff

4
Client/UPacketHandlers.pas
View File

@ -56,11 +56,11 @@ procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UPackets, UAdminHandling;
UAdminHandling;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;

748
Client/UPackets.pas
View File

@ -1,375 +1,373 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UPackets;
interface
uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics;
type
TBlockCoords = packed record
X: Word;
Y: Word;
end;
TBlockCoordsArray = array of TBlockCoords;
{ TCompressedPacket }
TCompressedPacket = class(TPacket)
constructor Create(APacket: TPacket);
end;
{ TLoginRequestPacket }
TLoginRequestPacket = class(TPacket)
constructor Create(AUsername, APassword: string);
end;
{ TQuitPacket }
TQuitPacket = class(TPacket)
constructor Create;
end;
{ TRequestBlocksPacket }
TRequestBlocksPacket = class(TPacket)
constructor Create(ACoords: TBlockCoordsArray);
end;
{ TFreeBlockPacket }
TFreeBlockPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TDrawMapPacket }
TDrawMapPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
end;
{ TStaticPacket }
TStaticPacket = class(TPacket)
protected
procedure WriteStaticItem(AStaticItem: TStaticItem);
end;
{ TInsertStaticPacket }
TInsertStaticPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
end;
{ TDeleteStaticPacket }
TDeleteStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TElevateStaticPacket }
TElevateStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewZ: Word);
end;
{ TMoveStaticPacket }
TMoveStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewX, ANewY: Word);
end;
{ THueStaticPacket }
THueStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewHue: Word);
end;
{ TUpdateClientPosPacket }
TUpdateClientPosPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(AMessage: string);
end;
{ TGotoClientPosPacket }
TGotoClientPosPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TRequestRadarChecksumPacket }
TRequestRadarChecksumPacket = class(TPacket)
constructor Create;
end;
{ TRequestRadarMapPacket }
TRequestRadarMapPacket = class(TPacket)
constructor Create;
end;
{ TNoOpPacket }
TNoOpPacket = class(TPacket)
constructor Create;
end;
implementation
{ TCompressedPacket }
constructor TCompressedPacket.Create(APacket: TPacket);
var
compBuffer: TEnhancedMemoryStream;
compStream: TCompressionStream;
sourceStream: TStream;
begin
inherited Create($01, 0);
compBuffer := TEnhancedMemoryStream.Create;
compStream := TCompressionStream.Create(clMax, compBuffer);
sourceStream := APacket.Stream;
compStream.CopyFrom(sourceStream, 0);
compStream.Free;
FStream.WriteCardinal(sourceStream.Size);
FStream.CopyFrom(compBuffer, 0);
compBuffer.Free;
APacket.Free;
end;
{ TLoginRequestPacket }
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword);
end;
{ TQuitPacket }
constructor TQuitPacket.Create;
begin
inherited Create($02, 0);
FStream.WriteByte($05);
end;
{ TRequestBlocksPacket }
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
var
i: Integer;
begin
inherited Create($04, 0);
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
end;
{ TFreeBlockPacket }
constructor TFreeBlockPacket.Create(AX, AY: Word);
begin
inherited Create($05, 5);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TDrawMapPacket }
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
begin
inherited Create($06, 8);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
end;
{ TStaticPacket }
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
begin
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TInsertStaticPacket }
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word);
begin
inherited Create($07, 10);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
end;
{ TDeleteStaticPacket }
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($08, 10);
WriteStaticItem(AStaticItem);
end;
{ TElevateStaticPacket }
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
begin
inherited Create($09, 11);
WriteStaticItem(AStaticItem);
FStream.WriteShortInt(ANewZ);
end;
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word; ANewZ: Word);
begin
inherited Create($09, 11);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteShortInt(ANewZ);
end;
{ TMoveStaticPacket }
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
ANewY: Word);
begin
inherited Create($0A, 14);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewX, ANewY: Word);
begin
inherited Create($0A, 14);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
{ THueStaticPacket }
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
begin
inherited Create($0B, 12);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewHue);
end;
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewHue: Word);
begin
inherited Create($0B, 12);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewHue);
end;
{ TUpdateClientPosPacket }
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(AMessage);
end;
{ TGotoClientPosPacket }
constructor TGotoClientPosPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($06);
FStream.WriteStringNull(AUsername);
end;
{ TRequestRadarChecksumPacket }
constructor TRequestRadarChecksumPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($01);
end;
{ TRequestRadarMapPacket }
constructor TRequestRadarMapPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($02);
end;
{ TNoOpPacket }
constructor TNoOpPacket.Create;
begin
inherited Create($FF, 1);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UPackets;
interface
uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics;
type
TBlockCoords = packed record
X: Word;
Y: Word;
end;
TBlockCoordsArray = array of TBlockCoords;
{ TCompressedPacket }
TCompressedPacket = class(TPacket)
constructor Create(APacket: TPacket);
end;
{ TLoginRequestPacket }
TLoginRequestPacket = class(TPacket)
constructor Create(AUsername, APassword: string);
end;
{ TQuitPacket }
TQuitPacket = class(TPacket)
constructor Create;
end;
{ TRequestBlocksPacket }
TRequestBlocksPacket = class(TPacket)
constructor Create(ACoords: TBlockCoordsArray);
end;
{ TFreeBlockPacket }
TFreeBlockPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TDrawMapPacket }
TDrawMapPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
end;
{ TStaticPacket }
TStaticPacket = class(TPacket)
protected
procedure WriteStaticItem(AStaticItem: TStaticItem);
end;
{ TInsertStaticPacket }
TInsertStaticPacket = class(TPacket)
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word);
end;
{ TDeleteStaticPacket }
TDeleteStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TElevateStaticPacket }
TElevateStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewZ: Word);
end;
{ TMoveStaticPacket }
TMoveStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewX, ANewY: Word);
end;
{ THueStaticPacket }
THueStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewHue: Word);
end;
{ TUpdateClientPosPacket }
TUpdateClientPosPacket = class(TPacket)
constructor Create(AX, AY: Word);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(AMessage: string);
end;
{ TGotoClientPosPacket }
TGotoClientPosPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TRequestRadarChecksumPacket }
TRequestRadarChecksumPacket = class(TPacket)
constructor Create;
end;
{ TRequestRadarMapPacket }
TRequestRadarMapPacket = class(TPacket)
constructor Create;
end;
{ TNoOpPacket }
TNoOpPacket = class(TPacket)
constructor Create;
end;
implementation
{ TCompressedPacket }
constructor TCompressedPacket.Create(APacket: TPacket);
var
compBuffer: TEnhancedMemoryStream;
compStream: TCompressionStream;
sourceStream: TStream;
begin
inherited Create($01, 0);
compBuffer := TEnhancedMemoryStream.Create;
compStream := TCompressionStream.Create(clMax, compBuffer);
sourceStream := APacket.Stream;
compStream.CopyFrom(sourceStream, 0);
compStream.Free;
FStream.WriteCardinal(sourceStream.Size);
FStream.CopyFrom(compBuffer, 0);
compBuffer.Free;
APacket.Free;
end;
{ TLoginRequestPacket }
constructor TLoginRequestPacket.Create(AUsername, APassword: string);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword);
end;
{ TQuitPacket }
constructor TQuitPacket.Create;
begin
inherited Create($02, 0);
FStream.WriteByte($05);
end;
{ TRequestBlocksPacket }
constructor TRequestBlocksPacket.Create(ACoords: TBlockCoordsArray);
begin
inherited Create($04, 0);
FStream.Write(ACoords[0], Length(ACoords) * SizeOf(TBlockCoords));
end;
{ TFreeBlockPacket }
constructor TFreeBlockPacket.Create(AX, AY: Word);
begin
inherited Create($05, 5);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TDrawMapPacket }
constructor TDrawMapPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word);
begin
inherited Create($06, 8);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
end;
{ TStaticPacket }
procedure TStaticPacket.WriteStaticItem(AStaticItem: TStaticItem);
begin
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TInsertStaticPacket }
constructor TInsertStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word);
begin
inherited Create($07, 10);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
end;
{ TDeleteStaticPacket }
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($08, 10);
WriteStaticItem(AStaticItem);
end;
{ TElevateStaticPacket }
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
begin
inherited Create($09, 11);
WriteStaticItem(AStaticItem);
FStream.WriteShortInt(ANewZ);
end;
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word; ANewZ: Word);
begin
inherited Create($09, 11);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteShortInt(ANewZ);
end;
{ TMoveStaticPacket }
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
ANewY: Word);
begin
inherited Create($0A, 14);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
constructor TMoveStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewX, ANewY: Word);
begin
inherited Create($0A, 14);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
{ THueStaticPacket }
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
begin
inherited Create($0B, 12);
WriteStaticItem(AStaticItem);
FStream.WriteWord(ANewHue);
end;
constructor THueStaticPacket.Create(AX, AY: Word; AZ: ShortInt; ATileID: Word;
AHue: Word; ANewHue: Word);
begin
inherited Create($0B, 12);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteShortInt(AZ);
FStream.WriteWord(ATileID);
FStream.WriteWord(AHue);
FStream.WriteWord(ANewHue);
end;
{ TUpdateClientPosPacket }
constructor TUpdateClientPosPacket.Create(AX, AY: Word);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(AMessage);
end;
{ TGotoClientPosPacket }
constructor TGotoClientPosPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($06);
FStream.WriteStringNull(AUsername);
end;
{ TRequestRadarChecksumPacket }
constructor TRequestRadarChecksumPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($01);
end;
{ TRequestRadarMapPacket }
constructor TRequestRadarMapPacket.Create;
begin
inherited Create($0D, 2);
FStream.WriteByte($02);
end;
{ TNoOpPacket }
constructor TNoOpPacket.Create;
begin
inherited Create($FF, 1);
end;
end.

210
Client/UResourceManager.pas
View File

@ -1,105 +1,105 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UResourceManager;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TResourceManager }
TResourceManager = class(TObject)
constructor Create(AFileName: string);
destructor Destroy; override;
protected
FFileStream: TFileStream;
FCount: Integer;
FLookupTable: array of Cardinal;
FCurrentResource: Integer;
FResourceStream: TMemoryStream;
public
function GetResource(AIndex: Integer): TStream;
end;
var
ResourceManager: TResourceManager;
implementation
{ TResourceManager }
constructor TResourceManager.Create(AFileName: string);
begin
inherited Create;
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
FFileStream.Position := 0;
FFileStream.Read(FCount, SizeOf(Integer));
SetLength(FLookupTable, FCount);
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
FCurrentResource := -1;
end;
destructor TResourceManager.Destroy;
begin
FreeAndNil(FFileStream);
FreeAndNil(FResourceStream);
inherited Destroy;
end;
function TResourceManager.GetResource(AIndex: Integer): TStream;
var
size: Cardinal;
begin
if AIndex <> FCurrentResource then
begin
FFileStream.Position := FLookupTable[AIndex];
FResourceStream.Free;
FResourceStream := TMemoryStream.Create;
FFileStream.Read(size, SizeOf(Cardinal));
FResourceStream.CopyFrom(FFileStream, size);
FCurrentResource := AIndex;
end;
FResourceStream.Position := 0;
Result := FResourceStream;
end;
initialization
begin
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
end;
finalization
begin
if ResourceManager <> nil then FreeAndNil(ResourceManager);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UResourceManager;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TResourceManager }
TResourceManager = class
constructor Create(AFileName: string);
destructor Destroy; override;
protected
FFileStream: TFileStream;
FCount: Integer;
FLookupTable: array of Cardinal;
FCurrentResource: Integer;
FResourceStream: TMemoryStream;
public
function GetResource(AIndex: Integer): TStream;
end;
var
ResourceManager: TResourceManager;
implementation
{ TResourceManager }
constructor TResourceManager.Create(AFileName: string);
begin
inherited Create;
FFileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
FFileStream.Position := 0;
FFileStream.Read(FCount, SizeOf(Integer));
SetLength(FLookupTable, FCount);
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
FCurrentResource := -1;
end;
destructor TResourceManager.Destroy;
begin
FreeAndNil(FFileStream);
FreeAndNil(FResourceStream);
inherited Destroy;
end;
function TResourceManager.GetResource(AIndex: Integer): TStream;
var
size: Cardinal;
begin
if AIndex <> FCurrentResource then
begin
FFileStream.Position := FLookupTable[AIndex];
FResourceStream.Free;
FResourceStream := TMemoryStream.Create;
FFileStream.Read(size, SizeOf(Cardinal));
FResourceStream.CopyFrom(FFileStream, size);
FCurrentResource := AIndex;
end;
FResourceStream.Position := 0;
Result := FResourceStream;
end;
initialization
begin
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat'));
end;
finalization
begin
if ResourceManager <> nil then FreeAndNil(ResourceManager);
end;
end.

131
Client/UfrmMain.lfm
View File

@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 766
ActiveControl = oglGameWindow
Caption = 'UO CentrED'
ClientHeight = 580
ClientHeight = 583
ClientWidth = 766
Constraints.MinHeight = 603
Constraints.MinWidth = 766
@ -23,7 +23,7 @@ object frmMain: TfrmMain
object pnlBottom: TPanel
Left = 0
Height = 31
Top = 549
Top = 552
Width = 766
Align = alBottom
BevelOuter = bvNone
@ -34,7 +34,7 @@ object frmMain: TfrmMain
Left = 11
Height = 14
Top = 7
Width = 11
Width = 10
Caption = 'X:'
ParentColor = False
end
@ -42,7 +42,7 @@ object frmMain: TfrmMain
Left = 88
Height = 14
Top = 7
Width = 10
Width = 9
Caption = 'Y:'
ParentColor = False
end
@ -55,10 +55,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTip: TLabel
Left = 528
Left = 534
Height = 31
Top = 0
Width = 230
Width = 224
Align = alRight
Alignment = taRightJustify
BorderSpacing.Right = 8
@ -67,10 +67,10 @@ object frmMain: TfrmMain
ParentColor = False
end
object lblTipC: TLabel
Left = 498
Left = 511
Height = 31
Top = 0
Width = 30
Width = 23
Align = alRight
Caption = 'Tip: '
Font.Height = -11
@ -81,7 +81,7 @@ object frmMain: TfrmMain
end
object edX: TSpinEdit
Left = 24
Height = 19
Height = 21
Top = 3
Width = 55
MaxValue = 100000
@ -89,7 +89,7 @@ object frmMain: TfrmMain
end
object edY: TSpinEdit
Left = 104
Height = 19
Height = 21
Top = 3
Width = 52
MaxValue = 100000
@ -108,7 +108,7 @@ object frmMain: TfrmMain
end
object pcLeft: TPageControl
Left = 0
Height = 525
Height = 528
Top = 24
Width = 224
ActivePage = tsTiles
@ -117,13 +117,13 @@ object frmMain: TfrmMain
TabOrder = 1
object tsTiles: TTabSheet
Caption = 'Tiles'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 502
ClientWidth = 216
object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain
Left = 81
Left = 75
Height = 14
Top = 8
Width = 30
@ -140,9 +140,9 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList
Left = 4
Height = 242
Top = 56
Width = 210
Height = 258
Top = 50
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 4
@ -194,13 +194,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom
Left = 0
Height = 189
Top = 303
Width = 218
Top = 313
Width = 216
Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool'
ClientHeight = 175
ClientWidth = 216
ClientHeight = 171
ClientWidth = 212
TabOrder = 1
object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom
@ -360,10 +360,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete
Left = 164
Left = 160
Height = 22
Hint = 'Save Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -414,10 +414,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
Left = 190
Left = 186
Height = 22
Hint = 'Delete Preset'
Top = 142
Top = 146
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -474,9 +474,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset
Cursor = 63
Left = 4
Height = 114
Height = 118
Top = 24
Width = 208
Width = 204
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 2
@ -522,14 +522,14 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 29
Top = 142
Width = 156
Height = 21
Top = 146
Width = 152
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 0
ItemHeight = 13
OnChange = cbRandomPresetChange
Sorted = True
Style = csDropDownList
@ -543,8 +543,8 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 0
Height = 5
Top = 298
Width = 218
Top = 308
Width = 216
Align = alNone
Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom
@ -554,10 +554,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom
Left = 110
Height = 19
Left = 108
Height = 21
Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 271
Top = 279
Width = 96
Anchors = [akRight, akBottom]
BorderSpacing.Right = 8
@ -576,10 +576,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom
Left = 81
Height = 19
Left = 75
Height = 21
Top = 22
Width = 121
Width = 125
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone
@ -590,10 +590,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom
Left = 4
Height = 22
Top = 30
Width = 60
Left = 5
Height = 19
Top = 27
Width = 53
Caption = 'Statics'
Checked = True
OnChange = cbStaticsChange
@ -604,9 +604,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles
Left = 4
Height = 22
Height = 19
Top = 8
Width = 61
Width = 55
BorderSpacing.Left = 4
BorderSpacing.Top = 8
Caption = 'Terrain'
@ -618,26 +618,25 @@ object frmMain: TfrmMain
end
object tsClients: TTabSheet
Caption = 'Clients'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 499
ClientWidth = 216
object lbClients: TListBox
Left = 0
Height = 492
Height = 499
Top = 0
Width = 218
Width = 216
Align = alClient
ItemHeight = 0
OnDblClick = mnuGoToClientClick
PopupMenu = pmClients
Sorted = True
TabOrder = 0
TopIndex = -1
end
end
object tsLocations: TTabSheet
Caption = 'Locations'
ClientHeight = 492
ClientWidth = 218
ClientHeight = 499
ClientWidth = 216
object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom
@ -645,7 +644,7 @@ object frmMain: TfrmMain
Left = 125
Height = 22
Hint = 'Clear'
Top = 466
Top = 473
Width = 23
BorderSpacing.Left = 4
Color = clBtnFace
@ -698,7 +697,7 @@ object frmMain: TfrmMain
Left = 98
Height = 22
Hint = 'Delete'
Top = 466
Top = 473
Width = 23
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
@ -750,7 +749,7 @@ object frmMain: TfrmMain
Left = 71
Height = 22
Hint = 'Add'
Top = 466
Top = 473
Width = 23
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
@ -804,9 +803,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63
Left = 4
Height = 458
Height = 465
Top = 4
Width = 210
Width = 208
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4
BorderStyle = bsSingle
@ -821,7 +820,7 @@ object frmMain: TfrmMain
item
Position = 1
Text = 'Name'
Width = 131
Width = 129
end>
Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
@ -1029,7 +1028,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat
Left = 224
Height = 22
Top = 413
Top = 416
Width = 542
Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised
@ -1042,7 +1041,7 @@ object frmMain: TfrmMain
Left = 10
Height = 18
Top = 2
Width = 104
Width = 101
Align = alLeft
BorderSpacing.Left = 8
Caption = 'Chat and Messages'
@ -1063,7 +1062,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom
Left = 224
Height = 109
Top = 440
Top = 443
Width = 542
Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone
@ -1074,7 +1073,7 @@ object frmMain: TfrmMain
object vstChat: TVirtualStringTree
Cursor = 63
Left = 0
Height = 90
Height = 88
Top = 0
Width = 542
Align = alClient
@ -1112,8 +1111,8 @@ object frmMain: TfrmMain
end
object edChat: TEdit
Left = 0
Height = 19
Top = 90
Height = 21
Top = 88
Width = 542
Align = alBottom
OnKeyPress = edChatKeyPress
@ -1128,7 +1127,7 @@ object frmMain: TfrmMain
Cursor = crVSplit
Left = 224
Height = 5
Top = 435
Top = 438
Width = 542
Align = alNone
Anchors = [akLeft, akRight, akBottom]
@ -1145,7 +1144,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader
Left = 224
Height = 389
Height = 392
Top = 24
Width = 542
Anchors = [akTop, akLeft, akRight, akBottom]

8
Client/UfrmMain.pas
View File

@ -607,8 +607,6 @@ end;
procedure TfrmMain.oglGameWindowMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
node: PVirtualNode;
tileInfo: PTileInfo;
map: TMapCell;
i: Integer;
z: ShortInt;
@ -923,7 +921,7 @@ end;
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
var
presetName: string;
i, index: Integer;
i: Integer;
preset, tile: TDOMElement;
children: TDOMNodeList;
tileNode: PVirtualNode;
@ -2047,7 +2045,7 @@ end;
procedure TfrmMain.PrepareScreenBlock(ABlockInfo: PBlockInfo);
procedure GetLandAlt(const AX, AY: Integer; const ADefaultZ,
ADefaultRaw: SmallInt; var Z, RawZ: SmallInt);
ADefaultRaw: SmallInt; out Z, RawZ: SmallInt);
var
cell: TMapCell;
begin
@ -2547,7 +2545,7 @@ begin
virtualTile.Y := tileY;
virtualTile.Z := frmVirtualLayer.seZ.Value;
virtualTile.Priority := virtualTile.Z;
virtualTile.PriorityBonus := MaxInt;
virtualTile.PriorityBonus := High(ShortInt);
Inc(i);
end;

356
Client/UfrmTileInfo.pas
View File

@ -1,186 +1,170 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UfrmTileInfo;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLIntf, LCLType, LMessages, strutils;
type
{ TfrmTileInfo }
TfrmTileInfo = class(TForm)
lblName: TLabel;
lblFlags: TLabel;
lblTileID: TLabel;
tmHide: TTimer;
procedure FormShow(Sender: TObject);
procedure tmHideTimer(Sender: TObject);
private
{ private declarations }
public
procedure Update(ATileID: Word);
//procedure Show; overload; reintroduce;
procedure Show(ATileID: Word); overload;
end;
var
frmTileInfo: TfrmTileInfo;
implementation
uses
UGameResources, UTiledata;
{ TfrmTileInfo }
procedure TfrmTileInfo.tmHideTimer(Sender: TObject);
begin
tmHide.Enabled := False;
Hide;
end;
procedure TfrmTileInfo.FormShow(Sender: TObject);
begin
tmHide.Enabled := True;
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
procedure TfrmTileInfo.Update(ATileID: Word);
var
tileData: TTiledata;
prefix, flags: string;
procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
begin
if AFlag in tileData.Flags then
begin
if flags <> '' then
flags := flags + ', ' + AName
else
flags := AName;
end;
end;
begin
if Visible then
begin
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
flags := '';
if ATileID < $4000 then
begin
tileData := ResMan.Tiledata.LandTiles[ATileID];
if TLandTiledata(tileData).TextureID > 0 then
flags := 'Stretchable';
end else
begin
Dec(ATileID, $4000);
tileData := ResMan.Tiledata.StaticTiles[ATileID];
end;
if tdfArticleA in tileData.Flags then
prefix := 'a '
else if tdfArticleAn in tileData.Flags then
prefix := 'an '
else
prefix := '';
lblName.Caption := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']);
lblTileID.Caption := Format('Tile ID: $%x (%0:d)', [ATileID]);
UpdateFlags(tdfBackground, 'Background');
UpdateFlags(tdfWeapon, 'Weapon');
UpdateFlags(tdfTransparent, 'Transparent');
UpdateFlags(tdfTranslucent, 'Translucent');
UpdateFlags(tdfWall, 'Wall');
UpdateFlags(tdfDamaging, 'Damaging');
UpdateFlags(tdfImpassable, 'Impassable');
UpdateFlags(tdfWet, 'Wet');
UpdateFlags(tdfSurface, 'Surface');
UpdateFlags(tdfBridge, 'Bridge');
UpdateFlags(tdfGeneric, 'Generic');
UpdateFlags(tdfWindow, 'Window');
UpdateFlags(tdfNoShoot, 'NoShoot');
UpdateFlags(tdfInternal, 'Internal');
UpdateFlags(tdfFoliage, 'Foliage');
UpdateFlags(tdfPartialHue, 'PartialHue');
UpdateFlags(tdfMap, 'Map');
UpdateFlags(tdfContainer, 'Container');
UpdateFlags(tdfWearable, 'Wearable');
UpdateFlags(tdfLightSource, 'Lightsource');
UpdateFlags(tdfAnimation, 'Animation');
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
UpdateFlags(tdfArmor, 'Armor');
UpdateFlags(tdfRoof, 'Roof');
UpdateFlags(tdfDoor, 'Door');
UpdateFlags(tdfStairBack, 'StairBack');
UpdateFlags(tdfStairRight, 'StairRight');
lblFlags.Caption := Format('Flags = [%s]', [flags]);
if tmHide.Enabled then
begin
tmHide.Enabled := False;
tmHide.Enabled := True; //Refresh timer
end;
end;
{procedure TfrmTileInfo.Show;
begin
ShowWindow(Handle, SW_SHOWNOACTIVATE);
Include(FormState, fsVisible);
VisibleChanging;
try
Perform(CM_VISIBLECHANGED, WParam(Ord(True)), 0);
AdjustSize;
RequestAlign;
finally
VisibleChanged;
end;
//FormShow(Self);
end;}
procedure TfrmTileInfo.Show(ATileID: Word);
begin
Update(ATileID);
Show;
end;
initialization
{$I UfrmTileInfo.lrs}
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmTileInfo;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLIntf, LCLType, strutils;
type
{ TfrmTileInfo }
TfrmTileInfo = class(TForm)
lblName: TLabel;
lblFlags: TLabel;
lblTileID: TLabel;
tmHide: TTimer;
procedure FormShow(Sender: TObject);
procedure tmHideTimer(Sender: TObject);
private
{ private declarations }
public
procedure Update(ATileID: Word);
procedure Show(ATileID: Word); overload;
end;
var
frmTileInfo: TfrmTileInfo;
implementation
uses
UGameResources, UTiledata;
{ TfrmTileInfo }
procedure TfrmTileInfo.tmHideTimer(Sender: TObject);
begin
tmHide.Enabled := False;
Hide;
end;
procedure TfrmTileInfo.FormShow(Sender: TObject);
begin
tmHide.Enabled := True;
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
procedure TfrmTileInfo.Update(ATileID: Word);
var
tileData: TTiledata;
prefix, flags: string;
procedure UpdateFlags(AFlag: TTileDataFlag; AName: string);
begin
if AFlag in tileData.Flags then
begin
if flags <> '' then
flags := flags + ', ' + AName
else
flags := AName;
end;
end;
begin
if Visible then
begin
Left := Mouse.CursorPos.x + 8;
Top := Mouse.CursorPos.y + 8;
end;
flags := '';
if ATileID < $4000 then
begin
tileData := ResMan.Tiledata.LandTiles[ATileID];
if TLandTiledata(tileData).TextureID > 0 then
flags := 'Stretchable';
end else
begin
Dec(ATileID, $4000);
tileData := ResMan.Tiledata.StaticTiles[ATileID];
end;
if tdfArticleA in tileData.Flags then
prefix := 'a '
else if tdfArticleAn in tileData.Flags then
prefix := 'an '
else
prefix := '';
lblName.Caption := AnsiProperCase(Format('%s%s', [prefix, tileData.TileName]), [' ']);
lblTileID.Caption := Format('Tile ID: $%x (%0:d)', [ATileID]);
UpdateFlags(tdfBackground, 'Background');
UpdateFlags(tdfWeapon, 'Weapon');
UpdateFlags(tdfTransparent, 'Transparent');
UpdateFlags(tdfTranslucent, 'Translucent');
UpdateFlags(tdfWall, 'Wall');
UpdateFlags(tdfDamaging, 'Damaging');
UpdateFlags(tdfImpassable, 'Impassable');
UpdateFlags(tdfWet, 'Wet');
UpdateFlags(tdfSurface, 'Surface');
UpdateFlags(tdfBridge, 'Bridge');
UpdateFlags(tdfGeneric, 'Generic');
UpdateFlags(tdfWindow, 'Window');
UpdateFlags(tdfNoShoot, 'NoShoot');
UpdateFlags(tdfInternal, 'Internal');
UpdateFlags(tdfFoliage, 'Foliage');
UpdateFlags(tdfPartialHue, 'PartialHue');
UpdateFlags(tdfMap, 'Map');
UpdateFlags(tdfContainer, 'Container');
UpdateFlags(tdfWearable, 'Wearable');
UpdateFlags(tdfLightSource, 'Lightsource');
UpdateFlags(tdfAnimation, 'Animation');
UpdateFlags(tdfNoDiagonal, 'NoDiagonal');
UpdateFlags(tdfArmor, 'Armor');
UpdateFlags(tdfRoof, 'Roof');
UpdateFlags(tdfDoor, 'Door');
UpdateFlags(tdfStairBack, 'StairBack');
UpdateFlags(tdfStairRight, 'StairRight');
lblFlags.Caption := Format('Flags = [%s]', [flags]);
if tmHide.Enabled then
begin
tmHide.Enabled := False;
tmHide.Enabled := True; //Refresh timer
end;
end;
procedure TfrmTileInfo.Show(ATileID: Word);
begin
Update(ATileID);
Show;
end;
initialization
{$I UfrmTileInfo.lrs}
end.

78
Logging.pas
View File

@ -1,39 +1,39 @@
unit Logging;
{$mode objfpc}{$H+}
interface
uses
MultiLog, IPCChannel;
const
lcAll = [0..31]; //all logging classes
lcDebug = 0;
lcError = 1;
lcInfo = 2;
lcWarning = 3;
lcEvents = 4;
lcServer = 10;
lcClient = 11;
lcLandscape = 12;
var
Logger: TLogger;
implementation
initialization
Logger := TLogger.Create;
{$IFNDEF NoLogging}
Logger.Channels.Add(TIPCChannel.Create);
Logger.ActiveClasses := lcAll;
{$ENDIF}
finalization
Logger.Free;
end.
unit Logging;
{$mode objfpc}{$H+}
interface
uses
MultiLog{$IFNDEF NoLogging}, IPCChannel{$ENDIF};
const
lcAll = [0..31]; //all logging classes
lcDebug = 0;
lcError = 1;
lcInfo = 2;
lcWarning = 3;
lcEvents = 4;
lcServer = 10;
lcClient = 11;
lcLandscape = 12;
var
Logger: TLogger;
implementation
initialization
Logger := TLogger.Create;
{$IFNDEF NoLogging}
Logger.Channels.Add(TIPCChannel.Create);
Logger.ActiveClasses := lcAll;
{$ENDIF}
finalization
Logger.Free;
end.

258
MulProvider/UMulManager.pas
View File

@ -1,129 +1,129 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulManager;
interface
uses
SysUtils, UMulProvider, UTileDataProvider, UArtProvider, UGumpProvider,
UTexmapProvider, UHueProvider, URadarProvider, UAnimDataProvider;
type
{ TMulManager }
TMulManager = class
destructor Destroy; override;
protected
FArtProvider: TArtProvider;
FGumpProvider: TGumpProvider;
FTexmapProvider: TTexmapProvider;
FTileDataProvider: TTileDataProvider;
FAnimDataProvider: TAnimDataProvider;
FHueProvider: THueProvider;
FRadarProvider: TRadarProvider;
public
procedure RegisterArtProvider(AArtProvider: TArtProvider);
procedure RegisterGumpProvider(AGumpProvider: TGumpProvider);
procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider);
procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider);
procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider);
procedure RegisterHueProvider(AHueProvider: THueProvider);
procedure RegisterRadarProvider(ARadarProvider: TRadarProvider);
property ArtProvider: TArtProvider read FArtProvider;
property GumpProvider: TGumpProvider read FGumpProvider;
property TexmapProvider: TTexmapProvider read FTexmapProvider;
property TileDataProvider: TTileDataProvider read FTileDataProvider;
property AnimDataProvider: TAnimDataProvider read FAnimDataProvider;
property HueProvider: THueProvider read FHueProvider;
property RadarProvider: TRadarPRovider read FRadarProvider;
end;
implementation
{ TMulManager }
destructor TMulManager.Destroy;
begin
RegisterArtProvider(nil);
RegisterGumpProvider(nil);
RegisterTexmapProvider(nil);
RegisterTileDataProvider(nil);
RegisterHueProvider(nil);
RegisterRadarProvider(nil);
inherited Destroy;
end;
procedure TMulManager.RegisterArtProvider(
AArtProvider: TArtProvider);
begin
FreeAndNil(FArtProvider);
FArtProvider := AArtProvider;
end;
procedure TMulManager.RegisterGumpProvider(
AGumpProvider: TGumpProvider);
begin
FreeAndNil(FGumpProvider);
FGumpProvider := AGumpProvider;
end;
procedure TMulManager.RegisterHueProvider(
AHueProvider: THueProvider);
begin
FreeAndNil(FHueProvider);
FHueProvider := AHueProvider;
end;
procedure TMulManager.RegisterRadarProvider(
ARadarProvider: TRadarProvider);
begin
FreeAndNil(FRadarProvider);
FRadarProvider := ARadarProvider;
end;
procedure TMulManager.RegisterTexmapProvider(
ATexmapProvider: TTexmapProvider);
begin
FreeAndNil(FTexmapProvider);
FTexmapProvider := ATexmapProvider;
end;
procedure TMulManager.RegisterTileDataProvider(
ATileDataProvider: TTileDataProvider);
begin
FreeAndNil(FTileDataProvider);
FTileDataProvider := ATileDataProvider;
end;
procedure TMulManager.RegisterAnimDataProvider(
AAnimDataProvider: TAnimDataProvider);
begin
FreeAndNil(FAnimDataProvider);
FAnimDataProvider := AAnimDataProvider;
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulManager;
interface
uses
SysUtils, UTileDataProvider, UArtProvider, UGumpProvider, UTexmapProvider,
UHueProvider, URadarProvider, UAnimDataProvider;
type
{ TMulManager }
TMulManager = class
destructor Destroy; override;
protected
FArtProvider: TArtProvider;
FGumpProvider: TGumpProvider;
FTexmapProvider: TTexmapProvider;
FTileDataProvider: TTileDataProvider;
FAnimDataProvider: TAnimDataProvider;
FHueProvider: THueProvider;
FRadarProvider: TRadarProvider;
public
procedure RegisterArtProvider(AArtProvider: TArtProvider);
procedure RegisterGumpProvider(AGumpProvider: TGumpProvider);
procedure RegisterTexmapProvider(ATexmapProvider: TTexmapProvider);
procedure RegisterTileDataProvider(ATileDataProvider: TTileDataProvider);
procedure RegisterAnimDataProvider(AAnimDataProvider: TAnimDataProvider);
procedure RegisterHueProvider(AHueProvider: THueProvider);
procedure RegisterRadarProvider(ARadarProvider: TRadarProvider);
property ArtProvider: TArtProvider read FArtProvider;
property GumpProvider: TGumpProvider read FGumpProvider;
property TexmapProvider: TTexmapProvider read FTexmapProvider;
property TileDataProvider: TTileDataProvider read FTileDataProvider;
property AnimDataProvider: TAnimDataProvider read FAnimDataProvider;
property HueProvider: THueProvider read FHueProvider;
property RadarProvider: TRadarPRovider read FRadarProvider;
end;
implementation
{ TMulManager }
destructor TMulManager.Destroy;
begin
RegisterArtProvider(nil);
RegisterGumpProvider(nil);
RegisterTexmapProvider(nil);
RegisterTileDataProvider(nil);
RegisterHueProvider(nil);
RegisterRadarProvider(nil);
inherited Destroy;
end;
procedure TMulManager.RegisterArtProvider(
AArtProvider: TArtProvider);
begin
FreeAndNil(FArtProvider);
FArtProvider := AArtProvider;
end;
procedure TMulManager.RegisterGumpProvider(
AGumpProvider: TGumpProvider);
begin
FreeAndNil(FGumpProvider);
FGumpProvider := AGumpProvider;
end;
procedure TMulManager.RegisterHueProvider(
AHueProvider: THueProvider);
begin
FreeAndNil(FHueProvider);
FHueProvider := AHueProvider;
end;
procedure TMulManager.RegisterRadarProvider(
ARadarProvider: TRadarProvider);
begin
FreeAndNil(FRadarProvider);
FRadarProvider := ARadarProvider;
end;
procedure TMulManager.RegisterTexmapProvider(
ATexmapProvider: TTexmapProvider);
begin
FreeAndNil(FTexmapProvider);
FTexmapProvider := ATexmapProvider;
end;
procedure TMulManager.RegisterTileDataProvider(
ATileDataProvider: TTileDataProvider);
begin
FreeAndNil(FTileDataProvider);
FTileDataProvider := ATileDataProvider;
end;
procedure TMulManager.RegisterAnimDataProvider(
AAnimDataProvider: TAnimDataProvider);
begin
FreeAndNil(FAnimDataProvider);
FAnimDataProvider := AAnimDataProvider;
end;
end.

13
MulProvider/URadarProvider.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
* Portions Copyright 2009 Andreas Schneider
*)
unit URadarProvider;
@ -33,7 +33,10 @@ uses
SysUtils, Classes, UBufferedStreams;
type
TRadarProvider = class(TObject)
{ TRadarProvider }
TRadarProvider = class
constructor Create; overload; virtual;
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual;
@ -77,18 +80,18 @@ end;
destructor TRadarProvider.Destroy;
begin
if Assigned(FData) then FreeAndNil(FData);
FreeAndNil(FData);
inherited Destroy;
end;
function TRadarProvider.GetColor(AID: Integer): Word;
begin
Result := 0;
if (AID >= 0) and (AID < $10000) then
begin
FData.Position := SizeOf(Word) * AID;
FData.Read(Result, SizeOf(Word));
end else
Result := 0;
end;
end;
procedure TRadarProvider.SetColor(AID: Integer; AColor: Word);

648
UOLib/UArt.pas
View File

@ -1,323 +1,325 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UArt;
{$mode objfpc}{$H+}
interface
uses
Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses,
UMulBlock, UGenericIndex, UHue;
type
TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload;
destructor Destroy; override;
function Clone: TArt; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure RefreshBuffer;
protected
FArtType: TArtType;
FHeader: LongInt;
FGraphic: TSingleImage;
FBuffer: TStream;
public
property ArtType: TArtType read FArtType write FArtType;
property Header: LongInt read FHeader write FHeader;
property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer;
end;
implementation
type
PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType);
begin
Create(AData, AIndex, AArtType, 0, nil, False);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean);
begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean);
var
i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
lookup: array of integer;
color, run, offset: Word;
block: TMemoryStream;
P: PWordArray;
r, g, b: Byte;
begin
FBuffer := TMemoryStream.Create;
FArtType := AArtType;
AArtColor := AArtColor or $8000; //set alpha bit on background
if Assigned(AData) and (AIndex.Lookup > -1) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
if AArtType = atLand then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do
begin
P := FGraphic.Bits + y * 44 * 2;
block.Read(P^[22 - (y + 1)], (y + 1) * 4);
end;
for y := 0 to 21 do
begin
P := FGraphic.Bits + (22 + y) * 44 * 2;
block.Read(P^[y], (22 - y) * 4);
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do
begin
for x := 0 to i * 2 - 1 do
begin
y := i * 2 - x - 1;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color;
end;
end;
for i := 22 to 43 do
begin
for y := 0 to (44 - i) * 2 - 1 do
begin
x := 42 - (43 - i) * 2 + y;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color;
end;
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then
begin
block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt));
FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5);
FillWord(FGraphic.Bits^, width * height, AArtColor);
SetLength(lookup, height);
start := block.Position + (height * 2);
for i := 0 to height - 1 do
begin
block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2);
end;
for iCurrentHeight := 0 to height - 1 do
begin
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and (offset + run <> 0) do
begin
inc(iCurrentWidth, offset);
for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end;
end;
if AHue <> nil then
begin
for i := 0 to width * height - 1 do
begin
color := PWordArray(FGraphic.Bits)^[i];
if color <> AArtColor then
begin
r := (color and $7C00) shr 10;
if APartialHue then
begin
g := (color and $3E0) shr 5;
b := color and $1F;
if (r = g) and (g = b) then
color := AHue.ColorTable[r];
end else
color := AHue.ColorTable[r];
end;
PWordArray(FGraphic.Bits)^[i] := color;
end;
end;
for i := 0 to width * height - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else
FGraphic:= TSingleImage.Create;
if Assigned(block) then block.Free;
end else
begin
FHeader := 1;
FGraphic := TSingleImage.Create;
end;
FGraphic.Format := ifA8R8G8B8;
end;
destructor TArt.Destroy;
begin
if assigned(FGraphic) then FGraphic.Free;
if assigned(FBuffer) then FBuffer.Free;
inherited;
end;
function TArt.Clone: TArt;
begin
Result := TArt.Create(nil, nil, FArtType);
Result.FHeader := FHeader;
Result.FGraphic.Assign(FGraphic);
end;
procedure TArt.Write(AData: TStream);
begin
FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
end;
function TArt.GetSize: Integer;
begin
RefreshBuffer;
Result := FBuffer.Size
end;
procedure TArt.RefreshBuffer;
var
argbGraphic: TSingleImage;
i, j, x, y, lineWidth, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
color, run, offset: Word;
lookup: array of SmallInt;
begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifA1R5G5B5;
for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do
PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit
FBuffer.Size := 0;
if FArtType = atLand then
begin
if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit;
x := 21;
y := 0;
lineWidth := 2;
for i := 1 to 22 do
begin
Dec(x);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(y);
Inc(lineWidth, 2);
end;
for i := 1 to 22 do
begin
Dec(lineWidth, 2);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(x);
Inc(y);
end;
end else if FArtType = atStatic then
begin
if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit;
width := argbGraphic.Width;
height := argbGraphic.Height;
FBuffer.Write(FHeader, SizeOf(LongInt));
FBuffer.Write(width, SizeOf(SmallInt));
FBuffer.Write(height, SizeOf(SmallInt));
SetLength(lookup, height);
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table
start := FBuffer.Position;
for iCurrentHeight := 0 to height - 1 do
begin
lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line
offset := 0;
run := 0;
for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line
begin
color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth];
if (color and $8000 = 0) and (run = 0) then //new visible pixel found
begin
FBuffer.Write(offset, SizeOf(Word));
FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length"
run := 1;
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found
begin
inc(run);
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ...
FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ...
FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed
run := 0;
offset := 1;
end else
inc(offset);
end;
if run > 0 then //no more pixels but the "run" didn't end yet ;-)
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent);
FBuffer.Write(run, SizeOf(Word));
FBuffer.Seek(Integer(run * 2), soFromCurrent);
run := 0;
end;
FBuffer.Write(run, SizeOf(Word)); //just write "0"
FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line
end;
FBuffer.Position := start - (height * 2); //now update the lookup table with our new values
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt));
end;
argbGraphic.Free;
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UArt;
{$mode objfpc}{$H+}
interface
uses
Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses,
UMulBlock, UGenericIndex, UHue;
type
TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload;
destructor Destroy; override;
function Clone: TArt; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure RefreshBuffer;
protected
FArtType: TArtType;
FHeader: LongInt;
FGraphic: TSingleImage;
FBuffer: TStream;
public
property ArtType: TArtType read FArtType write FArtType;
property Header: LongInt read FHeader write FHeader;
property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer;
end;
implementation
type
PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType);
begin
Create(AData, AIndex, AArtType, 0, nil, False);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean);
begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean);
var
i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
lookup: array of integer;
color, run, offset: Word;
block: TMemoryStream;
P: PWordArray;
r, g, b: Byte;
begin
FBuffer := TMemoryStream.Create;
FArtType := AArtType;
AArtColor := AArtColor or $8000; //set alpha bit on background
if Assigned(AData) and (AIndex.Lookup > -1) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
if AArtType = atLand then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do
begin
P := FGraphic.Bits + y * 44 * 2;
block.Read(P^[22 - (y + 1)], (y + 1) * 4);
end;
for y := 0 to 21 do
begin
P := FGraphic.Bits + (22 + y) * 44 * 2;
block.Read(P^[y], (22 - y) * 4);
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do
begin
for x := 0 to i * 2 - 1 do
begin
y := i * 2 - x - 1;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color;
end;
end;
for i := 22 to 43 do
begin
for y := 0 to (44 - i) * 2 - 1 do
begin
x := 42 - (43 - i) * 2 + y;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color;
end;
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then
begin
block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt));
FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5);
FillWord(FGraphic.Bits^, width * height, AArtColor);
SetLength(lookup, height);
start := block.Position + (height * 2);
for i := 0 to height - 1 do
begin
block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2);
end;
for iCurrentHeight := 0 to height - 1 do
begin
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
(block.Read(run, SizeOf(Word)) = SizeOf(Word)) and
(offset + run <> 0) do
begin
inc(iCurrentWidth, offset);
for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end;
end;
if AHue <> nil then
begin
for i := 0 to width * height - 1 do
begin
color := PWordArray(FGraphic.Bits)^[i];
if color <> AArtColor then
begin
r := (color and $7C00) shr 10;
if APartialHue then
begin
g := (color and $3E0) shr 5;
b := color and $1F;
if (r = g) and (g = b) then
color := AHue.ColorTable[r];
end else
color := AHue.ColorTable[r];
end;
PWordArray(FGraphic.Bits)^[i] := color;
end;
end;
for i := 0 to width * height - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else
FGraphic:= TSingleImage.Create;
if Assigned(block) then block.Free;
end else
begin
FHeader := 1;
FGraphic := TSingleImage.Create;
end;
FGraphic.Format := ifA8R8G8B8;
end;
destructor TArt.Destroy;
begin
if assigned(FGraphic) then FGraphic.Free;
if assigned(FBuffer) then FBuffer.Free;
inherited;
end;
function TArt.Clone: TArt;
begin
Result := TArt.Create(nil, nil, FArtType);
Result.FHeader := FHeader;
Result.FGraphic.Assign(FGraphic);
end;
procedure TArt.Write(AData: TStream);
begin
FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
end;
function TArt.GetSize: Integer;
begin
RefreshBuffer;
Result := FBuffer.Size
end;
procedure TArt.RefreshBuffer;
var
argbGraphic: TSingleImage;
i, x, y, lineWidth, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
color, run, offset: Word;
lookup: array of SmallInt;
begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifA1R5G5B5;
for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do
PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit
FBuffer.Size := 0;
if FArtType = atLand then
begin
if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit;
x := 21;
y := 0;
lineWidth := 2;
for i := 1 to 22 do
begin
Dec(x);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth);
Inc(y);
Inc(lineWidth, 2);
end;
for i := 1 to 22 do
begin
Dec(lineWidth, 2);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + i], lineWidth);
Inc(x);
Inc(y);
end;
end else if FArtType = atStatic then
begin
if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit;
width := argbGraphic.Width;
height := argbGraphic.Height;
FBuffer.Write(FHeader, SizeOf(LongInt));
FBuffer.Write(width, SizeOf(SmallInt));
FBuffer.Write(height, SizeOf(SmallInt));
SetLength(lookup, height);
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table
start := FBuffer.Position;
for iCurrentHeight := 0 to height - 1 do
begin
lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line
offset := 0;
run := 0;
for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line
begin
color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth];
if (color and $8000 = 0) and (run = 0) then //new visible pixel found
begin
FBuffer.Write(offset, SizeOf(Word));
FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length"
run := 1;
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found
begin
inc(run);
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ...
FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ...
FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed
run := 0;
offset := 1;
end else
inc(offset);
end;
if run > 0 then //no more pixels but the "run" didn't end yet ;-)
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent);
FBuffer.Write(run, SizeOf(Word));
FBuffer.Seek(Integer(run * 2), soFromCurrent);
run := 0;
end;
FBuffer.Write(run, SizeOf(Word)); //just write "0"
FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line
end;
FBuffer.Position := start - (height * 2); //now update the lookup table with our new values
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt));
end;
argbGraphic.Free;
end;
end.

25
UOLib/UHue.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
* Portions Copyright 2009 Andreas Schneider
*)
unit UHue;
@ -30,10 +30,14 @@ unit UHue;
interface
uses
SysUtils, Classes, Graphics, UMulBlock, UGraphicHelper;
SysUtils, Classes, Graphics, UMulBlock;
type
TColorTable = array[0..31] of Word;
{ THue }
THue = class(TMulBlock)
constructor Create(AData: TStream);
function Clone: THue; override;
@ -52,7 +56,11 @@ type
property TableEnd: Word read FTableEnd write FTableEnd;
property Name: string read GetName write SetName;
end;
THueEntries = array[0..7] of THue;
{ THueGroup }
THueGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
@ -92,7 +100,7 @@ var
color: Word;
begin
SetLength(FName, 20);
if Assigned(AData) then
if AData <> nil then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 88);
@ -158,7 +166,7 @@ var
i: Integer;
buffer: TMemoryStream;
begin
if Assigned(AData) then
if AData <> nil then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 708);
@ -170,7 +178,7 @@ begin
for i := 0 to 7 do
FHueEntries[i] := THue.Create(buffer);
if Assigned(buffer) then FreeAndNil(buffer);
buffer.Free;
end;
destructor THueGroup.Destroy;
@ -178,9 +186,8 @@ var
i: Integer;
begin
for i := 0 to 7 do
if Assigned(FHueEntries[i]) then
FreeAndNil(FHueEntries[i]);
inherited;
FreeAndNil(FHueEntries[i]);
inherited Destroy;
end;
function THueGroup.GetHueEntry(AIndex: Integer): THue;
@ -195,7 +202,7 @@ end;
procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue);
begin
if Assigned(FHueEntries[AIndex]) then FreeAndNil(FHueEntries[AIndex]);
FreeAndNil(FHueEntries[AIndex]);
FHueEntries[AIndex] := AValue;
end;

444
UOLib/UMap.pas
View File

@ -1,222 +1,222 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UMulBlock, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
{ TMapCell }
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
FIsGhost: Boolean;
FGhostZ: ShortInt;
FGhostID: Word;
function GetTileID: Word; override;
function GetZ: ShortInt; override;
public
property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
TMapCellList = specialize TFPGObjectList<TMapCell>;
{ TMapBlock }
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
function GetMapCellOffset(ABlock: Integer): Integer;
implementation
function GetMapCellOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
group := ABlock div 64;
tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end;
{ TMapCell }
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
FIsGhost := False;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TMapCell.GetTileID: Word;
begin
if FIsGhost then
Result := FGhostID
else
Result := FTileID;
end;
function TMapCell.GetZ: ShortInt;
begin
if FIsGhost then
Result := FGhostZ
else
Result := FZ;
end;
function TMapCell.Clone: TMapCell;
begin
Result := TMapCell.Create(nil, nil);
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FTileID := FTileID;
end;
procedure TMapCell.Write(AData: TStream);
begin
AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt));
end;
function TMapCell.GetSize: Integer;
begin
Result := MapCellSize;
end;
{ TMapBlock }
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var
iX, iY: Integer;
buffer: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
try
buffer := nil;
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt));
end;
for iY := 0 to 7 do
for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally
if Assigned(buffer) then FreeAndNil(buffer);
end;
end;
constructor TMapBlock.Create(AData: TStream);
begin
Create(AData, 0, 0);
end;
destructor TMapBlock.Destroy;
var
i: Integer;
begin
for i := 0 to 63 do
Cells[i].Free;
inherited;
end;
function TMapBlock.Clone: TMapBlock;
var
i: Integer;
begin
Result := TMapBlock.Create(nil);
Result.FX := FX;
Result.FY := FY;
for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone;
end;
procedure TMapBlock.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do
Cells[i].Write(AData);
end;
function TMapBlock.GetSize: Integer;
begin
Result := MapBlockSize;
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
{ TMapCell }
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
FIsGhost: Boolean;
FGhostZ: ShortInt;
FGhostID: Word;
function GetTileID: Word; override;
function GetZ: ShortInt; override;
public
property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
TMapCellList = specialize TFPGObjectList<TMapCell>;
{ TMapBlock }
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
function GetMapCellOffset(ABlock: Integer): Integer;
implementation
function GetMapCellOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
group := ABlock div 64;
tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end;
{ TMapCell }
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
FIsGhost := False;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TMapCell.GetTileID: Word;
begin
if FIsGhost then
Result := FGhostID
else
Result := FTileID;
end;
function TMapCell.GetZ: ShortInt;
begin
if FIsGhost then
Result := FGhostZ
else
Result := FZ;
end;
function TMapCell.Clone: TMapCell;
begin
Result := TMapCell.Create(nil, nil);
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FTileID := FTileID;
end;
procedure TMapCell.Write(AData: TStream);
begin
AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt));
end;
function TMapCell.GetSize: Integer;
begin
Result := MapCellSize;
end;
{ TMapBlock }
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var
iX, iY: Integer;
buffer: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
try
buffer := nil;
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt));
end;
for iY := 0 to 7 do
for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally
if Assigned(buffer) then FreeAndNil(buffer);
end;
end;
constructor TMapBlock.Create(AData: TStream);
begin
Create(AData, 0, 0);
end;
destructor TMapBlock.Destroy;
var
i: Integer;
begin
for i := 0 to 63 do
Cells[i].Free;
inherited;
end;
function TMapBlock.Clone: TMapBlock;
var
i: Integer;
begin
Result := TMapBlock.Create(nil);
Result.FX := FX;
Result.FY := FY;
for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone;
end;
procedure TMapBlock.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do
Cells[i].Write(AData);
end;
function TMapBlock.GetSize: Integer;
begin
Result := MapBlockSize;
end;
end.

6
UOLib/UMulBlock.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulBlock;
@ -38,7 +38,7 @@ type
{ TMulBlockEventHandler }
TMulBlockEventHandler = class(TObject)
TMulBlockEventHandler = class
constructor Create;
destructor Destroy; override;
protected
@ -51,7 +51,7 @@ type
{ TMulBlock }
TMulBlock = class(TObject)
TMulBlock = class
constructor Create;
destructor Destroy; override;
protected

510
UOLib/UStatics.pas
View File

@ -1,256 +1,254 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UStatics;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
type
{ TStaticItem }
TStaticItem = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
{ Members }
FHue: Word;
FOrgHue: Word;
{ Methods }
function HasChanged: Boolean; override;
procedure SetHue(AHue: Word);
public
{ Fields }
property Hue: Word read FHue write SetHue;
{ Methods }
function Clone: TStaticItem; override;
function GetSize: Integer; override;
procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override;
end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
protected
{ Members }
FItems: TStaticItemList;
public
{ Fields }
property Items: TStaticItemList read FItems write FItems;
{ Methods }
function Clone: TStaticBlock; override;
function GetSize: Integer; override;
procedure ReverseWrite(AData: TStream);
procedure Sort;
procedure Write(AData: TStream); override;
end;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin
Result := CompareWorldItems(AStatic1, AStatic2);
end;
{ TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word);
var
iX, iY: Byte;
begin
inherited Create(AOwner);
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
InitOriginalState;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TStaticItem.HasChanged: Boolean;
begin
Result := (FHue <> FOrgHue) or inherited HasChanged;
end;
procedure TStaticItem.SetHue(AHue: Word);
begin
FHue := AHue;
DoChanged;
end;
function TStaticItem.Clone: TStaticItem;
begin
Result := TStaticItem.Create(nil, nil);
Result.FTileID := FTileID;
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FHue := FHue;
end;
function TStaticItem.GetSize: Integer;
begin
Result := 7;
end;
procedure TStaticItem.InitOriginalState;
begin
FOrgHue := FHue;
inherited InitOriginalState;
end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer);
begin
FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus);
if ATileData.Height > 0 then
Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver;
end;
procedure TStaticItem.Write(AData: TStream);
var
iX, iY: Byte;
begin
iX := FX mod 8;
iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt));
end;
{ TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word);
var
i: Integer;
block: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free;
end;
end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TStaticBlock.Destroy;
var
i: Integer;
begin
FreeAndNil(FItems);
inherited;
end;
function TStaticBlock.Clone: TStaticBlock;
var
i: Integer;
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(FItems.Items[i].Clone);
end;
function TStaticBlock.GetSize: Integer;
begin
Result := FItems.Count * 7;
end;
procedure TStaticBlock.ReverseWrite(AData: TStream);
var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
FItems[i].Write(AData);
end;
procedure TStaticBlock.Sort;
begin
FItems.Sort(@CompareStaticItems);
end;
procedure TStaticBlock.Write(AData: TStream);
var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
FItems[i].Write(AData);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UStatics;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
type
{ TStaticItem }
TStaticItem = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
protected
{ Members }
FHue: Word;
FOrgHue: Word;
{ Methods }
function HasChanged: Boolean; override;
procedure SetHue(AHue: Word);
public
{ Fields }
property Hue: Word read FHue write SetHue;
{ Methods }
function Clone: TStaticItem; override;
function GetSize: Integer; override;
procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override;
end;
TStaticItemList = specialize TFPGObjectList<TStaticItem>;
{ TStaticBlock}
TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
protected
{ Members }
FItems: TStaticItemList;
public
{ Fields }
property Items: TStaticItemList read FItems write FItems;
{ Methods }
function Clone: TStaticBlock; override;
function GetSize: Integer; override;
procedure ReverseWrite(AData: TStream);
procedure Sort;
procedure Write(AData: TStream); override;
end;
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
begin
Result := CompareWorldItems(AStatic1, AStatic2);
end;
{ TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
ABlockY: Word);
var
iX, iY: Byte;
begin
inherited Create(AOwner);
if AData <> nil then
begin
AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
InitOriginalState;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TStaticItem.HasChanged: Boolean;
begin
Result := (FHue <> FOrgHue) or inherited HasChanged;
end;
procedure TStaticItem.SetHue(AHue: Word);
begin
FHue := AHue;
DoChanged;
end;
function TStaticItem.Clone: TStaticItem;
begin
Result := TStaticItem.Create(nil, nil);
Result.FTileID := FTileID;
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FHue := FHue;
end;
function TStaticItem.GetSize: Integer;
begin
Result := 7;
end;
procedure TStaticItem.InitOriginalState;
begin
FOrgHue := FHue;
inherited InitOriginalState;
end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer);
begin
FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus);
if ATileData.Height > 0 then
Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver;
end;
procedure TStaticItem.Write(AData: TStream);
var
iX, iY: Byte;
begin
iX := FX mod 8;
iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt));
end;
{ TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word);
var
i: Integer;
block: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free;
end;
end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TStaticBlock.Destroy;
begin
FreeAndNil(FItems);
inherited;
end;
function TStaticBlock.Clone: TStaticBlock;
var
i: Integer;
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(FItems.Items[i].Clone);
end;
function TStaticBlock.GetSize: Integer;
begin
Result := FItems.Count * 7;
end;
procedure TStaticBlock.ReverseWrite(AData: TStream);
var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
FItems[i].Write(AData);
end;
procedure TStaticBlock.Sort;
begin
FItems.Sort(@CompareStaticItems);
end;
procedure TStaticBlock.Write(AData: TStream);
var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
FItems[i].Write(AData);
end;
end.