home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1995 August / NEBULA.mdf / Apps / DevTools / COWS / Code / COWSStandardLibrary.m < prev    next >
Encoding:
Text File  |  1994-03-22  |  13.5 KB  |  759 lines
  1. /*
  2.     Copyright (C) 1994 Sean Luke
  3.  
  4.     COWSStandardLibrary.m
  5.     Version 1.0
  6.     Sean Luke
  7.     
  8. */
  9.  
  10.  
  11.  
  12.  
  13. #import "COWSStandardLibrary.h"
  14. #import <stdio.h>
  15.  
  16. @implementation COWSStandardLibrary
  17.  
  18. - loadLibrary:sender
  19.     {
  20.     id returnval=[super loadLibrary:sender];
  21.     
  22.     if (![sender conformsTo:@protocol(LibraryControl)])
  23.         {
  24.         printf ("StandardLibrary error:  Interpreter cannot accept Library Control protocol!\n");
  25.         return NULL;
  26.         }
  27.     
  28.     [sender addLibraryFunction:"="
  29.             selector:@selector(COWSfunc_equal:)
  30.             target:self];
  31.     
  32.     [sender addLibraryFunction:">"
  33.             selector:@selector(COWSfunc_greater:)
  34.             target:self];
  35.     
  36.     [sender addLibraryFunction:"<"
  37.             selector:@selector(COWSfunc_lesser:)
  38.             target:self];
  39.     
  40.     [sender addLibraryFunction:"+"
  41.             selector:@selector(COWSfunc_add:)
  42.             target:self];
  43.     
  44.     [sender addLibraryFunction:"-"
  45.             selector:@selector(COWSfunc_subtract:)
  46.             target:self];
  47.     
  48.     [sender addLibraryFunction:"*"
  49.             selector:@selector(COWSfunc_multiply:)
  50.             target:self];
  51.     
  52.     [sender addLibraryFunction:"/"
  53.             selector:@selector(COWSfunc_divide:)
  54.             target:self];
  55.     
  56.     [sender addLibraryFunction:"print"
  57.             selector:@selector(COWSfunc_print:)
  58.             target:self];
  59.     
  60.     [sender addLibraryFunction:"and"
  61.             selector:@selector(COWSfunc_and:)
  62.             target:self];
  63.     
  64.     [sender addLibraryFunction:"or"
  65.             selector:@selector(COWSfunc_or:)
  66.             target:self];
  67.     
  68.     [sender addLibraryFunction:"not"
  69.             selector:@selector(COWSfunc_not:)
  70.             target:self];
  71.     
  72.     [sender addLibraryFunction:"concatenate"
  73.             selector:@selector(COWSfunc_concatenate:)
  74.             target:self];
  75.     
  76.     [sender addLibraryFunction:"quote"
  77.             selector:@selector(COWSfunc_quote:)
  78.             target:self];
  79.     
  80.     [sender addLibraryFunction:"is"
  81.             selector:@selector(COWSfunc_is:)
  82.             target:self];
  83.     
  84.     [sender addLibraryFunction:"do"
  85.             selector:@selector(COWSfunc_do:)
  86.             target:self];
  87.     
  88.     [sender addLibraryFunction:"do-first"
  89.             selector:@selector(COWSfunc_dofirst:)
  90.             target:self];
  91.     
  92.     [sender addLibraryFunction:"error"
  93.             selector:@selector(COWSfunc_error:)
  94.             target:self];
  95.     
  96.     return returnval;
  97.     }
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105. - COWSfunc_equal:arg_list            // numerically compares the first
  106.                                     // value against all the other values.
  107.                                     // if they are equal, returns t.
  108.                                     // returns f if there are no values,
  109.                                     // or in any other situation.
  110.     {
  111.     float first;
  112.     BOOL success=YES;
  113.     id return_val=[[COWSStringNode alloc] init];
  114.     id current;
  115.     
  116.     if ([arg_list top]==NULL)                 // no args
  117.         {
  118.         [return_val setString:"f"];
  119.         return return_val;
  120.         }
  121.     else
  122.         {
  123.         current=[arg_list pop];
  124.         first=atof([current string]);
  125.         [current free];
  126.         }
  127.         
  128.     while ([arg_list top]!=NULL)
  129.         {
  130.         current=[arg_list pop];
  131.         if (first!=atof([current string]))
  132.             {
  133.             success=NO;
  134.             [current free];
  135.             break;
  136.             }
  137.         [current free];
  138.         }
  139.     if (success)
  140.         {
  141.         [return_val setString:"t"];
  142.         }
  143.     else
  144.         {
  145.         [return_val setString:"f"];
  146.         }
  147.     return return_val;
  148.     }
  149.     
  150.     
  151.     
  152.     
  153. - COWSfunc_greater:arg_list            // numerically compares the first
  154.                                     // value against all the other values.
  155.                                     // if it is greater, returns t.
  156.                                     // returns f if there are no values,
  157.                                     // or in any other situation.
  158.     {
  159.     float first;
  160.     BOOL success=YES;
  161.     id return_val=[[COWSStringNode alloc] init];
  162.     id current;
  163.     
  164.     if ([arg_list top]==NULL)                 // no args
  165.         {
  166.         [return_val setString:"f"];
  167.         return return_val;
  168.         }
  169.     else
  170.         {
  171.         current=[arg_list pop];
  172.         first=atof([current string]);
  173.         [current free];
  174.         }
  175.         
  176.     while ([arg_list top]!=NULL)
  177.         {
  178.         current=[arg_list pop];
  179.         if (first<=atof([current string]))
  180.             {
  181.             success=NO;
  182.             [current free];
  183.             break;
  184.             }
  185.         [current free];
  186.         }
  187.     if (success)
  188.         {
  189.         [return_val setString:"t"];
  190.         }
  191.     else
  192.         {
  193.         [return_val setString:"f"];
  194.         }
  195.     return return_val;
  196.     }
  197.     
  198.     
  199. - COWSfunc_lesser:arg_list            // numerically compares the first
  200.                                     // value against all the other values.
  201.                                     // if it is smaller, returns t.
  202.                                     // returns f if there are no values,
  203.                                     // or in any other situation.
  204.     {
  205.     float first;
  206.     BOOL success=YES;
  207.     id return_val=[[COWSStringNode alloc] init];
  208.     id current;
  209.     
  210.     if ([arg_list top]==NULL)                 // no args
  211.         {
  212.         [return_val setString:"f"];
  213.         return return_val;
  214.         }
  215.     else
  216.         {
  217.         current=[arg_list pop];
  218.         first=atof([current string]);
  219.         [current free];
  220.         }
  221.         
  222.     while ([arg_list top]!=NULL)
  223.         {
  224.         current=[arg_list pop];
  225.         if (first>=atof([current string]))
  226.             {
  227.             success=NO;
  228.             [current free];
  229.             break;
  230.             }
  231.         [current free];
  232.         }
  233.     if (success)
  234.         {
  235.         [return_val setString:"t"];
  236.         }
  237.     else
  238.         {
  239.         [return_val setString:"f"];
  240.         }
  241.     return return_val;
  242.     }
  243.     
  244.     
  245.     
  246.     
  247. - COWSfunc_is:arg_list                // string-compares the first
  248.                                     // value against all the other values.
  249.                                     // if it the same, returns t.
  250.                                     // returns f if there are no values,
  251.                                     // or in any other situation.
  252.     {
  253.     char* first;
  254.     BOOL success=NO;
  255.     id return_val=[[COWSStringNode alloc] init];
  256.     id current;
  257.     
  258.     if ([arg_list top]==NULL)                 // no args
  259.         {
  260.         [return_val setString:"f"];
  261.         return return_val;
  262.         }
  263.     else
  264.         {
  265.         current=[arg_list pop];
  266.         first=newstr([current string]);
  267.         [current free];
  268.         }
  269.         
  270.     while ([arg_list top]!=NULL)
  271.         {
  272.         current=[arg_list pop];
  273.         if (!strcmp(first,[current string]))
  274.             {
  275.             success=YES;
  276.             [current free];
  277.             break;
  278.             }
  279.         [current free];
  280.         }
  281.     if (success)
  282.         {
  283.         [return_val setString:"t"];
  284.         }
  285.     else
  286.         {
  287.         [return_val setString:"f"];
  288.         }
  289.     free(first);
  290.     return return_val;
  291.     }
  292.  
  293.  
  294.  
  295.  
  296.     
  297. - COWSfunc_print:arg_list    // prints each argument
  298.                             // returns first item
  299.     {
  300.     id return_val=[[COWSStringNode alloc] init];
  301.     id current;
  302.     if ([arg_list top]!=NULL)
  303.         {
  304.         [return_val setString:[[arg_list top] string]];
  305.         }
  306.         
  307.     while ([arg_list top]!=NULL)
  308.         {
  309.         current=[arg_list pop];
  310.         printf("%s\n",[current string]);
  311.         [current free];
  312.         }
  313.     return return_val;
  314.     }
  315.     
  316.     
  317.     
  318.     
  319. - COWSfunc_do:arg_list        // returns last item
  320.     {
  321.     id return_val=[[COWSStringNode alloc] init];
  322.     id current;
  323.  
  324.     while ([arg_list top]!=NULL)
  325.         {
  326.         current=[arg_list pop];
  327.         [return_val setString:[current string]];        
  328.                             // pretty inefficient
  329.         [current free];
  330.         }
  331.     return return_val;
  332.     }
  333.     
  334.  
  335.  
  336.  
  337. - COWSfunc_dofirst:arg_list        // returns first item
  338.     {
  339.     id return_val=[[COWSStringNode alloc] init];
  340.     id current=[arg_list top];
  341.     if (current!=NULL)
  342.         {
  343.         [return_val setString:[current string]];
  344.         }
  345.     return return_val;
  346.     }
  347.  
  348.  
  349.  
  350.  
  351. - COWSfunc_not:arg_list        // NOTs first item
  352.     {
  353.     id return_val=[[COWSStringNode alloc] init];
  354.     id current=[arg_list top];
  355.     if (current!=NULL)
  356.         {
  357.         if (!strcmp([current string],"t"))        // string is true
  358.             {
  359.             [return_val setString:"f"];
  360.             }
  361.         else
  362.             {
  363.             [return_val setString:"t"];
  364.             }
  365.         }
  366.     return return_val;
  367.     }
  368.  
  369.  
  370.  
  371.  
  372. - COWSfunc_and:arg_list        // ANDs items
  373.     {
  374.     id return_val=[[COWSStringNode alloc] init];
  375.     id current;
  376.     BOOL result=NO;
  377.     
  378.     if ([arg_list top]!=NULL)
  379.         {
  380.         current=[arg_list pop];
  381.         result=(!strcmp([current string],"t"));
  382.         [current free];
  383.         }
  384.     else
  385.         {
  386.         [return_val setString:"or error: nothing to OR against."];
  387.         [return_val setError:YES];
  388.         return return_val;                    
  389.         }
  390.         
  391.     if ([arg_list top]!=NULL)
  392.         {
  393.         current=[arg_list pop];
  394.         result=result&&(!strcmp([current string],"t"));
  395.         [current free];
  396.         }
  397.     else
  398.         {
  399.         [return_val setString:"or error: nothing to OR with."];
  400.         [return_val setError:YES];
  401.         return return_val;
  402.         }
  403.         
  404.     while ([arg_list top]!=NULL)
  405.         {
  406.         current=[arg_list pop];
  407.         result=result&&(!strcmp([current string],"t"));
  408.         [current free];
  409.         }
  410.     [return_val setString: (result ? "t" : "f")]; 
  411.     return return_val;
  412.     }
  413.  
  414.  
  415.  
  416.  
  417. - COWSfunc_or:arg_list        // ORs items
  418.     {
  419.     id return_val=[[COWSStringNode alloc] init];
  420.     id current;
  421.     BOOL result=NO;
  422.     
  423.     if ([arg_list top]!=NULL)
  424.         {
  425.         current=[arg_list pop];
  426.         result=(!strcmp([current string],"t"));
  427.         [current free];
  428.         }
  429.     else
  430.         {
  431.         [return_val setString:"or error: nothing to OR against."];
  432.         [return_val setError:YES];
  433.         return return_val;                    
  434.         }
  435.         
  436.     if ([arg_list top]!=NULL)
  437.         {
  438.         current=[arg_list pop];
  439.         result=result||(!strcmp([current string],"t"));
  440.         [current free];
  441.         }
  442.     else
  443.         {
  444.         [return_val setString:"or error: nothing to OR with."];
  445.         [return_val setError:YES];
  446.         return return_val;
  447.         }
  448.         
  449.     while ([arg_list top]!=NULL)
  450.         {
  451.         current=[arg_list pop];
  452.         result=result||(!strcmp([current string],"t"));
  453.         [current free];
  454.         }
  455.     [return_val setString: (result ? "t" : "f")]; 
  456.     return return_val;
  457.     }
  458.  
  459.  
  460.  
  461.  
  462. - COWSfunc_add:arg_list        // adds items
  463.     {
  464.     id return_val=[[COWSStringNode alloc] init];
  465.     id current;
  466.     float result;
  467.     char pass_val[COWSLARGENUMBER];
  468.     
  469.     if ([arg_list top]!=NULL)
  470.         {
  471.         current=[arg_list pop];
  472.         result=atof([current string]);
  473.         [current free];
  474.         }
  475.     else
  476.         {
  477.         [return_val setString:"+ error: nothing to add against."];
  478.         [return_val setError:YES];
  479.         return return_val;                    
  480.         }
  481.         
  482.     if ([arg_list top]!=NULL)
  483.         {
  484.         current=[arg_list pop];
  485.         result+=atof([current string]);
  486.         [current free];
  487.         }
  488.     else
  489.         {
  490.         [return_val setString:"+ error: nothing to add with."];
  491.         [return_val setError:YES];
  492.         return return_val;
  493.         }
  494.         
  495.     while ([arg_list top]!=NULL)
  496.         {
  497.         current=[arg_list pop];
  498.         result+=atof([current string]);
  499.         [current free];
  500.         }
  501.     sprintf(pass_val,"%f",result);
  502.     [return_val setString:pass_val]; 
  503.     return return_val;
  504.     }
  505.  
  506.  
  507. - COWSfunc_multiply:arg_list        // Multiplies items
  508.     {
  509.     id return_val=[[COWSStringNode alloc] init];
  510.     id current;
  511.     float result;
  512.     char pass_val[COWSLARGENUMBER];
  513.     
  514.     if ([arg_list top]!=NULL)
  515.         {
  516.         current=[arg_list pop];
  517.         result=atof([current string]);
  518.         [current free];
  519.         }
  520.     else
  521.         {
  522.         [return_val setString:"* error: nothing to multiply against."];
  523.         [return_val setError:YES];
  524.         return return_val;                    
  525.         }
  526.         
  527.     if ([arg_list top]!=NULL)
  528.         {
  529.         current=[arg_list pop];
  530.         result*=atof([current string]);
  531.         [current free];
  532.         }
  533.     else
  534.         {
  535.         [return_val setString:"* error: nothing to multiply with."];
  536.         [return_val setError:YES];
  537.         return return_val;
  538.         }
  539.         
  540.     while ([arg_list top]!=NULL)
  541.         {
  542.         current=[arg_list pop];
  543.         result*=atof([current string]);
  544.         [current free];
  545.         }
  546.     sprintf(pass_val,"%f",result);
  547.     [return_val setString:pass_val]; 
  548.     return return_val;
  549.     }
  550.  
  551.  
  552.  
  553.  
  554. - COWSfunc_subtract:arg_list        // Subtracts items
  555.     {
  556.     id return_val=[[COWSStringNode alloc] init];
  557.     id current;
  558.     float result;
  559.     char pass_val[COWSLARGENUMBER];
  560.     
  561.     if ([arg_list top]!=NULL)
  562.         {
  563.         current=[arg_list pop];
  564.         result=atof([current string]);
  565.         [current free];
  566.         }
  567.     else
  568.         {
  569.         [return_val setString:"- error: nothing to subtract against."];
  570.         [return_val setError:YES];
  571.         return return_val;                    
  572.         }
  573.         
  574.     if ([arg_list top]!=NULL)
  575.         {
  576.         current=[arg_list pop];
  577.         result-=atof([current string]);
  578.         [current free];
  579.         }
  580.     else
  581.         {
  582.         [return_val setString:"- error: nothing to subtract with."];
  583.         [return_val setError:YES];
  584.         return return_val;
  585.         }
  586.         
  587.     while ([arg_list top]!=NULL)
  588.         {
  589.         current=[arg_list pop];
  590.         result-=atof([current string]);
  591.         [current free];
  592.         }
  593.     sprintf(pass_val,"%f",result);
  594.     [return_val setString:pass_val]; 
  595.     return return_val;
  596.     }
  597.  
  598.  
  599.  
  600. - COWSfunc_divide:arg_list        // divides items
  601.     {
  602.     id return_val=[[COWSStringNode alloc] init];
  603.     id current;
  604.     float result;
  605.     char pass_val[COWSLARGENUMBER];
  606.     
  607.     if ([arg_list top]!=NULL)
  608.         {
  609.         current=[arg_list pop];
  610.         result=atof([current string]);
  611.         [current free];
  612.         }
  613.     else
  614.         {
  615.         [return_val setString:"/ error: nothing to divide against."];
  616.         [return_val setError:YES];
  617.         return return_val;                    
  618.         }
  619.     if ([arg_list top]!=NULL)
  620.         {
  621.         current=[arg_list pop];
  622.         if (atof([current string])==0)
  623.             {
  624.             [return_val setString:"/ error: zero divide."];
  625.             [return_val setError:YES];
  626.             [current free];
  627.             return return_val;                    
  628.             }
  629.         result/=atof([current string]);
  630.         [current free];
  631.         }
  632.     else
  633.         {
  634.         [return_val setString:"/ error: nothing to divide with."];
  635.         [return_val setError:YES];
  636.         return return_val;
  637.         }
  638.         
  639.     while ([arg_list top]!=NULL)
  640.         {
  641.         current=[arg_list pop];
  642.         if (atof([current string])==0)
  643.             {
  644.             [return_val setString:"/ error: zero divide."];
  645.             [return_val setError:YES];
  646.             [current free];
  647.             return return_val;                    
  648.             }
  649.         result/=atof([current string]);
  650.         [current free];
  651.         }
  652.     sprintf(pass_val,"%f",result);
  653.     [return_val setString:pass_val]; 
  654.     return return_val;
  655.     }
  656.  
  657.  
  658.  
  659.  
  660. - COWSfunc_concatenate:arg_list
  661.     {
  662.     id return_val=[[COWSStringNode alloc] init];
  663.     id current;
  664.     
  665.     if ([arg_list top]!=NULL)
  666.         {
  667.         current=[arg_list pop];
  668.         [return_val setString:[current string]];
  669.         [current free];
  670.         }
  671.     else
  672.         {
  673.         [return_val setString:"concatenate error: nothing to concatenate against."];
  674.         [return_val setError:YES];
  675.         return return_val;                    
  676.         }
  677.         
  678.     if ([arg_list top]!=NULL)
  679.         {
  680.         int length;
  681.         current=[arg_list pop];
  682.         length=strlen([current string])+strlen([return_val string]);
  683.         if (1)        // just something to get a block...
  684.             {
  685.             char buf[length+1];
  686.             strcpy(buf,[return_val string]);
  687.             strcat(buf,[current string]);
  688.             buf[length]='\0';
  689.             [return_val setString:buf];
  690.             }
  691.         [current free];
  692.         }
  693.     else
  694.         {
  695.         [return_val setString:"concatenate error: nothing to concatenate with."];
  696.         [return_val setError:YES];
  697.         return return_val;
  698.         }
  699.         
  700.     while ([arg_list top]!=NULL)
  701.         {
  702.         int length;
  703.         current=[arg_list pop];
  704.         length=strlen([current string])+strlen([return_val string]);
  705.         if (1)        // just something to get a block...
  706.             {
  707.             char buf[length+1];
  708.             strcpy(buf,[return_val string]);
  709.             strcat(buf,[current string]);
  710.             buf[length]='\0';
  711.             [return_val setString:buf];
  712.             }
  713.         [current free];
  714.         }
  715.     return return_val;
  716.     }
  717.  
  718.  
  719.  
  720.  
  721. - COWSfunc_quote:arg_list        // returns a double-quote
  722.     {
  723.     id return_val=[[COWSStringNode alloc] init];
  724.     [return_val setString: "\""]; 
  725.     return return_val;
  726.     }
  727.  
  728.  
  729.  
  730.  
  731. - COWSfunc_error:arg_list    // prints each argument
  732.                             // returns first item
  733.     {
  734.     id return_val=[[COWSStringNode alloc] init];
  735.     id current;
  736.     if ([arg_list top]==NULL)
  737.         {
  738.         [return_val setString:""];
  739.         }
  740.     else
  741.         {
  742.         current=[arg_list pop];
  743.         [return_val setString:[current string]];
  744.         [current free];
  745.         }
  746.     [return_val setError:YES];
  747.     return return_val;
  748.     }
  749.     
  750. - pauseCancelled:sender
  751.     {
  752.     return self;
  753.     }
  754.     
  755.  
  756.  
  757.  
  758.  
  759. @end