home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fscan < prev    next >
Encoding:
Text File  |  1990-07-19  |  2.6 KB  |  158 lines
  1. /*
  2.  * File: fscan.c
  3.  *  Contents: move, pos, tab.
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9.  
  10.  
  11. /*
  12.  * move(i) - move &pos by i, return substring of &subject spanned.
  13.  *  Reverses effects if resumed.
  14.  */
  15. FncDcl(move,1)
  16.    {
  17.    register word i, j;
  18.    word oldpos;
  19.  
  20.    /*
  21.     * Arg1 must be a (non-long) integer.
  22.     */
  23.    switch (cvint(&Arg1)) {
  24.  
  25.       case T_Integer:
  26.          j = (word)IntVal(Arg1);
  27.          break;
  28.  
  29.       default:
  30.          RunErr(101, &Arg1);
  31.       }
  32.  
  33.    /*
  34.     * Save old &pos.  Local variable i holds &pos before the move.
  35.     */
  36.    oldpos = i = k_pos;
  37.  
  38.    /*
  39.     * If attempted move is past either end of the string, fail.
  40.     */
  41.    if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
  42.       Fail;
  43.  
  44.    /*
  45.     * Set new &pos.
  46.     */
  47.    k_pos += j;
  48.  
  49.    /*
  50.     * Make sure j >= 0.
  51.     */
  52.    if (j < 0) {
  53.       i += j;
  54.       j = -j;
  55.       }
  56.  
  57.    /*
  58.     * Suspend substring of &subject that was moved over.
  59.     */
  60.    StrLen(Arg0) = j;
  61.    StrLoc(Arg0) = StrLoc(k_subject) + i - 1;
  62.    Suspend;
  63.  
  64.    /*
  65.     * If move is resumed, restore the old position and fail.
  66.     */
  67.    if (oldpos > StrLen(k_subject) + 1) {
  68.       RunErr(205, &tvky_pos.kyval)
  69.       }
  70.    else
  71.       k_pos = oldpos;
  72.    Fail;
  73.    }
  74.  
  75. /*
  76.  * pos(i) - test if &pos is at position i in &subject.
  77.  */
  78. FncDcl(pos,1)
  79.    {
  80.    register word i;
  81.  
  82.    /*
  83.     * Arg1 must be an integer.
  84.     */
  85.    if (cvint(&Arg1) == CvtFail) 
  86.       RunErr(101, &Arg1);
  87.  
  88.    /*
  89.     * Fail if &pos is not equivalent to Arg1, return Arg1 otherwise.
  90.     */
  91.    if ((i = cvpos(IntVal(Arg1), StrLen(k_subject))) != k_pos)
  92.       Fail;
  93.    MakeInt(i, &Arg0);
  94.    Return;
  95.    }
  96.  
  97. /*
  98.  * tab(i) - set &pos to i, return substring of &subject spanned.
  99.  *  Reverses effects if resumed..
  100.  */
  101.  
  102. FncDcl(tab,1)
  103.    {
  104.    register word i, j;
  105.    word t, oldpos;
  106.  
  107.    /*
  108.     * Arg1 must be an integer.
  109.     */
  110.    if (cvint(&Arg1) == CvtFail) 
  111.       RunErr(101, &Arg1);
  112.  
  113.    /*
  114.     * Convert it to an absolute position.
  115.     */
  116.    j = cvpos(IntVal(Arg1), StrLen(k_subject));
  117.    if (j == CvtFail)
  118.       Fail;
  119.  
  120.    /*
  121.     * Save old &pos.  Local variable i holds &pos before the tab.
  122.     */
  123.    oldpos = i = k_pos;
  124.  
  125.    /*
  126.     * Set new &pos.
  127.     */
  128.    k_pos = j;
  129.  
  130.    /*
  131.     *  Make j the length of the substring &subject[i:j]
  132.     */
  133.    if (i > j) {
  134.       t = i;
  135.       i = j;
  136.       j = t - j;
  137.       }
  138.    else
  139.       j = j - i;
  140.  
  141.    /*
  142.     * Suspend the portion of &subject that was tabbed over.
  143.     */
  144.    StrLoc(Arg0) = StrLoc(k_subject) + i - 1;
  145.    StrLen(Arg0) = j;
  146.    Suspend;
  147.  
  148.    /*
  149.     * If tab is resumed, restore the old position and fail.
  150.     */
  151.    if (oldpos > StrLen(k_subject) + 1) {
  152.       RunErr(205, &tvky_pos.kyval);
  153.       }
  154.    else
  155.       k_pos = oldpos;
  156.    Fail;
  157.    }
  158.