Subversion Repositories wimsdev

Rev

Rev 8148 | Rev 12122 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. /*    Copyright (C) 1998-2003 XIAO, Gang of Universite de Nice - Sophia Antipolis
  2.  *
  3.  *  This program is free software; you can redistribute it and/or modify
  4.  *  it under the terms of the GNU General Public License as published by
  5.  *  the Free Software Foundation; either version 2 of the License, or
  6.  *  (at your option) any later version.
  7.  *
  8.  *  This program is distributed in the hope that it will be useful,
  9.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11.  *  GNU General Public License for more details.
  12.  *
  13.  *  You should have received a copy of the GNU General Public License
  14.  *  along with this program; if not, write to the Free Software
  15.  *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  */
  17. #include "../Lib/libwims.h"
  18. #include "sp.h"
  19.  
  20. char *setpre="";
  21.  
  22. void sp_asis(char *p, int ptype)
  23. {
  24.     fprintf(outf,"%stmp%d=!nosubst %s\n\n",setpre,prepcnt,p);
  25. }
  26.  
  27. void sp_evalue(char *p, int ptype)
  28. {
  29.     char *p1, *p2, *pe;
  30.  
  31.     p1=strparchr(p,',');
  32.     if(p1==NULL) {
  33.       fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
  34.       return;
  35.     }
  36.     *p1++=0; fprintf(outf,"%sevaltmp=%s\n\n", setpre,p);
  37.     for(; p1!=NULL; p1=p2){
  38.       p1=find_word_start(p1);
  39.       p2=strparchr(p1,',');
  40.       if(p2!=NULL) *p2++=0;
  41.       pe=strchr(p1,'=');
  42.       if(pe==NULL) continue;
  43.       *pe++=0; *find_word_end(p1)=0;
  44.       if(*p1==0) continue;
  45.       fprintf(outf,"%sevaltmp=!mathsubst %s=(%s) in $evaltmp\n",
  46.             setpre,p1,pe);
  47.     }
  48.     fprintf(outf,"%stmp%d=($evaltmp)\n",setpre,prepcnt);
  49. }
  50.  
  51. /* simple roots.*/
  52. void sp_solve(char *p, int ptype)
  53. {
  54.     fprintf(outf,"%stmp=!replace internal .. by , in %s \n\n\
  55. !distribute items $tmp into tmp1,tmp2,tmp3\n\
  56. %stmp2=!replace internal = by , in $tmp2\n\
  57. !distribute items $tmp2 into tmp4,tmp5\n\
  58. %stmp%d=!solve $tmp1 for $tmp4 = $tmp5 to $tmp3 \n",
  59.           setpre,p,setpre,setpre,prepcnt);
  60. }
  61.  
  62. /* use maxima to do formal derivation. */
  63. void sp_diff(char *p, int ptype)
  64. {
  65.     fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s\n\n\
  66. %stmp=!lower $tmp\n\
  67. %stmp%d=!exec maxima diff($tmp);\n",
  68.           setpre,p,setpre,setpre,prepcnt);
  69. }
  70.  
  71. /* user pari to compute matrix determinant. */
  72. void sp_det(char *p, int ptype)
  73. {
  74.     fprintf(outf,"%stmp=!translate $    $ to ; in %s\n\n\
  75. %stmp%d=!exec pari matdet([$tmp])\n",
  76.           setpre,p,setpre,prepcnt);
  77. }
  78.  
  79. /* use maxima to do formal integration,
  80.  * but pari for numerical integration. */
  81. void sp_int(char *p, int ptype)
  82. {
  83.     char *s;
  84.  
  85.     if((s=strchr(p,'='))!=NULL) *s=',';
  86.     if((s=strstr(p,".."))!=NULL) {*s=','; *(s+1)=' ';}
  87.     fprintf(outf,"%stmp=!translate ;\";': to $     $ in %s \n\
  88. %stmp=!lower $tmp\n\
  89. !readproc slib/function/integrate $tmp\n\
  90. %stmp%d=$slib_out\n",
  91.           setpre,p,setpre,setpre,prepcnt);
  92. }
  93.  
  94. void sp_htmlmath(char *p, int ptype)
  95. {
  96.     fprintf(outf,"%stmp%d=!htmlmath %s\n\n",setpre,prepcnt,p);
  97. }
  98.  
  99. void sp_teximg(char *p, int ptype)
  100. {
  101.     fprintf(outf,"!readproc %s/teximg.phtml %s \n\
  102. %stmp%d=$ins_url\n", primitive_dir, p, setpre,prepcnt);
  103. }
  104.  
  105. void sp_texmath(char *p, int ptype)
  106. {
  107.     fprintf(outf,"%stmp%d=!texmath %s\n\n",setpre,prepcnt,p);
  108. }
  109.  
  110. void sp_maxima(char *p, int ptype)
  111. {
  112.     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
  113. %stmp%d=!exec maxima $t_\n\n",setpre,p,setpre,prepcnt);
  114. }
  115.  
  116. void sp_yacas(char *p, int ptype)
  117. {
  118.     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
  119. %stmp%d=!exec yacas $t_\n\n",setpre,p,setpre,prepcnt);
  120. }
  121.  
  122. void sp_pari(char *p, int ptype)
  123. {
  124.     fprintf(outf,"%st_=!replace internal \\( by ( in %s\n\
  125. %stmp%d=!exec pari $t_\n\n",setpre,p,setpre,prepcnt);
  126. }
  127.  
  128. void sp_simplify(char *p, int ptype)
  129. {
  130.     fprintf(outf,"%stmp=!translate \";': to $     $ in %s\n\n\
  131. %stmp=!lower $tmp\n\
  132. %stmp%d=!exec maxima fullratsimp($tmp);\n",
  133.           setpre,p,setpre,setpre,prepcnt);
  134. }
  135.  
  136. void sp_slib(char *p, int ptype)
  137. {
  138.     char *p2;
  139.     p=find_word_start(p);
  140.     for(p2=p;*p2!=0 && !isspace(*p2) && *p2!=',' && *p2!=';';p2++);
  141.     if(*p2!=0 && !isspace(*p2)) *p2=' ';
  142.     fprintf(outf,"!readproc slib/%s \n\
  143. %stmp%d=$slib_out\n",p,setpre,prepcnt);
  144. }
  145.  
  146. void sp_draw(char *p, int ptype)
  147. {
  148.     char *p2;
  149.     p2=strchr(p,'       '); if(p2==NULL) p2=strchr(p,'\n');
  150.     if(p2==NULL) return; *p2++=0;
  151.     fprintf(outf,"!readproc %s/draw.phtml %s \\\n%s \n\
  152. %stmp%d=$ins_url\n", primitive_dir, p, p2, setpre,prepcnt);
  153. }
  154.  
  155. void sp_canvasdraw(char *p, int ptype)
  156. {
  157.     char *p2;
  158.     p2=strchr(p,'       '); if(p2==NULL) p2=strchr(p,'\n');
  159.     if(p2==NULL) return; *p2++=0;
  160.     fprintf(outf,"!readproc %s/canvasdraw.phtml %s \\\n%s \n\
  161. %stmp%d=$canvasdraw_out\n", primitive_dir, p, p2, setpre,prepcnt);
  162. }
  163.  
  164. void sp_shuffle(char *p, int ptype)
  165. {
  166.     fprintf(outf,"%stmp%d=!shuffle %s\n\n",setpre,prepcnt,p);
  167. }
  168.  
  169. void sp_positionof(char *p, int ptype)
  170. {
  171.     char *p1;
  172.     p1=strparchr(p,','); if(p1==NULL) {
  173.       fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p); return;
  174.     }
  175.     *p1++=0;
  176.     fprintf(outf,"%stmp%d=!positionof item %s in %s\n\n",setpre,prepcnt,p, p1);
  177. }
  178.  
  179. void sp_random(char *p, int ptype)
  180. {
  181.     char *pr, *p2, buf[MAX_LINELEN+1];
  182.     snprintf(buf,sizeof(buf),"%s",p);
  183.     for(p2=buf; *p2 && p2-buf<MAX_LINELEN; p2++) {
  184.       if(*p2=='(') {
  185.           p2=find_matching(p2+1,')'); continue;
  186.       }
  187.       if(*p2==',' || (*p2=='.' && *(p2+1)=='.')) break;
  188.     }
  189.     if(*p2==',') pr="randitem";
  190.     else {
  191.       if(*p2=='.') {
  192.           *p2=','; *(p2+1)=' ';
  193.       }
  194.       if(ptype==pt_int) pr="randint"; else pr="random";
  195.     }
  196.     fprintf(outf,"%stmp%d=!%s %s\n\n",setpre,prepcnt,pr,buf);
  197. }
  198.  
  199. void sp_pickone(char *p, int ptype)
  200. {
  201.     sp_random(p,pt_int);
  202. }
  203.  
  204. void sp_item(char *p, int ptype)
  205. {
  206.     char *pp, *p2, buf[MAX_LINELEN+1];
  207.     pp=strparchr(p,',');
  208.     if(pp==NULL) pp=""; else *pp++=0;
  209.     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
  210.     strip_enclosing_par(buf);
  211.     if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
  212.     fprintf(outf,"%stmp%d=!item %s of %s\n\n",setpre,prepcnt,buf,pp);
  213. }
  214.  
  215. void sp_items(char *p, int ptype)
  216. {
  217.     fprintf(outf,"%stmp%d=!itemcnt %s\n\n",setpre,prepcnt,p);
  218. }
  219.  
  220. void sp_randitem(char *p, int ptype)
  221. {
  222.     fprintf(outf,"%stmp=!nonempty items %s\n\n\
  223. %stmp%d=!randitem $tmp\n",setpre,p,setpre,prepcnt);
  224. }
  225.  
  226. void sp_column(char *p, int ptype)
  227. {
  228.     char *pp, *p2, buf[MAX_LINELEN+1];
  229.     pp=strparchr(p,',');
  230.     if(pp==NULL) pp=""; else *pp++=0;
  231.     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
  232.     strip_enclosing_par(buf);
  233.     if((p2=strstr(buf,".."))!=NULL) string_modify(buf,p2,p2+2," to ");
  234.     fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
  235. %stmp=!column %s of $tmp\n\
  236. %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
  237.           setpre,pp,setpre, buf, setpre, prepcnt);
  238. }
  239.  
  240. void sp_row(char *p, int ptype)
  241. {
  242.     char *pp, *p2, buf[MAX_LINELEN+1];
  243.     pp=strparchr(p,',');
  244.     if(pp==NULL) pp=""; else *pp++=0;
  245.     strncpy(buf,p,MAX_LINELEN);buf[MAX_LINELEN]=0;
  246.     strip_enclosing_par(buf);
  247.     fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n",
  248.           setpre,pp);
  249.     if(strstr(buf,"column")!=NULL) {
  250.       fprintf(outf,"%stmp%d=!select $tmp where %s\n\n",setpre,prepcnt,buf);
  251.       return;
  252.     }
  253.     while((p2=strstr(buf,".."))!=NULL)
  254.       string_modify(buf,p2,p2+2," to ");
  255.     fprintf(outf,"%stmp=!row %s of $tmp\n\
  256. %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
  257.           setpre, buf, setpre, prepcnt);
  258. }
  259.  
  260. void sp_rows(char *p, int ptype)
  261. {
  262.     fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
  263. %stmp%d=!rowcnt $tmp\n",setpre,p,setpre,prepcnt);
  264. }
  265.  
  266. void sp_randrow(char *p, int ptype)
  267. {
  268.     fprintf(outf,"%stmp=!translate internal $   $ to ; in %s\n\n\
  269. %stmp=!nonempty rows $tmp\n\
  270. %stmp=!randrow $tmp\n\
  271. %stmp%d=!translate internal $\\\n$ to ; in $tmp\n",
  272.           setpre,p,setpre,setpre,setpre,prepcnt);
  273. }
  274.  
  275. void sp_mathexp_cut(char *p, int ptype)
  276. {
  277.     char *p2;
  278.     p2=find_word_end(find_word_start(p)); if(isspace(*p2)) *p2++=0;
  279.     p2=find_word_start(p2);
  280.     fprintf(outf,"%stmp%d=!exec mathexp cut %s\\\n%s\n\n",
  281.           setpre,prepcnt,p,p2);
  282. }
  283.  
  284. void sp_wims(char *p, int ptype)
  285. {
  286.     p=find_word_start(p);
  287.     if(!isalpha(*p) || strncasecmp(p,"ins",3)==0)
  288.       fprintf(outf,"%stmp%d=%s\n\n",setpre,prepcnt,p);
  289.     else
  290.       fprintf(outf,"%stmp%d=!%s\n\n",setpre,prepcnt,p);
  291. }
  292.  
  293. struct specialfn specialfn[]={
  294.       {"asis",  sp_asis},
  295.       {"canvasdraw", sp_canvasdraw},
  296.       {"column", sp_column},
  297.       {"deriv",  sp_diff},
  298.       {"derivative", sp_diff},
  299.       {"det",  sp_det},
  300.       {"determinant", sp_det},
  301.       {"diff",  sp_diff},
  302.       {"draw",  sp_draw},
  303.       {"evaluate", sp_evalue},
  304.       {"evalue", sp_evalue},
  305.       {"htmlmath", sp_htmlmath},
  306.       {"int",  sp_int},
  307.       {"integral", sp_int},
  308.       {"integrate", sp_int},
  309.       {"item",  sp_item},
  310.       {"items",  sp_items},
  311.       {"mathexp_cut", sp_mathexp_cut},
  312.       {"maxima", sp_maxima},
  313.       {"pari",  sp_pari},
  314.       {"pickone", sp_pickone},
  315.       {"position", sp_positionof},
  316.       {"positionof", sp_positionof},
  317.       {"randint", sp_pickone},
  318.       {"randitem", sp_randitem},
  319.       {"random", sp_random},
  320.       {"randomitem", sp_randitem},
  321.       {"randomrow", sp_randrow},
  322.       {"randrow", sp_randrow},
  323.       {"row",  sp_row},
  324.       {"rows",  sp_rows},
  325.       {"shuffle", sp_shuffle},
  326.       {"simplify", sp_simplify},
  327.       {"slib",  sp_slib},
  328.       {"solve",  sp_solve},
  329.       {"teximg", sp_teximg},
  330.       {"texmath", sp_texmath},
  331.       {"wims",  sp_wims},
  332.       {"yacas", sp_yacas}
  333. };
  334. int specialfn_no=(sizeof(specialfn)/sizeof(specialfn[0]));
  335.  
  336. /* This routine treats special functions */
  337. void parmprep(char *p,int ptype)
  338. {
  339.     char *pp, *p2, *pn, namebuf[32], buf[MAX_LINELEN+1];
  340.     int i;
  341.  
  342.     while((pp=strchr(p,'\n'))!=NULL) *pp='      ';
  343.     for(pp=p;*pp && pp-p<MAX_LINELEN;pp++) {
  344. /* function names */
  345.       if(isalpha(*pp)) {
  346.           for(i=0;i<30 && (isalnum(pp[i]) || pp[i]=='_');i++) namebuf[i]=pp[i];
  347.           namebuf[i]=0; p2=find_word_start(pp+i);
  348.           if((pp>p && isalnum(*(pp-1))) || *p2!='(') {
  349. /* if(*p2=='\\' && *(p2+1)=='(') ovlstrcpy(p2,p2+1); */
  350.             pp=p2-1; continue;
  351.           }
  352.           pn=pp; pp=p2+1; p2=find_matching(pp,')');
  353.           if(p2==NULL) {
  354.             sp_error("unmatched_parentheses");
  355.             pp=p2; continue;
  356.           }
  357.           i=search_list(specialfn,specialfn_no,sizeof(specialfn[0]),namebuf);
  358.           if(i<0) {
  359.             pp--; continue;
  360.           }
  361.           *p2=0;
  362.           snprintf(buf,sizeof(buf),"%s",pp);
  363.           if(specialfn[i].processor!=sp_asis) parmprep(buf,ptype);
  364.           specialfn[i].processor(buf,ptype);
  365.           string_modify(p, pn, p2+1, "$(tmp%d)",prepcnt); prepcnt++;
  366.           pp=pn+6;
  367.       }
  368.     }
  369. }
  370.  
  371.