Is it dark outside? Draw a sun map!
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 cases, invalid IO usage.
Haskell, in the 'because it's there' category
I was curious so I wrote one. The formulas are reasonably accurate[1], but then I go and use some ascii art instead of a proper Plate Carrée map, because it looked nicer (the way I convert pixels to lat/long only works correctly for Plate Carrée)
import Data.Time
d=pi/180
tau=2*pi
m0=UTCTime(fromGregorian 2000 1 1)(secondsToDiffTime(12*60*60))
dark lat long now =
let
time=(realToFrac$diffUTCTime now m0)/(60*60*24)
hour=(realToFrac$utctDayTime now)/(60*60)
mnlong=280.460+0.9856474*time
mnanom=(357.528+0.9856003*time)*d
eclong=(mnlong+1.915*sin(mnanom)+0.020*sin(2*mnanom))*d
oblqec=(23.439-0.0000004*time)*d
ra=let num=cos(oblqec)*sin(eclong)
den=cos(eclong) in
if den<0 then atan(num/den)+pi else atan(num/den)
dec=asin(sin(oblqec)*sin(eclong))
gmst =6.697375+0.0657098242*time+hour
lmst=(gmst*15*d)+long
ha=(lmst-ra)
el=asin(sin(dec)*sin(lat)+cos(dec)*cos(lat)*cos(ha))
in
el<=0
td x = fromIntegral x :: Double
keep="NSEW"++['0'..'9']
pixel p dk=if dk && p`notElem`keep then if p==' ' then '#' else '%' else p
showMap t= do
let w=length(worldmap!!0)
h=length worldmap
putStrLn (worldmap!!0)
putStrLn (worldmap!!1)
mapM_(\y->do
mapM_(\x->let
lat=(0.5-td y/td h)*pi
long=(0.5-td x/td w)*tau
in
putStr [pixel ((worldmap!!(y+2))!!x) (dark lat long t)]) [0..(w-1)]
putStrLn "") [0..(h-4)]
putStrLn (last worldmap)
main = do {t<-getCurrentTime; showMap t}
worldmap=[
"180 150W 120W 90W 60W 30W 000 30E 60E 90E 120E 150E 180",
"| | | | | | | | | | | | |",
"+90N-+-----+-----+-----+-----+----+-----+-----+-----+-----+-----+-----+",
"| . _..::__: ,-\"-\"._ |7 , _,.__ |",
"| _.___ _ _<_>`!(._`.`-. / _._ `_ ,_/ ' '-._.---.-.__|",
"|.{ \" \" `-==,',._\\{ \\ / {) / _ \">_,-' ` mt-2_|",
"+ \\_.:--. `._ )`^-. \"' , [_/( __,/-' +",
"|'\"' \\ \" _L oD_,--' ) /. (| |",
"| | ,' _)_.\\\\._<> 6 _,' / ' |",
"| `. / [_/_'` `\"( <'} ) |",
"+30N \\\\ .-. ) / `-'\"..' `:._ _) ' +",
"| ` \\ ( `( / `:\\ > \\ ,-^. /' ' |",
"| `._, \"\" | \\`' \\| ?_) {\\ |",
"| `=.---. `._._ ,' \"` |' ,- '. |",
"+000 | `-._ | / `:`<_|h--._ +",
"| ( > . | , `=.__.`-'\\ |",
"| `. / | |{| ,-.,\\ .|",
"| | ,' \\ / `' ,\" \\ |",
"+30S | / |_' | __ / +",
"| | | '-' `-' \\.|",
"| |/ \" / |",
"| \\. ' |",
"+60S +",
"| ,/ ______._.--._ _..---.---------._ |",
"| ,-----\"-..?----_/ ) _,-'\" \" ( |",
"|.._( `-----' `-|",
"+90S-+-----+-----+-----+-----+----+-----+-----+-----+-----+-----+-----+",
"Map 1998 Matthew Thomas. Freely usable as long as this line is included"]
Example output, from a more interesting time of year (we're near the equinox, so Wander Nauta's rectangular blobs are fairly accurate :) ) - this is for Jan 16 13:55:51 UTC 2014:
180 150W 120W 90W 60W 30W 000 30E 60E 90E 120E 150E 180
| | | | | | | | | | | | |
%90N%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%##########%#%%%%%%%%##%%%%%%%#######%7#######%#####%%%%%#############%
%##%%%%%#%#%%%%%%%%%%%%%%####%########%%%#####%%#%%%##%##%%%%%%%%%%%%%%
%%%#####%#%#%%%%%%%%%%%##%##%#%%#####%#%#%%%%%%#%################%%%2%%
%#%%%%%%%#######%%%#%%%%%#%%######, [_/( ##############%%%%%%#%
%%%%#####%#########%####%%##### oD_,--' ####%#####%%#%%###%
%#########%###########%%##### _)_.\\._<> 6 ######%%%#%##%###%
%#########%%#########%###### [_/_'` `"( ###%%%##%######%
%30N#######%%####%%%#%##### / `-'"..' `:._ ###%%##%#######%
%###%########%##%##%%##### / `:\ > \ ,-^. #%%#%#########%
%#############%%%%###%%### | \`' \| ?_)##%%#########%
%################%%%%%%%# `._._ ,' "` |' %%#%%########%
%000###############%####`-._ | / `:`<_%%%%%%######%
%##################%#### > . | , `=.%%%%%%%#####%
%###################%%# / | |{| %%%%%#####%%
%####################%# ,' \ / `' ,"#####%#####%
%30S#################% / |_' | %%##%#####%
%####################% | '-'##%%%###%%%
%####################|/ ##%####%#%
%####################\. #####%##%
%60S################ ########%
%################## ,/ ______._.--._ _..---.-------%%%%###%
%####%%%%%%%%%%%%%--_/ ) _,-'" " ##%##%
%%%%%########### `-----' ##%%%
%90S%%%%%%%%%----+-----+-----+----+-----+-----+-----+-----+-----+----%%
Map 1998 Matthew Thomas. Freely usable as long as this line is included
[1] they're the same as you'll find elsewhere, except without the extra work to keep degrees between 0 and 360, hours between 0 and 24, and radians between 0 and 2pi. I think those are holdovers from the days we used slide rules; trig functions work just fine outside those ranges...
.
Bash, 882* characters
This is my second entry, this time in the Aesthetics, Weird tech, Fun and Short code categories. It's inspired by Ram Narasimhan's entry and Peter Taylor's comment.
The script first generates a low-res texture of the world, bundled as base64-encoded data. It then generates 24 PovRay-scenes containing a sphere with that texture, each one rotated to 'face the sun'. Finally, the frames are combined into a GIF animation using ImageMagick. This means you'll have to have both PovRay and ImageMagick installed for the script to work - feel free to ignore this entry if you think that should disqualify it.
Like Ram's entry, and my first entry, this does not account for seasonal change, which means it's not very precise. It is, however, shorter, prettier and more precise than my first entry - and unlike Ram's entry, the map data and the code for generating the GIF animation are included.
echo '
iVBO Rw0KGgoAAAA NS
UhE U g AAAEgAAAA kAQMAAAAQFe4lAAAABlB
MVEUAFFwAbxKgAD63 AAAA AWJLR0 QAiAUdSAAAAAlwSFlzAAALEwAACx
MB AJqcGAAAAAd0SU1FB9 4DE hUWI op Fp5MAAADDSURBVBhXrcYhTsNQGADgr3ShE4Qi
h4BeYQFBgqAJN8Lh +r jBb rArIJHPobgAgkzgeSQkVHT7MWThAHzq44
/j/jezy6jSH M6fB gd 9T Nbxdl99R4Q+XpdNRISj4dlFRCz
oI11FxIpup4uIRDe5 fokp0Y2W25jQFDfrGNGsDNsoqBaGj34D2
bA7TcAwnmRoDZM 5tLkePUJb6uIT2rEq7hKaUhUHCXWpv7Q
PqEv1rsuoc7X RbV Bn2d kGTYKMQ3C7H8z2+wc/eMd S
QW39v8kAAA AA SUVOR K5CYII='|base64 \
-di>t;for X in {0..23};do R=$((90-(\
$X*15) )); echo "camera{location <0,
0, -5> angle 38 } light_source{
<0,0, -1000> rgb < 2,2, 2>} sphere
{<0 ,0,0> 1 pigment {
/**/ image_map{\"t\" map_type
1}} rotate <0,$R,0>
}">s ;povray +Is +H300\
+Of$X.png +W400
mogrify -fill white \
-annotate +0+10 "$X:00" \
-gravity south f$X.png
done; convert -delay \
100 -loop 0 $(ls f* \
|sort -V) ani.gif
exit;
As a bonus, here's a GIF that uses NASA's Blue Marble image instead of the space-saving 1-bit texture, i.e. what the result would have looked like without any size restriction: http://i.imgur.com/AnahEIu.gif
*: 882 characters not counting decorative whitespace, 1872 characters total.