Kronecker product based fractals: Difference between revisions

=={{header|Action!}}==

The user must type in the monitor the following command after compilation and before running the program!<pre>SET EndProg=*</pre>

{{libheader|Action! Tool Kit}}

<lang Action!>CARD EndProg ;required for ALLOCATE.ACT

INCLUDE "D2:ALLOCATE.ACT" ;from the Action! Tool Kit. You must type 'SET EndProg=*' from the monitor after compiling, but before running this program!

DEFINE PTR="CARD"

DEFINE MATRIX_SIZE="4"

TYPE Matrix=[

BYTE width,height

PTR data]

PTR FUNC CreateEmpty(BYTE w,h)

Matrix POINTER m

m=Alloc(MATRIX_SIZE)

m.width=w

m.height=h

m.data=Alloc(w*h)

RETURN (m)

PTR FUNC Create(BYTE w,h BYTE ARRAY a)

Matrix POINTER m

m=CreateEmpty(w,h)

MoveBlock(m.data,a,w*h)

RETURN (m)

PROC Destroy(Matrix POINTER m)

Free(m.data,m.width*m.height)

Free(m,MATRIX_SIZE)

RETURN

PTR FUNC Product(Matrix POINTER m1,m2)

Matrix POINTER m

BYTE x1,x2,y1,y2

INT i1,i2,i

BYTE ARRAY a1,a2,a

m=CreateEmpty(m1.width*m2.width,m1.height*m2.height)

a1=m1.data

a2=m2.data

a=m.data

i=0

FOR y1=0 TO m1.height-1

DO

FOR y2=0 TO m2.height-1

DO

FOR x1=0 TO m1.width-1

DO

FOR x2=0 TO m2.width-1

DO

i1=y1*m1.width+x1

i2=y2*m2.width+x2

a(i)=a1(i1)*a2(i2)

i==+1

OD

OD

OD

OD

RETURN (m)

PROC DrawMatrix(Matrix POINTER m INT x,y)

INT i,j

BYTE ARRAY d

d=m.data

FOR j=0 TO m.height-1

DO

FOR i=0 TO m.width-1

DO

IF d(j*m.width+i) THEN

Plot(x+i,y+j)

FI

OD

OD

RETURN

PROC DrawFractal(BYTE ARRAY a BYTE w,h INT x,y BYTE n)

Matrix POINTER m1,m2,m3

BYTE i

m1=Create(w,h,a)

m2=Create(w,h,a)

FOR i=1 TO n

DO

m3=Product(m1,m2)

IF i<n THEN

Destroy(m1)

m1=m3 m3=0

FI

OD

DrawMatrix(m3,x,y)

Destroy(m1)

Destroy(m2)

Destroy(m3)

RETURN

PROC Main()

BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6

BYTE ARRAY a=[0 1 0 1 1 1 0 1 0],

b=[1 1 1 1 0 1 1 1 1],

c=[1 0 1 0 1 0 1 0 1]

Graphics(8+16)

AllocInit(0)

Color=1

COLOR1=$0C

COLOR2=$02

DrawFractal(a,3,3,12,55,3)

DrawFractal(b,3,3,120,55,3)

DrawFractal(c,3,3,226,55,3)

DO UNTIL CH#$FF OD

CH=$FF

RETURN</lang>

{{out}}

[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Kronecker_product_based_fractals.png Screenshot from Atari 8-bit computer]