1# -*- perl -*-
2
3#
4# Author: Slaven Rezic
5#
6# Copyright (C) 1999,2005,2012 Slaven Rezic. All rights reserved.
7# This package is free software; you can redistribute it and/or
8# modify it under the same terms as Perl itself.
9#
10# Mail: eserte@users.sourceforge.net
11# WWW:  http://bbbike.sourceforge.net
12#
13
14#XXX del: package main; # warum notwendig? irgendwann konnte bbbike.cgi nicht mehr ohne..
15#XXX irgendwann:
16package BBBikeCalc;
17
18use BBBikeUtil;
19use strict;
20use vars qw(@INC @EXPORT_OK
21	    %opposite %canvas_translation
22	    %wind_dir $winddir $wind_dir_from $wind_dir_to $wind);
23
24#XXX irgendwann:
25# require Exporter;
26# @ISA = qw(Exporter);
27# @EXPORT_OK = qw(CAKE %opposite opposite_direction init_wind
28# 		%wind_dir analyze_wind_dir norm_arc);
29
30# globale Variablen und Konstanten, die auch in main verwendet werden:
31#
32# CAKE: ein halbes Kuchenst�ck
33# %wind_dir: definiert die Windrichtungen in y- und x-Richtung
34# $winddir: aktuelle Windrichtung
35# $wind_dir_from, $wind_dir_to: Winkelangaben f�r die aktuelle Windrichtung
36# $wind: Windberechnung in head_wind() wird nur durchgef�hrt, wenn diese
37#        Variable wahr ist XXX del
38#
39
40#perl2exe_include constant.pm
41
42use constant CAKE => atan2(1,1)/2;
43
44%opposite =
45    ('n' => 's',
46     'e' => 'w',
47     'w' => 'e',
48     's' => 'n',
49     'ne' => 'sw',
50     'sw' => 'ne',
51     'nw' => 'se',
52     'se' => 'nw',
53     'nne' => 'ssw',
54     'ene' => 'esw',
55     'ese' => 'enw',
56     'sse' => 'nnw',
57     'ssw' => 'nne',
58     'wsw' => 'wne',
59     'wnw' => 'wse',
60     'nnw' => 'sse',
61    );
62sub opposite_direction { $opposite{$_[0]} }
63
64# to translate between y-up and y-down coordinate systems
65# XXX what's the difference between %opposite and %canvas_translation --- seems to be the same!
66%canvas_translation =
67    ('n' => 's',
68     'e' => 'e',
69     'w' => 'w',
70     's' => 'n',
71     'ne' => 'se',
72     'sw' => 'nw',
73     'nw' => 'sw',
74     'se' => 'ne',
75     'nne' => 'sse',
76     'ene' => 'ese',
77     'ese' => 'ene',
78     'sse' => 'nne',
79     'ssw' => 'nnw',
80     'wsw' => 'wnw',
81     'wnw' => 'wsw',
82     'nnw' => 'ssw',
83    );
84sub canvas_translation { $canvas_translation{$_[0]} }
85
86sub init_wind {
87    #        Windrichtung   y     x
88    %wind_dir = ('n'   => [ 1,    0],
89		 'nne' => [ 1,    0.5],
90		 'ne'  => [ 1,    1],
91		 'ene' => [ 0.5,  1],
92		 'e'   => [ 0,    1],
93		 'ese' => [-0.5,  1],
94		 'se'  => [-1,    1],
95		 'sse' => [-1,    0.5],
96		 's'   => [-1,    0],
97		 'ssw' => [-1,   -0.5],
98		 'sw'  => [-1,   -1],
99		 'wsw' => [-0.5, -1],
100		 'w'   => [ 0,   -1],
101		 'wnw' => [ 0.5  -1],
102		 'nw'  => [ 1,   -1],
103		 'nnw' => [ 1,   -0.5],
104		 ''    => [ 0,    0],
105		);
106}
107
108# Returns a list (normalized wind direction string, wind dir cake from, wind dir cake to)
109# Sets also the global variables $winddir, $wind_dir_from, $wind_dir_to
110sub analyze_wind_dir {
111    my($dir) = @_;
112    $winddir = lc($dir);
113    my @wd = @{$wind_dir{$winddir}};
114    my($winkel) = norm_arc(atan2($wd[0], $wd[1]));
115    ($wind_dir_from, $wind_dir_to) = ($winkel - CAKE, $winkel + CAKE);
116    # XXX was soll das hier? :
117    $wind_dir_from = norm_arc($wind_dir_from);
118    $wind_dir_to = norm_arc($wind_dir_to);
119    ($winddir, $wind_dir_from, $wind_dir_to);
120}
121
122sub norm_arc {
123    my($arc) = @_;
124    if ($arc < 0) {
125	$arc + 2*pi;
126    } elsif ($arc >= 2*pi) {
127	$arc - 2*pi;
128    } else {
129	$arc;
130    }
131}
132
133sub norm_deg {
134    my($deg) = @_;
135    if ($deg < 0) {
136	$deg + 360;
137    } elsif ($deg >= 360) {
138	$deg - 360;
139    } else {
140	$deg;
141    }
142}
143
144sub arc_is_between {
145    my($arc, $arc_from, $arc_to) = @_;
146    if ($arc_from > $arc_to) {
147	return 1 if $arc < $arc_from && $arc < $arc_to;
148	return 1 if $arc > $arc_from;
149	return 0;
150    } else {
151	return 1 if $arc > $arc_from && $arc < $arc_to;
152	return 0;
153    }
154}
155
156sub head_wind { # returns +2 for back wind and -2 for head wind
157    my($deltax, $deltay) = @_;
158    return 0 if !defined $deltax || !defined $deltay; #XXX || !$wind; del XXX
159    my $arc = norm_arc(atan2($deltay, $deltax));
160    my $i;
161    for($i=0; $i<4; $i++) {
162	if (arc_is_between($arc,
163			   norm_arc($wind_dir_from - $i*2*CAKE),
164			   norm_arc($wind_dir_to   + $i*2*CAKE))) {
165	    return $i - 2;
166	}
167    }
168    +2;
169}
170
171sub line_to_canvas_direction {
172    my($x1,$y1, $x2,$y2) = @_;
173    my $arc = norm_arc(atan2($y2-$y1, $x2-$x1));
174    if ($arc >= - CAKE && $arc <= CAKE) {
175	'e';
176    } elsif ($arc <= CAKE*3) {
177	'ne';
178    } elsif ($arc <= CAKE*5) {
179	'n';
180    } elsif ($arc <= CAKE*7) {
181	'nw';
182    } elsif ($arc <= CAKE*9) {
183	'w';
184    } elsif ($arc <= CAKE*11) {
185	'sw';
186    } elsif ($arc <= CAKE*13) {
187	's';
188    } elsif ($arc <= CAKE*15) {
189	'se';
190    } elsif ($arc <= CAKE*17) {
191	'e';
192    } elsif ($arc <= CAKE*19) {
193	'ne';
194    } elsif ($arc <= CAKE*21) {
195	'n';
196    } else {
197	warn "Winkel $arc is unknown";
198	undef;
199    }
200}
201
202sub localize_direction {
203    my($dir, $lang) = @_;
204    if ($lang eq 'de') {
205	$dir = { 'N'   => 'Norden',
206		 'NNE' => 'Nordnordosten',
207		 'NE'  => 'Nordosten',
208		 'ENE' => 'Ostnordosten',
209		 'E'   => 'Osten',
210		 'ESE' => 'Osts�dosten',
211		 'SE'  => 'S�dosten',
212		 'SSE' => 'S�ds�dosten',
213		 'S'   => 'S�den',
214		 'SSW' => 'S�ds�dwesten',
215		 'SW'  => 'S�dwesten',
216		 'WSW' => 'Wests�dwesten',
217		 'W'   => 'Westen',
218		 'WNW' => 'Westnordwesten',
219		 'NW'  => 'Nordwesten',
220		 'NNW' => 'Nordnordwesten',
221	       }->{uc($dir)};
222    } else {
223	$dir = { 'N'   => 'north',
224		 'NNE' => 'north-northeast',
225		 'NE'  => 'northeast',
226		 'ENE' => 'east-northeast',
227		 'E'   => 'east',
228		 'ESE' => 'east-southeast',
229		 'SE'  => 'southeast',
230		 'SSE' => 'south-southeast',
231		 'S'   => 'south',
232		 'SSW' => 'south-southwest',
233		 'SW'  => 'southwest',
234		 'WSW' => 'west-southwest',
235		 'W'   => 'west',
236		 'WNW' => 'west-northwest',
237		 'NW'  => 'northwest',
238		 'NNW' => 'north-northwest',
239	       }->{uc($dir)};
240    }
241    $dir;
242}
243
244sub localize_direction_abbrev {
245    my($dir, $lang) = @_;
246    if ($lang eq 'de') {
247	$dir =~ s{E}{O}i;
248    }
249    $dir;
250}
251
2521;
253
254__END__
255