diff --git a/Client/Tools/UfrmFilter.lfm b/Client/Tools/UfrmFilter.lfm index 183af28..8441d20 100644 --- a/Client/Tools/UfrmFilter.lfm +++ b/Client/Tools/UfrmFilter.lfm @@ -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 diff --git a/Client/Tools/UfrmFilter.pas b/Client/Tools/UfrmFilter.pas index 06b249d..65aa14a 100644 --- a/Client/Tools/UfrmFilter.pas +++ b/Client/Tools/UfrmFilter.pas @@ -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. + diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas index 89e3d92..05752bd 100644 --- a/Client/ULandscape.pas +++ b/Client/ULandscape.pas @@ -1,1708 +1,1705 @@ -(* - * 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 ULandscape; - -{$mode objfpc}{$H+} - -interface - -uses - SysUtils, Classes, math, LCLIntf, GL, GLu, ImagingOpenGL, Imaging, - ImagingClasses, ImagingTypes, ImagingUtility, - UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem, - UMulBlock, UAnimData, - UVector, UEnhancedMemoryStream, UGLFont, - UCacheManager; - -type - PNormals = ^TNormals; - TNormals = array[0..3] of TVector; - PRadarBlock = ^TRadarBlock; - TRadarBlock = array[0..7, 0..7] of Word; - - { TMaterial } - - TMaterial = class(ICacheable) - constructor Create; - destructor Destroy; override; - protected - FRefCount: Integer; - FWidth: Integer; - FHeight: Integer; - FRealWidth: Integer; - FRealHeight: Integer; - FGraphic: TMultiImage; - procedure CalculateTextureDimensions(ACaps: TGLTextureCaps; ARealWidth, - ARealHeight: Integer; out AWidth, AHeight: Integer); - function GenerateTexture(AImage: TBaseImage): TGLuint; - function GetTexture: GLuint; virtual; abstract; - public - property Width: Integer read FWidth; - property Height: Integer read FHeight; - property RealWidth: Integer read FRealWidth; - property RealHeight: Integer read FRealHeight; - property Texture: GLuint read GetTexture; - - procedure AddRef; - procedure DelRef; - function HitTest(AX, AY: Integer): Boolean; - - {ICacheable} - function CanBeRemoved: Boolean; - procedure RemoveFromCache; - end; - - { TSimpleMaterial } - - TSimpleMaterial = class(TMaterial) - constructor Create(AGraphic: TBaseImage); - destructor Destroy; override; - protected - FTexture: TGLuint; - function GetTexture: GLuint; override; - end; - - { TAnimMaterial } - - TAnimMaterial = class(TMaterial) - constructor Create(ABaseID: Word; AAnimData: TAnimData; AHue: THue = nil; - APartialHue: Boolean = False); - destructor Destroy; override; - protected - FActiveFrame: Byte; - FNextChange: DWord; - FAnimData: TAnimData; - FTextures: array of TGLuint; - function GetTexture: GLuint; override; - end; - - TMaterialCache = specialize TCacheManager; - - { TLandTextureManager } - - TLandTextureManager = class - constructor Create; - destructor Destroy; override; - protected - FArtCache: TMaterialCache; - FTexCache: TMaterialCache; - FAnimCache: TMaterialCache; - FUseAnims: Boolean; - public - property UseAnims: Boolean read FUseAnims write FUseAnims; - function GetArtMaterial(ATileID: Word): TMaterial; overload; - function GetArtMaterial(ATileID: Word; AHue: THue; - APartialHue: Boolean): TMaterial; overload; - function GetStaticMaterial(AStaticItem: TStaticItem; - AOverrideHue: Integer = -1): TMaterial; - function GetTexMaterial(ATileID: Word): TMaterial; - end; - - { TSeperatedStaticBlock } - - TSeperatedStaticBlock = class(TStaticBlock) - constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload; - constructor Create(AData: TStream; AIndex: TGenericIndex); overload; - destructor Destroy; override; - public - Cells: array[0..63] of TStaticItemList; - { Methods } - function Clone: TSeperatedStaticBlock; override; - function GetSize: Integer; override; - procedure RebuildList; - end; - - TLandscape = class; - - { TBlock } - - TBlock = class - constructor Create(AMap: TMapBlock; AStatics: TStaticBlock); - destructor Destroy; override; - protected - { Fields } - FMapBlock: TMapBlock; - FStaticBlock: TStaticBlock; - public - { Fields } - property Map: TMapBlock read FMapBlock; - property Static: TStaticBlock read FStaticBlock; - { Methods } - procedure UpdateBlockAcess(ALandscape: TLandscape); - end; - - TLandscapeChangeEvent = procedure of object; - TMapChangedEvent = procedure(AMapCell: TMapCell) of object; - TNewBlockEvent = procedure(ABlock: TBlock) of object; - TStaticChangedEvent = procedure(AStaticItem: TStaticItem) of object; - - TScreenBuffer = class; - TBlockCache = specialize TCacheManager; - - { TLandscape } - - TLandscape = class - constructor Create(AWidth, AHeight: Word); - destructor Destroy; override; - protected - { Members } - FWidth: Word; - FHeight: Word; - FCellWidth: Word; - FCellHeight: Word; - FBlockCache: TBlockCache; - FOnChange: TLandscapeChangeEvent; - FOnMapChanged: TMapChangedEvent; - FOnNewBlock: TNewBlockEvent; - FOnStaticInserted: TStaticChangedEvent; - FOnStaticDeleted: TStaticChangedEvent; - FOnStaticElevated: TStaticChangedEvent; - FOnStaticHued: TStaticChangedEvent; - FOpenRequests: TBits; - FWriteMap: TBits; - { Methods } - function GetMapBlock(AX, AY: Word): TMapBlock; - function GetMapCell(AX, AY: Word): TMapCell; - function GetNormals(AX, AY: Word): TNormals; - function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; - function GetStaticList(AX, AY: Word): TStaticItemList; - { Events } - procedure OnRemoveCachedObject(ABlock: TBlock); - procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); - procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); - procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); - procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream); - procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream); - procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream); - procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); - public - { Fields } - property Width: Word read FWidth; - property Height: Word read FHeight; - property CellWidth: Word read FCellWidth; - property CellHeight: Word read FCellHeight; - property MapCell[X, Y: Word]: TMapCell read GetMapCell; - property StaticList[X, Y: Word]: TStaticItemList read GetStaticList; - property Normals[X, Y: Word]: TNormals read GetNormals; - property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; - property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged; - property OnNewBlock: TNewBlockEvent read FOnNewBlock write FOnNewBlock; - property OnStaticInserted: TStaticChangedEvent read FOnStaticInserted - write FOnStaticInserted; - property OnStaticDeleted: TStaticChangedEvent read FOnStaticDeleted - write FOnStaticDeleted; - property OnStaticElevated: TStaticChangedEvent read FOnStaticElevated - write FOnStaticElevated; - property OnStaticHued: TStaticChangedEvent read FOnStaticHued - write FOnStaticHued; - { Methods } - function CanWrite(AX, AY: Word): Boolean; - procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, - AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; - AAdditionalTiles: TWorldItemList = nil); - function GetEffectiveAltitude(ATile: TMapCell): ShortInt; - function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; - procedure GetNormals(AX, AY: Word; var ANormals: TNormals); - procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word); - procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word); - procedure UpdateBlockAccess; - procedure UpdateWriteMap(AStream: TEnhancedMemoryStream); - end; - - { TGLText } - - TGLText = class - constructor Create(AFont: TGLFont; AText: String); - protected - FFont: TGLFont; - FText: String; - FWidth: Integer; - FHeight: Integer; - public - procedure Render(AScreenRect: TRect); - end; - - TScreenState = (ssNormal, ssFiltered, ssGhost); - - PBlockInfo = ^TBlockInfo; - TBlockInfo = record - ScreenRect: TRect; - DrawQuad: array[0..3,0..1] of TGLint; - RealQuad: array[0..3,0..1] of TGLint; - Item: TWorldItem; - HighRes: TMaterial; - LowRes: TMaterial; - Normals: PNormals; - State: TScreenState; - Highlighted: Boolean; - HueOverride: Boolean; - CheckRealQuad: Boolean; - Translucent: Boolean; - Text: TGLText; - Next: PBlockInfo; - end; - - { TScreenBuffer } - - TScreenBuffer = class - constructor Create; virtual; - destructor Destroy; override; - protected - { Members } - FCount: Cardinal; - FShortCuts: array[-1..10] of PBlockInfo; //-1 = last, 0 = first, 1..10 = other shortcuts - FShortCutsValid: Boolean; - FSerial: Cardinal; - public - { Methods } - function Add(AItem: TWorldItem): PBlockInfo; - procedure Clear; - procedure Delete(AItem: TWorldItem); - function Find(AScreenPosition: TPoint): PBlockInfo; - function GetSerial: Cardinal; - function Insert(AItem: TWorldItem): PBlockInfo; - function Iterate(var ABlockInfo: PBlockInfo): Boolean; - procedure UpdateShortcuts; - function UpdateSortOrder(AItem: TWorldItem): PBlockInfo; - { Events } - procedure OnTileRemoved(ATile: TMulBlock); - end; - - TStaticInfo = packed record - X: Word; - Y: Word; - Z: ShortInt; - TileID: Word; - Hue: Word; - end; - -implementation - -uses - UGameResources, UdmNetwork, UPackets, UPacketHandlers, Logging; - -function GetID(AX, AY: Word): Integer; inline; -begin - Result := (AX shl 16) or AY; -end; - -{ TLandTextureManager } - -constructor TLandTextureManager.Create; -begin - inherited Create; - FArtCache := TMaterialCache.Create(1024); - FTexCache := TMaterialCache.Create(128); - FAnimCache := TMaterialCache.Create(128); - FUseAnims := True; -end; - -destructor TLandTextureManager.Destroy; -begin - FreeAndNil(FArtCache); - FreeAndNil(FTexCache); - FreeAndNil(FAnimCache); - inherited Destroy; -end; - -function TLandTextureManager.GetArtMaterial(ATileID: Word): TMaterial; -var - artEntry: TArt; - animData: TAnimData; -begin - Result := nil; - - if FUseAnims and (ATileID >= $4000) and (tdfAnimation in - ResMan.Tiledata.StaticTiles[ATileID -$4000].Flags) then - begin - animData := ResMan.Animdata.AnimData[ATileID - $4000]; - if (animData.FrameCount > 0) and not FAnimCache.QueryID(ATileID, Result) then - begin - Result := TAnimMaterial.Create(ATileID, animData); - FAnimCache.StoreID(ATileID, Result); - end; - end; - - if (Result = nil) and not FArtCache.QueryID(ATileID, Result) then - begin - artEntry := TArt(ResMan.Art.Block[ATileID]); - - Result := TSimpleMaterial.Create(artEntry.Graphic); - FArtCache.StoreID(ATileID, Result); - - artEntry.Free; - end; - - Result.AddRef; -end; - -function TLandTextureManager.GetArtMaterial(ATileID: Word; AHue: THue; - APartialHue: Boolean): TMaterial; -var - artEntry: TArt; - animData: TAnimData; - id: Integer; -begin - if AHue = nil then - begin - Result := GetArtMaterial(ATileID); - end else - begin - Result := nil; - id := ATileID or ((AHue.ID and $3FFF) shl 16) or (Byte(APartialHue) shl 30); - - if FUseAnims and (ATileID >= $4000) and (tdfAnimation in - ResMan.Tiledata.StaticTiles[ATileID -$4000].Flags) then - begin - animData := ResMan.Animdata.AnimData[ATileID - $4000]; - if (animData.FrameCount > 0) and not FAnimCache.QueryID(id, Result) then - begin - Result := TAnimMaterial.Create(ATileID, animData, AHue, APartialHue); - FAnimCache.StoreID(id, Result); - end; - end; - - if (Result = nil) and not FArtCache.QueryID(id, Result) then - begin - artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue); - - Result := TSimpleMaterial.Create(artEntry.Graphic); - FArtCache.StoreID(id, Result); - - artEntry.Free; - end; - Result.AddRef; - end; -end; - -function TLandTextureManager.GetStaticMaterial(AStaticItem: TStaticItem; - AOverrideHue: Integer = -1): TMaterial; -var - staticTiledata: TStaticTiledata; - hue: THue; -begin - staticTiledata := ResMan.Tiledata.StaticTiles[AStaticItem.TileID]; - if AOverrideHue < 0 then - AOverrideHue := AStaticItem.Hue; - - if AOverrideHue > 0 then - hue := ResMan.Hue.Hues[AOverrideHue - 1] - else - hue := nil; - - Result := GetArtMaterial($4000 + AStaticItem.TileID, hue, - tdfPartialHue in staticTiledata.Flags); -end; - -function TLandTextureManager.GetTexMaterial(ATileID: Word): TMaterial; -var - texEntry: TTexture; - texID: Integer; -begin - if not FTexCache.QueryID(ATileID, Result) then - begin - texID := ResMan.Tiledata.LandTiles[ATileID].TextureID; - if texID > 0 then - begin - texEntry := TTexture(ResMan.Texmaps.Block[texID]); - - Result := TSimpleMaterial.Create(texEntry.Graphic); - FTexCache.StoreID(ATileID, Result); - - texEntry.Free; - end else - Result := nil; - end; - - if Result <> nil then - Result.AddRef; -end; - -{ TSeperatedStaticBlock } - -constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; - AX, AY: Word); -var - i: Integer; - item: TStaticItem; - block: TMemoryStream; -begin - inherited Create; - FItems := TStaticItemList.Create(False); - - FX := AX; - FY := AY; - - for i := 0 to 63 do - Cells[i] := TStaticItemList.Create; - - 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 - begin - item := TStaticItem.Create(Self, block, AX, AY); - Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item); - end; - block.Free; - end; -end; - -constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex); -begin - Create(AData, AIndex, 0, 0); -end; - -destructor TSeperatedStaticBlock.Destroy; -var - i: Integer; -begin - FreeAndNil(FItems); - - for i := 0 to 63 do - begin - if Cells[i] <> nil then - FreeAndNil(Cells[i]); - end; - - inherited Destroy; -end; - -function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock; -begin - raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).'); -end; - -function TSeperatedStaticBlock.GetSize: Integer; -begin - RebuildList; - Result := inherited GetSize; -end; - -procedure TSeperatedStaticBlock.RebuildList; -var - i, j, solver: Integer; -begin - FItems.Clear; - solver := 0; - for i := 0 to 63 do - begin - if Cells[i] <> nil then - begin - for j := 0 to Cells[i].Count - 1 do - begin - FItems.Add(Cells[i].Items[j]); - TStaticItem(Cells[i].Items[j]).UpdatePriorities( - ResMan.Tiledata.StaticTiles[TStaticItem(Cells[i].Items[j]).TileID], - solver); - Inc(solver); - end; - end; - end; - Sort; -end; - -{ TBlock } - -constructor TBlock.Create(AMap: TMapBlock; AStatics: TStaticBlock); -begin - inherited Create; - FMapBlock := AMap; - FStaticBlock := AStatics; -end; - -destructor TBlock.Destroy; -begin - if FMapBlock <> nil then FreeAndNil(FMapBlock); - if FStaticBlock <> nil then FreeAndNil(FStaticBlock); - inherited Destroy; -end; - -procedure TBlock.UpdateBlockAcess(ALandscape: TLandscape); -var - staticItem: TStaticItem; - i: Integer; -begin - for i := Low(FMapBlock.Cells) to High(FMapBlock.Cells) do - begin - FMapBlock.Cells[i].CanBeEdited := ALandscape.CanWrite(FMapBlock.Cells[i].X, - FMapBlock.Cells[i].Y); - end; - - if FStaticBlock is TSeperatedStaticBlock then - TSeperatedStaticBlock(FStaticBlock).RebuildList; //fill items - - for i := 0 to FStaticBlock.Items.Count - 1 do - begin - staticItem := FStaticBlock.Items[i]; - staticItem.CanBeEdited := ALandscape.CanWrite(staticItem.X, - staticItem.Y); - end; -end; - -{ TLandscape } - -constructor TLandscape.Create(AWidth, AHeight: Word); -var - i: Integer; -begin - inherited Create; - FWidth := AWidth; - FHeight := AHeight; - FCellWidth := FWidth * 8; - FCellHeight := FHeight * 8; - FBlockCache := TBlockCache.Create(256); - FBlockCache.OnRemoveObject := @OnRemoveCachedObject; - - FOnChange := nil; - FOnNewBlock := nil; - FOnStaticDeleted := nil; - FOnStaticElevated := nil; - FOnStaticHued := nil; - FOnStaticInserted := nil; - - FOpenRequests := TBits.Create(FWidth * FHeight); - FOpenRequests.Clearall; //set all to 0 - FWriteMap := TBits.Create(FCellWidth * FCellHeight); - for i := 0 to FWriteMap.Size - 1 do - FWriteMap[i] := True; - - RegisterPacketHandler($04, TPacketHandler.Create(0, @OnBlocksPacket)); - RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket)); - RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket)); - RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket)); - RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket)); - RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket)); - RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket)); -end; - -destructor TLandscape.Destroy; -begin - if FBlockCache <> nil then - begin - FBlockCache.OnRemoveObject := nil; - FreeAndNil(FBlockCache); - end; - - FreeAndNil(FOpenRequests); - FreeAndNil(FWriteMap); - - RegisterPacketHandler($04, nil); - RegisterPacketHandler($06, nil); - RegisterPacketHandler($07, nil); - RegisterPacketHandler($08, nil); - RegisterPacketHandler($09, nil); - RegisterPacketHandler($0A, nil); - RegisterPacketHandler($0B, nil); - - inherited Destroy; -end; - -function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock; -var - block: TBlock; -begin - Result := nil; - if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then - begin - if FBlockCache.QueryID(GetID(AX, AY), block) then - Result := block.Map; - end; -end; - -function TLandscape.GetMapCell(AX, AY: Word): TMapCell; -var - block: TMapBlock; -begin - Result := nil; - if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then - begin - block := GetMapBlock(AX div 8, AY div 8); - if block <> nil then - Result := block.Cells[(AY mod 8) * 8 + AX mod 8]; - end; -end; - -function TLandscape.GetNormals(AX, AY: Word): TNormals; -begin - GetNormals(AX, AY, Result); -end; - -function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; -var - block: TBlock; -begin - Result := nil; - if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then - begin - if FBlockCache.QueryID(GetID(AX, AY), block) then - Result := TSeperatedStaticBlock(block.Static); - end; -end; - -function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList; -var - block: TSeperatedStaticBlock; -begin - Result := nil; - if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then - begin - block := GetStaticBlock(AX div 8, AY div 8); - if block <> nil then - Result := block.Cells[(AY mod 8) * 8 + AX mod 8]; - end; -end; - -procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock); -begin - if ABlock <> nil then - dmNetwork.Send(TFreeBlockPacket.Create(ABlock.Map.X, ABlock.Map.Y)); -end; - -procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream); -var - index: TGenericIndex; - map: TMapBlock; - statics: TStaticBlock; - coords: TBlockCoords; - count: Word; - id: Integer; - block: TBlock; -begin - index := TGenericIndex.Create(nil); - while ABuffer.Position < ABuffer.Size do - begin - ABuffer.Read(coords, SizeOf(TBlockCoords)); - id := GetID(coords.X, coords.Y); - - map := TMapBlock.Create(ABuffer, coords.X, coords.Y); - count := ABuffer.ReadWord; - if count > 0 then - index.Lookup := ABuffer.Position - else - index.Lookup := -1; - index.Size := count * 7; - statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y); - - FBlockCache.RemoveID(id); - block := TBlock.Create(map, statics); - block.UpdateBlockAcess(Self); - FBlockCache.StoreID(id, block); - - FOpenRequests[coords.Y * FWidth + coords.X] := False; - - if Assigned(FOnNewBlock) then FOnNewBlock(block); - end; - index.Free; -end; - -procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); -var - x, y: Word; - cell: TMapCell; -begin - x := ABuffer.ReadWord; - y := ABuffer.ReadWord; - cell := GetMapCell(x, y); - if cell <> nil then - begin - cell.Altitude := ABuffer.ReadShortInt; - cell.TileID := ABuffer.ReadWord; - if Assigned(FOnMapChanged) then FOnMapChanged(cell); - end; -end; - -procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); -var - x, y: Word; - block: TSeperatedStaticBlock; - staticItem: TStaticItem; - targetStaticList: TStaticItemList; - i: Integer; -begin - x := ABuffer.ReadWord; - y := ABuffer.ReadWord; - block := GetStaticBlock(x div 8, y div 8); - if block <> nil then - begin - staticItem := TStaticItem.Create(nil, nil, 0, 0); - staticItem.X := x; - staticItem.Y := y; - staticItem.Z := ABuffer.ReadShortInt; - staticItem.TileID := ABuffer.ReadWord; - staticItem.Hue := ABuffer.ReadWord; - targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8]; - targetStaticList.Add(staticItem); - for i := 0 to targetStaticList.Count - 1 do - targetStaticList.Items[i].UpdatePriorities( - ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID], - i); - targetStaticList.Sort(@CompareStaticItems); - staticItem.Owner := block; - staticItem.CanBeEdited := CanWrite(x, y); - - if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem); - end; -end; - -procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream); -var - block: TSeperatedStaticBlock; - i: Integer; - statics: TStaticItemList; - staticInfo: TStaticInfo; - staticItem: TStaticItem; -begin - ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); - block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); - if block <> nil then - begin - statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; - for i := 0 to statics.Count - 1 do - begin - staticItem := statics.Items[i]; - if (staticItem.Z = staticInfo.Z) and - (staticItem.TileID = staticInfo.TileID) and - (staticItem.Hue = staticInfo.Hue) then - begin - if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem); - staticItem.Delete; - statics.Delete(i); - - Break; - end; - end; - end; -end; - -procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream); -var - block: TSeperatedStaticBlock; - i,j : Integer; - statics: TStaticItemList; - staticInfo: TStaticInfo; - staticItem: TStaticItem; -begin - ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); - block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); - if block <> nil then - begin - statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; - for i := 0 to statics.Count - 1 do - begin - staticItem := statics.Items[i]; - if (staticItem.Z = staticInfo.Z) and - (staticItem.TileID = staticInfo.TileID) and - (staticItem.Hue = staticInfo.Hue) then - begin - staticItem.Z := ABuffer.ReadShortInt; - for j := 0 to statics.Count - 1 do - statics.Items[j].UpdatePriorities( - ResMan.Tiledata.StaticTiles[statics.Items[j].TileID], - j); - statics.Sort(@CompareStaticItems); - - if Assigned(FOnStaticElevated) then FOnStaticElevated(staticItem); - - Break; - end; - end; - end; -end; - -procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream); -var - sourceBlock, targetBlock: TSeperatedStaticBlock; - i: Integer; - statics: TStaticItemList; - staticInfo: TStaticInfo; - staticItem: TStaticItem; - newX, newY: Word; -begin - staticItem := nil; - ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); - newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1); - newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1); - - sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); - targetBlock := GetStaticBlock(newX div 8, newY div 8); - if sourceBlock <> nil then - begin - statics := sourceBlock.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; - i := 0; - while (i < statics.Count) and (staticItem = nil) do - begin - staticItem := statics.Items[i]; - if (staticItem.Z <> staticInfo.Z) or - (staticItem.TileID <> staticInfo.TileID) or - (staticItem.Hue <> staticInfo.Hue) then - begin - staticItem := nil; - end; - Inc(i); - end; - - if staticItem <> nil then - begin - if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem); - staticItem.Delete; - statics.Remove(staticItem); - end; - end; - - if targetBlock <> nil then - begin - staticItem := TStaticItem.Create(nil, nil, 0, 0); - staticItem.X := newX; - staticItem.Y := newY; - staticItem.Z := staticInfo.Z; - staticItem.TileID := staticInfo.TileID; - staticItem.Hue := staticInfo.Hue; - statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8]; - statics.Add(staticItem); - for i := 0 to statics.Count - 1 do - TStaticItem(statics.Items[i]).UpdatePriorities( - ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[i]).TileID], - i); - statics.Sort(@CompareStaticItems); - staticItem.Owner := targetBlock; - staticItem.CanBeEdited := CanWrite(newX, newY); - - if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem); - end; -end; - -procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); -var - block: TSeperatedStaticBlock; - i : Integer; - statics: TStaticItemList; - staticInfo: TStaticInfo; - staticItem: TStaticItem; -begin - ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); - block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); - if block <> nil then - begin - statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; - for i := 0 to statics.Count - 1 do - begin - staticItem := statics.Items[i]; - if (staticItem.Z = staticInfo.Z) and - (staticItem.TileID = staticInfo.TileID) and - (staticItem.Hue = staticInfo.Hue) then - begin - staticItem.Hue := ABuffer.ReadWord; - if Assigned(FOnStaticHued) then FOnStaticHued(staticItem); - Break; - end; - end; - end; -end; - -function TLandscape.CanWrite(AX, AY: Word): Boolean; -begin - Result := FWriteMap[AX * FCellHeight + AY]; -end; - -procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, - AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; - AAdditionalTiles: TWorldItemList = nil); -var - drawMapCell: TMapCell; - drawStatics: TStaticItemList; - i, x, y: Integer; - tempDrawList: TWorldItemList; -begin - ADrawList.Clear; - tempDrawList := TWorldItemList.Create(False);; - for x := AX to AX + AWidth do - begin - for y := AY to AY + AWidth do - begin - if AMap then - begin - drawMapCell := GetMapCell(x, y); - if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then - begin - drawMapCell.Priority := GetEffectiveAltitude(drawMapCell); - drawMapCell.PriorityBonus := 0; - drawMapCell.PrioritySolver := 0; - tempDrawList.Add(drawMapCell); - end; - end; - - if AStatics then - begin - drawStatics := GetStaticList(x, y); - if drawStatics <> nil then - for i := 0 to drawStatics.Count - 1 do - begin - drawStatics[i].UpdatePriorities( - ResMan.Tiledata.StaticTiles[drawStatics[i].TileID], - ADrawList.GetSerial); - tempDrawList.Add(drawStatics[i]); - end; - end; - end; - end; - - for i := 0 to AAdditionalTiles.Count - 1 do - tempDrawList.Add(AAdditionalTiles[i]); - - tempDrawList.Sort(@CompareWorldItems); - for i := 0 to tempDrawList.Count - 1 do - ADrawList.Add(TWorldItem(tempDrawList[i])); - tempDrawList.Free; -end; - -function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt; -var - north, west, south, east: ShortInt; -begin - north := ATile.Altitude; - west := GetLandAlt(ATile.X, ATile.Y + 1, north); - south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north); - east := GetLandAlt(ATile.X + 1, ATile.Y, north); - - if Abs(north - south) >= Abs(west - east) then - Result := Min(north, south) + Abs(west - east) div 2 - else - Result := Min(north, south) + Abs(north - south) div 2; -end; - -function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; -var - cell: TMapCell; -begin - cell := MapCell[AX, AY]; - if cell <> nil then - Result := cell.Altitude - else - Result := ADefault; -end; - -procedure TLandscape.GetNormals(AX, AY: Word; var ANormals: TNormals); -var - cells: array[0..2, 0..2] of TNormals; - north, west, south, east: TVector; - i, j: Integer; - - function GetPlainNormals(X, Y: SmallInt): TNormals; - var - cell: TMapCell; - north, west, south, east: ShortInt; - u, v: TVector; - begin - cell := GetMapCell(X, Y); - if cell <> nil then - begin - north := cell.Altitude; - west := GetLandAlt(cell.X, cell.Y + 1, north); - south := GetLandAlt(cell.X + 1, cell.Y + 1, north); - east := GetLandAlt(cell.X + 1, cell.Y, north); - end else - begin - north := 0; - west := 0; - east := 0; - south := 0; - end; - - if (north = west) and (west = east) and (north = south) then - begin - Result[0] := Vector(0, 0, 1); - Result[1] := Vector(0, 0, 1); - Result[2] := Vector(0, 0, 1); - Result[3] := Vector(0, 0, 1); - end else - begin - u := Vector(-22, 22, (north - east) * 4); - v := Vector(-22, -22, (west - north) * 4); - Result[0] := VectorNorm(VectorCross(u, v)); - - u := Vector(22, 22, (east - south) * 4); - v := Vector(-22, 22, (north - east) * 4); - Result[1] := VectorNorm(VectorCross(u, v)); - - u := Vector(22, -22, (south - west) * 4); - v := Vector(22, 22, (east - south) * 4); - Result[2] := VectorNorm(VectorCross(u, v)); - - u := Vector(-22, -22, (west - north) * 4); - v := Vector(22, -22, (south - west) * 4); - Result[3] := VectorNorm(VectorCross(u, v)); - end; - end; -begin - for i := 0 to 2 do - for j := 0 to 2 do - cells[i, j] := GetPlainNormals(AX - 1 + i, AY - 1 + j); - - north := cells[0, 0][2]; - west := cells[0, 1][1]; - east := cells[1, 0][3]; - south := cells[1, 1][0]; - ANormals[0] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); - - north := cells[1, 0][2]; - west := cells[1, 1][1]; - east := cells[2, 0][3]; - south := cells[2, 1][0]; - ANormals[1] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); - - north := cells[1, 1][2]; - west := cells[1, 2][1]; - east := cells[2, 1][3]; - south := cells[2, 2][0]; - ANormals[2] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); - - north := cells[0, 1][2]; - west := cells[0, 2][1]; - east := cells[1, 1][3]; - south := cells[1, 2][0]; - ANormals[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); -end; - -procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word); -var - sourceBlock, targetBlock: TSeperatedStaticBlock; - targetStaticList: TStaticItemList; - i: Integer; -begin - if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then - begin - sourceBlock := AStatic.Owner as TSeperatedStaticBlock; - targetBlock := GetStaticBlock(AX div 8, AY div 8); - if (sourceBlock <> nil) and (targetBlock <> nil) then - begin - sourceBlock.Cells[(AStatic.Y mod 8) * 8 + AStatic.X mod 8].Remove(AStatic); - targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8]; - targetStaticList.Add(AStatic); - for i := 0 to targetStaticList.Count - 1 do - targetStaticList.Items[i].UpdatePriorities( - ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID], - i); - targetStaticList.Sort(@CompareStaticItems); - AStatic.UpdatePos(AX, AY, AStatic.Z); - AStatic.Owner := targetBlock; - end; - end; -end; - -procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word); -var - x, y, i: Integer; - coords: TBlockCoordsArray; - block: TBlock; -begin - AX1 := EnsureRange(AX1, 0, FWidth - 1); - AY1 := EnsureRange(AY1, 0, FHeight - 1); - AX2 := EnsureRange(AX2, 0, FWidth - 1); - AY2 := EnsureRange(AY2, 0, FHeight - 1); - - SetLength(coords, 0); - for x := AX1 to AX2 do - begin - for y := AY1 to AY2 do - begin - if (not FOpenRequests[y * FWidth + x]) and - (not FBlockCache.QueryID(GetID(x, y), block)) then - begin - SetLength(coords, Length(coords) + 1); - i := High(coords); - coords[i].X := x; - coords[i].Y := y; - FOpenRequests[y * FWidth + x] := True; - end; - end; - end; - if Length(coords) > 0 then - dmNetwork.Send(TRequestBlocksPacket.Create(coords)); -end; - -procedure TLandscape.UpdateBlockAccess; -var - cacheEntry: TBlockCache.PCacheEntry; -begin - cacheEntry := nil; - while FBlockCache.Iterate(cacheEntry) do - if cacheEntry^.Obj <> nil then - cacheEntry^.Obj.UpdateBlockAcess(Self); -end; - -procedure TLandscape.UpdateWriteMap(AStream: TEnhancedMemoryStream); -var - x1, y1, x2, y2: Word; - i, areaCount, cellX, cellY: Integer; -begin - Logger.EnterMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap'); - - areaCount := AStream.ReadWord; - Logger.Send([lcLandscape, lcDebug], 'AreaCount', areaCount); - - if areaCount > 0 then - begin - FWriteMap.Clearall; - for i := 0 to areaCount - 1 do - begin - x1 := AStream.ReadWord; - y1 := AStream.ReadWord; - x2 := AStream.ReadWord; - y2 := AStream.ReadWord; - for cellX := x1 to x2 do - for cellY := y1 to y2 do - FWriteMap[cellX * FCellHeight + cellY] := True; - end; - end else - for i := 0 to FWriteMap.Size - 1 do - FWriteMap[i] := True; - - Logger.Send([lcLandscape, lcDebug], 'WriteMap @ 0,0', FWriteMap[0]); - - UpdateBlockAccess; - Logger.ExitMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap'); -end; - -{ TMaterial } - -constructor TMaterial.Create; -begin - FRefCount := 1; -end; - -destructor TMaterial.Destroy; -begin - FreeAndNil(FGraphic); - inherited Destroy; -end; - -procedure TMaterial.CalculateTextureDimensions(ACaps: TGLTextureCaps; - ARealWidth, ARealHeight: Integer; out AWidth, AHeight: Integer); -begin - if ACaps.NonPowerOfTwo then - begin - AWidth := ARealWidth; - AHeight := ARealHeight; - end else - begin - if IsPow2(ARealWidth) then - AWidth := ARealWidth - else - AWidth := NextPow2(ARealWidth); - - if IsPow2(ARealHeight) then - AHeight := ARealHeight - else - AHeight := NextPow2(ARealHeight); - end; -end; - -function TMaterial.GenerateTexture(AImage: TBaseImage): TGLuint; -begin - Result := CreateGLTextureFromImage(AImage.ImageDataPointer^); - glBindTexture(GL_TEXTURE_2D, Result); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); -end; - -procedure TMaterial.AddRef; -begin - Inc(FRefCount); -end; - -procedure TMaterial.DelRef; -begin - Dec(FRefCount); - if FRefCount < 1 then - Free; -end; - -function TMaterial.HitTest(AX, AY: Integer): Boolean; -var - pixel: TColor32Rec; -begin - Result := False; - if InRange(AX, 0, FGraphic.Width - 1) and - InRange(AY, 0, FGraphic.Height - 1) then - begin - pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY); - if pixel.A > 0 then - Result := True; - end; -end; - -function TMaterial.CanBeRemoved: Boolean; -begin - Result := FRefCount <= 1; -end; - -procedure TMaterial.RemoveFromCache; -begin - DelRef; -end; - -{ TScreenBuffer } - -constructor TScreenBuffer.Create; -begin - inherited Create; - FCount := 0; - FSerial := 0; - UpdateShortcuts; -end; - -destructor TScreenBuffer.Destroy; -begin - Clear; - inherited Destroy; -end; - -function TScreenBuffer.Add(AItem: TWorldItem): PBlockInfo; -begin - New(Result); - AItem.Locked := True; - AItem.OnDestroy.RegisterEvent(@OnTileRemoved); - Result^.Item := AItem; - Result^.HighRes := nil; - Result^.LowRes := nil; - Result^.Normals := nil; - Result^.State := ssNormal; - Result^.Highlighted := False; - Result^.Translucent := False; - Result^.Text := nil; - Result^.Next := nil; - - if FShortCuts[0] = nil then //First element - begin - FShortCuts[0] := Result; - FShortCuts[-1] := Result; //Last element - end else - begin - FShortCuts[-1]^.Next := Result; - FShortCuts[-1] := Result; - end; - - Inc(FCount); -end; - -procedure TScreenBuffer.Clear; -var - current, next: PBlockInfo; -begin - current := FShortCuts[0]; - while current <> nil do - begin - next := current^.Next; - current^.Item.Locked := False; - current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved); - if current^.Normals <> nil then Dispose(current^.Normals); - if current^.HighRes <> nil then current^.HighRes.DelRef; - if current^.LowRes <> nil then current^.LowRes.DelRef; - current^.Text.Free; - Dispose(current); - current := next; - end; - FShortCuts[0] := nil; - FShortCuts[-1] := nil; - - FCount := 0; - FSerial := 0; - - UpdateShortcuts; -end; - -procedure TScreenBuffer.Delete(AItem: TWorldItem); -var - current, last, next: PBlockInfo; -begin - last := nil; - current := FShortCuts[0]; - while current <> nil do - begin - if current^.Item = AItem then - begin - if FShortCuts[-1] = current then FShortCuts[-1] := last; - if FShortCuts[0] = current then FShortCuts[0] := current^.Next; - if last <> nil then last^.Next := current^.Next; - - if current^.Normals <> nil then Dispose(current^.Normals); - if current^.HighRes <> nil then current^.HighRes.DelRef; - if current^.LowRes <> nil then current^.LowRes.DelRef; - current^.Text.Free; - - Dispose(current); - Dec(FCount); - FShortCutsValid := False; - next := nil; - end else - next := current^.Next; - - last := current; - current := next; - end; -end; - -function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo; -var - current: PBlockInfo; - buff: array[0..3] of GLuint; - hits: GLint; -begin - Result := nil; - current := FShortCuts[0]; - while current <> nil do //search the last matching tile - begin - if (current^.State = ssNormal) and - PtInRect(current^.ScreenRect, AScreenPosition)then - begin - if current^.CheckRealQuad then - begin - //OpenGL hit test - //We use the "real quad" here to prevent the draw-preview from - //intercepting with our actual tiles (which are "hidden" then). - glSelectBuffer(4, @buff[0]); - glViewport(current^.ScreenRect.Left, current^.ScreenRect.Top, - current^.ScreenRect.Right, current^.ScreenRect.Bottom); - glRenderMode(GL_SELECT); - glInitNames; - glPushName(0); - - glPushMatrix; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - gluOrtho2D(AScreenPosition.x, AScreenPosition.x + 1, - AScreenPosition.y + 1, AScreenPosition.y); - glMatrixMode(GL_MODELVIEW); - glLoadIdentity; - - glBegin(GL_QUADS); - glVertex2iv(@current^.RealQuad[0]); - glVertex2iv(@current^.RealQuad[3]); - glVertex2iv(@current^.RealQuad[2]); - glVertex2iv(@current^.RealQuad[1]); - glEnd; - glPopMatrix; - glFlush; - - if glRenderMode(GL_RENDER) > 0 then //glRenderMode now returns the number of hits - Result := current; - end else - if current^.LowRes.HitTest(AScreenPosition.x - current^.ScreenRect.Left, - AScreenPosition.y - current^.ScreenRect.Top) then - Result := current; - end; - current := current^.Next; - end; -end; - -function TScreenBuffer.GetSerial: Cardinal; -begin - Result := FSerial; - Inc(FSerial); -end; - -function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo; -var - current: PBlockInfo; - shortcut: Integer; -begin - if not FShortCutsValid then - UpdateShortcuts; - - New(Result); - AItem.Locked := True; - AItem.OnDestroy.RegisterEvent(@OnTileRemoved); - Result^.Item := AItem; - Result^.HighRes := nil; - Result^.LowRes := nil; - Result^.Normals := nil; - Result^.State := ssNormal; - Result^.Highlighted := False; - Result^.Translucent := False; - Result^.Text := nil; - - if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then - begin - if FShortCuts[0] = nil then - FShortCuts[-1] := Result; //Update last item - - Result^.Next := FShortCuts[0]; - FShortCuts[0] := Result; - end else - begin - //find best entry point - shortcut := 0; - while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and - (CompareWorldItems(AItem, FShortCuts[shortcut]^.Item) >= 0) do - begin - current := FShortCuts[shortcut]; - Inc(shortcut); - end; - - //now find the real match - while (current^.Next <> nil) and - (CompareWorldItems(AItem, current^.Next^.Item) > 0) do - begin - current := current^.Next; - end; - - if FShortCuts[-1] = current^.Next then - FShortCuts[-1] := Result; //Update last item - - Result^.Next := current^.Next; - current^.Next := Result; - end; - - Inc(FCount); -end; - -function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean; -begin - if ABlockInfo = nil then - ABlockInfo := FShortCuts[0] - else - ABlockInfo := ABlockInfo^.Next; - Result := ABlockInfo <> nil; -end; - -procedure TScreenBuffer.UpdateShortcuts; -var - shortcut, step, nextStep, stepSize: Integer; - blockInfo: PBlockInfo; -begin - if FCount < 10 then - begin - for shortcut := 1 to 10 do - FShortCuts[shortcut] := nil; - end - else if FShortCuts[0] <> nil then - begin - stepSize := FCount div 10; - nextStep := stepSize; - step := 0; - shortcut := 1; - blockInfo := FShortCuts[0]; - repeat - if step = nextStep then - begin - FShortCuts[shortcut] := blockInfo; - Inc(shortcut); - Inc(nextStep, stepSize); - end; - - Inc(step); - - FShortCuts[-1] := blockInfo; //update last known item - blockInfo := blockInfo^.Next; - until (blockInfo = nil); - end; - FShortCutsValid := True; -end; - -function TScreenBuffer.UpdateSortOrder(AItem: TWorldItem): PBlockInfo; -var - newNodePosition, oldNode, oldNodePrev, current: PBlockInfo; -begin - newNodePosition := nil; - oldNode := nil; - oldNodePrev := nil; - current := FShortCuts[0]; - - while (current <> nil) and ((oldNode = nil) or (newNodePosition = nil)) do - begin - if current^.Item = AItem then - oldNode := current - else if oldNode = nil then - oldNodePrev := current; - - if newNodePosition = nil then - begin - if (current^.Next = nil) or (CompareWorldItems(AItem, current^.Next^.Item) < 0) then - newNodePosition := current; - end; - - current := current^.Next; - end; - - //oldNode = nil, if the change happend out-of-screen - if (oldNode <> nil ) and (oldNode <> newNodePosition) then - begin - if oldNodePrev <> oldNode then - begin - if oldNodePrev = nil then - FShortCuts[0] := oldNode^.Next - else - oldNodePrev^.Next := oldNode^.Next; - end; - - if (newNodePosition = FShortCuts[0]) and (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then - begin - oldNode^.Next := FShortCuts[0]; - FShortCuts[0] := oldNode; - end else - begin - oldNode^.Next := newNodePosition^.Next; - newNodePosition^.Next := oldNode; - end; - end; - - Result := oldNode; -end; - -procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock); -begin - Delete(TWorldItem(ATile)); -end; - -{ TGLText } - -constructor TGLText.Create(AFont: TGLFont; AText: String); -var - i: Integer; -begin - FFont := AFont; - FText := AText; - FWidth := FFont.GetTextWidth(AText); - FHeight := FFont.GetTextHeight('A'); -end; - -procedure TGLText.Render(AScreenRect: TRect); -var - x, y: Integer; - i: Integer; -begin - y := AScreenRect.Top + (AScreenRect.Bottom - AScreenRect.Top - FHeight) div 2; - x := AScreenRect.Left + (AScreenRect.Right - AScreenRect.Left - FWidth) div 2; - FFont.DrawText(x, y, FText); -end; - -{ TSimpleMaterial } - -constructor TSimpleMaterial.Create(AGraphic: TBaseImage); -var - caps: TGLTextureCaps; -begin - inherited Create; - FRealWidth := AGraphic.Width; - FRealHeight := AGraphic.Height; - - GetGLTextureCaps(caps); - CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight); - FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8, 1); - AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0); - FTexture := GenerateTexture(FGraphic); -end; - -destructor TSimpleMaterial.Destroy; -begin - if FTexture <> 0 then glDeleteTextures(1, @FTexture); - inherited Destroy; -end; - -function TSimpleMaterial.GetTexture: GLuint; -begin - Result := FTexture; -end; - -{ TAnimMaterial } - -constructor TAnimMaterial.Create(ABaseID: Word; AAnimData: TAnimData; - AHue: THue = nil; APartialHue: Boolean = False); -var - i: Integer; - art: array of TArt; - caps: TGLTextureCaps; -begin - inherited Create; - - FAnimData := AAnimData; - - FRealWidth := 0; - FRealHeight := 0; - - SetLength(FTextures, AAnimData.FrameCount); - SetLength(art, AAnimData.FrameCount); - - for i := 0 to AAnimData.FrameCount - 1 do - begin - art[i] := ResMan.Art.GetArt(ABaseID + AAnimData.FrameData[i], 0, AHue, - APartialHue); - - if art[i].Graphic.Width > FRealWidth then - FRealWidth := art[i].Graphic.Width; - if art[i].Graphic.Height > FRealHeight then - FRealHeight := art[i].Graphic.Height; - end; - - GetGLTextureCaps(caps); - CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight); - FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8, - AAnimData.FrameCount); - - for i := 0 to AAnimData.FrameCount - 1 do - begin - FGraphic.ActiveImage := i; - art[i].Graphic.CopyTo(0, 0, art[i].Graphic.Width, art[i].Graphic.Height, - FGraphic, 0, 0); - FTextures[i] := GenerateTexture(FGraphic); - art[i].Free; - end; - - FGraphic.ActiveImage := 0; - FActiveFrame := 0; - FNextChange := GetTickCount + AAnimData.FrameStart * 100; -end; - -destructor TAnimMaterial.Destroy; -begin - glDeleteTextures(Length(FTextures), @FTextures[0]); - inherited Destroy; -end; - -function TAnimMaterial.GetTexture: GLuint; -begin - if FNextChange <= GetTickCount then - begin - FActiveFrame := (FActiveFrame + 1) mod FAnimData.FrameCount; - FGraphic.ActiveImage := FActiveFrame; - - if FActiveFrame = 0 then - FNextChange := GetTickCount + FAnimData.FrameStart * 100 - else - FNextChange:= GetTickCount + FAnimData.FrameInterval * 100; - end; - - Result := FTextures[FActiveFrame]; -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 ULandscape; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, math, LCLIntf, GL, GLu, ImagingOpenGL, Imaging, + ImagingClasses, ImagingTypes, ImagingUtility, + UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem, + UMulBlock, UAnimData, + UVector, UEnhancedMemoryStream, UGLFont, + UCacheManager; + +type + PNormals = ^TNormals; + TNormals = array[0..3] of TVector; + PRadarBlock = ^TRadarBlock; + TRadarBlock = array[0..7, 0..7] of Word; + + { TMaterial } + + TMaterial = class(ICacheable) + constructor Create; + destructor Destroy; override; + protected + FRefCount: Integer; + FWidth: Integer; + FHeight: Integer; + FRealWidth: Integer; + FRealHeight: Integer; + FGraphic: TMultiImage; + procedure CalculateTextureDimensions(ACaps: TGLTextureCaps; ARealWidth, + ARealHeight: Integer; out AWidth, AHeight: Integer); + function GenerateTexture(AImage: TBaseImage): TGLuint; + function GetTexture: GLuint; virtual; abstract; + public + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property RealWidth: Integer read FRealWidth; + property RealHeight: Integer read FRealHeight; + property Texture: GLuint read GetTexture; + + procedure AddRef; + procedure DelRef; + function HitTest(AX, AY: Integer): Boolean; + + {ICacheable} + function CanBeRemoved: Boolean; + procedure RemoveFromCache; + end; + + { TSimpleMaterial } + + TSimpleMaterial = class(TMaterial) + constructor Create(AGraphic: TBaseImage); + destructor Destroy; override; + protected + FTexture: TGLuint; + function GetTexture: GLuint; override; + end; + + { TAnimMaterial } + + TAnimMaterial = class(TMaterial) + constructor Create(ABaseID: Word; AAnimData: TAnimData; AHue: THue = nil; + APartialHue: Boolean = False); + destructor Destroy; override; + protected + FActiveFrame: Byte; + FNextChange: DWord; + FAnimData: TAnimData; + FTextures: array of TGLuint; + function GetTexture: GLuint; override; + end; + + TMaterialCache = specialize TCacheManager; + + { TLandTextureManager } + + TLandTextureManager = class + constructor Create; + destructor Destroy; override; + protected + FArtCache: TMaterialCache; + FTexCache: TMaterialCache; + FAnimCache: TMaterialCache; + FUseAnims: Boolean; + public + property UseAnims: Boolean read FUseAnims write FUseAnims; + function GetArtMaterial(ATileID: Word): TMaterial; overload; + function GetArtMaterial(ATileID: Word; AHue: THue; + APartialHue: Boolean): TMaterial; overload; + function GetStaticMaterial(AStaticItem: TStaticItem; + AOverrideHue: Integer = -1): TMaterial; + function GetTexMaterial(ATileID: Word): TMaterial; + end; + + { TSeperatedStaticBlock } + + TSeperatedStaticBlock = class(TStaticBlock) + constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload; + constructor Create(AData: TStream; AIndex: TGenericIndex); overload; + destructor Destroy; override; + public + Cells: array[0..63] of TStaticItemList; + { Methods } + function Clone: TSeperatedStaticBlock; override; + function GetSize: Integer; override; + procedure RebuildList; + end; + + TLandscape = class; + + { TBlock } + + TBlock = class + constructor Create(AMap: TMapBlock; AStatics: TStaticBlock); + destructor Destroy; override; + protected + { Fields } + FMapBlock: TMapBlock; + FStaticBlock: TStaticBlock; + public + { Fields } + property Map: TMapBlock read FMapBlock; + property Static: TStaticBlock read FStaticBlock; + { Methods } + procedure UpdateBlockAcess(ALandscape: TLandscape); + end; + + TLandscapeChangeEvent = procedure of object; + TMapChangedEvent = procedure(AMapCell: TMapCell) of object; + TNewBlockEvent = procedure(ABlock: TBlock) of object; + TStaticChangedEvent = procedure(AStaticItem: TStaticItem) of object; + + TScreenBuffer = class; + TBlockCache = specialize TCacheManager; + + { TLandscape } + + TLandscape = class + constructor Create(AWidth, AHeight: Word); + destructor Destroy; override; + protected + { Members } + FWidth: Word; + FHeight: Word; + FCellWidth: Word; + FCellHeight: Word; + FBlockCache: TBlockCache; + FOnChange: TLandscapeChangeEvent; + FOnMapChanged: TMapChangedEvent; + FOnNewBlock: TNewBlockEvent; + FOnStaticInserted: TStaticChangedEvent; + FOnStaticDeleted: TStaticChangedEvent; + FOnStaticElevated: TStaticChangedEvent; + FOnStaticHued: TStaticChangedEvent; + FOpenRequests: TBits; + FWriteMap: TBits; + { Methods } + function GetMapBlock(AX, AY: Word): TMapBlock; + function GetMapCell(AX, AY: Word): TMapCell; + function GetNormals(AX, AY: Word): TNormals; + function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; + function GetStaticList(AX, AY: Word): TStaticItemList; + { Events } + procedure OnRemoveCachedObject(ABlock: TBlock); + procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); + procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); + procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); + procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream); + procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream); + procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream); + procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); + public + { Fields } + property Width: Word read FWidth; + property Height: Word read FHeight; + property CellWidth: Word read FCellWidth; + property CellHeight: Word read FCellHeight; + property MapCell[X, Y: Word]: TMapCell read GetMapCell; + property StaticList[X, Y: Word]: TStaticItemList read GetStaticList; + property Normals[X, Y: Word]: TNormals read GetNormals; + property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; + property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged; + property OnNewBlock: TNewBlockEvent read FOnNewBlock write FOnNewBlock; + property OnStaticInserted: TStaticChangedEvent read FOnStaticInserted + write FOnStaticInserted; + property OnStaticDeleted: TStaticChangedEvent read FOnStaticDeleted + write FOnStaticDeleted; + property OnStaticElevated: TStaticChangedEvent read FOnStaticElevated + write FOnStaticElevated; + property OnStaticHued: TStaticChangedEvent read FOnStaticHued + write FOnStaticHued; + { Methods } + function CanWrite(AX, AY: Word): Boolean; + procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, + AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; + AAdditionalTiles: TWorldItemList = nil); + function GetEffectiveAltitude(ATile: TMapCell): ShortInt; + function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; + procedure GetNormals(AX, AY: Word; var ANormals: TNormals); + procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word); + procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word); + procedure UpdateBlockAccess; + procedure UpdateWriteMap(AStream: TEnhancedMemoryStream); + end; + + { TGLText } + + TGLText = class + constructor Create(AFont: TGLFont; AText: String); + protected + FFont: TGLFont; + FText: String; + FWidth: Integer; + FHeight: Integer; + public + procedure Render(AScreenRect: TRect); + end; + + TScreenState = (ssNormal, ssFiltered, ssGhost); + + PBlockInfo = ^TBlockInfo; + TBlockInfo = record + ScreenRect: TRect; + DrawQuad: array[0..3,0..1] of TGLint; + RealQuad: array[0..3,0..1] of TGLint; + Item: TWorldItem; + HighRes: TMaterial; + LowRes: TMaterial; + Normals: PNormals; + State: TScreenState; + Highlighted: Boolean; + HueOverride: Boolean; + CheckRealQuad: Boolean; + Translucent: Boolean; + Text: TGLText; + Next: PBlockInfo; + end; + + { TScreenBuffer } + + TScreenBuffer = class + constructor Create; virtual; + destructor Destroy; override; + protected + { Members } + FCount: Cardinal; + FShortCuts: array[-1..10] of PBlockInfo; //-1 = last, 0 = first, 1..10 = other shortcuts + FShortCutsValid: Boolean; + FSerial: Cardinal; + public + { Methods } + function Add(AItem: TWorldItem): PBlockInfo; + procedure Clear; + procedure Delete(AItem: TWorldItem); + function Find(AScreenPosition: TPoint): PBlockInfo; + function GetSerial: Cardinal; + function Insert(AItem: TWorldItem): PBlockInfo; + function Iterate(var ABlockInfo: PBlockInfo): Boolean; + procedure UpdateShortcuts; + function UpdateSortOrder(AItem: TWorldItem): PBlockInfo; + { Events } + procedure OnTileRemoved(ATile: TMulBlock); + end; + + TStaticInfo = packed record + X: Word; + Y: Word; + Z: ShortInt; + TileID: Word; + Hue: Word; + end; + +implementation + +uses + UGameResources, UdmNetwork, UPackets, UPacketHandlers, Logging; + +function GetID(AX, AY: Word): Integer; inline; +begin + Result := (AX shl 16) or AY; +end; + +{ TLandTextureManager } + +constructor TLandTextureManager.Create; +begin + inherited Create; + FArtCache := TMaterialCache.Create(1024); + FTexCache := TMaterialCache.Create(128); + FAnimCache := TMaterialCache.Create(128); + FUseAnims := True; +end; + +destructor TLandTextureManager.Destroy; +begin + FreeAndNil(FArtCache); + FreeAndNil(FTexCache); + FreeAndNil(FAnimCache); + inherited Destroy; +end; + +function TLandTextureManager.GetArtMaterial(ATileID: Word): TMaterial; +var + artEntry: TArt; + animData: TAnimData; +begin + Result := nil; + + if FUseAnims and (ATileID >= $4000) and (tdfAnimation in + ResMan.Tiledata.StaticTiles[ATileID -$4000].Flags) then + begin + animData := ResMan.Animdata.AnimData[ATileID - $4000]; + if (animData.FrameCount > 0) and not FAnimCache.QueryID(ATileID, Result) then + begin + Result := TAnimMaterial.Create(ATileID, animData); + FAnimCache.StoreID(ATileID, Result); + end; + end; + + if (Result = nil) and not FArtCache.QueryID(ATileID, Result) then + begin + artEntry := TArt(ResMan.Art.Block[ATileID]); + + Result := TSimpleMaterial.Create(artEntry.Graphic); + FArtCache.StoreID(ATileID, Result); + + artEntry.Free; + end; + + Result.AddRef; +end; + +function TLandTextureManager.GetArtMaterial(ATileID: Word; AHue: THue; + APartialHue: Boolean): TMaterial; +var + artEntry: TArt; + animData: TAnimData; + id: Integer; +begin + if AHue = nil then + begin + Result := GetArtMaterial(ATileID); + end else + begin + Result := nil; + id := ATileID or ((AHue.ID and $3FFF) shl 16) or (Byte(APartialHue) shl 30); + + if FUseAnims and (ATileID >= $4000) and (tdfAnimation in + ResMan.Tiledata.StaticTiles[ATileID -$4000].Flags) then + begin + animData := ResMan.Animdata.AnimData[ATileID - $4000]; + if (animData.FrameCount > 0) and not FAnimCache.QueryID(id, Result) then + begin + Result := TAnimMaterial.Create(ATileID, animData, AHue, APartialHue); + FAnimCache.StoreID(id, Result); + end; + end; + + if (Result = nil) and not FArtCache.QueryID(id, Result) then + begin + artEntry := ResMan.Art.GetArt(ATileID, 0, AHue, APartialHue); + + Result := TSimpleMaterial.Create(artEntry.Graphic); + FArtCache.StoreID(id, Result); + + artEntry.Free; + end; + Result.AddRef; + end; +end; + +function TLandTextureManager.GetStaticMaterial(AStaticItem: TStaticItem; + AOverrideHue: Integer = -1): TMaterial; +var + staticTiledata: TStaticTiledata; + hue: THue; +begin + staticTiledata := ResMan.Tiledata.StaticTiles[AStaticItem.TileID]; + if AOverrideHue < 0 then + AOverrideHue := AStaticItem.Hue; + + if AOverrideHue > 0 then + hue := ResMan.Hue.Hues[AOverrideHue - 1] + else + hue := nil; + + Result := GetArtMaterial($4000 + AStaticItem.TileID, hue, + tdfPartialHue in staticTiledata.Flags); +end; + +function TLandTextureManager.GetTexMaterial(ATileID: Word): TMaterial; +var + texEntry: TTexture; + texID: Integer; +begin + if not FTexCache.QueryID(ATileID, Result) then + begin + texID := ResMan.Tiledata.LandTiles[ATileID].TextureID; + if texID > 0 then + begin + texEntry := TTexture(ResMan.Texmaps.Block[texID]); + + Result := TSimpleMaterial.Create(texEntry.Graphic); + FTexCache.StoreID(ATileID, Result); + + texEntry.Free; + end else + Result := nil; + end; + + if Result <> nil then + Result.AddRef; +end; + +{ TSeperatedStaticBlock } + +constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; + AX, AY: Word); +var + i: Integer; + item: TStaticItem; + block: TMemoryStream; +begin + inherited Create; + FItems := TStaticItemList.Create(False); + + FX := AX; + FY := AY; + + for i := 0 to 63 do + Cells[i] := TStaticItemList.Create; + + 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 + begin + item := TStaticItem.Create(Self, block, AX, AY); + Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item); + end; + block.Free; + end; +end; + +constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex); +begin + Create(AData, AIndex, 0, 0); +end; + +destructor TSeperatedStaticBlock.Destroy; +var + i: Integer; +begin + FreeAndNil(FItems); + + for i := 0 to 63 do + begin + if Cells[i] <> nil then + FreeAndNil(Cells[i]); + end; + + inherited Destroy; +end; + +function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock; +begin + raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).'); + Result := nil; +end; + +function TSeperatedStaticBlock.GetSize: Integer; +begin + RebuildList; + Result := inherited GetSize; +end; + +procedure TSeperatedStaticBlock.RebuildList; +var + i, j, solver: Integer; +begin + FItems.Clear; + solver := 0; + for i := 0 to 63 do + begin + if Cells[i] <> nil then + begin + for j := 0 to Cells[i].Count - 1 do + begin + FItems.Add(Cells[i].Items[j]); + TStaticItem(Cells[i].Items[j]).UpdatePriorities( + ResMan.Tiledata.StaticTiles[TStaticItem(Cells[i].Items[j]).TileID], + solver); + Inc(solver); + end; + end; + end; + Sort; +end; + +{ TBlock } + +constructor TBlock.Create(AMap: TMapBlock; AStatics: TStaticBlock); +begin + inherited Create; + FMapBlock := AMap; + FStaticBlock := AStatics; +end; + +destructor TBlock.Destroy; +begin + if FMapBlock <> nil then FreeAndNil(FMapBlock); + if FStaticBlock <> nil then FreeAndNil(FStaticBlock); + inherited Destroy; +end; + +procedure TBlock.UpdateBlockAcess(ALandscape: TLandscape); +var + staticItem: TStaticItem; + i: Integer; +begin + for i := Low(FMapBlock.Cells) to High(FMapBlock.Cells) do + begin + FMapBlock.Cells[i].CanBeEdited := ALandscape.CanWrite(FMapBlock.Cells[i].X, + FMapBlock.Cells[i].Y); + end; + + if FStaticBlock is TSeperatedStaticBlock then + TSeperatedStaticBlock(FStaticBlock).RebuildList; //fill items + + for i := 0 to FStaticBlock.Items.Count - 1 do + begin + staticItem := FStaticBlock.Items[i]; + staticItem.CanBeEdited := ALandscape.CanWrite(staticItem.X, + staticItem.Y); + end; +end; + +{ TLandscape } + +constructor TLandscape.Create(AWidth, AHeight: Word); +var + i: Integer; +begin + inherited Create; + FWidth := AWidth; + FHeight := AHeight; + FCellWidth := FWidth * 8; + FCellHeight := FHeight * 8; + FBlockCache := TBlockCache.Create(256); + FBlockCache.OnRemoveObject := @OnRemoveCachedObject; + + FOnChange := nil; + FOnNewBlock := nil; + FOnStaticDeleted := nil; + FOnStaticElevated := nil; + FOnStaticHued := nil; + FOnStaticInserted := nil; + + FOpenRequests := TBits.Create(FWidth * FHeight); + FOpenRequests.Clearall; //set all to 0 + FWriteMap := TBits.Create(FCellWidth * FCellHeight); + for i := 0 to FWriteMap.Size - 1 do + FWriteMap[i] := True; + + RegisterPacketHandler($04, TPacketHandler.Create(0, @OnBlocksPacket)); + RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket)); + RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket)); + RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket)); + RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket)); + RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket)); + RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket)); +end; + +destructor TLandscape.Destroy; +begin + if FBlockCache <> nil then + begin + FBlockCache.OnRemoveObject := nil; + FreeAndNil(FBlockCache); + end; + + FreeAndNil(FOpenRequests); + FreeAndNil(FWriteMap); + + RegisterPacketHandler($04, nil); + RegisterPacketHandler($06, nil); + RegisterPacketHandler($07, nil); + RegisterPacketHandler($08, nil); + RegisterPacketHandler($09, nil); + RegisterPacketHandler($0A, nil); + RegisterPacketHandler($0B, nil); + + inherited Destroy; +end; + +function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock; +var + block: TBlock; +begin + Result := nil; + if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then + begin + if FBlockCache.QueryID(GetID(AX, AY), block) then + Result := block.Map; + end; +end; + +function TLandscape.GetMapCell(AX, AY: Word): TMapCell; +var + block: TMapBlock; +begin + Result := nil; + if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then + begin + block := GetMapBlock(AX div 8, AY div 8); + if block <> nil then + Result := block.Cells[(AY mod 8) * 8 + AX mod 8]; + end; +end; + +function TLandscape.GetNormals(AX, AY: Word): TNormals; +begin + GetNormals(AX, AY, Result); +end; + +function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; +var + block: TBlock; +begin + Result := nil; + if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then + begin + if FBlockCache.QueryID(GetID(AX, AY), block) then + Result := TSeperatedStaticBlock(block.Static); + end; +end; + +function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList; +var + block: TSeperatedStaticBlock; +begin + Result := nil; + if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then + begin + block := GetStaticBlock(AX div 8, AY div 8); + if block <> nil then + Result := block.Cells[(AY mod 8) * 8 + AX mod 8]; + end; +end; + +procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock); +begin + if ABlock <> nil then + dmNetwork.Send(TFreeBlockPacket.Create(ABlock.Map.X, ABlock.Map.Y)); +end; + +procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream); +var + index: TGenericIndex; + map: TMapBlock; + statics: TStaticBlock; + coords: TBlockCoords; + count: Word; + id: Integer; + block: TBlock; +begin + index := TGenericIndex.Create(nil); + while ABuffer.Position < ABuffer.Size do + begin + ABuffer.Read(coords, SizeOf(TBlockCoords)); + id := GetID(coords.X, coords.Y); + + map := TMapBlock.Create(ABuffer, coords.X, coords.Y); + count := ABuffer.ReadWord; + if count > 0 then + index.Lookup := ABuffer.Position + else + index.Lookup := -1; + index.Size := count * 7; + statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y); + + FBlockCache.RemoveID(id); + block := TBlock.Create(map, statics); + block.UpdateBlockAcess(Self); + FBlockCache.StoreID(id, block); + + FOpenRequests[coords.Y * FWidth + coords.X] := False; + + if Assigned(FOnNewBlock) then FOnNewBlock(block); + end; + index.Free; +end; + +procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); +var + x, y: Word; + cell: TMapCell; +begin + x := ABuffer.ReadWord; + y := ABuffer.ReadWord; + cell := GetMapCell(x, y); + if cell <> nil then + begin + cell.Altitude := ABuffer.ReadShortInt; + cell.TileID := ABuffer.ReadWord; + if Assigned(FOnMapChanged) then FOnMapChanged(cell); + end; +end; + +procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); +var + x, y: Word; + block: TSeperatedStaticBlock; + staticItem: TStaticItem; + targetStaticList: TStaticItemList; + i: Integer; +begin + x := ABuffer.ReadWord; + y := ABuffer.ReadWord; + block := GetStaticBlock(x div 8, y div 8); + if block <> nil then + begin + staticItem := TStaticItem.Create(nil, nil, 0, 0); + staticItem.X := x; + staticItem.Y := y; + staticItem.Z := ABuffer.ReadShortInt; + staticItem.TileID := ABuffer.ReadWord; + staticItem.Hue := ABuffer.ReadWord; + targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8]; + targetStaticList.Add(staticItem); + for i := 0 to targetStaticList.Count - 1 do + targetStaticList.Items[i].UpdatePriorities( + ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID], + i); + targetStaticList.Sort(@CompareStaticItems); + staticItem.Owner := block; + staticItem.CanBeEdited := CanWrite(x, y); + + if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem); + end; +end; + +procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream); +var + block: TSeperatedStaticBlock; + i: Integer; + statics: TStaticItemList; + staticInfo: TStaticInfo; + staticItem: TStaticItem; +begin + ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); + block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); + if block <> nil then + begin + statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; + for i := 0 to statics.Count - 1 do + begin + staticItem := statics.Items[i]; + if (staticItem.Z = staticInfo.Z) and + (staticItem.TileID = staticInfo.TileID) and + (staticItem.Hue = staticInfo.Hue) then + begin + if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem); + staticItem.Delete; + statics.Delete(i); + + Break; + end; + end; + end; +end; + +procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream); +var + block: TSeperatedStaticBlock; + i,j : Integer; + statics: TStaticItemList; + staticInfo: TStaticInfo; + staticItem: TStaticItem; +begin + ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); + block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); + if block <> nil then + begin + statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; + for i := 0 to statics.Count - 1 do + begin + staticItem := statics.Items[i]; + if (staticItem.Z = staticInfo.Z) and + (staticItem.TileID = staticInfo.TileID) and + (staticItem.Hue = staticInfo.Hue) then + begin + staticItem.Z := ABuffer.ReadShortInt; + for j := 0 to statics.Count - 1 do + statics.Items[j].UpdatePriorities( + ResMan.Tiledata.StaticTiles[statics.Items[j].TileID], + j); + statics.Sort(@CompareStaticItems); + + if Assigned(FOnStaticElevated) then FOnStaticElevated(staticItem); + + Break; + end; + end; + end; +end; + +procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream); +var + sourceBlock, targetBlock: TSeperatedStaticBlock; + i: Integer; + statics: TStaticItemList; + staticInfo: TStaticInfo; + staticItem: TStaticItem; + newX, newY: Word; +begin + staticItem := nil; + ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); + newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1); + newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1); + + sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); + targetBlock := GetStaticBlock(newX div 8, newY div 8); + if sourceBlock <> nil then + begin + statics := sourceBlock.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; + i := 0; + while (i < statics.Count) and (staticItem = nil) do + begin + staticItem := statics.Items[i]; + if (staticItem.Z <> staticInfo.Z) or + (staticItem.TileID <> staticInfo.TileID) or + (staticItem.Hue <> staticInfo.Hue) then + begin + staticItem := nil; + end; + Inc(i); + end; + + if staticItem <> nil then + begin + if Assigned(FOnStaticDeleted) then FOnStaticDeleted(staticItem); + staticItem.Delete; + statics.Remove(staticItem); + end; + end; + + if targetBlock <> nil then + begin + staticItem := TStaticItem.Create(nil, nil, 0, 0); + staticItem.X := newX; + staticItem.Y := newY; + staticItem.Z := staticInfo.Z; + staticItem.TileID := staticInfo.TileID; + staticItem.Hue := staticInfo.Hue; + statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8]; + statics.Add(staticItem); + for i := 0 to statics.Count - 1 do + TStaticItem(statics.Items[i]).UpdatePriorities( + ResMan.Tiledata.StaticTiles[TStaticItem(statics.Items[i]).TileID], + i); + statics.Sort(@CompareStaticItems); + staticItem.Owner := targetBlock; + staticItem.CanBeEdited := CanWrite(newX, newY); + + if Assigned(FOnStaticInserted) then FOnStaticInserted(staticItem); + end; +end; + +procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); +var + block: TSeperatedStaticBlock; + i : Integer; + statics: TStaticItemList; + staticInfo: TStaticInfo; + staticItem: TStaticItem; +begin + ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); + block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); + if block <> nil then + begin + statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8]; + for i := 0 to statics.Count - 1 do + begin + staticItem := statics.Items[i]; + if (staticItem.Z = staticInfo.Z) and + (staticItem.TileID = staticInfo.TileID) and + (staticItem.Hue = staticInfo.Hue) then + begin + staticItem.Hue := ABuffer.ReadWord; + if Assigned(FOnStaticHued) then FOnStaticHued(staticItem); + Break; + end; + end; + end; +end; + +function TLandscape.CanWrite(AX, AY: Word): Boolean; +begin + Result := FWriteMap[AX * FCellHeight + AY]; +end; + +procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, + AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; + AAdditionalTiles: TWorldItemList = nil); +var + drawMapCell: TMapCell; + drawStatics: TStaticItemList; + i, x, y: Integer; + tempDrawList: TWorldItemList; +begin + ADrawList.Clear; + tempDrawList := TWorldItemList.Create(False);; + for x := AX to AX + AWidth do + begin + for y := AY to AY + AWidth do + begin + if AMap then + begin + drawMapCell := GetMapCell(x, y); + if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then + begin + drawMapCell.Priority := GetEffectiveAltitude(drawMapCell); + drawMapCell.PriorityBonus := 0; + drawMapCell.PrioritySolver := 0; + tempDrawList.Add(drawMapCell); + end; + end; + + if AStatics then + begin + drawStatics := GetStaticList(x, y); + if drawStatics <> nil then + for i := 0 to drawStatics.Count - 1 do + begin + drawStatics[i].UpdatePriorities( + ResMan.Tiledata.StaticTiles[drawStatics[i].TileID], + ADrawList.GetSerial); + tempDrawList.Add(drawStatics[i]); + end; + end; + end; + end; + + for i := 0 to AAdditionalTiles.Count - 1 do + tempDrawList.Add(AAdditionalTiles[i]); + + tempDrawList.Sort(@CompareWorldItems); + for i := 0 to tempDrawList.Count - 1 do + ADrawList.Add(TWorldItem(tempDrawList[i])); + tempDrawList.Free; +end; + +function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt; +var + north, west, south, east: ShortInt; +begin + north := ATile.Altitude; + west := GetLandAlt(ATile.X, ATile.Y + 1, north); + south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north); + east := GetLandAlt(ATile.X + 1, ATile.Y, north); + + if Abs(north - south) >= Abs(west - east) then + Result := Min(north, south) + Abs(west - east) div 2 + else + Result := Min(north, south) + Abs(north - south) div 2; +end; + +function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; +var + cell: TMapCell; +begin + cell := MapCell[AX, AY]; + if cell <> nil then + Result := cell.Altitude + else + Result := ADefault; +end; + +procedure TLandscape.GetNormals(AX, AY: Word; var ANormals: TNormals); +var + cells: array[0..2, 0..2] of TNormals; + north, west, south, east: TVector; + i, j: Integer; + + function GetPlainNormals(X, Y: SmallInt): TNormals; + var + cell: TMapCell; + north, west, south, east: ShortInt; + u, v: TVector; + begin + cell := GetMapCell(X, Y); + if cell <> nil then + begin + north := cell.Altitude; + west := GetLandAlt(cell.X, cell.Y + 1, north); + south := GetLandAlt(cell.X + 1, cell.Y + 1, north); + east := GetLandAlt(cell.X + 1, cell.Y, north); + end else + begin + north := 0; + west := 0; + east := 0; + south := 0; + end; + + if (north = west) and (west = east) and (north = south) then + begin + Result[0] := Vector(0, 0, 1); + Result[1] := Vector(0, 0, 1); + Result[2] := Vector(0, 0, 1); + Result[3] := Vector(0, 0, 1); + end else + begin + u := Vector(-22, 22, (north - east) * 4); + v := Vector(-22, -22, (west - north) * 4); + Result[0] := VectorNorm(VectorCross(u, v)); + + u := Vector(22, 22, (east - south) * 4); + v := Vector(-22, 22, (north - east) * 4); + Result[1] := VectorNorm(VectorCross(u, v)); + + u := Vector(22, -22, (south - west) * 4); + v := Vector(22, 22, (east - south) * 4); + Result[2] := VectorNorm(VectorCross(u, v)); + + u := Vector(-22, -22, (west - north) * 4); + v := Vector(22, -22, (south - west) * 4); + Result[3] := VectorNorm(VectorCross(u, v)); + end; + end; +begin + for i := 0 to 2 do + for j := 0 to 2 do + cells[i, j] := GetPlainNormals(AX - 1 + i, AY - 1 + j); + + north := cells[0, 0][2]; + west := cells[0, 1][1]; + east := cells[1, 0][3]; + south := cells[1, 1][0]; + ANormals[0] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); + + north := cells[1, 0][2]; + west := cells[1, 1][1]; + east := cells[2, 0][3]; + south := cells[2, 1][0]; + ANormals[1] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); + + north := cells[1, 1][2]; + west := cells[1, 2][1]; + east := cells[2, 1][3]; + south := cells[2, 2][0]; + ANormals[2] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); + + north := cells[0, 1][2]; + west := cells[0, 2][1]; + east := cells[1, 1][3]; + south := cells[1, 2][0]; + ANormals[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); +end; + +procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word); +var + sourceBlock, targetBlock: TSeperatedStaticBlock; + targetStaticList: TStaticItemList; + i: Integer; +begin + if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then + begin + sourceBlock := AStatic.Owner as TSeperatedStaticBlock; + targetBlock := GetStaticBlock(AX div 8, AY div 8); + if (sourceBlock <> nil) and (targetBlock <> nil) then + begin + sourceBlock.Cells[(AStatic.Y mod 8) * 8 + AStatic.X mod 8].Remove(AStatic); + targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8]; + targetStaticList.Add(AStatic); + for i := 0 to targetStaticList.Count - 1 do + targetStaticList.Items[i].UpdatePriorities( + ResMan.Tiledata.StaticTiles[targetStaticList.Items[i].TileID], + i); + targetStaticList.Sort(@CompareStaticItems); + AStatic.UpdatePos(AX, AY, AStatic.Z); + AStatic.Owner := targetBlock; + end; + end; +end; + +procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word); +var + x, y, i: Integer; + coords: TBlockCoordsArray; + block: TBlock; +begin + AX1 := EnsureRange(AX1, 0, FWidth - 1); + AY1 := EnsureRange(AY1, 0, FHeight - 1); + AX2 := EnsureRange(AX2, 0, FWidth - 1); + AY2 := EnsureRange(AY2, 0, FHeight - 1); + + SetLength(coords, 0); + for x := AX1 to AX2 do + begin + for y := AY1 to AY2 do + begin + if (not FOpenRequests[y * FWidth + x]) and + (not FBlockCache.QueryID(GetID(x, y), block)) then + begin + SetLength(coords, Length(coords) + 1); + i := High(coords); + coords[i].X := x; + coords[i].Y := y; + FOpenRequests[y * FWidth + x] := True; + end; + end; + end; + if Length(coords) > 0 then + dmNetwork.Send(TRequestBlocksPacket.Create(coords)); +end; + +procedure TLandscape.UpdateBlockAccess; +var + cacheEntry: TBlockCache.PCacheEntry; +begin + cacheEntry := nil; + while FBlockCache.Iterate(cacheEntry) do + if cacheEntry^.Obj <> nil then + cacheEntry^.Obj.UpdateBlockAcess(Self); +end; + +procedure TLandscape.UpdateWriteMap(AStream: TEnhancedMemoryStream); +var + x1, y1, x2, y2: Word; + i, areaCount, cellX, cellY: Integer; +begin + Logger.EnterMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap'); + + areaCount := AStream.ReadWord; + Logger.Send([lcLandscape, lcDebug], 'AreaCount', areaCount); + + if areaCount > 0 then + begin + FWriteMap.Clearall; + for i := 0 to areaCount - 1 do + begin + x1 := AStream.ReadWord; + y1 := AStream.ReadWord; + x2 := AStream.ReadWord; + y2 := AStream.ReadWord; + for cellX := x1 to x2 do + for cellY := y1 to y2 do + FWriteMap[cellX * FCellHeight + cellY] := True; + end; + end else + for i := 0 to FWriteMap.Size - 1 do + FWriteMap[i] := True; + + Logger.Send([lcLandscape, lcDebug], 'WriteMap @ 0,0', FWriteMap[0]); + + UpdateBlockAccess; + Logger.ExitMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap'); +end; + +{ TMaterial } + +constructor TMaterial.Create; +begin + FRefCount := 1; +end; + +destructor TMaterial.Destroy; +begin + FreeAndNil(FGraphic); + inherited Destroy; +end; + +procedure TMaterial.CalculateTextureDimensions(ACaps: TGLTextureCaps; + ARealWidth, ARealHeight: Integer; out AWidth, AHeight: Integer); +begin + if ACaps.NonPowerOfTwo then + begin + AWidth := ARealWidth; + AHeight := ARealHeight; + end else + begin + if IsPow2(ARealWidth) then + AWidth := ARealWidth + else + AWidth := NextPow2(ARealWidth); + + if IsPow2(ARealHeight) then + AHeight := ARealHeight + else + AHeight := NextPow2(ARealHeight); + end; +end; + +function TMaterial.GenerateTexture(AImage: TBaseImage): TGLuint; +begin + Result := CreateGLTextureFromImage(AImage.ImageDataPointer^); + glBindTexture(GL_TEXTURE_2D, Result); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); +end; + +procedure TMaterial.AddRef; +begin + Inc(FRefCount); +end; + +procedure TMaterial.DelRef; +begin + Dec(FRefCount); + if FRefCount < 1 then + Free; +end; + +function TMaterial.HitTest(AX, AY: Integer): Boolean; +var + pixel: TColor32Rec; +begin + Result := False; + if InRange(AX, 0, FGraphic.Width - 1) and + InRange(AY, 0, FGraphic.Height - 1) then + begin + pixel := GetPixel32(FGraphic.ImageDataPointer^, AX, AY); + if pixel.A > 0 then + Result := True; + end; +end; + +function TMaterial.CanBeRemoved: Boolean; +begin + Result := FRefCount <= 1; +end; + +procedure TMaterial.RemoveFromCache; +begin + DelRef; +end; + +{ TScreenBuffer } + +constructor TScreenBuffer.Create; +begin + inherited Create; + FCount := 0; + FSerial := 0; + UpdateShortcuts; +end; + +destructor TScreenBuffer.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TScreenBuffer.Add(AItem: TWorldItem): PBlockInfo; +begin + New(Result); + AItem.Locked := True; + AItem.OnDestroy.RegisterEvent(@OnTileRemoved); + Result^.Item := AItem; + Result^.HighRes := nil; + Result^.LowRes := nil; + Result^.Normals := nil; + Result^.State := ssNormal; + Result^.Highlighted := False; + Result^.Translucent := False; + Result^.Text := nil; + Result^.Next := nil; + + if FShortCuts[0] = nil then //First element + begin + FShortCuts[0] := Result; + FShortCuts[-1] := Result; //Last element + end else + begin + FShortCuts[-1]^.Next := Result; + FShortCuts[-1] := Result; + end; + + Inc(FCount); +end; + +procedure TScreenBuffer.Clear; +var + current, next: PBlockInfo; +begin + current := FShortCuts[0]; + while current <> nil do + begin + next := current^.Next; + current^.Item.Locked := False; + current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved); + if current^.Normals <> nil then Dispose(current^.Normals); + if current^.HighRes <> nil then current^.HighRes.DelRef; + if current^.LowRes <> nil then current^.LowRes.DelRef; + current^.Text.Free; + Dispose(current); + current := next; + end; + FShortCuts[0] := nil; + FShortCuts[-1] := nil; + + FCount := 0; + FSerial := 0; + + UpdateShortcuts; +end; + +procedure TScreenBuffer.Delete(AItem: TWorldItem); +var + current, last, next: PBlockInfo; +begin + last := nil; + current := FShortCuts[0]; + while current <> nil do + begin + if current^.Item = AItem then + begin + if FShortCuts[-1] = current then FShortCuts[-1] := last; + if FShortCuts[0] = current then FShortCuts[0] := current^.Next; + if last <> nil then last^.Next := current^.Next; + + if current^.Normals <> nil then Dispose(current^.Normals); + if current^.HighRes <> nil then current^.HighRes.DelRef; + if current^.LowRes <> nil then current^.LowRes.DelRef; + current^.Text.Free; + + Dispose(current); + Dec(FCount); + FShortCutsValid := False; + next := nil; + end else + next := current^.Next; + + last := current; + current := next; + end; +end; + +function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo; +var + current: PBlockInfo; + buff: array[0..3] of GLuint; +begin + Result := nil; + current := FShortCuts[0]; + while current <> nil do //search the last matching tile + begin + if (current^.State = ssNormal) and + PtInRect(current^.ScreenRect, AScreenPosition)then + begin + if current^.CheckRealQuad then + begin + //OpenGL hit test + //We use the "real quad" here to prevent the draw-preview from + //intercepting with our actual tiles (which are "hidden" then). + glSelectBuffer(4, @buff[0]); + glViewport(current^.ScreenRect.Left, current^.ScreenRect.Top, + current^.ScreenRect.Right, current^.ScreenRect.Bottom); + glRenderMode(GL_SELECT); + glInitNames; + glPushName(0); + + glPushMatrix; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + gluOrtho2D(AScreenPosition.x, AScreenPosition.x + 1, + AScreenPosition.y + 1, AScreenPosition.y); + glMatrixMode(GL_MODELVIEW); + glLoadIdentity; + + glBegin(GL_QUADS); + glVertex2iv(@current^.RealQuad[0]); + glVertex2iv(@current^.RealQuad[3]); + glVertex2iv(@current^.RealQuad[2]); + glVertex2iv(@current^.RealQuad[1]); + glEnd; + glPopMatrix; + glFlush; + + if glRenderMode(GL_RENDER) > 0 then //glRenderMode now returns the number of hits + Result := current; + end else + if current^.LowRes.HitTest(AScreenPosition.x - current^.ScreenRect.Left, + AScreenPosition.y - current^.ScreenRect.Top) then + Result := current; + end; + current := current^.Next; + end; +end; + +function TScreenBuffer.GetSerial: Cardinal; +begin + Result := FSerial; + Inc(FSerial); +end; + +function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo; +var + current: PBlockInfo; + shortcut: Integer; +begin + if not FShortCutsValid then + UpdateShortcuts; + + New(Result); + AItem.Locked := True; + AItem.OnDestroy.RegisterEvent(@OnTileRemoved); + Result^.Item := AItem; + Result^.HighRes := nil; + Result^.LowRes := nil; + Result^.Normals := nil; + Result^.State := ssNormal; + Result^.Highlighted := False; + Result^.Translucent := False; + Result^.Text := nil; + + if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then + begin + if FShortCuts[0] = nil then + FShortCuts[-1] := Result; //Update last item + + Result^.Next := FShortCuts[0]; + FShortCuts[0] := Result; + end else + begin + //find best entry point + shortcut := 0; + while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and + (CompareWorldItems(AItem, FShortCuts[shortcut]^.Item) >= 0) do + begin + current := FShortCuts[shortcut]; + Inc(shortcut); + end; + + //now find the real match + while (current^.Next <> nil) and + (CompareWorldItems(AItem, current^.Next^.Item) > 0) do + begin + current := current^.Next; + end; + + if FShortCuts[-1] = current^.Next then + FShortCuts[-1] := Result; //Update last item + + Result^.Next := current^.Next; + current^.Next := Result; + end; + + Inc(FCount); +end; + +function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean; +begin + if ABlockInfo = nil then + ABlockInfo := FShortCuts[0] + else + ABlockInfo := ABlockInfo^.Next; + Result := ABlockInfo <> nil; +end; + +procedure TScreenBuffer.UpdateShortcuts; +var + shortcut, step, nextStep, stepSize: Integer; + blockInfo: PBlockInfo; +begin + if FCount < 10 then + begin + for shortcut := 1 to 10 do + FShortCuts[shortcut] := nil; + end + else if FShortCuts[0] <> nil then + begin + stepSize := FCount div 10; + nextStep := stepSize; + step := 0; + shortcut := 1; + blockInfo := FShortCuts[0]; + repeat + if step = nextStep then + begin + FShortCuts[shortcut] := blockInfo; + Inc(shortcut); + Inc(nextStep, stepSize); + end; + + Inc(step); + + FShortCuts[-1] := blockInfo; //update last known item + blockInfo := blockInfo^.Next; + until (blockInfo = nil); + end; + FShortCutsValid := True; +end; + +function TScreenBuffer.UpdateSortOrder(AItem: TWorldItem): PBlockInfo; +var + newNodePosition, oldNode, oldNodePrev, current: PBlockInfo; +begin + newNodePosition := nil; + oldNode := nil; + oldNodePrev := nil; + current := FShortCuts[0]; + + while (current <> nil) and ((oldNode = nil) or (newNodePosition = nil)) do + begin + if current^.Item = AItem then + oldNode := current + else if oldNode = nil then + oldNodePrev := current; + + if newNodePosition = nil then + begin + if (current^.Next = nil) or (CompareWorldItems(AItem, current^.Next^.Item) < 0) then + newNodePosition := current; + end; + + current := current^.Next; + end; + + //oldNode = nil, if the change happend out-of-screen + if (oldNode <> nil ) and (oldNode <> newNodePosition) then + begin + if oldNodePrev <> oldNode then + begin + if oldNodePrev = nil then + FShortCuts[0] := oldNode^.Next + else + oldNodePrev^.Next := oldNode^.Next; + end; + + if (newNodePosition = FShortCuts[0]) and (CompareWorldItems(AItem, FShortCuts[0]^.Item) < 0) then + begin + oldNode^.Next := FShortCuts[0]; + FShortCuts[0] := oldNode; + end else + begin + oldNode^.Next := newNodePosition^.Next; + newNodePosition^.Next := oldNode; + end; + end; + + Result := oldNode; +end; + +procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock); +begin + Delete(TWorldItem(ATile)); +end; + +{ TGLText } + +constructor TGLText.Create(AFont: TGLFont; AText: String); +begin + FFont := AFont; + FText := AText; + FWidth := FFont.GetTextWidth(AText); + FHeight := FFont.GetTextHeight('A'); +end; + +procedure TGLText.Render(AScreenRect: TRect); +var + x, y: Integer; +begin + y := AScreenRect.Top + (AScreenRect.Bottom - AScreenRect.Top - FHeight) div 2; + x := AScreenRect.Left + (AScreenRect.Right - AScreenRect.Left - FWidth) div 2; + FFont.DrawText(x, y, FText); +end; + +{ TSimpleMaterial } + +constructor TSimpleMaterial.Create(AGraphic: TBaseImage); +var + caps: TGLTextureCaps; +begin + inherited Create; + FRealWidth := AGraphic.Width; + FRealHeight := AGraphic.Height; + + GetGLTextureCaps(caps); + CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight); + FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8, 1); + AGraphic.CopyTo(0, 0, FRealWidth, FRealHeight, FGraphic, 0, 0); + FTexture := GenerateTexture(FGraphic); +end; + +destructor TSimpleMaterial.Destroy; +begin + if FTexture <> 0 then glDeleteTextures(1, @FTexture); + inherited Destroy; +end; + +function TSimpleMaterial.GetTexture: GLuint; +begin + Result := FTexture; +end; + +{ TAnimMaterial } + +constructor TAnimMaterial.Create(ABaseID: Word; AAnimData: TAnimData; + AHue: THue = nil; APartialHue: Boolean = False); +var + i: Integer; + art: array of TArt; + caps: TGLTextureCaps; +begin + inherited Create; + + FAnimData := AAnimData; + + FRealWidth := 0; + FRealHeight := 0; + + SetLength(FTextures, AAnimData.FrameCount); + SetLength(art, AAnimData.FrameCount); + + for i := 0 to AAnimData.FrameCount - 1 do + begin + art[i] := ResMan.Art.GetArt(ABaseID + AAnimData.FrameData[i], 0, AHue, + APartialHue); + + if art[i].Graphic.Width > FRealWidth then + FRealWidth := art[i].Graphic.Width; + if art[i].Graphic.Height > FRealHeight then + FRealHeight := art[i].Graphic.Height; + end; + + GetGLTextureCaps(caps); + CalculateTextureDimensions(caps, FRealWidth, FRealHeight, FWidth, FHeight); + FGraphic := TMultiImage.CreateFromParams(FWidth, FHeight, ifA8R8G8B8, + AAnimData.FrameCount); + + for i := 0 to AAnimData.FrameCount - 1 do + begin + FGraphic.ActiveImage := i; + art[i].Graphic.CopyTo(0, 0, art[i].Graphic.Width, art[i].Graphic.Height, + FGraphic, 0, 0); + FTextures[i] := GenerateTexture(FGraphic); + art[i].Free; + end; + + FGraphic.ActiveImage := 0; + FActiveFrame := 0; + FNextChange := GetTickCount + AAnimData.FrameStart * 100; +end; + +destructor TAnimMaterial.Destroy; +begin + glDeleteTextures(Length(FTextures), @FTextures[0]); + inherited Destroy; +end; + +function TAnimMaterial.GetTexture: GLuint; +begin + if FNextChange <= GetTickCount then + begin + FActiveFrame := (FActiveFrame + 1) mod FAnimData.FrameCount; + FGraphic.ActiveImage := FActiveFrame; + + if FActiveFrame = 0 then + FNextChange := GetTickCount + FAnimData.FrameStart * 100 + else + FNextChange:= GetTickCount + FAnimData.FrameInterval * 100; + end; + + Result := FTextures[FActiveFrame]; +end; + +end. + diff --git a/Client/UPacketHandlers.pas b/Client/UPacketHandlers.pas index e3d7e32..f710d1e 100644 --- a/Client/UPacketHandlers.pas +++ b/Client/UPacketHandlers.pas @@ -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; diff --git a/Client/UPackets.pas b/Client/UPackets.pas index a6581ea..f26dd06 100644 --- a/Client/UPackets.pas +++ b/Client/UPackets.pas @@ -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. + diff --git a/Client/UResourceManager.pas b/Client/UResourceManager.pas index 4c47aa3..59c8e60 100644 --- a/Client/UResourceManager.pas +++ b/Client/UResourceManager.pas @@ -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. + diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 1d23055..34ca2de 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -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] diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index d3d004e..83d6046 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -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; diff --git a/Client/UfrmTileInfo.pas b/Client/UfrmTileInfo.pas index f888e24..2fca8e7 100644 --- a/Client/UfrmTileInfo.pas +++ b/Client/UfrmTileInfo.pas @@ -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. + diff --git a/Logging.pas b/Logging.pas index 33b98e0..feb4b07 100644 --- a/Logging.pas +++ b/Logging.pas @@ -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. + diff --git a/MulProvider/UMulManager.pas b/MulProvider/UMulManager.pas index eba90cd..715337a 100644 --- a/MulProvider/UMulManager.pas +++ b/MulProvider/UMulManager.pas @@ -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. diff --git a/MulProvider/URadarProvider.pas b/MulProvider/URadarProvider.pas index 1812bad..a48c407 100644 --- a/MulProvider/URadarProvider.pas +++ b/MulProvider/URadarProvider.pas @@ -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); diff --git a/UOLib/UArt.pas b/UOLib/UArt.pas index da0e79c..ef44514 100644 --- a/UOLib/UArt.pas +++ b/UOLib/UArt.pas @@ -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. + diff --git a/UOLib/UHue.pas b/UOLib/UHue.pas index d086db2..2cd8e44 100644 --- a/UOLib/UHue.pas +++ b/UOLib/UHue.pas @@ -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; diff --git a/UOLib/UMap.pas b/UOLib/UMap.pas index 92646d5..474be8f 100644 --- a/UOLib/UMap.pas +++ b/UOLib/UMap.pas @@ -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; - - { 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; + + { 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. + diff --git a/UOLib/UMulBlock.pas b/UOLib/UMulBlock.pas index 9d17f6c..a6009c7 100644 --- a/UOLib/UMulBlock.pas +++ b/UOLib/UMulBlock.pas @@ -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 diff --git a/UOLib/UStatics.pas b/UOLib/UStatics.pas index 08dab96..5e8f90f 100644 --- a/UOLib/UStatics.pas +++ b/UOLib/UStatics.pas @@ -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; - - { 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; + + { 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. +