rsagl-0.2.1: Models/PlanetRingMoon.hs

module Models.PlanetRingMoon
    (planet,ring,moon,ground,monolith,station,orb,glow_orb,orb_upper_leg,orb_lower_leg)
    where

import RSAGL.Model
import RSAGL.Vector
import RSAGL.ModelingExtras
import RSAGL.RayTrace
import RSAGL.Affine
import RSAGL.Auxiliary
import System.Random
import RSAGL.Angle
import RSAGL.CurveExtras
import RSAGL.Curve

ring :: Modeling ()
ring = model $ do openDisc 0.75 1.0
                  material $
		      do transparent $ pure $ alpha 0.25 purple
                         specular 2 $ pure purple
                  bumps $ waves 0.2 0.01
                  twoSided True

planet :: Modeling ()
planet = model $ 
    do sphere (Point3D 0 0 0) 0.65
       deform $ constrain (\(SurfaceVertex3D (Point3D x y z) _) -> x > 0 && y > 0 && z > 0) $ 
           shadowDeform (Vector3D (-1) (-1) (-1)) (map (plane (Point3D 0 0 0)) [Vector3D 1 0 0,Vector3D 0 1 0,Vector3D 0 0 1])
       let land_vs_water land water = pattern (cloudy 26 0.4) [(0,water),(0.5,water),(0.51,land),(1,land)]
       let grass_and_mountains = pattern (cloudy 81 0.25) [(0.4,pattern (cloudy 99 0.1) [(0.0,pure brown),(1.0,pure slate_gray)]),(0.5,pure forest_green)]
       let land_and_water = land_vs_water grass_and_mountains (pure blue)
       let cities bright dark = land_vs_water (pattern (cloudy 5 0.1) [(0.0,bright),(0.5,dark)]) (dark)
       let planet_surface = pattern (gradient (Point3D 0 0 0) (Vector3D 0 0.65 0)) 
                                    [(-0.9,pure white),(-0.85,land_and_water),(0.85,land_and_water),(0.9,pure white)]
       let planet_interior inner_core outer_core crust = pattern (spherical (Point3D 0 0 0) 0.65) 
                  [(0.0,inner_core),(0.25,inner_core),(0.5,outer_core),(0.95,outer_core),(1.0,crust)]
       material $
           do pigment $ planet_interior (pure blackbody) (pure blackbody) $ cities (pure black) planet_surface
              emissive $ planet_interior (pure yellow) (pure red) $ cities (pure $ scaleRGB 0.2 white) (pure blackbody)
              specular 20 $ planet_interior (pure blackbody) (pure blackbody) $ land_vs_water (pure blackbody) (pure white)

moon :: Modeling ()
moon = model $ 
    do sphere (Point3D 0 0 0) 0.2
       material $ pigment $ pattern (cloudy 8 0.05) [(0.0,pure slate_gray),(1.0,pure black)]

monolith :: Modeling ()
monolith = model $
    do smoothbox 0.1 (Point3D 4 9 1) (Point3D (-4) (-9) (-1))
       affine (translate $ Vector3D 0 9 0)
       affine (scale' 0.20)
       material $
           do pigment $ pure blackbody
              specular 100 $ pure white

ground :: Modeling ()
ground = model $
    do closedDisc (Point3D 0 (-0.1) 0) (Vector3D 0 1 0) 75
       material $ pigment $ pattern (cloudy 27 1.0) [(0.0,pure brown),(1.0,pure forest_green)]

station :: Modeling ()
station = model $
    do model $ 
         do torus 0.5 0.1
            openCone (Point3D (-0.5) 0 0,0.02) (Point3D 0.5 0 0,0.02)
            openCone (Point3D 0 0 (-0.5),0.02) (Point3D 0 0 0.5,0.02)
            closedCone (Point3D 0 0.2 0,0.2) (Point3D 0 (-0.2) 0,0.2)
            material $ 
	        do pigment $ pure silver
                   specular 100 $ pure silver
       model $ 
         do box (Point3D (-0.15) 0.19 (-0.05)) (Point3D 0.15 0.21 0.05)
            material $ emissive $ pure white
       sequence_ $ dropRandomElements 30 (mkStdGen 19) $ concatMap (rotationGroup (Vector3D 0 1 0) 40) $ 
         [window_box,
          transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 25) window_box,
          transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-25)) window_box,
          transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees 50) window_box,
          transformAbout (Point3D 0.5 0 0) (rotateZ $ fromDegrees (-50)) window_box]
            where window_box = model $
                      do quadralateral (Point3D 0.51 (-0.105) 0.03) (Point3D 0.49 (-0.105) 0.03)
                                       (Point3D 0.49 (-0.105) (-0.03)) (Point3D 0.51 (-0.105) (-0.03))
                         quadralateral (Point3D 0.51 0.105 (-0.03)) (Point3D 0.49 0.105 (-0.03))
                                       (Point3D 0.49 0.105 0.03) (Point3D 0.51 0.105 0.03)
                         material $
			     do pigment $ pure black
                                emissive $ pure white
                         tesselationHintComplexity 0
                         fixed (3,3)

orb :: Modeling ()
orb = model $
    do sor $ linearInterpolation $ points2d
               [(-0.001,0.4),
                (0.5,0.45),
                (0.5,0.4),
                (0.6,0.4),
                (0.6,0.6),
                (0.5,0.6),
                (0.5,0.55),
                (-0.001,0.6)]
       sequence_ $ rotationGroup (Vector3D 0 1 0) 5 $
           tube $ zipCurve (,) (pure 0.05) $ smoothCurve 3 0.4 $ loopedLinearInterpolation $ points3d
               [(0.4,0.2,0.4),
                (0.4,0.8,0.8),
                (-0.4,0.8,0.8),
                (-0.4,0.2,0.4)]
       regularPrism (Point3D 0 0.5 0,0.5) (Point3D 0 1.0 0,-0.001) 4
       material $
           do pigment $ pure gold
              specular 64 $ pure silver

glow_orb :: Modeling ()
glow_orb = translate (Vector3D 0 1 0) $
    do closedDisc (Point3D 0 0 0) (Vector3D 0 1 0) 1
       material $ emissive $ pattern (spherical (Point3D 0 0 0) 1) [(0.0,pure $ scaleRGB 1.5 white),(0.25,pure white),(0.95,pure blackbody)]

orb_upper_leg :: Modeling ()
orb_upper_leg =
    do tube $ zipCurve (,) (pure 0.05) $ linearInterpolation [Point3D 0 0 0,Point3D 0 0.1 0.5,Point3D 0 0 1]
       sphere (Point3D 0 0 1) 0.05
       material $
           do pigment $ pure gold
              specular 64 $ pure silver

orb_lower_leg :: Modeling ()
orb_lower_leg =
    do openCone (Point3D 0 0 0,0.05) (Point3D 0 0 1,-0.001)
       material $ 
           do pigment $ pure gold
              specular 64 $ pure silver