/* === FRACTAL MICROSCOPE === */
/* By Terry Newton 10/07/90 */
/* 02/25/92 */
/* (Compressed Bitmaps) */
/* This program produces fractal */
/* images of the Mandelbrot set */
/* and Julia sets in low or high */
/* resolution. Low res simulated */
/* GR15 mode using GR8 runs on */
/* all 8 bit Atari (GR7PLUS) */
/* Compile using ACE or L.S.C. */
/* Part one of source. Link to */
/* SCSUB.CCC (esttime, etc) */
/* PLOTSUB.CCC (mathart subs) */
/* ACECIO.CCC (ACE C library) */
/* ITER7000.OBJ (plotting code) */
/* GR7P6F00.OBJ (GR15 graphics) */
/* CMP6D40.OBJ (Compression) */
/* COL06F0.OBJ (Default Color) */
/* ENGINE.OBJ (Debugged vers) */
char *ptr,*start,ca[6],cb[6];
char za[6],zb[6],real[6],imag[6];
char gapx[6],gapy[6],range[6],mr[6];
char acor[6],bcor[6],f0[6],f2[6];
char temp[6],temp1[6],magf[6];
char ac[6],bc[6],xc[6],yc[6];
char fspec[20],prevf[20],ts[255];
int size,limit,setflg,lastpix;
int a,b,j,k,n,esc,hres,vres,lx,ly;
int lores,key,cr0,cr1,cr2,cr3,cr4;
int col,esc1,func,cf,drvnum;
int x,y,i,qcnt,err,pxcol,mode;
int bandf,count,juliaflg;
main() $(
/* set Sparta RUNLOC */
if(peek(dpeek(10)+28)==128||
peek(0x0700)==0x53)
dpoke(dpeek(10)+61,0x3635);
initvars();
while(1) $(
getdisp();setresol(lores,start);
menu();
if(func==1)newplot();
if(func==2)plotpic();
if(func==3)saveima();
if(func==4)loadima();
if(func==5)magnify();
if(func==6)viewima();
if(func==7)alter();
if(func==8)dispdata();
if(func==9)quitdos();
if(func==10)dispdir();
$)
$)
initvars() $(
/* initialize vars if loaded */
if(peek(0x6F00)>0) $(
drvnum=peek(0x0021);setdrive();
lx=0;ly=0;limit=250;juliaflg=0;
atof(real,"-0.6");atof(imag,"0.0");
atof(range,"2.5");atof(ca,"-0.7");
atof(cb,"0.3");atof(f0,"0.0");
atof(f2,"2.0");bandf=10;
poke(prevf,0);poke(fspec,0);
lores=0;graphics(8);
defaultc();setcols;poke(752,1);
ptitle();lores=1;defaultc();
$)
poke(0x6F00,0);
$)
/* set drive number for ACE */
setdrive() $(
poke(dpeek(0x2CB4),drvnum+48);
$)
newplot() $(
pnewplot();
key=toupper(getkey());
if(key=='Y') getdata();
$)
/* alter colors (link) */
alter() $(
altcolor();
cr0=peek(708); cr1=peek(709);
cr2=peek(710); cr3=peek(711);
cr4=peek(712);
$)
/* main menu */
menu() $(
poke(range+4,0);poke(range+5,0);
graphics(8+32);if(lores)gr7plus();
setcols();poke(752,1);
func=0;while(func==0) $(
setdrive();
func=pmenu(lores,juliaflg,drvnum);
if(func>20) $(
drvnum=func-20;func=0;
$)
$)
$)
/* show plot parameters */
dispdata() $(
poke(82,0);
printf("↰Real:%-14f ",real);
if(juliaflg)printf("CA:%f",ca);
printf("\nImag:%-14f ",imag);
if(juliaflg)printf("CB:%f",cb);
printf("\nRange:%-13f Band Factor:%d\n",range,bandf);
printf(" XPOS:%-4dYPOS:%-5d",lx,ly);
printf("Iter Limit :%d",limit);
getkey();
$)
/* get new plot parameters */
getdata() $(
graphics(0);textcols();poke(82,2);
poke(752,1);
printf("↰↓Mandelbrot or Julia?\n↑");
key=0;
while(key!='M'&&key!='J'&&key!=155) key=toupper(getkey());
if(key!=155) $(
if(key=='J')juliaflg=1;
else juliaflg=0;
$)
if(juliaflg)printf("Julia");
else printf("Mandelbrot");
printf(" Plot Variables...\n\n");
poke(magf,0);getdata1();
$)
getdata1() $(
disp1();poke(752,0);
if(strlen(magf)==0) $(
printf("Real Center:");gets(ts);
if(strlen(ts)>0)atof(real,ts);
printf("Imag Center:");gets(ts);
if(strlen(ts)>0)atof(imag,ts);
printf("Plot Range :");gets(ts);
if(strlen(ts)>0)atof(range,ts);
if(juliaflg&&func==1) $(
printf("C Real (CA):");gets(ts);
if(strlen(ts)>0)atof(ca,ts);
printf("C Imag (CB):");gets(ts);
if(strlen(ts)>0)atof(cb,ts);
$)
$)
printf("Band Factor:");gets(ts);
if(strlen(ts)>0)bandf=val(ts);
printf("Iter Limit :");gets(ts);
if(strlen(ts)>0)limit=val(ts);
printf("Low or High Resolution:");
i=0;while(i!='L'&&i!='H'&&i!=155)
i=toupper(getkey());
if(i!=155) $(
j=lores;
lores=0;if(i=='L')lores=1;
if(j!=lores)defaultc();
$)
poke(prevf,0);lx=0;ly=0;
graphics(8);
$)
/* show current vars */
disp1() $(
printf("Real : %f\n",real);
printf("Imag : %f\n",imag);
printf("Range: %f\n",range);
if(juliaflg) $(
printf("CA : %f\n",ca);
printf("CB : %f\n",cb);
$)
printf("Band : %d\n",bandf);
printf("Limit: %d\n\n",limit);
$)
/* plot the image */
plotpic() $(
getresol();
if(lx==0&&ly==0)cf=0;else cf=1;
if(lx<hres&&ly<vres) $(
itof(hres,temp);
fdiv(range,temp,gapx);
itof(vres,temp);
fdiv(range,temp,gapy);
fdiv(range,f2,temp);
fsub(real,temp,acor);
fsub(imag,temp,bcor);
i=0;if(lx==0&&ly==0)mode=doest();
if(mode==0) $(
pplotima();
if(lx==0&&ly==0)graphics(8+16);
poke(764,255);graphics(8+48);
if(lores)gr7plus();
setcols();esc=1;
for(;ly<vres&&esc;++ly) $(
itof(ly,temp);
fmul(temp,gapy,zb);
fadd(zb,bcor,zb);
if(cf==0)lx=0;
setflg=0;lastpix=0;
for(;lx<hres&&esc;++lx) $(
itof(lx,temp);
fmul(temp,gapx,za);
fadd(za,acor,za);
if(juliaflg==1)
count=iterfix(ca,cb,limit,za,zb);
else
count=iterfix(za,zb,limit,f0,f0);
pxcol=transfrm(count);poke(77,0);
if(lores==0&&lx==0)cf=1;
if(cf==0)pplot(lx,ly,pxcol);
if(count==limit&&((lx+ly)&1)==1)$(
lx++;setflg=1;
$)
if(count<limit&&setflg==1) $(
if(lx>1)lx-=2;
setflg=0;
$)
cf=0;
key=peek(764);poke(764,255);
if(key!=255)slow();
if(key==56)fast();
if(key==28)esc=0;
$)
$)
slow();if(esc==0) $(
lx--;ly--;
$)
$)
$)
$)
/* compression ML links */
encode()
asm 0x6D40;
decode()
asm 0x6D43;
/* iteration ML link */
iterfix()
asm 0x7000;
/* transform ML link */
transml()
asm 0x7003;
/* tranform count into color */
transfrm(ct)
int ct;
$(
if(ct==limit)pxcol=0;
else pxcol=transml(ct,bandf);
if(lores==0) $(
i=pxcol;
if(pxcol==0)pxcol=(lx+ly)&1;
else $(
if(pxcol==lastpix)pxcol=0;
else pxcol=1;
$)
lastpix=i;
$)
return(pxcol);
$)
/* estimate time (link) */
doest() $(
esttime(lores,juliaflg,limit,ca,cb,gapx,gapy,acor,bcor);
$)
/* set color registers */
setcols() $(
poke(708,cr0);poke(709,cr1);
poke(710,cr2);poke(711,cr3);
poke(712,cr4);poke(752,1);
$)
/* get hres, vres */
getresol() $(
vres=192;hres=320;
if(lores)hres=160;
$)
/* save plot to disk */
saveima() $(
poke(752,0);poke(82,6);
printf("↰ SAVE IMAGE ");
if(strlen(prevf)>0)printf("%s",prevf);
else printf("D%d:*.PIC",drvnum);
printf("\n\nName>");gets(fspec);
if(strlen(fspec)>0) $(
normalize(fspec,"PIC");
err=open(4,8,0,fspec);
if(err<0)errtrap(err);
else $(
graphics(8+48);if(lores)gr7plus();
setcols();strcpy(prevf,fspec);
getdisp();i=8;if(lores)i=15;
cr3=254; /* compress flag */
cputc(i,4);cputc(cr0,4);
cputc(cr1,4);cputc(cr2,4);
cputc(cr3,4);cputc(cr4,4);
encode(start,7680,4);
err=peek(0x0383);
if(err>1)errtrap(err);
else wrdata();
$)
close(4);
$)
$)
/* load plot from disk */
loadima() $(
poke(752,0);poke(82,6);
printf("↰ LOAD IMAGE ");
printf("D%d:*.PIC",drvnum);
printf("\n\nName>");gets(fspec);
poke(752,1);i=strlen(fspec);
if(i>0) $(
normalize(fspec,"PIC");
err=open(4,4,0,fspec);
if(err<0)errtrap(err);
else $(
i=cgetc(4);
if(i==8||i==15) $(
strcpy(prevf,fspec);
lores=0;if(i==15)lores=1;
graphics(8+16);if(lores)gr7plus();
cr0=cgetc(4);cr1=cgetc(4);
cr2=cgetc(4);cr3=cgetc(4);
cr4=cgetc(4);setcols();getdisp();
if(cr3==254)decode(start,7680,4);
else bgets(start,7680,4);
err=peek(0x0383);
if(err>1)errtrap(err);
else $(
rddata();getresol();
$)
$) else $(
poke(752,1);
printf("↰↓Cannot Load");
getkey();
$)
$)
close(4);
$)
$)
/* get screen address, size */
getdisp() $(
start=peek(106)*256;
start-=7856;
$)
/* write data block to #4 */
wrdata() $(
printf(4,"%f\n",real);
printf(4,"%f\n",imag);
printf(4,"%f\n",range);
printf(4,"%d\n",limit);
printf(4,"%d\n",lx);
printf(4,"%d\n",ly);
printf(4,"%d\n",bandf);
printf(4,"%f\n",ca);
printf(4,"%f\n",cb);
printf(4,"%d\n",juliaflg);
printf(4,"%d\n",mode);
$)
/* read data block from #4 */
rddata() $(
cgets(ts,4);atof(real,ts);
cgets(ts,4);atof(imag,ts);
cgets(ts,4);atof(range,ts);
cgets(ts,4);limit=val(ts);
cgets(ts,4);lx=val(ts);
cgets(ts,4);ly=val(ts);
cgets(ts,4);bandf=val(ts);
cgets(ts,4);atof(ca,ts);
cgets(ts,4);atof(cb,ts);
cgets(ts,4);juliaflg=val(ts);
if(juliaflg!=1)juliaflg=0;
cgets(ts,4);mode=val(ts);
if(mode<0||mode>2)mode=0;
$)
/* magnify or make Julia */
magnify() $(
getresol();x=hres/2;y=vres/2;
esc=0;while(esc==0) $(
graphics(8+48);if(lores)gr7plus();
setcols();getdisp();esc=0;qcnt=1;
while(esc==0) $(
drawcurs(x,y);
key=peek(764);poke(764,255);
i=x+y;
if(key==14) y-=qcnt;
if(key==15) y+=qcnt;
if(key==6) x-=qcnt;
if(key==7) x+=qcnt;
if(key==12) esc=1;
if(i!=x+y) $(
qcnt=qcnt+1;
if(qcnt>10) qcnt=10;
if(x<2) x+=hres-4;
else if(x>=hres-2) x-=hres-4;
else if(y<2) y+=vres-4;
else if(y>=vres-2) y-=vres-4;
$) else qcnt=1;
$)
if(mode==2) $( /* adjust range */
itof(4,temp); /* for mini-plot */
fmul(range,temp,mr);
$) else move(range,mr,6);
itof(hres,temp);
fdiv(mr,temp,gapx);
itof(vres,temp);
fdiv(mr,temp,gapy);
itof(2,temp);
fdiv(mr,temp,temp1);
fsub(real,temp1,acor);
fsub(imag,temp1,bcor);
itof(x,temp);
fmul(gapx,temp,temp);
fadd(acor,temp,xc);
itof(y,temp);
fmul(gapy,temp,temp);
fadd(bcor,temp,yc);
atof(temp,"1E-8"); /* compensate */
fadd(yc,temp,yc); /* roundoff */
graphics(8+32);if(lores)gr7plus();
setcols();esc1=0;while(esc1==0) $(
poke(752,1);poke(82,2);
printf("↰Real point: %f\n",xc);
printf("Imag point: %f\n",yc);
printf(" F Find another M Magnify area\n");
printf(" I Iterations ");
if(juliaflg==0)printf(" J Julia Plot");
esc=0;esc1=1;while(esc==0) $(
key=toupper(getkey());esc=1;
if(key=='J'&&juliaflg)esc=0;
$)
if(key=='F')esc=0;
if(key=='M') $(
pnewplot();
i=toupper(getkey());
if(i=='Y') $(
poke(752,0);
printf("↰↓Current Range: %f",range);
printf("\nMagnification: ");
gets(ts);if(strlen(ts)>0) $(
atof(magf,ts);
graphics(0);textcols();
poke(prevf,0);
if(juliaflg)printf("↰Julia");
else printf("↰Mandelbrot");
printf(" Plot...\n\n");
move(xc,real,6);move(yc,imag,6);
fdiv(range,magf,range);
getdata1();
$) else esc1=0;
$) else esc1=0;
$)
if(key=='J') $(
pnewjul();
i=toupper(getkey());
if(i=='Y') $(
graphics(0);textcols();
printf("↰JULIA PLOT...\n\n");
atof(range,"2.00");
atof(real,"0.00");
atof(imag,"0.00");
move(xc,ca,6);move(yc,cb,6);
poke(magf,0);juliaflg=1;
getdata1();
$) else esc1=0;
$)
if(key=='I') $(
esc1=0;i=limit;
if(limit<1000) limit=1000;
printf("↰↓Iteration Count: ");
if(juliaflg==1)
count=iterfix(ca,cb,limit,xc,yc);
else
count=iterfix(xc,yc,limit,f0,f0);
printf("%d\n",count);
limit=i;getkey();
$)
$)
$)
$)
/* default colors */
defaultc() $(
ptr=0x06F0;if(lores) $(
cr0=*(ptr);cr1=*(ptr+1);
cr2=*(ptr+2);cr4=*(ptr+3);
$) else $(
cr1=*(ptr+4);cr2=*(ptr+5);
cr4=*(ptr+6);cr0=0;
$) cr3=254;setcols();
$)
/* end of main program */