HALMA.bc

1000 A=200:GOTO20:REM == SOLITAIRE ==
1010 DIMV$(6,6):DM=0:XO=3:YO=3
1020 T$="Druecke eine Taste":CO$="32"
1030 S$="S = beenden"
1040 REM
1050 GOSUB100
1060 PRINT:PRINT
1070 PRINT"      S O L I T A I R E"
1080 PRINT
1090 PRINT:PRINT"MENU"
1100 PRINT:PRINT"     1 = SPIELREGEL"
1110 PRINT:PRINT"     2 = SPIELEN"
1120 PRINT:PRINT"     3 = DEMONSTRATION"
1130 PRINT:PRINT"     4 = STOPPEN"
1140 PRINT:PRINT"          1,2,3 of 4";
1150 GOSUB210
1160 IFIN=49 THEN GOSUB5020:GOTO1000
1170 IFIN=50 THEN1220
1180 IFIN=51 THENDM=1:GOTO1220
1190 IFIN=52 THEN950
1200 GOTO1150
1210 REM
1220 GOSUB600
1230 REM === TEKEN SPEELBORD ===
1240 CN=0
1250 FORHO=.4 TO.63 STEP.075
1260 VE=.1:GOSUB620:VE=.8:GOSUB630
1270 NEXTHO
1280 FORHO=.25 TO.78 STEP.075
1290 VE=.3:GOSUB620:VE=.6:GOSUB630
1300 NEXTHO
1310 FORVE=.3 TO.6 STEP.1
1320 HO=.25:GOSUB620:HO=.775:GOSUB630
1330 NEXTVE
1340 FORVE=.1 TO.81 STEP.1
1350 HO=.4:GOSUB620:HO=.625:GOSUB630
1360 NEXTVE
1370 HO=.05:VE=.9
1380 IFDM=1 THENSR$=T$:GOSUB650:GOTO1410
1390 SR$=S$:GOSUB650
1400 REM === ARRAY VULLEN ===
1410 FORX=0 TO6:FORY=2 TO4
1420 V$(X,Y)="*":NEXTY:NEXTX
1430 FORX=2 TO4:FORY=0 TO6
1440 V$(X,Y)="*":NEXTY:NEXTX
1450 V$(3,3)=" "
1460 REM === SPEELBORD VULLEN ===
1470 FORX=0 TO6:FORY=0 TO6
1480 HO=.27+X*.075:VE=.14+Y*.1
1490 IFV$(X,Y)="*" THENSR$="*":GOSUB650
1500 NEXTY:NEXTX
1510 X=3:Y=3:GOSUB3020
2000 REM
2010 REM *** HET SPEELPROGRAMMA ***
2020 REM
2030 REM === TOETSINVOER ===
2040 IFDM=1 THEN GOSUB6010:GOTO1000
2050 GOSUB210::GOSUB2070:GOTO2050
2060 REM === ANALYSE TOETSINVOER ===
2070 Q=IN
2080 IF(Q>27)AND(Q<32)THEN GOSUB2510
2090 IFIN$=" " THEN GOSUB3130
2100 IFIN=83 THEN1000:REM S
2110 RETURN
2500 REM === PIJLTOETSEN ===
2510 R=Q-27:ONR GOTO2530,2570,2610,2650
2520 REM
2530 IF(X=2)AND((Y<2)OR(Y>4))THENRETURN
2540 IFX=0 THENRETURN
2550 X=X-1:GOSUB3020:RETURN
2560 REM
2570 IF(X=4)AND((Y<2)OR(Y>4))THENRETURN
2580 IFX=6 THENRETURN
2590 X=X+1:GOSUB3020:RETURN
2600 REM
2610 IF(Y=4)AND((X<2)OR(X>4))THENRETURN
2620 IFY=6 THENRETURN
2630 Y=Y+1:GOSUB3020:RETURN
2640 REM
2650 IF(Y=2)AND((X<2)OR(X>4))THENRETURN
2660 IFY=0 THENRETURN
2670 Y=Y-1:GOSUB3020:RETURN
3000 REM
3010 REM === VERPLAATS DE CURSOR ===
3020 CN=1:P=XO:Q=YO:GOSUB3060
3030 CN=0:P=X:Q=Y:GOSUB3060
3040 XO=X:YO=Y
3050 RETURN
3060 HO=.264+P*.075:VE=.121+Q*.1:GOSUB620
3070 HO=.312+P*.075:GOSUB630
3080 VE=.185+Q*.1:GOSUB630
3090 HO=.264+P*.075:GOSUB630
3100 VE=.121+Q*.1:GOSUB630
3110 RETURN
3120 REM === NA SPATIE SLAAN ===
3130 GOSUB210:Q=IN
3140 IF(Q<28)OR(Q>31)THENRETURN
3150 IFV$(X,Y)<>"*" THENRETURN
3160 Q=Q-27
3170 ONQ GOTO3190,3290,3390,3490
3180 REM
3190 IFX<2 THENRETURN
3200 IFV$(X-1,Y)<>"*" THENRETURN
3210 IFV$(X-2,Y)<>" " THENRETURN
3220 V$(X,Y)=" ":GOSUB3600
3230 X=X-1:GOSUB3020
3240 V$(X,Y)=" ":GOSUB3600
3250 X=X-1:GOSUB3020
3260 V$(X,Y)="*":GOSUB3600
3270 GOTO3570
3280 REM
3290 IFX>4 THENRETURN
3300 IFV$(X+1,Y)<>"*" THENRETURN
3310 IFV$(X+2,Y)<>" " THENRETURN
3320 V$(X,Y)=" ":GOSUB3600
3330 X=X+1:GOSUB3020
3340 V$(X,Y)=" ":GOSUB3600
3350 X=X+1:GOSUB3020
3360 V$(X,Y)="*":GOSUB3600
3370 GOTO3570
3380 REM
3390 IFY>4 THENRETURN
3400 IFV$(X,Y+1)<>"*" THENRETURN
3410 IFV$(X,Y+2)<>" " THENRETURN
3420 V$(X,Y)=" ":GOSUB3600
3430 Y=Y+1:GOSUB3020
3440 V$(X,Y)=" ":GOSUB3600
3450 Y=Y+1:GOSUB3020
3460 V$(X,Y)="*":GOSUB3600
3470 GOTO3570
3480 REM
3490 IFY<2 THENRETURN
3500 IFV$(X,Y-1)<>"*" THENRETURN
3510 IFV$(X,Y-2)<>" " THENRETURN
3520 V$(X,Y)=" ":GOSUB3600
3530 Y=Y-1:GOSUB3020
3540 V$(X,Y)=" ":GOSUB3600
3550 Y=Y-1:GOSUB3020
3560 V$(X,Y)="*":GOSUB3600
3570 GOSUB4020:RETURN
3580 REM
3590 REM === WERK HET BORD BIJ ===
3600 HO=.27+X*.075:VE=.14+Y*.1
3610 CN=1:SR$="*":GOSUB650
3620 CN=0:SR$=V$(X,Y):GOSUB650
3630 RETURN
4000 REM
4010 REM === HOE IS DE STAND? ===
4020 C=0:FORM=0 TO6:FORN=0 TO6
4030 IFV$(M,N)="*" THENC=C+1
4040 NEXTN:NEXTM
4050 SR=C:GOSUB300:C$=SR$
4060 HO=.05:VE=.02:CN=1:SR$="NOCH "+CO$:GOSUB650
4070 CN=0:CO$=C$:IFC>1 THEN4160
4080 IFDM=0 THEN4100
4090 SR$="FERTIG! NUN SELBST PROBIEREN...":GOSUB650:GOTO4110
4100 SR$="Das ist geglueckt! GRATULATION!":GOSUB650
4110 HO=.05:VE=.9:CN=1:SR$=T$:GOSUB650
4120 SR$=S$:GOSUB650
4130 CN=0:SR$="DRUECKE RETURN":GOSUB650
4140 GOSUB210:IFIN<>13 THEN4140
4150 GOTO1000
4160 SR$="NOCH "+C$:GOSUB650:RETURN
5000 REM
5010 REM === INSTRUCTIES ===
5020 GOSUB100
5030 PRINT:PRINT"Durch ueberspringen der Sterne werden"
5040 PRINT:PRINT"diese entfernt. Ziel ist es, dass nur"
5050 PRINT:PRINT"ein Stern (in der Mitte) uebrigbleibt."
5060 PRINT:PRINT"Die Absprungposition erreicht man mit"
5070 PRINT:PRINT"den Cursortasten, dann Leertaste druecken"
5080 PRINT:PRINT"   =Sprungbereitschaft"
5090 PRINT:PRINT"und durch Cursor-Taste die gewuenschte"
5100 PRINT:PRINT"Sprungrichtung festlegen."
5110 PRINT:PRINT"Falsche *Zuege* werden vom Computer"
5120 PRINT:PRINT"       verweigert."
5130 PRINT:PRINT"  VIEL              SPASS !"
5140 PRINT:PRINT"---> TASTE DRUECKEN";
5150 GOSUB210:RETURN
6000 REM ===DEMONSTRATIE ===
6010 FORD=1 TO31:READA$
6020 X$=MID$(A$,1,1):X=VAL(X$)
6030 Y$=MID$(A$,2,1):Y=VAL(Y$)
6040 GOSUB3020:GOSUB210
6050 Q$=MID$(A$,3,1):Q=VAL(Q$)
6060 GOSUB3170:GOSUB210
6070 NEXTD:GOTO1000
25000 DATA"313","521","444","464","262"
25010 DATA"631","433","464","322","621"
25020 DATA"413","433","641","454","122"
25030 DATA"203","401","321","022","234"
25040 DATA"203","254","223","032","233"
25050 DATA"042","254","331","354","431"
25060 DATA"132"
32000 REM
32010 REM GEMAAKT OP EEN BBC COMPUTER
32020 REM DOOR
32030 REM
32040 REM Ch.W. Brederode
32050 REM Lisse / Niederlande
32060 REM
32100 REM TROS RADIO dd 870923
32110 REM
32120 REM Erstausstrahlung Radio DDR
32130 REM 891115