Нашел на форуме интересную программу:
Dim col.a(6)
Dim egacol(15)
egacol(0)=RGB($00,$00,$00)
egacol(1)=RGB($00,$00,$AA)
egacol(2)=RGB($00,$AA,$00)
egacol(3)=RGB($00,$AA,$AA)
egacol(4)=RGB($AA,$00,$00)
egacol(5)=RGB($AA,$00,$AA)
egacol(6)=RGB($AA,$55,$00)
egacol(7)=RGB($AA,$AA,$AA)
egacol(8)=RGB($55,$55,$55)
egacol(9)=RGB($55,$55,$FF)
egacol(10)=RGB($55,$FF,$55)
egacol(11)=RGB($55,$FF,$FF)
egacol(12)=RGB($FF,$55,$55)
egacol(13)=RGB($FF,$55,$FF)
egacol(14)=RGB($FF,$FF,$55)
egacol(15)=RGB($FF,$FF,$ff)
If OpenWindow(0, 0, 0, 640, 480, "Barnsley, fractals everywhere", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, 640, 480)
xm=320
ym=240
a.f=0.3
a2.f=Sqr(2)
b1.f=Sqr(2)/(1-a)
b2.f=-a/(1-a)
c.f=1/Sqr(2)
xc=0
yc.f=0.7
delh.f=1.6
delv.f=1.2
n1=300
n2.f=Int(n1*delv/delh)
;colours
Restore clut
For i=0 To 6
Read.a col(i)
Next i
If StartDrawing(CanvasOutput(0))
Box(0,0,640,480,0)
For I=0 To N1
For J=-N2 To N2
X.f=XC+I*DELH/N1
Y.f=YC+J*DELV/N2
For K=1 To 50
If X>0
Z.f=X
X=-1+A2*Y
Y=B1*Z+B2*Y
Else
Z=X
X=1-A2*Y
Y=-B1*Z+B2*Y
EndIf
If X*X+(Y-C)*(Y-C)>20
;L=1+K MOD 6 : Gosub graphics : EXIT For
L=1+K%6
If K>5 And K<25
Box( XM+I,YM-J,1,1,egacol(COL(L)) )
Box( XM-I,YM-J,1,1,egacol(COL(L)) )
EndIf
Break 1
EndIf
Next K
Next J : Next I
StopDrawing()
EndIf
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
DataSection
clut:
Data.a 0,1,9,4,12,14,0
Dim egacol(15)
egacol(0)=RGB($00,$00,$00)
egacol(1)=RGB($00,$00,$AA)
egacol(2)=RGB($00,$AA,$00)
egacol(3)=RGB($00,$AA,$AA)
egacol(4)=RGB($AA,$00,$00)
egacol(5)=RGB($AA,$00,$AA)
egacol(6)=RGB($AA,$55,$00)
egacol(7)=RGB($AA,$AA,$AA)
egacol(8)=RGB($55,$55,$55)
egacol(9)=RGB($55,$55,$FF)
egacol(10)=RGB($55,$FF,$55)
egacol(11)=RGB($55,$FF,$FF)
egacol(12)=RGB($FF,$55,$55)
egacol(13)=RGB($FF,$55,$FF)
egacol(14)=RGB($FF,$FF,$55)
egacol(15)=RGB($FF,$FF,$ff)
If OpenWindow(0, 0, 0, 640, 480, "Barnsley, fractals everywhere", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, 640, 480)
xm=320
ym=240
a.f=0.3
a2.f=Sqr(2)
b1.f=Sqr(2)/(1-a)
b2.f=-a/(1-a)
c.f=1/Sqr(2)
xc=0
yc.f=0.7
delh.f=1.6
delv.f=1.2
n1=300
n2.f=Int(n1*delv/delh)
;colours
Restore clut
For i=0 To 6
Read.a col(i)
Next i
If StartDrawing(CanvasOutput(0))
Box(0,0,640,480,0)
For I=0 To N1
For J=-N2 To N2
X.f=XC+I*DELH/N1
Y.f=YC+J*DELV/N2
For K=1 To 50
If X>0
Z.f=X
X=-1+A2*Y
Y=B1*Z+B2*Y
Else
Z=X
X=1-A2*Y
Y=-B1*Z+B2*Y
EndIf
If X*X+(Y-C)*(Y-C)>20
;L=1+K MOD 6 : Gosub graphics : EXIT For
L=1+K%6
If K>5 And K<25
Box( XM+I,YM-J,1,1,egacol(COL(L)) )
Box( XM-I,YM-J,1,1,egacol(COL(L)) )
EndIf
Break 1
EndIf
Next K
Next J : Next I
StopDrawing()
EndIf
Repeat
Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
EndIf
DataSection
clut:
Data.a 0,1,9,4,12,14,0
До кучи добавлена программа на Quick Basic:
REM ***fractal pattern***
REM ***cf. Barnsley, fractals everywhere***
REM ***name:BARNS3***
SCREEN 12 : CLS
XM=320 : YM=240
REM ***data system***
A=.3 : A2=SQR(2)
B1=SQR(2)/(1-A) : B2=-A/(1-A) : C=1/SQR(2)
XC=0 : YC=.7 : DELH=1.6 : DELV=1.2
N1=300 : N2=INT(N1*DELV/DELH)
REM ***colours***
DIM COL(6)
DATA 0,1,9,4,12,14,0
FOR I=0 TO 6 : READ COL(I) : NEXT I
REM ***main program***
FOR I=0 TO N1 : FOR J=-N2 TO N2
IF INKEY$<>"" THEN END
X=XC+I*DELH/N1 : Y=YC+J*DELV/N2
FOR K=1 TO 50
IF X>0 THEN
Z=X : X=-1+A2*Y : Y=B1*Z+B2*Y
ELSE
Z=X : X=1-A2*Y : Y=-B1*Z+B2*Y
END IF
IF X*X+(Y-C)*(Y-C)>20 THEN
L=1+K MOD 6 : GOSUB graphics : EXIT FOR
END IF
NEXT K
NEXT J : NEXT I : A$=INPUT$(1)
END
graphics:
IF K>5 AND K<25 THEN
PSET (XM+I,YM-J),COL(L) : PSET (XM-I,YM-J),COL(L)
END IF
RETURN
Долго мучался с MBasic, потом подобрал значения. Теперь втиснул картинку в 320х320
Комментарии
Отправить комментарий