1 REM BASICODE 2 ROUTINES DOOR HENK WEVERS 2 REM NADERE INLICHTINGEN BASICODE 3 REM NOS, HOBBYSCOOP HILVERSUM 5 PRINT CHR$(26);:WIDTH(255) 10 GOTO 1000 20 GOTO 1010 100 PRINT CHR$(26);:RETURN 110 REM 111 IF HO>51 THEN HO=51 112 IF VE>23 THEN VE=23 113 PRINT CHR$(27);"=";CHR$(VE+32);CHR$(HO+32); 115 RETURN 120 HO=PEEK(&HEF5A):VE=PEEK(&HEF5B)-&HF0 121 VE=VE*2 122 IF HO>127 THEN HO=HO-128:VE=VE+1 123 VE=VE-PEEK(&HEF62):IF VE<0 THEN VE=32+VE 124 RETURN 200 IN$=INKEY$:RETURN 210 GOSUB 200:IF IN$="" THEN 210 211 RETURN 250 PRINT CHR$(7);:RETURN 260 RV=RND(1):RETURN 270 FR=FRE(2):RETURN 300 SR$=STR$(SR) 301 Q7=LEN(SR$):IF Q7=0 THEN RETURN 302 IF RIGHT$(SR$,1)<>" " THEN 304 303 SR$=LEFT$(SR$,Q7-1):GOTO 301 304 IF LEFT$(SR$,1)<>" " THEN RETURN 305 SR$=RIGHT$(SR$,Q7-1):GOTO 301 310 Q4=SR:IF CN<>0 THEN 316 312 SR=INT(SR+.5):GOSUB 300:GOTO 330 316 Q5=SGN(SR):SR=ABS(SR):Q8=INT(SR):Q9=SR-Q8 318 FOR Q6=1 TO CN:Q9=Q9*10:NEXT Q6 320 Q9=INT(Q9+.5):SR=Q9:GOSUB 300 322 Q9$=RIGHT$("00000000000000000000"+SR$,CN) 324 IF Q8=0 AND Q9=0 THEN Q5=1 326 SR=Q8:GOSUB 300:IF Q5=-1 THEN SR$="-"+SR$ 328 SR$=SR$+"."+Q9$ 330 IF LEN(SR$)<=CT THEN 334 332 SR$=LEFT$("********************",CT):GOTO 340 334 SR$=RIGHT$(" "+SR$,CT) 340 SR=Q4:RETURN 350 LPRINT SR$;:RETURN 360 LPRINT:RETURN 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 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