LogView.pm.svn-base
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:4k
源码类别:

外挂编程

开发平台:

Windows_Unix

  1. #########################################################################
  2. #  OpenKore - WxWidgets Interface
  3. #  Log viewer control
  4. #  A text control with a limited line capacity. It will automatically
  5. #  remove the first line(s) if you insert more lines than the capacity
  6. #  allows.
  7. #
  8. #  Copyright (c) 2004 OpenKore development team 
  9. #
  10. #  This program is free software; you can redistribute it and/or modify
  11. #  it under the terms of the GNU General Public License as published by
  12. #  the Free Software Foundation; either version 2 of the License, or
  13. #  (at your option) any later version.
  14. #
  15. #  This program is distributed in the hope that it will be useful,
  16. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. #  GNU General Public License for more details.
  19. #
  20. #
  21. #  $Revision$
  22. #  $Id$
  23. #
  24. #########################################################################
  25. package Interface::Wx::LogView;
  26. use strict;
  27. use Wx ':everything';
  28. use base qw(Wx::TextCtrl);
  29. require DynaLoader;
  30. use Globals;
  31. use Utils qw(binFind);
  32. use constant MAX_LINES => 1000;
  33. our $platform;
  34. sub new {
  35. my ($class, $parent) = @_;
  36. if (!$platform) {
  37. if ($^O eq 'MSWin32') {
  38. $platform = 'win32';
  39. } else {
  40. my $mod = 'use IPC::Open2; use POSIX;';
  41. eval $mod;
  42. if (DynaLoader::dl_find_symbol_anywhere('pango_font_description_new')) {
  43. # wxGTK is linked to GTK 2
  44. $platform = 'gtk2';
  45. # GTK 2 will segfault if we try to use non-UTF 8 characters,
  46. # so we need functions to convert them to UTF-8
  47. $mod = 'use utf8; use Encode;';
  48. eval $mod;
  49. } else {
  50. $platform = 'gtk1';
  51. }
  52. }
  53. }
  54. my $self = $class->SUPER::new($parent, -1, '',
  55. wxDefaultPosition, wxDefaultSize,
  56. wxTE_MULTILINE | wxTE_RICH | wxTE_NOHIDESEL);
  57. $self->SetEditable(0);
  58. ### Fonts
  59. my $font;
  60. if ($platform eq 'win32') {
  61. $font = new Wx::Font(9, wxDEFAULT, wxNORMAL, wxNORMAL, 0, 'Courier New');
  62. } elsif ($platform eq 'gtk2') {
  63. my $enum = new Wx::FontEnumerator;
  64. $enum->EnumerateFacenames(wxFONTENCODING_SYSTEM, 1);
  65. my @fonts = $enum->GetFacenames;
  66. my $name;
  67. if (defined binFind(@fonts, 'Bitstream Vera Sans Mono')) {
  68. $name = 'Bitstream Vera Sans Mono';
  69. } else {
  70. $name = 'monospace';
  71. }
  72. $font = new Wx::Font(10, wxDEFAULT, wxNORMAL, wxNORMAL, 0, $name);
  73. } else {
  74. $font = Wx::SystemSettings::GetFont(wxSYS_ANSI_FIXED_FONT);
  75. }
  76. $self->{font} = $font;
  77. $self->{defaultStyle} = new Wx::TextAttr(
  78. Wx::SystemSettings::GetColour(wxSYS_COLOUR_WINDOWTEXT),
  79. Wx::SystemSettings::GetColour(wxSYS_COLOUR_WINDOW),
  80. $font);
  81. $self->SetDefaultStyle($self->{defaultStyle});
  82. $self->{styles} = {};
  83. return $self;
  84. }
  85. sub setDefaultColor {
  86. my ($self, $fg, $bg) = @_;
  87. if (!$fg && !$bg) {
  88. $self->{defaultStyle} = new Wx::TextAttr(
  89. Wx::SystemSettings::GetColour(wxSYS_COLOUR_WINDOWTEXT),
  90. Wx::SystemSettings::GetColour(wxSYS_COLOUR_WINDOW),
  91. $self->{font});
  92. $self->SetBackgroundColour(Wx::SystemSettings::GetColour(wxSYS_COLOUR_WINDOW));
  93. } else {
  94. $self->{defaultStyle} = new Wx::TextAttr($fg, $bg, $self->{font});
  95. $self->SetBackgroundColour($bg);
  96. }
  97. $self->SetDefaultStyle($self->{defaultStyle});
  98. foreach my $name (keys %{$self->{styles}}) {
  99. my $color = $self->{styles}{$name}->GetTextColour;
  100. $self->addColor($name, $color->Red, $color->Green, $color->Blue);
  101. }
  102. }
  103. sub addColor {
  104. my ($self, $name, $r, $g, $b) = @_;
  105. my $style = new Wx::TextAttr(
  106. new Wx::Colour($r, $g, $b),
  107. $self->GetBackgroundColour,
  108. $self->{font}
  109. );
  110. $self->{styles}{$name} = $style;
  111. }
  112. sub add {
  113. my ($self, $text, $color) = @_;
  114. my $revertStyle;
  115. $self->Freeze;
  116. if ($platform eq 'gtk2') {
  117. my $utf8;
  118. # Convert to UTF-8 so we don't segfault.
  119. # Conversion to ISO-8859-1 will always succeed
  120. foreach my $encoding ("EUC-KR", "EUCKR", "ISO-2022-KR", "ISO8859-1") {
  121. $utf8 = Encode::encode($encoding, $text);
  122. last if $utf8;
  123. }
  124. $text = Encode::encode_utf8($utf8);
  125. }
  126. if ($self->{styles}{$color}) {
  127. $revertStyle = 1;
  128. $self->SetDefaultStyle($self->{styles}{$color});
  129. }
  130. $self->AppendText($text);
  131. $self->SetDefaultStyle($self->{defaultStyle}) if ($revertStyle);
  132. # Limit the number of lines in the console
  133. if ($self->GetNumberOfLines > MAX_LINES) {
  134. my $linesToDelete = $self->GetNumberOfLines - MAX_LINES;
  135. my $pos = $self->XYToPosition(0, $linesToDelete + MAX_LINES / 10);
  136. $self->Remove(0, $pos);
  137. }
  138. $self->SetInsertionPointEnd;
  139. $self->Thaw;
  140. }
  141. 1;