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;