home *** CD-ROM | disk | FTP | other *** search
/ A.N.A.L.O.G. Magazine 1986 May / 86_may.atr / bonsai3.lst < prev    next >
File List  |  2023-02-26  |  8KB  |  1 lines

  1. 5 REM *************************¢10 REM *       PERSPEC         *¢20 REM *  AUTOMATIC 3-D PLOT   *¢30 REM *      PROGRAMME        *¢40 REM *************************¢70 REM ¢80 GOTO 20000¢440 REM ##########################¢441 REM #         BEGIN          #¢442 REM ##########################¢450 X(0)=VX:Y(0)=VY:Z(0)=VZ:D0=1¢490 DX=VX-OX:DY=VY-OY:DZ=VZ-OZ¢495 POKE 559,0¢500 U1=SQR(DX*DX+DY*DY+DZ*DZ):IF U1=0 THEN U1=1E-06¢510 CX=DX/U1:CY=DY/U1:CZ=DZ/U1¢520 S3=SQR(1-CZ*CZ):S2=SQR(1-CY*CY)¢530 QX=OX+D0*CX:QY=OY+D0*CY:QZ=OZ+D0*CZ¢540 XW=X(0):YW=Y(0):ZW=Z(0):GOSUB 610¢541 FOR I=1 TO PS:XW=X(I)*SCL+XS:YW=Y(I)*SCL+YS:ZW=Z(I)*SCL+ZS:GOSUB 610:NEXT I¢549 I=0:IF VIS(I)<>0 THEN XW=X(0):YW=Y(0):ZW=Z(0):GOSUB 610:GOSUB 670¢550 FOR I=1 TO PS:IF VIS(I)=0 THEN 570¢560 XW=X(I)*SCL+XS:YW=Y(I)*SCL+YS:ZW=Z(I)*SCL+ZS:GOSUB 610:GOSUB 670¢570 NEXT I:GOTO 740¢580 REM ***************************¢590 REM *  IS THE POINT VISIBLE?  *¢600 REM ***************************¢610 VIS(I)=1:VCX=XW-OX:VCY=YW-OY:VCZ=ZW-OZ¢620 IF DX*VCX+DY*VCY+DZ*VCZ>0 THEN RETURN ¢630 VIS(I)=0:RETURN ¢640 REM ***************************¢650 REM *  NOW CALC PLOT COORDS   *¢660 REM ***************************¢670 K=D0/(VCX*CX+VCY*CY+VCZ*CZ)¢680 AX=OX+K*VCX:AY=OY+K*VCY:AZ=OZ+K*VCZ¢690 IF S3=0 THEN 720¢700 P(I,1)=((AX-QX)*CY-(AY-QY)*CX)/S3¢710 P(I,2)=(AZ-QZ)/S3:RETURN ¢720 P(I,1)=((QX-AX)*CZ+(AZ-QZ)*CX)/S2¢730 P(I,2)=(AY-QY)/S2:RETURN ¢740 REM ***************************¢750 REM *     SCALE THE IMAGE     *¢760 REM ***************************¢770 T=450*ZOOM:FOR I=0 TO PS¢780 P(I,1)=P(I,1)*T¢790 P(I,2)=P(I,2)*T¢800 NEXT I¢810 XAD=160-P(0,1):YAD=96-P(0,2):FOR I=1 TO PS:P(I,1)=P(I,1)+XAD:P(I,2)=P(I,2)+YAD:NEXT I¢820 REM ***************************¢830 REM *   NOW DRAW THE IMAGE!   *¢840 REM ***************************¢845 SETCOLOR 2,0,0:COLOR 1:TRAP OFF:GRAPHICS 56¢870 FOR I=1 TO LS:TV=VIS(LN(I,0))+VIS(LN(I,1)):IF TV=0 THEN 1010¢880 IF TV=2 THEN 980¢890 QT=0:ISAVE=I:IF VIS(LN(I,0))=0 THEN I1=LN(I,0):I2=LN(I,1):I=LN(I,0):GOTO 910¢900 I1=LN(I,1):I2=LN(I,0):I=LN(I,1)¢910 XT1=X(I1)*SCL+XS:YT1=Y(I1)*SCL+YS:ZT1=Z(I1)*SCL+ZS¢911 XT2=X(I2)*SCL+XS:YT2=Y(I2)*SCL+YS:ZT2=Z(I2)*SCL+ZS:FV=0:FH=0¢920 XW=(XT1+XT2)/2:YW=(YT1+YT2)/2:ZW=(ZT1+ZT2)/2:GOSUB 610¢930 IF VIS(I)>0 THEN XT2=XW:YT2=YW:ZT2=ZW:GOTO 950¢940 XT1=XW:YT1=YW:ZT1=ZW¢950 QT=QT+1:IF QT<15 THEN 920¢960 XW=XT2:YW=YT2:ZW=ZT2:GOSUB 610¢970 GOSUB 670:P(I,1)=P(I,1)*T+XAD:P(I,2)=P(I,2)*T+YAD:VIS(I)=0:I=ISAVE¢980 X1=P(LN(I,0),1):Y1=191-P(LN(I,0),2):X2=P(LN(I,1),1):Y2=191-P(LN(I,1),2)¢981 W=LN(I,2):XC=X1:YC=Y1:X=X2:Y=Y2¢982 KK=((X(I1)+X(I2))/2+XS-OX)^2+((Y(I1)+Y(I2))/2+YS-OY)^2+((Z(I1)+Z(I2))/2+ZS-OZ)^2¢983 W=6*W*KK^-0.5:GOSUB 3000¢1010 NEXT I¢1011 IF O$="Y" THEN ? #3;"H"¢1030 FOR X=15 TO 0 STEP -1:SOUND 0,120,10,X:NEXT X¢1040 RETURN ¢1190 ? :? "}I/O ERROR - ";PEEK(195):GOTO 1210¢1210 ? :? "PRESS פדקרפמ":INPUT IN$:STOP ¢1550 REM ***************************¢1560 REM *  GRAPHICS CLIP ROUTINE  *¢1570 REM ***************************¢1580 L1=0:L2=0:R1=0:G(10)=0:T1=0:T2=0:G(9)=0:G(8)=0:POK=0¢1590 IF X1<G(7) THEN L1=1:GOTO 1610¢1600 IF X1>G(6) THEN R1=1¢1610 IF Y1>G(5) THEN G(9)=1:GOTO 1630¢1620 IF Y1<YT THEN T1=1¢1630 IF X2<G(7) THEN L2=1:GOTO 1650¢1640 IF X2>G(6) THEN G(10)=1¢1650 IF Y2>G(5) THEN G(8)=1:GOTO 1670¢1660 IF Y2<YT THEN T2=1¢1670 IF L1+L2=2 OR R1+G(10)=2 OR T1+T2=2 OR G(9)+G(8)=2 THEN RETURN ¢1680 G(4)=X1:G(3)=Y1:G(2)=X2:G(1)=Y2:GOSUB 1730¢1690 L1=L2:R1=G(10):T1=T2:G(9)=G(8)¢1700 X1=XW:Y1=YW:G(4)=X2:G(3)=Y2:G(2)=X1:G(1)=Y1:GOSUB 1730¢1710 IF X1<G(7) OR X1>G(6) OR Y1<YT OR Y1>G(5) OR XW<G(7) OR XW>G(6) OR YW<YT OR YW>G(5) THEN RETURN ¢1720 PLOT X1,SCY*Y1:DRAWTO XW,SCY*YW:POK=1:RETURN ¢1730 IF L1+T1+G(9)+R1=0 THEN XW=G(4):YW=G(3):RETURN ¢1740 IF L1 THEN XW=G(7):YW=G(3)+(G(1)-G(3))*(G(7)-G(4))/(G(2)-G(4)):G(4)=XW:G(3)=YW¢1742 IF L1 AND G(3)>=YT AND G(3)<=G(5) THEN RETURN ¢1750 IF R1 THEN XW=G(6):YW=G(3)+(G(1)-G(3))*(G(6)-G(4))/(G(2)-G(4)):G(4)=XW:G(3)=YW¢1752 IF R1 AND G(3)>=YT AND G(3)<=G(5) THEN RETURN ¢1760 IF G(9) THEN YW=G(5):XW=G(4)+(G(2)-G(4))*(G(5)-G(3))/(G(1)-G(3)):G(4)=XW:G(3)=YW¢1762 IF G(9) AND G(4)>=G(6) AND G(4)<=G(7) THEN RETURN ¢1770 IF T1 THEN YW=YT:XW=G(4)+(G(2)-G(4))*(YT-G(3))/(G(1)-G(3)):G(4)=XW:G(3)=YW¢1780 RETURN ¢2000 REM ***********************¢2010 REM *      GET FILE       *¢2020 REM ***********************¢2025 F$=DRIVE$:F$(LEN(F$)+1)=FILE$:FF$=F$¢2060 F$(LEN(F$)+1)=".PNT":CLOSE #1:OPEN #1,4,0,F$:INPUT #1;PS¢2080 TRAP 2100:DIM X(PS),Y(PS),Z(PS),P(PS,2),VIS(PS)¢2100 FOR X=1 TO PS:INPUT #1,Q1:X(X)=Q1:NEXT X¢2110 FOR X=1 TO PS:INPUT #1,Q1:Y(X)=Q1:NEXT X¢2120 FOR X=1 TO PS:INPUT #1,Q1:Z(X)=Q1:NEXT X:CLOSE #1¢2170 F$=FF$:F$(LEN(F$)+1)=".LIN":CLOSE #1:OPEN #1,4,0,F$:INPUT #1;LS¢2190 TRAP 2210:DIM LN(LS,2)¢2210 FOR X=1 TO LS:INPUT #1,Q1:LN(X,0)=Q1:INPUT #1,Q1:LN(X,1)=Q1:INPUT #1,Q1:LN(X,2)=Q1:NEXT X¢2240 CLOSE #1:TRAP OFF:RETURN ¢2250 ? :? "}CAN'T OPEN FILE!":GOTO 1210¢2260 ? :? "}FILE FORMAT ERROR - ";PEEK(195):GOTO 1210¢2700 REM **********************¢2701 REM *       ROTATE       *¢2702 REM **********************¢2705 POKE 559,0:XC=0:YC=0¢2720 FOR J=1 TO PS:X=X(J):Y=Y(J):GOSUB 3100¢2740 X(J)=XC+R*COS(THETA+PHI)¢2750 Y(J)=YC+R*SIN(THETA+PHI)¢2760 NEXT J¢2770 RETURN ¢2996 REM **********************¢2997 REM *       WIDE         *¢2999 REM **********************¢3000 IF (X=XC) AND (Y=YC) THEN RETURN ¢3010 GOSUB 3070¢3040 IF ABS(XS0)>ABS(YS0) THEN XS0=-SIN(PHI)/COS(PHI):YS0=1:GOTO 3060¢3050 YS0=COS(PHI)/SIN(PHI):XS0=-1¢3051 IF (W<0.4) OR (SD$="N") THEN GOSUB 1550:FOR J=1 TO 1:GOTO 3061¢3060 FOR J=-W/2 TO W/2 STEP 0.4:X1=XC+J*XS0:Y1=YC+J*YS0:X2=XC+J*XS0+R*COS(PHI):Y2=YC+J*YS0+R*SIN(PHI):GOSUB 1550¢3061 IF O$="N" OR POK=0 THEN NEXT J:RETURN ¢3062 IF SD$="Y" THEN 3064¢3063 ? #3;"M";X1*1.5;",";(191-Y1)*1.5;"*D";XW*1.5;",";(191-YW)*1.5:PC=PC+1:RETURN ¢3064 ? #3;"M";2.5*(191-Y1);",";-2.5*X1;"*D";2.5*(191-YW);",";-2.5*XW:PC=PC+1¢3065 NEXT J:RETURN ¢3070 REM **********************¢3080 REM *        ATAN        *¢3090 REM **********************¢3100 DEG :XS0=X-XC:YS0=Y-YC:R=(XS0*XS0+YS0*YS0)^0.5:PH=180¢3110 IF XS0=0 THEN PHI=PH/2+(SGN(YS0)<>1)*PH:RETURN ¢3120 PHI=ATN(YS0/XS0):IF SGN(XS0)=1 THEN PHI=2*PH*(SGN(YS0)=-1)+PHI:RETURN ¢3130 PHI=PH+PHI:RETURN ¢3200 REM *************************¢3201 REM *    PLOTTER CONTROL    *¢3202 REM *************************¢3210 O$="Y"¢3220 CLOSE #3:OPEN #3,8,0,"P:":? #3;EG$:PC=0¢3240 RETURN ¢3245 O$="N":CLOSE #3:RETURN ¢3250 ? #3;"C1":RETURN ¢3251 ? #3;"C2":RETURN ¢3253 ? #3;"C3":RETURN ¢3254 ? #3;"C0":RETURN ¢3260 IF O$<>"Y" THEN RETURN ¢3261 IF SD$="Y" THEN ? #3;"H*M0,-900*I":RETURN ¢3262 ? #3;"H*M0,-480*I":RETURN ¢3271 IF O$="Y" AND SD$="Y" THEN ? #3;"M0,0*D480,0*D480,-800*D0,-800*D0,0":RETURN ¢3280 IF O$="Y" THEN ? #3;"M0,0*D480,0*D480,288*D0,288*D0,0"¢3290 RETURN ¢4000 REM ******EPSON DUMP*********¢4010 SCREEN=PEEK(88)+PEEK(89)*256:TRAP 4040:CLOSE #1:OPEN #1,8,0,"P:":? #1;"A";CHR$(8)¢4020 FOR I=SCREEN TO SCREEN+39:? #1;"K";CHR$(192);CHR$(0);¢4030 FOR J=I+7640 TO I STEP -40:PUT #1,PEEK(J):NEXT J:? #1:NEXT I:CLOSE #1¢4035 STOP ¢4040 RETURN ¢5000 F$=DRIVE$:F$(LEN(F$)+1)=FILE$:FF$=F$¢5010 CLOSE #1:OPEN #1,4,0,F$:INPUT #1;PS¢5020 TRAP 5030:DIM X(PS),Y(PS),Z(PS),P(PS,2),VIS(PS)¢5030 FOR X=1 TO PS:INPUT #1,Q1:X(X)=Q1:NEXT X¢5040 FOR X=1 TO PS:INPUT #1,Q1:Y(X)=Q1:NEXT X¢5050 FOR X=1 TO PS:INPUT #1,Q1:Z(X)=Q1:NEXT X:CLOSE #1¢5060 INPUT #1;LS¢5070 TRAP 5080:DIM LN(LS,2)¢5080 FOR X=1 TO LS:INPUT #1,Q1:LN(X,0)=Q1:INPUT #1,Q1:LN(X,1)=Q1:LN(X,2)=WIDTH:NEXT X¢5090 CLOSE #1:TRAP OFF:RETURN ¢5100 SD$="Y":GOSUB PLOTON:RETURN ¢5200 SD$="N":GOSUB PLOTON:RETURN ¢20000 SCY=11/13:DIM O$(1),EG$(2),SD$(1),G(10):EG$=CHR$(27):EG$(2)=CHR$(7)¢20010 DIM DRIVE$(3),FILE$(8),FF$(20),F$(20),IN$(1),F1$(20)¢20020 G(7)=0:G(6)=319:YT=0:G(5)=191:OFF=40000¢20030 LET GETFILE=2025:LET GO=450:ROTATE=2705:LET PLOTON=3210:DUMP=4010:BIG=5100:SMALL=5200:LET PLOTOFF=3245¢20031 OLDFILE=5000:RED=3253:BLUE=3250:GREEN=3251:BLACK=3254:PAGE=3260:FRAME=3271¢29995 REM **********************¢29996 REM *    YOUR DISPLAY    *¢29997 REM *   PROGRAMME GOES   *¢29998 REM *        HERE        *¢29999 REM **********************¢