16
$\begingroup$

You should have already seen such a thing, specially in documentaries about ancient life: the movement of a tribe is shown on an ancient map along a route with a dashed arrow. I want to do the same thing in Mathematica.

Given a bitmap image of a map like this one and a list of points on the 2d map such as {{123,233}, {177, 279}, ...}, I want to make a movie that shows an arrow along the given route on the map. The movie looks like it is captured from a helicopter flying on the map.

Edit:

This is what I did after rm -rf♦'s comment:

map = ImageResize[
   Import["http://upload.wikimedia.org/wikipedia/commons/e/e3/China_\
old_map.jpg"], 500];
path = .3 {{300, 500}, {350, 600}, {450, 700}, {600, 750}, {650, 
     750}, {700, 780}, {800, 800}, {850, 900}, {900, 1000}, {1000, 
     1050}, {1100, 1050}, {1150, 1100}};
ListAnimate[
 Table[Show[map, Graphics[{Thick, Dashed, Arrow[Take[path, i]]}], 
   ImageSize -> {500}], {i, Length@path}]]
Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ This shouldn't be very hard to do. Using Line or Arrow to draw the primitives, update the list of points to add a new point as time progresses. This gives you the list of frames for the movie. You can then use ListAnimate or Export as a gif or a movie. If you want a close up view from the top and move along the map as the direction changes, use ImageTake to focus on only a WxH rectangle centered at the latest point. I suggest that you make an attempt first and show us what you've tried. $\endgroup$
    – rm -rf ♦
    Commented Nov 12, 2012 at 21:16
  • $\begingroup$ What you described is just fine for a flat 2d view. But I am looking for a 3d view, that is, the camera is not perpendicular to the map. $\endgroup$
    – Helium
    Commented Nov 12, 2012 at 21:22
  • $\begingroup$ I think you will find many tools you need in @Vitaly's notebook Mastering Dynamic Visualizations and the related video. To map your 2D picture to a plane in 3D Texture may be the right tool (see this Q/A for an example.) $\endgroup$
    – kglr
    Commented Nov 12, 2012 at 21:27
  • $\begingroup$ More in the cineastic sense, this is kind of reminiscent of Indiana Jones travel scenes :-) $\endgroup$
    – Yves Klett
    Commented Nov 13, 2012 at 8:52

3 Answers 3

Reset to default
14
$\begingroup$ 
map = Import["http://upload.wikimedia.org/wikipedia/commons/e/e3/China_old_map.jpg"]
{w, h} = map // ImageDimensions;

The route:

route = {{1107.07`, 184.181`}, {1096.17`, 198.195`}, {1072.81`, 237.121`}, {1071.25`, 244.906`}, {1068.14`, 254.249`}, {1065.03`, 265.148`}, {1063.47`, 274.49`}, {1063.47`, 286.947`}, {1063.47`, 296.289`}, {1063.47`, 308.746`}, {1061.91`, 313.417`}, {1061.91`,  319.645`}, {1057.24`, 338.33`}, {1051.01`, 350.786`}, {1044.78`, 361.685`}, {1037.`, 372.585`}, {1029.21`, 381.927`}, {1019.87`, 388.155`}, {1012.09`, 391.269`}, {1001.19`, 397.498`}, {991.845`, 403.726`}, {980.945`, 409.954`}, {970.046`, 413.068`}, {957.589`,   417.739`}, {943.576`, 425.525`}, {935.791`, 430.196`}, {931.119`, 433.31`}, {924.891`, 437.981`}, {921.777`, 441.095`}, {918.663`, 448.881`}, {915.549`, 451.995`}, {907.764`, 462.894`}, {903.092`, 470.679`}, {899.978`, 481.579`}, {895.307`, 489.364`}, {893.75`,  497.149`}, {892.193`, 504.935`}, {887.522`, 511.163`}, {884.408`, 517.391`}, {882.851`, 525.176`}, {881.294`, 539.19`}, {879.737`,  545.418`}, {878.18`, 550.089`}, {876.622`, 556.317`}, {876.622`, 567.217`}, {876.622`, 578.116`}, {876.622`, 587.459`}, {876.622`, 598.358`}, {876.622`, 603.029`}, {870.394`, 618.6`}, {868.837`, 629.499`}, {862.609`, 643.513`}, {857.938`, 657.526`}, {853.267`, 668.425`}, {848.595`, 680.882`}, {840.81`, 690.224`}, {833.025`, 699.567`}, {825.24`, 707.352`}, {819.011`, 715.137`}, {811.226`, 721.365`}, {800.327`, 729.151`}, {787.87`, 738.493`}, {781.642`, 746.278`}, {775.414`, 752.506`}, {772.3`, 752.506`}, {761.4`, 763.406`}, {744.273`, 783.648`}, {734.93`, 794.547`}, {725.588`, 813.232`}, {714.689`, 830.359`}, {708.46`, 844.373`}, {703.789`, 861.5`}, {700.675`, 873.957`}, {699.118`, 884.856`}, {699.118`, 900.427`}, {700.675`, 911.326`}, {702.232`, 920.669`}, {708.46`, 928.454`}, {720.917`, 940.91`}, {730.259`, 948.696`}, {739.602`, 954.924`}, {759.843`, 965.823`}, {781.642`, 975.165`}, {800.327`, 978.28`}, {815.897`, 979.837`}, {819.011`, 979.837`}, {834.582`, 981.394`}, {853.267`, 984.508`}, {868.837`, 986.065`}, {879.737`, 986.065`}, {890.636`, 987.622`}, {898.421`, 987.622`}, {912.435`, 989.179`}, {923.334`, 990.736`}, {932.677`, 992.293`}, {943.576`, 993.85`}, {954.475`, 995.407`}, {968.489`, 995.407`}, {977.831`, 996.964`}, {987.173`, 998.521`}, {996.516`, 1000.08`}, {1007.42`, 1001.64`}, {1019.87`, 1004.75`}, {1027.66`, 1004.75`}, {1033.89`, 1006.31`}, {1044.78`, 1007.86`}, {1058.8`, 1009.42`}, {1068.14`, 1009.42`}, {1072.81`, 1009.42`}, {1102.4`, 1006.31`}, {1121.08`, 1003.19`}, {1144.44`, 998.521`}, {1156.89`, 996.964`}, {1175.58`, 992.293`}, {1194.26`, 982.951`}, {1206.72`, 978.28`}, {1222.29`, 972.051`}, {1244.09`, 962.709`}, {1258.1`, 958.038`}, {1262.77`, 956.481`}, {1292.36`, 942.467`}, {1326.61`, 933.125`}, {1349.97`, 925.34`}, {1363.98`, 919.111`}, {1370.21`, 917.554`}, {1373.32`, 915.997`}, {1379.55`, 911.326`}, {1384.22`, 908.212`}, {1387.34`, 906.655`}, {1390.45`, 906.655`}, {1395.12`, 901.984`}, {1401.35`, 898.87`}, {1407.58`, 895.756`}, {1410.69`, 894.199`}, {1413.81`, 889.527`}, {1418.48`, 884.856`}, {1421.59`, 883.299`}, {1423.15`, 880.185`}, {1426.26`, 877.071`}, {1430.93`, 872.4`}, {1432.49`, 869.286`}, {1432.49`, 864.614`}, {1435.61`, 858.386`}};

Use ImageComposeto combine route and map:

Manipulate[
 ImageCompose[
   map, 
   Graphics[{Thickness[0.02], Dashed, Arrowheads[.06], Arrow[SplineCurve@Take[route, i]]}, 
   PlotRange -> {{0, w}, {0, h}}]
 ], {i, 1, Length@route, 1}
]

Mathematica graphics

Routines to show a part of the route:

routePart[i_] := Take[route, Max[1, Round[Length[route] i]]]
mapPlusRoute[i_] := 
 ImageCompose[map, 
  Graphics[{Thickness[0.02], Dashed, Arrowheads[.06], 
    Arrow[BSplineCurve@routePart[i]]}, PlotRange -> {{0, w}, {0, h}}]]

Now put it in 3D using Graphics3D and Texture. Add some camera movements and aiming and... presto. I exported the separate frames to process them in an external program, but MMA can make animated GIFs as well.

mc = 1;
Do[
 Export["C:\\Users\\Sjoerd\\Desktop\\Movie\\Movie" <> 
   IntegerString[mc++, 10, 4] <> ".bmp",
  Graphics3D[
   {
    Texture[mapPlusRoute[i]], 
    Polygon[{{0, 0, 0}, {w, 0, 0}, {w, h, 0}, {0, h, 0}}, 
     VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]
    },
   Lighting -> "Neutral",
   Boxed -> False,
   ViewVector -> {{1500 Cos[i 2 \[Pi] ] + w/2, 
      h/2 - 1500 Sin[2 \[Pi] i ], 1000}, 
     Append[routePart[i][[-1]], 0]},
   ViewVertical -> {0, 0, 1},
   ViewAngle -> 25 \[Degree], ImageSize -> 600
   ]
  ],
 {i, 0.07, 1, .005}
 ]

Gif Movie here, uploading didn't work at the moment. The hand-drawn route is a bit rocky but you get the idea.

Improve this answer
$\endgroup$
4
  • $\begingroup$ +1 for the effort, but that GIF has a kind of judder that makes me feel a bit ill after watching it. Do you know of any way to improve that? $\endgroup$
    – Mr.Wizard
    Commented Nov 12, 2012 at 23:15
  • $\begingroup$ @Mr.Wizard The route point set is a bit rough (it was hand drawn, as I wrote above) so the orientation of the arrow isn't very stable (the camera's orientation is dependent on the arrow position as well, so an erratic arrow path doesn't help there either). I just saw that after making the movie, and didn't want to do it all over again. It's the principle that counts, after all. $\endgroup$
    – Sjoerd C. de Vries
    Commented Nov 12, 2012 at 23:21
  • $\begingroup$ @Mr.Wizard Could you try including the GIF in the text itself? When I try to do that, my connection is throttled to a few bytes/sec. Never had that before. $\endgroup$
    – Sjoerd C. de Vries
    Commented Nov 12, 2012 at 23:23
  • 1
    $\begingroup$ The file is 17.5 MB -- probably too large for Imgur. $\endgroup$
    – Mr.Wizard
    Commented Nov 12, 2012 at 23:31
14
$\begingroup$

Here's your approach, but with 3D primitives. You can then move the camera around using your own definition for ViewVector (or you can steal Sjoerd's):

Module[{mapZ = 0, mapDim = ImageDimensions@map, arrowZ = 5, ordering},
    Graphics3D[
        {
            {Texture@map,Polygon[
                List[##, mapZ] & @@@ Tuples[Transpose@{{0, 0}, mapDim}] // 
                    #[[ordering = Rest@First@FindCurvePath@#]] &,
                VertexTextureCoordinates -> Tuples[{0, 1}, 2][[ordering]]
            ]},
            {Red, Thick, Tube[List[##, arrowZ] & @@@ path]}
        },
        Lighting -> "Neutral",Axes -> False, Boxed -> False, BoxRatios -> {1, 1, 1/100}
    ]
]

Improve this answer
$\endgroup$
5
  • $\begingroup$ Why is it not working properly on my computer? $\endgroup$
    – yulinlinyu
    Commented Nov 13, 2012 at 5:23
  • $\begingroup$ I don't know... $\endgroup$
    – rm -rf ♦
    Commented Nov 13, 2012 at 5:27
  • $\begingroup$ @yulinlinyu Perhaps you're on version 7 which doesn't have Texture or your graphics card doesn't support it or ... or... $\endgroup$
    – Sjoerd C. de Vries
    Commented Nov 13, 2012 at 6:06
  • $\begingroup$ @ Sjoerd C. de Vries, it is mathematica 8. No path is displayed on the graph in my computer. $\endgroup$
    – yulinlinyu
    Commented Nov 13, 2012 at 11:00
  • $\begingroup$ @yulinlinyu Maybe the default view in yours is different. Try flipping the map upside down... $\endgroup$
    – rm -rf ♦
    Commented Nov 13, 2012 at 14:51
3
$\begingroup$

Using some Graphics3D construct and changing ViewVector option might do for a good start

map=Import["http://upload.wikimedia.org/wikipedia/commons/e/e3/\
China_old_map.jpg"];

(* Destinations, taken by right clicking image extracting coordinates \
with Get Coordinates *)

destinations = {{1758.32`, 1251.75`}, {877.471`, 509.279`}, {600.73`, 
    802.894`}, {948.343`, 910.891`}, {1076.59`, 617.276`}, {1181.21`, 
    1143.76`}, {1434.33`, 667.899`}, {1464.7`, 904.141`}};

(* Height of helicopter *)
height = 500;

{w, h} = ImageDimensions[map];

(* Interpolate flight path *)
path = Interpolation[MapIndexed[{First[#2], #1} &, destinations]];

(* Polygon with map as texture *)
world = Graphics3D[{
    Texture[map], EdgeForm[Black], 
    Polygon[{{0, 0, 0}, {w, 0, 0}, {w, h, 0}, {0, h, 0}}, 
     VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}];

DynamicModule[{t = 1.1},
 Column[
  {Slider[Dynamic[t], {1, Length[destinations]}],
   Dynamic[t],
   Show[
    world,
    Graphics3D[{Arrowheads[15], 
      Arrow[Dynamic[{Append[path[t - 0.1], 1], Append[path[t], 1]}]]}],
    (* View from height units above path straight down, the 0.0001 is just there to avoid weird rotations *)
    ViewVector -> 
     Dynamic[{Append[path[t], height], 
       Append[path[t], 0] + {0.0001, 0, 0}}]]}]]
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.