home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume10 / logo / part02 / logonum.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-23  |  9.6 KB  |  539 lines
  1.  
  2. /*    Numeric operations in LOGO.
  3.  *    In arithmetic operations, the input, which is a character, is
  4.  *    converted to numeric, the operations are done, and the result is
  5.  *    converted back to character.
  6.  *    In all cases, the inputs are freed, and a new output is created.
  7.  *
  8.  *    Copyright (C) 1979, The Children's Museum, Boston, Mass.
  9.  *    Written by Douglas B. Klunder.
  10.  */
  11.  
  12. #include <math.h>
  13. #include "logo.h"
  14.  
  15. nump(x)        /* non-LOGO numberp, just for strings */
  16. register struct object *x;
  17. {    /* a number is a series of at least one digit, with an optional
  18.     * starting + or -. */
  19.     register char ch,*cp;
  20.  
  21.     cp = x->obstr;
  22.     if (*cp=='\0') return(0);
  23.     if (*cp!='-' && *cp!='+' && (*cp<'0' || *cp>'9') && *cp!='.') return(0);
  24.     if ((*cp=='-' || *cp=='+' || *cp=='.') && *(cp+1)=='\0') return(0);
  25.     if(*cp=='.' && index(cp+1,'.')) return(0);
  26.     cp++;
  27.     while ((ch = *cp)!='\0') {
  28.         if ((ch<'0'||ch>'9')&&(ch!='e')&&(ch!='E')&&(ch!='.'))
  29.             return(0);
  30.         if ((ch == 'e') || (ch == 'E')) {
  31.             if (index(cp+1,'e') || index(cp+1,'E')
  32.               || index(cp+1,'.')) return(0);
  33.             if (((ch = *(cp+1))=='+') || (ch=='-')) cp++;
  34.         }
  35.         else if (ch == '.') {
  36.             if (index(cp+1,'e') || index(cp+1,'E')
  37.               || index(cp+1,'.')) return(0);
  38.         }
  39.         cp++;
  40.     }
  41.     return(1);
  42. }
  43.  
  44. /* Check a STRING object to see if it's an integer string */
  45. isint(x)
  46. register struct object *x;
  47. {
  48.     register char ch,*cp;
  49.  
  50.     cp = x->obstr;
  51.     while (ch = *cp++)
  52.         if ((ch == '.') || (ch == 'e') || (ch == 'E'))
  53.             return(0);
  54.     return(1);
  55. }
  56.  
  57. /* convert object (which might be a word of digits) to a number */
  58. struct object *numconv(thing,op)
  59. register struct object *thing;
  60. char *op;
  61. {
  62.     register struct object *newthing;
  63.     FIXNUM ithing;
  64.     NUMBER dthing;
  65.  
  66.     if (thing == 0) ungood(op,thing);
  67.     switch (thing->obtype) {
  68.         case CONS:
  69.             ungood(op,thing);
  70.         case INT:
  71.         case DUB:
  72.             return(thing);
  73.         default:
  74.             if (!nump(thing)) ungood(op,thing);
  75.             if (isint(thing)) {
  76.                 sscanf(thing->obstr,FIXFMT,&ithing);
  77.                 newthing = localize(objint(ithing));
  78.             } else {
  79.                 sscanf(thing->obstr,EFMT,&dthing);
  80.                 newthing = localize(objdub(dthing));
  81.             }
  82.     }
  83.     mfree(thing);
  84.     return(newthing);
  85. }
  86.  
  87. /* convert integer to double */
  88. struct object *dubconv(num)
  89. register struct object *num;
  90. {
  91.     NUMBER d;
  92.  
  93.     if (dubp(num)) return(num);
  94.     d = num->obint;
  95.     mfree(num);
  96.     return(localize(objdub(d)));
  97. }
  98.  
  99. struct object *opp(x)    /* Unary - */
  100. register struct object *x;
  101. {
  102.     register struct object *ans;
  103.  
  104.     x = numconv(x,"Minus");
  105.     if (intp(x)) {
  106.         ans = objint(-(x->obint));
  107.     } else {
  108.         ans = objdub(-(x->obdub));
  109.     }
  110.     mfree(x);
  111.     return(localize(ans));
  112. }
  113.  
  114. struct object *add(x,y)    /* sum */
  115. register struct object *x,*y;
  116. {
  117.     FIXNUM iz;
  118.     NUMBER dz;
  119.     register struct object *z;
  120.  
  121.     x = numconv(x,"Sum");
  122.     y = numconv(y,"Sum");
  123.     if (!intp(x) || !intp(y)) {
  124.         x = dubconv(x);
  125.         y = dubconv(y);
  126.     }
  127.     if (intp(x)) {
  128.         iz = (x->obint)+(y->obint);
  129.         z = objint(iz);
  130.     } else {
  131.         dz = (x->obdub)+(y->obdub);
  132.         z = objdub(dz);
  133.     }
  134.     mfree(x);
  135.     mfree(y);
  136.     return(localize(z));
  137. }
  138.  
  139. struct object *sub(x,y)    /* difference */
  140. register struct object *x,*y;
  141. {
  142.     FIXNUM iz;
  143.     NUMBER dz;
  144.     register struct object *z;
  145.  
  146.     x = numconv(x,"Difference");
  147.     y = numconv(y,"Difference");
  148.     if (!intp(x) || !intp(y)) {
  149.         x = dubconv(x);
  150.         y = dubconv(y);
  151.     }
  152.     if (intp(x)) {
  153.         iz = (x->obint)-(y->obint);
  154.         z = objint(iz);
  155.     } else {
  156.         dz = (x->obdub)-(y->obdub);
  157.         z = objdub(dz);
  158.     }
  159.     mfree(x);
  160.     mfree(y);
  161.     return(localize(z));
  162. }
  163.  
  164. struct object *mult(x,y)    /* product */
  165. register struct object *x,*y;
  166. {
  167.     FIXNUM iz;
  168.     NUMBER dz;
  169.     register struct object *z;
  170.  
  171.     x = numconv(x,"Product");
  172.     y = numconv(y,"Product");
  173.     if (!intp(x) || !intp(y)) {
  174.         x = dubconv(x);
  175.         y = dubconv(y);
  176.     }
  177.     if (intp(x)) {
  178.         iz = (x->obint)*(y->obint);
  179.         z = objint(iz);
  180.     } else {
  181.         dz = (x->obdub)*(y->obdub);
  182.         z = objdub(dz);
  183.     }
  184.     mfree(x);
  185.     mfree(y);
  186.     return(localize(z));
  187. }
  188.  
  189. divzero(name)
  190. char *name;
  191. {
  192.     pf1("%s can't divide by zero.\n",name);
  193.     errhand();
  194. }
  195.  
  196. struct object *div(x,y)    /* quotient */
  197. register struct object *x,*y;
  198. {
  199.     NUMBER dz;
  200.  
  201.     x = numconv(x,"Quotient");
  202.     y = numconv(y,"Quotient");
  203.     x = dubconv(x);
  204.     y = dubconv(y);
  205.     if (y->obdub == 0.0) divzero("Quotient");
  206.     dz = (x->obdub)/(y->obdub);
  207.     mfree(x);
  208.     mfree(y);
  209.     if (dz == (NUMBER)(FIXNUM)dz) {
  210.         return(localize(objint((FIXNUM)dz)));
  211.     } else {
  212.         return(localize(objdub(dz)));
  213.     }
  214. }
  215.  
  216. struct object *rem(x,y)    /* remainder */
  217. register struct object *x,*y;
  218. {
  219.     FIXNUM iz;
  220.     register struct object *z;
  221.  
  222.     x = numconv(x,"Remainder");
  223.     y = numconv(y,"Remainder");
  224.     if (!intp(x)) ungood("Remainder",x);
  225.     if (!intp(y)) ungood("Remainder",y);
  226.     if (y->obint == 0) divzero("Remainder");
  227.     iz = (x->obint)%(y->obint);
  228.     z = objint(iz);
  229.     mfree(x);
  230.     mfree(y);
  231.     return(localize(z));
  232. }
  233.  
  234. struct object *torf(pred)
  235. int pred;
  236. {
  237.     if (pred) return(true());
  238.     return(false());
  239. }
  240.  
  241. struct object *greatp(x,y)    /* greaterp */
  242. register struct object *x,*y;
  243. {
  244.     int iz;
  245.  
  246.     x = numconv(x,"Greaterp");
  247.     y = numconv(y,"Greaterp");
  248.     if (!intp(x) || !intp(y)) {
  249.         x = dubconv(x);
  250.         y = dubconv(y);
  251.     }
  252.     if (intp(x)) {
  253.         iz = ((x->obint)>(y->obint));
  254.     } else {
  255.         iz = ((x->obdub)>(y->obdub));
  256.     }
  257.     mfree(x);
  258.     mfree(y);
  259.     return torf(iz);
  260. }
  261.  
  262. struct object *lessp(x,y)    /* lessp */
  263. register struct object *x,*y;
  264. {
  265.     int iz;
  266.  
  267.     x = numconv(x,"Lessp");
  268.     y = numconv(y,"Lessp");
  269.     if (!intp(x) || !intp(y)) {
  270.         x = dubconv(x);
  271.         y = dubconv(y);
  272.     }
  273.     if (intp(x)) {
  274.         iz = ((x->obint)<(y->obint));
  275.     } else {
  276.         iz = ((x->obdub)<(y->obdub));
  277.     }
  278.     mfree(x);
  279.     mfree(y);
  280.     return torf(iz);
  281. }
  282.  
  283. struct object *lmax(x,y)    /* maximum */
  284. register struct object *x,*y;
  285. {
  286.     x = numconv(x,"Maximum");
  287.     y = numconv(y,"Maximum");
  288.     if (!intp(x) || !intp(y)) {
  289.         x = dubconv(x);
  290.         y = dubconv(y);
  291.     }
  292.     if (intp(x)) {
  293.         if ((x->obint) > (y->obint)) {
  294.             mfree(y);
  295.             return(x);
  296.         } else {
  297.             mfree(x);
  298.             return(y);
  299.         }
  300.     } else {
  301.         if ((x->obdub) > (y->obdub)) {
  302.             mfree(y);
  303.             return(x);
  304.         } else {
  305.             mfree(x);
  306.             return(y);
  307.         }
  308.     }
  309. }
  310.  
  311. struct object *lmin(x,y)    /* minimum */
  312. register struct object *x,*y;
  313. {
  314.     x = numconv(x,"Minimum");
  315.     y = numconv(y,"Minimum");
  316.     if (!intp(x) || !intp(y)) {
  317.         x = dubconv(x);
  318.         y = dubconv(y);
  319.     }
  320.     if (intp(x)) {
  321.         if ((x->obint) < (y->obint)) {
  322.             mfree(y);
  323.             return(x);
  324.         } else {
  325.             mfree(x);
  326.             return(y);
  327.         }
  328.     } else {
  329.         if ((x->obdub) < (y->obdub)) {
  330.             mfree(y);
  331.             return(x);
  332.         } else {
  333.             mfree(x);
  334.             return(y);
  335.         }
  336.     }
  337. }
  338.  
  339. struct object *lnump(x)        /* LOGO numberp */
  340. register struct object *x;
  341. {
  342.     if (x == 0) return(false());
  343.     switch (x->obtype) {
  344.         case CONS:
  345.             mfree(x);
  346.             return(false());
  347.         case INT:
  348.         case DUB:
  349.             mfree(x);
  350.             return(true());
  351.         default:    /* case STRING */
  352.             if (nump(x)) {
  353.                 mfree(x);
  354.                 return(true());
  355.             } else {
  356.                 mfree(x);
  357.                 return(false());
  358.             }
  359.     }
  360. }
  361.  
  362. struct object *lrandd()        /* random */
  363. {
  364.     register struct object *val;
  365.     register temp;
  366.  
  367.     temp=(RAND()/100)%10;
  368.     val = objint((FIXNUM)temp);
  369.     return(localize(val));
  370. }
  371.  
  372. struct object *rnd(arg)
  373. register struct object *arg;
  374. {
  375.     register temp;
  376.  
  377.     arg = numconv(arg,"Rnd");
  378.     if(!intp(arg)) ungood("Rnd",arg);
  379.     if ((arg->obint) <= 0) ungood("Rnd",arg);
  380.     temp=RAND() % (int)(arg->obint);
  381.     mfree(arg);
  382.     return(localize(objint((FIXNUM)temp)));
  383. }
  384.  
  385. struct object *sq(arg)
  386. register struct object *arg;
  387. {
  388.     NUMBER temp;
  389.  
  390.     arg = numconv(arg,"Sqrt");
  391.     arg = dubconv(arg);
  392.     temp = sqrt(arg->obdub);
  393.     mfree(arg);
  394.     return(localize(objdub(temp)));
  395. }
  396.  
  397. struct object *lsin(arg)
  398. register struct object *arg;
  399. {
  400.     NUMBER temp;
  401.  
  402.     arg = numconv(arg,"Sin");
  403.     arg = dubconv(arg);
  404.     temp = sin((3.1415926/180.0)*(arg->obdub));
  405.     mfree(arg);
  406.     return(localize(objdub(temp)));
  407. }
  408.  
  409. struct object *lcos(arg)
  410. register struct object *arg;
  411. {
  412.     NUMBER temp;
  413.  
  414.     arg = numconv(arg,"Cos");
  415.     arg = dubconv(arg);
  416.     temp = cos((3.1415926/180.0)*(arg->obdub));
  417.     mfree(arg);
  418.     return(localize(objdub(temp)));
  419. }
  420.  
  421. struct object *lpow(x,y)
  422. register struct object *x,*y;
  423. {
  424.     FIXNUM iz;
  425.     NUMBER dz;
  426.     register struct object *z;
  427.  
  428.     x = numconv(x,"Pow");
  429.     y = numconv(y,"Pow");
  430.     x = dubconv(x);
  431.     y = dubconv(y);
  432.     dz = pow((x->obdub),(y->obdub));
  433.     iz = dz;    /* convert to integer for integerness test */
  434.     if (dz == (NUMBER)iz)
  435.         z = objint(iz);
  436.     else 
  437.         z = objdub(dz);
  438.     mfree(x);
  439.     mfree(y);
  440.     return(localize(z));
  441. }
  442.  
  443. struct object *latan(arg)
  444. register struct object *arg;
  445. {
  446.     NUMBER temp;
  447.  
  448.     arg = numconv(arg,"Atan");
  449.     arg = dubconv(arg);
  450.     temp = (180.0/3.1415926)*atan(arg->obdub);
  451.     mfree(arg);
  452.     return(localize(objdub(temp)));
  453. }
  454.  
  455. struct object *zerop(x)        /* zerop */
  456. register struct object *x;
  457. {
  458.     register int iz;
  459.  
  460.     x = numconv(x,"Zerop");
  461.     if (intp(x))
  462.         iz = ((x->obint)==0);
  463.     else
  464.         iz = ((x->obdub)==0.0);
  465.     mfree(x);
  466.     return(torf(iz));
  467. }
  468.  
  469. struct object *intpart(arg)
  470. register struct object *arg;
  471. {
  472.     register FIXNUM result;
  473.  
  474.     arg = numconv(arg,"Int");
  475.     if (intp(arg)) return(arg);
  476.     result = arg->obdub;
  477.     mfree(arg);
  478.     return(localize(objint(result)));
  479. }
  480.  
  481. struct object *round(arg)
  482. register struct object *arg;
  483. {
  484.     register FIXNUM result;
  485.  
  486.     arg = numconv(arg,"Round");
  487.     if (intp(arg)) return(arg);
  488.     if (arg->obdub >= 0.0)
  489.         result = arg->obdub + 0.5;
  490.     else
  491.         result = arg->obdub - 0.5;
  492.     mfree(arg);
  493.     return(localize(objint(result)));
  494. }
  495.  
  496. struct object *toascii(arg)
  497. register struct object *arg;
  498. {
  499.     register char *cp;
  500.     char str[50];
  501.  
  502.     if (arg==0) ungood("Ascii",arg);
  503.     switch(arg->obtype) {
  504.         case CONS:
  505.             ungood("Ascii",arg);
  506.         case STRING:
  507.             cp = arg->obstr;
  508.             break;
  509.         case INT:
  510.             sprintf(str,FIXFMT,arg->obint);
  511.             cp = str;
  512.             break;
  513.         case DUB:
  514.             sprintf(str,"%g",arg->obdub);
  515.             cp = str;
  516.             break;
  517.     }
  518.     if (strlen(cp) != 1) ungood("Ascii",arg);
  519.     mfree(arg);
  520.     return(localize(objint((FIXNUM)((*cp)&0377))));
  521. }
  522.  
  523. struct object *tochar(arg)
  524. register struct object *arg;
  525. {
  526.     register int ichar;
  527.     char str[2];
  528.  
  529.     arg = numconv(arg,"Char");
  530.     if (intp(arg)) ichar = arg->obint;
  531.     else ichar = arg->obdub;
  532.     if ((ichar < 0) || (ichar > 255)) ungood("Char",arg);
  533.     mfree(arg);
  534.     str[0] = ichar;
  535.     str[1] = '\0';
  536.     return(localize(objcpstr(str)));
  537. }
  538.  
  539.