Atari 8-bit Source code

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	

• Download link 1
• Download link 2