home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / apln1.zip / Apln.cwx next >
Text File  |  2001-12-22  |  7KB  |  192 lines
  1. /*apln.cwx    polygon of n sides  */
  2. call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  3. call SysLoadFuncs
  4. numeric digits 12
  5. pi=3.14159265359
  6. /***min.=3 max=100 (you can modify it)*********************/
  7. numlados=6   /**change this value for other number of sizes **/
  8. /*****************************************************/
  9.  
  10. call continue
  11. exit
  12.  
  13. Continue:
  14.  
  15. /* Prompt user for color of starburst and wait for them to click OK */
  16. /*
  17. if Instances = 0 then
  18.         exit
  19.   */
  20. /* Assemble the starting and ending shadow colors */
  21.  
  22. /*SC1=255;SC2=125;SC3=0*/
  23. SC1=0;SC2=0;SC3=0
  24. /* Stop drawing until we've setup the display */
  25. Window=CwGetCurrentView()
  26. call CwStopRender window
  27.  
  28. /* Create a custom region to hold the starburst */
  29. Burst = CwCreateEffect("Custom Region", "Solid Color")
  30. w1=7;h1=7 ;xcent=4;ycent=4
  31. call CwSetPosition Burst, XCent, YCent, W1, H1, 0, 0
  32. BurstTool = CwGetTool(Burst)
  33. call CwSetProperty BurstTool, "Color", '('SC1','SC2','SC3')'
  34. BurstView = CwGetView(CwGetRegion(Burst))
  35. call CwSelectView BurstView
  36.  
  37. /* Draw the yellow base for the starburst */
  38. Base = CwCreateEffect("Rectangle", "Solid Color")
  39. w1=7;h1=7 /*lados del cuadrado base*/
  40. call CwSetPosition Base, XCent, YCent, W1, H1, 0, 0
  41. BaseTool = CwGetTool(Base)
  42. call CwSetProperty BaseTool, "Color", '('sc1','sc2','sc3')'
  43.  
  44. /* Now overlay white ellipses to create the bursting effect */
  45. /*radio 1.5 ; ancho del rectangulo 2 ; largo 5;  */
  46. rad=1;ancho=3.8;largo=9
  47.  
  48.  
  49. /*check number of sides  100 (by the time for made it), not small that 3 sides*/
  50. if numlados<3 then numlados=3
  51. if numlados>100 then do
  52.  numlados=3
  53.  RC=RxMessageBox("If you indicate more that 100 sizes, the aplication change to 3, by the time for made it. You can change the rexx scrit. " ,"TO MANY SIDES","OK")
  54. end
  55.  
  56. do n=0 to numlados-1
  57.     angulop=360*n/numlados
  58.     /*pasarlo a radianes*/
  59.     angulop=angulop*2*Pi/360
  60.     angulo=(360/numlados)
  61.     if n=0 then
  62.     do
  63.     inclinacion=180
  64.     end
  65.     else
  66.     do
  67.     inclinacion=inclinacion-angulo
  68.         /*if inclinacion>180 then inclinacion=inclinacion-180
  69.         if inclinacion<180 then inclinacion=inclinacion+180*/
  70.     end
  71.  
  72.     x1c=(rad+ancho/2)*seno(angulop)+4
  73.     y1c=(rad+ancho/2)*coseno(angulop)+4
  74.     /*RC=RxMessageBox("VALORES DEL RECTANGULO x , y, angulop inclinacion " x1c y1c angulop inclinacion ,"Merge?","OK")*/
  75.     Cutout = CwCreateEffect("Rectangle", "Solid Color")
  76.     call CwSetPosition Cutout,x1c,y1c, largo, ancho, inclinacion, 0
  77.     CutTool = CwGetTool(Cutout)
  78.     call CwSetProperty CutTool, "Color", "(255,255,255)"
  79. end
  80.  
  81. /* Now render the screen for the user */
  82. /*Window=CwGetCurrentView()*/
  83. call CwStartRender window
  84.  
  85. return
  86.  
  87. /* ================================================================== */
  88.  /* seno(x)                                                             */
  89.  /*                                                                    */
  90.  /* Method:                                                            */
  91.  /*   x is first reduced so that ABS(x) <= pi/2. Then a polynomial     */
  92.  /*   approximation is used for evaluation.                            */
  93.  /*                                                                    */
  94.  
  95.  seno: PROCEDURE
  96.    ARG x
  97.    CALL argtest "seno",x
  98.    s=SIGN(x)
  99.    x=ABS(x)
  100.    x = x//6.28318530718
  101.    IF x > 3.14159265359 THEN
  102.    DO
  103.      x = x - 3.14159265359
  104.      s = -s
  105.    END
  106.    IF x > 1.57079632679 THEN
  107.      x = 3.14159265359 - x
  108.    y = x*x
  109.    x = s*x*(((((-.0000000239*y + .0000027526)*y - .0001984090)*y + .0083333315)*y - .1666666664)*y + 1)
  110.  RETURN x
  111.  
  112.  /* ================================================================== */
  113.  /* coseno(x)                                                             */
  114.  /*                                                                    */
  115.  /* Method:                                                            */
  116.  /*   x is first reduced so that ABS(x) <= pi/2. Then a                */
  117.  /*   polynomial approximation is used for evaluation.                 */
  118.  /*                                                                    */
  119.  coseno: PROCEDURE
  120.    ARG x
  121.    CALL argtest "coseno",x
  122.    s=1
  123.    x=ABS(x)
  124.    x = x//6.28318530718
  125.    IF x > 3.14159265359 THEN
  126.    DO
  127.      x = x - 3.14159265359
  128.      s = -s
  129.    END
  130.    IF x > 1.57079632679 THEN
  131.    DO
  132.      x = 3.14159265359 - x
  133.      s = -s
  134.    END
  135.    y = x*x
  136.    x = s*(((((-.0000002605*y + .0000247609)*y - .0013888397)*y +  .0416666418)*y - .4999999963)*y + 1)
  137.  RETURN x
  138.  
  139.  /* ================================================================== */
  140.  /* atan(x)                                                            */
  141.  /*                                                                    */
  142.  /* Method:                                                            */
  143.  /*   Use atan(x) = pi/4 - atan((1-x)/(1+x)).  Evaluate                */
  144.  /*   the latter function usenog a polynomial approximation, taking     */
  145.  /*   advantage of the fact that its argument is less than one as      */
  146.  /*   long as x > -1.                                                  */
  147.  /*                                                                    */
  148.  atan: PROCEDURE
  149.    ARG x
  150.    CALL argtest "atan",x
  151.    IF x = 0 THEN
  152.      RETURN 0
  153.    s=SIGN(x)
  154.    x=ABS(x)
  155.    x = (x - 1)/(x + 1)
  156.    y = x*x
  157.    x = ((((((((.0028662257*y - .0161657367)*y + .0429096138)*y - .0752896400)*y + .1065626393)*y - .1420889944)*y + .1999355085)*y - .3333314528)*y + 1)*x
  158.  RETURN .785398163397 + s*x
  159.  
  160.  
  161.  
  162.  /* ------------------------------------------------------------------ */
  163.  /* function: check if the argument for a function is numeric          */
  164.  /*                                                                    */
  165.  /* call:     ArgTest functionName, functionArgument                   */
  166.  /*                                                                    */
  167.  /* where:    functionName - name of the function                      */
  168.  /*           functionArgument - argument for the function             */
  169.  /*                                                                    */
  170.  /* returns:  nothing                                                  */
  171.  /*                                                                    */
  172.  /* note:     exits the program if the argument is not numeric         */
  173.  /*                                                                    */
  174.  Argtest: PROCEDURE
  175.    PARSE ARG name,x
  176.  
  177.    IF DATATYPE(x,"N") THEN
  178.      RETURN
  179.    SAY name "argument" x "not a number."
  180.  EXIT
  181. /******************************************/
  182. /*Roberto Gainza                                             */
  183. /*zikonyl@attglobal.net                                     */
  184. /*Special thanks to Team OS/2 spain for your help*/
  185. /*   http://www.os2spain.org                              */
  186. /*Free and not warranty for it                           */
  187. /*****bye bye******************************/
  188.  
  189.  
  190.  
  191.  
  192.