/* === BIOMORPH === Vers 3-10-92  */
/* Prog by Terry Newton 10-24-89  */
/* This program plots the complex */
/* number plane using various     */
/* algorithms. See the July 89    */
/* issue of Scientific American.  */
/* Required Link Files...         */
/*  GR7P6F00.OBJ Mode 15 Code     */
/*  CMP6D40.OBJ  File Compression */
/*  PLOTSUB.CCC  Math Art Subs    */
/*  ACECIO.CCC   ACE C functions  */
/*  ENGINE.OBJ   ACE C runtime    */
/*  COL06F0.OBJ  Default Colors   */
int  check1;
char ca[6],cb[6],z0a[6],z0b[6];
char za[6],zb[6],real[6],imag[6];
char gapx[6],gapy[6],range[6];
char va[6],vb[6],vc[6],vd[6];
char ve[6],vf[6],vg[6],vh[6];
char acor[6],bcor[6],z1a[6],z1b[6];
char fp2[6],fp3[6],temp[6],temp1[6];
char *start,*ptr;
char ac[6],bc[6],temps[20];
char xc[6],yc[6],magf[6];
char fspec[20], prevf[20];
int  size,iterlmt,sizelmt;
int  a,b,j,k,n,esc,hres,vres;
int  lores,key,cr0,cr1,cr2,cr3,cr4;
int  col,formula,esc1,func,contflg;
int  x,y,tempi,tempi1;
int  qcnt,err,drv,check2;

main() $(
/* set Sparta RUNLOC */
 if(peek(dpeek(10)+28)==128||
    peek(0x0700)==0x53)
  dpoke(dpeek(10)+61,0x3635);
 /* initialize default variables */
 if(peek(0x6F00)>0)check1=0;
 if(check1!=4321||check2!=8765) $(
  poke(0x6F00,0);
  itof(2,fp2);itof(3,fp3);
  j=0;k=0;iterlmt=20;sizelmt=10;
  formula=1;lores=1;
  atof(real,"0");atof(imag,"0");
  atof(range,"3");
  atof(ca,".6");atof(cb,"0");
  poke(prevf,0);poke(fspec,0);
  graphics(8);defaultc();
 $)
 /* loop always */
 while(1) $(
  start=dpeek(0x0058);
  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==9)dispdata();
  if(func==8) $(
   printf("↰↓  Select Drive (1-8) ");
   key=getchar();key=key-48;
   if(key>0&&key<9) $(
    drv=key;setdrive();dispdir();
   $)
  $)
  if(func==10) $(
   printf("↰↓Press RETURN to Exit");
   key=getkey();if(key==155) $(
    poke(752,0);printf("↰");
    check1=4321;check2=8765;exit();
   $)
  $)
 $)
$)
/* set drive number for ACE */
setdrive() $(
 poke(dpeek(0x2CB4),drv+48);
$)
/* confirm new plot */
newplot() $(
 printf("↰↓  *** NEW PLOT ***\n");
 printf("  Are you sure? (Y/N)");
 key=tolower(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() $(
 if(formula<1||formula>4)formula=1;
 poke(range+4,0);poke(range+5,0);
 graphics(8+32);if(lores)gr7plus();
 setcols();poke(82,2);
 printf("↰*** BIOMORPH ***    %s\n",prevf);
 printf("Select: New  Continue  Save  Load\n");
 printf("Magnify  View  Parameters  Files\n");
 printf("Alter colors  DOS");
 func=0;while(func==0) $(
  poke(764,255);
  while(peek(764)==255) poke(77,0);
  key=tolower(getkey());
  if(key=='n')func=1;
  if(key=='c')func=2;
  if(key=='s')func=3;
  if(key=='l')func=4;
  if(key=='m')func=5;
  if(key=='v')func=6;
  if(key=='a')func=7;
  if(key=='f')func=8;
  if(key=='p')func=9;
  if(key=='d')func=10;
 $)
$)
/* show plot parameters */
dispdata() $(
 poke(82,0);printf("↰");
 if(func!=9)printf("↓  Current Parameters...↓\n");
 printf("Real=%-14f CA=%f\n",real,ca);
 printf("Imag=%-14f CB=%f\n",imag,cb);
 printf("Range=%-13f Formula %d\n",range,formula);
 printf("Iter Limit=%-8d Size Limit=%d",iterlmt,sizelmt);
 if(func==9)waitkey();
$)
/* get new plot parameters */
getdata() $(
 graphics(0);textcols();
 dispdata();poke(82,2);
 printf("\n↓Enter New Parameters...↓\n");
 printf("Real Center:");gets(temps);
 if(strlen(temps)>0)atof(real,temps);
 printf("Imag Center:");gets(temps);
 if(strlen(temps)>0)atof(imag,temps);
 printf("Plot Range :");gets(temps);
 if(strlen(temps)>0) atof(range,temps);
 printf("C Real (CA):"); gets(temps);
 if(strlen(temps)>0) atof(ca,temps);
 printf("C Imag (CB):"); gets(temps);
 if(strlen(temps)>0) atof(cb,temps);
 printf("Iter Limit :"); gets(temps);
 if(strlen(temps)>0)iterlmt=val(temps);
 printf("Size Limit :"); gets(temps);
 if(strlen(temps)>0)sizelmt=val(temps);
 printf("Formulas...\n");
 printf("  1. Z=Z^2+C\n");
 printf("  2. Z=Z^3+C\n");
 printf("  3. Z=Z^4+C\n");
 printf("  4. Z=Z^5+C\n");
 printf("Which one:");
 key=getkey()-48;
 if(key>0&&key<5) $(
  printf("%d",key);formula=key;
 $)
 printf("\nLow or High Resolution:");
 key=tolower(getkey());
 if(key=='l'||key=='h') $(
  tempi=lores;
  lores=0;if(key=='l')lores=1;
  if(tempi!=lores) defaultc();
 $)
 j=0;k=0;graphics(8);poke(prevf,0);
$)
/* plot the image (if not done) */
plotpic() $(
 getresol();
 if(k<vres) plotpic1();
$)
plotpic1() $(
 printf("↰↓  While plotting...\n");
 printf("  [F] Fast  [S] Slow  [ESC] Menu");
 for(n=0;n<3000;n++);if(j==hres)j=0;
 if(j==0&&k==0)graphics(8+16);
 graphics(8+48);if(lores)gr7plus();
 setcols();
 itof(hres,va);fdiv(range,va,gapx);
 itof(vres,va);fdiv(range,va,gapy);
 fdiv(range,fp2,va);
 fsub(real,va,acor);
 fsub(imag,va,bcor);
 esc=0;contflg=0;
 for(;k<vres&&esc==0;k++) $(
  itof(k,va);fmul(va,gapy,va);
  fadd(va,bcor,z0b);
  if(contflg)j=0;
  for(;j<hres&&esc==0;j++) $(
   itof(j,va);fmul(va,gapx,va);
   fadd(va,acor,z0a);
   move(z0a,za,6);move(z0b,zb,6);
   n=0;poke(77,0);
   for(;n<iterlmt;n++) $(
    if(formula==2)compfnc2();
    else if(formula==3)compfnc3();
    else if(formula==4)compfnc4();
    else compfnc1();
    a=abs(ftoi(za));b=abs(ftoi(zb));
    size=a*a;size+=b*b;
    if(size>sizelmt*sizelmt)break;
    if(a>sizelmt||b>sizelmt)break;
   $)
   if(lores==0) $(
    if(a<sizelmt||b<sizelmt)color(0);
    else color(1);
    plot(j,k);
   $) else $(
    if(a<sizelmt&&b<sizelmt)col=0;
    else if(a<sizelmt)col=1;
    else if(b<sizelmt)col=2;
    else col=3;
    pplot(j,k,col);
   $)
   contflg=1;
   key=peek(764);poke(764,255);
   if(key==28)esc=1;
   if(key==56)fast();
   if(key==62)slow();
  $)
 $)
 slow();if(esc) $( j--;k--; $)
$)
/* Function #1... */
/* za,zb = (za,zb)^2 + ca,cb  */
compfnc1() $(
 fmul(za,za,va);fmul(zb,zb,vb);
 fsub(va,vb,z1a);fmul(fp2,za,vc);
 fmul(zb,vc,z1b);fadd(z1a,ca,za);
 fadd(z1b,cb,zb);
$)
/* Function #2... */
/* za,zb = (za,zb)^3 + ca,cb  */
compfnc2() $(
 fmul(za,za,va);fmul(zb,zb,vb);
 fmul(vb,fp3,vd);fsub(va,vd,z1a);
 fmul(va,fp3,vd);fsub(vd,vb,z1b);
 fmul(za,z1a,z1a);fmul(zb,z1b,z1b);
 fadd(z1a,ca,za);fadd(z1b,cb,zb);
$)
/* Function #3 */
/* za,zb = (za,zb)^4 + ca,cb */
compfnc3() $(
 fmul(za,za,va);fmul(zb,zb,vb);
 fsub(va,vb,vc);fmul(fp2,za,vd);
 fmul(vd,zb,vd);fmul(vc,vc,va);
 fmul(vd,vd,vb);fsub(va,vb,z1a);
 fmul(fp2,vc,z1b);fmul(z1b,vd,z1b);
 fadd(z1a,ca,za);fadd(z1b,cb,zb);
$)
/* Function #4 */
/* za,zb = (za,zb)^5 + ca,cb */
compfnc4() $(
 /* vc,vd = (za,zb)^2 */
 fmul(za,za,va);fmul(zb,zb,vb);
 fsub(va,vb,vc);fmul(za,zb,vd);
 fmul(fp2,vd,vd);
 /* ve,vf = (za,zb)^3 */
 fmul(fp3,vb,ve);fmul(fp3,va,vf);
 fsub(va,ve,ve);fsub(vf,vb,vf);
 fmul(za,ve,ve);fmul(zb,vf,vf);
 /* z1a,z1b = vc,vd * ve,vf */
 fmul(vc,ve,vg);fmul(vd,vf,vh);
 fsub(vg,vh,z1a);fmul(vc,vf,vg);
 fmul(vd,ve,vh);fadd(vg,vh,z1b);
 /* za,zb = z1a,z1b + ca,cb */
 fadd(z1a,ca,za);fadd(z1b,cb,zb);
$)
/* 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() $(
 if(lores==0) $( hres=320;vres=192; $)
 else $( hres=160;vres=192; $)
$)
/* compression ML */
encode()
  asm 0x6D40;
decode()
  asm 0x6D43;
/* save plot to disk */
saveima() $(
 poke(752,0);
 printf("↰*** SAVE PLOT ***\n");
 printf("Name>");gets(fspec);
 tempi=strlen(fspec);
 if(tempi>0) $(
  normalize(fspec,"PIC");poke(752,1);
  printf("\nSaving %s...",fspec);
  err=open(4,8,0,fspec);
  if(err<0)errtrap(err);
  else $(
   strcpy(prevf,fspec);
   tempi=8;if(lores)tempi=15;
   cr3=254;/* compressed bitmap */
   cputc(tempi,4);cputc(cr0,4);
   cputc(cr1,4);cputc(cr2,4);
   cputc(cr3,4);cputc(cr4,4);
   start=dpeek(0x0058);
   encode(start,7680,4);
   err=peek(0x0383);
   if(err>1)errtrap(err);
   else wrdata();
  $)
  close(4);
 $)
$)
/* load plot */
loadima() $(
 poke(752,0);
 printf("↰*** LOAD PLOT ***\n");
 printf("Name>");gets(fspec);
 tempi=strlen(fspec);
 if(tempi>0) $(
  normalize(fspec,"PIC");
  err=open(4,4,0,fspec);
  if(err<0)errtrap(err);
  else $(
   tempi=cgetc(4);
   if(tempi==8||tempi==15) $(
    strcpy(prevf,fspec);
    lores=0;if(tempi==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();
    start=dpeek(0x0058);
    if(cr3==254)decode(start,7680,4);
    else bgets(start,7680,4);
    err=peek(0x0383);
    if(err>1)errtrap(err);
    else $(
     rddata();getresol();
     if(j==hres&&k==vres)waitkey();
    $)
   $) else $(
    poke(752,1);
    printf("↰↓ Cannot Load File");
    getkey();
   $)
  $)
  close(4);
 $)
$)
/* write data block to #4 */
wrdata() $(
 printf(4,"%f\n",real);
 printf(4,"%f\n",imag);
 printf(4,"%f\n",range);
 printf(4,"%f\n",ca);
 printf(4,"%f\n",cb);
 printf(4,"%d\n",iterlmt);
 printf(4,"%d\n",sizelmt);
 printf(4,"%d\n",formula);
 printf(4,"%d\n",j);
 printf(4,"%d\n",k);
$)
/* read data block from #4 */
rddata() $(
 err=cgets(temps,4);if(err>0) $(
  atof(real,temps);
  cgets(temps,4);atof(imag,temps);
  cgets(temps,4);atof(range,temps);
  cgets(temps,4);atof(ca,temps);
  cgets(temps,4);atof(cb,temps);
  cgets(temps,4);iterlmt=val(temps);
  cgets(temps,4);sizelmt=val(temps);
  cgets(temps,4);formula=val(temps);
  cgets(temps,4);j=val(temps);
  cgets(temps,4);k=val(temps);
 $)
$)
/* magnify an area */
magnify() $(
 getresol();x=hres/2;y=vres/2;esc=0;
 while(esc==0) $(
  graphics(8+48);if(lores)gr7plus();
  setcols();esc=0;qcnt=1;
  while(esc==0) $(
   drawcurs(x,y);tempi=x+y;
   key=peek(764);poke(764,255);
   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(tempi!=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;
  $)
  graphics(8+32);if(lores)gr7plus();
  setcols();poke(752,1);printf("↰");
  itof(hres,temp);
  fdiv(range,temp,gapx);
  itof(vres,temp);
  fdiv(range,temp,gapy);
  itof(2,temp);
  fdiv(range,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);
  printf("Real=%f\nImag=%f\n",xc,yc);
  printf("Find  Magnify  Set\n");
  printf("RETURN for menu  ");
  esc=0;while(esc==0) $(
   key=tolower(getkey());
   if(key=='f'||key=='m'||key=='s'||
      key==155)esc=1;
  $)
  esc=0;if(key==155)esc=1;
  if(key=='s') $(
   esc=1;poke(prevf,0);graphics(8);
   move(xc,ca,6);move(yc,cb,6);
   atof(real,"0");atof(imag,"0");
   atof(range,"4");j=0;k=0;
   iterlmt=20;sizelmt=10;formula=1;
  $)
  if(key=='m') $(
   poke(752,0);esc=1;
   printf("↰Current Range=%f\n",range);
   printf("Enter Magnification :");
   gets(temps);
   if(strlen(temps)>0) $(
    atof(magf,temps);
    fdiv(range,magf,range);
    move(xc,real,6);move(yc,imag,6);
    j=0;k=0;graphics(8);poke(prevf,0);
   $)
  $)
 $)
$)
/* 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 part one */