-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathFKT3D.bc
114 lines (114 loc) · 3.85 KB
/
FKT3D.bc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
1000 A=100:GOTO20:REM ## FKT3D ##
1010 GOTO1100:REM --- hier ist z = f(x,y) abzulegen ---
1020 Z=ABS(X)+ABS(Y):IFZ<.01 THENZ=1:RETURN
1030 Z=SIN(Z)/Z
1040 RETURN
1100 SR$="3D-Funktion"
1110 HO=INT((HO-LEN(SR$)-6)/2):VE=0:GOSUB110:GOSUB150:PRINT
1120 REM --- Startwerte ---
1130 XS=-20:XE=20:YS=-20:YE=20
1140 ZS=-.5:ZE=1:F1=3:F2=20:T$="N"
1150 REM --- Hauptroutine ---
1160 REM --- erzeugt das Bild ---
1170 Y2=INT(VG/2):XX=HG-Y2:DIMHI(HG,1),FU(XX,1)
1180 REM --- Feld belegen ---
1190 PRINT"bitte etwas warten"
1200 FORJ=0 TOHG:HI(J,0)=0:HI(J,1)=1:NEXTJ
1210 REM --- Eingaben ---
1220 PRINT"Startwert von x =";XS;:A$="":INPUTA$
1230 IFA$="" THEN1250
1240 XS=VAL(A$)
1250 PRINT"Endwert von x =";XE;:A$="":INPUTA$
1260 IFA$="" THEN1280
1270 XE=VAL(A$)
1280 IFXE<=XS THENPRINT"Fehler":GOTO1220
1290 PRINT"Startwert von y =";YS;:A$="":INPUTA$
1300 IFA$="" THEN1320
1310 YS=VAL(A$)
1320 PRINT"Endwert von y =";YE;:A$="":INPUTA$
1330 IFA$="" THEN1350
1340 YE=VAL(A$)
1350 IFYE<=YS THENPRINT"Fehler":GOTO1290
1360 PRINT"Startwert von z =";ZS;:A$="":INPUTA$
1370 IFA$="" THEN1390
1380 ZS=VAL(A$)
1390 PRINT"Endwert von z =";ZE;:A$="":INPUTA$
1400 IFA$="" THEN1420
1410 IFZE<=ZS THENPRINT"Fehler":GOTO1360
1420 PRINT"x-Schritt =";F2;:A$="":INPUTA$
1430 IFA$="" THEN1450
1440 F2=VAL(A$)
1450 PRINT"y-Schritt =";F1;:A$="":INPUTA$
1460 IFA$="" THEN1490
1470 F1=VAL(A$)
1480 REM --- Hilfswerte ---
1490 VZ=Y2/(ZE-ZS):V2=VZ/VG:MO=2:MI=-1:MA=100:GV=1/VG
1500 REM --- Schrittweiten ---
1510 SX=(XE-XS)/XX:SY=(YE-YS)/Y2:SS=SX*F2
1520 REM --- Bild darstellen ---
1530 GOSUB600:CN=0
1540 S2=SY*F1:YW=YS-S2
1550 FORJ=0 TOY2+.8*F1 STEPF1:J1=1-J*GV
1560 YW=YW+S2:XW=XS-SX:VA=MA
1570 IFJ>Y2 THENJ=Y2:YW=YE
1580 FORI=0 TOXX
1590 XW=XW+SX:K=I+J:X=XW:Y=YW:HO=K/HG
1600 GOSUB1020
1610 VE=J1+(ZS-Z)*V2
1620 IFVE>MO THENVE=MO
1630 IFVE<MI THENVE=MI
1640 IF(VA=MA)OR(ABS(VA-VE)<=GV) THEN1700
1650 S=SGN(VE-VA)/VG:VV=VE
1660 FORVE=VA+S TOVV STEPS
1670 IFVE>HI(K,0) THEN GOSUB620
1680 IFVE<HI(K,1) THEN GOSUB620
1690 NEXTVE:VE=VV
1700 VA=VE:FU(I,1)=VE
1710 IFVE>HI(K,1) THENFU(I,0)=HI(K,1):FU(I,1)=HI(K,1)
1720 IFVE>HI(K,0) THENHI(K,0)=VE:GOSUB620
1730 IFVE<HI(K,1) THENHI(K,1)=VE:GOSUB620
1740 IFJ=0 THENFU(I,0)=VE
1750 GOSUB200:IFIN<>0 THEN2030
1760 NEXTI
1770 REM --- Querlinien ---
1780 FORI=0 TOXX+.9*F2 STEPF2
1790 IFI>XX THENI=XX
1800 F=FU(I,0)>FU(I,1)
1810 IFF THENHO=(J+I-F1)/HG:VE=FU(I,0):GOSUB620
1820 IFF THENHO=(J+I)/HG:VE=FU(I,1):GOSUB630
1830 NEXTI
1840 REM --- Umschreiben der Querlinienwerte ---
1850 FORI=0 TOXX:FU(I,0)=FU(I,1):NEXTI
1860 REM ---- unterer Kasten ----
1870 IFJ=0 THENHO=0:VE=FU(0,0):GOSUB620:VE=1-GV:GOSUB630
1880 IFJ=0 THENHO=XX/HG:GOSUB630:VE=FU(XX,0):GOSUB630
1890 NEXTJ
1900 REM ----- rechts unterer Kasten ---
1910 HO=XX/HG:VE=1-GV:GOSUB620:HO=1-1/HG:VE=Y2*GV
1920 GOSUB630:VE=FU(XX,1):GOSUB630
1930 REM --- Bild fertig ---
1940 GOSUB210:REM Kennwerte schreiben
1950 SR=F1:GOSUB300:A$="Schritte "+SR$+":"
1960 SR=F2:GOSUB300:SR$=A$+SR$:HO=0:VE=0:GOSUB650
1970 SR=XS:GOSUB300:A$=SR$+"<x<":SR=XE:GOSUB300
1980 SR$=A$+SR$:VE=8*GV:GOSUB650
1990 SR=YS:GOSUB300:A$=SR$+"<y<":SR=YE:GOSUB300
2000 SR$=A$+SR$:VE=16*GV:GOSUB650
2010 SR=ZS:GOSUB300:A$=SR$+"<z<":SR=ZE:GOSUB300
2020 SR$=A$+SR$:VE=24*GV:GOSUB650
2030 GOSUB210:GOSUB100
2040 PRINT"Wie fortsetzen ?"
2050 INPUT"E = Ende N = Neues Bild";T$:
2060 IF(T$<>"E")AND(T$<>"e") THENT$="N":GOTO1190
2070 GOTO950
30000 REM --------- Hinweise ----------------
30010 REM Programm dient zum 3-dimensionalen Darstellen
30020 REM von Funktionen der Art z = f(x, y)
30030 REM Die Funktion ist den Zeilen 1020 bis 1090
30040 REM abzulegen und mit RETURN abzuschliessen.
32000 REM ----------- Autor ------------------
32010 REM H. Voelz; 22.8.89; fuer BASICODE-Buch
32020 REM ------------------------------------
32030 REM
32040 REM Erstausstrahlung: Radio DDR
32050 REM 900124