Swirly

 

Увидел тему на одном форуме и постарался переписать программу с дурацкого диалекта Бейсика.

Procedure.l rainbow(x.f)
  hi = Int(x*6)%6;+ 5*(x<0)  'fixed to 0..5
  If x<0
    hi+5
  EndIf
  ;f = (x*6) mod 1 + (x<0)         'frac, 0..1
  f.f=Mod((x*6),1)
  If x<0
    f+1
  EndIf
  q.f = (1-f)
  Select hi
    Case 0
      r.f = 1: g.f = f: b.f = 0
    Case 1
      r = q: g = 1: b = 0
    Case 2
      r = 0: g = 1: b = f
    Case 3
      r = 0: g = q: b = 1
    Case 4
      r = f: g = 0: b = 1
    Case 5
      r = 1: g = 0: b = q
  EndSelect
  ProcedureReturn RGB(Int(r*255),Int(g*255),Int(b*255))
EndProcedure
Procedure.f ATan_2(y.f,x.f)
  ;    pi = acs(-1)    'could be made global to save some ticks
  If x <> 0
    arctan.f = ATan(y/x)
  EndIf
  
  If x>0
    atan2.f = arctan
  ElseIf y>=0 And x<0
    atan2 = #PI + arctan
  ElseIf y<0 And x<0
    atan2 = arctan - #PI
  ElseIf y>0 And x=0
    atan2 =#PI/2
  ElseIf y<0 And x=0
    atan2=#PI/-2
  EndIf
  ProcedureReturn atan2
EndProcedure
If InitSprite() And OpenWindow(0,0,0,640,480,"Swirly",#PB_Window_SystemMenu) And OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0) 
  StartDrawing(ScreenOutput()) 
  
  sz=10
radius=200
r.f=Log(2)*radius/5 ;???
s=2
rot=1
cx=320
cy=240
  ;For x=-50 To 40
  x.f=-10
  While x<10
    ;For y=-50 To 40
    y.f=-10
    While y<10
      xx=cx+x*sz+sz/2
      yy=cy+y*sz+sz/2
      dx=xx-cx
      dy=yy-cy
      phi.f=ATan_2(dy, dx)
      rho.f=Sqr(dx*dx+dy*dy)
      phi2.f=phi+s*Exp(0-rho/r+rot)
      ;           c$=rainbow$(phi2/2/acs(-1))
      Box(xx,yy,1,1,rainbow(phi2/2/ACos(-1)))
      y+0.1
    Wend;Next y
    x+0.1
  Wend;Next x
  StopDrawing()   
  FlipBuffers() 
  Repeat 
  Until WindowEvent()=#PB_Event_CloseWindow 
EndIf

Скачать