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;