Data commit

Task/Draw-a-sphere/M2000-Interpreter/draw-a-sphere.m2000

@@ -0,0 +1,59 @@
+Module CheckIt {
+      Er$="Pset is a new statement"
+      If Version<9.4 Then Error Er$
+      If Version=9.4 then If revision<26 then Error Er$
+      Form 60, 40
+      Cls 0 ' Black
+      Gradient 0,1
+      Pen 14 ' Yellow
+      Set Fast !
+      Refresh 500
+      Module Sphere (R as long, X0 as long, Y0 as long, fun){
+            R2 = R * R
+            Def Long X, Y, D2
+            Let Scale=twipsx/R*13.5
+            For Y = -R To R  step twipsx  {
+            Move X0-R, Y+Y0
+            For X = -R To R step twipsy  {
+                  D2 = X **2 + Y **2
+                  IF R2>D2 THEN Pset Fun(Max.Data(Min.Data((Sqrt(R2 - D2) - ( X + Y) / 2 )*Scale ,255),0))
+                  Step twipsx
+            }
+            }
+      }
+      Blue=lambda (c)->{
+            c1=c/4+192
+            =Color(c,c,c1)
+      }
+      Blue1=lambda (c)->{
+            c1=c/4+Random(150,192)
+            =Color(c,c,c1)
+      }
+      Mystery=lambda m=1 (c)->{
+            c1=c/4+m
+            m+=10
+            if m>192 then m=1
+            =Color(c,c,c1)
+      }
+      Mystery2=lambda m=1, p=true  (c)->{
+            c1=c/4+m
+           if p then m+=10
+           Else m=-10
+            if m>192 then m-=10 : p=false
+            If m<0 then m+=10: p=true
+            =Color(c,c,c1)
+      }
+      Buffer Alfa as byte*8
+      Trans =lambda  Alfa (c) -> {
+            Return Alfa, 0:=-point as long
+            Return Alfa, 4:=-color(c,c, c/4+192) as long
+            for i=0 to 2: Return Alfa, i:=(Eval(Alfa, i)+Eval(Alfa, i+4))/2: Next i
+            =-Eval(Alfa, 0 as long)
+      }
+      Sphere 2400, 9000,7000, Blue
+      Sphere 800, 6000, 7000, Blue1
+      Sphere 1200, 5000,5000, Mystery
+      Sphere 1200, 10000,6000, Mystery2
+      Sphere 1200, 8000,5000, trans
+}
+Checkit