source: subversion/utils/makeMapOnMove/mm.pl @ 1998

Last change on this file since 1998 was 1998, checked in by ojw, 13 years ago

add perl interpreter
+ unix newlines
+ clear screen

File size: 9.2 KB
Line 
1#!/usr/bin/perl
2use strict;
3#---------------------------------------------------------------------------------
4# Make map on move
5#
6# Usage: mm.pl
7#  and then open index.htm in a browser where you can see it with the console still open
8#  then reselect the console window so that it receives keystrokes
9#
10#  All input should be to console window via the numeric keypad
11#  All output will be to the browser
12#  Press q to quit
13#---------------------------------------------------------------------------------
14# Copyright 2007, Oliver White
15#
16# This program is free software; you can redistribute it and/or modify
17# it under the terms of the GNU General Public License as published by
18# the Free Software Foundation; either version 2 of the License, or
19# (at your option) any later version.
20#
21# This program is distributed in the hope that it will be useful,
22# but WITHOUT ANY WARRANTY; without even the implied warranty of
23# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24# GNU General Public License for more details.
25#
26# You should have received a copy of the GNU General Public License
27# along with this program; if not, write to the Free Software
28# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
29#---------------------------------------------------------------------------------
30
31# We only use this for non-blocking getch()
32require Term::Screen;
33my $scr = new Term::Screen;
34die("Can't init term::screen\n") if(!$scr);
35$scr->clrscr();
36
37# Setup stuff for a fake GPS (that reads a logfile)
38use Time::HiRes qw(sleep);
39open(my $fpLogIn, "<log.nmea") || die("Can't open log");
40
41# Global variables
42my (@Nodes, @CurrentWay, @Poi);
43my %Tags = ("highway"=>"unclassified"); # default tags
44my $NodeCount = 0; my $SegCount = 0;
45my ($posLat,$posLon) = (0,0);
46my $Mode = "default";
47my ($LastKey, $LastError);
48my @Interface;
49
50# Interface commands
51loadInterface("interface.txt");
52
53# Obsolete: remove
54my %WayTypes = (
55"1" => "Track",
56"2" => "Unclassified",
57"3" => "Residential",
58"4" => "Secondary",
59"5" => "Primary",
60"6" => "Motorway",
61"7" => "Trunk",
62"8" => "Motorway link",
63"9" => "Service");
64
65# Run (100 steps only in testing)
66foreach(1..100){
67  update();
68  render();
69  sleep(0.2);
70}
71
72
73# Updates everything
74sub update{
75  # Get the position
76  my ($lat,$lon,$valid) = getPos();
77  if($valid){
78    # Record the position, add it to our journey
79    addNode($lat,$lon);
80    $posLat = $lat; 
81    $posLon = $lon;
82  }
83  processInput();
84  showInterface();
85  showHtml();
86  outputOsm();
87}
88sub showInterface{
89  # Obsolete: remove
90}
91sub showHtml{
92  # Create an HTML page as output
93 
94  # Take input from a template HTML file
95  open(my $fp, "<template.htm") || die("Can't read HTML template\n");
96  my $template = join("", <$fp>);
97  close $fp;
98 
99  # List of keywords to look for
100  foreach my $Keyword( qw(KEYPAD POS MODE ATTRIBUTES LAST_KEYPRESS LAST_ERROR)){
101    # Lookup each keyword in the getHtmlPart function
102    my $Data = getHtmlPart($Keyword);
103    $template =~ s/\{\{$Keyword\}\}/$Data/g;
104  }
105 
106  # Save the output to index.htm
107  open(my $fp, ">index.htm") || die("Can't write HTML\n");
108  print $fp $template;
109  close $fp;
110}
111
112sub getHtmlPart{
113  my $Key = shift();
114  # HTML keywords that can be replaced
115  return getHtmlKeypad() if($Key eq "KEYPAD");
116  return sprintf("%1.5f, %1.5f", $posLat,$posLon) if($Key eq "POS");
117  return $Mode if($Key eq "MODE");
118  return getHtmlAttributes() if($Key eq "ATTRIBUTES");
119  return $LastKey if($Key eq "LAST_KEYPRESS");
120  return $LastError if($Key eq "LAST_ERROR");
121}
122sub getHtmlKeypad{
123  # Get the currently-available interface, as an HTML table
124  my %Keys;
125 
126  # Look through the interface definition for keypresses which exist in this mode
127  foreach my $Interface(@Interface){
128    my($ifMode,$ifKey,$ifLabel,$ifAction,$ifParams) = split(/:/,$Interface);
129    if($ifMode eq $Mode){
130      $Keys{$ifKey} = $ifLabel;
131    }
132  }
133 
134  # Create an HTML table representing our input device
135  my $Keypad = 
136    "<table class=\"keypad\" cellspacing=\"0\"><tr><td>{7}</td><td>{8}</td><td>{9}</td></tr>\n".
137    "<tr><td>{4}</td><td>{5}</td><td>{6}</td></tr>\n".
138    "<tr><td>{1}</td><td>{2}</td><td>{3}</td></tr>\n".
139    "<tr><td>{0}</td><td>{.}</td><td>{Enter}</td></tr></table>\n";
140   
141  # Replace every {{key}} entry with a label from the interface definition
142  while(my ($k,$v) = each(%Keys)){
143    my $htmlVal = "<span class=\"keyname\">$k</span><br><span class=\"keyaction\">$v</span>";
144    $Keypad =~ s/\{$k\}/$htmlVal/g;
145  }
146 
147  # Replace any unused key entries with HTML spaces
148  $Keypad =~ s/\{.*?\}/&nbsp;/g;
149 
150  return $Keypad;
151}
152
153sub getHtmlAttributes{
154  # Get the current way's attributes, as an HTML table
155  my $Html = "<table class=\"attributes\">";
156  while(my($k,$v) = each(%Tags)){
157    $Html .= "<tr><td>$k</td><td>$v</td></tr>\n";
158  }
159  return($Html ."</table>");
160}
161sub processInput{
162  # Handle any keyboard input
163  return if(!$scr->key_pressed());
164  my $c = $scr->getch();
165  finish() if($c eq "q");
166  $LastKey = $c;
167 
168  # Look for an interface command that matches what was just pressed
169  # and which is valid in the current mode, and implement it
170  foreach my $Interface(@Interface){
171    my($ifMode,$ifKey,$ifLabel,$ifAction,$ifParams) = split(/:/,$Interface);
172    if($ifMode eq $Mode and $ifKey eq $c){
173      handleAction($ifAction, $ifParams);
174      return;
175    }
176  }
177  $Mode = "default";
178  return;
179 
180}
181sub handleAction{
182  # Do something as the result of a keypress
183  my ($action, $params) = @_;
184  if($action eq "mode"){
185    $Mode = $params;
186  }
187  elsif($action eq "set"){
188    setTags(split(/=/,$params));
189    $Mode = "default";
190  }
191  elsif($action eq "add"){
192    addPoi($params);
193  }
194  elsif($action eq "action"){
195  }
196  else{
197    $LastError = "Unrecognised action $action";
198  }
199}
200sub addPoi{
201  # Add a node as POI (not in route)
202  my $KeyVal = shift();
203  my $PoiData;
204 
205  foreach my $Part(split(/,\s*/,$KeyVal)){
206    my($k,$v) = split(/=/,$Part);
207    $PoiData->{$k} = $v;
208    }
209  $PoiData->{"lat"} = $posLat;
210  $PoiData->{"lon"} = $posLon;
211 
212  push(@Poi, $PoiData);
213}
214sub setTags{
215  # Set attributes of the current Way
216  my ($k,$v) = @_;
217  $Tags{$k} = $v;
218}
219
220sub addNode{
221  # Add a node to the current Way
222  my $Node;
223  $Node->{lat} = shift();
224  $Node->{lon} = shift();
225  push @Nodes, $Node;
226  push @CurrentWay, scalar(@Nodes);
227}
228
229sub outputOsm{
230  # Save everything we know as an OSM file
231  open(my $fp, ">data.osm") || die("Can't write to OSM file\n");
232 
233  print $fp "<?xml version='1.0' encoding='UTF-8'?>\n";
234  print $fp "<osm version='0.3' generator='mm'>\n";
235
236  my $Count = 0;
237 
238  # Save route nodes to OSM file
239  foreach my $Node (@Nodes){
240    printf $fp "<node id='%d' lat='%f' lon='%f' />\n",
241      ++$Count,
242      $Node->{lat},
243      $Node->{lon};
244  }
245 
246  # Save POI nodes to OSM file
247  foreach my $Poi (@Poi){
248    printf $fp "<node id='%d' lat='%f' lon='%f'>\n", ++$Count, $Poi->{"lat"},$Poi->{"lon"};
249    while(my($k,$v) = each(%$Poi)){
250      printf $fp "<tag k='%s' v='%s' />\n",$k,$v if($k !~ /^(lat|lon)$/);
251    }
252    printf $fp "</node>\n",
253  }
254 
255  # Save current position as a node
256  printf $fp "<node id='%d' lat='%f' lon='%f'>\n", ++$Count, $posLat, $posLon;
257  printf $fp "<tag k='mapmaker' v='current_position' />\n";
258  printf $fp "</node>\n",
259 
260  # Save bounding box, makes osmarender give a map centred on the current position
261  my $HalfAreaLat = 0.003;
262  my $HalfAreaLon = $HalfAreaLat * (cos($posLon / 57));
263 
264  printf $fp "<bounds returned_minlat=\"%f\" returned_minlon=\"%f\" returned_maxlat=\"%f\" returned_maxlon=\"%f\" />\n",
265    $posLat - $HalfAreaLat,
266    $posLon - $HalfAreaLon,
267    $posLat + $HalfAreaLat,
268    $posLon + $HalfAreaLon;
269 
270 
271  # Save the current Way
272  $Count = 0;
273  my $LastPoint;
274 
275  my @WaySegs;
276  foreach my $Point (@CurrentWay){
277    if($Count > 0){
278      printf $fp "<segment id='%d' from='%d' to='%d' />\n",
279        $Count,
280        $LastPoint,
281        $Point;
282      push(@WaySegs, $Count);
283    }
284    $Count++;
285    $LastPoint = $Point;
286  }
287 
288  my $Segs = "";
289  foreach my $Seg (@WaySegs){
290    $Segs .= sprintf("<seg id='%d' />\n", $Seg);
291  }
292
293  my $Tags = "";
294  while(my ($k,$v) = each(%Tags)){
295    $Tags .= sprintf("<tag k='%s' v='%s' />\n",$k,$v);
296  }
297 
298  printf $fp "<way id='1'>\n$Segs$Tags\n</way>\n";
299
300  print $fp "</osm>";
301  close $fp;
302}
303
304sub render(){
305  # Render the OSM data we just created
306  `cd render;./render.sh 2>/dev/null &`;
307}
308
309sub getPos{
310  # Get current position as WGS-84 lat/long
311  # This should be replaced with a GPSD call later
312  my $Line = <$fpLogIn>;
313  chomp $Line;
314  if($Line =~ /\$GPGGA,(.*)/){
315    my ($Time,$Lat,$NS,$Long,$WE,@others) = split(/,/,$1);
316   
317    my $Lat = convertPos($Lat,$NS);
318    my $Long = convertPos($Long,$WE);
319   
320    printf "%1.13f, %1.13f\n", $Lat, $Long if(0);
321
322    return($Lat,$Long,1);
323  }
324  return(0,0,0);
325}
326
327
328sub convertPos{
329  # Convert NMEA-style number format (DDMM.MMM) to decimal
330  my ($Num,$Quadrant) = @_;
331  if($Num =~ /(\d+)(\d{2}\.\d+)/){
332    $Num = $1 + $2 / 60;
333  }
334  if($Quadrant =~ /[SW]/){
335    $Num *= -1;
336  }
337  return($Num);
338}
339sub finish{
340  # Exit the program
341  $scr->clrscr();
342  exit;
343}
344
345sub loadInterface{
346  # Load interface definition file from disk
347  open(my $fp, "<", shift()) || die("Can't read interface definition\n");
348  while(my $Line = <$fp>){
349    chomp $Line;
350    $Line =~ s/\s*#.*$//;  # Remove comments
351    push @Interface, $Line;
352  }
353  close $fp;
354}
Note: See TracBrowser for help on using the repository browser.