home *** CD-ROM | disk | FTP | other *** search
- 0 '
- 10 title$=" 3D-Molecules "
- 20 title$=chr$(32)+chr$(14)+chr$(15)+title$
- 30 title$=title$+chr$(14)+chr$(15)+chr$(32)
- 40 poke systab+24,1
- 50 a#=gb
- 60 gintin=peek(a#+8)
- 70 poke gintin+0,peek(systab+8)
- 80 poke gintin+2,2
- 90 s#=gintin+4
- 100 title$=title$+chr$(0)
- 110 poke s#,varptr(title$)
- 120 gemsys(105)
- 130 poke systab+24,0:IF EX=1 THEN END
- 140 ' This program and the data files that come with it originally
- 150 ' were downloaded from BYTENET LISTINGS. The program was
- 160 ' originally designed for the IBM-PC. I made the necessary
- 170 ' modifications so as to take full advantage of the 520ST
- 180 ' the modifications involved removing almost HALF of the
- 190 ' program because so much was already a part of ST BASIC
- 200 ' Run the program in LOW res only. Look for a monochrome
- 210 ' version & other converted PC-programs soon.
- 220 ' The BYTE article covering this program is in the FEB-86 issue.
- 230 ' In there they say it takes a PC 20-40 seconds to do the plot.
- 240 ' It only takes the ST 4-15 seconds!!!!!!!! Don't knock ST BASIC.
- 250 ' It is much more powerful than you think!
- 260 '
- 270 ' For the 'phi' and 'theta' values use 0,0 at first
- 280 ' 'phi' rotates in horizontal plane
- 290 ' 'theta' rotates in vertical plane
- 300 ' ********* COLOR3D.BAS *********
- 310 ' Draws a 3D, perspective image of a molecule on IBM PCs with BASICA.
- 320 ' ********* NOW for Atari 520/1040 ST *********
- 330 ' For private, noncommercial use only.
- 340 ' John J. Farrell *** April 1, 1985
- 350 ' Inspired by Earl Kirkland's MODEL3D.BAS for the Mac, BYTE, Feb. 1985.
- 360 '
- 370 ' ****** Atari 520/1040 ST Adaptation by Britton W. Robbins
- 380 ' ****** PO BOX 85152 MB 227
- 390 ' ****** February 2,1986 San Diego, CA 92138
- 400 COLOR 1,0,1,1,1
- 410 fullw 2:clearw 2:' clear screen for graphics
- 420 color 1,0,1,1,1
- 430 DEFINT I-N: DEFSNG O-Z: DEFSNG A-G
- 440 DIM X(200), Y(200), Z(200), S(200), COL(200),COLPAT(200)
- 450 '
- 460 ' Ask for input parameters.
- 470 GOTOXY 1,1:?"ENTER Q TO QUIT.":?:?:?
- 480 INPUT "Data file name:", FILE$:FILE$=FILE$+".DAT"
- 490 IF FILE$="Q.DAT" OR FILE$="q.DAT"THEN CLEARW 2:EX=1:title$="OUTPUT":goto 40
- 500 INPUT "Azim., polar angles (phi, theta):", PHI, THETA
- 510 INPUT "Viewing distance:",VIEWD
- 520 INPUT "Size magnitude:",SMAG
- 530 SMAG = 1.15*SMAG
- 540 ' DISTORT is used later to account for fact that one unit of x
- 550 ' on screen (horizonal) is not equal to one unit of z (vertical).
- 560 DISTORT = 1.2
- 570 ' Convert degrees to radians.
- 580 PHI = PHI*3.14159/180!: THETA = THETA*3.14159/180!
- 590 CP = COS(PHI): SP = SIN(PHI): CT = COS(THETA): ST = SIN(THETA)
- 600 '
- 610 OPEN "I",#1,FILE$
- 620 ' Set xmin very large and xmax very small.
- 630 XMIN = 1000000!: XMAX = -XMIN: YMIN = XMIN: YMAX = XMAX
- 640 ZMIN = XMIN: ZMAX = XMAX: N = 0
- 650 ' Read data file: color, x,y,z (atomic coords),r (Angstroms).
- 660 WHILE NOT EOF(1)
- 670 N = N + 1
- 680 INPUT #1,COLPAT(N), X(N),Y(N), Z(N), S(N)
- 690 ' Find maximum and minimum values for x,y,z.
- 700 IF X(N) > XMAX THEN XMAX = X(N)
- 710 IF X(N) < XMIN THEN XMIN = X(N)
- 720 IF Y(N) > YMAX THEN YMAX = Y(N)
- 730 IF Y(N) < YMIN THEN YMIN = Y(N)
- 740 IF Z(N) > ZMAX THEN ZMAX = Z(N)
- 750 IF Z(N) < ZMIN THEN ZMIN = Z(N)
- 760 WEND
- 770 PRINT N "atoms"
- 780 PRINT "rotating..."
- 790 ' Find center values for x,y,z.
- 800 XCEN = .5*(XMAX+XMIN): YCEN = .5*(YMIN + YMAX): ZCEN = .5*(ZMIN+ZMAX)
- 810 ' Rotate molecule around its center.
- 820 FOR I = 1 TO N
- 830 XA = X(I) - XCEN: YA = Y(I) - YCEN
- 840 X(I) = CP*XA+SP*YA: Y(I) = -SP*XA+CP*YA
- 850 YA = Y(I): ZA = Z(I) - ZCEN
- 860 Y(I) = CT*YA+ST*ZA: Z(I) = -ST*YA+CT*ZA
- 870 IF VIEWD < Y(I) THEN CLEARW 2:?"Viewing distance is within molecule!";
- 880 IF VIEWD < Y(I) THEN ?" Rerun with a larger viewing distance.":goto 1270
- 890 NEXT I: PRINT "sorting..."
- 900 '
- 910 ' Sort by depth (shell sort).
- 920 IGAP = INT(CSNG(N)/2!)
- 930 WHILE IGAP >= 1
- 940 FOR I = IGAP +1 TO N
- 950 FOR J = I-IGAP TO 1 STEP -IGAP
- 960 JG = J + IGAP
- 970 IF Y(J) <= Y(JG) THEN GOTO 1020
- 980 SWAP X(J),X(JG): SWAP Y(J), Y(JG)
- 990 SWAP Z(J), Z(JG): SWAP S(J), S(JG)
- 1000 SWAP COL(J), COL(JG): SWAP COLPAT(J), COLPAT(JG)
- 1010 NEXT J
- 1020 NEXT I
- 1030 IGAP = INT(CSNG(IGAP)/2!)
- 1040 WEND
- 1050 '
- 1060 clearw 2
- 1070 ' Perspective projection and scale coordinates.
- 1080 SCALE = -1000000!: SMAX = SCALE
- 1090 FOR I = 1 TO N
- 1100 YA = 1!/(VIEWD - Y(I)): X(I) = X(I) *YA: Z(I) = Z(I) * YA: S(I) = S(I)*YA
- 1110 IF SCALE < ABS(X(I)) THEN SCALE = ABS(X(I))
- 1120 IF SCALE < ABS(Z(I)) THEN SCALE = ABS(Z(I))
- 1130 IF SMAX <S(I) THEN SMAX = S(I)
- 1140 NEXT I: SCALE = 75!/(SCALE + .5*SMAX*SMAG)
- 1150 SCALEX = SCALE*DISTORT
- 1160 '
- 1170 FOR I = 1 TO N
- 1180 ' Find screen x (ix) and screen z (iz) and screen radius (ir).
- 1190 ' Center of screen is x = 160 and z = 85.
- 1200 IX = INT(X(I)*SCALEX+ 160!): IZ = INT(Z(I)*SCALE + 85!)
- 1210 IR = INT(S(I)*SCALE*SMAG): IRZ = IR/DISTORT
- 1220 COL = COL(I): COLPAT = COLPAT(I)
- 1230 GOSUB 1300
- 1240 NEXT I
- 1250 CLOSE 1
- 1260 IF NOT INP(-2) THEN 1260
- 1270 CLEAR:GOTO 0
- 1280 ' Draw patterned circles at ix,iz with radius ir.
- 1290 ' Draw a blank circle in background color with negative outline
- 1300 color 1,1,1,2,8:PCIRCLE IX,IZ,IR+1
- 1310 FILCOL=COLPAT:FILX=IX:FILY=IZ:GOSUB 1330:'FILL IX,IZ-IRZ+1:FILL IX,IZ+IRZ-1
- 1320 RETURN
- 1330 ON FILCOL GOSUB 1350,1360,1370,1380,1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510,1520,1530,1540,1550,1560,1570,1580
- 1340 RETURN
- 1350 COLOR 1,2,2,2,1:FILL FILX,FILY:RETURN
- 1360 COLOR 1,3,3,2,1:FILL FILX,FILY:RETURN
- 1370 COLOR 1,4,4,2,1:FILL FILX,FILY:RETURN
- 1380 COLOR 1,5,5,2,1:FILL FILX,FILY:RETURN
- 1390 COLOR 1,6,6,2,1:FILL FILX,FILY:RETURN
- 1400 COLOR 1,7,7,2,1:FILL FILX,FILY:RETURN
- 1410 COLOR 1,8,8,2,1:FILL FILX,FILY:RETURN
- 1420 COLOR 1,9,9,2,1:FILL FILX,FILY:RETURN
- 1430 COLOR 1,10,10,2,1:FILL FILX,FILY:RETURN
- 1440 COLOR 1,11,11,2,1:FILL FILX,FILY:RETURN
- 1450 COLOR 1,12,12,2,1:FILL FILX,FILY:RETURN
- 1460 COLOR 1,13,13,2,1:FILL FILX,FILY:RETURN
- 1470 COLOR 1,14,14,2,1:FILL FILX,FILY:RETURN
- 1480 COLOR 1,15,15,2,1:FILL FILX,FILY:RETURN
- 1490 COLOR 1,2,2,5,2:FILL FILX,FILY:RETURN
- 1500 COLOR 1,3,3,5,2:FILL FILX,FILY:RETURN
- 1510 COLOR 1,4,4,5,2:FILL FILX,FILY:RETURN
- 1520 COLOR 1,5,5,5,2:FILL FILX,FILY:RETURN
- 1530 COLOR 1,6,6,5,2:FILL FILX,FILY:RETURN
- 1540 COLOR 1,7,7,5,2:FILL FILX,FILY:RETURN
- 1550 COLOR 1,8,8,5,2:FILL FILX,FILY:RETURN
- 1560 COLOR 1,9,9,5,2:FILL FILX,FILY:RETURN
- 1570 COLOR 1,10,12,5,2:FILL FILX,FILY:RETURN
- 1580 COLOR 1,11,11,5,2:FILL FILX,FILY:RETURN
-