11_Sorteren.bc2

1000 A=1000:GOTO20:REM ALPHA-SORT
1010 GOTO2990:REM INITIALISATIE
1020 AW=0:REM AANTAL WOORDEN
1030 HO=0:VE=4+2*AW
1040 IFAW<5 THEN1060
1050 HO=19:VE=2*AW-6
1060 GOSUB110
1070 SR=AW+1:CT=2:CN=0:GOSUB310
1080 PRINTSR$;" ";:ML=9:GOSUB2750:IFA$="" THEN1140
1090 GOSUB1280:IFAW<10 THEN1030
1100 GOSUB2440
1110 HO=0:VE=23:GOSUB110
1120 PRINT"Met <RETURN> start het sorteren...  ";
1130 GOSUB210:IFASC(IN$)<>13 THEN1130
1140 IFAW=0 THEN3030
1150 GOSUB1520:REM OVERZICHT
1160 GOSUB1410:REM SNELSORTEER
1170 HO=29:FORI=1 TOAW
1180 VE=2*I+1:GOSUB110:PRINTS$(I):NEXTI
1190 HO=0:VE=23:GOSUB110
1200 PRINT"Wilt U dat nu wat langzamer zien ? ";:GOSUB2920
1210 IFY=0 THEN1270
1220 IFY<0 THEN1190
1230 GOSUB1520:REM OVERZICHT
1240 GOSUB1710:REM OPSCHUIVEN
1250 GOSUB1790:REM TRAAGSORTEER
1260 GOSUB2590:REM SPATIE
1270 END
1280 REM SUBR CONTROLEER  WOORD  A$
1290 LE=0
1300 FORVK=1 TOLEN(A$)
1310 VB=ASC(MID$(A$,VK,1))
1320 IF(VB>64) AND(VB<91) THEN1350
1330 IF(VB>64+HL) AND(VB<91+HL) THEN1350
1340 LE=1
1350 NEXTVK
1360 IFLE=0 THEN1390
1370 EE$="Woord bevat niet alleen maar letters !"
1380 GOSUB2490:GOTO1400
1390 AW=AW+1:WO$(AW)=A$
1400 RETURN
1410 REM SUBR SNELSORTEER
1420 GOSUB1590
1430 IFAW=1 THEN1510
1440 FORI=1 TOAW-1
1450 FORJ=I+1 TOAW
1460 IFW$(I)<=W$(J) THEN1490
1470 FT$=W$(I):W$(I)=W$(J):W$(J)=FT$
1480 FT$=S$(I):S$(I)=S$(J):S$(J)=FT$
1490 NEXTJ
1500 NEXTI
1510 RETURN
1520 REM SUBR OVERZICHT
1530 GOSUB100:PRINT"Ongesorteerd";
1540 HO=29:VE=0:GOSUB110:PRINT"Gesorteerd"
1550 FORI=1 TOAW
1560 HO=0:VE=2*I+1:GOSUB110:PRINTWO$(I)
1570 NEXTI
1580 RETURN
1590 REM SUBR ZET OM IN HOOFDLETTERS
1600 FORI=1 TOAW
1610 A$=""
1620 FORJ=1 TOLEN(WO$(I))
1630 B=ASC(MID$(WO$(I),J,1))
1640 IFB<96 THENB=B+HL
1650 A$=A$+CHR$(B)
1660 NEXTJ
1670 W$(I)=A$
1680 S$(I)=WO$(I)
1690 NEXTI
1700 RETURN
1710 REM SUBROUTINE SHIFT
1720 FORI=1 TO29:HO=I-1
1730 FORJ=1 TOAW
1740 VE=2*J+1:GOSUB110
1750 PRINTMID$(WO$(J)+LEFT$(LE$,29),I,1);WO$(J)
1760 NEXTJ
1770 NEXTI
1780 RETURN
1790 REM SUBR TRAAGSORTEER
1800 GOSUB1590
1810 IFAW=1 THENRETURN
1820 FORX=1 TOAW-1
1830 B=X
1840 FORY=X+1 TOAW
1850 IFW$(B)>W$(Y) THENB=Y
1860 NEXTY
1870 IFB>X THENGOSUB1900
1880 NEXTX
1890 RETURN
1900 REM SUBR VERWISSEL  X EN  B
1910 IR=2*X+1:JR=2*B+1
1920 JC=28-LEN(S$(B))
1930 IC=JC-LEN(S$(X))-1
1940 IFX+1=B THENIC=29
1950 REM-- SCHUIF S$(B) ERUIT --
1960 FORHO=29 TOJC STEP-1
1970 GOSUB2300
1980 VE=JR:GOSUB110:PRINTS$(B);" "
1990 NEXTHO
2000 REM-- SCHUIF S$(X) ERUIT --
2010 IFIC>28 THEN2060
2020 FORHO=29 TOIC STEP-1
2030 GOSUB2300
2040 VE=IR:GOSUB110:PRINTS$(X);" "
2050 NEXTHO
2060 REM SCHUIF W$(B) OP, W$(X) NEER
2070 HO=JC:FORSK=JR TOIR+1 STEP-1
2080 GOSUB2300
2090 VE=SK:GOSUB110:PRINTLEFT$(LE$,LEN(S$(B)))
2100 VE=SK-1:GOSUB110:PRINTS$(B)
2110 NEXTSK
2120 HO=IC:FORSK=IR TOJR-1
2130 GOSUB2300
2140 VE=SK:GOSUB110:PRINTLEFT$(LE$,LEN(S$(X)))
2150 VE=SK+1:GOSUB110:PRINTS$(X):NEXTSK
2160 REM SCHUIF STRINGS TERUG
2170 FORHO=JC TO28
2180 GOSUB2300
2190 VE=IR:GOSUB110:PRINT" ";S$(B)
2200 NEXTHO
2210 IFIC>28 THEN2260
2220 FORHO=IC TO28
2230 GOSUB2300
2240 VE=JR:GOSUB110:PRINT" ";S$(X)
2250 NEXTHO
2260 T$=W$(X):W$(X)=W$(B):W$(B)=T$
2270 T$=S$(X):S$(X)=S$(B):S$(B)=T$
2280 XX=1:GOSUB2560
2290 RETURN
2300 REM SUBR PAUZE
2310 XX=0.1:GOSUB2560
2320 RETURN
2330 REM SUBR HEADER
2340 GOSUB100:HO=10:VE=1:GOSUB110
2350 PRINT"ALFABETISCH SORTEREN"
2360 HO=10:VE=2:GOSUB110
2370 PRINT"--------------------"
2380 RETURN
2390 REM SUBR INSTRUCTIES
2400 HO=0:VE=19:GOSUB110
2410 PRINT"Druk op RETURN na elk ingevoerd woord"
2420 PRINT:PRINT"Druk weer op RETURN voor het sorteren."
2430 RETURN
2440 REM SUBR WIS ONDERSTE REGELS
2450 HO=0:FORVE=19 TO23
2460 GOSUB110:PRINTLE$;
2470 NEXTVE
2480 RETURN
2490 REM SUBR FOUTMELDING EE$
2500 GOSUB2440:REM WIS ONDERSTE REGELS
2510 HO=19-LEN(EE$)/2:VE=20:GOSUB110:PRINTEE$
2520 GOSUB2590:REM SPATIE
2530 GOSUB2440:REM WIS ONDERSTE REGELS
2540 GOSUB2390:REM INSTRUCTIES
2550 RETURN
2560 REM PROC WACHT XX SECONDEN
2570 FORZZ=1 TO100*XX:NEXTZZ
2580 RETURN
2590 REM SUBR SPATIE
2600 HO=2:VE=23:GOSUB110
2610 PRINT"Druk op de SPATIEBALK voor vervolg";:GOSUB2720
2620 GOSUB210:IFIN$<>" " THEN2620
2630 RETURN
2640 REM SUBR TITELPAGINA
2650 GOSUB100:HO=14:VE=8:GOSUB110
2660 PRINT"ALFABETISCH"
2670 HO=16:VE=11:GOSUB110
2680 PRINT"SORTEREN"
2690 FORHO=1 TO1000:GOSUB200:IFIN$<>"" THENHO=1000
2700 NEXTHO
2710 RETURN
2720 REM SUBR BUFFER LEEGMAKEN
2730 GOSUB200:IFIN$<>"" THEN2730
2740 RETURN
2750 REM SUBR INVOER VAN EEN STRING
2760 A$=""
2770 GOSUB120:FOROO=1 TOML:PRINT" ";:NEXTOO
2780 GOSUB110
2790 GOSUB2720:REM BUFFER LEGEN
2800 GOSUB210:GB=ASC(IN$):IFGB=13 THEN2910
2810 IF(GB=DL) AND(A$="") THENGOSUB250:GOTO2790
2820 IFGB<>DL THEN2870
2830 IFLEN(A$)=1 THENA$="":GOTO2850
2840 A$=LEFT$(A$,LEN(A$)-1)
2850 GOSUB120:HO=HO-1:GOSUB110:PRINT" ";:GOSUB110
2860 GOTO2790
2870 IF(LEN(A$)=ML) OR(GB<33) THEN2900
2880 IF(GB>127) AND(GB<160) THEN2900
2890 PRINTIN$;:A$=A$+IN$:GOTO2800
2900 GOSUB250:GOTO2800
2910 RETURN
2920 REM SUBR JA OF NEE
2930 ML=3:GOSUB2750
2940 OB$=LEFT$(A$,1)
2950 Y=-1
2960 IF(OB$="J") OR(OB$="j") THENY=1
2970 IF(OB$="N") OR(OB$="n") THENY=0
2980 RETURN
2990 REM INITIALISERING
3000 DIMWO$(10),W$(10),S$(10)
3010 LE$="                                       "
3020 HL=ASC("A")-ASC("a"):IFHL<0 THENHL=-HL
3030 GOSUB100
3040 GOSUB2640:GOSUB2330
3050 HO=0:VE=7:GOSUB110
3060 PRINT"Tik hoogstens tien woorden in,"
3070 PRINT"elk met maximaal negen letters."
3080 PRINT:PRINT"Het maakt niet uit of het HOOFDletters"
3090 PRINT"of kleine letters zijn."
3100 PRINT:PRINT"Nadat U de woorden hebt ingetikt, zal"
3110 PRINT"de computer ze sorteren."
3120 PRINT:PRINT"Tik nu het karakter in wat U gebruikt"
3130 PRINT"om een karakter te wissen:";:GOSUB210
3140 DL=ASC(IN$)
3150 GOSUB2590
3160 GOSUB2330:GOSUB2390
3170 GOTO1020
30000 REM"ALPHABETISCH SORTEREN    "
30010 REM EEN PROGRAMMA VAN
30020 REM"    Andrew Chapman       "
30030 REM           &
30040 REM"   Jerry Temple-Fry      "
30050 REM   (NETHERHALL SCHOOL)
30060 REM           &
30070 REM"   Richard G Warner      "
30080 REM OORSPRONKELIJK GESCHREVEN
30090 REM        VOOR DE
30100 REM"BBC model A microcomputer"
30110 REM VERTAALD NAAR
30120 REM 'EENVOUDIG' BASIC
30130 REM EN GESCHIKT GEMAAKT VOOR
30140 REM"BASICODE-2      door:    "
30150 REM"       J. Haubrich       "
30160 REM  DECEMBER 1982