SORT.bc2

1000 A=1000:GOTO 20:REM STRINGRUIMTE
1010 GOTO 7000:REM INITIALISATIE
1100 AW=0:REM AANTAL WOORDEN
1110 HO=0:VE=4+2*AW
1120 IF AW<5 THEN 1140
1130 HO=19:VE=2*AW-6
1140 GOSUB 110
1150 SR=AW+1:CT=2:CN=0:GOSUB 310
1160 PRINT SR$;" ";:ML=9:GOSUB 6100:IF A$=""THEN 1220
1170 GOSUB 2000:IF AW<10 THEN 1110
1180 GOSUB 4800
1190 HO=0:VE=22:GOSUB 110
1200 PRINT"Met <RETURN> start het sorteren...  ";
1210 GOSUB 210:IF ASC(IN$)<>13 THEN 1210
1220 IF AW=0 THEN 7040
1230 GOSUB 2600:REM OVERZICHT
1240 GOSUB 2300:REM SNELSORTEER
1250 HO=29:FOR I=1 TO AW
1260 VE=2*I+1:GOSUB 110:PRINT S$(I):NEXT I
1270 HO=0:VE=22:GOSUB 110
1280 PRINT"Wilt U dat nu wat langzamer zien ? ";:GOSUB 6400
1290 IF Y=0 THEN 1350
1300 IF Y<0 THEN 1270
1310 GOSUB 2600:REM OVERZICHT
1320 GOSUB 3100:REM OPSCHUIVEN
1330 GOSUB 3300:REM TRAAGSORTEER
1340 GOSUB 5400:REM SPATIE
1350 END
1360 :
2000 REM SUBR CONTROLEER  WOORD  A$
2010 LE=0
2020 FOR VK=1 TO LEN(A$)
2030 VB=ASC(MID$(A$,VK,1))
2040 IF VB>64 AND VB<91 THEN 2070
2050 IF VB>64+HL AND VB<91+HL THEN 2070
2060 LE=1
2070 NEXT VK
2080 IF LE=0 THEN 2110
2090 OE$="Woord bevat niet alleen maar letters !"
2100 GOSUB 5000:GOTO 2120
2110 AW=AW+1:WO$(AW)=A$
2120 RETURN
2130 :
2300 REM SUBR SNELSORTEER
2310 GOSUB 2800
2320 IF AW=1 THEN 2400
2330 FOR I=1 TO AW-1
2340 FOR J=I+1 TO AW
2350 IF W$(I)<=W$(J)THEN 2380
2360 FT$=W$(I):W$(I)=W$(J):W$(J)=FT$
2370 FT$=S$(I):S$(I)=S$(J):S$(J)=FT$
2380 NEXT J
2390 NEXT I
2400 RETURN
2410 :
2600 REM SUBR OVERZICHT
2610 GOSUB 100:PRINT"Ongesorteerd";
2620 HO=29:VE=0:GOSUB 110:PRINT"Gesorteerd"
2630 FOR I=1 TO AW
2640 HO=0:VE=2*I+1:GOSUB 110:PRINT WO$(I)
2650 NEXT I
2660 RETURN
2670 :
2800 REM SUBR ZET OM IN HOOFDLETTERS
2810 FOR I=1 TO AW
2820 :A$=""
2830 :FOR J=1 TO LEN(WO$(I))
2840 ::B=ASC(MID$(WO$(I),J,1))
2850 ::IF B<96 THEN B=B+HL
2860 ::A$=A$+CHR$(B)
2870 :NEXT J
2880 :W$(I)=A$
2890 :S$(I)=WO$(I)
2900 NEXT I
2910 RETURN
2920 :
3100 REM SUBROUTINE SHIFT
3110 :
3120 FOR I=1 TO 29:HO=I-1
3130 :FOR J=1 TO AW
3140 ::VE=2*J+1:GOSUB 110
3150 ::PRINT MID$(WO$(J)+LEFT$(LE$,29),I,1);WO$(J)
3160 :NEXT J
3170 NEXT I
3180 RETURN
3190 :
3300 REM SUBR TRAAGSORTEER
3310 :
3320 GOSUB 2800
3330 IF AW=1 THEN RETURN
3340 FOR X=1 TO AW-1
3350 :B=X
3360 :FOR Y=X+1 TO AW
3370 ::IF W$(B)>W$(Y)THEN B=Y
3380 :NEXT Y
3390 :IF B>X THEN GOSUB 3600
3400 NEXT X
3410 RETURN
3420 :
3600 REM SUBR VERWISSEL  X EN  B
3610 :
3620 IR=2*X+1:JR=2*B+1
3630 JC=28-LEN(S$(B))
3640 IC=JC-LEN(S$(X))-1
3650 IF X+1=B THEN IC=29
3660 REM-- SCHUIF S$(B) ERUIT --
3670 FOR HO=29 TO JC STEP-1
3680 GOSUB 4200
3690 VE=JR:GOSUB 110:PRINT S$(B);" "
3700 NEXT HO
3710 REM-- SCHUIF S$(X) ERUIT --
3720 IF IC>28 THEN 3770
3730 FOR HO=29 TO IC STEP-1
3740 GOSUB 4200
3750 VE=IR:GOSUB 110:PRINT S$(X);" "
3760 NEXT HO
3770 REM SCHUIF W$(B) OP, W$(X) NEER
3780 HO=JC:FOR SK=JR TO IR+1 STEP-1
3790 GOSUB 4200
3800 VE=SK:GOSUB 110:PRINT LEFT$(LE$,LEN(S$(B)))
3810 VE=SK-1:GOSUB 110:PRINT S$(B)
3820 NEXT SK
3830 HO=IC:FOR SK=IR TO JR-1
3840 GOSUB 4200
3850 VE=SK:GOSUB 110:PRINT LEFT$(LE$,LEN(S$(X)))
3860 VE=SK+1:GOSUB 110:PRINT S$(X):NEXT SK
3870 REM SCHUIF STRINGS TERUG
3880 FOR HO=JC TO 28
3890 GOSUB 4200
3900 VE=IR:GOSUB 110:PRINT" ";S$(B)
3910 NEXT HO
3920 IF IC>28 THEN 3970
3930 FOR HO=IC TO 28
3940 GOSUB 4200
3950 VE=JR:GOSUB 110:PRINT" ";S$(X)
3960 NEXT HO
3970 T$=W$(X):W$(X)=W$(B):W$(B)=T$
3980 T$=S$(X):S$(X)=S$(B):S$(B)=T$
3990 OX=1:GOSUB 5200
4000 RETURN
4010 :
4200 REM SUBR PAUZE
4210 :
4220 OX=.1:GOSUB 5200
4230 RETURN
4240 :
4400 REM SUBR HEADER
4410 :
4420 GOSUB 100:HO=10:VE=1:GOSUB 110
4430 PRINT"ALFABETISCH SORTEREN"
4435 HO=10:VE=2:GOSUB 110
4440 PRINT"--------------------"
4450 RETURN
4460 :
4600 REM SUBR INSTRUCTIES
4610 :
4620 HO=0:VE=19:GOSUB 110
4630 PRINT"Druk op RETURN na elk ingevoerd woord"
4640 PRINT:PRINT"Druk weer op RETURN voor het sorteren."
4650 RETURN
4660 :
4800 REM SUBR WIS ONDERSTE REGELS
4810 :
4820 HO=0:FOR VE=19 TO 23
4830 GOSUB 110:PRINT LE$;
4840 NEXT VE
4850 RETURN
4860 :
5000 REM SUBR FOUTMELDING OE$
5010 :
5020 GOSUB 4800:REM WIS ONDERSTE REGELS
5030 HO=19-LEN(OE$)/2:VE=20:GOSUB 110:PRINT OE$
5040 GOSUB 5400:REM SPATIE
5050 GOSUB 4800:REM WIS ONDERSTE REGELS
5060 GOSUB 4600:REM INSTRUCTIES
5070 RETURN
5080 :
5200 REM PROC WACHT OX SECONDEN
5210 :
5220 FOR OZ=1 TO 100*OX:NEXT
5230 RETURN
5240 :
5400 REM SUBR SPATIE
5410 :
5420 HO=2:VE=23:GOSUB 110
5430 PRINT"Druk op de SPATIEBALK voor vervolg";:GOSUB 5800
5440 GOSUB 210:IF IN$<>" "THEN 5440
5450 RETURN
5460 :
5600 REM SUBR TITELPAGINA
5610 :
5620 GOSUB 100:HO=14:VE=8:GOSUB 110
5630 PRINT"ALFABETISCH"
5640 HO=16:VE=11:GOSUB 110
5650 PRINT"SORTEREN"
5660 FOR HO=1 TO 1000:GOSUB 200:IF IN$<>""THEN HO=1000
5670 NEXT HO
5680 RETURN
5690 :
5800 REM SUBR BUFFER LEEGMAKEN
5810 :
5820 GOSUB 200:IF IN$<>""THEN 5820
5830 RETURN
5840 :
6100 REM SUBR INVOER VAN EEN STRING
6110 A$=""
6120 GOSUB 120:FOR OO=1 TO ML:PRINT" ";:NEXT OO
6130 GOSUB 110
6140 GOSUB 5800:REM BUFFER LEGEN
6150 GOSUB 210:GB=ASC(IN$):IF GB=13 THEN 6260
6160 IF GB=DL AND A$=""THEN 6150
6170 IF GB<>DL THEN 6220
6180 IF LEN(A$)=1 THEN A$="":GOTO 6200
6190 A$=LEFT$(A$,LEN(A$)-1)
6200 GOSUB 120:HO=HO-1:GOSUB 110
6201 PRINT " ";:GOSUB 120:HO=HO-1:GOSUB 110
6210 GOTO 6140
6220 IF LEN(A$)=ML OR GB<33 THEN 6250
6230 IF(GB>127 AND GB<160)THEN 6250
6240 PRINT IN$;:A$=A$+IN$:GOTO 6150
6250 GOSUB 250:GOTO 6150
6260 RETURN
6270 :
6400 REM SUBR JA OF NEE
6410 :
6420 ML=3:GOSUB 6100
6430 OB$=LEFT$(A$,1)
6440 Y=-1
6450 IF OB$="J"OR OB$="j"THEN Y=1
6460 IF OB$="N"OR OB$="n"THEN Y=0
6470 RETURN
6480 :
7000 REM INITIALISERING
7010 DIM WO$(10),W$(10),S$(10)
7020 LE$="                                       "
7030 HL=ASC("A")-ASC("a"):IF HL<0 THEN HL=-HL
7040 GOSUB 100
7050 GOSUB 5600:GOSUB 4400
7060 HO=0:VE=7:GOSUB 110:
7070 PRINT"Tik hoogstens tien woorden in,"
7080 PRINT"elk met maximaal negen letters."
7090 PRINT:PRINT"Het maakt niet uit of het HOOFDletters"
7100 PRINT"of kleine letters zijn."
7110 PRINT:PRINT"Nadat U de woorden hebt ingetikt, zal"
7120 PRINT"de computer ze sorteren."
7121 PRINT:PRINT"Tik nu het karakter in wat U gebruikt"
7122 PRINT"om een karakter te wissen:";:GOSUB 210
7123 DL=ASC(IN$)
7130 GOSUB 5400
7140 GOSUB 4400:GOSUB 4600
7150 GOTO 1100
7160 :
10000 REM"ALPHABETISCH SORTEREN    "
10010 :
10020 REM EEN PROGRAMMA VAN :
10030 REM"    Andrew Chapman       "
10040 REM           &
10050 REM"   Jerry Temple-Fry      "
10060 REM   (NETHERHALL SCHOOL)
10070 REM           &
10080 REM"   Richard G Warner      "
10090 :
10100 REM OORSPRONKELIJK GESCHREVEN
10110 REM        VOOR DE
10120 REM"BBC model A microcomputer"
10130 :
10140 REM VERTAALD NAAR
10150 REM 'EENVOUDIG' BASIC
10160 REM EN GESCHIKT GEMAAKT VOOR
10170 REM"BASICODE-2      door:    "
10190 REM"       J. Haubrich       "
10200 REM  DECEMBER 1982