home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 058.lha / 3DPlot1 (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1986-11-20  |  2.6 KB  |  109 lines
  1. start:
  2.   CLS
  3.   SCREEN 1,640,200,4,2
  4.   WINDOW 3,"3D-Surface",,0,1
  5.   PALETTE 0,0,0,0
  6.   PALETTE 2,1,1,0.47
  7.   PALETTE 3,1,0.8,0
  8.   PALETTE 4,1,0.6,0
  9.   PALETTE 5,1,0.4,0
  10.   PALETTE 6,0.8,0.8,0
  11.   PALETTE 7,0.4,0.93,0.13
  12.   PALETTE 8,0,1,0.6
  13.   PALETTE 9,0,0.8,0.8
  14.   PALETTE 10,0,0.4,0.8
  15.   PALETTE 11,0.4,0.2,1
  16.   PALETTE 12,0.6,0,1
  17.   PALETTE 13,0.6,0,0.8
  18.   PALETTE 14,0.4,0,0.6
  19.   PALETTE 15,0.2,0,0.4
  20.   DEFINT i-n:DIM ic(7),hm(7),xp(7),yp(7),wx(7),wy(7)
  21.   ic=0:id=0
  22.   PRINT "Choose plotting parameters"
  23.   PRINT "       (Suggested values in parenthesis)"
  24.   INPUT"Speed to plot (1 slowest)";sp
  25.   ln=512:mf=ln*2/3
  26. getpeaks:
  27.   INPUT"Number of peaks in field (1 to 7)";a$
  28.   np=VAL(a$):IF np<1 OR np>7 THEN getpeaks
  29.   lm=50
  30.   FOR i= 1 TO np
  31. circwaves:
  32.   PRINT"Peak #";i;", circular form waves (y/n)? ";
  33.   GOSUB getchar
  34.   PRINT 
  35.   ic(i)=0
  36.   IF a$="Y" THEN ic(i)=1
  37.   IF a$<>"N" AND a$<>"Y" THEN circwaves
  38.   PRINT "Peak #";i;", X position (0 to";mf;")";
  39.   INPUT a$:xp(i)=VAL(a$)
  40.   PRINT "Peak #";i;", Y position (0 to";mf;")";
  41.   INPUT a$:yp(i)=VAL(a$)
  42.   IF ic(i)=1 THEN m=mf/7 :ELSE m=mf/4.5
  43.   PRINT "Peak #";i;", X wave length (";m;")";
  44.   INPUT a$:wx(i)=6.28319/VAL(a$)
  45.   PRINT "Peak #";i;", Y wave length (";m;")";
  46.   INPUT a$:wy(i)=6.28319/VAL(a$)
  47.   m=lm+xp(i)-20
  48.   PRINT "Peak #"i", height multiplier (50 to"m")";
  49.   INPUT a$:hm(i)=VAL(a$)
  50.   NEXT i:CLS
  51.   di=1/8192:k=7:nc=0:mm=640
  52.   xscreen=0:yscreen=200
  53.   FOR i=1 TO ln STEP sp
  54.     il=2000:ih=-il
  55.     FOR j=1 TO mf
  56.       IF j>i THEN j=mf:GOTO skippoint
  57.       ix=(i-j)*2:IF ix>mf THEN skippoint
  58.       x=ix:Y=j:z=ix+lm
  59.       FOR n=1 TO np
  60.         x1=(x-xp(n))*wx(n)+di:y1=(Y-yp(n))*wy(n)+di
  61.         w=SQR(x1*x1+y1*y1)+di 
  62.         IF ic(n)=1 THEN 
  63.           z=z-SIN(w)/w*hm(n)  
  64.         ELSE 
  65.           z=z-SIN(x1)/x1*SIN(y1)/y1*hm(n)
  66.         END IF
  67.       NEXT n
  68.       iz=z
  69.       IF iz<0 OR iz>mm GOTO skippoint
  70.       IF iz>ih THEN
  71.         ih=iz
  72.         col=INT(w/2.5) AND 15
  73.         PSET(xscreen,iz/2.2),col-(col=0)
  74.       END IF
  75.       IF iz<il THEN
  76.         il=iz
  77.         col=INT(w/2.5) AND 15
  78.         PSET(xscreen,iz/2.2),col-(col=0)
  79.       END IF
  80. skippoint:
  81.       NEXT j
  82.     xscreen=xscreen+sp
  83.     NEXT i
  84.   LOCATE 20,5
  85. question:
  86.   PRINT "Finally done."
  87.   LOCATE 21,5
  88.   PRINT "Another one (Y/N)? ";
  89.   GOSUB getchar
  90.   IF a$="Y" THEN start
  91.   IF a$="N" THEN done
  92.   GOTO question
  93.   
  94. done:
  95.   WINDOW CLOSE 3
  96.   SCREEN CLOSE 1
  97.   END  
  98.   
  99. getchar:
  100.   a$=""
  101.   WHILE a$=""
  102.     a$=INKEY$  
  103.   WEND
  104.   a$=UCASE$(a$)
  105.   PRINT a$;
  106.   RETURN
  107.   
  108.   
  109.