home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 025.lha / try3d (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1987-04-02  |  9.1 KB  |  480 lines

  1. '  Try3D -- An Example of 3D Programming
  2. '  Initial Amiga implementation
  3. '  by Jim Meadows 6/1/86 Compuserve [75046,2012]
  4. '
  5. '  Refer to article in AMAZING COMPUTING 1986 vol.1 / #7, pages 13-23
  6.  
  7.  
  8. '  3D Greeting
  9. CLS:  PRINT
  10. COLOR 3: PRINT "    Try3D";
  11. COLOR 1: PRINT " -- An Example of 3D Programming"
  12. COLOR 1: PRINT "             by Jim Meadows     "
  13. GOSUB InitVals
  14. GOSUB SetImage
  15. ' GOSUB SetImage
  16. ' GOTO Manual
  17. ef = -1
  18. ax = 10
  19. ay = 5
  20. px = 180
  21. py = 70
  22. GOSUB DrawImage
  23. LOCATE 18,20: COLOR 3: PRINT "Hello!"
  24. GOSUB Pause
  25. ax = 10
  26. ay = -30
  27. GOSUB DrawImage
  28. LOCATE 18,3: COLOR 3: PRINT "Welcome to the World of 3D Graphics!"
  29. GOSUB Pause
  30. ax = 30
  31. ay = 20
  32. GOSUB DrawImage
  33. LOCATE 18,15: COLOR 3: PRINT "Hmmmmmm....."
  34. GOSUB Pause
  35. ax = -30
  36. ay = -15
  37. az = 20
  38. di = 500
  39. GOSUB DrawImage
  40. LOCATE 18,8: COLOR 3: PRINT "Yep, just as I figured..."
  41. GOSUB Pause
  42. az = -20
  43. ay =  15
  44. GOSUB DrawImage
  45. LOCATE 18,4: COLOR 3: PRINT "You've got what it takes for 3D!"
  46. GOSUB Pause
  47. ax = 10
  48. ay = -20
  49. az = 0
  50. di = 900
  51. GOSUB DrawImage
  52. LOCATE 18,15: COLOR 3: PRINT "You have ..."
  53. GOSUB Pause
  54. ax = -5
  55. ay =  0
  56. di = 700
  57. GOSUB DrawImage
  58. LOCATE 18,15: COLOR 3: PRINT "... an AMIGA ! !"
  59. GOSUB Pause
  60. FOR i = 1 TO 10000: NEXT
  61. ef = 0
  62.  
  63.  
  64. Ri:
  65. '   Rotating Image
  66. CLS
  67. LOCATE 19,13: COLOR 3: PRINT "Delta Wing Fighter"
  68. GOSUB SetImage
  69. '  Draw and Undraw rotating image
  70. ax = -90
  71. ay = 270
  72. az = 0
  73. px = 160
  74. py = 100
  75. FOR ii = 1 TO 4
  76.   GOSUB DrawImage
  77.   GOSUB Pause
  78.   ef = 1
  79.   GOSUB DrawImage
  80.   ef = 0
  81.   ax = -20
  82.   ay = ay - 60
  83.   IF ii = 1 THEN ax = 0: ay = 270: az = 0
  84. NEXT ii
  85.  
  86.  
  87. Fly:
  88. '   Animated flight path  
  89. FOR inum = 1 TO 2
  90.   IF inum = 2  THEN  GOSUB SetImage
  91.   di = 2400
  92.   ax = 0
  93.   ay = 270
  94.   az = 0
  95.   px = 30
  96.   py = 30
  97.   ef = -1
  98.   GOSUB DrawImage
  99.   px = px + 40
  100.   ax = ax - 5
  101.   di = di - 100
  102.   GOSUB DrawImage
  103.   ax = ax - 5
  104.   di = di - 100
  105.   FOR r = 1 TO 3
  106.     px = px + 40
  107.     ay = ay - 20
  108.     di = di - 100
  109.     GOSUB DrawImage
  110.   NEXT r
  111.   FOR r = 1 TO 3
  112.     px = px + 30
  113.     ay = ay - 20
  114.     az = az - 20
  115.     di = di - 100
  116.     GOSUB DrawImage
  117.   NEXT r
  118.   FOR r = 1 TO 4
  119.     px = px - 20
  120.     py = py + 10
  121.     az = az + 10
  122.     di = di - 80
  123.     GOSUB DrawImage
  124.   NEXT r
  125.   FOR r = 1 TO 8
  126.     px = px - 9 * r
  127.     py = py + 10
  128.     az = az + 5
  129.     di = di - 60
  130.     ax = ax - 5
  131.     GOSUB DrawImage
  132.   NEXT r
  133. NEXT inum
  134.  
  135.  
  136. '  Finally allow manual control
  137. GOSUB SetImage
  138.  
  139. Manual:
  140.  
  141. MENU  1,0,1,"Rotate +"
  142. MENU  1,1,1,"Around X-axis"
  143. MENU  1,2,1,"Around Y-axis"
  144. MENU  1,3,1,"Around Z-axis"
  145.   
  146. MENU  2,0,1,"Rotate -"
  147. MENU  2,1,1,"Around X-axis"
  148. MENU  2,2,1,"Around Y-axis"
  149. MENU  2,3,1,"Around Z-axis"
  150.  
  151. MENU 3,0,1,"Move"
  152. MENU 3,1,1,"Closer"  
  153. MENU 3,2,1,"Away"  
  154. MENU 3,3,1,"Right"
  155. MENU 3,4,1,"Left"  
  156. MENU 3,5,1,"Up"  
  157. MENU 3,6,1,"Down"
  158.  
  159. MENU 4,0,1,"Reset"  
  160. MENU 4,1,1,"Angles"  
  161. MENU 4,2,1,"Distance"  
  162. MENU 4,3,1,"Position"  
  163. MENU 4,4,1,"Quit"
  164.  
  165. ON MENU GOSUB Menus
  166. ON MOUSE GOSUB Mous
  167.  
  168. m1 = 1:  GOSUB Reeset
  169. m1 = 2:  GOSUB Reeset
  170. m1 = 3:  GOSUB Reeset
  171. act = 1
  172. ef = -1
  173.  
  174. MOUSE ON 
  175. MENU  ON
  176.  
  177.  
  178. Loop:
  179.   IF act = 0  THEN  inc = 1:  GOTO Loop
  180.   GOSUB DrawImage
  181.   GOSUB Vals
  182.   IF MOUSE(0) <> -1  THEN  act = 0  :ELSE  GOSUB Mous
  183.   GOTO Loop
  184.   
  185.  
  186. '---------------
  187. '  Subroutines
  188. '---------------
  189. Vals:
  190.   COLOR 1
  191.   LOCATE 1,1: PRINT "Ax,Ay,Az: "ax","ay","az
  192.   LOCATE 2,1: PRINT "Px,Py   : "px","py
  193.   LOCATE 3,1: PRINT "Di      : "di
  194.   COLOR 3
  195.   LOCATE 4,1: PRINT "Use Menus to Change View"
  196.   LOCATE 5,3: PRINT "eg  select AWAY view to zoom out  "
  197.   COLOR 2 
  198.   LOCATE 6,1: PRINT "(press left button to repeat)"
  199.   LOCATE 7,1: PRINT "(keep it pressed to speed things up a little)"
  200. RETURN
  201.  
  202. Menus:
  203.   act = 1 
  204.   inc = 1
  205.   m0 = MENU(0)
  206.   m1 = MENU(1)
  207.   ON m0 GOSUB RotateP,RotateM,MoveI,Reeset
  208. RETURN
  209.  
  210.  
  211. Mous:
  212.   act = 1
  213.   inc = inc + 0.5
  214.   ON m0  GOSUB  RotateP,RotateM,MoveI,Reeset
  215. RETURN
  216.  
  217.  
  218. RotateP:
  219.   IF m1 = 1  THEN  ax = ax + 10 * inc
  220.   IF m1 = 2  THEN  ay = ay + 10 * inc
  221.   IF m1 = 3  THEN  az = az + 10 * inc
  222. RETURN
  223.  
  224.  
  225. RotateM:
  226.   IF m1 = 1  THEN  ax = ax - 10 * inc
  227.   IF m1 = 2  THEN  ay = ay - 10 * inc
  228.   IF m1 = 3  THEN  az = az - 10 * inc
  229. RETURN
  230.  
  231.  
  232. MoveI:
  233.   IF m1 = 1  THEN  di = di - 50 * inc
  234.   IF m1 = 2  THEN  di = di + 50 * inc
  235.   IF m1 = 3  THEN  px = px + 20 * inc
  236.   IF m1 = 4  THEN  px = px - 20 * inc
  237.   IF m1 = 5  THEN  py = py - 10 * inc
  238.   IF m1 = 6  THEN  py = py + 10 * inc
  239. RETURN
  240.  
  241.  
  242. Reeset:
  243.   IF m1 = 1  THEN  ax = -15: ay = -25: az = 0
  244.   IF m1 = 2  THEN  di = 1200
  245.   IF m1 = 3  THEN  px = 160: py = 100
  246.   IF m1 = 4  THEN  MENU OFF: END
  247. RETURN
  248.  
  249.  
  250. Pause:
  251.   FOR i = 1  TO  4000: NEXT
  252. RETURN
  253.  
  254.  
  255. ' --------------------------------------
  256. ' |         3-D  Routines              |
  257. ' --------------------------------------
  258.              
  259. ' ax,ay,az  =  rotation Angle in degrees
  260. ' di        =  distance to image
  261. ' dw        =  distance to window (projection plane)
  262. ' px,py     =  position of image on screen
  263. ' sf        =  screen scaling factor
  264. ' ef        =  erase flag (1=erase, 0=draw, -1=cls & draw)
  265. ' Image data is at end of profram
  266.  
  267. InitVals:
  268.   '  Define Arrays
  269.   DIM it%(100,3):     ' Image Table
  270.   DIM rim%(100,3):    ' Rotated Image
  271.   '  Initialize Values
  272.   x = 0
  273.   y = 0
  274.   z = 0
  275.   dw = 4000:          ' Distance to Window
  276.   di = 900:           ' Distance to image 
  277.   sf = 2.35:          ' Screen scale factor
  278.   ax = 0:  ay = 0:  az = 0:     ' Angles in degrees
  279.   px = 200:  py = 100:          ' x,y Image Location
  280.   ef = 0:             ' Erase Flag
  281.   f = 57.2958:       ' Degrees to Radians factor
  282. RETURN
  283.  
  284.  
  285. DrawImage:
  286. ' Draw the Image
  287.     GOSUB Rotate
  288.     GOSUB DrawIt
  289. RETURN
  290.  
  291.  
  292. Rotate:
  293.   ' First get trig values from angles
  294.   sx = SIN(ax / f)
  295.   cx = COS(ax / f)
  296.   sy = SIN(ay / f)
  297.   cy = COS(ay / f)
  298.   sz = SIN(az / f)
  299.   cz = COS(az / f)
  300.   ' Then compute rotation values
  301.   xRx =  cy * cz
  302.   yRx = -cy * sz
  303.   zRx = -sy
  304.   xRy =  cx * sz - sx * sy * cz
  305.   yRy =  cx * cz + sx * sy * sz
  306.   zRy = -sx * cy
  307.   xRz =  sx * sz + cx * sy * cz
  308.   yRz =  sx * cz - cx * sy * sz
  309.   zRz =  cx * cy
  310.   ' Now Rotate Image
  311.   np = 0
  312.   
  313.   Rotate1:
  314.     ' Get next point
  315.     c = it%(np, 0):  IF c = -1 THEN RETURN
  316.     x = it%(np, 1)
  317.     y = it%(np, 2)
  318.     z = it%(np, 3)
  319.     ' Compute its new location
  320.     rim%(np, 1) = x * xRx + y * yRx + z * zRx
  321.     rim%(np, 2) = x * xRy + y * yRy + z * zRy
  322.     rim%(np, 3) = x * xRz + y * yRz + z * zRz
  323.     np = np + 1
  324.     GOTO Rotate1
  325.     
  326.     
  327. DrawIt:
  328.   np = 0
  329.   IF ef = -1  THEN  CLS
  330.   DrawIt1:
  331.    ' Check for end of table
  332.    c = it%(np, 0) 
  333.    IF c = -1  THEN  RETURN
  334.    ' Keep from dividing by zero
  335.    IF  (rim%(np, 3) + di)  =  0  THEN  rim%(np, 3) = rim%(np, 3) + 1
  336.    ' Compute screen x & y
  337.    xw = px + (rim%(np, 1) / (rim%(np, 3) + di)) * dw * sf
  338.    yw = py + (rim%(np, 2) / (rim%(np, 3) + di)) * dw
  339.    ' Draw next line or move to next point
  340.    IF c = 0  THEN  GOTO JustMove
  341.    colr = c 
  342.    IF ef = 1  THEN  colr = 0
  343.    LINE (lx, ly)-(xw, yw),colr
  344.    JustMove:  lx = xw:  ly = yw
  345.    np = np + 1
  346.    GOTO DrawIt1
  347.  
  348.   
  349. SetImage:
  350.   ' Routine to insert an image into the table
  351.   n = 0
  352.   itloop:
  353.     READ it%(n, 0)
  354.     IF it%(n, 0) = -1  THEN  RETURN
  355.     READ it%(n, 1), it%(n, 2), it%(n, 3)
  356.     n = n + 1
  357.     GOTO itloop
  358.     
  359.     
  360. ' Greeting Image
  361. ' Image Data Format: c,x,y,z
  362. '   (c = color,  if = 0  then  move w/o drawing)
  363.  
  364. DATA 0,-50,30,0
  365. DATA 1,-55,35,10
  366. DATA 1,-45,0,0
  367. DATA 1,-20,-60,-30
  368. DATA 1,20,-60,-30
  369. DATA 1,20,-60,-30
  370. DATA 1,45,0,0
  371. DATA 1,55,35,10
  372. DATA 1,50,30,0
  373. DATA 3,30,80,-30
  374. DATA 3,-30,80,-30
  375. DATA 3,-50,30,0
  376. DATA 0,0,22,-30
  377. DATA 1,0,-4,-36
  378. DATA 0,-5,0,-30
  379. DATA 1,0,-4,-36
  380. DATA 1,5,0,-30
  381. DATA 0,-20,30,-25
  382. DATA 1,-35,25,-17
  383. DATA 1,-20,20,-25
  384. DATA 1,-5,25,-21
  385. DATA 1,-20,30,-25
  386. DATA 2,-20,20,-25
  387. DATA 0,20,30,-25
  388. DATA 1,35,25,-17
  389. DATA 1,20,20,-25
  390. DATA 1,5,25,-21
  391. DATA 1,20,30,-25
  392. DATA 2,20,20,-25
  393. DATA 0,-20,-26,-22
  394. DATA 3,0,-34,-30
  395. DATA 3,20,-26,-22
  396. DATA 0,-10,-30,-26
  397. DATA 3,10,-30,-26
  398. DATA -1
  399.  
  400. ' Delta Wing Fighter Image
  401. DATA 0,0,-20,100
  402. DATA 1,0,20,-100
  403. DATA 0,50,-20,-100
  404. DATA 1,0,-20,100
  405. DATA 1,-50,-20,-100
  406. DATA 2,0,20,-100
  407. DATA 2,50,-20,-100
  408. DATA 2,-50,-20,-100
  409. DATA 0,-75,0,-100
  410. DATA 3,0,0,0
  411. DATA 3,75,0,-100
  412. DATA 3,-75,0,-100
  413. DATA -1:  ' End of Image
  414.  
  415.  
  416. ' Chaser Image
  417. DATA 0,-25,0,-25
  418. DATA 1,25,0,-25
  419. DATA 1,25,0,25
  420. DATA 1,-25,0,25
  421. DATA 1,-25,0,-25
  422. DATA 0,-25,25,25
  423. DATA 3,-25,-25,25
  424. DATA 3,-25,-25,-25
  425. DATA 3,-25,25,-25
  426. DATA 3,-25,25,25
  427. DATA 0,25,25,25
  428. DATA 3,25,-25,25
  429. DATA 3,25,-25,-25
  430. DATA 3,25,25,-25
  431. DATA 3,25,25,25
  432. DATA 0,0,0,-25
  433. DATA 2,0,0,50
  434. DATA 2,0,10,25
  435. DATA 2,0,0,-25
  436. DATA -1
  437.  
  438.  
  439. ' XYZ axis Image
  440. DATA 0,-100,0,0
  441. DATA 1,100,0,0
  442. DATA 1,80,-20,0
  443. DATA 0,100,0,0
  444. DATA 1,80,20,0
  445. DATA 0,140,14,0
  446. DATA 1,170,-16,0
  447. DATA 0,140,-16,0
  448. DATA 1,170,14,0
  449. DATA 0,0,-100,0
  450. DATA 2,0,100,0
  451. DATA 2,20,80,0
  452. DATA 0,0,100,0
  453. DATA 2,-20,80,0
  454. DATA 0,0,120,0
  455. DATA 2,0,134,0
  456. DATA 2,14,148,0
  457. DATA 0,0,134,0
  458. DATA 2,-14,148,0
  459. DATA 0,0,0,100
  460. DATA 3,0,0,-100
  461. DATA 3,0,-20,-80
  462. DATA 0,0,0,-100
  463. DATA 3,0,20,-80
  464. DATA 0,-14,14,-140
  465. DATA 3,16,14,-140
  466. DATA 3,-14,-16,-140
  467. DATA 3,16,-16,-140
  468. DATA -1
  469.     
  470.   
  471.   
  472.   
  473.           
  474.   
  475.   
  476.  
  477.  
  478.  
  479.  
  480.