home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p068 / 4.img / GROUPS.CDL < prev    next >
Encoding:
Text File  |  1989-01-04  |  6.3 KB  |  287 lines
  1. REM  @(#)CADKEY SOLIDS    groups.cdl    2.4    10/31/88
  2. REM
  3. REM  program to set group information for CADKEY SOLIDS
  4. REM
  5.  
  6. $tmpstr = "     "
  7. $mat = "        "
  8. $mat1 = "        "
  9. $mat2 = "        "
  10. $mat3 = "        "
  11. $mat4 = "        "
  12. $mat5 = "        "
  13. $mat6 = "        "
  14. $mat7 = "        "
  15. $mat8 = "        "
  16.  
  17. $dum1 = "        "
  18. $dum2 = "         "
  19. $dum3 = "         "
  20. $dum4 = "         "
  21. $dum5 = "         "
  22.  
  23. REM    "skip past the first entries "
  24.  
  25.     set devin, matter.dat
  26.     input    "%s %s %s %s %s",$dum1,$dum2,$dum3,$dum4,$dum5
  27.     input    "%s %s %s %s %s",$dum1,$dum2,$dum3,$dum4,$dum5
  28.  
  29. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  30.     if ( @NREAD <= 0 ) 
  31.     goto done
  32.     CALL STRCPY ,$mat1,$tmpstr
  33.  
  34. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  35.     if ( @NREAD <= 0 ) 
  36.     goto done
  37.     CALL STRCPY ,$mat2,$tmpstr
  38.  
  39. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  40.     if ( @NREAD <= 0 ) 
  41.     goto done
  42.     CALL STRCPY ,$mat3,$tmpstr
  43.  
  44. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  45.     if ( @NREAD <= 0 ) 
  46.     goto done
  47.     CALL STRCPY ,$mat4,$tmpstr
  48.  
  49. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  50.     if ( @NREAD <= 0 ) 
  51.     goto done
  52.     CALL STRCPY ,$mat5,$tmpstr
  53.  
  54. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  55.     if ( @NREAD <= 0 ) 
  56.     goto done
  57.     CALL STRCPY ,$mat6,$tmpstr
  58.  
  59. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  60.     if ( @NREAD <= 0 ) 
  61.     goto done
  62.     CALL STRCPY ,$mat7,$tmpstr
  63.  
  64. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  65.     if ( @NREAD <= 0 ) 
  66.     goto done
  67.     CALL STRCPY ,$mat8,$tmpstr
  68. :done
  69. set devout,tmp.grp
  70. REM '-----------------------------------------------------------------'
  71. REM '--        Handle group data                                      '
  72. REM '-----------------------------------------------------------------'
  73. grp1 = 1  
  74. :mainmenu
  75.     getmenu "GROUPS : Choose option",\
  76.         "SELECT",\
  77.         "MATERIAL",\
  78.         "VELOCITY",\
  79.         "DENSITY",\
  80.         "AWDENS",\
  81.         "SHAD PR",\
  82.         "DONE"
  83.  
  84.     on (@key + 3) goto leaveit,mainmenu,mainmenu,,\
  85.         get_groups,\
  86.         matmenu,\
  87.         velomenu,\
  88.         density,\
  89.         awdens,\
  90.         shadmenu,\
  91.         getout
  92.     goto mainmenu
  93.  
  94. :get_groups
  95.     getmenu "GROUPS : Choose option",\
  96.         "SELECT",\
  97.         "KEYIN",\
  98.  
  99.     on (@key + 3) goto leaveit,mainmenu,get_groups,,\
  100.         selectg,\
  101.         keyin
  102.     goto get_groups
  103.  
  104. :selectg
  105. getent "Select group",etype
  106. on ( @key + 3  ) goto leaveit,get_groups,selectg,
  107. grp1 = @INTDAT[1]
  108. goto get_groups
  109.  
  110. :keyin
  111. tmp = grp1
  112. getint "GROUPS : Enter group number (%d) =>",tmp,grp
  113. on ( @key + 3  ) goto leaveit,get_groups,keyin,
  114. grp1 = grp
  115. goto get_groups
  116.  
  117.  
  118. :matmenu
  119.     getmenu "GROUPS : Choose option",\
  120.         $mat1,\
  121.         $mat2,\
  122.         $mat3,\
  123.         $mat4,\
  124.         $mat5,\
  125.         $mat6,\
  126.         $mat7,\
  127.         $mat8
  128.  
  129.     on (@key + 3) goto leaveit,mainmenu,matmenu,,\
  130.         s1,\
  131.         s2,\
  132.         s3,\
  133.         s4,\
  134.         s5,\
  135.         s6,\
  136.         s7,\
  137.         s8
  138.     goto mainmenu
  139. :s1
  140. CALL STRCPY ,$mat,$mat1
  141. goto setmater
  142. :s2
  143. CALL STRCPY ,$mat,$mat2
  144. goto setmater
  145. :s3
  146. CALL STRCPY ,$mat,$mat3
  147. goto setmater
  148. :s4
  149. CALL STRCPY ,$mat,$mat4
  150. goto setmater
  151. :s5
  152. CALL STRCPY ,$mat,$mat5
  153. goto setmater
  154. :s6
  155. CALL STRCPY ,$mat,$mat6
  156. goto setmater
  157. :s7
  158. CALL STRCPY ,$mat,$mat7
  159. goto setmater
  160. :s8
  161. CALL STRCPY ,$mat,$mat8
  162. goto setmater
  163.  
  164. :setmater
  165.     set devin, matter.dat
  166.     input    "%s %s %s %s %s",$dum1,$dum2,$dum3,$dum4,$dum5
  167.     input    "%s %s %s %s %s",$dum1,$dum2,$dum3,$dum4,$dum5
  168. iset = 0
  169. :loop
  170. INPUT "%s %f %f %f %d",$tmpstr,dens,diffuse,specular,reflect
  171. CALL STRCMPI ,$mat,$tmpstr,r
  172. if (r != 0 )
  173. goto nextone
  174.     print "\nMATERIAL %d,%s",grp1,$mat 
  175.     print "\nDENSITY %d, %f",grp1,dens 
  176.     print "\nDIFFUSE %d, %f",grp1,diffuse 
  177.     print "\nSPECULAR %d, %f",grp1,specular 
  178.     print "\nREFLECTIVITY %d, %d",grp1,reflect 
  179.     iset = 1
  180.     goto mainmenu
  181. :nextone
  182. if ( @nread != 0 )
  183. goto loop
  184. goto mainmenu
  185.  
  186. :velomenu
  187. tmp = 1.0
  188. GETFLT "Enter x angular velocity of current group =>",tmp,xvel
  189. on ( @key + 3 ) goto leaveit,mainmenu,velomenu,
  190. print "\nANGVX %d,%f",grp1,xvel
  191.  
  192. :yveloc
  193. GETFLT "Enter y angular velocity of current group =>",tmp,yvel
  194. on ( @key + 3 ) goto leaveit,velomenu,yveloc,
  195. print "\nANGVY %d,%f",grp1,yvel
  196.  
  197. :zveloc
  198. GETFLT "Enter z angular velocity of current group =>",tmp,zvel
  199. on ( @key + 3 ) goto leaveit,yveloc,zveloc,
  200. print "\nANGVZ %d,%f",grp1,zvel
  201. goto mainmenu
  202.  
  203. :density
  204. tmp = 1.0
  205. GETFLT "Enter density of current group (%f) =>",tmp,dens
  206. on ( @key + 3 ) goto leaveit,mainmenu,density,
  207. if ( dens > 0.0 )
  208.     print "\nDENSITY %d,%f",grp1,dens
  209. if ( dens >= 0.0)
  210.     goto mainmenu
  211. pause "Invalid density entered"
  212. goto density
  213.  
  214. :awdens
  215. tmp = 1.0
  216. GETFLT "Enter area weighted density of current group (%f) =>",tmp,awd
  217. on ( @key + 3 ) goto leaveit,mainmenu,awdens,
  218. if ( awd >= 0.0)
  219.     print "\nAWDENSITY %d,%f",grp1,awd
  220. if ( awd >= 0.0)
  221.     goto mainmenu
  222. awd = tmp
  223. pause "Invalid area weighted density entered"
  224. goto awdens
  225.  
  226. :shadmenu
  227.     getmenu "GROUPS : Choose option",\
  228.         "DIFFUSE",\
  229.         "SPECULAR",\
  230.         "REFLECT",\
  231.  
  232.     on (@key + 3) goto leaveit,mainmenu,shadmenu,,\
  233.         diff,\
  234.         spec,\
  235.         ref
  236.     goto mainmenu
  237.  
  238. :diff
  239. tmp = 0.7
  240. GETFLT "Enter diffuse coefficient of current group (%f) =>",tmp,diffuse
  241. on ( @key + 3 ) goto leaveit,shadmenu,diff,
  242. if ( ( diffuse < 0.0 ) || ( diffuse > 1.0 ) )
  243.     goto baddiff
  244. print "\nDIFFUSE %d,%f",grp1,diffuse
  245. goto shadmenu
  246. :baddiff
  247.     pause "Invalid diffuse value entered"
  248.     goto diff
  249. :spec
  250. tmp = 0.2
  251. GETFLT "Enter specular coefficient of current group (%f) =>",tmp,specular
  252. on ( @key + 3 ) goto leaveit,shadmenu,spec,
  253. if ( ( specular < 0.0 ) || ( specular > 1.0 ) )
  254.     goto badspec
  255. print "\nSPECULAR %d,%f",grp1,specular
  256. goto shadmenu
  257. :badspec
  258.     pause "Invalid specular value entered"
  259.     goto spec
  260.  
  261. :ref
  262. tmp = 5
  263. GETINT "Enter reflectivity coefficient of current group (%d) =>",tmp,reflect
  264. on ( @key + 3 ) goto leaveit,shadmenu,ref,
  265. if ( ( reflect < 0 ) || ( reflect > 200 ) )
  266.     goto badref
  267. print "\nREFLECTIVITY %d,%f",grp1,reflect
  268. goto shadmenu
  269. :badref
  270.     pause "Invalid reflectivity coefficient entered"
  271.     goto ref
  272.  
  273. :getout
  274. $ts = "sol.grp"
  275. getstr "GROUPS : Enter group information file name (%s) => ",$ts,$anname
  276. on (@key + 3 ) goto leaveit,mainmenu,makeit
  277.  
  278. :makeit
  279. sprint $str,"copy tmp.grp %s \n", $anname
  280. exec 1, $str
  281.  
  282. :leaveit
  283. clear tmp,xvel,yvel,zvel,diffuse,specular,reflect,grp1,$ts,$anname,$str
  284. clear    dens,awd
  285. clear $mat1,$mat2,$mat3,$mat4,$mat5,$mat6,$mat7,$mat8
  286. clear $dum1,$dum2,$dum3,$dum4,$dum5,$tmpstr
  287.