Data update

Task/Draw-a-sphere/Ada/draw-a-sphere-1.adb

@@ -0,0 +1,30 @@
+with Glib;                use Glib;
+with Cairo;               use Cairo;
+with Cairo.Png;           use Cairo.Png;
+with Cairo.Pattern;       use Cairo.Pattern;
+with Cairo.Image_Surface; use Cairo.Image_Surface;
+with Ada.Numerics;
+
+procedure Sphere is
+   subtype Dub is Glib.Gdouble;
+
+   Surface    : Cairo_Surface;
+   Cr         : Cairo_Context;
+   Pat        : Cairo_Pattern;
+   Status_Out : Cairo_Status;
+   M_Pi       : constant Dub := Dub (Ada.Numerics.Pi);
+
+begin
+   Surface := Create (Cairo_Format_ARGB32, 512, 512);
+   Cr      := Create (Surface);
+   Pat     :=
+      Cairo.Pattern.Create_Radial (230.4, 204.8, 51.1, 204.8, 204.8, 256.0);
+   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 0.0, 1.0, 1.0, 1.0, 1.0);
+   Cairo.Pattern.Add_Color_Stop_Rgba (Pat, 1.0, 0.0, 0.0, 0.0, 1.0);
+   Cairo.Set_Source (Cr, Pat);
+   Cairo.Arc (Cr, 256.0, 256.0, 153.6, 0.0, 2.0 * M_Pi);
+   Cairo.Fill (Cr);
+   Cairo.Pattern.Destroy (Pat);
+   Status_Out := Write_To_Png (Surface, "SphereAda.png");
+   pragma Assert (Status_Out = Cairo_Status_Success);
+end Sphere;

Task/Draw-a-sphere/Ada/draw-a-sphere-2.adb

@@ -0,0 +1,12 @@
+with Display; use Display;
+with Display.Basic; use Display.Basic;
+
+procedure Main is
+   Ball : Shape_Id := New_Circle
+     (X      => 0.0,
+      Y      => 0.0,
+      Radius => 20.0,
+      Color  => Blue);
+begin
+   null;
+end Main;

Task/Draw-a-sphere/Emacs-Lisp/draw-a-sphere.el

@@ -0,0 +1,54 @@
+; Draw a sphere
+
+(defun normalize (v)
+  "Normalize a vector."
+  (setq invlen (/ 1.0 (sqrt (dot v v))))
+  (mapcar (lambda (x) (* invlen x)) v))
+
+(defun dot (v1 v2)
+  "Dot product of two vectors."
+  (+ (* (car v1) (car v2))
+     (* (cadr v1) (cadr v2))
+     (* (caddr v1) (caddr v2))))
+
+(defun make-array (size)
+  "Create an empty array with size*size elements."
+  (setq m-array (make-vector size nil))
+  (dotimes (i size)
+    (setf (aref m-array i) (make-vector size 0)))
+  m-array)
+
+(defun pic-lines (arr size)
+  "Turn array into a string."
+  (setq all "")
+  (dotimes (y size)
+    (setq line "")
+    (dotimes (x size)
+      (setq line (concat line (format "%i \n" (elt (elt arr y) x)))))
+    (setq all (concat all line "\n")))
+  all)
+
+(defun pic-show (arr size)
+  "Convert size*size array to grayscale PBM image and show it."
+  (insert-image (create-image (concat (format "P2
+%i %i 255\n" size size) (pic-lines arr size)) 'pbm t)))
+
+(defun sphere (size k amb dir)
+  "Draw a sphere."
+  (let ((arr (make-array size))
+        (ndir (normalize dir))
+        (r (/ size 2)))
+    (dotimes (yp size)
+      (dotimes (xp size)
+        (setq x (- xp r))
+        (setq y (- yp r))
+        (setq z (- (* r r) (* x x) (* y y)))
+        (if (>= z 0)
+          (let* ((vec (normalize (list x y (sqrt z))))
+                 (s (max 0 (dot vec ndir)))
+                 (lum (max 0 (min 255 (* 255 (+ amb (expt s k))
+                                                    (/ (1+ amb)))))))
+            (setf (elt (elt arr yp) xp) lum)))))
+    (pic-show arr size)))
+
+(sphere 200 1.5 0.2 '(-30 -30 50))

Task/Draw-a-sphere/Odin/draw-a-sphere.odin

@@ -0,0 +1,32 @@
+package sphere
+
+import rl "vendor:raylib"
+
+main :: proc() {
+	rl.InitWindow(640, 480, "Rosetta Code - draw a sphere")
+
+	camera: rl.Camera3D
+	camera.fovy = 45
+	camera.position = {0, 2.5, 5}
+	camera.up = {0, 1, 0}
+
+	for !rl.WindowShouldClose() {
+		rl.UpdateCamera(&camera, .ORBITAL)
+		
+		rl.BeginDrawing()
+
+		rl.ClearBackground(rl.RAYWHITE)
+
+		rl.BeginMode3D(camera)
+
+		rl.DrawGrid(10, .5)
+
+		rl.DrawSphere({}, .5, rl.LIME)
+
+		rl.EndMode3D()
+
+		rl.EndDrawing()
+	}
+
+	rl.CloseWindow()
+}

Task/Draw-a-sphere/Pluto/draw-a-sphere.pluto

@@ -0,0 +1,8 @@
+require "bitmap"
+
+local bmp = bitmap.of(400, 400, color.white, "Draw a sphere")
+for n = 1, 100 do
+    local clr = bitmap.rgbColor(2 * n, 2 * n, 2 * n)
+    bmp:circle(math.round(150-2 * n / 3) + 50, math.round(150 - n / 2) + 50, 150 - n, clr)
+end
+bmp:view()

Task/Draw-a-sphere/R/draw-a-sphere.r

@@ -0,0 +1,12 @@
+library(lattice)
+theta <- seq(0, pi, length.out=100)
+phi <- seq(0, 2*pi, length.out=100)
+x <- outer(sin(theta), cos(phi))
+y <- outer(sin(theta), sin(phi))
+z <- sqrt(1-x^2-y^2)
+xx <- kronecker(matrix(1, 2, 2), x)
+yy <- kronecker(matrix(1, 2, 2), y)
+zz <- kronecker(matrix(c(1, -1, -1, 1), 2, 2), z)
+png(filename="Sphere-R.png", width=1000, height=1000)
+wireframe(zz ~ xx*yy)
+dev.off()

Task/Draw-a-sphere/VBScript/draw-a-sphere.vbs

@@ -0,0 +1,51 @@
+shades = Array(".", ":", "!", "*", "o", "e", "&", "#", "%", "@")
+light = Array(30, 30, -50)
+
+Sub Normalize(v)
+   length = Sqr(v(0)*v(0) + v(1)*v(1) + v(2)*v(2))
+   v(0) = v(0)/length : v(1) = v(1)/length : v(2) = v(2)/length
+End Sub
+
+Function Dot(x, y)
+   d = x(0)*y(0) + x(1)*y(1) + x(2)*y(2)
+   If d < 0 Then Dot = -d Else Dot = 0 End If
+End Function
+
+'floor function is the Int function
+'ceil function implementation
+Function Ceil(x)
+    Ceil = Int(x)
+    If Ceil <> x Then Ceil = Ceil + 1 End if
+End Function
+
+Sub DrawSphere(R, k, ambient)
+   Dim i, j, intensity, inten, b, x, y
+   Dim vec(3)
+   For i = Int(-R) to Ceil(R)
+      x = i + 0.5
+      line = ""
+      For j = Int(-2*R) to Ceil(2*R)
+         y = j / 2 + 0.5
+         If x * x + y * y <= R*R Then
+            vec(0) = x
+            vec(1) = y
+            vec(2) = Sqr(R * R - x * x - y * y)
+            Normalize vec
+            b = dot(light, vec)^k + ambient
+            intensity = Int((1 - b) * UBound(shades))
+            If intensity < 0 Then intensity = 0 End If
+            If intensity >= UBound(shades) Then
+               intensity = UBound(shades)
+            End If
+            line = line & shades(intensity)
+         Else
+            line = line & " "
+         End If
+      Next
+      WScript.StdOut.WriteLine line
+   Next
+End Sub
+
+Normalize light
+DrawSphere 20, 4, 0.1
+DrawSphere 10,2,0.4