Data commit

Task/Draw-a-sphere/Haskell/draw-a-sphere-1.hs

@@ -0,0 +1,48 @@
+import Graphics.Rendering.OpenGL.GL
+import Graphics.UI.GLUT.Objects
+import Graphics.UI.GLUT
+
+setProjection :: IO ()
+setProjection = do
+  matrixMode $= Projection
+  ortho (-1) 1 (-1) 1 0 (-1)
+
+grey1,grey9,red,white :: Color4 GLfloat
+grey1 = Color4 0.1 0.1 0.1 1
+grey9 = Color4 0.9 0.9 0.9 1
+red   = Color4 1   0   0   1
+white = Color4 1   1   1   1
+
+setLights :: IO ()
+setLights = do
+  let l = Light 0
+  ambient  l $= grey1
+  diffuse  l $= white
+  specular l $= white
+  position l $= Vertex4 (-4) 4 3 (0 :: GLfloat)
+  light    l $= Enabled
+  lighting   $= Enabled
+
+setMaterial :: IO ()
+setMaterial = do
+  materialAmbient   Front $= grey1
+  materialDiffuse   Front $= red
+  materialSpecular  Front $= grey9
+  materialShininess Front $= (32 :: GLfloat)
+
+display :: IO()
+display = do
+  clear [ColorBuffer]
+  renderObject Solid $ Sphere' 0.8 64 64
+  swapBuffers
+
+main :: IO()
+main = do
+  _ <- getArgsAndInitialize
+  _ <- createWindow "Sphere"
+  clearColor $= Color4 0.0 0.0 0.0 0.0
+  setProjection
+  setLights
+  setMaterial
+  displayCallback $= display
+  mainLoop

Task/Draw-a-sphere/Haskell/draw-a-sphere-2.hs

@@ -0,0 +1,16 @@
+import Data.List (genericLength)
+
+shades = ".:!*oe%#&@"
+n = genericLength shades
+dot a b = sum $ zipWith (*) a b
+normalize x = (/ sqrt (x `dot` x)) <$> x
+
+sphere r k amb light = unlines $
+  [ [ if x*x + y*y <= r*r
+      then let vec = normalize [x, y, sqrt (r*r-x*x-y*y)]
+               b = (light `dot` vec) ** k + amb
+               intensity = (1 - b)*(n - 1)
+           in shades !! round ((0 `max` intensity) `min` n)
+      else ' '
+    | y <- map (/2.12) [- 2*r - 0.5 .. 2*r + 0.5]  ]
+  | x <- [ - r - 0.5 .. r + 0.5] ]

Task/Draw-a-sphere/Haskell/draw-a-sphere-3.hs

@@ -0,0 +1,7 @@
+procedure main()
+W := open("Demo", "gl", "size=400,400", "bg=black") | stop("can't open window!")
+WAttrib(W, "slices=40", "rings=40", "light0=on, ambient white; diffuse gold; specular gold; position 5, 0, 0" )
+Fg(W, "emission blue")
+DrawSphere(W, 0, 0, -5, 1)
+Event(W)
+end