-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathBESTAND.bc
239 lines (239 loc) · 7.57 KB
/
BESTAND.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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
1000 A=10000:GOTO20:REM Bestaende in BASICODE 3
1010 MX=600:DIMI$(MX),S(INT(LN(MX)/LN(2))+1,1)
1020 DIMA$(14),N$(3),N(3),I(3)
1030 A$(1)="Basicode Kassette"
1040 A$(2)="Standart Kassette"
1050 A$(3)="Disk ( standart )"
1060 A$(4)="Disk unit Nr 2 "
1070 A$(5)="Computerspeicher "
1080 A$(6)="DATA - Zeilen "
1090 REM MENU
1100 A$(7)="Einlesen "
1110 A$(8)="Drucken "
1120 A$(9)="Kopieren "
1130 A$(10)="Zusammenfuegen "
1140 A$(11)="Vergleichen "
1150 A$(12)="Sortieren "
1160 A$(13)="Hilfe "
1170 A$(14)="Ende "
1180 I=0:J=-1:S$=" "
1190 REM MENU
1200 GOSUB100
1210 PRINT" B E S T A E N D E "
1220 PRINT" -----------------":PRINT
1230 GOSUB120:V=VE:PRINT"Waehle .....":PRINT
1240 FORM=7 TO13
1250 PRINTA$(M);" ";CHR$(58+M)
1260 NEXTM
1270 PRINTA$(14);" ";CHR$(72);" oder ";CHR$(88):PRINT
1280 GOSUB120:M=VE:HO=0:VE=V:GOSUB110
1290 REM KEUZE
1300 GOSUB210:K=IN-64:IFIN=88 THENK=8
1310 IF(K<1)OR(K>8)THEN1300
1320 VE=V:GOSUB110:PRINTA$(K+6)
1330 FORVE=M TOV+2 STEP-1:GOSUB110:PRINTS$:NEXTVE
1340 VE=V:GOSUB110
1350 IFK=8 THEN950
1360 IFK=6 THEN GOSUB4010:GOTO1200
1370 IFK=7 THEN GOSUB5010:GOTO1200
1380 N(1)=97:N(2)=98:N(3)=99
1390 GOSUB3005:GOTO1200
2000 REM BESTANDSNAMEN
2010 GOSUB120:V=VE:HO=12:GOSUB110
2020 IFN=1 THENPRINT"Einlesen...";
2030 IFN=2 THENPRINT"Einlesen2 ";
2040 IFN=3 THENPRINT"Auslesen .";
2050 PRINT".........":PRINT
2060 FORM=1 TO6
2070 PRINT" ";A$(M);" ";CHR$(M+48):NEXTM:PRINT
2080 PRINT" Abgebrochen ";CHR$(88)
2090 GOSUB120:M=VE:VE=V:HO=12:GOSUB110
2100 GOSUB210:N(N)=IN-48
2110 IFIN=88 THENFT=1:RETURN
2120 IF(IN<49)OR(IN>54)THEN2100
2130 FORVE=M TOV STEP-1:GOSUB110:PRINTS$:NEXTVE
2140 VE=V:GOSUB110:PRINTA$(N(N));" ";
2150 REM
2160 IF(IN<50)OR(IN>52)THENN$(N)="":PRINT:RETURN
2170 N$="":GOSUB120
2180 PRINT"'";N$;"' ";:GOSUB110
2190 GOSUB210:IFIN>31 THEN2220
2200 IFLEN(N$)>7 THEN GOSUB250:GOTO2180
2210 N$(N)=N$:GOTO2510
2220 IFIN<>127 THENN$=N$+IN$:GOTO2180
2230 IFLEN(N$)=1 THENN$=""
2240 IFLEN(N$)>1 THENN$=LEFT$(N$,LEN(N$)-1)
2250 GOTO2180
2500 REM EINDE BESTANDSNAAM
2510 PRINT:RETURN
2600 REM AFBREKEN
2610 HO=0:VE=M:GOSUB110
2620 PRINT:PRINT"Abgebrochen"
2630 GOSUB210:RETURN
2700 REM FOUT
2710 PRINT:PRINT"2 x Dasselbe !!"
2720 GOSUB210:RETURN
3000 REM INIT
3005 FT=0:N=1:GOSUB2010
3010 IFFT<>0 THEN2610
3015 IF(K=4)OR(K=5)THENN=2:GOSUB2010
3020 IFFT<>0 THEN2610
3025 IF(K=3)OR(K=4)THENN=3:GOSUB2010
3030 IFFT<>0 THEN2610
3035 IF(N(1)<3)AND(N(2)<3)THEN2710
3040 IF(N(1)<3)AND(N(3)<3)THEN2710
3045 IF(N(2)<3)AND(N(3)<3)THEN2710
3050 IFN(1)=N(2)THEN2710
3055 IFN(1)=N(3)THEN2710
3060 IFN(2)=N(3)THEN2710
3100 REM INIT 2
3110 PRINT
3120 N(1)=(N(1)-1)*2:REM INPUT
3130 N(2)=(N(2)-1)*2:REM INPUT
3140 N(3)=(N(3)-1)*2+1:REM OUTPUT
3150 I(1)=0:I(2)=0:I(3)=0
3200 REM OPENEN FILES
3205 FT=0:H$="":RESTORE:IFN(3)=9 THENJ=-1
3210 FORN=1 TO3
3215 IN=0:NF=N(N):NF$=N$(N)
3220 IFN(N)<8 THEN GOSUB500
3225 IF(N(N)=8)AND(J=-1)THENIN=-1
3230 IFN(N)=10 THENREADD$:IFD$="$$$$$" THENIN=-1
3235 I(N)=IN:IFIN<>0 THENPRINT"falsche Eroeffnung":FT=N:N=3
3240 NEXTN:IFFT<>0 THENN=FT:GOTO3810
3245 N=3:I=0:IJ=0:L=0
3250 IFK<>1 THEN GOSUB120:PRINT"0";
3300 REM LEES FILE 1
3310 IFK<>1 THEN GOSUB110:SR=I:GOSUB300:PRINTSR$;
3320 IFN(1)<8 THENNF=N(1):GOSUB540:SR$=IN$:I(1)=IN
3330 IFN(1)=8 THENSR$=I$(IJ):IJ=IJ+1:IFIJ>J THENI(1)=1
3340 IFN(1)=10 THENSR$=D$:READD$:IFD$="$$$$$" THENI(1)=1
3400 REM LEES FILE 2
3410 IFK<>5 THEN3510
3420 IFN(2)<8 THENNF=N(2):GOSUB540:H$=IN$:I(2)=IN
3430 IFN(2)=8 THENH$=I$(IJ):IJ=IJ+1:IFIJ>J THENI(2)=1:H$=""
3440 IFN(2)=10 THENH$=D$:READD$:IFD$="$$$$$" THENI(2)=1
3500 REM SCHRIJF FILE 3
3510 IFN(3)<8 THENNF=N(3):GOSUB560:I(3)=IN
3520 IFN(3)=9 THENI$(I)=SR$:IFI>=MX THENI(3)=-1
3530 IFK=1 THENPRINTSR$
3540 IFK=2 THEN GOSUB350:GOSUB360
3550 IF(K=5)AND(SR$<>H$)THENFT=1:I(1)=1:I(2)=1
3560 IF(K=5)AND(I(1)<>I(2))THENFT=1
3600 REM CONTROLE INTERRUPT
3610 IN=0:GOSUB200
3620 IFIN=88 THENI(1)=2:PRINT:PRINT:PRINT"Abgebrochen":IN=0
3630 IFIN<>0 THEN GOSUB210
3640 IFIN=88 THENI(1)=2:PRINT:PRINT:PRINT"Abgebrochen"
3700 REM EINDE BESTAND ?
3710 IFABS(I(1))+ABS(I(2))+ABS(I(3))=0 THENI=I+1:GOTO3310
3720 IFI(1)<>1 THEN3770
3730 IF(K<>4)OR(L=1)THEN3770
3740 H$=N$(1):N$(1)=N$(2):N$(2)=H$
3750 H=N(1):N(1)=N(2):N(2)=H
3760 L=1:I(1)=0:I=I+1:GOTO3310
3770 IFN(3)=9 THENJ=I
3780 IFK<>1 THENSR=I+1:GOSUB110:GOSUB300:PRINTSR$:PRINT
3800 REM SLUITEN BESTANDEN
3810 PRINT
3820 FORM=1 TON
3830 IFN(M)<8 THENNF=N(M):GOSUB580
3840 NEXTM
3900 REM EINDE
3910 IF(K=5)AND(FT=0)THENPRINT"Bestaende sind ungleich"
3920 IF(K=5)AND(FT<>0)THENPRINT"Bestaende sind ungleich"
3930 FT=0:IFI(1)<0 THENFT=1
3940 IFI(2)<0 THENFT=2
3950 IFI(3)<0 THENFT=3
3960 IFFT=0 THENPRINT"Ok.":GOTO3990
3970 PRINT"Fehler in : ";A$(INT(N(FT)/2)+1);
3980 IFN$(FT)<>"" THENPRINT" '";N$(FT);"'";
3990 PRINT:GOSUB210:RETURN
4000 REM SORTEREN QUICKSORT
4010 IFJ<1 THENRETURN
4020 PRINT:PRINT:SR=0:GOSUB120:PRINT"0"
4030 S(1,0)=0:S(1,1)=J:S=1:F=1
4040 L=S(S,0):R=S(S,1):S=S-1:P=L:Q=R
4050 X$=I$(INT((L+R)/2))
4060 IFI$(P)<X$ THENP=INT(P+1.5):GOTO4060
4070 IFX$<I$(Q)THENQ=INT(Q-0.5):GOTO4070
4080 IFP>Q THEN4140
4090 W$=I$(P):I$(P)=I$(Q):I$(Q)=W$
4100 SR=SR+1:GOSUB300:GOSUB110:PRINTSR$
4110 P=P+1:P=J-(J-P+ABS(J-P))/2
4120 Q=Q-1:Q=(Q+ABS(Q))/2
4130 GOTO4060
4140 IFL<Q THENS=S+1:S(S,0)=L:S(S,1)=Q
4150 IFP<R THENS=S+1:S(S,0)=P:S(S,1)=R
4160 IFS<>0 THEN4040
4170 PRINT:PRINT:PRINT"Ok.":GOSUB210:RETURN
5000 REM HELP
5010 GOSUB100
5020 PRINT" B E S T A E N D E "
5030 PRINT" ----------------- ":PRINT
5040 GOSUB120:V=VE:PRINT"Hilfe":PRINT
5050 PRINT"Mit Hilfe dieses Programms koennen Sie"
5060 PRINT"BASICODE - 3 Bestaende kopieren. Sie "
5070 PRINT"koennen Bestaende ausdrucken( Bild"
5080 PRINT"u. Drucker), Bestaende kopieren, zusam-"
5090 PRINT"menfuegen und vergleichen."
5100 REM
5110 PRINT:PRINT"Die Bestaende koennen auf Kassette(auch"
5120 PRINT"Basicode) und auf Disk stehen. Auch "
5130 PRINT"kann ein 'Bestand' aus DATA-Zeilen be-"
5140 PRINT"stehen. Als Zwischespeicher kann"
5150 PRINT"der Computerspeicher genutzt werden."
5160 PRINT"Das kann maximal 500 Zeilen betreffen,"
5170 PRINT"die auch sortiert werden koennen."
5180 PRINT:PRINT"Mit einer Taste wird die Bearbeitung"
5190 PRINT"unterbrochen, mit der Taste 'x' beendet."
5200 REM
5210 PRINT:PRINT" <Taste>";
5220 GOSUB210:HO=0
5230 FORVE=23 TO4 STEP-1:GOSUB110
5240 PRINT" ";
5250 NEXTVE:RETURN
25000 REM EVT DATA-REGELS
25010 DATA"Vorlage DATA - Zeilen"
25020 DATA":"
25030 DATA"siehe Programm 25000-29000"
29000 DATA"$$$$$"
30000 REM BESTANDEN 1.8
30010 REM
30020 REM UTILITIES VOOR BESTANDEN
30030 REM
30040 REM IN BASICODE 3
30050 REM
31000 REM NF= 0 1 BASICODE CASSETTE
31010 REM 2 3 STANDAARD CASSETTE
31020 REM 4 5 DISK (STANDAARD)
31030 REM 6 7 DISK (UNIT NR 2)
31040 REM 8 9 COMPUTER GEHEUGEN
31050 REM 10 DATA-REGELS
31060 REM
31070 REM N$(3) N(3) I(3)
31080 REM
31090 REM 1 = INPUT FILE 1
31100 REM 2 = EVT INPUT FILE 2
31110 REM 3 = EVT OUTPUT FILE
31120 REM
32000 REM GESCHREVEN DOOR
32010 REM
32020 REM HENK VAN DEELEN
32030 REM RUDOLPHLAAN 28
32040 REM 3794 MZ DE GLIND
32050 REM
32060 REM (C) H VAN DEELEN 1988
32070 REM
32080 REM TROS-RADIO DD 890405
32090 REM
32100 REM Uebersetzt von
32110 REM Ronald Knak
32120 REM Dr.-H.-Wolf-Str.1
32130 REM Schwerin
32140 REM 2 7 5 8
32150 REM
32160 REM am 14.12.90
32170 REM
32180 REM Erstausstrahlung: Deutschlandsender Kultur
32190 REM-spezial 910220