/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* pick APL2 V1.0.0 ****************************************************
* Selects item of rite specified by indices in left.                   *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb pick(left,rite,new)
Aplcb left,     /* Indices directing the pick operation.            */
      rite,     /* Variable to pick from, or selective assign to.   */
      new;      /* Replacement variable if selective specification. */
{
     Aplcopy; Endoper; Errinit; Errstop; Getcb; Imin; Integer;
     Temp;
     Aplcb pickit(Aplcb, Aplcb, Aplcb**, Aplcb, int);
     extern int aplerr;
     Aplcb lw, out=NULL, *riteptr=NULL, rw;
     int i, ltype;
     void *vp;

     for(;;) {
          if (errinit()) break;
          if (left->aplcount == 0)
               return(errstop(0,left,rite,temp(aplcopy(rite))));
          if (left->aplrank > 1) { aplerr = 124; break; }
          rw = rite;
          ltype = left->aplflags & (APLMASK + APLAPL);
          if (ltype == APLAPL) {
               for (i = 0; aplerr == 0; i++) {
                    lw = *(left->aplptr.aplapl + i);
                    if ((left->aplcount - i) == 1) break;
                    rw = pickit(lw,rw,&riteptr,new,0);
               }
               if (aplerr) break;
               out = pickit(lw,rw,&riteptr,new,1);
          }
          else {
               if (ltype != APLINT) left = integer(left);
               if (aplerr) break;
               lw = getcb(NULL, 1, APLINT + APLTEMP, 0, NULL);
               if (aplerr) break;
               for (i = 0; aplerr == 0; i++) {
                    *(lw->aplptr.aplint) = *(left->aplptr.aplint + i);
                    if ((left->aplcount - i) == 1) break;
                    rw = pickit(lw,rw,&riteptr,new,0);
               }
               if (aplerr) break;
               out = pickit(lw,rw,&riteptr,new,1);
               endoper(lw);
          }
          break;
     }
     return(errstop(0,left,rite,out));
}