Haskell - low quality code
I was extremely tired when I wrote this.
I might have gone too far with projections idea, anyway, here's the projection the program uses. Basically like projecting earth onto a cube and then unfolding it. Besides, in this projection, the shadow is made of straight lines.
The program uses current date/time, and outputs a PPM file on stdout.
import Data.Time.Clock
import Data.Time.Calendar
import Control.Applicative
import Data.Fixed
import Data.Maybe
earth :: [[Int]]
earth = [[256],[256],[256],[256],[64,1,1,2,1,5,14,16,152],[56,19,3,27,1,6,50,1,2,1,90],[53,6,1,11,2,36,26,1,2,1,16,2,1,1,2,1,24,4,66],[47,2,5,14,4,35,22,7,54,2,1,3,60],[38,1,2,2,3,1,6,1,2,1,2,7,6,1,1,33,24,3,3,1,56,2,60],[34,2,1,4,2,1,3,1,1,3,3,2,15,3,3,29,57,5,19,1,2,11,17,1,1,1,34],[40,3,10,2,1,8,16,27,54,3,18,19,18,1,36],[33,6,5,3,2,3,1,3,2,2,1,5,16,21,1,2,53,2,10,1,6,19,1,7,4,3,9,2,33],[32,4,1,7,1,2,3,2,1,1,3,11,14,23,53,2,10,3,1,4,2,33,7,7,29],[8,5,25,10,5,3,2,14,10,2,1,18,1,2,31,6,18,1,7,4,1,60,22],[5,18,2,12,3,5,1,3,2,2,1,3,4,2,3,8,11,18,30,13,9,2,7,3,2,72,1,6,8],[4,36,2,1,1,4,3,7,1,4,3,9,8,15,34,18,2,2,2,17,1,78,4],[4,1,1,27,3,1,1,24,6,3,1,1,1,3,6,13,13,1,20,15,1,4,1,104,1],[3,31,1,24,1,2,4,8,10,9,12,6,18,7,3,7,1,1,2,99,3,2,2],[7,50,2,2,2,1,2,1,3,2,1,2,10,7,15,1,20,7,2,111,7,1],[4,35,1,15,9,1,1,3,4,1,12,5,34,8,3,110,10],[4,9,1,2,1,37,12,6,16,3,34,8,3,96,5,6,13],[6,6,1,1,8,32,12,6,3,1,49,9,4,2,1,86,1,3,4,2,19],[9,2,1,1,11,31,11,11,40,1,8,1,2,4,5,83,12,3,20],[8,1,16,33,9,11,39,2,8,1,2,3,3,83,13,5,19],[28,33,5,12,40,2,7,3,6,62,1,19,13,5,20],[27,36,2,15,34,3,2,2,6,71,1,22,11,2,22],[30,21,1,11,2,16,33,3,1,4,2,72,1,24,1,1,9,1,23],[31,21,1,26,39,4,1,98,1,1,33],[31,42,7,1,40,100,1,1,33],[33,25,2,15,4,4,35,102,36],[33,23,2,1,2,14,8,1,36,27,1,9,1,61,3,1,33],[33,26,5,14,42,10,1,11,2,2,2,7,3,5,1,9,1,44,38],[33,26,1,2,1,9,2,1,45,7,1,2,2,9,8,6,2,6,1,53,4,2,33],[33,26,1,4,1,6,44,8,6,2,3,7,9,5,3,56,1,1,4,3,33],[33,37,45,8,7,2,3,6,2,4,3,6,4,53,43],[33,36,46,6,6,1,4,1,2,2,3,16,3,47,1,5,8,2,34],[34,34,46,7,11,1,3,2,2,16,3,45,6,2,8,1,35],[34,33,48,5,11,1,4,1,4,16,2,49,3,2,6,2,35],[35,32,54,8,17,60,5,2,4,4,35],[36,30,50,12,18,60,8,2,1,1,38],[38,27,50,15,16,61,6,2,41],[38,25,51,18,3,4,6,62,6,1,42],[39,1,1,17,2,3,51,93,49],[40,1,1,11,9,2,49,31,1,10,2,50,49],[40,1,2,9,10,2,48,33,1,10,2,49,49],[41,1,2,8,11,1,47,34,2,10,5,44,50],[42,1,2,7,58,36,1,11,2,1,8,36,51],[46,6,58,36,2,15,7,34,2,1,49],[46,6,12,2,43,38,2,14,7,2,1,12,1,15,55],[46,6,5,2,7,2,41,38,2,14,10,10,4,10,59],[47,6,3,3,10,3,38,37,3,12,11,8,6,9,2,1,57],[49,10,51,38,3,9,13,7,8,9,9,2,48],[51,7,51,40,2,7,15,6,9,1,1,8,8,2,48],[55,7,47,41,1,6,17,4,12,8,8,1,49],[57,5,47,42,1,2,20,4,13,8,9,1,47],[59,3,8,1,38,43,22,4,13,1,2,4,10,2,46],[60,2,6,5,38,41,1,4,18,3,17,3,10,2,46],[61,2,1,1,2,3,1,7,34,45,18,2,18,1,60],[63,1,2,13,33,44,22,1,12,1,16,3,45],[66,14,33,43,22,1,13,1,14,1,1,1,46],[66,18,30,4,1,1,5,30,34,1,2,2,9,3,50],[66,19,43,27,34,2,2,1,7,3,52],[65,20,43,26,36,2,1,2,5,5,51],[65,21,42,24,39,3,4,7,2,1,1,1,1,1,44],[56,1,7,23,41,16,1,6,41,2,4,6,7,1,44],[64,25,39,16,1,5,42,3,4,5,2,1,8,1,2,1,37],[64,29,35,22,43,3,1,1,2,3,2,1,1,1,2,1,1,2,1,7,6,1,27],[63,31,35,20,45,2,11,1,9,7,4,2,26],[64,32,34,19,67,1,2,6,1,2,28],[65,31,34,12,1,6,48,4,18,6,31],[65,31,34,19,54,2,1,2,2,1,10,2,2,1,30],[66,29,36,14,1,3,57,1,19,2,28],[66,29,36,14,1,4,63,1,42],[67,27,36,15,1,4,63,5,3,2,33],[67,26,37,20,5,2,53,2,1,4,4,2,33],[68,25,37,20,4,3,52,9,3,3,32],[70,23,36,20,3,4,53,11,1,4,31],[71,22,37,17,5,4,51,18,31],[71,22,37,16,7,3,50,20,30],[71,21,39,15,6,3,5,1,42,24,29],[71,20,40,15,6,3,47,26,28],[71,17,43,15,6,3,46,28,27],[71,16,45,13,8,1,48,27,27],[71,16,45,12,58,28,26],[71,16,45,12,58,28,26],[70,16,47,10,59,28,26],[70,15,49,9,60,27,26],[70,14,50,7,62,7,6,13,27],[70,13,51,6,63,6,8,1,1,9,28],[70,10,138,10,28],[69,12,139,7,29],[69,11,141,5,19,3,8],[69,8,167,3,9],[69,8,166,1,1,1,10],[70,5,149,2,16,2,12],[69,6,166,3,12],[68,6,166,2,14],[68,5,166,3,14],[68,6,182],[67,6,183],[68,4,184],[68,4,6,2,176],[69,4,183],[70,5,20,1,160],[256],[256],[256],[256],[256],[256],[78,1,1,1,109,1,65],[75,2,115,1,23,1,39],[72,3,80,1,1,5,20,42,32],[74,1,70,1,4,21,5,52,2,1,25],[67,1,2,2,1,4,64,28,4,62,21],[69,9,34,1,1,1,1,1,1,1,2,48,3,69,15],[50,1,5,1,16,5,34,130,14],[32,1,1,2,4,1,3,1,4,29,32,128,18],[20,1,1,54,32,128,20],[17,49,34,137,19],[9,1,2,54,20,4,6,143,17],[16,51,18,5,10,135,21],[11,1,4,54,25,140,21],[12,66,4,155,19],[12,231,13],[0,6,9,5,2,234],[0,256],[0,256]]
main = do
header
mapM_ line [0..299]
where
header = do
putStrLn "P3"
putStrLn "# Some PPM readers expect a comment here"
putStrLn "400 300"
putStrLn "2"
line y = mapM_ (\x -> pixel x y >>= draw) [0..399]
where
draw (r, g, b) = putStrLn $ (show r) ++ " " ++ (show g) ++ " " ++ (show b)
pixel x y = fromMaybe (return (1, 1, 1)) $
mapRegion (\x y -> (50, -x, y)) (x - 50) (y - 50)
<|> mapRegion (\x y -> (-x, -50, y)) (x - 150) (y - 50)
<|> mapRegion (\x y -> (-x, y, 50)) (x - 150) (y - 150)
<|> mapRegion (\x y -> (-50, y, -x)) (x - 250) (y - 150)
<|> mapRegion (\x y -> (y, 50, -x)) (x - 250) (y - 250)
<|> mapRegion (\x y -> (y, -x, -50)) (x - 350) (y - 250)
where
mapRegion f x y = if x >= -50 && y >= -50 && x < 50 && y < 50 then
Just $ fmap (worldMap . shade) getCurrentTime
else Nothing
where
t (x, y, z) = (atan2 y z) / pi
p (x, y, z) = asin (x / (sqrt $ x*x+y*y+z*z)) / pi * 2
rotate o (x, y, z) = (x, y * cos o + z * sin o, z * cos o - y * sin o)
tilt o (x, y, z) = (x * cos o - y * sin o, x * sin o + y * cos o, z)
shade c = ((t $ rotate yearAngle $ tilt 0.366 $ rotate (dayAngle - yearAngle) $ f x y)) `mod'` 2 > 1
where
dayAngle = fromIntegral (fromEnum $ utctDayTime c) / 43200000000000000 * pi + pi / 2
yearAngle = (fromIntegral $ toModifiedJulianDay $ utctDay c) / 182.624 * pi + 2.5311
worldMap c = case (c, index (t $ f x y) (p $ f x y)) of
(False, False) -> (0, 0, 0)
(False, True) -> (0, 0, 1)
(True, False) -> (2, 1, 0)
(True, True) -> (0, 1, 2)
where
index x y = index' (earth !! (floor $ (y + 1) * 63)) (floor $ (x + 1) * 127) True
where
index' [] _ p = False
index' (x:d) n p
| n < x = p
| otherwise = index' d (n - x) (not p)
That's right - triangular where
-code, nested case
s, invalid IO usage.
1Surely this is a lot easier on a 3D Earth, because you just have to position the lights correctly. – Peter Taylor – 2014-03-16T17:29:40.503
3@PeterTaylor Probably! I think you don't even have to do lighting: you could draw a 3D earth and rotate it so that the daylight part (and nothing else) faces the viewer. It wouldn't show the nighttime part of the planet, but that's not required. – Wander Nauta – 2014-03-16T18:17:10.383
30An alternative solution is simply to install windows. (In the basement, I mean.) – r3mainer – 2014-03-16T21:55:22.657
1"x86 assembly" oh boy. – qwr – 2014-03-17T00:46:34.513
2@qwr I'd take x86 assembly over
m4
any day of the week for this task... – Wander Nauta – 2014-03-17T00:52:19.7233Also: "the sun is quite fidgety because it rises and sets at different times." Definitely the sun's fault :P – qwr – 2014-03-17T01:08:00.300
2@qwr Ever thought about how easy time/date calculations would be if we had 10-hour days, 10-day weeks, 10-week months and 10-month years, and sun between t=0 and t=5? But no, the sun has to go and show its ugly face at different places at different times and take too long to go around the earth. No complaints division either. Disgusting. – Wander Nauta – 2014-03-17T01:15:54.120
1Even if the times formed neat multiples of each other, and if there weren't other astronomical bodies to complicate things, and if the mean axis of rotation of Earth were perpendicular to the ecliptic, it still wouldn't be as simple as you wish because gyroscopic motion is complicated. – Peter Taylor – 2014-03-17T10:34:52.850
@PeterTaylor Without a doubt. But a man can dream, can't he? – Wander Nauta – 2014-03-17T10:49:35.610
2
Obligatory xkcd link: http://xkcd.com/now
– ntoskrnl – 2014-03-17T20:50:12.363@ntoskrnl the xkcd thing would be a great answer for this if mousing over the earth changed the daylight ring on the outside. Make it so ;) – bazzargh – 2014-03-17T22:07:22.687