开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 外挂编程 > 查看源码
Vx.pm
资源名称：openkore-2.0.7.zip　[点击查看]
上传用户：market2
上传日期：2018-11-18
资源大小：18786k
文件大小：33k
源码类别：

外挂编程

开发平台：

Windows_Unix

Vx.pm：源码内容
  1. #########################################################################
  2. #  OpenKore :: Vx Interface Module
  3. #  Based on OO
  4. #  Originally By Star-Kung - http://modkore.sourceforge.net.
  5. #
  6. #  Copyright (c) 2005 OpenKore development team 
  7. #
  8. #  This program is free software; you can redistribute it and/or modify
  9. #  it under the terms of the GNU General Public License as published by
  10. #  the Free Software Foundation; either version 2 of the License, or
  11. #  (at your option) any later version.
  12. #
  13. #  This program is distributed in the hope that it will be useful,
  14. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. #  GNU General Public License for more details.
  17. #
  18. #  $Revision: 5989 $
  19. #  $Id: Vx.pm 5989 2007-09-30 11:36:16Z vcl_kore $
  20. #
  21. #########################################################################
  23. package Interface::Vx;
  24. use strict;
  25. use warnings;
  27. use AI;
  28. use Interface;
  29. use base qw/Interface/;
  30. use Plugins;
  31. use Globals;
  32. use Field;
  33. use Settings qw(%sys);
  34. use Misc;
  35. use Utils;
  36. #use Log qw(message warning);
  38. use Carp qw/carp croak confess/;
  39. use File::Spec;
  40. use Time::HiRes qw/time usleep/;
  41. use Tk;
  42. use Tk::ROText;
  43. use Tk::BrowseEntry;
  45. # parse panelTwo_domains into a hash
  46. my %panelTwo_domains;
  47. $sys{panelTwo_domains} ||= "publicchat, pm, guildchat, partychat, pm/sent, list, info, selfchat, schat, error, warning";
  48. my @array = split / *, */, $sys{panelTwo_domains};
  49. foreach (@array) {
  50. s/^s+//;
  51. s/s+$//;
  52. s/s+/ /g;
  53. $panelTwo_domains{$_} = 1;
  54. }
  56. my $buildType = 1;
  57. # main interface functions
  59. sub new {
  60. my $class = shift;
  61. my $self = {
  62. input_list => [], # input history
  63. input_offset => 0, # position while scrolling through input history
  64. input_que => [], # queued input data
  65. default_font => "MS Sans Serif",
  66. input_type => "Command",
  67. input_pm => undef,
  68. total_lines => {"panelOne" => 0, "panelTwo" => 0},
  69. last_line_end => {"panelOne" => 0, "panelTwo" => 0},
  70. line_limit => {"panelOne" => $sys{panelOne_lineLimit} || 900, "panelTwo" => $sys{panelTwo_lineLimit} || 100},
  71. mapDir => 'map'
  72. };
  74. if ($buildType == 0) {
  75. eval "use Win32::API;";
  76. $self->{ShellExecute} = new Win32::API("shell32", "ShellExecute",
  77. "NPPPPN", "V");
  78. }
  80. bless $self, $class;
  81. $self->initTk;
  83. $self->{hooks} = Plugins::addHooks(
  84. ['mainLoop_pre', &updateHook, $self],
  85. ['postloadfiles', &resetColors, $self],
  86. ['parseMsg/pre',  &packet, $self],
  87. ['attack_start', sub { $_[2]->followObj($_[1]->{ID}); }, $self]
  88. );
  89. return $self;
  90. }
  92. sub DESTROY {
  93. my $self = shift;
  94. Plugins::delHooks($self->{hooks});
  95. }
  97. sub update {
  98. my $self = shift;
  99. $self->{mw}->update();
  100. }
  102. sub getInput {
  103. my $self = shift;
  104. my $timeout = shift;
  105. my $msg;
  106. if ($timeout < 0) {
  107. until (defined $msg) {
  108. $self->update();
  109. if (@{ $self->{input_que} }) { 
  110. $msg = shift @{ $self->{input_que} }; 
  111. } 
  112. }
  113. } elsif ($timeout > 0) {
  114. my $end = time + $timeout;
  115. until ($end < time || defined $msg) {
  116. $self->update();
  117. if (@{ $self->{input_que} }) { 
  118. $msg = shift @{ $self->{input_que} }; 
  119. } 
  120. }
  121. } else {
  122. if (@{ $self->{input_que} }) { 
  123. $msg = shift @{ $self->{input_que} }; 
  124. } 
  125. }
  126. $self->update();
  127. $msg =~ s/n// if defined $msg;
  128. return $msg;
  129. }
  131. sub writeOutput {
  132. my $self = shift;
  133. my $type = shift || '';
  134. my $message = shift || '';
  135. my $domain = shift || '';
  137. my $panel;
  138. # FIXME: you can put message types like error and warning in the list because I wanted to see them
  139. # FIXME: a default list of domains should be given to the user if they didn't configure any
  140. if ($panelTwo_domains{$domain} || ($domain eq 'console' && $panelTwo_domains{$type})) {
  141. $panel = "panelTwo";
  142. } else {
  143. $panel = "panelOne";
  144. }
  146. my $scroll = 0;
  147. $scroll = 1 if (($self->{$panel}->yview)[1] == 1);
  149. #keep track of lines to limit the number of lines in the text widget
  150. $self->{total_lines}{panel} += $message =~ s/r?n/n/g;
  152. $self->{$panel}->insert('end', "n") if $self->{last_line_end}{$panel};
  153. $self->{last_line_end}{$panel} = $message =~ s/n$//;
  155. $self->{$panel}->insert('end', $message, "$type $type.$domain");
  157. #remove extra lines
  158. if ($self->{total_lines}{$panel} > $self->{line_limit}{$panel}) {
  159. my $overage = $self->{total_lines}{$panel} - $self->{line_limit}{$panel};
  160. $self->{$panel}->delete('1.0', $overage+1 . ".0");
  161. $self->{total_lines}{$panel} -= $overage;
  162. }
  164. $self->{$panel}->see('end') if $scroll;
  165. }
  167. sub title {
  168. my $self = shift;
  169. my $title = shift;
  171. if (defined $title) {
  172. if (!defined $self->{currentTitle} || $self->{currentTitle} ne $title) {
  173. $self->{mw}->title($title);
  174. $self->{currentTitle} = $title;
  175. }
  176. } else {
  177. return $self->{mw}->title();
  178. }
  179. }
  181. # interface construction
  183. sub initTk {
  184. my $self = shift;
  185. my $panelFont = $sys{panelFont} || 'Verdana';
  186. my $menuFont = $sys{menuFont} || 'Lucida Console';
  187. my $sbarFont = $sys{sbarFont} || 'Arial';
  189. # create main window
  191. $self->{mw} = MainWindow->new();
  192. #$self->{mw}->minsize(316,290);
  193. $self->{mw}->protocol('WM_DELETE_WINDOW', [&OnExit, $self]);
  194. #$self->{mw}->Icon(-image=>$self->{mw}->Photo(-file=>"hyb.gif"));
  195. $self->{mw}->title($Settings::NAME);
  197. # Main window menu
  199. $self->{mw}->configure(-menu => $self->{mw}->Menu(-menuitems=>
  200. [ map 
  201. ['cascade', $_->[0], -tearoff=> 0, -font=>[-family=>$menuFont,-size=>8], -menuitems => $_->[1]],
  202. ['~OpenKore',
  203. [[qw/command E~xit  -accelerator Alt+P/, -font=>[-family=>$menuFont,-size=>8], -command=>[&OnExit, $self]],]
  204. ],
  205. ['~View',
  206. [
  207. [qw/command Map  -accelerator Alt+M/, -font=>[-family=>$menuFont,-size=>8], -command=>[&OpenMap, $self]],
  208. '',
  209. [qw/command Status -accelerator Alt+D/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("s") }],
  210. [qw/command Storage -accelerator Alt+X/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("storage") }],
  211. [qw/command Skill -accelerator Alt+S/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("skills") }],
  212. [qw/command Stat -accelerator Alt+A/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("st") }],
  213. [qw/command Exp -accelerator Alt+Z/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("exp") }],
  214. [qw/command Usable -accelerator Alt+E/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("i u") }],
  215. [qw/command Equipped -accelerator Alt+Q/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("i eq") }],
  216. [qw/command Unequipped -accelerator Alt+C/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("i neq") }],
  217. [qw/command Non-Usable -accelerator Alt+W/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("i nu") }],
  218. '',
  219. [cascade=>"Guild", -tearoff=> 0, -font=>[-family=>$menuFont,-size=>8], -menuitems =>
  220. [
  221. [qw/command Info -accelerator ALT+F/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("guild info") }],
  222. [qw/command Member -accelerator ALT+G/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("guild member") }]
  223. ],
  224. ],
  225. '',
  226. [cascade=>"Font Weight", -tearoff=> 0, -font=>[-family=>$menuFont,-size=>8], -menuitems => 
  227. [
  228. [Checkbutton  => '~Bold', -variable => $self->{is_bold},-font=>[-family=>$sbarFont,-size=>8],-command => [&change_fontWeight, $self]],
  229. ]
  230. ],
  231. ],
  232. ],
  233. ['~Reload',
  234. [
  235. [qw/command config -accelerator Ctrl+Shift+C/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("reload config") }],
  236. [qw/command mon_control  -accelerator Ctrl+Shift+W/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("reload mon_control") }],
  237. [qw/command item_control  -accelerator Ctrl+Shift+Q/, -font=>[-family=>$menuFont,-size=>8], -command => sub{ Commands::run("reload items_control") }],
  238. [qw/command cart_control  -accelerator Ctrl+Shift+E/, -font=>[-family=>$menuFont,-size=>8], -command=>sub{ Commands::run("reload avoid") }],
  239. [qw/command timeouts  -accelerator Ctrl+Shift+Z/, -font=>[-family=>$menuFont,-size=>8], -command=>sub{ Commands::run("reload timeouts") }],
  240. [qw/command pickupitems  -accelerator Ctrl+Shift+V/, -font=>[-family=>$menuFont,-size=>8], -command=>sub{ Commands::run("reload pickupitems") }],
  241. [qw/command chatresp  -accelerator Ctrl+Shift+T/, -font=>[-family=>$menuFont,-size=>8], -command=>sub{ Commands::run("reload chat_resp") }],
  242. '',
  243. [qw/command All  -accelerator Ctrl+Shift+A/, -font=>[-family=>$menuFont,-size=>8], -command=>sub{ Commands::run("reload all") }],
  244. ]
  245. ],
  246. ['~Help',
  247. [[qw/command Manual  -accelerator Alt+H/, -font=>[-family=>$menuFont,-size=>8], -command=>[&showManual, $self]],]
  248. ]
  249. ]
  250. ));
  252. # subclasses of main window
  254. # status frame
  256. $self->{status_frame} = $self->{mw}->Frame()->pack(
  257. -side => 'bottom',
  258. -expand => 0,
  259. -fill => 'x',
  260. );
  262. #------ subclass in status frame
  264. $self->{status_gen} = $self->{status_frame}->Label(
  265. -anchor => 'w',
  266. -text => 'Ready',
  267. -font => [$sbarFont, 8],
  268. -bd=>0,
  269. -relief => 'sunken',
  270. )->pack(
  271. -side => 'left',
  272. -expand => 1,
  273. -fill => 'x',
  274. );
  276. $self->{status_ai} = $self->{status_frame}->Label(
  277. -text => 'Ai - Status',
  278. -font => [$sbarFont, 8],
  279. -width => 25,
  280. -relief => 'ridge',
  281. )->pack(
  282. -side => 'left',
  283. -expand => 0,
  284. -fill => 'x',
  285. );
  287. $self->{status_posx} = $self->{status_frame}->Label(
  288. -text => '0',
  289. -font => [$sbarFont, 8],
  290. -width => 4,
  291. -relief => 'ridge',
  292. )->pack(
  293. -side => 'left',
  294. -expand => 0,
  295. -fill => 'x',
  296. );
  298. $self->{status_posy} = $self->{status_frame}->Label(
  299. -text => '0',
  300. -font => [$sbarFont, 8],
  301. -width => 4,
  302. -relief => 'ridge',
  303. )->pack(
  304. -side => 'left',
  305. -expand => 0,
  306. -fill => 'x',
  307. );
  309. # input frame
  311. $self->{input_frame} = $self->{mw}->Frame(
  312. -bg=>'black'
  313. )->pack(
  314. -side => 'bottom',
  315. -expand => 0,
  316. -fill => 'x',
  317. );
  319. #------ subclass in input frame
  321. $self->{pminput} = $self->{input_frame}->BrowseEntry(
  322. -bg=>'black',
  323. -fg=>'grey',
  324. -variable => $self->{input_pm},
  325. -width => 8,
  326. -font=>[ -family => $panelFont ,-size=>10,],
  327. -autolimitheight => 1,
  328. -state =>'normal',
  329. -relief => 'flat',
  330. )->pack(
  331. -expand=>0,
  332. -fill => 'x',
  333. -side => 'left',
  334. );
  336. $self->{input} = $self->{input_frame}->Entry(
  337. -bg => 'black',
  338. -fg => 'grey',
  339. -insertbackground => 'grey',
  340. -relief => 'sunken',
  341. -font=>[ -family => $panelFont ,-size=>10,],
  342. )->pack(
  343. -expand=>1,
  344. -fill => 'x',
  345. -side => 'left',
  346. );
  348. $self->{sinput} = $self->{input_frame}->BrowseEntry(
  349. -bg=>'black',
  350. -fg=>'grey',
  351. -disabledbackground => 'black',
  352. -disabledforeground => 'grey',
  353. -variable => $self->{input_type},
  354. -autolimitheight => 1,
  355. -listwidth => 30,
  356. -font=>[ -family => $panelFont ,-size=>10,],
  357. -width => 8,
  358. -state => 'readonly',
  359. -relief => 'flat',
  360. )->pack (
  361. -expand=>0,
  362. -fill => 'x',
  363. -side => 'left',
  364. );
  365. $self->{sinput}->insert("end", qw(Command Public Party Guild));
  367. ### panelOne and panelTwo
  369. $self->{panelOne} = $self->{mw}->Scrolled('ROText',
  370. -bg=>'black',
  371. -fg=>'grey',
  372. -scrollbars => 'e',
  373. -height => $sys{panelOne_height} || 8,
  374. -width => $sys{panelOne_width} || 60,
  375. -wrap => 'word',
  376. -insertontime => 0,
  377. -background => 'black',
  378. -foreground => 'grey',
  379. -font=>[ -family => $panelFont ,-size=>$sys{panelOne_fontsize} || 8,],
  380. -relief => 'sunken',
  381. )->pack(
  382. -expand => 1,
  383. -fill => 'both',
  384. -side => $sys{panelOne_side} || 'top',
  385. );
  387. $self->{panelTwo} = $self->{mw}->Scrolled('ROText',
  388. -bg=>'black',
  389. -fg=>'grey',
  390. -scrollbars => 'e',
  391. -height => $sys{panelTwo_height} || 4,
  392. -width => $sys{panelTwo_width} || 40,
  393. -wrap => 'word',
  394. -insertontime => 0,
  395. -background => 'black',
  396. -foreground => 'grey',
  397. -font=>[ -family => $panelFont ,-size=>$sys{panelTwo_fontsize} || 8,],
  398. -relief => 'sunken',
  399. )->pack(
  400. -expand => 1,
  401. -fill => 'both',
  402. -side => $sys{panelTwo_side} || 'top',
  403. );
  405. # button frame, removed
  406. #$self->{btn_frame} = $self->{mw}->Frame(
  407. # #-bg=>'black'
  408. #)->pack(
  409. # -side => 'right',
  410. # -expand => 0,
  411. # -fill => 'y',
  412. #);
  414. ### Binding ###
  415. $self->{mw}->bind('all', '<Alt-p>' =>  [&OnExit, $self]);
  416. $self->{mw}->bind('all', '<Alt-m>' => [&OpenMap, $self]);
  417. $self->{mw}->bind('all', '<Control-Shift-C>' => sub{ Commands::run("reload config") });
  418. $self->{mw}->bind('all', '<Control-Shift-W>' => sub{ Commands::run("reload mon_control") });
  419. $self->{mw}->bind('all', '<Control-Shift-Q>' => sub{ Commands::run("reload items_control") });
  420. $self->{mw}->bind('all', '<Control-Shift-E>' => sub{ Commands::run("reload avoid") });
  421. $self->{mw}->bind('all', '<Control-Shift-Z>' => sub{ Commands::run("reload timeouts") });
  422. $self->{mw}->bind('all', '<Control-Shift-V>' => sub{ Commands::run("reload pickupitems") });
  423. $self->{mw}->bind('all', '<Control-Shift-T>' => sub{ Commands::run("reload chat_resp") });
  424. $self->{mw}->bind('all', '<Control-Shift-A>' => sub{ Commands::run("reload all") });
  425. $self->{mw}->bind('all', '<Alt-d>' =>  sub{ Commands::run("s") });
  426. $self->{mw}->bind('all', '<Alt-x>' =>  sub{ Commands::run("storage") });
  427. $self->{mw}->bind('all', '<Alt-s>' =>  sub{ Commands::run("skills") });
  428. $self->{mw}->bind('all', '<Alt-q>' =>  sub{ Commands::run("i eq") });
  429. $self->{mw}->bind('all', '<Alt-a>' =>  sub{ Commands::run("st") });
  430. $self->{mw}->bind('all', '<Alt-e>' =>  sub{ Commands::run("i u") });
  431. $self->{mw}->bind('all', '<Alt-w>' =>  sub{ Commands::run("i nu") });
  432. $self->{mw}->bind('all', '<Alt-z>' =>  sub{ Commands::run("exp") });
  433. $self->{mw}->bind('all', '<Alt-c>' =>  sub{ Commands::run("i neq") });
  434. $self->{mw}->bind('all', '<Alt-f>' =>  sub{ Commands::run("guild info") });
  435. $self->{mw}->bind('all', '<Alt-g>' =>  sub{ Commands::run("guild member") });
  436. $self->{mw}->bind('all', '<Alt-h>' =>  [&showManual, $self]);
  438. $self->{input}->bind('<Up>' => [&inputUp, $self]);
  439. $self->{input}->bind('<Down>' => [&inputDown, $self]);
  440. $self->{input}->bind('<Return>' => [&inputEnter, $self]);
  441. $self->{input}->focus();
  443. if ($buildType == 0) {
  444. $self->{input}->bind('<MouseWheel>' => [&w32mWheel, $self, Ev('k'), "panelTwo"]);
  445. $self->{panelTwo}->bind('<MouseWheel>' => [&w32mWheel, $self, Ev('k'), "panelTwo"]);
  446. $self->{panelOne}->bind('<MouseWheel>' => [&w32mWheel, $self, Ev('k'), "panelOne"]);
  448. my $console;
  449. eval 'use Win32::Console; $console = new Win32::Console(STD_OUTPUT_HANDLE);';
  450. $console->Free();
  451. }
  453. $self->{mw}->raise();
  454. }
  456. sub inputUp {
  457. my $inputarea = shift; #this is redundant =
  458. my $self = shift;
  460. my $line;
  462. chomp($line = $self->{input}->get);
  463. unless ($self->{input_offset}) {
  464. $self->{input_list}[$self->{input_offset}] = $line;
  465. }
  466. $self->{input_offset}++;
  467. $self->{input_offset} -= $#{$self->{input_list}} + 1 while $self->{input_offset} > $#{$self->{input_list}};
  469. $self->{input}->delete('0', 'end');
  470. $self->{input}->insert('end', "$self->{input_list}[$self->{input_offset}]");
  471. }
  472. sub w32mWheel {
  473. my $action_area = shift;
  474. my $self = shift;
  475. my $zDist = shift;
  476. my $panel = shift;
  478. $self->{$panel}->yview('scroll', -int($zDist/40), "units");
  479. }
  480. sub inputDown {
  481. my $inputarea = shift; #this is redundant =
  482. my $self = shift;
  484. my $line;
  486. chomp($line = $self->{input}->get);
  487. unless ($self->{input_offset}) {
  488. $self->{input_list}[$self->{input_offset}] = $line;
  489. }
  490. $self->{input_offset}--;
  491. $self->{input_offset} += $#{$self->{input_list}} + 1 while $self->{input_offset} < 0;
  493. $self->{input}->delete('0', 'end');
  494. $self->{input}->insert('end', "$self->{input_list}[$self->{input_offset}]");
  495. }
  497. sub inputEnter {
  498. my $inputarea = shift; #this is redundant =
  499. my $self = shift;
  501. my $line;
  503. $line = $self->{input}->get;
  504. $self->{input}->delete('0', 'end');
  506. # add input to input history
  507. $self->{input_list}[0] = $line;
  508. unshift(@{$self->{input_list}}, "");
  510. # modify the input based on what modes we are using
  511. if ($line =~ /^/(.*)/) {
  512. $line = $1;
  513. } else {
  514. if ($self->{input_pm} eq "") {
  515. if ($self->{input_type} eq "Public") {
  516. $line = "c ".$line;
  517. } elsif ($self->{input_type} eq "Party"){
  518. $line = "p ".$line;
  519. } elsif ($self->{input_type} eq "Guild"){
  520. $line = "g ".$line;
  521. }
  522. } else {
  523. $self->pm_add($self->{input_pm});
  524. $line = "pm "$self->{input_pm}" $line";
  525. }
  526. }
  528. return unless defined $line;
  530. $self->{input_offset} = 0;
  532. # add to interface input queue for processing
  533. push(@{ $self->{input_que} }, $line);
  534. }
  536. sub updateHook {
  537. my $hookname = shift;
  538. my $r_args = shift;
  539. my $self = shift;
  540. return unless defined $self->{mw};
  541. $self->updatePos();
  542. $self->{mw}->update();
  543. $self->setAiText("@ai_seq");
  544. #if ($field{name} eq $config{lockMap} || !$config{lockMap}) {
  545. # $self->status_update("On Map: $field{name}");
  546. #} else {
  547. # $self->status_update("On Map: $field{name} | LockMap: $config{lockMap}");
  548. #}
  549. }
  551. sub updatePos {
  552. my $self = shift;
  553. return unless (defined $char && defined $char->{pos_to});
  554. my ($x,$y) = @{$char->{pos_to}}{'x', 'y'};
  555. $self->{status_posx}->configure( -text =>$x);
  556. $self->{status_posy}->configure( -text =>$y);
  557. if ($self->mapIsShown()) {
  558. # show player coords
  559. $self->{map}{'canvas'}->delete($self->{map}{'player'}) if ($self->{map}{'player'});
  560. $self->{map}{'player'} = $self->{map}{'canvas'}->createOval(
  561. $x-2,$self->{map}{'map'}{'y'} - $y-2,
  562. $x+2,$self->{map}{'map'}{'y'} - $y+2,
  563. ,-fill => '#ffcccc', -outline=>'#ff0000');
  564. $self->{map}{'canvas'}->delete($self->{map}{'dest'}) if ($self->{map}{'dest'});
  566. # show route destination
  567. my $action = AI::findAction("route");
  568. if (defined $action) {
  569. my $args = AI::args($action);
  570. if ($args->{dest}{map} eq $field{name}) {
  571. my ($x,$y) = @{$args->{dest}{pos}}{'x', 'y'};
  572. $self->{map}{'dest'} = $self->{map}{'canvas'}->createOval(
  573. $x-2,$self->{map}{'map'}{'y'} - $y-2,
  574. $x+2,$self->{map}{'map'}{'y'} - $y+2,
  575. ,-fill => '#0000ff', -outline=>'#ccccff');
  576. }
  577. }
  579. # show circle of attack range
  580. $self->{map}{'canvas'}->delete($self->{map}{'range'}) if ($self->{map}{'range'});
  581. my $dis = $config{'attackDistance'};
  582. $self->{map}{'range'} = $self->{map}{'canvas'}->createOval(
  583. $x-$dis,$self->{map}{'map'}{'y'} - $y-$dis,
  584. $x+$dis,$self->{map}{'map'}{'y'} - $y+$dis,
  585. ,-outline=>'#ff0000');
  586. }
  587. }
  589. sub status_update {
  590. my $self = shift;
  591. my $text = shift;
  592. $self->{status_gen}->configure(-text => $text);
  593. }
  595. sub setAiText {
  596. my $self = shift;
  597. my ($text) = shift;
  598. $self->{status_ai}->configure(-text => $text);
  599. }
  601. sub OnExit {
  602. my $self = shift;
  603. if ($conState) {
  604. push(@{ $self->{input_que} }, "n");
  605. quit();
  606. } else {
  607. exit();
  608. }
  609. }
  611. sub showManual {
  612. my $self = shift;
  613. $self->{ShellExecute}->Call(0, '', 'http://openkore.sourceforge.net/manual/', '', '', 1);
  614. }
  616. sub change_fontWeight {
  617. my $self = shift;
  618. my $panelFont = $sys{panelFont} || 'Verdana';
  619. if ($self->{is_bold}) {
  620. $self->{panelOne}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'bold']);
  621. $self->{panelTwo}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'bold']);
  622. $self->{input}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'bold']);
  623. }else{
  624. $self->{panelOne}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'normal']);
  625. $self->{panelTwo}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'normal']);
  626. $self->{input}->configure(-font=>[-family => $panelFont ,-size=>10,-weight=>'normal']);
  627. }
  628. }
  630. sub pm_add {
  631. my $self = shift;
  632. my $name = shift;
  633. $self->{pminput}->insert("end",$name) if !defined binFind($self->{pminput}->get(0,'end'), $name);
  634. }
  636. # map functions
  638. sub OpenMap {
  639. my ($self, $param2) = @_;
  640. $self = $param2 if ($param2);
  642. if (!exists $self->{map}) {
  643. undef $self->{obj};
  644. my ($x,$y);
  645. $self->{map} = $self->{mw}->Toplevel();
  646. $self->{map}->transient($self->{mw});
  647. $self->{map}->title("Map View : ".$field{name});
  648. $self->{map}->protocol('WM_DELETE_WINDOW', 
  649. sub {
  650. undef $self->{obj};
  651. $self->{map}->destroy();
  652. delete $self->{map};
  653. }
  654. );
  655. $self->{map}->resizable(0,0);
  656. $self->{map}{'canvas'} = $self->{map}->Canvas(-width => 200, -height => 200,-background => 'white')->pack(-side => 'top');
  657. $self->loadMap;
  658. $x = $self->{status_posx}->cget(-text);
  659. $y = $self->{status_posy}->cget(-text);
  660. $self->{map}{'player'} = $self->{map}{'canvas'}->createOval(
  661. $x-2,$self->{map}{'map'}{'y'} - $y-2,
  662. $x+2,$self->{map}{'map'}{'y'} - $y+2,
  663. ,-fill => '#ffcccc', -outline=>'#ff0000');
  664. my $dis = $config{'attackDistance'};
  665. $self->{map}{'range'} = $self->{map}{'canvas'}->createOval(
  666. $x-$dis,$self->{map}{'map'}{'y'} - $y-$dis,
  667. $x+$dis,$self->{map}{'map'}{'y'} - $y+$dis,
  668. ,-outline=>'#ff0000');
  669. $self->{map}->bind('<1>', [&dblchk, $self, Ev('x') , Ev('y')]);
  670. $self->{map}->bind('<Motion>', [&pointchk, $self, Ev('x') , Ev('y')]); 
  671. } else {
  672. undef $self->{obj};
  673. $self->{map}->destroy();
  674. delete $self->{map};
  675. }
  676. }
  678. # map image loader functions
  680. sub _map {
  681. my $self = shift;
  682. return File::Spec->catfile($self->{mapDir}, @_);
  683. }
  685. sub loadMap {
  686. my $self = shift;
  687. $self->{map}{'canvas'}->delete('map');
  688. $self->{map}{'canvas'}->createText(50,20,-text =>'Processing..',-tags=>'map');
  690. my $name = $field{baseName};
  691. if (-f $self->_map("$name.jpg")) {
  692. require Tk::JPEG;
  693. $self->{map}{'map'} = $self->{map}{'canvas'}->Photo(-format => 'jpeg', -file=> $self->_map("$name.jpg"));
  694. } elsif (-f $self->_map("$name.png")) {
  695. require Tk::PNG;
  696. $self->{map}{'map'} = $self->{map}{'canvas'}->Photo(-format => 'png', -file=> $self->_map("$name.png"));
  697. } elsif (-f $self->_map("$name.gif")) {
  698. $self->{map}{'map'} = $self->{map}{'canvas'}->Photo(-format => 'gif', -file=> $self->_map("$name.gif"));
  699. } elsif (-f $self->_map("$name.bmp")) {
  700. $self->{map}{'map'} = $self->{map}{'canvas'}->Bitmap(-file => $self->_map("$name.bmp"));
  701. } else {
  702. $self->{map}{'map'} = $self->{map}{'canvas'}->Photo(-format => 'xpm', -data => Utils::xpmmake($field{width}, $field{height}, $field{rawMap}));
  703. }
  705. $self->{map}{'canvas'}->delete('map');
  706. $self->{map}{'canvas'}->createImage(2,2,-image =>$self->{map}{'map'},-anchor => 'nw',-tags=>'map');
  707. $self->{map}{'canvas'}->configure(
  708. -width => $field{'width'},
  709. -height => $field{'height'}
  710. );
  711. $self->{map}{'map'}{'x'} = $field{'width'};
  712. $self->{map}{'map'}{'y'} = $field{'height'};
  713. }
  715. # mouse moving over map viewer shows coordinates
  716. sub pointchk {
  717. my $actionArea = shift;
  718. my $self = shift;
  719. my $mvcpx = $_[0];
  720. my $mvcpy = $self->{map}{'map'}{'y'} - $_[1];
  721. $self->{map}->title("Map View : ".$field{'name'}." [$mvcpx , $mvcpy]");
  722. $self->{map}->update;
  723. }
  725. # click on map viewer to move to coordinates
  726. sub dblchk {
  727. my $actionarea = shift;
  728. my $self = shift;
  729. my $mvcpx = $_[0];
  730. my $mvcpy = $self->{map}{'map'}{'y'} - $_[1];
  731. push(@{$self->{input_que}}, "move $mvcpx $mvcpy"); 
  732. } 
  734. sub mapIsShown {
  735. my $self = shift;
  736. return defined $self->{map};
  737. }
  739. sub addObj {
  740. my $self = shift;
  741. my ($id,$type) = @_;
  742. my ($fg,$bg);
  743. return if (!$self->mapIsShown());
  744. if ($type eq "npc") {
  745. $fg = "#ABD5BD";
  746. $bg = "#005826";
  747. }elsif ($type eq "m") {
  748. $fg = "#A9D3E3";
  749. $bg = "#0076A3";
  750. }elsif ($type eq "p") {
  751. $fg = "#FFFFCC";
  752. $bg = "#FF6600";
  753. }else {
  754. $fg = "#666666";
  755. $bg = "#FF6600";
  756. }
  757. $self->{objc}{$id}[0] = $fg;
  758. $self->{objc}{$id}[1] = $bg;
  759. }
  761. sub moveObj {
  762. my $self = shift;
  763. return if (!$self->mapIsShown());
  764. my ($id,$type,$x,$y,$newx,$newy) = @_;
  765. my $range;
  766. if ($self->{obj}{$id}){
  767. $self->{map}{'canvas'}->delete($self->{obj}{$id});
  768. } else {
  769. $self->addObj($id,$type);
  770. }
  771. if (defined $newx && defined $newy) {
  772. $x = $newx;
  773. $y = $newy;
  774. }
  775. $self->{obj}{$id} = $self->{map}{'canvas'}->createOval(
  776. $x-2,$self->{map}{'map'}{'y'} - $y-2,
  777. $x+2,$self->{map}{'map'}{'y'} - $y+2,
  778. ,-fill => $self->{objc}{$id}[0], -outline=>$self->{objc}{$id}[1]); 
  779. }
  781. sub removeObj {
  782. my $self = shift;
  783. my ($id) = shift;
  784. return if (!$self->{obj}{$id} || !$self->mapIsShown());
  785. $self->{map}{'canvas'}->delete($self->{obj}{$id});
  786. undef $self->{obj}{$id};
  787. }
  789. sub removeAllObj {
  790. my $self = shift;
  791. return if (!$self->mapIsShown());
  792. foreach (keys %{$self->{obj}}) {
  793. $self->{map}{'canvas'}->delete($self->{obj}{$_}) if ($self->{obj}{$_});
  794. undef $self->{obj}{$_};
  795. }
  796. }
  798. # FIXME: the color specified here is never used
  799. sub followObj {
  800. my $self = shift;
  801. return if (!$self->mapIsShown());
  802. my ($id, $type) = @_;
  803. $self->{objc}{$id}[0] = "#FFCCFF";
  804. $self->{objc}{$id}[1] = "#CC00CC";
  805. }
  807. # load color tags
  809. sub resetColors {
  810. my $hookname = shift;
  811. my $r_args = shift;
  812. my $self = shift;
  813. return if $hookname ne 'postloadfiles';
  814. my $colors_loaded = 0;
  815. foreach my $filehash (@{ $r_args->{files} }) {
  816. if ($filehash->{file} =~ /consolecolors.txt$/) {
  817. $colors_loaded = 1;
  818. last;
  819. }
  820. }
  821. return unless $colors_loaded;
  822. my %gdefault = (-foreground => 'grey', -background => 'black');
  823. eval {
  824. $self->{panelOne}->configure(%gdefault);
  825. $self->{panelTwo}->configure(%gdefault);
  826. $self->{input}->configure(%gdefault);
  827. $self->{pminput}->configure(%gdefault);
  828. $self->{sinput}->configure(%gdefault);
  829. };
  830. if ($@) {
  831. if ($@ =~ /unknown color name "(.*)" at/) {
  832. Log::message("Color '$1' not recognised.n");
  833. return undef if !$consoleColors{''}{'useColors'}; #don't bother throwing a lot of errors in the next section.
  834. } else {
  835. die $@;
  836. }
  837. }
  838. foreach my $type (keys %consoleColors) {
  839. next if $type eq '';
  840. my %tdefault =%gdefault;
  841. if ($consoleColors{''}{'useColors'} && $consoleColors{$type}{'default'}) {
  842. $consoleColors{$type}{'default'} =~ m|([^/]*)(?:/(.*))?|;
  843. $tdefault{-foreground} = defined($1) && $1 ne 'default' ? $1 : $gdefault{-foreground};
  844. $tdefault{-background} = defined($2) && $2 ne 'default' ? $2 : $gdefault{-background};
  845. }
  846. eval {
  847. # FIXME: loading colors for both panels is pointless
  848. $self->{panelOne}->tagConfigure($type, %tdefault);
  849. $self->{panelTwo}->tagConfigure($type, %tdefault);
  850. };
  851. if ($@) {
  852. if ($@ =~ /unknown color name "(.*)" at/) {
  853. Log::message("Color '$1' not recognised in consolecolors.txt at [$type]: default.n");
  854. } else {
  855. die $@;
  856. }
  857. }
  858. foreach my $domain (keys %{ $consoleColors{$type} }) {
  859. my %color = %tdefault;
  860. if ($consoleColors{''}{'useColors'} && $consoleColors{$type}{$domain}) {
  861. $consoleColors{$type}{$domain} =~ m|([^/]*)(?:/(.*))?|;
  862. $color{-foreground} = defined($1) && $1 ne 'default' ? $1 : $tdefault{-foreground};
  863. $color{-background} = defined($2) && $2 ne 'default' ? $2 : $tdefault{-background};
  864. }
  865. eval {
  866. # FIXME: loading colors for both panels is pointless
  867. $self->{panelOne}->tagConfigure("$type.$domain", %color);
  868. $self->{panelTwo}->tagConfigure("$type.$domain", %color);
  869. };
  870. if ($@) {
  871. if ($@ =~ /unknown color name "(.*)" at/) {
  872. Log::message("Color '$1' not recognised in consolecolors.txt at [$type]: $domain.n");
  873. } else {
  874. die $@;
  875. }
  876. }
  877. }
  878. }
  881. # FIXME: find a better spot to fix the initial window scrolling
  882. $self->{panelOne}->see('end');
  883. $self->{panelTwo}->see('end');
  884. }
  886. # packet parsing hook
  887. # maybe this should be replaced by proper hooks in the future
  889. sub packet {
  890. my $hookName = shift;
  891. my $args = shift;
  892. my $self = shift;
  893. my $switch = $args->{switch};
  894. my $msg = $args->{msg};
  896. if ($switch eq "0071") {
  897. #0071 <character ID> l <map name> 16B <ip> l <port> w 
  898. #Character selection success & map name & game IP/port
  899. my ($map_name) = substr($msg, 6, 16) =~ /([sS]*?)00/;
  900. ($map_name) = $map_name =~ /([sS]*)./;
  901. if (!$config{lockMap} || $map_name eq $config{lockMap}) {
  902. $self->status_update("On Map : $map_name");
  903. } else {
  904. $self->status_update("On Map : $map_name | LockMap : $config{lockMap}");
  905. }
  907. #} elsif ($switch eq "0073") {
  908. # #0073 <server tick> l <coordinate> 3B? 2B 
  909. # #Game connection success & server side 1ms clock & appearance position
  910. # my %pos;
  911. # makeCoords(%pos, substr($msg, 6, 3));
  912. # $self->updatePos($pos{x},$pos{y});
  914. } elsif ($switch eq "0078" || $switch eq "01D8") {
  915. #0078 <ID> l <speed> w <opt1> w <opt2> w <option> w <class> w <hair> w <weapon> w <head option bottom> w <shield> w <head option top> w <head option mid> w <hair color> w? W <head dir> w <guild> l <emblem> l <manner> w <karma> B <sex> B <X_Y_dir> 3B? B? B <sit> B <Lv> B
  916. #01d8 <ID>.l <speed>.w <opt1>.w <opt2>.w <option>.w <class>.w <hair>.w <item id1>.w <item id2>.w <head option bottom>.w <head option top>.w <head option mid>.w <hair color>.w ?.w <head dir>.w <guild>.l <emblem>.l <manner>.w <karma>.B <sex>.B <X_Y_dir>.3B ?.B ?.B <sit>.B <Lv>.B ?.B
  917. #0078 mainly is monster , portal
  918. #01D8 = npc + player for episode 4+
  919. my $ID = substr($msg, 2, 4);
  920. my $type = unpack("v*",substr($msg, 14,  2));
  921. my $pet = unpack("C*",substr($msg, 16,  1));
  922. my %coords;
  923. makeCoords(%coords, substr($msg, 46, 3));
  925. if ($jobs_lut{$type}) {
  926. if (!$players{$ID}) {
  927. $self->addObj($ID,"p");
  928. }
  929. } elsif ($type >= 1000) {
  930. if ($pet) {
  931. if ($monsters{$ID}) {
  932. $self->removeObj($ID);
  933. }
  934. } else {
  935. $self->addObj($ID,"m");
  936. }
  937. } elsif ($type < 1000) {
  938. if (!$npcs{$ID}) {
  939. $self->addObj($ID,"npc");
  940. }
  941. }
  942. $self->moveObj($ID,"un",$coords{x},$coords{y}) if ($type != 45 && !$pet);
  944. } elsif ($switch eq "0079" || $switch eq "01D9") {
  945. #0079 <ID>.l <speed>.w <opt1>.w <opt2>.w <option>.w <class>.w <hair>.w <weapon>.w <head option bottom>.w <sheild>.w <head option top>.w <head option mid>.w <hair color>.w ?.w <head dir>.w <guild>.l <emblem>.l <manner>.w <karma>.B <sex>.B <X_Y_dir>.3B ?.B ?.B <Lv>.B
  946. #01d9 <ID>.l <speed>.w <opt1>.w <opt2>.w <option>.w <class>.w <hair>.w <item id1>.w <item id2>.w.<head option bottom>.w <head option top>.w <head option mid>.w <hair color>.w ?.w <head dir>.w <guild>.l <emblem>.l <manner>.w <karma>.B <sex>.B <X_Y_dir>.3B ?.B ?.B <Lv>.B ?.B
  947. #For boiling Character inside the indicatory range of teleport and the like, it faces and is not attached Character information? 
  948. my $ID = substr($msg, 2, 4);
  949. my %coords;
  950. makeCoords(%coords, substr($msg, 46, 3));
  951. $self->moveObj($ID,"p",$coords{x},$coords{y});
  953. } elsif ($switch eq "007B" || $switch eq "01DA" || $switch eq "0086") {
  954. #007b <ID> l <speed> w <opt1> w <opt2> w <option> w <class> w <hair> w <weapon> w <head option bottom> w <server tick> l <shield> w <head option top> w <head option mid> w <hair color> w? W <head dir> w <guild> l <emblem> l <manner> w <karma> B <sex> B <X_Y_X_Y> 5B? B? B? B <Lv> B 
  955. #01da <ID>.l <speed>.w <opt1>.w <opt2>.w <option>.w <class>.w <hair>.<item id1>.w <item id2>.w <head option bottom>.w <server tick>.l <head option top>.w <head option mid>.w <hair color>.w ?.w <head dir>.w <guild>.l <emblem>.l <manner>.w <karma>.B <sex>.B <X_Y_X_Y>.5B ?.B ?.B ?.B <Lv>.B ?.B
  956. #Information of Character movement inside indicatory range
  957. my $ID = substr($msg, 2, 4);
  958. my %coordsFrom;
  959. makeCoords(%coordsFrom, substr($msg, 50, 3));
  960. my %coordsTo;
  961. makeCoords2(%coordsTo, substr($msg, 52, 3));
  962. my $type = unpack("v1",substr($msg, 14,  2));
  963. my $pet = unpack("C1",substr($msg, 16,  1));
  965. if ($jobs_lut{$type}) {
  966. if (!$players{$ID}) {
  967. $self->addObj($ID,"p");
  968. }
  969. } elsif ($type >= 1000) {
  970. if ($pet) {
  971. if ($monsters{$ID}) {
  972. $self->removeObj($ID);
  973. }
  974. } else {
  975. if (!$monsters{$ID}) {
  976. $self->addObj($ID,"m");
  977. }
  978. }
  979. }
  980. $self->moveObj($ID,"un",$coordsFrom{x},$coordsFrom{y},$coordsTo{x},$coordsTo{y});
  982. } elsif ($switch eq "007C") {
  983. #007c <ID> l <speed> w? 6w <class> w? 7w <X_Y> 3B? 2B 
  984. #Character information inside the indicatory range for NPC
  985. my $ID = substr($msg, 2, 4);
  986. my %coords;
  987. makeCoords(%coords, substr($msg, 36, 3));
  988. my $type = unpack("v*",substr($msg, 20,  2));
  989. if ($jobs_lut{$type}) {
  990. $self->addObj($ID,"p");
  991. } elsif ($type >= 1000) {
  992. $self->addObj($ID,"m");
  993. }
  994. $self->moveObj($ID,"un",$coords{x},$coords{y});
  996. } elsif ($switch eq "0080") {
  997. #0080 <ID> l <type> B
  998. #Character Status (include other)
  999. my $ID = substr($msg, 2, 4);
  1000. $self->removeObj($ID);
  1002. #} elsif ($switch eq "0087") {
  1003. # #0087 <server tick> l <X_Y_X_Y> 5B? B 
  1004. # #Movement response 
  1005. # my %coordsFrom;
  1006. # makeCoords(%coordsFrom, substr($msg, 6, 3));
  1007. # my %coordsTo;
  1008. # makeCoords2(%coordsTo, substr($msg, 8, 3));
  1009. # $self->updatePos($coordsTo{x},$coordsTo{y});
  1011. } elsif ($switch eq "0091") {
  1012. #0091 <map name> 16B <X> w <Y> w 
  1013. #Business such as movement, teleport and fly between maps inside 
  1014. my ($map_name) = substr($msg, 2, 16) =~ /([sS]*?)00/;
  1015. ($map_name) = $map_name =~ /([sS]*)./;
  1016. if ($map_name ne $field{name}) {
  1017. eval {
  1018. $field = new Field(name => $map_name);
  1019. if (!$config{lockMap} || $map_name eq $config{lockMap}) {
  1020. $self->status_update("On Map : $map_name");
  1021. } else {
  1022. $self->status_update("On Map : $map_name | LockMap : $config{lockMap}");
  1023. }
  1024. $self->loadMap() if ($self->mapIsShown());
  1025. };
  1026. if ($@) {
  1027. undef $field;
  1028. }
  1029. }
  1030. #my %coords;
  1031. #$coords{x} = unpack("v1", substr($msg, 18, 2));
  1032. #$coords{y} = unpack("v1", substr($msg, 20, 2));
  1033. #$self->updatePos($coords{x},$coords{y});
  1034. $self->removeAllObj();
  1036. } elsif ($switch eq "0092") {
  1037. #0092 <map name> 16B <X> w <Y> w <IP> l <port> w 
  1038. #Movement between
  1039. my ($map_name) = substr($msg, 2, 16) =~ /([sS]*?)00/;
  1040. ($map_name) = $map_name =~ /([sS]*)./;
  1041. if ($map_name ne $field{'name'}) {
  1042. eval {
  1043. $field = new Field(name => $map_name);
  1044. $self->loadMap() if ($self->mapIsShown());
  1045. $self->removeAllObj();
  1046. if (!$config{lockMap} || $map_name eq $config{lockMap}) {
  1047. $self->status_update("On Map : $map_name");
  1048. } else {
  1049. $self->status_update("On Map : $map_name | LockMap : $config{lockMap}");
  1050. }
  1051. };
  1052. if ($@) {
  1053. undef $field;
  1054. }
  1055. }
  1057. } elsif ($switch eq "0097") {
  1058. # Private message
  1059. my $msg_size = length($msg);
  1060. my $newmsg;
  1061. main::decrypt($newmsg, substr($msg, 28, length($msg)-28));
  1062. $msg = substr($msg, 0, 28) . $newmsg;
  1063. my ($privMsgUser) = substr($msg, 4, 24) =~ /([sS]*?)00/;
  1064. my $privMsg = substr($msg, 28, $msg_size - 29);
  1065. $self->pm_add($privMsgUser);
  1067. } elsif ($switch eq "01A4") {
  1068. #01a4 < type >.B < ID >.l < val >.l 
  1069. #pet spawn
  1070. my $ID = substr($msg, 3, 4);
  1071. if ($monsters{$ID}) {
  1072. $self->removeObj($ID);
  1073. }
  1074. }
  1075. }
  1078. 1;