Initial data commit

This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions

View file

@ -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

View file

@ -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] ]

View file

@ -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