ASCII sphere

 

Переписал код, найденный на страничке. Как всегда, Locomotive BASIC не даст соскучится.

OpenConsole()
s$=".:!*oe&#%@"
Dim v.f(2)
Dim vec.f(2)
v(0)=30;30
v(1)=30
v(2)=-50
lung.f=Sqr(v(0)*v(0)+v(1)*v(1)+v(2)*v(2));40
v(0)=v(0)/lung;50
v(1)=v(1)/lung;60
v(2)=v(2)/lung;70
r=10
k=2
ambient.f=0.4
For i=Int(-r) To Int(r);90
x.f=i+0.5
For j=Int(-2*r) To Int(2*r)
y.f=j/2+0.5
If (x*x+y*y<=r*r)
  ;  Gosub 1000
vec(0)=x;1000 
vec(1)=y;1010 
vec(2)=Sqr(r*r-x*x-y*y);1020 
;1030 Gosub 2000
lung.f=Sqr(vec(0)*vec(0)+vec(1)*vec(1)+vec(2)*vec(2));2000 
vec(0)=vec(0)/lung;2010 
vec(1)=vec(1)/lung;2020 
vec(2)=vec(2)/lung;2030 
;1040 Gosub 3000
d.f=v(0)*vec(0)+v(1)*vec(1)+v(2)*vec(2);3000 
If d<0                                 ;3010 
  d=-d
Else
  d=0
EndIf
;1050 b=d^k+ambient
b.f=d*d+ambient;1050 
intensity.w=(1-b)*(Len(s$)-1)
If (intensity<0);1070 
  intensity=0
 EndIf
 If (intensity>Len(s$)-1);1070
   intensity=Len(s$)-2
 EndIf
Print( Mid(s$,intensity+1,1) )
Else
  Print(" ")
EndIf
Next j
 PrintN("")
 Next i
Input()