home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d514 / dkbtrace.lha / DKBTrace / dkbutsrc.lzh / diamond.bas < prev    next >
BASIC Source File  |  1991-05-16  |  5KB  |  145 lines
  1. 'DKB Diamond Data file Generator by Ken Koehler
  2. 'Updated to DKB 2.11 by Aaron A. Collins
  3.  
  4. defdbl a-z
  5. const FALSE= 0
  6. const TRUE = NOT FALSE
  7. CONST PI = 3.141592653589#
  8. full.scene=TRUE
  9.  
  10. input "Number of sides          :";s
  11. input "Top Radius    from center:";tr
  12. input "Top Height    from center:";th
  13. input "Center Radius from center:";cr
  14. input "Bottom Depth  from center:";bd
  15. screen 1 : color 7
  16. if tr>cr then wy=tr else wy=cr        ' get max dimension
  17. if th>wy then bound=th else bound=wy
  18. if bd>wy then bound=bd
  19. wy=wy*1.1                ' allow % extra screen space
  20. wx=wy*1.5                ' adjust aspect ratio
  21. window (-wx,-wy) - (wx,wy)
  22.   open "diamond.dat" for output as #1
  23.   if full.scene then gosub WritePreText
  24.   print #1,
  25.   print #1,"DECLARE Diamond =
  26.   print #1,"  COMPOSITE
  27.   print #1,"         { s =";s ;"  tr=";tr;"  th=";th;"  cr=";cr;"  bd=";bd;" }"
  28.   ''' Constant
  29.   if tr>cr then size=tr else size=cr
  30.   if th+bd>size then size=th+bd
  31.   ark=2*pi/s/2
  32.   b1x=0         : b1y=-bd: b1z=0
  33.   a4x=0         : a4y= th: a4z=0
  34.   ''' Prep
  35.   long.side=TRUE
  36.   pointx=cos(-2.5*ark) : pointz=sin(-2.5*ark)
  37.   a1x=pointx   *cr  : a1y=00 : a1z=pointz   *cr
  38.   c3x=pointx   *tr  : c3y=th : c3z=pointz   *tr
  39. ' line (  0,  0)-(c3x,c3z),1
  40.   line (c3x,c3z)-(a1x,a1z),3
  41.   for angle = (-1.5*ark) to (2*pi)+(-2.5*ark) step ark*2
  42.       if long.side=TRUE  then pointx=cos(angle)     : pointz=sin(angle)
  43.       if long.side=FALSE then pointx=cos(angle+ark) : pointz=sin(angle+ark)
  44.       c1x=pointx*cr : c1y= 00: c1z=pointz*cr
  45.       b2x=pointx*tr : b2y= th: b2z=pointz*tr
  46. '     line (  0,  0)-(b2x,b2z),1
  47.       line (b2x,b2z)-(c1x,c1z),3
  48.       line (c1x,c1z)-(a1x,a1z),3
  49.       line (b2x,b2z)-(c3x,c3z),1
  50.       gosub WritePoint
  51.       a1x=c1x : a1y=c1y : a1z=c1z
  52.       c3x=b2x : c3y=b2y : c3z=b2z
  53.       long.side=NOT long.side
  54.   next angle
  55.   print #1, "   { BOUNDED_BY                          }"
  56.   if th>bd then print #1,      "   { ** WARNING: Watch for bounding off of top surface ** }"
  57.   print #1,using "   {    SPHERE <0 0 0> ###.##";bound*1.01;' MAX+1%
  58.   print #1, " END_SPHERE }"
  59.   print #1, "   { END_BOUND                           }"
  60.   print #1, "  END_COMPOSITE
  61.   if full.scene then gosub WritePostText
  62.   close #1
  63. while inkey$="":wend
  64. end
  65.  
  66. WritePreText:
  67.   print #1,"INCLUDE ";chr$(34);"shapes.dat";chr$(34)
  68.   print #1,"INCLUDE ";chr$(34);"colors.dat";chr$(34)
  69.   print #1,"INCLUDE ";chr$(34);"textures.dat";chr$(34)
  70.   print #1,
  71.   print #1,"DECLARE DiamondCol = COLOUR Red
  72.   print #1,"DECLARE DiamondTex = TEXTURE
  73.   print #1,"    COLOUR DiamondCol
  74. ' print #1,"    REFLECTION 0.4
  75.   print #1,"END_TEXTURE
  76. return
  77.  
  78. WritePostText:
  79.   print #1,"
  80.   print #1,"VIEW_POINT
  81.   print #1,using "   LOCATION <0.0  0.0  ####.##>";-size*1.5
  82.   print #1,"   DIRECTION <0.0 0.0  1.0>
  83.   print #1,"   UP  <0.0  1.0  0.0>
  84.   print #1,"   RIGHT <1.33333 0.0 0.0>
  85.   print #1,"   LOOK_AT ";
  86.   print #1,using "<0.0 ####.## 0.0>";th-(size/2)
  87.   print #1,"END_VIEW_POINT
  88.   print #1,"
  89.   print #1,"{ Put down the beloved famous raytrace green/yellow checkered floor }
  90.   print #1,"OBJECT
  91.   print #1,using "   PLANE <0.0 1.0 0.0> ####.##";-bd*1.10; ' 10% lower
  92.   print #1," END_PLANE"
  93.   print #1,"
  94.   print #1,"   TEXTURE
  95.   print #1,"      CHECKER COLOUR Yellow COLOUR Green
  96.   print #1,using "      SCALE < ####.## ####.## ####.##>";wy/2;wy/2;wy/2
  97.   print #1,"      AMBIENT 0.1
  98.   print #1,"      DIFFUSE 0.9
  99.   print #1,"   END_TEXTURE
  100.   print #1,"   COLOUR Yellow
  101.   print #1,"END_OBJECT
  102.   print #1,"
  103.   print #1,"{ Put up a ceiling}
  104.   print #1,"OBJECT
  105.   print #1,"   PLANE <0.0 1.0 0.0>  130.00";
  106.   print #1," END_PLANE"
  107.   print #1,"
  108.   print #1,"   TEXTURE
  109.   print #1,"      CHECKER COLOUR White COLOUR Blue
  110.   print #1,using "      SCALE < ####.## ####.## ####.##>";wy/2;wy/2;wy/2
  111.   print #1,"      AMBIENT 0.1
  112.   print #1,"      DIFFUSE 0.9
  113.   print #1,"   END_TEXTURE
  114.   print #1,"   COLOUR Blue
  115.   print #1,"END_OBJECT
  116.   print #1,"
  117.   print #1,"COMPOSITE Diamond
  118.   print #1,"  END_COMPOSITE
  119.   print #1,"
  120.   print #1,"OBJECT
  121.   print #1,"   SPHERE <0.0 0.0 0.0> 2.0 END_SPHERE
  122.   print #1,"   TRANSLATE <100.0  120.0  -130.0>
  123.   print #1,"   TEXTURE
  124.   print #1,"      COLOUR White
  125.   print #1,"      AMBIENT 1.0
  126.   print #1,"      DIFFUSE 0.0
  127.   print #1,"   END_TEXTURE
  128.   print #1,"   LIGHT_SOURCE
  129.   print #1,"   COLOUR White
  130.   print #1,"END_OBJECT
  131. return
  132.  
  133. WritePoint:
  134.   current.point%=current.point%+1
  135.   print #1, using "       { Side #### }";current.point%
  136.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;a1z  ;c1x;c1y;c1z  ;b1x;b1y;b1z;
  137.   print #1," END_TRIANGLE COLOUR DiamondCol TEXTURE DiamondTex END_TEXTURE END_OBJECT"
  138.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;a1z  ;c1x;c1y;c1z  ;b2x;b2y;b2z;
  139.   print #1," END_TRIANGLE COLOUR DiamondCol TEXTURE DiamondTex END_TEXTURE END_OBJECT"
  140.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a1x;a1y;a1z  ;b2x;b2y;b2z  ;c3x;c3y;c3z;
  141.   print #1," END_TRIANGLE COLOUR DiamondCol TEXTURE DiamondTex END_TEXTURE END_OBJECT"
  142.   print #1, using "    OBJECT TRIANGLE <###.#### ###.#### ###.####> <###.#### ###.#### ###.####> <###.#### ###.#### ###.####>" ;a4x;a4y;a4z  ;b2x;b2y;b2z  ;c3x;c3y;c3z;
  143.   print #1," END_TRIANGLE COLOUR DiamondCol TEXTURE DiamondTex END_TEXTURE END_OBJECT"
  144. return
  145.