mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-09 07:03:11 +00:00
Country distortion video (#54)
* Support GeoJSON. * Fix framerate issue for gifs. * Vastly improve performance for SVG serialization. Former-commit-id: b0dbb06b8810d56aa993d7138dd97c9e514db2e3
This commit is contained in:
David Himmelstrup
GitHub
parent
b466bcc6be
commit
458da0f2ec
20 changed files with 1045 additions and 108 deletions
|
|
@ -3,3 +3,4 @@
|
|||
* https://cc0textures.com/
|
||||
* https://www.publicdomainpictures.net/en/index.php
|
||||
* https://www.naturalearthdata.com/
|
||||
* https://github.com/Flow-Based-Cartograms/go_cart
|
||||
|
|
|
|||
|
|
@ -9,4 +9,4 @@ import Reanimate.Builtin.Images
|
|||
main :: IO ()
|
||||
main = reanimate $ animate $
|
||||
const $ scaleToSize screenWidth screenHeight $
|
||||
embedImage $ project smallEarth (orthoP 0 0)
|
||||
embedImage $ project smallEarth (orthoP $ LonLat 0 0)
|
||||
|
|
|
|||
|
|
@ -81,12 +81,13 @@ library
|
|||
Paths_reanimate
|
||||
build-depends: base >=4.10 && <5,
|
||||
time, text, filepath, process, directory,
|
||||
containers, reanimate-svg >= 0.9.4.0, xml, bytestring, lens, linear, mtl, matrix,
|
||||
containers, reanimate-svg >= 0.9.7.0, xml, bytestring, lens, linear, mtl, matrix,
|
||||
JuicyPixels, attoparsec, parallel,
|
||||
cubicbezier, websockets,
|
||||
hashable, fsnotify, open-browser, random-shuffle, base64-bytestring,
|
||||
vector, colour, cassava, ansi-wl-pprint, here, temporary,
|
||||
optparse-applicative, chiphunk >= 0.1.2.1
|
||||
optparse-applicative, chiphunk >= 0.1.2.1,
|
||||
geojson, aeson >= 1.3.0.0
|
||||
ghc-options: -Wall
|
||||
|
||||
test-suite spec
|
||||
|
|
|
|||
|
|
@ -21,13 +21,13 @@ embedImage key = do
|
|||
Nothing -> error "Malformed svg"
|
||||
Just svg -> return $ embedDocument svg
|
||||
|
||||
loadJPG :: FilePath -> Image PixelRGB8
|
||||
loadJPG :: FilePath -> Image PixelRGBA8
|
||||
loadJPG key = unsafePerformIO $ do
|
||||
jpg_file <- getDataFileName key
|
||||
dat <- B.readFile jpg_file
|
||||
case decodeJpeg dat of
|
||||
Left err -> error err
|
||||
Right img -> return $ convertRGB8 img
|
||||
Right img -> return $ convertRGBA8 img
|
||||
|
||||
{- HLINT ignore svgLogo -}
|
||||
-- | <<docs/gifs/doc_svgLogo.gif>>
|
||||
|
|
@ -47,5 +47,5 @@ githubIcon = unsafePerformIO $ embedImage "data/github-icon.svg"
|
|||
-- | 300x150 equirectangular earth
|
||||
--
|
||||
-- <<docs/gifs/doc_smallEarth.gif>>
|
||||
smallEarth :: Image PixelRGB8
|
||||
smallEarth :: Image PixelRGBA8
|
||||
smallEarth = loadJPG "data/small_earth.jpg"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
module Reanimate.GeoProjection
|
||||
( Projection(..)
|
||||
, XYCoord(..)
|
||||
|
|
@ -31,16 +32,31 @@ module Reanimate.GeoProjection
|
|||
, faheyP
|
||||
, foucautP
|
||||
, lagrangeP
|
||||
-- * GeoJSON helpers
|
||||
, drawFeatureCollection -- :: GeoFeatureCollection a -> (a -> SVG -> SVG) -> SVG
|
||||
, loadFeatureCollection -- :: FromJSON a => FilePath -> (a -> SVG -> SVG) -> SVG
|
||||
, applyProjection -- :: Projection -> SVG -> SVG
|
||||
, applyProjection' -- :: Double -> Projection -> SVG -> SVG
|
||||
, renderGeometry
|
||||
) where
|
||||
|
||||
import Codec.Picture
|
||||
import Codec.Picture.Types
|
||||
import Control.Lens ((^.))
|
||||
import Control.Monad
|
||||
import Control.Monad.ST
|
||||
-- import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Aeson
|
||||
import Data.Foldable
|
||||
import Data.Geospatial hiding (LonLat)
|
||||
import Data.LinearRing
|
||||
import qualified Data.LineString as Line
|
||||
import Debug.Trace
|
||||
import Graphics.SvgTree (Tree (None))
|
||||
import Linear (distance, lerp)
|
||||
import Linear.V2 hiding (angle)
|
||||
import Reanimate
|
||||
import System.IO.Unsafe
|
||||
|
||||
|
||||
-- Constants
|
||||
halfPi, sqrtPi, sqrt2, epsilon, tau :: Double
|
||||
|
|
@ -54,31 +70,34 @@ toRads, cot :: Double -> Double
|
|||
toRads dec = dec/180 * pi
|
||||
cot = recip . tan
|
||||
|
||||
srcPixel :: Image PixelRGB8 -> LonLat -> PixelRGB8
|
||||
srcPixel :: Pixel pixel => Image pixel -> LonLat -> pixel
|
||||
srcPixel src (LonLat lam phi) =
|
||||
pixelAt src xPx yPx
|
||||
where
|
||||
xPx = round $ ((lam+pi)/tau) * fromIntegral (imageWidth src-1)
|
||||
yPx = round $ (1-((phi+halfPi)/pi)) * fromIntegral (imageHeight src-1)
|
||||
!xPx = round $ ((lam+pi)/tau) * fromIntegral (imageWidth src-1)
|
||||
!yPx = round $ (1-((phi+halfPi)/pi)) * fromIntegral (imageHeight src-1)
|
||||
|
||||
{- HLINT ignore -}
|
||||
findValidCoord :: Image PixelRGB8 -> Projection -> XYCoord -> XYCoord
|
||||
findValidCoord src p (XYCoord x y) = fromMaybe (XYCoord x y) $ listToMaybe
|
||||
findValidCoord :: Image pixel -> Projection -> XYCoord -> XYCoord
|
||||
findValidCoord !src !p (XYCoord x y) = foldr const (XYCoord x y)
|
||||
[ XYCoord x' y'
|
||||
| let xi = round $ x * wMax
|
||||
yi = round $ y * hMax
|
||||
, ax <- [xi, xi-1, xi+1]
|
||||
, ay <- [yi, yi-1, yi+1]
|
||||
, ax >= 0 && ax < w && ay >= 0 && ay < h
|
||||
, let x' = fromIntegral ax / wMax
|
||||
y' = fromIntegral ay / hMax
|
||||
, validLonLat $ projectionInverse p (XYCoord x' y')
|
||||
| let !xi = round $ x * wMax
|
||||
!yi = round $ y * hMax
|
||||
, !ax <- [xi, xi-1, xi+1]
|
||||
, ax >= 0
|
||||
, ax < w
|
||||
, let !x' = fromIntegral ax / wMax
|
||||
, !ay <- [yi, yi-1, yi+1]
|
||||
, ay >= 0
|
||||
, ay < h
|
||||
, let !y' = fromIntegral ay / hMax
|
||||
, validLonLat $! projectionInverse p $! XYCoord x' y'
|
||||
]
|
||||
where
|
||||
w = imageWidth src
|
||||
h = imageHeight src
|
||||
wMax = fromIntegral (w-1)
|
||||
hMax = fromIntegral (h-1)
|
||||
!w = imageWidth src
|
||||
!h = imageHeight src
|
||||
!wMax = fromIntegral (w-1)
|
||||
!hMax = fromIntegral (h-1)
|
||||
|
||||
isInWorld :: Projection -> XYCoord -> Bool
|
||||
isInWorld p coord =
|
||||
|
|
@ -109,7 +128,7 @@ worldPolygon p =
|
|||
| n <- [0..steps-1]]
|
||||
|
||||
findNearestPixel :: MutableImage s PixelRGBA8 -> Int -> Int -> Int -> Int -> ST s PixelRGBA8
|
||||
findNearestPixel src w h srcX srcY = worker
|
||||
findNearestPixel src w h srcX srcY = worker $ take 20
|
||||
[ (x, y)
|
||||
| n <- [1..]
|
||||
, x <- [srcX-n .. srcY+n]
|
||||
|
|
@ -120,7 +139,7 @@ findNearestPixel src w h srcX srcY = worker
|
|||
, y < h
|
||||
]
|
||||
where
|
||||
worker [] = undefined
|
||||
worker [] = pure $ PixelRGBA8 0xFF 0x00 0x00 0xFF
|
||||
worker ((x,y):rest) = do
|
||||
this <- readPixel src x y
|
||||
if this == blank
|
||||
|
|
@ -128,9 +147,9 @@ findNearestPixel src w h srcX srcY = worker
|
|||
else return this
|
||||
blank = PixelRGBA8 0x00 0x00 0x00 0x00
|
||||
|
||||
interpP :: Image PixelRGB8 -> Projection -> Projection -> Double -> Image PixelRGBA8
|
||||
interpP src p1 p2 t = runST $ do
|
||||
img <- newMutableImage w h
|
||||
interpP :: Image PixelRGBA8 -> Projection -> Projection -> Double -> Image PixelRGBA8
|
||||
interpP !src !p1 !p2 !t = runST $ do
|
||||
!img <- newMutableImage w h
|
||||
let blank = PixelRGBA8 0x00 0x00 0x00 0x00
|
||||
let isBlank pixel = pixel == blank
|
||||
-- forM_ [0..w-1] $ \x ->
|
||||
|
|
@ -140,46 +159,56 @@ interpP src p1 p2 t = runST $ do
|
|||
-- when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $
|
||||
-- writePixel img x y $ PixelRGBA8 0xFF 0x00 0x00 0xFF
|
||||
let factor = 2
|
||||
forM_ [0..(w*factor)-1] $ \x ->
|
||||
forM_ [0..(h*factor)-1] $ \y -> do
|
||||
let x1' = fromIntegral x / (wMax*fromIntegral factor)
|
||||
y1' = fromIntegral y / (hMax*fromIntegral factor)
|
||||
lonlat = projectionInverse p1 (XYCoord x1' y1')
|
||||
XYCoord x1 y1 = projectionForward p1 lonlat
|
||||
XYCoord x2 y2 = findValidCoord src p2 $ projectionForward p2 lonlat
|
||||
x3 = round $ fromToS x1 x2 t * wMax
|
||||
y3 = round $ (1 - fromToS y1 y2 t) * hMax
|
||||
when (validLonLat lonlat && validXYCoord (XYCoord x2 y2)) $
|
||||
when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $
|
||||
writePixel img x3 y3 (promotePixel $ srcPixel src lonlat)
|
||||
forM_ [0..(w*factor)-1] $ \x ->
|
||||
forM_ [0..(h*factor)-1] $ \y -> do
|
||||
let x2' = fromIntegral x / (wMax*fromIntegral factor)
|
||||
y2' = fromIntegral y / (hMax*fromIntegral factor)
|
||||
lonlat = projectionInverse p2 (XYCoord x2' y2')
|
||||
XYCoord x2 y2 = projectionForward p2 lonlat
|
||||
XYCoord x1 y1 = findValidCoord src p1 $ projectionForward p1 lonlat
|
||||
-- (x2,y2) = p2 lam phi
|
||||
x3 = round $ fromToS x1 x2 t * wMax
|
||||
y3 = round $ (1 - fromToS y1 y2 t) * hMax
|
||||
when (validLonLat lonlat && validXYCoord (XYCoord x1 y1)) $
|
||||
when (validLonLat lonlat) $
|
||||
when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $
|
||||
writePixel img x3 y3 (promotePixel $ srcPixel src lonlat)
|
||||
forM_ [1..w-1] $ \x ->
|
||||
forM_ [0..h-1] $ \y -> do
|
||||
let x1 = fromIntegral x / wMax
|
||||
y1 = 1 - fromIntegral y / hMax
|
||||
this <- readPixel img x y
|
||||
when (isBlank this) $
|
||||
when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $
|
||||
writePixel img x y =<< findNearestPixel img w h x y
|
||||
let l1 =
|
||||
loopTo (w*factor) $ \x -> do
|
||||
loopTo (h*factor) $ \y -> do
|
||||
let !x1' = fromIntegral x / (wMax*fromIntegral factor)
|
||||
!y1' = fromIntegral y / (hMax*fromIntegral factor)
|
||||
!lonlat = projectionInverse p1 $! XYCoord x1' y1'
|
||||
p = srcPixel src lonlat
|
||||
when (validLonLat lonlat && pixelOpacity p /= 0) $ do
|
||||
let XYCoord x1 y1 = projectionForward p1 lonlat
|
||||
XYCoord x2 y2 = findValidCoord src p2 $ projectionForward p2 lonlat
|
||||
!x3 = round $ fromToS x1 x2 t * wMax
|
||||
!y3 = round $ (1 - fromToS y1 y2 t) * hMax
|
||||
when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $
|
||||
writePixel img x3 y3 p
|
||||
l2 =
|
||||
loopTo (w*factor) $ \x ->
|
||||
loopTo (h*factor) $ \y -> do
|
||||
let !x2' = fromIntegral x / (wMax*fromIntegral factor)
|
||||
!y2' = fromIntegral y / (hMax*fromIntegral factor)
|
||||
!lonlat = projectionInverse p2 (XYCoord x2' y2')
|
||||
p = srcPixel src lonlat
|
||||
when (validLonLat lonlat && pixelOpacity p /= 0) $ do
|
||||
let XYCoord x2 y2 = projectionForward p2 lonlat
|
||||
XYCoord x1 y1 = findValidCoord src p1 $ projectionForward p1 lonlat
|
||||
!x3 = round $ fromToS x1 x2 t * wMax
|
||||
!y3 = round $ (1 - fromToS y1 y2 t) * hMax
|
||||
when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $ do
|
||||
writePixel img x3 y3 p
|
||||
if t < 0.5
|
||||
then l1 >> l2
|
||||
else l2 >> l1
|
||||
|
||||
when False $
|
||||
forM_ [0..w-1] $ \x ->
|
||||
forM_ [0..h-1] $ \y -> do
|
||||
let x1 = fromIntegral x / (wMax)
|
||||
y1 = 1 - fromIntegral y / (hMax)
|
||||
this <- readPixel img x y
|
||||
when (isBlank this) $
|
||||
when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $
|
||||
writePixel img x y =<< findNearestPixel img w h x y
|
||||
unsafeFreezeImage img
|
||||
where
|
||||
w = imageWidth src
|
||||
h = imageHeight src
|
||||
wMax = fromIntegral (w-1)
|
||||
hMax = fromIntegral (h-1)
|
||||
loopTo m fn = go m
|
||||
where go 0 = return ()
|
||||
go n = fn (n-1) >> go (n-1)
|
||||
!w = imageWidth src
|
||||
!h = imageHeight src
|
||||
!wMax = fromIntegral (w-1)
|
||||
!hMax = fromIntegral (h-1)
|
||||
|
||||
eqLonLat :: LonLat -> LonLat -> Bool
|
||||
eqLonLat (LonLat x1 y1) (LonLat x2 y2)
|
||||
|
|
@ -192,17 +221,17 @@ eqCoords (XYCoord x1 y1) (XYCoord x2 y2)
|
|||
eqDouble :: Double -> Double -> Bool
|
||||
eqDouble a b = abs (a-b) < epsilon
|
||||
|
||||
data XYCoord = XYCoord Double Double -- 0 to 1
|
||||
data XYCoord = XYCoord !Double !Double -- 0 to 1
|
||||
deriving (Read,Show,Eq,Ord)
|
||||
data LonLat = LonLat Double Double -- -pi to +pi, -halfPi to +halfPi
|
||||
data LonLat = LonLat !Double !Double -- -pi to +pi, -halfPi to +halfPi
|
||||
deriving (Read,Show,Eq,Ord)
|
||||
data Projection = Projection
|
||||
{ projectionForward :: LonLat -> XYCoord
|
||||
, projectionInverse :: XYCoord -> LonLat
|
||||
{ projectionForward :: !(LonLat -> XYCoord)
|
||||
, projectionInverse :: !(XYCoord -> LonLat)
|
||||
}
|
||||
|
||||
-- FIXME: Verify that 'src' has an aspect ratio of 2:1.
|
||||
project :: Image PixelRGB8 -> Projection -> Image PixelRGBA8
|
||||
project :: Image PixelRGBA8 -> Projection -> Image PixelRGBA8
|
||||
project src (Projection _ pInv) = generateImage fn w h
|
||||
where
|
||||
w = imageWidth src
|
||||
|
|
@ -213,15 +242,15 @@ project src (Projection _ pInv) = generateImage fn w h
|
|||
lonlat = pInv (XYCoord x y)
|
||||
in
|
||||
if validLonLat lonlat
|
||||
then promotePixel (srcPixel src lonlat)
|
||||
then srcPixel src lonlat
|
||||
else PixelRGBA8 0 0 0 0
|
||||
|
||||
validLonLat :: LonLat -> Bool
|
||||
validLonLat (LonLat lam phi) =
|
||||
lam >= -pi && lam <= pi && phi >= -pi/2 && phi <= pi/2
|
||||
|
||||
validXYCoord :: XYCoord -> Bool
|
||||
validXYCoord (XYCoord x y) = x >= 0 && x <= 1 && y >= 0 && y <= 1
|
||||
_validXYCoord :: XYCoord -> Bool
|
||||
_validXYCoord (XYCoord x y) = x >= 0 && x <= 1 && y >= 0 && y <= 1
|
||||
|
||||
isValidP :: Projection -> Bool
|
||||
isValidP (Projection p pInv) = and
|
||||
|
|
@ -302,7 +331,7 @@ mercatorP = Projection forward inverse
|
|||
where
|
||||
forward (LonLat lam phi) =
|
||||
XYCoord ((lam+pi)/tau)
|
||||
((log(tan(pi/4+phi/2)) + pi)/tau)
|
||||
(min 1 $ max (0) $ (((log(tan(pi/4+phi/2))) + pi)/tau))
|
||||
inverse (XYCoord x y) = LonLat xPi (atan (sinh yPi))
|
||||
where
|
||||
xPi = fromToS (-pi) pi x
|
||||
|
|
@ -362,7 +391,7 @@ lambertP = Projection forward inverse
|
|||
|
||||
-- | <<docs/gifs/doc_bottomleyP.gif>>
|
||||
bottomleyP :: Double -> Projection
|
||||
bottomleyP phi_1 = Projection forward inverse
|
||||
bottomleyP !phi_1 = Projection forward inverse
|
||||
where
|
||||
forward (LonLat lam phi) =
|
||||
XYCoord ((x+pi)/tau) ((y+pi/2)/pi)
|
||||
|
|
@ -404,7 +433,7 @@ wernerP = moveTopP 0.23 $ Projection forward inverse
|
|||
XYCoord ((x+pi)/tau) ((y+pi/2)/pi)
|
||||
where
|
||||
rho = pi/2 - phi
|
||||
e = lam * sin rho / rho
|
||||
e = if rho == 0 then rho else lam * sin rho / rho
|
||||
x = rho * sin e
|
||||
y = pi/2 - rho * cos e
|
||||
inverse (XYCoord x' y') = LonLat lam phi
|
||||
|
|
@ -441,18 +470,23 @@ bonneP phi_0 = moveTopP (-0.17*factor) $ scaleP 1 (fromToS 1 0.65 factor) $ Proj
|
|||
lam = rho / cos phi * atan2 x (cotPhi0-y)
|
||||
|
||||
-- | <<docs/gifs/doc_orthoP.gif>>
|
||||
orthoP :: Double -> Double -> Projection
|
||||
orthoP lam_0 phi_0 = Projection forward inverse
|
||||
orthoP :: LonLat -> Projection
|
||||
orthoP (LonLat lam_0 phi_0) = Projection forward inverse
|
||||
where
|
||||
forward (LonLat lam phi)
|
||||
| (lam+lam_0) < -halfPi || (lam+lam_0) > halfPi ||
|
||||
(phi+phi_0) < -halfPi/2 || (phi+phi_0) > halfPi/2
|
||||
= XYCoord (0/0) (0/0)
|
||||
forward (LonLat lam phi) =
|
||||
XYCoord ((x+(16/9))/(16/9*2)) ((y+1)/2)
|
||||
| cosc < 0 =
|
||||
let ang = atan2 y x
|
||||
xV = cos ang
|
||||
yV = sin ang
|
||||
xPos = 7/32 + ((xV+1)/2 * 9/16)
|
||||
in -- trace (show (x,y)) $
|
||||
XYCoord xPos ((yV+1)/2)
|
||||
--XYCoord (0/0) (0/0)
|
||||
| otherwise = XYCoord ((x+(16/9))/(16/9*2)) ((y+1)/2)
|
||||
where
|
||||
x = cos phi * sin (lam - lam_0)
|
||||
y = cos phi_0 * sin phi - sin phi_0 * cos phi * cos (lam - lam_0)
|
||||
cosc = sin phi_0 * sin phi + cos phi_0 * cos phi * cos (lam-lam_0)
|
||||
inverse (XYCoord x' y') = LonLat lam phi
|
||||
where
|
||||
x = fromToS (-16/9) (16/9) x'
|
||||
|
|
@ -460,8 +494,8 @@ orthoP lam_0 phi_0 = Projection forward inverse
|
|||
lam = wrap (-pi) pi $
|
||||
lam_0 + atan2 (x * sin c) (rho * cos c * cos phi_0 - y * sin c * sin phi_0)
|
||||
phi = wrap (-pi/2) (pi/2) $
|
||||
asin ((cos c * sin phi_0 + y * sin c * cos phi_0)/rho)
|
||||
rho = sqrt (x**2 + y**2)
|
||||
asin (cos c * sin phi_0 + (y * sin c * cos phi_0)/rho)
|
||||
rho = sqrt (x*x + y*y)
|
||||
c = asin rho
|
||||
wrap lower upper v
|
||||
| v > upper = v-upper+lower
|
||||
|
|
@ -668,3 +702,90 @@ lagrangeP = Projection forward inverse
|
|||
t' = ((1+t) / (1-t)) ** (1/n)
|
||||
lam = atan2 (2*x) (1-x2-y2) / n
|
||||
phi = asin ((t'-1)/(t'+1))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
drawFeatureCollection :: GeoFeatureCollection a -> (a -> SVG -> SVG) -> SVG
|
||||
drawFeatureCollection geo fn = mkGroup
|
||||
[ fn (feature ^. properties) $ renderGeometry (feature ^. geometry)
|
||||
| feature <- toList (geo ^. geofeatures)
|
||||
]
|
||||
|
||||
{-# INLINE loadFeatureCollection #-}
|
||||
loadFeatureCollection :: FromJSON a => FilePath -> (a -> SVG -> SVG) -> SVG
|
||||
loadFeatureCollection path = unsafePerformIO $ do
|
||||
mbGeo <- decodeFileStrict path
|
||||
case mbGeo of
|
||||
Nothing -> error $ "loadFeatureCollection: Invalid GeoJSON: " ++ path
|
||||
Just geo -> return (drawFeatureCollection geo)
|
||||
|
||||
-- drawFeatureCollection :: GeoFeatureCollection a -> (a -> SVG -> SVG) -> SVG
|
||||
-- loadFeatureColection :: FromJSON a => FilePath -> (a -> SVG -> SVG) -> SVG
|
||||
-- modifyPoints :: ((Double,Double) -> (Double, Double)) -> SVG -> SVG
|
||||
-- pointsToRadians :: SVG -> SVG
|
||||
-- applyProjection :: Projection -> SVG -> SVG
|
||||
|
||||
renderGeometry :: GeospatialGeometry -> SVG
|
||||
renderGeometry shape =
|
||||
case shape of
|
||||
MultiPolygon mpolygon ->
|
||||
mkGroup $ map (renderGeometry . Polygon) $ toList (splitGeoMultiPolygon mpolygon)
|
||||
Polygon poly ->
|
||||
mkGroup
|
||||
[ mkLinePath section
|
||||
| section <- pure
|
||||
[ (x, y)
|
||||
| PointXY x y <- map retrieveXY (fromLinearRing (head (toList (poly^.unGeoPolygon))))
|
||||
]
|
||||
]
|
||||
Line line ->
|
||||
mkLinePath
|
||||
[ (x, y)
|
||||
| PointXY x y <- map retrieveXY (Line.fromLineString (line ^. unGeoLine))
|
||||
]
|
||||
MultiLine ml ->
|
||||
mkGroup $ map (renderGeometry . Line) $ toList (splitGeoMultiLine ml)
|
||||
_ -> None
|
||||
|
||||
|
||||
applyProjection :: Projection -> SVG -> SVG
|
||||
applyProjection = applyProjection' 1e-2
|
||||
|
||||
applyProjection' :: Double -> Projection -> SVG -> SVG
|
||||
applyProjection' tolerance p = mapSvgLines start
|
||||
where
|
||||
start (LineMove x:rest) = LineMove (proj x) : worker x rest
|
||||
start _ = []
|
||||
worker a (LineEnd b : rest) =
|
||||
let (x:xs) = reverse $ drop 1 $ mkChunks a b
|
||||
in map (\v -> LineBezier [v]) (map proj $ reverse xs) ++ LineEnd (proj x) : start rest
|
||||
worker a (LineBezier [b] : rest) =
|
||||
let (x:xs) = reverse $ drop 1 $ mkChunks a b
|
||||
in map (\v -> LineBezier [v]) (map proj $ reverse xs) ++ LineBezier [proj x] : worker x rest
|
||||
worker _ (LineBezier ps : rest) =
|
||||
LineBezier (map proj ps) : worker (last ps) rest
|
||||
worker _ (LineMove x:rest) = LineMove (proj x) : worker x rest
|
||||
worker _ [] = []
|
||||
lowTolerance = tolerance*tolerance
|
||||
|
||||
proj (V2 lam phi) =
|
||||
case projectionForward p $ LonLat lam phi of
|
||||
XYCoord x y -> V2 x y
|
||||
mkChunks a b =
|
||||
let midway = lerp 0.5 a b in
|
||||
if distance (proj a) (proj b) < tolerance || distance a b < lowTolerance
|
||||
then [a, b]
|
||||
else mkChunks a midway ++ drop 1 (mkChunks midway b)
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ module Reanimate.Raster
|
|||
, embedDynamicImage
|
||||
, embedPng
|
||||
, raster
|
||||
, rasterSized
|
||||
, vectorize
|
||||
, vectorize_
|
||||
, svgAsPngFile
|
||||
|
|
@ -90,8 +91,11 @@ embedDynamicImage img = embedPng width height imgData
|
|||
|
||||
|
||||
raster :: Tree -> DynamicImage
|
||||
raster svg = unsafePerformIO $ do
|
||||
png <- B.readFile (svgAsPngFile svg)
|
||||
raster = rasterSized 2560 1440
|
||||
|
||||
rasterSized :: Int -> Int -> Tree -> DynamicImage
|
||||
rasterSized w h svg = unsafePerformIO $ do
|
||||
png <- B.readFile (svgAsPngFile' w h svg)
|
||||
case decodePng png of
|
||||
Left{} -> error "bad image"
|
||||
Right img -> return img
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@ render ani target raster format width height fps = do
|
|||
,"-vf", "fps="++show fps++",scale=320:-1:flags=lanczos,palettegen"
|
||||
,"-t", showFFloat Nothing (duration ani) ""
|
||||
, palette ]
|
||||
runCmd ffmpeg ["-i", template, "-y"
|
||||
runCmd ffmpeg ["-framerate", show fps,"-i", template, "-y"
|
||||
,"-i", palette
|
||||
,"-progress", progress
|
||||
,"-filter_complex"
|
||||
|
|
|
|||
|
|
@ -12,7 +12,9 @@ import Control.Monad.State
|
|||
import Graphics.SvgTree hiding (height, line, path, use,
|
||||
width)
|
||||
import Linear.V2 hiding (angle)
|
||||
import Data.Monoid ((<>))
|
||||
import Reanimate.Constants
|
||||
import Reanimate.Animation (SVG)
|
||||
import Reanimate.Svg.Constructors
|
||||
import Reanimate.Svg.LineCommand
|
||||
import Reanimate.Svg.BoundingBox
|
||||
|
|
@ -38,6 +40,7 @@ lowerTransformations = worker Transform.identity
|
|||
GroupTree g -> GroupTree $
|
||||
g & groupChildren %~ map (worker m')
|
||||
& transform .~ Nothing
|
||||
ClipPathTree{} -> t
|
||||
_ -> mkGroup [t] & transform ?~ [ Transform.toTransformation m ]
|
||||
|
||||
lowerIds :: Tree -> Tree
|
||||
|
|
@ -74,6 +77,28 @@ simplify root =
|
|||
| null (g^.groupChildren) = []
|
||||
dropNulls t = [t]
|
||||
|
||||
removeGroups :: Tree -> [Tree]
|
||||
removeGroups = worker defaultSvg
|
||||
where
|
||||
worker _attr None = []
|
||||
worker _attr (DefinitionTree d) =
|
||||
concatMap dropNulls $
|
||||
[DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]
|
||||
worker attr (GroupTree g)
|
||||
| g ^. drawAttributes == defaultSvg =
|
||||
concatMap dropNulls $
|
||||
concatMap (worker attr) (g^.groupChildren)
|
||||
| otherwise =
|
||||
concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)
|
||||
worker attr t = dropNulls (t & drawAttributes .~ attr)
|
||||
|
||||
dropNulls None = []
|
||||
dropNulls (DefinitionTree d)
|
||||
| null (d^.groupChildren) = []
|
||||
dropNulls (GroupTree g)
|
||||
| null (g^.groupChildren) = []
|
||||
dropNulls t = [t]
|
||||
|
||||
extractPath :: Tree -> [PathCommand]
|
||||
extractPath = worker . simplify . lowerTransformations . pathify
|
||||
where
|
||||
|
|
@ -156,8 +181,9 @@ svgGlyphs = worker id defaultSvg
|
|||
in concatMap (worker acc' attr') (g ^. groupChildren)
|
||||
t -> [(acc, attr, t)]
|
||||
|
||||
{-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or 'mkEllipse') into SVG path.
|
||||
This can be useful for creating animations of these shapes being drawn progressively with 'partialSvg'.
|
||||
{-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
|
||||
'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
|
||||
drawn progressively with 'partialSvg'.
|
||||
|
||||
Example:
|
||||
|
||||
|
|
@ -210,7 +236,8 @@ pathify = mapTree worker
|
|||
let points = pg ^. polygonPoints
|
||||
in PathTree $ defaultSvg
|
||||
& drawAttributes .~ pg ^. drawAttributes
|
||||
-- Polygon automatically connects the last point to the first. For path we must do it explicitly
|
||||
-- Polygon automatically connects the last point to the first. For path we must do
|
||||
-- it explicitly
|
||||
& pathDefinition .~ (pointsToPathCommands points ++ [EndPath])
|
||||
EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip ->
|
||||
PathTree $ defaultSvg
|
||||
|
|
@ -225,7 +252,8 @@ pathify = mapTree worker
|
|||
liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)
|
||||
unpackEllipse elip = do
|
||||
let (x,y) = elip ^. ellipseCenter
|
||||
liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius) (unpackNumber $ elip ^. ellipseYRadius)
|
||||
liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)
|
||||
(unpackNumber $ elip ^. ellipseYRadius)
|
||||
unpackLine line = do
|
||||
let (x1,y1) = line ^. linePoint1
|
||||
(x2,y2) = line ^. linePoint2
|
||||
|
|
@ -245,3 +273,28 @@ pathify = mapTree worker
|
|||
case toUserUnit defaultDPI n of
|
||||
Num d -> Just d
|
||||
_ -> Nothing
|
||||
|
||||
mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
|
||||
mapSvgPaths fn = mapTree worker
|
||||
where
|
||||
worker =
|
||||
\case
|
||||
PathTree path -> PathTree $
|
||||
path & pathDefinition %~ fn
|
||||
t -> t
|
||||
|
||||
mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
|
||||
mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)
|
||||
|
||||
-- Only maps points in paths
|
||||
mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
|
||||
mapSvgPoints fn = mapSvgLines (map worker)
|
||||
where
|
||||
worker (LineMove p) = LineMove (fn p)
|
||||
worker (LineBezier ps) = LineBezier (map fn ps)
|
||||
worker (LineEnd p) = LineEnd (fn p)
|
||||
|
||||
svgPointsToRadians :: SVG -> SVG
|
||||
svgPointsToRadians = mapSvgPoints worker
|
||||
where
|
||||
worker (V2 x y) = V2 (x/180*pi) (y/180*pi)
|
||||
|
|
|
|||
|
|
@ -225,7 +225,7 @@ withStrokeWidth width = strokeWidth .~ pure (Num width)
|
|||
withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
|
||||
-> Tree -- ^ Image that will be clipped by the referenced clip path
|
||||
-> Tree
|
||||
withClipPathRef ref = clipPathRef .~ pure ref
|
||||
withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref
|
||||
|
||||
-- | Assigns ID attribute to given image.
|
||||
withId :: String -> Tree -> Tree
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
module Reanimate.Transform
|
||||
( identity
|
||||
|
|
@ -26,7 +27,13 @@ fromList _ = error "Reanimate.Transform.fromList: bad input"
|
|||
transformPoint :: TMatrix -> RPoint -> RPoint
|
||||
transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
|
||||
where
|
||||
(a:c:e:b:d:f:_) = M.toList m
|
||||
!a = M.unsafeGet 1 1 m
|
||||
!c = M.unsafeGet 1 2 m
|
||||
!e = M.unsafeGet 1 3 m
|
||||
!b = M.unsafeGet 2 1 m
|
||||
!d = M.unsafeGet 2 2 m
|
||||
!f = M.unsafeGet 2 3 m
|
||||
-- (a:c:e:b:d:f:_) = M.toList m
|
||||
|
||||
mkMatrix :: Maybe [Transformation] -> TMatrix
|
||||
mkMatrix Nothing = identity
|
||||
|
|
|
|||
|
|
@ -6,8 +6,10 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.4.0
|
||||
- reanimate-svg-0.9.8.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
- matrices-0.5.0@sha256:b2761813f6a61c84224559619cc60a16a858ac671c8436bbac8ec89e85473058
|
||||
- geojson-4.0.1@sha256:276de5cb2aa3e07179a8d42c184b1a4e52d2c8d23cf2eb989ecfa6adbe726227
|
||||
- aeson-1.3.0.0
|
||||
|
|
|
|||
|
|
@ -6,8 +6,9 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.4.0
|
||||
- reanimate-svg-0.9.8.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
- matrices-0.5.0@sha256:b2761813f6a61c84224559619cc60a16a858ac671c8436bbac8ec89e85473058
|
||||
- geojson-4.0.1@sha256:276de5cb2aa3e07179a8d42c184b1a4e52d2c8d23cf2eb989ecfa6adbe726227
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.4.0
|
||||
- reanimate-svg-0.9.8.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
|
|
|
|||
|
|
@ -5,12 +5,12 @@
|
|||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: reanimate-svg-0.9.4.0@sha256:6acada3f3fea83e8b5e8ae5c9960b2fafdde8e6a48c32f094e6aa346bc7cc226,2448
|
||||
hackage: reanimate-svg-0.9.8.0@sha256:541ea5d9677d9ad055ea0b47ce3ebdd585d7197e5bdec248a53a5d53a281519f,2507
|
||||
pantry-tree:
|
||||
size: 1117
|
||||
sha256: 4cdd5f71443fc486f561b5a0d50b87d6890cd7fb5fbf1f8c0899b40a0e70d27e
|
||||
sha256: c7a66d694d4486c908018875515206e598946cbf2fba38fa72738231aaf3cf3e
|
||||
original:
|
||||
hackage: reanimate-svg-0.9.4.0
|
||||
hackage: reanimate-svg-0.9.8.0
|
||||
- completed:
|
||||
hackage: chiphunk-0.1.2.1@sha256:1e17e0e3d2fc91317e2cfcb8fd9f7add4a5038d76a4ae6b444641c0a2adec881,4619
|
||||
pantry-tree:
|
||||
|
|
|
|||
1
videos/map-projection/countries.json.REMOVED.git-id
Normal file
1
videos/map-projection/countries.json.REMOVED.git-id
Normal file
|
|
@ -0,0 +1 @@
|
|||
8c9923fcfe6c9b00e4add6dd47e8455b51fa9f37
|
||||
|
|
@ -64,11 +64,12 @@ main = seq equirectangular $ reanimate $ sceneAnimation $ do
|
|||
embedImage $ project src equirectangularP
|
||||
, grid equirectangularP ]
|
||||
|
||||
-- pushInterp "Lambert" lambertP
|
||||
pushInterp "Lambert" lambertP
|
||||
-- 1
|
||||
pushInterp "Web Mercator" mercatorP
|
||||
-- 2
|
||||
pushInterp "Mollweide" mollweideP
|
||||
pushInterp "Hammer" hammerP
|
||||
-- 3
|
||||
pushInterp "Bottomley 30\\degree" (bottomleyP (toRads 30))
|
||||
-- 4
|
||||
|
|
@ -87,6 +88,7 @@ main = seq equirectangular $ reanimate $ sceneAnimation $ do
|
|||
destroySprite eckert
|
||||
-- 7
|
||||
pushInterp "Fahey" faheyP
|
||||
pushInterp "Collignon" collignonP
|
||||
-- 8
|
||||
pushInterp "August" augustP
|
||||
-- 9
|
||||
|
|
@ -125,7 +127,7 @@ toRads dec = dec/180 * pi
|
|||
|
||||
grid :: Projection -> SVG
|
||||
grid p =
|
||||
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
|
|
@ -141,11 +143,11 @@ grid p =
|
|||
[ geometryToSVG p geo
|
||||
| geo <- landBorders
|
||||
]
|
||||
, withStrokeColorPixel (PixelRGBA8 0x30 0x30 0x30 0x0) $
|
||||
, withStrokeColorPixel (PixelRGBA8 0x50 0x50 0x50 0x0) $
|
||||
mkGroup $ map mkLinePath (latitudeLines p ++ longitudeLines p)
|
||||
]
|
||||
where
|
||||
strokeWidth = defaultStrokeWidth * 0.02
|
||||
strokeWidth = defaultStrokeWidth*0.5
|
||||
|
||||
worldLine :: Projection -> SVG
|
||||
worldLine p =
|
||||
|
|
|
|||
191
videos/map-projection/gif.hs
Normal file
191
videos/map-projection/gif.hs
Normal file
|
|
@ -0,0 +1,191 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings, ApplicativeDo #-}
|
||||
module Main(main) where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Codec.Picture
|
||||
import Codec.Picture.Jpg
|
||||
import Codec.Picture.Types
|
||||
import Control.Monad.ST
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as BS
|
||||
import Reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Scene
|
||||
import Reanimate.GeoProjection
|
||||
import System.IO.Unsafe
|
||||
import Data.Geospatial hiding (LonLat)
|
||||
import Data.LinearRing
|
||||
import qualified Data.LineString as Line
|
||||
import Data.Aeson
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Graphics.SvgTree (PathCommand (..), Tree (None))
|
||||
import Data.Foldable
|
||||
import Control.Lens ((^.))
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = seq equirectangular $ reanimate $ sceneAnimation $ do
|
||||
newSpriteSVG $ mkBackground "white"
|
||||
prevProj <- newVar equirectangularP
|
||||
let push label proj = do
|
||||
prev <- readVar prevProj
|
||||
play $ pauseAtEnd waitT $ signalA (curveS 2) $
|
||||
mkAnimation morphT $ \t ->
|
||||
mkGroup $
|
||||
[ grid $ mergeP prev proj t ]
|
||||
writeVar prevProj proj
|
||||
|
||||
-- play $ staticFrame morphT $
|
||||
-- mkGroup
|
||||
-- [ grid equirectangularP ]
|
||||
|
||||
-- push "Lambert" lambertP
|
||||
push "Web Mercator" mercatorP
|
||||
push "Mollweide" mollweideP
|
||||
-- push "Bottomley 30\\degree" (bottomleyP (toRads 30))
|
||||
-- 4
|
||||
-- pushInterp "Werner" wernerP
|
||||
-- 5
|
||||
-- pushInterp "Bonne 45\\degree" (bonneP (toRads 45))
|
||||
-- pushT
|
||||
-- (\t -> "Bonne " <> T.pack (show $ round $ fromToS 45 0 t) <> "\\degree")
|
||||
-- (bonneP . toRads . fromToS 45 0)
|
||||
-- 6
|
||||
-- pushInterp "Eckert I" eckert1P
|
||||
-- pushInterp "Eckert III" eckert3P
|
||||
-- pushInterp "Eckert IV" eckert5P
|
||||
-- 7
|
||||
-- push "Fahey" faheyP
|
||||
-- 8
|
||||
push "August" augustP
|
||||
-- 9
|
||||
push "Foucaut" foucautP
|
||||
-- 10
|
||||
push "Lagrange" lagrangeP
|
||||
|
||||
prev <- readVar prevProj
|
||||
play $ signalA (curveS 2) $
|
||||
mkAnimation morphT $ grid . mergeP prev equirectangularP
|
||||
where
|
||||
src = equirectangular
|
||||
waitT = 0
|
||||
morphT = 1
|
||||
|
||||
equirectangular :: Image PixelRGB8
|
||||
equirectangular = unsafePerformIO $ do
|
||||
dat <- BS.readFile "earth.jpg"
|
||||
case decodeJpeg dat of
|
||||
Left err -> error err
|
||||
Right img -> return $ convertRGB8 img
|
||||
|
||||
toRads :: Double -> Double
|
||||
toRads dec = dec/180 * pi
|
||||
|
||||
|
||||
grid :: Projection -> SVG
|
||||
-- grid p = None
|
||||
grid p =
|
||||
withStrokeWidth strokeWidth $
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
|
||||
withFillOpacity 0 $
|
||||
mkGroup
|
||||
[ mkGroup []
|
||||
, withStrokeColor "black" $
|
||||
withFillOpacity 0 $ mkGroup
|
||||
[ geometryToSVG p geo
|
||||
| geo <- landBorders
|
||||
]
|
||||
, withStrokeColor "black" $
|
||||
mkGroup $ map mkLinePath (latitudeLines p ++ longitudeLines p)
|
||||
]
|
||||
where
|
||||
strokeWidth = defaultStrokeWidth * 0.5
|
||||
|
||||
worldLine :: Projection -> SVG
|
||||
worldLine p =
|
||||
mkLinePath $
|
||||
map apply
|
||||
[ (-pi, -halfPi)
|
||||
, (-pi, halfPi)
|
||||
, (pi, halfPi)
|
||||
, (pi, -halfPi)
|
||||
, (-pi, -halfPi) ]
|
||||
where
|
||||
apply (lam, phi) =
|
||||
let XYCoord x y = projectionForward p $ LonLat lam phi
|
||||
in (x, y)
|
||||
|
||||
latitudeLines :: Projection -> [[(Double, Double)]]
|
||||
latitudeLines p =
|
||||
[ latitudeLine (fromToS (-pi) pi (n/(latLines*2)))
|
||||
| n <- [0 .. latLines*2]]
|
||||
where
|
||||
latLines = 2
|
||||
segments = 100
|
||||
maxLat = atan (sinh pi)
|
||||
latitudeLine lam =
|
||||
[ (x, y)
|
||||
| n <- [0..segments]
|
||||
, let phi = fromToS (-maxLat) maxLat (n/segments)
|
||||
, let XYCoord x y = projectionForward p $ LonLat lam phi ]
|
||||
|
||||
longitudeLines :: Projection -> [[(Double, Double)]]
|
||||
longitudeLines p =
|
||||
longitudeLine maxLat :
|
||||
longitudeLine (-maxLat) :
|
||||
[ longitudeLine (fromToS (-halfPi) halfPi (n/(lonLines*2)))
|
||||
| n <- [1 .. lonLines*2-1] ]
|
||||
where
|
||||
lonLines = 2
|
||||
segments = 100
|
||||
maxLat = atan (sinh pi)
|
||||
longitudeLine phi =
|
||||
[ (x, y)
|
||||
| n <- [0..segments]
|
||||
, let lam = fromToS (-pi) pi (n/segments)
|
||||
, let XYCoord x y = projectionForward p $ LonLat lam phi ]
|
||||
|
||||
halfPi :: Double
|
||||
halfPi = pi/2
|
||||
|
||||
landBorders :: [(GeospatialGeometry)]
|
||||
landBorders = unsafePerformIO $ do
|
||||
Just geo <- decodeFileStrict "countries.json"
|
||||
return
|
||||
[ (feature ^. geometry)
|
||||
| feature <- toList $ geo ^. geofeatures
|
||||
, let p = feature ^. properties :: Map String Value
|
||||
]
|
||||
|
||||
geometryToSVG :: Projection -> GeospatialGeometry -> SVG
|
||||
geometryToSVG p geometry =
|
||||
case geometry of
|
||||
MultiPolygon mpolygon ->
|
||||
mkGroup $ map (geometryToSVG p . Polygon) $ toList (splitGeoMultiPolygon mpolygon)
|
||||
Polygon poly ->
|
||||
mkGroup
|
||||
[ mkLinePath section
|
||||
| section <- pure
|
||||
[ (x', y')
|
||||
| PointXY x y <- map retrieveXY (fromLinearRing (head (toList (poly^.unGeoPolygon))))
|
||||
, let XYCoord x' y' = projectionForward p $ LonLat (x/180*pi) (y/180*pi)
|
||||
]
|
||||
]
|
||||
Line line ->
|
||||
mkLinePath
|
||||
[ (x', y')
|
||||
| PointXY x y <- map retrieveXY (Line.fromLineString (line ^. unGeoLine))
|
||||
, let XYCoord x' y' = projectionForward p $ LonLat (x/180*pi) (y/180*pi)
|
||||
]
|
||||
MultiLine ml ->
|
||||
mkGroup $ map (geometryToSVG p . Line) $ toList (splitGeoMultiLine ml)
|
||||
_ -> None
|
||||
551
videos/map-projection/sizes.hs
Normal file
551
videos/map-projection/sizes.hs
Normal file
|
|
@ -0,0 +1,551 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
import Codec.Picture.Jpg
|
||||
import Codec.Picture.Types
|
||||
import Control.Lens ((^.), (%~), (&))
|
||||
import Control.Monad
|
||||
import Control.Monad.ST
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.Sequence as Seq
|
||||
import Data.Char
|
||||
import Data.Foldable
|
||||
import Data.Geospatial hiding (LonLat)
|
||||
import Data.LinearRing
|
||||
import qualified Data.LineString as Line
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
import Data.String.Here
|
||||
import qualified Data.Text as T
|
||||
import Graphics.SvgTree (ElementRef (..), PathCommand (..),
|
||||
Tree (None))
|
||||
import Reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Blender
|
||||
import Reanimate.GeoProjection
|
||||
import Reanimate.Scene
|
||||
import Reanimate.Raster
|
||||
import System.IO.Unsafe
|
||||
|
||||
|
||||
{-
|
||||
Show the earth.
|
||||
Rotate
|
||||
-}
|
||||
|
||||
earth :: FilePath
|
||||
-- earth = "earth-low.jpg"
|
||||
-- earth = "earth-mid.jpg"
|
||||
earth = "earth-high.jpg"
|
||||
-- earth = "earth-extreme.jpg"
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate mainScene
|
||||
|
||||
testScene :: Animation
|
||||
testScene = sceneAnimation $ do
|
||||
bg <- newSpriteSVG $ mkBackground "white"
|
||||
spriteZ bg (-1)
|
||||
-- play $ animate $ const $ scale (1/halfPi * (4/4.5)) $ scaleToSize screenWidth screenHeight $
|
||||
-- embedImage $ project src (orthoP $ LonLat 0 0)
|
||||
bend <- newVar 1
|
||||
let LonLat lam phi = newzealandLonLat
|
||||
rotX <- newVar 0
|
||||
rotY <- newVar 0
|
||||
draw <- newVar 0
|
||||
_ <- newSprite $ do
|
||||
getBend <- unVar bend
|
||||
getRotX <- unVar rotX
|
||||
getRotY <- unVar rotY
|
||||
getDraw <- unVar draw
|
||||
return $
|
||||
scale (fromToS 1 ((9*pi)/16) getBend) $
|
||||
mkGroup
|
||||
[ blender (script earth getBend getRotX getRotY)
|
||||
-- , lowerTransformations $ scale (1/halfPi * (4/4.5)) $
|
||||
-- grid $ orthoP $ LonLat (getRotY) (getRotX)
|
||||
]
|
||||
-- wait 1
|
||||
-- tweenVar bend 1 $ \v -> fromToS v 0 . curveS 2
|
||||
fork $ tweenVar rotY 1 $ \v -> fromToS v (lam) . curveS 2
|
||||
tweenVar rotX 1 $ \v -> fromToS v (phi) . curveS 2
|
||||
-- wait 1
|
||||
fork $ tweenVar rotY 2 $ \v -> fromToS v 0 . curveS 2
|
||||
fork $ tweenVar rotX 2 $ \v -> fromToS v 0 . curveS 2
|
||||
wait 0.3
|
||||
tweenVar bend 2 $ \v -> fromToS v 0 . curveS 2
|
||||
where
|
||||
src = equirectangular
|
||||
|
||||
mainScene :: Animation
|
||||
mainScene = seq equirectangular $ -- takeA 5 $ dropA 19 $
|
||||
mapA (withStrokeColor "black") $ sceneAnimation $ do
|
||||
bg <- newSpriteSVG $ mkBackground "white"
|
||||
spriteZ bg (-1)
|
||||
|
||||
|
||||
let offset = translate 0 (-screenHeight/2 * 0.25)
|
||||
orthoScale = 0.35
|
||||
largeScale = 0.50
|
||||
Globe{..} <- newGlobe
|
||||
|
||||
morph <- newVar 0
|
||||
mapScale <- newVar orthoScale
|
||||
projs <- newVar (orthoP, equirectangularP)
|
||||
|
||||
spriteModify globeSprite $ do
|
||||
s <- unVar mapScale
|
||||
pure $ \(svg, z) -> (scale s svg, z)
|
||||
spriteMap globeSprite (offset)
|
||||
-- destroySprite globeSprite
|
||||
|
||||
let addRegion x y s proj lonlat@(LonLat lam phi) = do
|
||||
let idName = filter isAlphaNum $ show lonlat
|
||||
outline = lowerTransformations $ scale orthoScale $
|
||||
proj (orthoP lonlat)
|
||||
region1 <- newSpriteSVG outline
|
||||
destroySprite region1
|
||||
|
||||
spriteZ region1 2
|
||||
move <- newVar 0
|
||||
region1Shadow <- newSprite $ do
|
||||
~(from, to) <- unVar projs
|
||||
m <- unVar morph
|
||||
relScale <- unVar mapScale
|
||||
|
||||
t <- unVar move
|
||||
|
||||
pure $
|
||||
let srcWidth = imageWidth equirectangularExtreme
|
||||
srcHeight = imageHeight equirectangularExtreme
|
||||
!subImg = convertRGBA8 $ rasterSized srcWidth srcHeight $ mkGroup
|
||||
[ mkGroup []
|
||||
, mkClipPath idName $
|
||||
clipSvg
|
||||
, withClipPathRef (Ref idName) $
|
||||
scaleToSize screenWidth screenHeight $
|
||||
embedImage $ project equirectangularExtreme equirectangularP]
|
||||
setPos =
|
||||
translate (fromToS 0 x $ curveS 2 t)
|
||||
(fromToS 0 y $ curveS 2 t) .
|
||||
offset .
|
||||
scale (fromToS 1 s $ curveS 2 t)
|
||||
posSvg =
|
||||
lowerTransformations $ proj (mergeP (from lonlat) to m)
|
||||
clipSvg = removeGroups $
|
||||
lowerTransformations $ proj equirectangularP in
|
||||
mkGroup
|
||||
[ mkGroup []
|
||||
, setPos $ scale relScale $ centerWithDelta 1 posSvg $
|
||||
scaleToSize screenWidth screenHeight $
|
||||
embedImage $ interpP subImg (from lonlat) to m
|
||||
, lowerTransformations $ setPos $ scale orthoScale $ center $
|
||||
proj (orthoP lonlat)
|
||||
]
|
||||
fork $ tweenVar move 1 $ \v -> fromToS v 1 . curveS 2
|
||||
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v usaLonLat . curveS 2
|
||||
fork $ addRegion (-5.5) 4 3 america usaLonLat
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v brazilLonLat . curveS 2
|
||||
fork $ addRegion (-6) 0 3 brazil brazilLonLat
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v ukLonLat . curveS 2
|
||||
fork $ addRegion (-1) 4 5 uk ukLonLat
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v germanyLonLat . curveS 2
|
||||
fork $ addRegion 1 4 5 germany germanyLonLat
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v ausLonLat . curveS 2
|
||||
fork $ addRegion 6 4 3 australia ausLonLat
|
||||
|
||||
tweenVar globePosition 2 $ \v -> fromToLonLat v newzealandLonLat . curveS 2
|
||||
fork $ addRegion 6 0 4 newzealand newzealandLonLat
|
||||
|
||||
fork $ tweenVar globePosition 3 $ \v -> fromToLonLat v (LonLat 0 0) . curveS 2
|
||||
wait 1
|
||||
fork $ tweenVar mapScale 2 $ \v -> fromToS v largeScale . curveS 2
|
||||
fork $ tweenVar morph 2 $ \v -> fromToS v 1 . curveS 2
|
||||
tweenVar globeBend 2 $ \v -> fromToS v 0 . curveS 2
|
||||
destroySprite globeSprite
|
||||
|
||||
|
||||
writeVar projs (const equirectangularP, equirectangularP)
|
||||
mapS <- newSprite $ do
|
||||
~(from, to) <- unVar projs
|
||||
m <- unVar morph
|
||||
relScale <- unVar mapScale
|
||||
pure $ lowerTransformations $ scale relScale $ mkGroup
|
||||
[ mkGroup []
|
||||
, scaleToSize screenWidth screenHeight $
|
||||
embedImage $ interpP src (from (LonLat 0 0)) to m
|
||||
, grid $ mergeP (from (LonLat 0 0)) to m
|
||||
]
|
||||
spriteMap mapS offset
|
||||
|
||||
wait 1
|
||||
|
||||
let push proj = do
|
||||
(_, prev) <- readVar projs
|
||||
writeVar projs (const $ prev, proj)
|
||||
writeVar morph 0
|
||||
tweenVar morph 1 $ \v -> fromToS v 1 . curveS 2
|
||||
wait 1
|
||||
|
||||
push lambertP
|
||||
push mercatorP
|
||||
push mollweideP
|
||||
push hammerP
|
||||
push (bottomleyP $ 30/180*pi)
|
||||
push sinusoidalP
|
||||
push wernerP
|
||||
push (bonneP $ 45/180*pi)
|
||||
push augustP
|
||||
push collignonP
|
||||
push eckert1P
|
||||
push eckert3P
|
||||
push eckert5P
|
||||
push faheyP
|
||||
push foucautP
|
||||
push lagrangeP
|
||||
|
||||
where
|
||||
src = equirectangular
|
||||
waitT = 2
|
||||
morphT = 2
|
||||
|
||||
centerDelta :: Double -> Tree -> Tree
|
||||
centerDelta d t = translate ((-x-w/2)*d) ((-y-h/2)*d) t
|
||||
where
|
||||
(x, y, w, h) = boundingBox t
|
||||
|
||||
centerWithDelta :: Double -> Tree -> Tree -> Tree
|
||||
centerWithDelta d orig t = translate ((-x-w/2)*d) ((-y-h/2)*d) t
|
||||
where
|
||||
(x, y, w, h) = boundingBox orig
|
||||
|
||||
centerXWithDelta :: Double -> Tree -> Tree -> Tree
|
||||
centerXWithDelta d orig t = translate ((-x-w/2)*d) 0 t
|
||||
where
|
||||
(x, y, w, h) = boundingBox orig
|
||||
|
||||
|
||||
renderLabel label =
|
||||
let ref = scale 1.5 $ latex "\\texttt{Tygv123}"
|
||||
glyphs = scale 1.5 $ latex ("\\texttt{" <> label <> "}")
|
||||
svgTxt = mkGroup
|
||||
[ withStrokeColor "black" $ withFillColor "white" $
|
||||
glyphs
|
||||
, withFillColor "white" $
|
||||
glyphs ]
|
||||
in
|
||||
translate (screenWidth*0.01) (screenHeight*0.02) $
|
||||
translate (-screenWidth/2) (-screenHeight/2) $
|
||||
translate 0 (svgHeight ref) svgTxt
|
||||
|
||||
equirectangular :: Image PixelRGBA8
|
||||
equirectangular = unsafePerformIO $ do
|
||||
dat <- BS.readFile earth
|
||||
case decodeJpeg dat of
|
||||
Left err -> error err
|
||||
Right img -> return $ convertRGBA8 img
|
||||
|
||||
equirectangularExtreme :: Image PixelRGBA8
|
||||
equirectangularExtreme = unsafePerformIO $ do
|
||||
dat <- BS.readFile "earth-extreme.jpg"
|
||||
case decodeJpeg dat of
|
||||
Left err -> error err
|
||||
Right img -> return $ convertRGBA8 img
|
||||
|
||||
usaLonLat = svgToLonLat americaE
|
||||
ukLonLat = svgToLonLat ukE
|
||||
germanyLonLat = svgToLonLat $ germany equirectangularP
|
||||
newzealandLonLat = svgToLonLat $ newzealand equirectangularP
|
||||
ausLonLat = svgToLonLat australiaE
|
||||
brazilLonLat = svgToLonLat brazilE
|
||||
|
||||
svgToLonLat :: SVG -> LonLat
|
||||
svgToLonLat svg =
|
||||
LonLat (cx / (screenWidth/2) * pi)
|
||||
(cy / (screenHeight/2) * halfPi)
|
||||
where
|
||||
cx = x + w/2
|
||||
cy = y + h/2
|
||||
(x, y, w, h) = boundingBox svg
|
||||
|
||||
fromToLonLat (LonLat lam1 phi1) (LonLat lam2 phi2) t =
|
||||
LonLat (fromToS lam1 lam2 t) (fromToS phi1 phi2 t)
|
||||
|
||||
toRads :: Double -> Double
|
||||
toRads dec = dec/180 * pi
|
||||
|
||||
fetchCountry :: Projection -> (Map String Value -> SVG -> Maybe SVG) -> SVG
|
||||
fetchCountry p checker =
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
withStrokeWidth strokeWidth $
|
||||
|
||||
withFillOpacity 0 $
|
||||
mkGroup
|
||||
[ mkGroup []
|
||||
, applyProjection p $
|
||||
svgPointsToRadians $
|
||||
pathify $ countriesGeo annotate
|
||||
]
|
||||
where
|
||||
annotate :: Map String Value -> SVG -> SVG
|
||||
annotate props svg = fromMaybe None (checker props svg)
|
||||
strokeWidth = defaultStrokeWidth * 0.3
|
||||
|
||||
countriesGeo :: (Map String Value -> SVG -> SVG) -> SVG
|
||||
countriesGeo = loadFeatureCollection "countries-limited.json"
|
||||
|
||||
filterCountries :: IO ()
|
||||
filterCountries = do
|
||||
mbGeo <- decodeFileStrict "countries.json"
|
||||
case mbGeo of
|
||||
Nothing -> return ()
|
||||
Just geo -> do
|
||||
let geo' :: GeoFeatureCollection (Map String Value)
|
||||
geo' = geo & geofeatures %~ Seq.filter fn
|
||||
fn feat =
|
||||
case Map.lookup "NAME" (feat ^. properties) of
|
||||
Nothing -> False
|
||||
Just name -> name `elem` goodNames
|
||||
encodeFile "countries-limited.json" geo'
|
||||
where
|
||||
goodNames =
|
||||
[ "United States of America"
|
||||
, "United Kingdom"
|
||||
, "Germany"
|
||||
, "New Zealand"
|
||||
, "Australia"
|
||||
, "Brazil" ]
|
||||
|
||||
america :: Projection -> SVG
|
||||
america p = fetchCountry p $ \props svg -> do
|
||||
"United States of America" <- Map.lookup "NAME" props
|
||||
return $ snd $ splitGlyphs [75] svg
|
||||
|
||||
americaE :: SVG
|
||||
americaE = america equirectangularP
|
||||
|
||||
uk :: Projection -> SVG
|
||||
uk p = fetchCountry p $ \props svg -> do
|
||||
name <- Map.lookup "NAME" props
|
||||
guard (name `elem` ["United Kingdom"])
|
||||
return svg
|
||||
|
||||
ukE :: SVG
|
||||
ukE = uk equirectangularP
|
||||
|
||||
germany :: Projection -> SVG
|
||||
germany p = fetchCountry p $ \props svg -> do
|
||||
"Germany" <- Map.lookup "NAME" props
|
||||
return svg
|
||||
|
||||
australia :: Projection -> SVG
|
||||
australia p = fetchCountry p $ \props svg -> do
|
||||
"Australia" <- Map.lookup "NAME" props
|
||||
return $ snd $ splitGlyphs [0] svg
|
||||
|
||||
australiaE :: SVG
|
||||
australiaE = australia equirectangularP
|
||||
|
||||
newzealand :: Projection -> SVG
|
||||
newzealand p = fetchCountry p $ \props svg -> do
|
||||
"New Zealand" <- Map.lookup "NAME" props
|
||||
return $ snd $ splitGlyphs [0,1,2,3,4,5,6] svg
|
||||
|
||||
brazil :: Projection -> SVG
|
||||
brazil p = fetchCountry p $ \props svg -> do
|
||||
"Brazil" <- Map.lookup "NAME" props
|
||||
return $ snd $ splitGlyphs [0] svg
|
||||
|
||||
brazilE :: SVG
|
||||
brazilE = brazil equirectangularP
|
||||
|
||||
-- Alaska: 16
|
||||
-- Continent: 75
|
||||
grid :: Projection -> SVG
|
||||
grid p =
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
withStrokeWidth strokeWidth $
|
||||
|
||||
withFillOpacity 0 $
|
||||
-- withFillColor "black" $
|
||||
mkGroup
|
||||
[ mkGroup []
|
||||
, withStrokeColor "black" $
|
||||
applyProjection p $
|
||||
svgPointsToRadians $
|
||||
pathify $ landGeo annotate
|
||||
, withStrokeColor "black" $
|
||||
applyProjection p $ pathify $
|
||||
gridLines 7 4
|
||||
]
|
||||
where
|
||||
annotate :: Map String Value -> SVG -> SVG
|
||||
annotate props svg = svg
|
||||
strokeWidth = defaultStrokeWidth * 0.3
|
||||
|
||||
landGeo :: (Map String Value -> SVG -> SVG) -> SVG
|
||||
landGeo = loadFeatureCollection "land.geojson"
|
||||
|
||||
gridLines :: Int -> Int -> SVG
|
||||
gridLines latLines lonLines = mkGroup $ map mkLinePath $
|
||||
map longitudeLine (stepper (-halfPi) halfPi (lonLines+1)) ++
|
||||
map latitudeLine (stepper (-pi) pi (latLines))
|
||||
where
|
||||
segments = 100
|
||||
stepper from to nMax =
|
||||
[ fromToS from to (fromIntegral n / fromIntegral (nMax))
|
||||
| n <- [0 .. nMax-1] ]
|
||||
maxLat = halfPi -- atan (sinh pi)
|
||||
latitudeLine lam =
|
||||
[ (lam + pi/fromIntegral latLines, phi)
|
||||
| n <- [0..segments]
|
||||
, let phi = fromToS (-maxLat) maxLat (n/segments) ]
|
||||
longitudeLine phi =
|
||||
[ (lam, phi)
|
||||
| n <- [0..segments]
|
||||
, let lam = fromToS (-pi) pi (n/segments) ]
|
||||
|
||||
|
||||
halfPi :: Double
|
||||
halfPi = pi/2
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
data Globe s = Globe
|
||||
{ globeSprite :: Sprite s
|
||||
, globePosition :: Var s LonLat
|
||||
, globeBend :: Var s Double
|
||||
}
|
||||
|
||||
newGlobe :: Scene s (Globe s)
|
||||
newGlobe = do
|
||||
bend <- newVar 1
|
||||
pos <- newVar $ LonLat 0 0
|
||||
globe <- newSprite $ do
|
||||
getBend <- unVar bend
|
||||
~(LonLat lam phi) <- unVar pos
|
||||
pure $
|
||||
scale (fromToS 1 ((9*pi)/16) getBend) $
|
||||
blender $ script earth getBend phi lam
|
||||
return $ Globe globe pos bend
|
||||
|
||||
script :: FilePath -> Double -> Double -> Double -> T.Text
|
||||
script img bend rotX rotY = [iTrim|
|
||||
import os
|
||||
import math
|
||||
|
||||
import bpy
|
||||
|
||||
light = bpy.data.objects['Light']
|
||||
bpy.ops.object.select_all(action='DESELECT')
|
||||
light.select_set(True)
|
||||
bpy.ops.object.delete()
|
||||
|
||||
cam = bpy.data.objects['Camera']
|
||||
cam.data.type = 'ORTHO'
|
||||
cam.data.ortho_scale = 16
|
||||
cam.location = (0,0,5)
|
||||
cam.rotation_euler = (0, 0, 0)
|
||||
bpy.ops.object.empty_add(location=(0.0, 0, 0))
|
||||
focus_target = bpy.context.object
|
||||
bpy.ops.object.select_all(action='DESELECT')
|
||||
cam.select_set(True)
|
||||
focus_target.select_set(True)
|
||||
bpy.ops.object.parent_set()
|
||||
|
||||
focus_target.rotation_euler = (${negate rotX}, 0, 0)
|
||||
|
||||
|
||||
origin = bpy.data.objects['Cube']
|
||||
bpy.ops.object.select_all(action='DESELECT')
|
||||
origin.select_set(True)
|
||||
bpy.ops.object.delete()
|
||||
|
||||
x = ${bend}
|
||||
bpy.ops.mesh.primitive_plane_add()
|
||||
plane = bpy.context.object
|
||||
plane.scale = (16/2,${fromToS (9/2) 4 bend},1)
|
||||
bpy.ops.object.shade_smooth()
|
||||
|
||||
bpy.context.object.active_material = bpy.data.materials['Material']
|
||||
mat = bpy.context.object.active_material
|
||||
image_node = mat.node_tree.nodes.new('ShaderNodeTexImage')
|
||||
output = mat.node_tree.nodes['Material Output']
|
||||
mat.node_tree.links.new(image_node.outputs['Color'], output.inputs['Surface'])
|
||||
|
||||
image_node.image = bpy.data.images.load('${T.pack img}')
|
||||
|
||||
|
||||
modifier = plane.modifiers.new(name='Subsurf', type='SUBSURF')
|
||||
modifier.levels = 7
|
||||
modifier.render_levels = 7
|
||||
modifier.subdivision_type = 'SIMPLE'
|
||||
|
||||
bpy.ops.object.empty_add(type='ARROWS',rotation=(math.pi/2,0,0))
|
||||
empty = bpy.context.object
|
||||
|
||||
bendUp = plane.modifiers.new(name='Bend up', type='SIMPLE_DEFORM')
|
||||
bendUp.deform_method = 'BEND'
|
||||
bendUp.origin = empty
|
||||
bendUp.deform_axis = 'X'
|
||||
bendUp.factor = -math.pi*x
|
||||
|
||||
bendAround = plane.modifiers.new(name='Bend around', type='SIMPLE_DEFORM')
|
||||
bendAround.deform_method = 'BEND'
|
||||
bendAround.origin = empty
|
||||
bendAround.deform_axis = 'Z'
|
||||
bendAround.factor = -math.pi*2*x
|
||||
|
||||
bpy.context.view_layer.objects.active = plane
|
||||
bpy.ops.object.modifier_apply(modifier='Subsurf')
|
||||
bpy.ops.object.modifier_apply(modifier='Bend up')
|
||||
bpy.ops.object.modifier_apply(modifier='Bend around')
|
||||
|
||||
bpy.ops.object.select_all(action='DESELECT')
|
||||
plane.select_set(True);
|
||||
#bpy.ops.object.origin_set(type='ORIGIN_GEOMETRY')
|
||||
bpy.ops.object.origin_clear()
|
||||
bpy.ops.object.origin_set(type='GEOMETRY_ORIGIN')
|
||||
|
||||
plane.rotation_euler = (0, ${negate rotY}, 0)
|
||||
|
||||
scn = bpy.context.scene
|
||||
|
||||
#scn.render.engine = 'CYCLES'
|
||||
#scn.render.resolution_percentage = 10
|
||||
|
||||
scn.view_settings.view_transform = 'Standard'
|
||||
|
||||
scn.render.film_transparent = True
|
||||
|
||||
bpy.ops.render.render( write_still=True )
|
||||
|]
|
||||
1
videos/map-projection/state_lines.json.REMOVED.git-id
Normal file
1
videos/map-projection/state_lines.json.REMOVED.git-id
Normal file
|
|
@ -0,0 +1 @@
|
|||
ce43baa3dacf76f4887cdd40fb1e8363c98fc290
|
||||
1
videos/map-projection/states.json.REMOVED.git-id
Normal file
1
videos/map-projection/states.json.REMOVED.git-id
Normal file
|
|
@ -0,0 +1 @@
|
|||
9d8f615c8f4f8229b165042e75570e392db77299
|
||||
Loading…
Reference in a new issue