home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / SPHERE.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  2.0 KB  |  102 lines
  1. REM  @(#)CADKEY SOLIDS    sphere.cdl    2.2    10/31/88
  2. REM program to draw sphere entity
  3.  
  4. REM define view matrices for view 1, 2 and 5
  5.  
  6. array vmat1[9] = {
  7.         1, 0, 0, 0, 1, 0, 0, 0, 1
  8. }
  9. array vmat2[9] = {
  10.         1, 0, 0, 0, 0, -1, 0, 1, 0
  11. }
  12. array vmat5[9] = {
  13.         0, 0, 1, 1, 0, 0, 0, 1, 0
  14. }
  15.  
  16. def = 1
  17.  
  18. :radius
  19. REM Positive radius for the sphere
  20.  
  21. getflt "Enter radius (%f) =>", 1, rad1
  22. if (@key <= -2)
  23.         exit
  24. if (rad1 > 0.00001)
  25.         goto sections
  26. pause "Invalid radius ... (Press RETURN)"
  27. goto radius
  28.  
  29. :sections
  30. REM Number of latitudinal circles in the sphere
  31.  
  32. getint "Enter no. of transverse sections (%d) =>", 7, sect
  33. if (@key == -3)
  34.         exit
  35. if (@key == -2)
  36.         goto radius
  37. if (sect >= 2)
  38.         goto pos
  39. pause "Invalid number of sections ... (Press RETURN)"
  40. goto sections
  41.  
  42. :pos
  43. getpos "Indicate center", def
  44. if (@key == -1)
  45.         goto pos
  46. if (@key == -3)
  47.         exit
  48. if (@key == -2)
  49.         goto sections
  50.  
  51. def = @key
  52. x1 = @xworld
  53. y1 = @yworld
  54. z1 = @zworld
  55.  
  56. REM define view 1, 2 and 5 to draw the circles in these views. The latitudes
  57. REM are drawn in view 1, one circle in view 2 and one in view 5.
  58.  
  59. view 1, 1, 0, 0, 0, 1, 0, 0, 0, 1
  60. view 2, 1, 0, 0, 0, 0, -1, 0, 1, 0
  61. view 5, 0, 0, 1, 1, 0, 0, 0, 1, 0
  62.  
  63. call xfmwv, vmat1, x1, y1, z1, xc, yc, zc
  64.  
  65. REM Increment the total group number and check for overflow
  66.  
  67. ptot = ptot + 1
  68. IF (ptot > 128)
  69.     goto overflow
  70.  
  71. REM Name and make the group.
  72.  
  73. sprint $grp, "_sph%d", ptot
  74. group $grp, ptot, 2
  75.  
  76. inc = 180/sect
  77. i = 0
  78.  
  79. :loop
  80. i = i+1
  81. if (i >= sect)
  82.         goto lat
  83. diff = rad1 * cos(i*inc)
  84. rad2 = sqrt(rad1*rad1 - diff*diff)
  85. circle xc, yc, zc+diff, rad2, 1,,,, ptot, 1
  86. goto loop
  87.  
  88. :lat
  89. call xfmwv, vmat2, x1, y1, z1, xc, yc, zc
  90. circle xc, yc, zc, rad1, 2,,,, ptot, 1
  91.  
  92. call xfmwv, vmat5, x1, y1, z1, xc, yc, zc
  93. circle xc, yc, zc, rad1, 5,,,, ptot, 2
  94. goto pos
  95.  
  96. :overflow
  97. pause "Group overflow ... Abnormal termination"
  98. abort
  99.  
  100. :exit
  101. exit
  102.