1# -*- perl -*-
2
3#
4# $Id: BBBikeTrans.pm,v 1.6 2004/01/17 17:56:08 eserte Exp $
5# Author: Slaven Rezic
6#
7# Copyright (C) 1999 Slaven Rezic. All rights reserved.
8# This package is free software; you can redistribute it and/or
9# modify it under the same terms as Perl itself.
10#
11# Mail: eserte@cs.tu-berlin.de
12# WWW:  http://user.cs.tu-berlin.de/~eserte/
13#
14
15use strict;
16use vars qw($scale $small_scale $medium_scale $verbose);
17
18######################################################################
19#
20# Tranpose-Funktionen
21#
22
23# Transponiert die Daten (y-Achse vertauschen etc.) und setzt das
24# Zentrum auf die Berliner Innenstadt.
25# Diese Funktion bildet praktisch von realcoords (die vermessenen) auf
26# @coords (im canvas) ab.
27# XXX Problem!!!
28# new_create_transpose_subs funktioniert nur im Normalmodus, aber nicht
29# im Editmodus!
30# Kein Autoload-Sub wegen Parsing-Problemen von make_autoload
31sub new_create_transpose_subs {
32    my(%args) = @_;
33    my $x_delta = $args{-xdelta} || -200;
34    my $y_delta = $args{-ydelta} || 600;
35    my $x_mount = $args{-xmount} || 1;
36    my $y_mount = $args{-ymount} || -1;
37    my $scale   = $args{-scale}  || $scale;
38    my $small_scale   = $args{-smallscale}  || $small_scale;
39    my $medium_scale  = $args{-mediumscale} || $medium_scale;
40    local($^W) = undef;
41    my $code = "
42sub transpose_ls_slow {
43    (int(($x_delta+($x_mount)*" . '$_[0]' . "/25)*$scale),
44     int(($y_delta+($y_mount)*" . '$_[1]' . "/25)*$scale));
45}
46sub transpose_pt {
47    (int((  $y_delta +($y_mount)*" . '$_[1]' . "/25)*$scale),
48     int((-($x_delta)-($x_mount)*" . '$_[0]' . "/25)*$scale));
49}
50# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $small_scale)
51sub transpose_ls_small {
52    (int(($x_delta+($x_mount)*" . '$_[0]' . "/25)*$small_scale),
53     int(($y_delta+($y_mount)*" . '$_[1]' . "/25)*$small_scale));
54}
55sub transpose_pt_small {
56    (int((  $y_delta +($y_mount)*" . '$_[1]' . "/25)*$small_scale),
57     int((-($x_delta)-($x_mount)*" . '$_[0]' . "/25)*$small_scale));
58}
59# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $medium_scale)
60sub transpose_ls_medium {
61    (int(($x_delta+($x_mount)*" . '$_[0]' . "/25)*$medium_scale),
62     int(($y_delta+($y_mount)*" . '$_[1]' . "/25)*$medium_scale));
63}
64sub transpose_pt_medium {
65    (int((  $y_delta +($y_mount)*" . '$_[1]' . "/25)*$medium_scale),
66     int((-($x_delta)-($x_mount)*" . '$_[0]' . "/25)*$medium_scale));
67}
68# wie transpose_ls, nur ohne x und y_delta. F�r das Berechnen von Breiten
69# und H�hen geeignet
70sub transpose_ls_abs {
71    (int((" . '$_[0]' . "/25)*$scale),
72     int((" . '$_[1]' . "/25)*$scale));
73}
74# Diese Funktion bildet von coords (im canvas) auf realcoords ab.
75sub anti_transpose_ls {
76    (int(($x_mount*" . '$_[0]' . "/$scale-($x_delta))*25),
77     int(($y_mount*" . '$_[1]' . "/$scale+($y_delta))*25));
78}
79sub anti_transpose_pt {
80    (int((-($x_delta)-($x_mount)*" . '$_[1]' . "/$scale)*25),
81     int((  $y_delta +($y_mount)*" . '$_[0]' . "/$scale)*25));
82}
83";
84#XXX anti_transpose_ls_medium etc. missing
85    warn $code if $verbose;
86    eval $code;
87    warn $@ if $@;
88}
89
90# old static transpose/anti_transpose functions
91# Wird verwendet!!!
92# kann gel�scht werden, wenn new_create_transpose_subs auch im Edit-Modus
93# funktioniert.
94# dann kann new_create_transpose_subs nach create_transpose_subs
95# umbenannt und die symbolische Referenz f�r create_transpose_subs
96# gel�scht werden.
97my $create_transpose_subs_created = 0; # nur einmal erzeugen
98# Kein Autoload-Sub wegen Parsing-Problemen von make_autoload
99sub old_create_transpose_subs {
100    return if ($create_transpose_subs_created);
101    $create_transpose_subs_created++;
102    my $code = '
103sub transpose_ls_slow {
104    (int((-200+$_[0]/25)*$scale), int((600-$_[1]/25)*$scale));
105}
106sub transpose_pt {
107    (int((600-$_[1]/25)*$scale), int((200-$_[0]/25)*$scale));
108}
109# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $small_scale)
110sub transpose_ls_small {
111    (int((-200+$_[0]/25)*$small_scale), int((600-$_[1]/25)*$small_scale));
112}
113sub transpose_pt_small {
114    (int((600-$_[1]/25)*$small_scale), int((200-$_[0]/25)*$small_scale));
115}
116# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $medium_scale)
117sub transpose_ls_medium {
118    (int((-200+$_[0]/25)*$medium_scale), int((600-$_[1]/25)*$medium_scale));
119}
120sub transpose_pt_medium {
121    (int((600-$_[1]/25)*$medium_scale), int((200-$_[0]/25)*$medium_scale));
122}
123# wie transpose_ls, nur ohne x und y_delta. F�r das Berechnen von Breiten
124# und H�hen geeignet
125sub transpose_ls_abs {
126    (int(($_[0]/25)*$scale), int(($_[1]/25)*$scale));
127}
128# Diese Funktion bildet von coords (im canvas) auf realcoords ab.
129sub anti_transpose_ls {
130    (int(($_[0]/$scale+200)*25), int((600-$_[1]/$scale)*25));
131}
132sub anti_transpose_pt {
133    (int((200-$_[1]/$scale)*25), int((600-$_[0]/$scale)*25));
134}
135# wie anti_transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $small_scale)
136sub anti_transpose_ls_small {
137    (int(($_[0]/$small_scale+200)*25), int((600-$_[1]/$small_scale)*25));
138}
139sub anti_transpose_pt_small {
140    (int((200-$_[1]/$small_scale)*25), int((600-$_[0]/$small_scale)*25));
141}
142# wie anti_transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $medium_scale)
143sub anti_transpose_ls_medium {
144    (int(($_[0]/$medium_scale+200)*25), int((600-$_[1]/$medium_scale)*25));
145}
146sub anti_transpose_pt_medium {
147    (int((200-$_[1]/$medium_scale)*25), int((600-$_[0]/$medium_scale)*25));
148}
149';
150    warn $code if $verbose;
151    eval $code;
152    warn $@ if $@;
153}
154
155# Besser, da nicht mit ints gearbeitet wird (vor allem beim Reinzoomen!).
156# K�nnte auf Maschinen ohne FPU langsamer sein.
157my $create_transpose_subs_no_int_created = 0;
158sub old_create_transpose_subs_no_int {
159    return if ($create_transpose_subs_no_int_created);
160    #warn "XXX Using old_create_transpose_subs_no_int ...\n";
161    $create_transpose_subs_no_int_created++;
162    my $code = '
163sub transpose_ls_slow {
164    ((-200+$_[0]/25)*$scale, (600-$_[1]/25)*$scale);
165}
166sub transpose_pt {
167    ((600-$_[1]/25)*$scale, (200-$_[0]/25)*$scale);
168}
169# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $small_scale)
170sub transpose_ls_small {
171    ((-200+$_[0]/25)*$small_scale, (600-$_[1]/25)*$small_scale);
172}
173sub transpose_pt_small {
174    ((600-$_[1]/25)*$small_scale, (200-$_[0]/25)*$small_scale);
175}
176# wie transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $medium_scale)
177sub transpose_ls_medium {
178    ((-200+$_[0]/25)*$medium_scale, (600-$_[1]/25)*$medium_scale);
179}
180sub transpose_pt_medium {
181    ((600-$_[1]/25)*$medium_scale, (200-$_[0]/25)*$medium_scale);
182}
183# wie transpose_ls, nur ohne x und y_delta. F�r das Berechnen von Breiten
184# und H�hen geeignet
185sub transpose_ls_abs {
186    (($_[0]/25)*$scale, ($_[1]/25)*$scale);
187}
188# Diese Funktion bildet von coords (im canvas) auf realcoords ab.
189sub anti_transpose_ls {
190    (($_[0]/$scale+200)*25, (600-$_[1]/$scale)*25);
191}
192sub anti_transpose_pt {
193    ((200-$_[1]/$scale)*25, (600-$_[0]/$scale)*25);
194}
195# wie anti_transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $small_scale)
196sub anti_transpose_ls_small {
197    (($_[0]/$small_scale+200)*25, (600-$_[1]/$small_scale)*25);
198}
199sub anti_transpose_pt_small {
200    ((200-$_[1]/$small_scale)*25, (600-$_[0]/$small_scale)*25);
201}
202# wie anti_transpose_ls, nur f�r das Overview-Fenster (Verkleinerung: $medium_scale)
203sub anti_transpose_ls_medium {
204    (($_[0]/$medium_scale+200)*25, (600-$_[1]/$medium_scale)*25);
205}
206sub anti_transpose_pt_medium {
207    ((200-$_[1]/$medium_scale)*25, (600-$_[0]/$medium_scale)*25);
208}
209';
210    warn $code if $verbose;
211    eval $code;
212    warn $@ if $@;
213}
214
215# Transponiert die �bergebene Liste und gibt sie zur�ck.
216# ([x1,y1],[x2,y2],...) => ([tx1,ty1],[tx2,ty2],...)
217sub transpose_all {
218    my @res;
219    foreach (@_) {
220	push @res, [transpose(@$_)];
221    }
222    @res;
223}
224
225# Transponiert die �bergebene Liste zur�ck und gibt sie zur�ck.
226# ([x1,y1],[x2,y2],...) => ([tx1,ty1],[tx2,ty2],...)
227sub anti_transpose_all {
228    my @res;
229    foreach (@_) {
230	push @res, [anti_transpose(@$_)];
231    }
232    @res;
233}
234
2351;
236
237__END__
238