tree fractal Sam Coupe

 


Вчера вечер пропал не зря - занимался переносом кода на PureBasic. Оригинал:

 10 REM wow. Another fractal  tree program that pushes Zonto the boundary of      infinity and causes X and Y to become imaginary     numbers only able to existin the multi dimensial    co - reality of L-space.  Rather crap really.
   20 REM AXE 911
   30>MODE 4
   40 LET ang=7*PI/16,k=2+2*COS ang
   50 INPUT "NUMBER (500 - 2000) ";S
   60 LET XRG=s*0.62,YRG=s*0.62
   70 CLS: PLOT xrg/3,0
   80 tree s,0
   90 INPUT "Run again ? ( Y/N ) ";a$
  100 IF a$="Y" OR a$="y" THEN RUN
  110 MODE 4: CLEAR: BOOT
  120 STOP
  130 DEF PROC tree n,t: LOCAL d
  140 IF n<30 THEN lin n,t: END PROC
  150 LET d=n/k: IF n<s THEN tree d,t
  160 LET t=t+ang : tree d,t
  170 LET t=t-2*ang : tree d,t
  180 IF n<s THEN LET t=t+ang: tree d,t
  190 END PROC
  200 DEF PROC lin r,t
  210 DRAW r*COS t,r*SIN t
  220 END PROC
  230 DEF PROC s
  240 CLEAR
  250 SAVE "TREE" LINE 30
  260 STOP

Не работает. Заморочка с рисованием:


Global ang.f=7*#PI/16

Global k.f=2+2*Cos(ang)

Global s=500*2
Global XRG.f=s*0.62
Global x0.f=XRG/3
Global y0.f=0
Procedure lin(r.f,t.f)
  x1.f=r*Cos(t)
  y1.f=r*Sin(t)
  
  LineXY(x1+x0,480-y1-y0,x0,480-y0,255)
  
  x0=x1+x0
  y0=y1+y0
EndProcedure
Procedure tree(n.f,t.f)
  If n<30
    lin(n,t)
    Goto stop
  EndIf
  ;d=n/k
  If n<s
    tree(n/k,t)
  EndIf
  t=t+ang
  tree(n/k,t)
  
  t=t-2*ang
  tree(n/k,t)
  
  If n<s
    t=t+ang
    tree(n/k,t)
  EndIf
  stop:
EndProcedure
;Debug k
If InitSprite() And OpenWindow(0,0,0,640,480,"3D",#PB_Window_SystemMenu) And OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0) 
  StartDrawing(ScreenOutput())
  tree(s,0)
  StopDrawing() 
  FlipBuffers() 
  
  Repeat 
  Until WindowEvent()=#PB_Event_CloseWindow 
EndIf


Комментарии