Kronecker product based fractals: Difference between revisions

Added solution for Action!
(Added solution for Action!)
Line 95:
{{out}}
The same as in Nim solution.
 
=={{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]
 
=={{header|Ada}}==
Anonymous user