| … | |
… | |
| 1409 | $refresh->(); |
1409 | $refresh->(); |
| 1410 | |
1410 | |
| 1411 | $vb |
1411 | $vb |
| 1412 | } |
1412 | } |
| 1413 | |
1413 | |
|
|
1414 | # just weirdness, pls. ignore |
|
|
1415 | sub load_html_page { |
|
|
1416 | my ($viewer, $base) = @_; |
|
|
1417 | |
|
|
1418 | $viewer->clear; |
|
|
1419 | |
|
|
1420 | require LWP::Simple; |
|
|
1421 | require HTML::Parser; |
|
|
1422 | require URI; |
|
|
1423 | |
|
|
1424 | my $page = LWP::Simple::get ($base) |
|
|
1425 | or return; |
|
|
1426 | |
|
|
1427 | my @s = { }; |
|
|
1428 | my %passthrough = map ($_ => undef), qw(b i u s tt big small sub sup); |
|
|
1429 | |
|
|
1430 | my $parser = HTML::Parser->new ( |
|
|
1431 | text_h => [sub { |
|
|
1432 | my ($text) = @_; |
|
|
1433 | $text =~ s/\s+/ /g; |
|
|
1434 | $s[-1]{text} .= CFClient::UI::Label::escape $text; |
|
|
1435 | }, "dtext"], |
|
|
1436 | start_h => [sub { |
|
|
1437 | my ($tag, $attr) = @_; |
|
|
1438 | if ($passthrough{$tag}) { |
|
|
1439 | $s[-1]{text} .= "<$tag>"; |
|
|
1440 | } elsif ($tag eq "h1") { |
|
|
1441 | push @s, { text => "<span foreground='#ffff00' size='x-large'>" }; |
|
|
1442 | } elsif ($tag eq "h2") { |
|
|
1443 | push @s, { text => "<span foreground='#ccccff' size='large'>" }; |
|
|
1444 | } elsif ($tag eq "h3") { |
|
|
1445 | push @s, { text => "<span size='large'>" }; |
|
|
1446 | } elsif ($tag eq "a") { |
|
|
1447 | push @s, { text => "", url => $attr->{href} }; |
|
|
1448 | } elsif ($tag eq "p") { |
|
|
1449 | push @s, { }; |
|
|
1450 | } elsif ($tag eq "img") { |
|
|
1451 | eval { |
|
|
1452 | push @{$s[-1]{obj}}, new CFClient::UI::Image |
|
|
1453 | tex => (new_from_image CFClient::Texture LWP::Simple::get (URI->new ($attr->{src}, $base)->abs ($base))); |
|
|
1454 | $s[-1]{text} .= "\x{fffc}"; |
|
|
1455 | }; |
|
|
1456 | } |
|
|
1457 | }, "tagname, attr"], |
|
|
1458 | end_h => [sub { |
|
|
1459 | my ($tag) = @_; |
|
|
1460 | if ($passthrough{$tag}) { |
|
|
1461 | $s[-1]{text} .= "</$tag>"; |
|
|
1462 | } elsif ($tag =~ /^h\d$/) { |
|
|
1463 | $s[-1]{text} .= "</span>"; |
|
|
1464 | push @s, { }; |
|
|
1465 | } elsif ($tag eq "a") { |
|
|
1466 | my $S = pop @s; |
|
|
1467 | $s[-1]{text} .= "\x{fffc}"; |
|
|
1468 | push @{$s[-1]{obj}}, new CFClient::UI::Label |
|
|
1469 | fg => [0.8, 0.8, 1], |
|
|
1470 | markup => "<u>$S->{text}</u>", |
|
|
1471 | fontsize => 0.8, |
|
|
1472 | can_events => 1, |
|
|
1473 | can_focus => 1, |
|
|
1474 | on_button_up => sub { |
|
|
1475 | load_html_page ($viewer, URI->new ($S->{url}, $base)->abs ($base)); |
|
|
1476 | }, |
|
|
1477 | ; |
|
|
1478 | } |
|
|
1479 | }, "tagname"], |
|
|
1480 | ); |
|
|
1481 | |
|
|
1482 | $parser->parse ($page); |
|
|
1483 | $parser->eof; |
|
|
1484 | |
|
|
1485 | $viewer->add_paragraph ([1, 1, 1, 1], [$_->{text}, @{ $_->{obj} || [] }], $_->{indent}) |
|
|
1486 | for @s; |
|
|
1487 | |
|
|
1488 | $viewer->set_offset (0); |
|
|
1489 | } |
|
|
1490 | |
| 1414 | sub help_window { |
1491 | sub help_window { |
| 1415 | my $win = new CFClient::UI::FancyFrame |
1492 | my $win = new CFClient::UI::FancyFrame |
| 1416 | x => 'center', |
1493 | x => 'center', |
| 1417 | y => 'center', |
1494 | y => 'center', |
| 1418 | z => 2, |
1495 | z => 2, |
| … | |
… | |
| 1436 | [manual => "Main Manual"], |
1513 | [manual => "Main Manual"], |
| 1437 | [skill_help => "Skill Reference"], |
1514 | [skill_help => "Skill Reference"], |
| 1438 | [command_help => "Command Reference"], |
1515 | [command_help => "Command Reference"], |
| 1439 | [dmcommand_help => "DM Commands"], |
1516 | [dmcommand_help => "DM Commands"], |
| 1440 | [COPYING => "License Terms"], |
1517 | [COPYING => "License Terms"], |
|
|
1518 | [test => "test (do not select)"], #d#TODO |
| 1441 | ], |
1519 | ], |
| 1442 | on_changed => sub { |
1520 | on_changed => sub { |
| 1443 | my ($self, $pod) = @_; |
1521 | my ($self, $pod) = @_; |
|
|
1522 | |
|
|
1523 | if ($pod eq "test") {#d#TODO |
|
|
1524 | eval { |
|
|
1525 | load_html_page $viewer, "http://crossfire.real-time.com/guides/walkthrough/newbie-tower.html"; |
|
|
1526 | }; |
|
|
1527 | warn "$@" if $@; |
|
|
1528 | return; |
|
|
1529 | } |
| 1444 | |
1530 | |
| 1445 | my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod", |
1531 | my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod", |
| 1446 | doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] }; |
1532 | doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] }; |
| 1447 | |
1533 | |
| 1448 | $viewer->clear; |
1534 | $viewer->clear; |
