home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga 13 / MA_Cover_13.bin / source / c / apl / ak.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-11-23  |  1.9 KB  |  134 lines
  1. #include "apl.h"
  2.  
  3. ex_scn0()
  4. {
  5.     fetch1();
  6.     scan0(0);
  7. }
  8.  
  9. ex_scan()
  10. {
  11.     struct item *p;
  12.  
  13.     p = fetch1();
  14.     scan0(p->rank-1);
  15. }
  16.  
  17. ex_scnk()
  18. {
  19.     int i;
  20.  
  21.     i = topfix() - thread.iorg;
  22.     scan0(i);
  23. }
  24.  
  25. scan0(k)
  26. {
  27.     struct item *p, *q;
  28.     data *param[2];
  29.     int scan1();
  30.  
  31.     p = fetch1();
  32.     if(p->type != DA) error("scan T");
  33.     bidx(p);
  34.     colapse(k);
  35.     if(idx.dimk == 0) {
  36. /*
  37.  *  scan identities - ets/jrl 5/76
  38.  */
  39.         q = newdat(DA,0,1);
  40.         q->dim[0] = 1;
  41.         switch(*pcp++) {
  42.     case ADD:
  43.     case SUB:
  44.     case OR:
  45.             q->datap[0] = 0;
  46.             break;
  47.     case AND:
  48.     case MUL:
  49.     case DIV:
  50.             q->datap[0] = 1;
  51.             break;
  52.     case MIN:
  53.             q->datap[0] = 1.0e38;
  54.             break;
  55.     case MAX:
  56.             q->datap[0] = -1.0e38;
  57.             break;
  58.     default:
  59.             error("reduce identity");
  60.         }
  61.         pop();
  62.         *sp++ = q;
  63.         return;
  64.     }
  65.     param[0] = p->datap;
  66.     param[1] = (data *)exop[*pcp++];
  67.     forloop(scan1, param);
  68. }
  69.  
  70. scan1(param)
  71. data *param[];
  72. {
  73.     int i, j;
  74.     data *dp, *ip, d, (*f)();
  75.  
  76.     f = (data (*)())param[1];
  77.     for (i=0; i<idx.dimk; i++) {
  78.         dp = param[0] + access() + (idx.dimk - (i+1)) * idx.delk;
  79.         ip = dp;
  80.         d  = *ip;
  81.         for (j=1; j<idx.dimk-i; j++) {
  82.             ip -= idx.delk;
  83.             d = (*f)(*ip, d);
  84.         }
  85.         *dp = d;
  86.     }
  87. }
  88.  
  89. /*
  90.  *    Everything from here to the eof is commented out.  This appears
  91.  *    to be some kind of graphics stuff, but very much specific to
  92.  *    things as they were at Purdue.  Come back and actually remove
  93.  *    this once I have all the related stuff pinned down -- MEC
  94.  *
  95. data scalex = 453.;
  96. data scaley = 453.;
  97. data origx = 0.0;
  98. data origy = 0.0;
  99.  
  100. ex_plot()
  101. {
  102.     struct item *p;
  103.     data *dp;
  104.     int i, ic, x, y;
  105.  
  106.     p = fetch1();
  107.     if(p->type != DA) error("plot T");
  108.     if(p->rank != 2) error("plot R");
  109.     if(p->dim[1] != 2) error("plot C");
  110.  
  111.     dp = p->datap;
  112.     if ((i = p->dim[0]) == 0) return;
  113.     ic=0;
  114.     while(i--) {
  115.         x = scalex*(*dp++ - origx);
  116.         y = 454-(scaley*(*dp++ - origy));
  117.         if(x<0 || x >= 576 || y<0 || y>=454) error("plot off screen");
  118.         if(ic) line(x,y);
  119.         else {
  120.             move(x,y);
  121.             ic=1;
  122.         }
  123.     }
  124. }
  125.  
  126. line(x,y)
  127. {
  128. }
  129.  
  130. move(x,y)
  131. {
  132. }
  133.  */
  134.