This is non-commercial site, its content is based on Atari 8-bit home computer contents and references.
If you feel your rights are violated by showing/using any part of contents of your product represented on this page,
please contact me immediatelly so I can remove it!
Atari 8-bit Source code
|
|
-
Entry name:CAD - Jet
-
Category:Graphics
-
Publisher/Developer:ABBUC e.V., Flop 6
Listing 1
1 REM 3-D-GRAPHIK
2 REM WM WONDERMIKE SOFTWARE!
3 REM EXCLUSIVE FOR ATARI BIT BYTER
5 REM PRELOZENO PRO FLOP
7 REM ************************
8 REM * PRIPRAVA *
9 REM ************************
10 GRAPHICS 18:SETCOLOR 4,0,6
15 POSITION 3,2:? #6;"c a d j e t"
20 POSITION 4,5:? #6;""
30 POSITION 3,6:? #6;"_____________"
40 POSITION 1,9:? #6;""
100 DIM X(80),Y(80),Z(80),U(80),V(80),I(200)
110 DEG:F=1:PERS=1:DARST=1860:ABST=400
120 A=COS(30):B=SIN(30)
130 C=COS(15):D=SIN(15)
140 XB=319:YB=191:XO=159:UO=159:VO=79
197 REM **********************
198 REM * CTENI DAT *
199 REM **********************
200 RESTORE 7000:READ N,M
210 RESTORE 6000:REM ZNAKOVE PRIKAZY
220 FOR J=1 TO M
230 READ ZB
240 I(J)=ZB
250 NEXT J:GOTO 260
255 IF TF=0 THEN GOSUB 1945
256 ? "":?:? " ** Zpatky do pocatecniho stavu **"
260 RESTORE 5000:REM rozek
270 FOR I=1 TO N
280 READ X,Y,Z
290 X(I)=X:Y(I)=Y:Z(I)=Z
300 NEXT I
390 GOSUB DARST:REM PERSPEKTIVA
397 REM **********************
398 REM * MENUE *
399 REM **********************
400 GOSUB 1945
405 ? "":? "pred prava ad ikmo ";
410 IF DARST=1710 THEN ? ",";
420 IF DARST=1760 THEN ? ",";
430 IF DARST=1810 THEN ? ",";
440 IF DARST=1860 THEN ? ",";
450 IF PERS=1 THEN ? "-zap"
460 IF PERS=0 THEN ? "-vyp"
470 ? " arva zap/vyp erspektiva zap/vyp"
480 ? "-toceni-tazeni-zrcad.-posuv";
490 GOSUB 600:REM Klavesnice
500 IF R=ASC("V") THEN GOSUB 1700
510 IF R=ASC("Z") THEN GOSUB 1750
520 IF R=ASC("N") THEN GOSUB 1800
530 IF R=ASC("S") THEN GOSUB 1850
540 IF R=ASC("1") THEN GOSUB 1400
550 IF R=ASC("2") THEN GOSUB 1100
555 IF R=ASC("3") THEN GOSUB 1300
560 IF R=ASC("4") THEN GOSUB 900
570 IF R=ASC("B") THEN GOSUB 800
575 IF R=ASC("P") THEN GOSUB 770
580 IF R=ASC("T") THEN GOSUB 1930
585 IF R=125 THEN GOTO 255
590 GOTO 400
597 REM **********************
598 REM * KLAVESNICE *
599 REM **********************
600 TRAP 650:POKE 694,0:POKE 702,64
610 POKE 764,255
620 OPEN #1,4,0,"K:":GET #1,R
630 IF PEEK(753)=3 THEN 630
640 TRAP 50000:POKE 764,255
650 CLOSE #1:RETURN
697 REM **********************
698 REM * TRANSFORMACE *
699 REM **********************
700 FOR I=1 TO N
710 X=X(I):Y=Y(I):Z=Z(I)
720 X(I)=PX*X+PY*Y+PZ*Z+PT
730 Y(I)=QX*X+QY*Y+QZ*Z+QT
740 Z(I)=RX*X+RY*Y+RZ*Z+RT
750 NEXT I
760 RETURN
764 REM **********************
765 REM * PERSPEKTIVA ZAP/VYP*
766 REM **********************
770 IF TF=0 THEN GOSUB 1945
775 ? "":? "**** Prave prepnuto ****"
780 IF PERS=0 THEN PERS=1:GOSUB DARST:RETURN
790 PERS=0:GOSUB DARST:RETURN
794 REM **********************
795 REM * BARVA ZAP/VYP *
796 REM **********************
800 IF TF=0 THEN GOSUB 1945
805 ? "":? " **** Prave prepnuto ****"
810 IF F=1 THEN F=2:GOTO 820
815 F=1
820 XB=INT(319/F):UO=INT(XO/F)
825 GOSUB DARST:RETURN
844 REM *********************
845 REM * NASTAVENI PARAM. *
846 REM *********************
850 PX=1:PY=0:PZ=0:PT=0
860 QX=0:QY=1:QZ=0:QT=0
870 RX=0:RY=0:RZ=1:RT=0
880 RETURN
897 REM **********************
898 REM * TRANSLACE *
899 REM **********************
900 GOSUB 850:IF TF=0 THEN GOSUB 1945
910 ? "":? "Posunuti: (ESC -->Menu)"
920 ?:? " In -,-,-Smer posunuti?";
930 GOSUB 600
940 IF R=ASC("X") THEN T=1:GOTO 980
950 IF R=ASC("Y") THEN T=2:GOTO 980
960 IF R=ASC("Z") THEN T=3:GOTO 980
965 IF R=27 THEN RETURN
970 ? "";:GOTO 930
980 TRAP 1030
985 ? "":? "Posunuti ve smeru ";CHR$(R);
990 ?:? "Jak daleko ";:INPUT STR
995 IF STR=0 THEN RETURN
1000 TRAP 50000
1010 ? "":?:? " ******* hned to bude ! ******"
1020 ON T GOTO 1050,1060,1070
1030 ? "":GOTO 980
1050 PT=STR:GOTO 1080
1060 QT=STR:GOTO 1080
1070 RT=STR
1080 GOSUB 700:GOSUB DARST:RETURN
1097 REM *********************
1098 REM * PROTAZENI *
1099 REM *********************
1100 GOSUB 850:IF TF=0 THEN GOSUB 1945
1105 ? "":? "Protazeni: (ESC -->Menu)":?
1110 ? " Zmena velikosti nebo "
1115 ? " protazeni ve smeru ,- nebo ?";
1120 GOSUB 600:REM klavesnice
1130 IF R=ASC("G") THEN T=1:GOTO 1175
1140 IF R=ASC("X") THEN T=2:GOTO 1180
1150 IF R=ASC("Y") THEN T=3:GOTO 1180
1155 IF R=ASC("Z") THEN T=4:GOTO 1180
1160 IF R=27 THEN RETURN
1170 ? "";:GOTO 1120
1175 ? "":? "Zvetseni / zmenseni:":?:GOTO 1190
1180 ? "":? "Protazeni ve smeru";CHR$(R);":":?
1190 TRAP 1230:? "V jakem pomeru";:INPUT FAK
1195 IF FAK=1 THEN RETURN
1200 TRAP 50000
1210 ? "":?:? " ********* makam ! ********"
1220 ON T GOTO 1240,1250,1260,1270
1230 ? "":GOTO 1130
1240 PX=FAK:QY=PX:RZ=PX:GOTO 1280
1250 PX=FAK:GOTO 1280
1260 QY=FAK:GOTO 1280
1270 RZ=FAK
1280 GOSUB 700:GOSUB DARST:RETURN
1297 REM *********************
1298 REM * ZRCADLENI *
1299 REM *********************
1300 GOSUB 850:IF TF=0 THEN GOSUB 1945
1305 ? "":? "Zrcadleni : (ESC -->Menu":?
1310 ? " redni/zadni eva/prava"
1315 ? " orni/dolni sechny smery";
1320 GOSUB 600
1330 IF R=ASC("P") THEN PX=-1:GOTO 1390
1340 IF R=ASC("L") THEN QY=-1:GOTO 1390
1350 IF R=ASC("H") THEN RZ=-1:GOTO 1390
1360 IF R=ASC("V") THEN GOTO 1380
1365 IF R=27 THEN RETURN
1370 ? "";:GOTO 1320
1380 PX=-1:QY=-1:RZ=-1
1390 ? "":? "***** Okamzicek, prosim ...! *****"
1395 GOSUB 700:GOSUB DARST:RETURN
1397 REM *********************
1398 REM * OTACENI *
1399 REM *********************
1400 GOSUB 850:IF TF=0 THEN GOSUB 1945
1410 ? "":? "Otoceni: (ESC --> Menu)"
1415 ?:? "Ve ktere ose? (,,)";
1420 GOSUB 600
1430 IF R=ASC("X") THEN T=1:GOTO 1470
1440 IF R=ASC("Y") THEN T=2:GOTO 1470
1450 IF R=ASC("Z") THEN T=3:GOTO 1470
1455 IF R=27 THEN RETURN
1460 ? "";:GOTO 1420
1470 TRAP 1520
1480 ? "":? "Otoceni v ose ";CHR$(R);":"
1490 ?:? "O jaky uhel";:INPUT ALPHA
1495 IF ALPHA=0 THEN RETURN
1500 ? "":? " **** Prosim, poseckejte ****"
1510 ON T GOTO 1530,1550,1570
1520 ? "":GOTO 1470
1530 PX=1:QY=COS(ALPHA):QZ=SIN(ALPHA)
1540 RY=-QZ:RZ=QY:GOTO 1590
1550 QY=1:PX=COS(ALPHA):RX=SIN(ALPHA)
1560 PZ=-RX:RZ=PX:GOTO 1590
1570 RZ=1:PX=COS(ALPHA):PY=SIN(ALPHA)
1580 QX=-PY:QY=PX
1590 TRAP 50000:GOSUB 700:GOSUB DARST:RETURN
1697 REM *********************
1698 REM * ZEPREDU *
1699 REM *********************
1700 IF DARST=1710 THEN RETURN
1704 IF TF=0 THEN GOSUB 1945
1705 ? "":? " **** Male strpeni prosim! ****"
1710 P=1
1715 FOR I=1 TO N
1720 IF PERS=1 THEN P=ABST/(ABST-X(I))
1730 U(I)=UO+P*Y(I)/F:V(I)=VO-P*Z(I)
1740 NEXT I:DARST=1710:GOTO 2000
1747 REM *********************
1748 REM * Ze strany *
1749 REM *********************
1750 IF DARST=1760 THEN RETURN
1754 IF TF=0 THEN GOSUB 1945
1755 ? "":? " ****** Provedu ! ******"
1760 P=1
1765 FOR I=1 TO N
1770 IF PERS=1 THEN P=ABST/(ABST-Y(I))
1780 U(I)=UO-P*X(I)/F:V(I)=VO-P*Z(I)
1790 NEXT I:DARST=1760:GOTO 2000
1797 REM *********************
1798 REM * Shora *
1799 REM *********************
1800 IF DARST=1810 THEN RETURN
1804 IF TF=0 THEN GOSUB 1945
1805 ? "":? " **** Okamzik ! ****"
1810 P=1
1815 FOR I=1 TO N
1820 IF PERS=1 THEN P=ABST/(ABST-Z(I))
1830 U(I)=UO+P*Y(I)/F:V(I)=VO+P*X(I)
1840 NEXT I:DARST=1810:GOTO 2000
1847 REM *********************
1848 REM * SKLON *
1849 REM *********************
1850 IF DARST=1860 THEN RETURN
1854 IF TF=0 THEN GOSUB 1945
1855 ? "":? " **** vterinku ...! ****"
1860 P=1
1865 FOR I=1 TO N
1870 IF PERS=1 THEN P=ABST/(ABST-C*(A*X(I)+B*Y(I))-D*Z(I))
1880 DX=ABST-C*(A*X(I)+B*Y(I))-D*Z(I)
1890 U(I)=UO+P*(A*Y(I)-B*X(I))/F
1900 V(I)=VO-P*(C*Z(I)-D*(A*X(I)+B*Y(I)))
1920 NEXT I:DARST=1860:GOTO 2000
1927 REM *********************
1928 REM *TEXT.OKENKO ZAP/VYP*
1929 REM *********************
1930 IF TF=1 THEN TF=0:GR=7*F+49:GOSUB 1950
1940 GOTO 490
1944 REM TEXTOVE OKNO ZAPNUTO
1945 TF=1:GR=7*F+33
1949 REM Obrazovka pripravena
1950 GRAPHICS GR
1960 IF F=1 THEN SETCOLOR 1,0,0:SETCOLOR 2,0,10:SETCOLOR 4,0,6
1970 POKE 752,1:POKE 756,204
1980 RETURN
1997 REM *********************
1998 REM * KRESLENI *
1999 REM *********************
2000 GR=7*F+17:GOSUB 1950:COLOR 1
2020 FOR J=1 TO M
2030 I=I(J)
2040 IF I>0 THEN 2050
2042 IF I<0 AND F=2 THEN COLOR -I
2044 FALL=0:NEXT J
2050 IF U(I)<0 OR U(I)>XB OR V(I)<0 OR V(I)>YB THEN FALL=FALL+3
2060 ON FALL GOTO 2100,2200,2300,2400,2500
2069 REM ******* FALL 0 *******
2070 PLOT U(I),V(I):FALL=1:GOTO 2550
2099 REM ******* FALL 1 *******
2100 DRAWTO U(I),V(I):GOTO 2550
2199 REM ******* FALL 2 *******
2200 LI=I(J-1)
2210 UA=U(LI):VA=V(LI):UB=U(I):VB=V(I)
2220 GOSUB 2600
2230 PLOT URA,VRA:DRAWTO UB,VB
2240 FALL=1:GOTO 2550
2299 REM ******* FALL 3 *******
2300 FALL=2:GOTO 2550
2399 REM ******* FALL 4 *******
2400 LI=I(J-1)
2410 UA=U(I):VA=V(I):UB=U(LI):VB=V(LI)
2420 GOSUB 2600
2430 DRAWTO URA,VRA
2440 FALL=2:GOTO 2550
2499 REM ******* FALL 5 *******
2500 LI=I(J-1)
2510 UA=U(LI):VA=V(LI):UB=U(I):VB=V(I)
2520 DURCH=0:GOSUB 2600
2530 IF DURCH=1 THEN PLOT URA,VRA:DRAWTO URB,VRB
2540 FALL=2
2550 NEXT J:RETURN
2596 REM *********************
2597 REM *VYPOCET KRAJNICH B.*
2598 REM *********************
2600 IF UA<0 AND UB<0 THEN RETURN
2610 IF UA>XB AND UB>XB THEN RETURN
2620 IF VA<0 AND VB<0 THEN RETURN
2630 IF VA>YB AND VB>YB THEN RETURN
2640 IF ABS(UB-UA)<1 THEN 2800
2645 IF ABS(VB-VA)<1 THEN 2820
2650 K=(VB-VA)/(UB-UA):DE=VB-K*UB
2660 IF DE>=0 AND DE<=YB THEN GOSUB 2840:DURCH=1
2670 V=K*XB+DE
2680 IF V>=0 AND V<=YB THEN GOSUB 2880:DURCH=1
2690 U=-DE/K
2700 IF U>=0 AND U<=XB THEN GOSUB 2920:DURCH=1
2710 U=(YB-DE)/K
2720 IF U>=0 AND U<=XB THEN GOSUB 2960:DURCH=1
2730 RETURN
2800 DURCH=1:URA=UA:URB=UB
2805 IF VA<0 THEN VRA=0:VRB=YB:RETURN
2810 VRA=YB:VRB=0:RETURN
2820 DURCH=1:VRA=VA:VRB=VB
2825 IF UA<0 THEN URA=0:URB=XB:RETURN
2830 URA=XB:URB=0:RETURN
2840 IF UA<0 THEN URA=0:VRA=DE:RETURN
2850 URB=0:VRB=DE:RETURN
2880 IF UA<XB THEN URB=XB:VRB=V:RETURN
2890 URA=XB:VRA=V:RETURN
2920 IF VA<0 THEN URA=U:VRA=0:RETURN
2930 URB=U:VRB=0:RETURN
2960 IF VA<YB THEN URB=U:VRB=YB:RETURN
2970 URA=U:VRA=YB:RETURN
4996 REM *********************
4997 REM * SOURADNICE *
4998 REM *********************
4999 REM ROHBAU
5000 DATA -33,-33,0,-48,-6,0
5010 DATA -48,18,0,-96,84,0
5020 DATA -96,102,0,-33,126,0
5030 DATA 0,96,15,0,0,15
5040 DATA -15,20,7.5,-15,-39,7.5
5050 DATA 0,-45,15,-7.5,-12,9
5060 DATA -7.5,-45,9,-15,111,7.5
5070 DATA -27,132,39,-27,108,39
5080 DATA -19.2,78,18,-15,33,7.5
5090 DATA -33,-33,0,-24,-45,0
5100 DATA 0,-156,0,24,-45,0
5110 DATA 33,-33,0,7.5,-45,9
5120 DATA 7.5,-12,9,15,20,7.5
5130 DATA 15,-39,7.5,33,-33,0
5140 DATA 33,126,0,15,111,7.5
5150 DATA 27,132,39,27,108,39
5160 DATA 19.2,78,18,15,33,7.5
5170 DATA 96,102,0,96,84,0
5180 DATA 48,18,0,48,-6,0
5190 DATA 21,-57,1.5,3,-57,12
5200 DATA 3,-114,3.6,-3,-57,12
5210 DATA -21,-57,1.5,-3,-114,3.6
5997 REM *********************
5998 REM * ZNAKOVE PRIKAZY *
5999 REM *********************
6000 DATA -2,7,6,29,7,0,29,35,36,37,38,28,29,0,6,5,4,3,2,1,6,-1,7,8,9,10,1,0,8,26,27,28,-3,30,31,32,33,34,30
6002 DATA 0,14,15,16,17,18,14,0,10,13,12,9,0,12,8,0,13,11,8,25,26,-3,11,24,25,-3,27,24,23,22,24,0,13,19,20,13
6003 DATA -2,11,21,22,0,20,21,-3,42,43,44,42,-3,39,40,41,39
6996 REM *********************
6997 REM * POCET ZNAKOVYCH *
6998 REM * POVELU *
6999 REM *********************
7000 DATA 61,92
References
Listing downloads
Copyright holder