1: #!/usr/bin/perl 2: package Earthdawn::Format::Character; 3: use strict; 5: # begin module initialization 6: use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $REVISION); 7: BEGIN { 8: $VERSION = 0.3; 9: $REVISION = q$Revision: $; 10: @ISA = qw(Exporter); 11: @EXPORT = (); 12: @EXPORT_OK = (); 13: %EXPORT_TAGS = (); 14: } 15: use Exporter; 16: # end module initialization 18: use Earthdawn::Format::Shared qw(:helpers :handlers $output); 19: use Earthdawn::Format::Helpers qw(:helpers); 21: my $debug = 0; 22: my $EDdir = "/home/xethair/RolePlaying/Earthdawn"; 25: sub install_handlers { 26: my ($eng) = @_; 28: $eng->mode_set('DEFAULT'); 29: $eng->element('CHAR', sub { 30: my ($eng, $el) = @_; 31: $eng->mode_push('Character'); 32: $eng->process_content; 33: $output->print("\n</TABLE>\n</body></html>\n"); 34: $eng->mode_pop('Character'); 35: }); 37: $eng->mode_set('Character'); 38: $eng->element('CONCEPT', sub { 39: my ($eng, $el) = @_; 40: $eng->suppress_content; 41: }); 43: my %disciplines = (); 44: my $artsncnt; 45: $eng->element('GENINFO', sub { 46: my ($eng, $el) = @_; 47: my ($charname,$jname,$jlink,$jfile,$rinsert,$linsert,$discip); 48: $artsncnt = 0; 49: $eng->mode_push('GeneralInfo'); 50: my %array = (collect_assoc($eng)); 51: $eng->mode_pop('GeneralInfo'); 52: $charname = $array{'NAME'}; 53: $jname = NormalizeFileName($charname); 54: $jlink = "../Journals/" . $jname . ".html"; 55: $jfile = $EDdir."/html/Journals/".$jname.".html"; 56: $rinsert = "<TD width=10%></TD>"; 57: $linsert = "<TD width=10%></TD>"; 58: if (-f $jfile) { 59: $rinsert = "<TD width=10%><A HREF='".$jlink."'><EM>Journal ". 60: "Available</EM></A></TD>"; 61: } 62: $output->print("<html> 63: <head> 64: <title>".$array{'NAME'}."</title> 65: </head> 66: <body background=\"../graphics/firering.gif\"> 67: <TABLE WIDTH=100% BORDER=1><TR> 68: <TR><TD align=center colspan=3> 69: <TABLE width=100% border=0> 70: <TR> 71: ".$linsert." 72: <TD align=center><H1>".$array{'NAME'}."</H1></TD> 73: ".$rinsert." 74: </TABLE> 75: </TD> 76: <TR> 77: <TD VALIGN=TOP><TABLE WIDTH=100% CELLSPACING=1 BORDER=1> 78: <TR><TD align=center colspan=4> 79: General Info 80: <TR><TD align=right> 81: Player </TD> 82: <TD align=left colspan=3> 83: ".$array{'PLAYER'}."</TD> 84: <TR><TD align=right> 85: Race </TD> 86: <TD align=left> 87: ".$array{'RACE'}."</TD> 88: <TD align=right> 89: Sex </TD> 90: <TD align=left> 91: ".$array{'SEX'}."</TD> 92: <TR><TD align=right> 93: Weight </TD> 94: <TD align=left> 95: ".$array{'WEIGHT'}."</TD> 96: <TD align=right> 97: Height </TD> 98: <TD align=left> 99: ".$array{'HEIGHT'}."</TD> 100: <TR><TD align=right> 101: Eyes </TD> 102: <TD align=left> 103: ".$array{'EYES'}."</TD> 104: <TD align=right> 105: Age </TD> 106: <TD align=left> 107: ".$array{'AGE'}."</TD> 108: <TR><TD align=right> 109: Hair </TD> 110: <TD align=left> 111: ".$array{'HAIR'}."</TD> 112: <TD align=right> 113: Skin </TD> 114: <TD align=left> 115: ".$array{'SKIN'}."</TD> 116: 117: <TR><TD align=left colspan=3> Discipline</TD><TD align=center>Circle</TD> 118: "); 119: foreach $discip (keys %disciplines) { 120: $output->print(" 121: <TR><TD align=center colspan=3> $discip </TD> 122: <TD align=center> ".$disciplines{$discip}." </TD> 123: "); 124: } 125: $output->print("\n </TABLE></TD>\n"); 126: }); 127: 128: $eng->element('SPECINFO', sub { 129: my ($eng, $el) = @_; 130: $eng->mode_push('SpecificInfo'); 131: $eng->process_content; 132: $eng->mode_pop('SpecificInfo'); 133: }); 134: $eng->element('THREADS', sub { 135: my ($eng, $el) = @_; 136: $output->print("<TR><TD COLSPAN=3><TABLE WIDTH=100% BORDER=1>\n". 137: "<TR><TD>Rank</TD><TD>Target</TD><TD>Effects</TD>". 138: "</TR>\n"); 139: $eng->mode_push('Threads'); 140: # my %array = (collect_assoc($eng)); 141: $eng->process_content; 142: $eng->mode_pop('Threads'); 143: $output->print("</TABLE></TD></TR>\n"); 144: }); 145: $eng->element('LEGEND', sub { 146: my ($eng, $el) = @_; 147: $eng->mode_push('LegendPoints'); 148: $eng->process_content; 149: $eng->mode_pop('LegendPoints'); 150: }); 151: $eng->element('EXTRA', sub { 152: my ($eng, $el) = @_; 153: $output->print("<TR><TD colspan=3><H3 align=center>Additional", 154: " (Mechanics) Information</H3>\n"); 155: $eng->process_content; 156: $output->print("</TD></TR>\n"); 157: }); 159: my @eqentries; 160: $eng->element('EQUIPMNT', sub { 161: my ($eng, $el) = @_; 162: @eqentries = (); 163: $eng->mode_push('Equipment'); 164: $eng->process_content; 165: $eng->mode_pop('Equipment'); 166: my ($numcols, $numents, $numrows, $r); 167: $numcols = 2; 168: $numents = $#eqentries + 1; 169: $numrows = ($numents+$numcols-($numents % $numcols)) / $numcols; 170: $output->print("<TR><TD colspan=3><TABLE WIDTH=100% BORDER=0 cellspacing=0>\n"); 171: $output->print(" <TR><TD colspan=2 ALIGN=CENTER>Equipment</TD>\n </TR><TR>"); 172: for ($r=0; $r < $numents; $r++) { 173: $output->print(" <TD valign=top><TABLE WIDTH=100% BORDER=1>\n") 174: if ($r % $numrows == 0); 175: $output->print(" <TR>$eqentries[$r]\n"); 176: $output->print(" </TABLE></TD>\n") 177: if (($r+1) % $numrows == 0); 178: } 179: $output->print(" </TABLE></TD>\n") unless ($r % $numrows == 0); 180: $output->print(" </TABLE></TD>\n</TR>\n"); 181: }); 182: $eng->element('DETAIL', sub { 183: my ($eng, $el) = @_; 184: $eng->mode_push('Detailing'); 185: $eng->process_content; 186: $eng->mode_pop('Detailing'); 187: }); 188: 190: ############################################################ 191: $eng->mode_set('GeneralInfo'); 193: $eng->element([qw(NAME PLAYER SEX AGE HEIGHT WEIGHT SKIN HAIR EYES)], 194: assoc_store_handler()); 195: $eng->element('DISCIPS', sub { 196: my ($eng, $el) = @_; 197: %disciplines = (collect_assoc($eng)); 198: }); 199: $eng->element('DISCIP', sub { 200: my ($eng, $el) = @_; 201: my $discip = collect_content($eng); 202: collect_this($discip, $el->{'Attributes'}->{'CIRCLE'}); 203: }); 204: $eng->element('PHYSCHAR', sub { 205: my ($eng, $el) = @_; 206: $eng->process_content; 207: }); 208: my (%raceadj,%kinfo); 209: $eng->element('RACE', sub { 210: my ($eng, $el) = @_; 211: my ($race,$racefile,$name); 212: %kinfo = %raceadj = (); 213: $race = collect_content($eng); 214: $racefile = $EDdir."/Races/".NormalizeFileName($race).".sgm"; 215: if (-f $racefile) { 216: ($name,$raceadj{'Dexterity'},$raceadj{'Strength'}, 217: $raceadj{'Toughness'},$raceadj{'Perception'}, 218: $raceadj{'Willpower'},$raceadj{'Charisma'},$kinfo{'MAX'}, 219: $kinfo{'COST'},$kinfo{'STEP'}) = 220: data_extract($racefile, [qw(NAME DEX STR TOU PER WIL 221: CHA MAX COST STEP)]); 222: } else { 223: warn 'FAILED to find race data for '.$race; 224: } 225: collect_this('RACE', $name); 226: }); 228: ############################################################ 229: $eng->mode_set('SpecificInfo'); 230: my %attr_step; # needed for talent calculations too 231: $eng->element('ATTRIBS', sub { 232: my ($eng, $el) = @_; 233: my (%attr_inc_str,%attr_val,$attr_format,$attr_name); 234: %attr_inc_str = (); 235: %attr_val = (); 236: $eng->mode_push('Attributes'); 237: # explicitly suppress content? 238: $eng->process_content_filter('attr-values'=>\%attr_val, 239: 'attr-increases'=>\%attr_inc_str); 240: $eng->mode_pop('Attributes'); 242: $attr_format = sub { # common code 243: my ($attr) = @_; 244: $output->print(" <TR><TD align=right> ",$attr); 245: $output->print("<SUP>", $attr_inc_str{$attr}, "</SUP>") 246: if ($attr_inc_str{$attr} || ''); 247: my $step = AttributeStepConvert($attr_val{$attr}); 248: $attr_step{$attr} = $step; 249: $output->print("</TD> <TD> ", $attr_val{$attr}, " </TD>\n", 250: " <TD>", $step, "</TD><TD>", 251: StepDice($step), "</TD>"); 252: }; 253: # format attribute section 254: $output->print(" 255: <TD VALIGN=TOP><TABLE WIDTH=100% CELLSPACING=1 BORDER=1> 256: <TR><TD align=center colspan=4> 257: Attributes</TD> 258: <TR><TD align=left> Physical</TD><TD>Value</TD><TD>Step</TD><TD>Dice</TD> 259: "); 261: foreach $attr_name ('Dexterity','Strength','Toughness') { 262: &$attr_format($attr_name); 263: } 264: $output->print(" 265: <TR><TD align=left> Mental</TD> 266: "); 267: foreach $attr_name ('Perception','Willpower','Charisma') { 268: &$attr_format($attr_name); 269: } 270: $output->print("\n </TABLE></TD>\n "); 271: }); 273: $eng->element('STATS', sub { 274: my ($eng, $el) = @_; 275: $eng->mode_push('Statistics'); 276: # explicitly suppress content? 277: my %stats = (); 278: $eng->process_content_filter('statistics'=>\%stats); 279: $eng->mode_pop('Statistics'); 280: $output->print(" 282: <TD VALIGN=TOP><TABLE WIDTH=100% CELLSPACING=1 BORDER=1> 283: <TR><TD ALIGN=CENTER colspan=4> 284: Combat Statistics</TD> 285: <TR><TD align=right>Physical Defense</TD> 286: <TD colspan=2 align=center> ",$stats{'PHYSICAL'}," </TD> 287: <TR><TD align=right>Spell Defense</TD> 288: <TD colspan=2 align=center> ",$stats{'SPELL'}," </TD> 289: <TR><TD align=right>Social Defense</TD> 290: <TD colspan=2 align=center> ",$stats{'SOCIAL'}," </TD> 291: <TR><TD align=right>Armor Physical/Mystic </TD> 292: <TD align=center> ",$stats{'NORMAL'}," </TD> 293: <TD align=center> ",$stats{'MYSTIC'}," </TD> 294: <TR> 295: <TR><TD alin=left>Movement</TD> 296: <TR><TD align=right>Normal Combat/Full</TD> 297: <TD align=center> ",$stats{'FOOT'.'COMBAT'}," </TD> 298: <TD align=center> ",$stats{'FOOT'.'FULL'}," </TD> 299: <TR><TD align=right>Flying Combat/Full</TD> 300: <TD align=center> ",$stats{'FLIGHT'.'COMBAT'}," </TD> 301: <TD align=center> ",$stats{'FLIGHT'.'FULL'}," </TD> 302: <TR> 303: <TR><TD align=right>Max Carry/Lift</TD> 304: <TD align=center> ",$stats{'CARRY'}," </TD> 305: <TD align=center> ",$stats{'LIFT'}," </TD> 306: </TABLE></TD> 307: </TR> 309: <TR><TD colspan=3><TABLE width=100% border=1><TR> 310: <TD><STRONG>Karma</STRONG></TD> 311: <TD>Current: ",$stats{'CURRENT'}," </TD> 312: <TD>Maximum: ",$kinfo{'MAX'},"</TD> 313: <TD>Cost: ",$kinfo{'COST'},"</TD> 314: <TD>Step: ",$kinfo{'STEP'},"</TD> 315: <TD>Dice: ", StepDice($kinfo{'STEP'}), "</TD> 316: </TR></TABLE></TD></TR> 317: "); 318: }); 320: $eng->element('TALENTS', sub { 321: my ($eng, $el) = @_; 322: $output->print(" 323: <TR><TD colspan=3><TABLE width=100% border=1> 324: <TR><TD align=center colspan=9> 325: Talents</TD> 326: <TR><TD align=center>Talent</TD> 327: <TD align=center>Rank</TD> 328: <TD align=center>Base</TD> 329: <TD align=center>Step</TD> 330: <TD align=center>Dice</TD> 331: <TD align=center>Disc</TD> 332: <TD align=center>Karma</TD> 333: <TD align=center>Strain</TD> 334: <TD align=center>Action</TD> 335: "); 336: $eng->mode_push('Talents'); 337: $eng->process_content; 338: $eng->mode_pop('Talents'); 339: $output->print("\n </TABLE></TD>\n</TR>\n"); 340: }); 341: my (@knowledges,@knowlranks); 342: $eng->element('SKILLS', sub { 343: my ($eng, $el) = @_; 344: @knowledges = (); 345: @knowlranks = (); 346: $output->print(" 347: <TR><TD colspan=2 rowspan=2 VALIGN=TOP><TABLE width=100% border=1> 348: <TR><TD align=center colspan=8> 349: Skills</TD> 350: <TR><TD align=center>Skill</TD> 351: <TD align=center>Rank</TD> 352: <TD align=center>Base</TD> 353: <TD align=center>Step</TD> 354: <TD align=center>Dice</TD> 355: <TD align=center>Karma</TD> 356: <TD align=center>Strain</TD> 357: <TD align=center>Action</TD> 358: "); 359: $eng->mode_push('Skills'); 360: $eng->process_content; 361: $eng->mode_pop('Skills'); 362: $output->print("\n </TABLE>"); # close cell under Languages 363: }); 365: $eng->element('LANGUAGE', sub { 366: my ($eng, $el) = @_; 367: my (@readlang, @speaklang, $numrows, $i); 368: @readlang = (); 369: @speaklang = (); 370: $eng->mode_push('Languages'); 371: $eng->process_content_filter('lang-READ'=>\@readlang, 372: 'lang-SPEAK'=>\@speaklang); 373: $eng->mode_pop('Languages'); 374: $numrows = $#speaklang; 375: $numrows = $#readlang if ($#readlang > $#speaklang); 376: $numrows++; 377: $output->print(" 378: <TD colspan=1 VALIGN=TOP><TABLE width=100% border=1> 379: <TR><TD colspan=2 ALIGN=RIGHT>Languages</TD> 380: <TR><TD colspan=1 ALIGN=CENTER>Spoken</TD> 381: <TD colspan=1 ALIGN=CENTER>Read</TD>"); 382: for ($i=0 ; $i < $numrows ; $i++) { 383: $output->print(" <TR><TD ALIGN=RIGHT>",$speaklang[$i],"</TD>", 384: "<TD ALIGN=LEFT>",$readlang[$i],"</TD>\n"); 385: } 386: $output->print("\n </TABLE></TD>\n </TD>\n</TR>\n"); 387: #print Knowledge Skills saved from skills section 388: $numrows = $#knowledges + 1; 389: $output->print("<TR><TD VALIGN=TOP><TABLE width=100% border=1>", 390: "<TR><TD COLSPAN=2 ALIGN=RIGHT>Knowledges</TD>"); 391: for ($i=0; $i < $numrows; $i++) { 392: $output->print("<TR><TD ALIGN=CENTER>",$knowledges[$i],"</TD>", 393: "<TD ALIGN=CENTER>",$knowlranks[$i],"</TD>\n"); 394: } 395: $output->print("</TABLE></TD>\n"); 396: }); 398: ############################################################ 399: $eng->mode_set('Attributes'); 400: $eng->element('ATTHIST', sub { 401: my ($eng, $el) = @_; 402: $eng->process_content; 403: }); 404: $eng->element('ORIG', sub { 405: my ($eng, $el) = @_; 406: $eng->stack->{'attr-val'} = collect_content($eng); 407: }); 408: $eng->element('INC', sub { 409: my ($eng, $el) = @_; 410: my $inc = $eng->stack->{'attr-inc'}; 411: push @$inc, collect_content($eng); 412: }); 413: $eng->element([qw(DEX STR TOU PER WIL CHA)], sub { 414: my ($eng, $el) = @_; 415: my (@inc, $name, $val, $orig, $cur); 416: # get storage 417: my $attr_increases = $eng->stack->{'attr-increases'}; 418: my $attr_values = $eng->stack->{'attr-values'}; 419: # read content 420: @inc = (); 421: ($val) = $eng->process_content_filter('attr-val'=>'', 422: 'attr-inc'=>\@inc); 423: # calculate useful values 424: $name = $AttributeNames{$el->{'Name'}}; 425: die 'no attribute name' unless $name; 426: $orig = 0 + $val; 427: $cur = $orig + scalar(@inc) + ($raceadj{$name} || 0); 428: # store 429: $attr_values->{$name} = $cur; 430: $attr_increases->{$name} = '' . join ", ", @inc; 431: }); 433: ############################################################ 434: $eng->mode_set('Statistics'); 436: $eng->element([qw(DEFENSE ARMOR MOVEMENT STRENGTH KARMA)], sub { 437: my ($eng, $el) = @_; 438: $eng->process_content_filter('stat-category'=>$el->{'Name'}); 439: }); 440: $eng->element([qw(PHYSICAL SOCIAL SPELL NORMAL MYSTIC LIFT CARRY 441: CURRENT USED)], sub { 442: my ($eng, $el) = @_; 443: #my $cat = $eng->stack->{'stat-category'}; 444: my $stats = $eng->stack->{'statistics'}; 445: $stats->{$el->{'Name'}} = collect_content($eng); 446: }); 447: $eng->element(['FOOT','FLIGHT'], sub { 448: my ($eng, $el) = @_; 449: $eng->process_content_filter('stat-category'=>$el->{'Name'}); 450: }); 451: $eng->element(['COMBAT','FULL'], sub { 452: my ($eng, $el) = @_; 453: my $cat = $eng->stack->{'stat-category'}; 454: my $stats = $eng->stack->{'statistics'}; 455: $stats->{$cat . $el->{'Name'}} = collect_content($eng); 456: }); 458: ############################################################ 459: $eng->mode_set('Talents'); 461: $eng->element('TALENT', sub { 462: my ($eng, $el) = @_; 463: my ($talent,$rank,$base,@knacks,$talfile,$karma,$step, 464: %tal_data,$dice,$disc,$note); 465: @knacks = (); 466: $eng->stack->{'current-talent-knacks'} = \@knacks; 467: $talent = collect_content($eng); 468: $rank = $el->{'Attributes'}->{'RANK'}; 469: 470: %tal_data = lookup_talent($talent); 471: ($base,$step,$dice) = prep_talent(\%tal_data, $rank, \%attr_step); 472: $disc = '<EM>(Ign)</EM>'; # Need discipline parsing for these two 473: if (($el->{'Attributes'}->{'VERSATILITY'} || '') eq 'VERSATILITY') { 474: $note = 'V'; 475: } else { 476: $note = ''; 477: } 478: $output->print(" 479: <TR><TD align=left> ",($note ? "<SUP>".$note."</SUP>" : ""),$talent,"</TD> 480: <TD align=center> ",$rank," </TD> 481: <TD align=center> ",$base," </TD> 482: <TD align=center> ",$step," </TD> 483: <TD align=center> ",$dice," </TD> 484: <TD align=center> ",$disc," </TD> 485: <TD align=center> ",$tal_data{'karma'}," </TD> 486: <TD align=center> ",$tal_data{'strain'}," </TD> 487: <TD align=center> ",$tal_data{'action'}," </TD> 488: "); 489: if (@knacks) { 490: $output->print(" <TR><TD></TD><TD align=left colspan=8>"); 491: $output->print(join ', ', @knacks); 492: $output->print("</TD>\n"); 493: } 494: }); 496: $eng->element('KNACK', sub { 497: my ($eng, $el) = @_; 498: my ($knack, $knfile, $name, $rank); 499: my $knacks = $eng->stack->{'current-talent-knacks'}; 500: $knack = collect_content($eng); 501: $knfile = $EDdir . "/Knacks/" . NormalizeFileName($knack) . ".sgm"; 502: if (-f $knfile) { 503: ($name,$rank) = data_extract($knfile, [qw(NAME RANK)]); 504: $rank = '<sup>'.$rank.'</sup>'; 505: } else { 506: $name = $knack; 507: $rank = ''; 508: } 509: push (@$knacks,"<EM>".$name."</EM>".$rank); 510: }); 512: ############################################################ 513: $eng->mode_set('Skills'); 515: $eng->element('SKILL', sub { 516: my ($eng, $el) = @_; 517: my ($skill,$rank,%tal_data,$base,$step,$dice); 518: $skill = collect_content($eng); 519: $rank = $el->{'Attributes'}->{'RANK'}; 520: if (($el->{'Attributes'}->{'KNOWLEDGE'} || '') eq 'KNOWLEDGE') { 521: push(@knowledges,$skill); 522: push(@knowlranks,$rank); 523: return (); 524: } 525: #$talfile = $talent; 526: #$talfile = $EDdir."/Skills/".NormalizeFileName($talfile).".sgm"; 527: #if (! -f $talfile) { 528: # $talfile =~ s|/Skills/|/Talents/|; 529: #} 530: %tal_data = lookup_talent($skill); 531: ($base,$step,$dice) = prep_talent(\%tal_data, $rank, \%attr_step); 533: $output->print(" 534: <TR><TD align=left> ",$skill,"</TD> 535: <TD align=center> ",$rank," </TD> 536: <TD align=center> ",$base," </TD> 537: <TD align=center> ",$step," </TD> 538: <TD align=center> ",$dice," </TD> 539: <TD align=center> ",$tal_data{'karma'}," </TD> 540: <TD align=center> ",$tal_data{'strain'}," </TD> 541: <TD align=center> ",$tal_data{'action'}," </TD> 542: "); 543: }); 545: ############################################################ 546: $eng->mode_set('Languages'); 548: $eng->element(['READ','SPEAK'], sub { 549: my ($eng, $el) = @_; 550: my $lang = $eng->stack->{'lang-'.$el->{'Name'}}; 551: push @$lang, collect_content($eng); 552: }); 554: ############################################################ 555: $eng->mode_set('LegendPoints'); 556: 557: $eng->element('LPHIST', sub { 558: my ($eng, $el) = @_; 559: my ($lptotal,$krtotal,$lpspent,@lpentries,$numcols,$numents,$numrows, 560: $level); 561: @lpentries = (); 562: ($lptotal,$lpspent,$krtotal) = 563: $eng->process_content_filter('lptotal'=>0, 'lpspent'=>0, 564: 'krtotal'=>0, 565: 'lpentries'=>\@lpentries); 567: if ($lptotal < 10000) { 568: $level = "None"; 569: } elsif ($lptotal < 40000) { 570: $level = "One"; 571: } elsif ($lptotal < 160000) { 572: $level = "<EM>Two</EM>"; 573: } elsif ($lptotal < 640000) { 574: $level = "<STRONG>Three</STRONG>"; 575: } elsif ($lptotal < 2560000) { 576: $level = "<STRONG><EM>Four</EM></STRONG>"; 577: } else { 578: $level = "<STRONG><EM>FIVE</EM></STRONG>"; 579: } 580: $numcols = 3; 581: $numents = @lpentries; 582: $numrows = ($numents+$numcols-($numents % $numcols)) / $numcols; 583: $output->print("<TR><TD COLSPAN=3><TABLE WIDTH=100% BORDER=0>\n", 584: "<TR><TD>Current: ", ($lptotal - $lpspent), "</TD>\n", 585: "<TD>Total: ",$lptotal,"</TD>\n"); 586: if ($krtotal > 0) { 587: $output->print("<TD>Karma Used: ",$krtotal,"</TD>\n"); 588: } 589: $output->print("<TD>Legendary Status: ",$level,"</TD>\n", 590: "</TABLE></TD></TR>\n"); 591: #print "<TR><TD COLSPAN=3><TABLE WIDTH=100% BORDER=1><TR>"; 592: #for ($r=0; $r < $#lpentries+1; $r++) { 593: # print "<TD valign=top><TABLE WIDTH=100% BORDER=1>\n" 594: # if ($r % $numrows == 0); 595: # print "<TR>$lpentries[$r]\n"; 596: # print "</TABLE></TD>\n" if (($r+1) % $numrows == 0); 597: #} 598: #print "</TABLE></TD>\n" unless ($r % $numrows == 0); 599: #print "</TR></TABLE></TD></TR>\n"; 600: }); 601: $eng->element('LPENTRY', sub { 602: my ($eng, $el) = @_; 603: my $e = collect_content($eng); 604: warn 'LPENTRY['.$e."]\n"; 605: push @{ $eng->stack->{'lpentries'} }, $e; 606: }); 607: $eng->element('LP', sub { 608: my ($eng, $el) = @_; 609: warn "LP_PRE[".$output."]\n"; 610: my $lp = collect_content($eng); 611: if ($lp > 0) { 612: $eng->stack->{'lptotal'} += $lp; 613: } else { 614: $eng->stack->{'lpspent'} += - $lp; 615: } 616: $output->print("<TD ALIGN=RIGHT VALIGN=TOP>", $lp, "</TD>"); 617: warn "LP_POST[".$output."]\n"; 618: }); 619: $eng->element('NOTE', sub { 620: my ($eng, $el) = @_; 621: my $karma = $el->{'Attributes'}->{'KARMA'} || ''; 622: $output->print("<TD>"); 623: if ($karma && $karma > 0) { 624: $eng->stack->{'krtotal'} += $karma; 625: $eng->stack->{'lpspent'} += $kinfo{'COST'} * $karma; 626: $output->print("<SUP>",$karma,"</SUP>"); 627: } 628: $output->print(collect_content($eng),"</TD>"); 629: }); 631: ############################################################ 632: $eng->mode_set('Detailing'); 634: $eng->element('BACKGRND', sub { 635: my ($eng, $el) = @_; 636: $output->print("<TR><TD colspan=3><H3 align=center>Background</H3>\n"); 637: $eng->process_content; 638: $output->print("</TD></TR>\n"); 639: }); 640: $eng->element('PROFILE', sub { 641: my ($eng, $el) = @_; 642: $output->print("<TR><TD colspan=3><TABLE width=100% border=0><TR>", 643: "<TD width=10%></TD><TD align=center><H3>Profile</H3>", 644: "</TD><TD width=10%>"); 645: #$output->print("<A HREF='",$jlink,"'><EM>Journal Available</EM></A>") 646: # if (-f $jfile); 647: $eng->process_content; 648: $output->print("</TD></TABLE>\n"); 649: $output->print("</TD></TR>\n"); 650: }); 652: ############################################################ 653: $eng->mode_set('Threads'); 655: $eng->element('THREAD', sub { 656: my ($eng, $el) = @_; 657: #$datarray{'EFFECT'} = $datarray{'TARGET'} = $datarray{'ITEM'} = ''; 658: my %thd = ('RANK'=>'', 'ITEM'=>'', 'EFFECT'=>'', 'TARGET'=>'', 659: collect_assoc($eng)); 660: $thd{'RANK'} = $el->{'Attributes'}->{'RANK'}; 661: $thd{'BASECOST'} = $el->{'Attributes'}->{'BASE'}; 662: $output->print(" <TR><TD ALIGN=CENTER VALIGN=TOP>", 663: $thd{'RANK'}, "</TD>"); 664: if (defined($thd{'ITEM'}) && $thd{'ITEM'} ne '') { 665: $output->print(" <TD ALIGN=LEFT VALIGN=TOP>", $thd{'ITEM'}, 666: "</TD>\n"); 667: $output->print(" <TD ALIGN=LEFT VALIGN=TOP>", $thd{'EFFECT'}, 668: "</TD>\n"); 669: } else { 670: $output->print(" <TD ALIGN=LEFT COLSPAN=2 VALIGN=TOP>", 671: $thd{'TARGET'}, "</TD>\n"); 672: } 673: $output->print(" </TR>\n"); 674: }); 675: $eng->element([qw(ITEM EFFECT TARGET)], assoc_store_handler()); 677: ############################################################ 678: $eng->mode_set('Equipment'); 680: $eng->element('EQENTRY', sub { 681: my ($eng, $el) = @_; 682: #$datarray{'NOTE'} = $datarray{'LOC'} = $datarray{'WEIGHT'} = 683: # $datarray{'ITEM'} = ''; 684: my %equip = ('ITEM'=>'', 'WEIGHT'=>'', 'LOC'=>'', 'NOTE'=>'', 685: collect_assoc($eng)); 686: my $entry = "<TD ALIGN=RIGHT VALIGN=TOP>".$equip{'ITEM'}."</TD>\n". 687: "<TD ALIGN=CENTER VALIGN=TOP>".$equip{'WEIGHT'}."</TD>\n". 688: "<TD ALIGN=CENTER VALIGN=TOP>".$equip{'LOC'}."</TD>\n". 689: "<TD ALIGN=LEFT VALIGN=TOP>".$equip{'NOTE'}."</TD>\n"; 690: push(@eqentries,$entry); 691: }); 693: $eng->element([qw(ITEM LOC WEIGHT NOTE)], assoc_store_handler()); 694: $eng->mode_set('DEFAULT'); 695: } 698: sub lookup_talent { 699: my ($talent) = @_; 700: my ($talfile, %tal_data, $stepdesc, $step_desc, @steparr, $stepel); 701: $talfile = $talent; 702: $talfile = $EDdir."/Talents/".NormalizeFileName($talfile).".sgm"; 703: %tal_data = ('karma'=>'', 'strain'=>'', 'action'=>'', 'base'=>'', 704: 'step'=>'', 'stepdesc'=>'', 'name'=>$talent); 705: return %tal_data unless (-f $talfile); 706: @tal_data{'name','action','karma','strain','stepdesc'} = 707: data_extract($talfile, [qw(NAME ACTION KARMA STRAIN STEP)]); 708: $stepdesc = $tal_data{'stepdesc'}; 709: @steparr = split(/\s*\+\s*/,$stepdesc); 710: $step_desc = ['',0,0]; 711: $tal_data{'stepdesc'} = $step_desc; 712: foreach $stepel (@steparr) { 713: if ($stepel =~ /rank/i) { 714: $step_desc->[1] = 1; 715: } elsif ( $stepel =~ /dexterity|strength|toughness|perception|willpower|charisma/i) { 716: $tal_data{'base'} = $step_desc->[0] = $stepel; 717: } elsif ($stepel =~ /[^\d\s]/) { 718: warn "bad data in talent step for ".$talent." : ".$stepdesc."\n"; 719: } else { 720: # can only be a number 721: $step_desc->[2] += $stepel; 722: } 723: } 724: return %tal_data; 725: } 728: sub prep_talent { 729: my ($data,$rank,$attr_step) = @_; 730: my ($dice,$step,$base,$bonus,@temp,$step_desc); 731: $dice = $base = ''; 732: $step = 0; 733: $step_desc = $data->{'stepdesc'}; 734: if (ref $step_desc) { # have real data 735: if ($step_desc->[1]) { 736: $step += $rank; 737: } 738: $step += $step_desc->[2]; 739: $base = $step_desc->[0]; 740: if ($base ne '') { 741: $bonus = $step; 742: $step += $attr_step->{$base}; 743: 744: @temp = split (//,$base,4); 745: $temp[0] =~ tr/a-z/A-Z/; 746: $temp[1] =~ tr/A-Z/a-z/; 747: $temp[2] =~ tr/A-Z/a-z/; 748: $base = $temp[0].$temp[1].$temp[2]; 749: if ($bonus > 0) { 750: $base .= "+".$bonus; 751: } 752: } 753: } 754: $dice = StepDice($step) if ($step > 0); 755: return ($base,$step,$dice); 756: } 759: 1;