home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / GFX / Raytracing / Raytracer / LW5VT09.LHA / Toaster / Arexx_examples / PlugIns / CreateSphere.lwm < prev    next >
Encoding:
Text File  |  1996-06-10  |  12.1 KB  |  424 lines
  1. /* CMD: ½CreateSphere                                                   */
  2. /* By Brett Evan Hester      13032 Copenhill Rd. Dallas, Tx. 75240-5302 */
  3.     MacrosName = "CreateSphere"
  4. /* Macro Type:                                                          */
  5. /* CREATES     * OBJECTS   * LAYER NEEDED * TIME NEEDED  * REMEMBERS    */
  6. /* Description:                                                         */
  7.  
  8. Info1A = "!Create Sphere ©               Information 1 of 2"
  9. Info1B = ""
  10. Info1C = "@This macro will create a sphere; using defaults "
  11. Info1D = "@based on the currently selected and last used   "
  12. Info1E = "@settings.                                       "
  13. Info1F = ""
  14. Info1G = "þ The CENTER defaults to that of the selected.  "
  15. Info1H = "þ The RADIUS defaults to that of the selected.  "
  16. Info1I = "¤ Unless the selected has no dimensions. Then it"
  17. Info1J = "¤ defaults to a radius of -1- or the last used. "
  18. Info1K = ""
  19. Info1L = "þ If GLOBE is used, set # of SIDES and SEGMENTS."
  20. Info1M = "  If TESSELATION is used, set LEVEL.            "
  21. Info1N = "  If BALL (Custom-Made) is used, set LEVEL.     "
  22.  
  23. Info2A = "!Create Sphere ©               Information 2 of 2"
  24. Info2B = "@               Plug-Ins and Go! ©               "
  25. Info2C = "                           Hester and associates"
  26. Info2D = "                           13032 Copenhill Road "
  27. Info2E = "                           Dallas, Texas 75240  "
  28. Info2F = "@Special Thanks to:                              "
  29. Info2G = "Arnie Cachelin  Henry Ribron    Mark J. Holland "
  30. Info2H = "J. Phil Kelso   Terry Wester    Steven K. Simms "
  31. Info2I = "Kevin DeRita    Greg Glaser     William S. Hawes"
  32. Info2J = "NewTek ©        Commodore ©     INOVAtronics ©  "
  33. Info2K = ""
  34. Info2L = "@This macro represents a lot of time & hard work."
  35. Info2M = "@Encourage people to create new ones and not kill"
  36. Info2N = "@that possibility by stealing those that are out."
  37.  
  38. /* -------------------------------------------------------------------- */
  39.                                      /* Start Error Detection (See End) */
  40. SIGNAL ON ERROR
  41. SIGNAL ON SYNTAX
  42.                                                    /* Address LightWave */
  43. VT3DLib = ADDLIB("LWModelerARexx.port",0)
  44. ADDRESS "LWModelerARexx.port"
  45.                                                   /* Add Math Functions */
  46. MATHLIB= "rexxmathlib.library"
  47. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  48.     IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  49.         CALL Notify(1,"!Can't find "MATHLIB)
  50.         IF VT3DLib THEN CALL REMLIB("LWModelerARexx.port")
  51.         EXIT
  52.     END
  53.  
  54. /* -------------------------------------------------------------------- */
  55.                                     /* Reading Global Macro Preferences */
  56. BEHDefaultFilePath = "Sys:"
  57. BEHSettingsSavedTo = "T:"
  58. BEHSpeechAndSound = "1"
  59.  
  60. IF (EXISTS("S:PlugInPrefs")) THEN DO
  61.     IF (~OPEN(PlugInPrefs, "S:PlugInPrefs", 'R')) THEN BREAK
  62.     IF (READLN(PlugInPrefs) ~= "PlugInPrefs") THEN BREAK
  63.     BEHDefaultFilePath = READLN(PlugInPrefs)
  64.     BEHSettingsSavedTo = READLN(PlugInPrefs)
  65.     BEHSpeechAndSound = READLN(PlugInPrefs)
  66.     CALL CLOSE PlugInPrefs
  67. END
  68.  
  69. /* -------------------------------------------------------------------- */
  70.                                                   /* Empty Layer Needed */
  71. CL = CurLayer()
  72. Empty = EmptyLayers()
  73. IF (WORDS(Empty) < 1) THEN DO
  74.     CALL Notify(1,"!Sorry!","@Need an empty layer","@for this operaton.")
  75.     CALL Exiting
  76. END
  77. EL = WORD(Empty, 1)
  78.  
  79. /* -------------------------------------------------------------------- */
  80.                                                     /* Default Settings */
  81. ReqCnt = 0 0 0 ; ReqRad = 1 1 1 ; ReqType = 1
  82. ReqSides = 16 ; ReqSegs = 8 ; ReqLevel = 2
  83.  
  84. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  85.                                                    /* Previous Settings */
  86.  
  87. PrefsFileName = BEHSettingsSavedTo||MacrosName||".PLUG"
  88.  
  89. IF (EXISTS(PrefsFileName)) THEN DO
  90.     IF (~OPEN(PrefsFile, PrefsFileName, 'R')) THEN BREAK
  91.     IF (READLN(PrefsFile) ~= MacrosName) THEN BREAK
  92.  
  93.     ReqCnt = READLN(PrefsFile)
  94.     ReqRad = READLN(PrefsFile)
  95.     ReqType = READLN(PrefsFile)
  96.     ReqSides = READLN(PrefsFile)
  97.     ReqSegs = READLN(PrefsFile)
  98.     ReqLevel = READLN(PrefsFile)
  99.  
  100.     CALL CLOSE PrefsFile
  101. END
  102.  
  103. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  104.                                                   /* BKG Layer Settings */
  105. BL = CurBLayer() ; Box = BoundingBox(BL)
  106. PARSE var Box N X1 X2 Y1 Y2 Z1 Z2
  107.  
  108. CX = (X1 / 2) + (X2 / 2)
  109. CY = (Y1 / 2) + (Y2 / 2)
  110. CZ = (Z1 / 2) + (Z2 / 2)
  111.  
  112. RX = (X2 - X1) / 2
  113. RY = (Y2 - Y1) / 2
  114. RZ = (Z2 - Z1) / 2
  115.  
  116. IF CX + CY + CZ ~= 0 THEN ReqCnt = CX CY CZ
  117. IF RX + RY + RZ ~= 0 THEN ReqRad = RX RY RZ
  118.  
  119. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  120.                                               /* Current Layer Settings */
  121. Box = BoundingBox()
  122. PARSE var Box N X1 X2 Y1 Y2 Z1 Z2
  123.  
  124. CX = (X1 / 2) + (X2 / 2)
  125. CY = (Y1 / 2) + (Y2 / 2)
  126. CZ = (Z1 / 2) + (Z2 / 2)
  127.  
  128. RX = (X2 - X1) / 2
  129. RY = (Y2 - Y1) / 2
  130. RZ = (Z2 - Z1) / 2
  131.  
  132. IF CX + CY + CZ ~= 0 THEN ReqCnt = CX CY CZ
  133. IF RX + RY + RZ ~= 0 THEN ReqRad = RX RY RZ
  134.  
  135. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  136.                                                    /* Selected Settings */
  137. N = XFrm_Begin()
  138. CALL End_All()
  139.  
  140. IF N > 0 THEN DO
  141.  
  142.     CALL Sel_Mode(USER)
  143.     CALL Copy()
  144.     CALL SetLayer(EL)
  145.     CALL Paste()
  146.  
  147.     Box = BoundingBox() ; PARSE var Box N X1 X2 Y1 Y2 Z1 Z2
  148.  
  149.     CX = (X1 / 2) + (X2 / 2)
  150.     CY = (Y1 / 2) + (Y2 / 2)
  151.     CZ = (Z1 / 2) + (Z2 / 2)
  152.  
  153.     RX = (X2 - X1) / 2
  154.     RY = (Y2 - Y1) / 2
  155.     RZ = (Z2 - Z1) / 2
  156.  
  157.     IF CX + CY + CZ ~= 0 THEN ReqCnt = CX CY CZ
  158.     IF RX + RY + RZ ~= 0 THEN ReqRad = RX RY RZ
  159.  
  160.     CALL Cut()
  161.  
  162.     CALL SetLayer(CL)
  163.  
  164. END
  165.  
  166. /* -------------------------------------------------------------------- */
  167.                                               /* For Information Window */
  168. BEHInfo = 1
  169.                       /* For Coming Back to Main Menu after Info Window */
  170. DO WHILE BEHInfo
  171.  
  172. /* -------------------------------------------------------------------- */
  173.                                                       /* User Interface */
  174.     CALL Req_Begin("Create Sphere ©                     by Brett Hester")
  175.  
  176.     ReqA = Req_AddControl("Center Point",'V',1)
  177.     ReqB = Req_AddControl("Radius",'V',1)
  178.     ReqC = Req_AddControl("Type",'CH',"·    Globe     ·  Tess. · · Ball ")
  179.     ReqD = Req_AddControl("",'V',0)
  180.     CALL Req_AddControl("",'T',"   Sides     Segments |   Level")
  181.     ReqE = Req_AddControl("",'CH', "Information")
  182.  
  183.     CALL Req_SetVal(ReqA, ReqCnt)
  184.     CALL Req_SetVal(ReqB, ReqRad)
  185.     CALL Req_SetVal(ReqC, ReqType)
  186.     CALL Req_SetVal(ReqD, ReqSides ReqSegs ReqLevel)
  187.     CALL Req_SetVal(ReqE, 0)
  188.  
  189.     OKorCancel = Req_Post() ; IF OKorCancel = 0 THEN CALL Exiting
  190.  
  191.     ReqCnt = Req_GetVal(ReqA)
  192.     ReqRad = Req_GetVal(ReqB)
  193.     ReqType = Req_GetVal(ReqC)
  194.     ReqSSL = Req_GetVal(ReqD)
  195.     BEHInfo = Req_GetVal(ReqE)
  196.  
  197.     CALL Req_End()
  198.  
  199.     PARSE var ReqCnt CX CY CZ
  200.     PARSE var ReqRad RX RY RZ
  201.     PARSE var ReqSSL ReqSides ReqSegs ReqLevel
  202.  
  203.     ReqSides = TRUNC(ABS(ReqSides))
  204.     ReqSegs = TRUNC(ABS(ReqSegs))
  205.     ReqLevel = TRUNC(ABS(ReqLevel))
  206.  
  207.     X1 = CX + RX
  208.     X2 = CX - RX
  209.     Y1 = CY + RY
  210.     Y2 = CY - RY
  211.     Z1 = CZ + RZ
  212.     Z2 = CZ - RZ
  213.  
  214.     IF BEHInfo = 1 THEN CALL InformationWindows
  215.  
  216. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  217.                                                         /* Verify Input */
  218.     IF RX + RY + RZ = 0 THEN DO
  219.         CALL Notify(1,"!Sorry!","@But the radius must be greater than zero.")
  220.         ReqRad = 1 1 1
  221.         BEHInfo = 1
  222.     END
  223.  
  224.     IF ReqType = 1 THEN DO
  225.         IF ReqSides <= 2 THEN DO
  226.             CALL Notify(1,"!Sorry!","But at least three sides must be chosen.")
  227.             ReqSides = 3
  228.             BEHInfo = 1
  229.         END
  230.         IF ReqSegs <= 1 THEN DO
  231.             CALL Notify(1,"!Sorry!","But at least two segments must be chosen.")
  232.             ReqSegs = 2
  233.             BEHInfo = 1
  234.         END
  235.     END
  236.  
  237.     IF ReqType = 2 THEN DO
  238.         IF ReqLevel >= 6 THEN DO
  239.             CALL Notify(1,"!Sorry!","The spheres detail level must be less than six.")
  240.             ReqLevel = 3
  241.             BEHInfo = 1
  242.         END
  243.     END
  244.  
  245. END
  246.  
  247. /* -------------------------------------------------------------------- */
  248.                                                       /* Creation Phase */
  249. IF ReqType = 1 THEN DO
  250.     CALL MakeBall(RX RY RZ, ReqSides, ReqSegs, CX CY CZ)
  251. END
  252.  
  253. IF ReqType = 2 THEN DO
  254.     CALL MakeTesBall(RX RY RZ, ReqLevel, CX CY CZ)
  255. END
  256.  
  257. IF ReqType = 3 THEN DO
  258.  
  259.     MCL = (SQRT(5)+1)/2
  260.  
  261.     ScaleX = RX / SQRT(MCL*MCL + 1)
  262.     ScaleY = RY / SQRT(MCL*MCL + 1)
  263.     ScaleZ = RZ / SQRT(MCL*MCL + 1)
  264.  
  265.     CALL SetLayer(EL)
  266.  
  267.     CALL Add_Begin()
  268.  
  269.     CALL Point(0.0, MCL, 1.0)
  270.     CALL Point(0.0, -MCL, 1.0)
  271.     CALL Point(0.0, MCL, -1.0)
  272.     CALL Point(0.0, -MCL, -1.0)
  273.     CALL Point(1.0, 0.0, MCL)
  274.     CALL Point(-1.0, 0.0, MCL)
  275.     CALL Point(1.0, 0.0, -MCL)
  276.     CALL Point(-1.0, 0.0, -MCL)
  277.     CALL Point(MCL, 1.0, 0.0)
  278.     CALL Point(-MCL, 1.0, 0.0)
  279.     CALL Point(MCL, -1.0, 0.0)
  280.     CALL Point(-MCL, -1.0, 0.0)
  281.     CALL Add_Polygon(1 6 5)
  282.     CALL Add_Polygon(1 5 9)
  283.     CALL Add_Polygon(5 11 9)
  284.     CALL Add_Polygon(2 11 5)
  285.     CALL Add_Polygon(2 5 6)
  286.     CALL Add_Polygon(2 6 12)
  287.     CALL Add_Polygon(6 10 12)
  288.     CALL Add_Polygon(1 10 6)
  289.     CALL Add_Polygon(1 3 10)
  290.     CALL Add_Polygon(1 9 3)
  291.     CALL Add_Polygon(2 12 4)
  292.     CALL Add_Polygon(2 4 11)
  293.     CALL Add_Polygon(3 7 8)
  294.     CALL Add_Polygon(3 9 7)
  295.     CALL Add_Polygon(7 9 11)
  296.     CALL Add_Polygon(4 7 11)
  297.     CALL Add_Polygon(4 8 7)
  298.     CALL Add_Polygon(4 12 8)
  299.     CALL Add_Polygon(8 12 10)
  300.     CALL Add_Polygon(3 8 10)
  301.  
  302.     CALL Add_End()
  303.  
  304.     DO i = 1 TO ReqLevel
  305.         CALL SubDivide(FLAT)
  306.     END
  307.  
  308.     N = XFrm_Begin()
  309.     CALL Meter_Begin N, "Spherize Process"
  310.     DO i = 1 to N
  311.         PARSE value XFrm_GetPos(i) with X Y Z .
  312.         DX = X - CX
  313.         DY = Y - CY
  314.         DZ = Z - CZ
  315.         D = SQRT(DX * DX + DY * DY + DZ * DZ)
  316.         IF (D ~= 0) THEN DO
  317.             DRadX = RX / D
  318.             DRadY = RY / D
  319.             DRadZ = RZ / D
  320.  
  321.             X = (DX * DRadX) + CX
  322.             Y = (DY * DRadY) + CY
  323.             Z = (DZ * DRadZ) + CZ
  324.  
  325.             CALL XFrm_SetPos(i, X Y Z)
  326.         END
  327.         CALL Meter_Step
  328.     END
  329.     CALL Meter_END
  330.     CALL XFrm_END
  331.  
  332.     CALL Cut()
  333.     CALL SetLayer(CL)
  334.     CALL Paste()
  335.  
  336. END
  337.  
  338. CALL SaveSettings
  339. CALL Exiting
  340.  
  341. /* -------------------------------------------------------------------- */
  342.  
  343. Point:
  344.  
  345.     ARG X,Y,Z
  346.     CALL Add_Point(X*ScaleX+CX Y*ScaleY+CY Z*ScaleZ+CZ)
  347.  
  348. RETURN
  349.  
  350. /* -------------------------------------------------------------------- */
  351.                                             /* Recording Macro Settings */
  352. SaveSettings:
  353.  
  354.     IF (OPEN(PrefsFile, PrefsFileName, 'W')) THEN DO
  355.         CALL WRITELN(PrefsFile, MacrosName)
  356.  
  357.         CALL WRITELN(PrefsFile, ReqCnt)
  358.         CALL WRITELN(PrefsFile, ReqRad)
  359.         CALL WRITELN(PrefsFile, ReqType)
  360.         CALL WRITELN(PrefsFile, ReqSides)
  361.         CALL WRITELN(PrefsFile, ReqSegs)
  362.         CALL WRITELN(PrefsFile, ReqLevel)
  363.  
  364.         CALL CLOSE PrefsFile
  365.     END
  366.  
  367. RETURN
  368.  
  369. /* -------------------------------------------------------------------- */
  370.                                                               /* Ending */
  371. Exiting:
  372.  
  373.     IF (VT3DLib) THEN CALL REMLIB("LWModelerARexx.port")
  374.     EXIT
  375.  
  376. RETURN
  377.  
  378. /* -------------------------------------------------------------------- */
  379.                                                  /* Information Windows */
  380. InformationWindows:
  381.  
  382.     OKorCancel = Notify(2, Info1A, Info1B, Info1C, Info1D, Info1E, Info1F, Info1G, Info1H, Info1I, Info1J, Info1K, Info1L, Info1M, Info1N)
  383.     IF OKorCancel = 1 THEN CALL Notify(1, Info2A, Info2B, Info2C, Info2D, Info2E, Info2F, Info2G, Info2H, Info2I, Info2J, Info2K, Info2L, Info2M, Info2N)
  384.  
  385. RETURN
  386.  
  387. /* -------------------------------------------------------------------- */
  388.                                                       /* Error Handling */
  389. SYNTAX:
  390. ERROR:
  391.  
  392.     ErrCode = RC
  393.     ErrLine = SIGL
  394.     ErrInfo = ERRORTEXT(ErrCode)
  395.  
  396.     Err1 = "!Sorry!"
  397.     Err2 = "An Error has been detected"
  398.     Err3 = "@þ Macro -            "
  399.     Err4 = "@þ Line Number -      "
  400.     Err5 = "@þ Error Code -       "
  401.     Err6 = "@þ Error Description -"
  402.     Err7 = "@¤ Please Inform -    "
  403.     Err8 = '  "Error Notice"     '
  404.     Err9 = "  13032 Copenhill Rd."
  405.     Err10 = "  Dallas, TX. 75240  "
  406.  
  407.     Call Notify(1,Err1,Err2,Err3,MacrosName,Err4,ErrLine,Err5,ErrCode,Err6,ErrInfo,Err7,Err8,Err9,Err10)
  408.  
  409. /* -------------------------------------------------------------------- */
  410.                                              /* Advanced Error Handling */
  411.     CALL SETCLIP("ErrorMacro",MacrosName)
  412.     CALL SETCLIP("ErrorLine",ErrLine)
  413.     CALL SETCLIP("ErrorCode",ErrCode)
  414.     CALL SETCLIP("ErrorDesc",ErrInfo)
  415.  
  416.     PARSE SOURCE TempA TempB ErrFile TempC TempD TempE
  417.  
  418.     CALL SETCLIP("ErrorFile",ErrFile)
  419.  
  420. /* -------------------------------------------------------------------- */
  421.  
  422.     IF (VT3DLib) THEN CALL REMLIB("LWModelerARexx.port")
  423.     EXIT
  424.