Annotation of igc_tool.pl, Revision 1.0
1.0 ! philip 1: #! /usr/bin/perl -w
! 2: use Tk;
! 3: use Tk::widgets qw/Dialog ErrorDialog ROText/;
! 4: use Time::Local qw/timegm_nocheck timelocal/;
! 5: use strict;
! 6:
! 7: my $mw = MainWindow->new;
! 8: $mw->CmdLine;
! 9: $mw->title("IGC log tool");
! 10: $mw->configure(-menu => my $menubar = $mw->Menu);
! 11:
! 12: my $file = $menubar->cascade(qw/-label File -underline 0 -menuitems/ =>
! 13: [
! 14: [command => 'Open', -command => [\&load_igc]],
! 15: [command => 'Exit', -command => [\&exit]],
! 16: ]);
! 17:
! 18: my $igc = $menubar->cascade(qw/-label Log -underline 0 -menuitems/ =>
! 19: [
! 20: [command => 'Barograph', -command => [\&baro]],
! 21: [command => 'Track map', -command => [\&map]],
! 22: [command => 'Generate Mapfile', -command => [\&generate_tab]],
! 23: [command => 'Split log', -command => [\&logsplit]],
! 24: ]);
! 25:
! 26: my $help = $menubar->cascade(qw/-label Help -underline 0 -menuitems/ =>
! 27: [
! 28: [command => 'About'],
! 29: [command => 'Usage'],
! 30: [command => 'Barograph'],
! 31: [command => 'Track map'],
! 32: [command => 'Split log'],
! 33: ]);
! 34:
! 35: my $DIALOG_ABOUT = $mw->Dialog(
! 36: -title => 'About IGC tool',
! 37: -bitmap => 'info',
! 38: -default_button => 'OK',
! 39: -buttons => ['OK'],
! 40: -text => "IGC log tool\nWindows version\nPhilip Plane\n" .
! 41: "6 March 2006\n\nPerl Version $]" .
! 42: "\nTk Version $Tk::VERSION",
! 43: );
! 44:
! 45: $help->cget(-menu)->entryconfigure('About',
! 46: -command => [$DIALOG_ABOUT => 'Show'],
! 47: );
! 48:
! 49: my $DIALOG_USAGE = $mw->Dialog(
! 50: -title => 'Using IGC tool',
! 51: -bitmap => 'info',
! 52: -default_button => 'OK',
! 53: -buttons => ['OK'],
! 54: -text => "To use the IGC tool, first open an IGC log file " .
! 55: "from the File menu. The text of the log will " .
! 56: "be displayed in the main window. " .
! 57: "When a file has been loaded the actions in the Log " .
! 58: "menu can be applied to the log.",
! 59: );
! 60:
! 61: $help->cget(-menu)->entryconfigure('Usage',
! 62: -command => [$DIALOG_USAGE => 'Show'],
! 63: );
! 64:
! 65: my $DIALOG_BARO = $mw->Dialog(
! 66: -title => 'Barograph',
! 67: -bitmap => 'info',
! 68: -default_button => 'OK',
! 69: -buttons => ['OK'],
! 70: -text => "The barograph trace shows height in feet, " .
! 71: "and various information from the log. " ,
! 72: );
! 73:
! 74: $help->cget(-menu)->entryconfigure('Barograph',
! 75: -command => [$DIALOG_BARO => 'Show'],
! 76: );
! 77:
! 78: my $DIALOG_MAP = $mw->Dialog(
! 79: -title => 'Track map',
! 80: -bitmap => 'info',
! 81: -default_button => 'OK',
! 82: -buttons => ['OK'],
! 83: -text => "The track map shows the track from the log file, " .
! 84: "any turnpoints in the log file, " .
! 85: "and any task in the log file. " .
! 86: "Projection is straight xy." .
! 87: "Turnpoints are shown as 500 meter circles",
! 88: );
! 89:
! 90: $help->cget(-menu)->entryconfigure('Track map',
! 91: -command => [$DIALOG_MAP => 'Show'],
! 92: );
! 93:
! 94: my $DIALOG_SPLIT = $mw->Dialog(
! 95: -title => 'Split log',
! 96: -bitmap => 'info',
! 97: -default_button => 'OK',
! 98: -buttons => ['OK'],
! 99: -text => "Some IGC loggers and their software produce logs " .
! 100: "that have more than one flight in the log. " .
! 101: "The log splitter scans through the log and attempts " .
! 102: "to seperate the flights into individual logs. " .
! 103: "If the number of logs it finds sounds reasonable, " .
! 104: "save the new logs to disk. The log files are named " .
! 105: "using the original file name with the eighth character " .
! 106: "replaced with a sequence number. ",
! 107: );
! 108:
! 109: $help->cget(-menu)->entryconfigure('Split log',
! 110: -command => [$DIALOG_SPLIT => 'Show'],
! 111: );
! 112:
! 113: my $text = $mw->Scrolled("ROText")->pack();
! 114:
! 115: # Globals from IGC file
! 116: my $maxalt;
! 117: my $minalt;
! 118: my $maxpres;
! 119: my $minpres;
! 120: my $minlat;
! 121: my $maxlat;
! 122: my $minlon;
! 123: my $maxlon;
! 124: my $mday;
! 125: my $month;
! 126: my $mon;
! 127: my $year;
! 128: my $time;
! 129: my $glider;
! 130: my $cid;
! 131: my $pilot;
! 132: my $recorder;
! 133: my $igcfile;
! 134: my @log;
! 135: my @tp;
! 136: my @task;
! 137: my @track;
! 138:
! 139: sub load_igc {
! 140: my $types = [
! 141: ['IGC Files','.igc'],
! 142: ['IGC Files','.IGC'],
! 143: ];
! 144:
! 145: my $igc = $mw->getOpenFile(-initialdir=>'/cygwin/home/philip',
! 146: -filetypes=>$types);
! 147: if ( defined $igc ){
! 148: my @igc = split /\//,$igc;
! 149: $igcfile = pop @igc;
! 150: open IGC, $igc or die "Can't open $igc : $!\n";
! 151: my @log = <IGC>;
! 152: close IGC;
! 153: $text->delete("1.0",'end');
! 154: @tp = ();
! 155: @task = ();
! 156: @track = ();
! 157: $maxalt = 0;
! 158: $minalt = 99999;
! 159: $maxpres = 0;
! 160: $minpres = 99999;
! 161: $minlat = 90;
! 162: $maxlat = -90;
! 163: $minlon = 180;
! 164: $maxlon = 0;
! 165: my $oh = 0;
! 166: while ( $_ = shift @log ){
! 167: s/\r//;
! 168: SWITCH: {
! 169: if ( /^HFDTE/ ){
! 170: my $date = substr($_,5);
! 171: $mday = substr($date,0,2);
! 172: $month = substr($date,2,2);
! 173: $year = substr($date,-2,2);
! 174: $mon = $month - 1;
! 175: last SWITCH;
! 176: }
! 177: if ( /^H.GID/ ){
! 178: $glider = substr($_,5);
! 179: last SWITCH;
! 180: }
! 181: if ( /^H.CID/ ){
! 182: $cid = substr($_,5);
! 183: last SWITCH;
! 184: }
! 185: if ( /^H.PLT/ ){
! 186: $pilot = substr($_,5);
! 187: last SWITCH;
! 188: }
! 189: if ( /^H.FTY/ ){
! 190: $recorder = substr($_,5);
! 191: chop $recorder;
! 192: last SWITCH;
! 193: }
! 194: if ( /^L\D{4}?(\d{5}?)(\d{7}?[NS])(\d{8}?[WE])(\d{6})(.{8}?)(.*)/ ){
! 195: # [ lat, lon, id, name, type ]
! 196: # turnpoints
! 197: my $lat = latitude($2);
! 198: my $lon = longitude($3);
! 199: push @tp, [ $lat, $lon, $1, $6, $5 ];
! 200: last SWITCH;
! 201: }
! 202: if ( /^C(\d{7}?[NS])(\d{8}?[WE])(.*)/ ){
! 203: # [ lat, lon, name ]
! 204: # task
! 205: my $lat = latitude($1);
! 206: my $lon = longitude($2);
! 207: if ( $lat == 0 ){
! 208: last SWITCH;
! 209: }
! 210: push @task, [ $lat, $lon, $3 ];
! 211: last SWITCH;
! 212: }
! 213: if ( /^B(\d{6})(\d{7}[NS])(\d{8}?[WE]).{1}(\d{5})(\d{5})/ ){
! 214: $time = $1;
! 215: my $lat = latitude($2);
! 216: my $lon = longitude($3);
! 217: my $alt = $4;
! 218: my $pres = $5;
! 219:
! 220: # $time is HHMMSS
! 221: $time =~ /(\d{2})(\d{2})(\d{2})/;
! 222: my $hour = $1;
! 223: my $min = $2;
! 224: my $sec = $3;
! 225: if ( $hour < $oh ) {
! 226: $mday++;
! 227: }
! 228: $oh = $hour;
! 229: my $gt = timegm_nocheck($sec,$min,$hour,$mday,$mon,$year);
! 230:
! 231: if ( $lat > $maxlat ) {
! 232: $maxlat = $lat;
! 233: }
! 234: if ( $lat < $minlat ) {
! 235: $minlat = $lat;
! 236: }
! 237: if ( $lon > $maxlon ) {
! 238: $maxlon = $lon;
! 239: }
! 240: if ( $lon < $minlon ) {
! 241: $minlon = $lon;
! 242: }
! 243:
! 244: if ( $alt < $minalt ){
! 245: $minalt = $alt;
! 246: }
! 247: if ( $alt > $maxalt ){
! 248: $maxalt = $alt;
! 249: }
! 250: if ( $pres < $minpres ){
! 251: $minpres = $pres;
! 252: }
! 253: if ( $pres > $maxpres ){
! 254: $maxpres = $pres;
! 255: }
! 256: push @track, [ $gt, $lat, $lon, $alt, $pres ];
! 257: last SWITCH;
! 258: }
! 259: }
! 260: $text->insert('end',$_);
! 261: }
! 262: }
! 263: }
! 264:
! 265: sub baro {
! 266: my $maxrec = scalar @track;
! 267: if ( $maxrec > 0 ) {
! 268: my $bwin = $mw->Toplevel();
! 269: $bwin->title($igcfile . " Barograph");
! 270: my $bg = $bwin->Scrolled('Canvas', -width => 850, -height => 500, -scrollregion => [-10,-10,1000,1000])->pack();
! 271: my $id;
! 272: my $date = sprintf("%02d/%02d/20%02d",$mday,$month,$year);
! 273: if ( not defined $glider ) {
! 274: $glider = $cid;
! 275: }
! 276: #clean up pilot name, remove extra whitespace
! 277: if ( defined $pilot ){
! 278: chop $pilot;
! 279: while ( $pilot =~ m/ / ){
! 280: $pilot =~ s/ / /;
! 281: }
! 282: }
! 283: if ( defined $glider ){
! 284: chop $glider;
! 285: }
! 286: my $gps = sprintf("GPS Low point: %5d ft High point: %5d ft",
! 287: feet($minalt),feet($maxalt));
! 288: my $pres = sprintf("Alt Low point: %5d ft High point: %5d ft",
! 289: feet($minpres),feet($maxpres));
! 290:
! 291: my @t = localtime($track[0][0]);
! 292: my $start = sprintf("Log started at %02d:%02d:%02d",$t[2],$t[1],$t[0]);
! 293: my @f = localtime($track[$maxrec - 1][0]);
! 294: my $finish = sprintf("Log ended at %02d:%02d:%02d",$f[2],$f[1],$f[0]);
! 295: my $duration = sprintf("Log duration %s",
! 296: sec2time($track[$maxrec - 1][0] - $track[0][0]));
! 297:
! 298: $id = $bg->createText(10,10, -text => $pilot, -anchor => "w");
! 299: $id = $bg->createText(410,10, -text => $recorder, -anchor => "w");
! 300: $id = $bg->createText(10,25, -text => $glider, -anchor => "w");
! 301: $id = $bg->createText(10,40, -text => $pres,-fill => "red", -anchor => "w");
! 302: $id = $bg->createText(10,55, -text => $gps, -fill => "blue", -anchor => "w");
! 303: $id = $bg->createText(10,70, -text => $date, -anchor => "w");
! 304: $id = $bg->createText(10,85, -text => $start, -anchor => "w");
! 305: $id = $bg->createText(10,100, -text => $finish, -anchor => "w");
! 306: $id = $bg->createText(10,115, -text => $duration, -anchor => "w");
! 307:
! 308: my $width = 800;
! 309: my $height = 450;
! 310:
! 311: my $hscale = ($track[$maxrec-1][0] - $track[0][0])/($width - 50);
! 312: my $vscale = 25;
! 313: if ($maxalt < 2000){
! 314: $vscale = 10;
! 315: }
! 316: elsif ($maxalt < 4000){
! 317: $vscale = 15;
! 318: }
! 319:
! 320: my $m = $maxalt / 305;
! 321:
! 322: # Draw lines at 1000ft (305m)
! 323: for(my $mil = 0;$mil < $m;$mil++){
! 324: my $ml = 400 - (($mil * 305)/$vscale);
! 325: $id = $bg->createLine(40,$ml,$width ,$ml, -dash => [6,4]);
! 326: $id = $bg->createText(35,$ml, -text => sprintf("%5d", 1000 * $mil), -anchor => "e");
! 327: }
! 328:
! 329: my $or = 400 - ( $track[0][4] / $vscale);
! 330: my $ob = 400 - ( $track[0][3] / $vscale);
! 331: my $ox = 30;
! 332: # munch through the track array [ $gt, $lat, $lon, $alt, $pres ]
! 333: my $osec = $track[0][0];
! 334: my $olat = $track[0][1];
! 335: my $olon = $track[0][2];
! 336: my $oalt = $track[0][3];
! 337: my $opres = $track[0][4];
! 338: my $launch = 0;
! 339: for (my $i = 0; $i < $maxrec; $i++) {
! 340: my $t_sec = $track[$i][0];
! 341: $t_sec = $t_sec - $track[0][0];
! 342: my $x = 50 + int($t_sec / $hscale);
! 343: my $pres = $track[$i][4];
! 344: my $alt = $track[$i][3];
! 345: my $dlat = abs($track[$i][1] - $olat);
! 346: my $dlng = abs($track[$i][2] - $olon);
! 347: my $dist = sqrt(($dlat*$dlat) + ($dlng*$dlng));
! 348: my $speed = 0;
! 349: my $dsec = $t_sec - $osec;
! 350: $osec = $t_sec;
! 351: if ( ($dsec > 0) and ($dist > 0)){
! 352: $speed = $dist / $dsec;
! 353: }
! 354: if ( ($speed > 0.000100) and ($oalt < $alt)){
! 355: $launch++;
! 356: }
! 357: if ( $launch == 3 ) {
! 358: $id = $bg->createLine($x,400,$x,150, -fill => "black");
! 359: $id = $bg->createText($x,140, -text => "takeoff");
! 360: $launch++;
! 361: }
! 362: if ( ($speed < 0.000100) and ($oalt == $alt) and ($launch > 0)){
! 363: $launch = 0;
! 364: $id = $bg->createLine($x,400,$x,150,-fill => "black");
! 365: $id = $bg->createText($x,140, -text => "land");
! 366: }
! 367: my $y = 400 - ( $pres/$vscale);
! 368: $id = $bg->createLine($x,$y,$ox,$or, -fill => "red");
! 369: $or = $y;
! 370: $y = 400 - ($alt/$vscale);
! 371: $id = $bg->createLine($x,$y,$ox,$ob, -fill => "blue");
! 372: $ob = $y;
! 373: $ox = $x;
! 374: $olat = $track[$i][1];
! 375: $olon = $track[$i][2];
! 376: $opres = $pres;
! 377: $oalt = $alt;
! 378: }
! 379: # add the timeticks
! 380: my @start = localtime($track[0][0]);
! 381: my @finish = localtime($track[$maxrec-1][0]);
! 382: for ( my $h = $start[2]+1;
! 383: $h <= $finish[2];
! 384: $h++ ){
! 385: @t = @start;
! 386: $t[2] = $h;
! 387: $t[0] = 0;
! 388: $t[1] = 0;
! 389: my $t = timelocal(@t);
! 390: my $x = 50 + int(($t - $track[0][0]) / $hscale);
! 391: $id = $bg->createText($x,410, -text => sprintf("%02d:00",$h));
! 392: $id = $bg->createLine($x,400,$x,350, -dash => [3,2],
! 393: -fill => "black");
! 394: }
! 395: }
! 396: }
! 397:
! 398: sub map {
! 399: my $maxrec = scalar @track;
! 400: if ( $maxrec > 0 ) {
! 401: my $zone;
! 402: my $ox;
! 403: my $oy;
! 404:
! 405: #use max vertical to set scale as most tracks are taller than wider.
! 406: my $scale = $maxlat - $minlat;
! 407:
! 408: my $bwin = $mw->Toplevel();
! 409: $bwin->title($igcfile . " Flight Track");
! 410: my $bg = $bwin->Scrolled('Canvas', -width => 850, -height => 600, -scrollregion => [-500,-500,1500,1500])->pack();
! 411:
! 412: my $width = 1000;
! 413: my $height = 1000;
! 414:
! 415: $scale = $height / $scale;
! 416:
! 417:
! 418: # 500 meter radius circle
! 419: my $r = .004 * $scale;
! 420:
! 421: #show the turnpoints
! 422: my $maxtp = scalar @tp;
! 423: for (my $t = 0; $t < $maxtp; $t++) {
! 424: my $y = $height - (($tp[$t][0] - $minlat) * $scale);
! 425: my $x = ($tp[$t][1] - $minlon) * $scale;
! 426: my $id = $bg->createText($x, $y + 10 + $r, -text => $tp[$t][3]);
! 427: $id = $bg->createOval($x - $r, $y - $r, $x + $r, $y + $r);
! 428: }
! 429: #show the task
! 430: my $maxtask = scalar @task;
! 431: if ( $maxtask > 0 ){
! 432: $oy = $height - (($task[0][0] - $minlat) * $scale);
! 433: $ox = ($task[0][1] - $minlon) * $scale;
! 434: }
! 435: for (my $t = 0; $t < $maxtask; $t++) {
! 436: my $y = $height - (($task[$t][0] - $minlat) * $scale);
! 437: my $x = ($task[$t][1] - $minlon) * $scale;
! 438: my $id = $bg->createText($x, $y + 10 + $r, -text => $task[$t][2]);
! 439: $id = $bg->createOval($x - $r, $y - $r, $x + $r, $y + $r, -outline => "green");
! 440: $id = $bg->createLine($x,$y,$ox,$oy, -dash => [6,4], -fill => "green");
! 441: $ox = $x;
! 442: $oy = $y;
! 443: }
! 444:
! 445: #prime the pump
! 446: $oy = $height - (($track[0][1] - $minlat) * $scale);
! 447: $ox = ($track[0][2] - $minlon) * $scale;
! 448:
! 449: #show the track
! 450: for (my $i = 0; $i < $maxrec; $i++) {
! 451: my $y = $height - (($track[$i][1] - $minlat) * $scale);
! 452: my $x = ($track[$i][2] - $minlon) * $scale;
! 453: my $id = $bg->createLine($ox,$oy,$x,$y, -fill => "blue");
! 454: $ox = $x;
! 455: $oy = $y;
! 456: }
! 457: }
! 458: }
! 459:
! 460: sub generate_tab {
! 461: my $header = "sTrackDescr\tiTrkID\tiColor\tsTimestamp\tfLat\tfLong\tfAlt\tfEasting\tfNorthing\n";
! 462: #IGClog 123 3:21 44.500000 170.200000 123.0
! 463: my $tab = $mw->getSaveFile(-initialdir=>'/',
! 464: -initialfile=>'tracklog.txt');
! 465: if ( defined $tab ){
! 466: open TXT, "> " . $tab or die "Couldn't open file $tab: $!\n";
! 467: print TXT $header;
! 468: my $maxrec = scalar @track;
! 469: for (my $i = 0; $i < $maxrec; $i++) {
! 470: my @now = localtime($track[$i][0]);
! 471: print TXT "IGCLog\t001\t\t";
! 472: printf TXT ("%02d:%02d:%02d\t",$now[2], $now[1], $now[0]);
! 473: printf TXT ("%6f\t%6f\n",$track[$i][1], $track[$i][2]);
! 474: }
! 475: close TXT;
! 476: }
! 477: }
! 478: sub logsplit {
! 479: my $maxrec = scalar @log;
! 480: my $osec = 0;
! 481: my $igccore;
! 482: my $igccount = 0;
! 483: my @logs =();
! 484:
! 485: for (my $i = 0; $i < $maxrec; $i++) {
! 486: if ( $log[$i] =~ /^B(\d{6})(\d{7}[NS])(\d{8}?[WE]).{1}(\d{5})(\d{5})/ ){
! 487: my $alt = $4;
! 488: my $time = $1;
! 489: $time =~ /(\d{2})(\d{2})(\d{2})/;
! 490: my $sec = ($1 *3600) + ($2 * 60) + $3;
! 491: # if the current second is less than the previous, time
! 492: # has gone backwards. This indicates you've crossed the
! 493: # boundry of a new day.
! 494: if ( $sec < $osec ) {
! 495: $osec -= 86400;
! 496: }
! 497: # if the gap in the log is more than sixty seconds assume that
! 498: # it's a new flight
! 499: if (( $sec - $osec ) > 60){
! 500: $logs[$igccount++] = $igccore;
! 501: $igccore = "";
! 502: }
! 503: $osec = $sec;
! 504: }
! 505: $igccore .= $log[$i];
! 506: }
! 507: $logs[$igccount] = $igccore;
! 508: my $split = $mw->Dialog(
! 509: -title => 'Split IGC log file',
! 510: -bitmap => 'question',
! 511: -default_button => 'OK',
! 512: -buttons => ['OK','Cancel'],
! 513: -text => "Found $igccount logs.\nWant to create seperate log files for them?\n",
! 514: )->Show();
! 515: if ($split eq 'OK'){
! 516: for (my $i = 1; $i <= $igccount; $i++) {
! 517: substr($igcfile,7,1) = $i;
! 518: my $frag = $mw->getSaveFile(-initialdir=>'/',
! 519: -initialfile=>$igcfile);
! 520: if ( defined $frag ){
! 521: open TEMP, ">" . $frag or die "Couldn't open $frag: $!\n";
! 522: print TEMP $logs[0], $logs[$i];
! 523: close TEMP;
! 524: }
! 525: }
! 526: }
! 527: }
! 528:
! 529:
! 530: sub feet{
! 531: my $meters = shift @_;
! 532: my $feet = $meters * 3.2808399;
! 533: return int($feet);
! 534: }
! 535:
! 536: sub duration{
! 537: # expects 2 parameters, start time and finish time
! 538: my $start = shift @_;
! 539: my $end = shift @_;
! 540: my $ss = seconds($start);
! 541: my $se = seconds($end);
! 542: # if we finished before we started, we crossed the day boundry
! 543: if ( $se < $ss ) {
! 544: $se += 60 * 60 * 24;
! 545: }
! 546: return $se - $ss;
! 547: }
! 548:
! 549: sub seconds{
! 550: my $time = shift @_;
! 551: my $hours = substr($time,0,2);
! 552: my $minutes = substr($time,2,2);
! 553: my $seconds = substr($time,4,2);
! 554: return $seconds + ($minutes * 60) + ($hours * 60 * 60);
! 555: }
! 556:
! 557: sub sec2time{
! 558: my $sec = shift @_;
! 559: my $hours = int($sec / 3600);
! 560: $sec = $sec % 3600;
! 561: my $minutes = int($sec / 60);
! 562: $sec = $sec % 60;
! 563: return sprintf("%02d:%02d:%02d",$hours,$minutes,$sec);
! 564: }
! 565:
! 566: sub latitude{
! 567: my $lat = shift @_;
! 568: my $degrees = substr($lat,0,2);
! 569: my $min = '0.' . substr($lat,2,5);
! 570: $min = $min * 1.66666667;
! 571: $degrees = $degrees + $min;
! 572: my $hemi = substr($lat,-1);
! 573: if ( $hemi eq 'S' ){
! 574: $degrees = 0 - $degrees;
! 575: }
! 576: return $degrees;
! 577: }
! 578:
! 579: sub longitude{
! 580: my $lon = shift @_;
! 581: my $degrees = substr($lon,0,3);
! 582: my $min = '0.' . substr($lon,3,5);
! 583: $min = $min * 1.66666667;
! 584: $degrees = $degrees + $min;
! 585: my $hemi = substr($lon,-1);
! 586: if ( $hemi eq 'W' ){
! 587: $degrees = 0 - $degrees;
! 588: }
! 589: return $degrees;
! 590: }
! 591:
! 592: MainLoop;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>