home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 025.lha / quadri (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1987-04-02  |  5.0 KB  |  244 lines
  1. CLEAR,25000
  2. CLEAR,40000
  3. DEFINT h-n
  4. DEF FNf1(x,y)=x*x+y*y
  5. DEF FNf2(x,y)=y*y-x*x
  6. DEF FNf3(x,y)=SQR(y*y+x*x)*2
  7. DEF FNf4(x,y)=SQR(y*y+x*x-2)*2
  8. DEF FNf5(x,y)=SQR(y*y-x*x-1)
  9. DEF FNf6(x,y)=SQR(1-x*x-y*y)
  10.  
  11. SCREEN 1,640,400,4,4
  12. WINDOW 2,"",,0,1
  13. COLOR 10,2
  14.  
  15. Make.Choice:
  16.   CLS
  17.   LOCATE 4,35:PRINT "3-D GRAPHICS"
  18.   LOCATE 6,11:PRINT "A translation to the Amiga of the programs from the article"
  19.   LOCATE 7,28:PRINT "Graphing Quadric Surfaces"
  20.   LOCATE 8,39:PRINT "by"
  21.   LOCATE 9,34:PRINT "George Haroney"
  22.   LOCATE 10,25:PRINT "Byte Magazine, Dec. 1986, p. 215"
  23.   LOCATE 12,37:PRINT "PICK ONE"
  24.   LOCATE 14,30:PRINT "1.  Parabloid"
  25.   LOCATE 15,30:PRINT "2.  Hyperbolic Parabloid"
  26.   LOCATE 16,30:PRINT "3.  Cone"
  27.   LOCATE 17,30:PRINT "4.  Hyperbloid of One Sheet"
  28.   LOCATE 18,30:PRINT "5.  Hyperbloid of Two Sheets"
  29.   LOCATE 19,30:PRINT "6.  Ellipsoid"
  30.   LOCATE 20,30:PRINT "7.  Quit"
  31.   LOCATE 22,30:INPUT "(1-7)";choice
  32.   IF choice=7 THEN WINDOW CLOSE 2:SCREEN CLOSE 1:END
  33.   CLS
  34.   pi=4*ATN(1)
  35.   dr=pi/180
  36.   hmin=0:hmax=631
  37.   lmin=0:lmax=386
  38.   hres=hmax-hmin:lres=lmax-lmin
  39.   hc=hmin+INT(hres/2)
  40.   IF choice=1 THEN 
  41.     lc=lmin+INT(19*lres/20)
  42.   ELSE
  43.     lc=lmin+INT(lres/2)
  44.   END IF
  45.  
  46.   IF choice=1 THEN
  47.     scaleh=24:scalev=4
  48.   ELSEIF choice=2 THEN
  49.     scaleh=30:scalev=7
  50.   ELSEIF choice=3 THEN
  51.     scaleh=16:scalev=8
  52.   ELSEIF choice=4 THEN
  53.     scaleh=16:scalev=14
  54.   ELSEIF choice=5 THEN
  55.     scaleh=6:scalev=6
  56.   ELSEIF choice=6 THEN
  57.     scaleh=100:scalev=100
  58.   END IF
  59.    
  60.   c1=ATN((lc-lmin)/(hmax-hc))
  61.   c2=pi-ATN((lc-lmin)/(hc-hmin))
  62.   c3=pi+ATN((lmax-lc)/(hc-hmin))
  63.   c4=2*pi-ATN((lmax-lc)/(hmax-hc))
  64.   LOCATE 5,10:PRINT "Choices of 15,-15,90 will roughly approximate the magazine"
  65.   LOCATE 6,10:PRINT "photos, but there are many other pictures just as interesting."
  66.   LOCATE 10,10:PRINT "The Amiga will beep when the drawing has been completed."
  67.   LOCATE 11,10:PRINT "Click the left mouse button to return to the main menu."
  68.   LOCATE 15,10:INPUT "Angles for x,y,z axes ";degx,degy,degz
  69.   CLS
  70.   degrees=degx
  71.   GOSUB degrees.to.radians
  72.   sinxa=SIN(a):cosxa=COS(a)
  73.   REM gosub draw.axis
  74.   degrees=degy
  75.   GOSUB degrees.to.radians
  76.   sinya=SIN(a):cosya=COS(a)
  77.   REM gosub draw.axis
  78.   degrees=degz
  79.   GOSUB degrees.to.radians
  80.   sinza=SIN(a):cosza=COS(a)
  81.   REM gosub draw.axis
  82.   IF choice=1 THEN 
  83.     GOSUB Parabloid
  84.   ELSEIF choice=2 THEN 
  85.     GOSUB Hyperbolic.Parabloid
  86.   ELSEIF choice=3 THEN 
  87.     GOSUB Cone
  88.   ELSEIF choice=4 THEN 
  89.     GOSUB OneSheet.Hyperbloid
  90.   ELSEIF choice=5 THEN 
  91.     GOSUB TwoSheet.Hyperbloid
  92.   ELSEIF choice=6 THEN 
  93.     GOSUB Ellipsoid
  94.   END IF
  95.  
  96. BEEP
  97. FOR dl=1 TO 30:NEXT dl
  98. BEEP
  99. WaitforClick:IF NOT MOUSE(0) THEN WaitforClick
  100. GOTO Make.Choice
  101.  
  102. Parabloid:
  103.   FOR ty=-6 TO 6 STEP 0.2
  104.     kolor=13
  105.     FOR tx=0 TO 6 STEP 0.2
  106.       tz=FNf1(tx,ty)
  107.       GOSUB project.and.scale
  108.       PSET(mh,mv),kolor
  109.     NEXT tx
  110.     kolor=12
  111.     FOR tx=-6 TO 0 STEP 0.075
  112.       tz=FNf1(tx,ty)
  113.       GOSUB project.and.scale
  114.       PSET(mh,mv),kolor
  115.     NEXT tx,ty
  116. RETURN
  117.  
  118. Hyperbolic.Parabloid:
  119.   FOR ty=-5 TO 5 STEP 0.2
  120.     kolor=13
  121.     FOR tx=0 TO 5 STEP 0.2
  122.       tz=FNf2(tx,ty)
  123.       GOSUB project.and.scale
  124.       PSET(mh,mv),kolor
  125.     NEXT tx
  126.     kolor=12
  127.     FOR tx=-5 TO 0 STEP 0.05
  128.       tz=FNf2(tx,ty)
  129.       GOSUB project.and.scale
  130.       PSET(mh,mv),kolor
  131.     NEXT tx,ty
  132. RETURN
  133.  
  134. Cone:
  135.   FOR ty=-6 TO 6 STEP 0.375
  136.     kolor=13
  137.     FOR tx=0 TO 6 STEP 0.25
  138.       tz=FNf3(tx,ty)
  139.       GOSUB project.and.scale
  140.       PSET(mh,mv),kolor
  141.       tz=-FNf3(tx,ty)
  142.       GOSUB project.and.scale
  143.       PSET(mh,mv),kolor
  144.     NEXT tx
  145.     kolor=12
  146.     FOR tx=-6 TO 0 STEP 0.1
  147.       tz=FNf3(tx,ty)
  148.       GOSUB project.and.scale
  149.       PSET(mh,mv),kolor
  150.       tz=-FNf3(tx,ty)
  151.       GOSUB project.and.scale
  152.       PSET(mh,mv),kolor
  153.     NEXT tx,ty
  154. RETURN
  155.  
  156. OneSheet.Hyperbloid:
  157.   FOR ty=-4 TO 4 STEP 0.25
  158.     FOR tx=-4 TO 4 STEP 0.1
  159.       IF tx*tx+ty*ty<2 THEN move.on :ELSE tz=FNf4(tx,ty)
  160.       GOSUB project.and.scale
  161.       IF tx<0 THEN kolor=12 :ELSE kolor=13
  162.       PSET(mh,mv),kolor
  163.       tz=-tz
  164.       GOSUB project.and.scale
  165.       PSET(mh,mv),kolor
  166.   move.on:
  167.     NEXT tx
  168.   NEXT ty
  169. RETURN
  170.  
  171. TwoSheet.Hyperbloid:
  172.   FOR ty=-20 TO 20 STEP 1
  173.     FOR tx=-20 TO 20 STEP 0.15
  174.       IF tx*tx+1>ty*ty THEN move.on1 :ELSE tz=FNf5(tx,ty)
  175.       GOSUB project.and.scale
  176.       IF tx<0 THEN kolor=12 :ELSE kolor=13
  177.       PSET(mh,mv),kolor
  178.       tz=-tz
  179.       GOSUB project.and.scale
  180.       PSET(mh,mv),kolor
  181.   move.on1:
  182.     NEXT tx
  183.   NEXT ty
  184. RETURN
  185.  
  186. Ellipsoid:
  187.   FOR ty=-0.99 TO 1 STEP 0.075
  188.     kolor=13
  189.     FOR tx=0.01 TO 1 STEP 0.015
  190.       IF tx*tx+ty*ty>=1 THEN skip :ELSE tz=FNf6(tx,ty)
  191.       GOSUB project.and.scale
  192.       PSET(mh,mv),kolor
  193.       tz=-tz
  194.       GOSUB project.and.scale
  195.       PSET(mh,mv),kolor
  196.   skip:
  197.     NEXT tx
  198.     kolor=12
  199.     FOR tx=-1 TO 0 STEP 0.0075
  200.       IF tx*tx+ty*ty>=1 THEN move.on2 :ELSE tz=FNf6(tx,ty)
  201.       GOSUB project.and.scale
  202.       PSET(mh,mv),kolor
  203.       tz=-tz
  204.       GOSUB project.and.scale
  205.       PSET(mh,mv),kolor
  206.  move.on2:
  207.     NEXT tx,ty
  208. RETURN
  209.  
  210. draw.axis:
  211.   tana=TAN(a)
  212.   GOSUB get.endpoint
  213.   h1=hz:l1=lz
  214.   degrees=degrees+180:GOSUB degrees.to.radians
  215.   GOSUB get.endpoint
  216.   h2=hz:l2=lz
  217.   LINE(h1,l1)-(h2,l2),kolor
  218. RETURN
  219.  
  220. degrees.to.radians:
  221.   WHILE degrees<0
  222.     degrees=degrees+360
  223.   WEND
  224.   WHILE degrees>=360
  225.     degrees=degrees-360
  226.   WEND
  227.   a=degrees*dr
  228. RETURN
  229.  
  230. get.endpoint:
  231.   IF a<=c1 OR a>c4 THEN hz=hmax:lz=lc-(hmax-hc)*tana:RETURN
  232.   IF a<=c2 THEN lz=lmin:hz=hc+(lc-lmin)/tana:RETURN
  233.   IF a<=c3 THEN hz=hmin:lz=lc+(hc-hmin)*tana:RETURN
  234.   IF a<=c4 THEN lz=lmax:hz=hc-(lmax-lc)/tana
  235. RETURN
  236.  
  237. project.and.scale:
  238.   px=tx*cosxa+ty*cosya+tz*cosza
  239.   py=tx*sinxa+ty*sinya+tz*sinza
  240.   mh=INT(hc+px*scaleh)
  241.   mv=INT(lc-py*scalev)
  242. RETURN
  243.   
  244.