/*
 *      BUGS.SL
 *          ¹Þݾ²ÄÞ³ÌÞ ¼Ý¶ ¼Ð­Ú°¼®Ý
 *
 *          »²´Ý½ 7 ¶Þ ºÞ³
 *                ºÝËß­°À°Ú¸Ø´°¼®Ý ÖØ
 *
 *         BUG        Feed(Bacteria)
 *         OOO          *   *
 *         O@O           *    *
 *         OOO        *    *    *
 *
 *  Do BUGs survive or die off?
 */

    ORG    $3000;
    OFFSET $9000-$3000;

#include SOROBAN.LIB

const   KETA=80,        /*  width KETA  */
        MAXL=24,        /*  locate(?,MAXL) is prohibited  */
        SKIP=10,        /*  how many skip  */
        BUGMAX=100,     /*  maximum of BUG  */
        BUGSIZE=32,     /*  size of BUG structure  */
        FIRSTBUG=10,    /*  first number of BUG  */
        BUGLIFE=5000,   /*  life limit of BUG  */
        REPYEAR=100,    /*  reproductable year of BUG  */
        REPENGY=500,    /*  reproductable energy of BUG  */
        FIRSTENGY=40,   /*  particular energy of first BUG  */
        ENGYMAX=1500,   /*  maximum of BUG energy  */
        FEEDENGY=40;    /*  energy par Feed(Bacteria)  */

array byte vramr[KETA-2][MAXL-1],byte svramr[KETA-2][MAXL-1];
var   byte vram[][MAXL-1],byte svram[][MAXL-1];
array byte bugdata[BUGMAX*BUGSIZE-1];   /*  BUG ÃÞ°À Ø®³²·  */
array word bugptr[BUGMAX-1];    /*  BUG Í É Îß²ÝÀ  */
array byte geta[@sng],      /*  ¶¸Ø ¦ ¼Þ¯½³ ¶× ¾²½³ Æ ÍÝ¶Ý ½Ù Ê޲ؠ(65535)  */
      byte zero[@sng],      /*  (float)0  */
      byte zwei[@sng];      /*  (float)0  */
array word xmove[5] = [ %0, %2, %2, %0,%-2,%-2 ],
      word ymove[5] = [ %2, %1,%-1,%-2,%-1, %1 ];

var bugnum;         /*  BUG É ¶½Þ  */

main()
var sk;
    [
    vram=vramr;     /*  vram Ê Ê²Ú vramr[][] Í É Îß²ÝÀ  */
    svram=svramr;   /*  svram Ê Ê²Ú svramr[][] Í É Îß²ÝÀ  */
    width(KETA);
    @single();      /*  ¹²»Ý Ê Àݾ²ÄÞ  */
    setfcon();      /*  ¼Þ¯½³Ã²½³ É Ã²·Þ  */
    initbug();      /*  BUG ¦ FIRSTBUG Ë· ʯ¾²  */
    vraminit();     /*  ¶¿³ VRAM ¼®·¶  */
//
    print("\c");
    sk=0;
    while(bugnum!=0)
        [
        if (newgen()!=TRUE)
            [
            locate(0,0);
            print("Too many BUGs were reproducted.\n");
            exit;
            ]
        case(sk)
            [
            0:  display();          /*  Ë®³¼Þ  */
            1:  [
                rewrite();          /*  ¾ÞÝÒÝ Ë®³¼Þ  */
                sk--;
                ]
            others: sk--;
            ]
        swap(&vram,&svram);
        case(inkey(0))
            [
            ' ':    pause();    /*  PAUSE & PRINT bugnum  */
            's','S':[           /*  SKIP mode  */
                    sk=sk+SKIP;
                    locate(0,0);
                    print("SKIP");
                    ]
            $1B:    [
                    locate(0,0);
                    exit;
                    ]
            ]
        ]
    if (bugnum==0)
        print("\cBUGs died off.\n");
    ]

setfcon()
    [
    @cvutf(geta,65535);         /*  geta=65535  */
    @cvutf(zero,0);             /*  zero=0  */
    @cvutf(zwei,2);             /*  zwei=2  */
    ]

initbug()
    var word p[];
    var i;
    [
    for (i=0; i<BUGMAX; i++)
    bugptr[i]=bugdata+BUGSIZE*i;
    for(bugnum=0; bugnum<FIRSTBUG; bugnum++)
        [
        p=bugptr[bugnum];
        p[0]=1;             /*  1 year old  */
        p[1]=FIRSTENGY;     /*  energy=Default  */
        p[2]=rnd(KETA-1);   /*  BUG's x  */
        p[3]=rnd(MAXL);     /*  BUG's y  */
        p[4]=rnd(6);        /*  random turn  */
        for(i=5; i<11; i++)
            p[i]=rnd(7)-3;  /*  random gene  */
        setprb(&p[5],&p[11]);   /*  set turn distribution  */
        ]
    ]

vraminit()
    var x,y;
    [
    for(y=0; y<MAXL; y++)
        for(x=0; x<KETA-1; x++)
            vram[x][y]=(amedas(x,y))?'*':' ';
    ]

svraminit()
    var x,y;
    [
    for (y=0; y<MAXL; y++)          /*  Sub-VRAM ¼®·¶  */
        for (x=0; x<KETA-1; x++)
            svram[x][y]=(amedas(x,y) or vram[x][y]=='*')?'*':' ';
    ]

sort(n)     /*  ²ÝÁ· ¿°Ä (¶Þ°ÍÞ¼ÞºÚ¸¼®Ý)  */
    var i,j,temp;
    [
    for (i=0; i<n; i++)
        if (memw[bugptr[i]]==0)
            [
            temp=bugptr[i];
            for (j=i; j<n-1; j++)
                bugptr[j]=bugptr[j+1];
            bugptr[n-1]=temp;
            ]
    ]

newgen()    /*  BUGS ¶Þ ²¼Þ®³¿Þ³¼®¸ ½ÚÊÞ FALSE¤ ¿³ÃÞ Å¹ÚÊÞ TRUE  */
    var death;
    [
    svraminit();
    death=grow();       /*  One step forward  */
    if (death!=0)
        sort(bugnum);   /*  Garbage collection  */
    if ((bugnum=bugnum-death)==0)       /*  BUG die off  */
        return(TRUE);
    return(newborn());  /*  Make new BUG  */
    ]

grow()
    var i,turn,death;
    var word p[];
    [
    for (i=0,death=0; i<bugnum; i++)
        [
        p=bugptr[i];            /*  p=&(i ÊÞÝÒ É bugdata)  */
        turn=getturn(&p[11]);   /*  prb[] Æ ¼À¶Þ¯Ã turn ¦ ¶´½  */
        p[4]=turn=(p[4]+turn) mod 6;                  /*  turn=newturn  */
        p[2]=(p[2]+xmove[turn]+KETA-1) mod (KETA-1);  /*  x=x+xmove(turn)  */
        p[3]=(p[3]+ymove[turn]+MAXL) mod MAXL;        /*  y=y+ymove(turn)  */
        p[1]=p[1]+putbug(p[2],p[3])*FEEDENGY-1; /*  put bug and eat virus  */
        if (p[1]>ENGYMAX)
            p[1]=ENGYMAX;           /*  energy<=ENGYMAX  */
        p[0]++;                     /*  year++  */
        //
        if (p[0]>BUGLIFE or p[1]==0)    /*  ¼Þ­Ð®³ or ¶Þ¼  */
            [
            p[0]=0;     /*  year=0  */
            death++;
            ]
        ]
    return(death);
    ]

newborn()       /*  Memory Over ¼ÀÄ· Ê FALSE¤ ¿³ÃÞ Å²Ä· Ê TRUE  */
    var i,j,birth,delta;
    var word p[],word pn1[],word pn2[];
    [
    for (i=0,birth=0; i<bugnum; i++)
        [
        p=bugptr[i];
        if (p[0]>REPYEAR AND p[1]>=REPENGY)    /*  ÌÞݶ ¶É³  */
            [
            if (bugnum+birth+2>=BUGMAX)       /*  Memory Over  */
                return(FALSE);
            //
            pn1=bugptr[bugnum+birth];
            pn2=bugptr[bugnum+birth+1];
            pn1[0]=pn2[0]=1;                /*  1 year old  */
            p[1]=pn1[1]=pn2[1]=p[1]/3;      /*  divide Energy equally  */
            pn1[2]=pn2[2]=p[2];             /*  x  */
            pn1[3]=pn2[3]=p[3];             /*  y  */
            pn1[4]=pn2[4]=p[4];             /*  turn  */
            //
            for (j=5; j<11; j++)        /*  recieve DNA  */
                [
                delta=rnd(7)-3;
                pn1[j]=p[j]+delta;
                pn2[j]=p[j]-delta;
                ]
            setprb(&pn1[5],&pn1[11]);
            setprb(&pn2[5],&pn2[11]);   /*  set newborn's turn distribution  */
            birth=birth+2;
            ]
        ]
    bugnum=bugnum+birth;
    return(TRUE);
    ]

setprb(word gene[],word prb[])
    var i,fp;
    array byte gsum[@sng],byte gpow[6][@sng],byte dummy[@sng];
    [
    @move(gsum,zero);       /*  *gsum=0  */
    @move(gpow[0],zero);    /*  *gpow[0]=0  */
    for (i=1; i<7; i++)
        [
        fp=@cvitf(gpow[i],gene[i-1]);    /*  *fp=*gpow[i]=(float)gene[i-1]  */
        @add(gsum,gsum,@pow(fp,zwei,fp));/*  *gsum=*gsum+pow(2,*fp)  */
        ]                                /*  *fp=pow(2,*fp)  */
    fp=gpow[0];                 /*  *fp=0  */
    for(i=0; i<6; i++)
        [
        @add(fp,fp,gpow[i+1]);  /*  *fp=*fp+*gpow[i+1]  */
        @div(dummy,fp,gsum);    /*  *dummy=*fp/*gsum  */
        prb[i]=@cvftu(@mul(dummy,dummy,geta));
                                /*  prb[i]=(unsigned)(*dummy**geta)  */
        ]
    ]

getturn(word prb[])     /*  prb Æ ¼À¶Þ¯Ã turn ¦ 1  ¶´½  */
    var i,ri;
    [
    ri=rnd(65535);
    for (i=0; i<5; i++)
        if (ri<prb[i])
            return(i);
    return(5);
    ]

putbug(x,y)     /*  (x,y) ¦ ËÀÞضÀ É »ÞË®³ ļà Sub-VRAM Æ BUG ¦ ¶·ºÑ  */
    var feed,   /*  ÀÍÞÀ ³²Ù½ É ¶½Þ ¦ ¶´½  */
        dx,dy,px,py;
    [
    for (feed=0,dy=0; dy<3; dy++)
        for (dx=0; dx<3; dx++)
            case(svram[px=((x+dx) mod (KETA-1))][py=((y+dy) mod MAXL)])
                [
                '*':    [
                        feed++;
                        svram[px][py]=(dx==1 and dy==1)?'@':'0';
                        ]
                ' ':    svram[px][py]=(dx==1 and dy==1)?'@':'0';
                ]
    return(feed);
    ]

display()
    var x,y,c;
    [
    for (y=0; y<MAXL; y++)
        for (x=0; x<KETA-1; x++)
            if ((c=svram[x][y])!=vram[x][y])
                [
                locate(x,y);
                print(str$(c,1));
                ]
    ]

rewrite()
    var x,y;
    [
    for (y=0; y<MAXL; y++)
        for (x=0; x<KETA-1; x++)
            [
            locate(x,y);
            print(str$(svram[x][y],1));
            ]
    ]

swap(word p[],word q[])
    var temp;
    [
    temp=p[0];
    p[0]=q[0];
    q[0]=temp;
    ]

pause()
    var x;
    [
    locate(0,0);
    print("PAUSE:",deci$(bugnum));
    while(inkey(2)==' ')
        ;
    for (x=0; x<11; x++)
        [
        locate(x,0);
        print(str$(vram[x][0],1));
        ]
    ]

amedas(x,y)
    [
    if (x<40)
        return(rnd(20000)==0);
    else
        return(rnd(20000)<4);
    ]