100 REM  ***** SOLITAER ************************************ VON ALEXANDER BERGER ***********************************************************
110 SY=1 :: RANDOMIZE :: CALL SCREEN(2) :: CALL CLEAR :: FOR A=2 TO 8 :: CALL COLOR(A,16,2) :: NEXT A
115 FOR COUNT=1 TO 1000 :: NEXT COUNT
120 S=0
130 CALL CHAR(128,"000000000000FFFF")
140 CALL CHAR(129,"FFFF000000000000")
150 CALL CHAR(130,"0303030303030303")
160 CALL CHAR(96,"") :: CALL CHAR(64,"3C4299A1A199423C") :: CALL CHAR(93,"0044004444444438")
170 CALL CHAR(91,"00420038447C4444")
180 CALL CHAR(131,"C0C0C0C0C0C0C0C0")
190 CALL CHAR(132,"FFFFC0C0C0C0C0C0")
200 CALL CHAR(133,"FFFF030303030303") :: CALL CHAR(136,"0303") :: CALL CHAR(137,"C0C0") :: CALL CHAR(138,"0000000000000303")
210 CALL CHAR(134,"030303030303FFFF") :: CALL CHAR(139,"000000000000C0C0")
220 CALL CHAR(135,"C0C0C0C0C0C0FFFF") :: CALL CHAR(120,"")
230 CALL CHAR(100+S,"0000000000010307")
240 CALL CHAR(101+S,"000000000080C0E0")
250 CALL CHAR(102+S,"0703010000000000")
260 CALL CHAR(103+S,"E0C0800000000000")
270 IF S=4 THEN 290
280 S=4 :: GOTO 230
290 S=0 :: CALL COLOR(9,10,5) :: CALL COLOR(10,2,5) :: CALL COLOR(13,11,2) :: CALL COLOR(14,11,2)
295 FOR COUNT=1 TO 150 :: NEXT COUNT
300 ROP=0 :: CALL DELSPRITE(ALL) :: DISPLAY AT(22,5):"" :: PL=32 :: PK=1 :: JOY=0
310 CALL SOUND(-555,262,1,330,9,392,17)
320 CALL HCHAR(5,13,138) :: CALL HCHAR(5,14,128,6) :: CALL HCHAR(5,20,139) :: CALL VCHAR(6,20,131,3) :: CALL HCHAR(9,20,135)
330 CALL HCHAR(9,21,128,3) :: CALL HCHAR(9,24,139) :: CALL VCHAR(10,24,131,6) :: CALL HCHAR(16,24,137) :: CALL HCHAR(16,21,129,3)
340 CALL HCHAR(16,20,132) :: CALL VCHAR(17,20,131,3) :: CALL HCHAR(20,20,137) :: CALL HCHAR(20,14,129,6) :: CALL HCHAR(20,13,136)
350 CALL VCHAR(17,13,130,3) :: CALL HCHAR(16,13,133) :: CALL HCHAR(16,10,129,3)
360 CALL HCHAR(16,9,136) :: CALL VCHAR(10,9,130,6) :: CALL HCHAR(9,9,138) :: CALL HCHAR(9,10,128,3) :: CALL HCHAR(9,13,134)
370 CALL VCHAR(6,13,130,3)
380 FOR A=6 TO 9 :: CALL HCHAR(A,14,32,6) :: NEXT A :: FOR A=10 TO 15 :: CALL HCHAR(A,10,32,14)
390 NEXT A :: FOR A=16 TO 19 :: CALL HCHAR(A,14,32,6) :: NEXT A
400 GOSUB 1710 :: RI=1 :: A=12 :: B=9 :: GOSUB 1660 :: IF SCH=1 THEN 410 ELSE 420
410 A$="    @ 1983" :: A=14 :: B=9 :: GOSUB 1660 :: SCH=0
420 IF QI=2 THEN 430 ELSE 440
430 A$="SPIELSTART JOYSTICKS MIT <J>  " :: A=3 :: B=2 :: QI=0 :: GOSUB 1660 :: GOTO 450
440 QI=QI+1 :: A$="SPIELSTART TASTATUR MIT <T> " :: A=3 :: B=2 :: GOSUB 1660
450 A$="SPIELREGELN MIT <SPACE>" :: A=22 :: B=4 :: GOSUB 1660
460 CALL KEY(0,K,S) :: IF K=84 OR K=116 THEN GOSUB 1370 :: GOTO 530
470 IF K=32 THEN 520
480 IF K=74 OR K=106 THEN JOY=1 :: GOSUB 1370 :: GOTO 530
490 CALL COLOR(12,2,INT((RND*13)+3))
500 FOR A=19 TO 16 STEP-1 :: CALL HCHAR(A,14,120,6) :: NEXT A :: FOR A=15 TO 10 STEP-1 :: CALL HCHAR(A,10,120,14)
510 NEXT A :: FOR A=9 TO 6 STEP-1 :: CALL HCHAR(A,14,120,6) :: NEXT A :: GOTO 380
520 GOTO 1440
530 FOR A=19 TO 16 STEP-1 :: CALL HCHAR(A,14,96,6) :: NEXT A :: FOR A=15 TO 10 STEP-1 :: CALL HCHAR(A,10,96,14)
540 NEXT A :: FOR A=9 TO 6 STEP-1 :: CALL HCHAR(A,14,96,6) :: NEXT A :: B=12
550 FOR Z=1 TO 3 :: B=B+2 :: FOR A=6 TO 18 STEP 2
560 CALL HCHAR(A,B,100) :: CALL HCHAR(A,B+1,101) :: CALL HCHAR(A+1,B,102) :: CALL HCHAR(A+1,B+1,103) :: NEXT A :: NEXT Z :: B=8
570 FOR Z=1 TO 2 :: B=B+2 :: FOR A=10 TO 14 STEP 2
580 CALL HCHAR(A,B,100) :: CALL HCHAR(A,B+1,101) :: CALL HCHAR(A+1,B,102) :: CALL HCHAR(A+1,B+1,103) :: NEXT A :: NEXT Z
590 IF CC=8 THEN 610
600 B=18 :: CC=8 :: GOTO 570
610 CC=0 :: COD=104 :: B=16 :: A=12 :: GOSUB 1320
620 CALL CHAR(112,"00000003060C181010180C0603000000000000C06030180808183060C0000000") :: CALL MAGNIFY(3) :: GOSUB 1380
630 CALL SPRITE(#1,112,11,89,121)
640 COD=100 :: A=23 :: B=10 :: GOSUB 1320
650 COD=104 :: A=23 :: B=22 :: GOSUB 1320
660 PL=32 :: PK=1 :: DISPLAY AT(22,7):PL;TAB(19);PK
670 CALL KEY(0,K,S) :: IF JOY=1 THEN GOSUB 1750 :: GOTO 790
680 IF S=0 THEN 670
690 IF K=69 THEN 700 ELSE 710
700 ROP=0 :: DZ=-16 :: DS=0 :: GOTO 820
710 IF K=88 THEN 720 ELSE 730
720 ROP=0 :: DZ=16 :: DS=0 :: GOTO 820
730 IF K=83 THEN 740 ELSE 750
740 ROP=0 :: DZ=0 :: DS=-16 :: GOTO 820
750 IF K=68 THEN 760 ELSE 770
760 ROP=0 :: DZ=0 :: DS=16 :: GOTO 820
770 IF K=13 THEN 780 ELSE 790
780 GOTO 870
790 IF K=15 THEN GOSUB 1580 :: GOTO 300
800 IF K=14 THEN CALL DELSPRITE(ALL) :: GOSUB 1400 :: ROP=0 :: GOTO 530 ELSE 670
810 REM  ***** SOLITAER **********************************PROGRAMMIERT VON ALEXANDER****************** BERGER *******************************
820 CALL POSITION(#1,O,P)
830 CALL GCHAR((O+DZ+7)/8,(P+DS+7)/8,ZE)
840 IF ZE=100 OR ZE=104 THEN 850 ELSE CALL SOUND(-1,110,1) :: DISPLAY AT(1,5):"ENDE DES SPIELFELDES!" :: GOTO 670
850 GOSUB 1380 :: CALL LOCATE(#1,O+DZ,P+DS) :: CALL SOUND(100,245,25,490,25) :: GOTO 670
860 REM  *************************************************COPYRIGHT ALEXANDER BERGER*****************************
870 CALL POSITION(#1,O,P)
880 CALL GCHAR((O+7)/8,(P+7)/8,ZE)
890 IF ZE=100 THEN 920 ELSE CALL SOUND(-8,880,1) :: DISPLAY AT(1,5):"   VERBOTENER ZUG   " :: GOTO 670
900 REM  **************************************************** VERSION EXT.BASIC ********************************
910 REM  ************************************************** VOLLENDET AM DIENSTAG, ******* 5. JULI 83/23h55 *********************************
920 GOSUB 1380 :: CALL SPRITE(#2,112,11,O,P)
930 CALL KEY(0,K,S) :: IF JOY=1 THEN GOSUB 1850 :: GOTO 1050
940 IF S=0 THEN 930
950 IF K=69 THEN 960 ELSE 970
960 ROP=0 :: DZ=-16 :: DS=0 :: GOTO 1080
970 IF K=88 THEN 980 ELSE 990
980 ROP=0 :: DZ=16 :: DS=0 :: GOTO 1080
990 IF K=83 THEN 1000 ELSE 1010
1000 ROP=0 :: DZ=0 :: DS=-16 :: GOTO 1080
1010 IF K=68 THEN 1020 ELSE 1030
1020 ROP=0 :: DZ=0 :: DS=16 :: GOTO 1080
1030 IF K=13 THEN 1040 ELSE 1050
1040 IF ROP=1 THEN GOTO 1950 ELSE ROP=ROP+1 :: GOTO 1120
1050 IF K=14 THEN CALL DELSPRITE(ALL) :: GOSUB 1400 :: ROP=0 :: GOTO 530
1060 IF K=15 THEN GOSUB 1580 :: GOTO 300
1070 GOTO 930
1080 CALL POSITION(#2,Q,R)
1090 CALL GCHAR((Q+DZ+7)/8,(R+DS+7)/8,ZA)
1100 IF ZA=100 OR ZA=104 THEN 1110 ELSE CALL SOUND(-1,110,1) :: DISPLAY AT(1,5):"ENDE DES SPIELFELDES" :: GOTO 930
1110 GOSUB 1380 :: CALL LOCATE(#2,Q+DZ,R+DS) :: CALL SOUND(100,245,25,490,25) :: GOTO 930
1120 CALL POSITION(#2,Q,R) :: CALL POSITION(#1,O,P)
1130 IF Q=O AND R=P THEN 930
1140 CALL GCHAR((Q+7)/8,(R+7)/8,ZA)
1150 IF ZA=104 THEN 1160 ELSE CALL SOUND(-8,880,1) :: DISPLAY AT(1,5):"   VERBOTENER ZUG   " :: GOTO 930
1160 CALL DISTANCE(#1,#2,EN)
1170 IF(EN<513 OR EN>2049)OR EN=1280 THEN CALL SOUND(-8,880,1) :: DISPLAY AT(1,5):"  FALSCHER ABSTAND  " :: GOTO 930 ELSE 1180
1180 UA=(O+Q)/2
1190 UB=(P+R)/2
1200 CALL GCHAR((UA+7)/8,(UB+7)/8,ZI)
1210 IF ZI=104 THEN CALL SOUND(-8,880,1) :: DISPLAY AT(1,5):"MITTELSTEIN IST LEER" :: GOTO 930
1220 GOSUB 1380
1230 COD=104 :: B=(P+7)/8 :: A=(O+7)/8 :: GOSUB 1320
1240 CALL SOUND(100,222,2,444,8,888,16)
1250 COD=100 :: B=(R+7)/8 :: A=(Q+7)/8 :: PL=PL-1 :: PK=PK+1 :: GOSUB 1320
1260 CALL SOUND(100,333,2,666,4,1332,16)
1270 COD=104 :: B=(UB+7)/8 :: A=(UA+7)/8 :: GOSUB 1320
1280 CALL SOUND(100,444,2,888,4,1776,16)
1290 CALL DELSPRITE(#1) :: CALL POSITION(#2,O,P)
1300 CALL SPRITE(#1,112,11,O,P) :: CALL DELSPRITE(#2) :: DISPLAY AT(22,7):PL;TAB(19);PK
1310 IF PL=1 THEN 1420 ELSE 670
1320 CALL HCHAR(A,B,COD)
1330 CALL HCHAR(A,B+1,COD+1)
1340 CALL HCHAR(A+1,B,COD+2)
1350 CALL HCHAR(A+1,B+1,COD+3)
1360 RETURN
1370 DISPLAY AT(22,1):""
1380 DISPLAY AT(1,1):"" :: DISPLAY AT(2,1):"" :: DISPLAY AT(3,1):""
1390 RETURN
1400 REM  * JEDEM DAS SEINE *****************************
1410 DISPLAY AT(1,2):"BIS AUF";PL;" STEINE ALLE GESCHLAGEN" :: RETURN
1420 DISPLAY AT(1,5):"GRATULATION,";"    SIE HABEN GEWONNEN." :: DISPLAY AT(22,5):"NEUES SPIEL MIT ENTER" :: CALL KEY(0,K,S)
1430 IF K=13 THEN CALL DELSPRITE(ALL) :: DISPLAY AT(1,1):"" :: DISPLAY AT(2,1):"" :: DISPLAY AT(22,1):"" :: GOTO 525 ELSE 1420
1440 CALL CLEAR
1450 PRINT "SPIELREGELN:   S O L I T [ R" :: PRINT "           " :: PRINT "DIESES SPIEL BESTEHT DARIN"
1460 PRINT :: PRINT "DURCH EINKREISEN UND ]BER-" :: PRINT :: PRINT "SPRINGEN VON STEINEN ALLE" :: PRINT
1470 PRINT "STEINE BIS AUF EINEN AUS" :: PRINT :: PRINT "DEM FELD ZU BEKOMMEN. DER" :: PRINT :: PRINT "SPRUNGSTEIN WIRD MIT DEM 1." :: PRINT
1480 PRINT "RING MARKIERT,ENTERN,UND" :: PRINT :: PRINT "NUN WIRD DIE STELLE MIT DEM" :: PRINT :: PRINT "ZWEITEN RING MARKIERT,AUF"
1490 PRINT :: PRINT "DIE MAN SPRINGEN WILL." :: PRINT :: PRINT
1500 DISPLAY AT(24,1):"<WEITER MIT ENTER>" :: CALL KEY(0,K,S) :: IF K=13 THEN GOSUB 1580 :: GOTO 1505 ELSE DISPLAY AT(24,1):"" :: GOTO 1500
1505 FOR COUNT=1 TO 300 :: NEXT COUNT
1510 PRINT "SPIELREGELN:  S O L I T [ R" :: PRINT "           " :: PRINT "DURCH DAS ZWEITE ENTER" :: PRINT
1520 PRINT "WIRD DER ZUG EINGELEITET." :: PRINT :: PRINT "FALSCHE Z]GE MIT NOCHMALIGEM":"" :: PRINT "ENTER KORREGIEREN. DIE RINGE":""
1530 PRINT "WERDEN DURCH DIE PFEILTASTEN" :: PRINT :: PRINT "BEWEGT. MIT BEGIN WIRD DAS " :: PRINT :: PRINT "SPIEL BEENDET UND MIT BACK":""
1540 PRINT "KEHRT MAN ZUR TITELSEITE" :: PRINT :: PRINT "ZUR]CK. SOLIT[R IST AUCH MIT" :: PRINT :: PRINT "DEN JOYSTICKS SPIELBAR."
1550 PRINT
1560 DISPLAY AT(24,1):"<WEITER MIT ENTER>" :: CALL KEY(0,K,S) :: IF K=13 THEN GOSUB 1580 :: GOTO 295 ELSE DISPLAY AT(24,1):"" :: GOTO 1560
1570 REM  *DAS IST DAS ENDE* ***************************
1580 CALL DELSPRITE(ALL) :: B=1 :: C=32 :: D=24
1590 FOR A=1 TO 12
1600 CALL HCHAR(A,B,32,C)
1610 CALL VCHAR(A+1,33-B,32,D-1)
1620 CALL HCHAR(25-A,B,32,C-1)
1630 CALL VCHAR(A+1,B,32,D-2)
1640 C=C-1 :: B=B+1 :: D=D-1 :: NEXT A
1650 RETURN
1660 FOR I=1 TO LEN(A$)
1670 X=ASC(SEG$(A$,I,1))
1680 CALL HCHAR(A,B+I,X)
1690 IF RI=0 THEN 1700 :: T=INT((RND*1001)+110) :: IF X=32 THEN 1700 ELSE CALL SOUND(-1,T,2)
1700 NEXT I :: RI=0 :: RETURN
1710 SY=SY*(-1) :: IF SY<0 THEN 1720 ELSE 1730
1720 A$="    SOLIT[R " :: GOTO 1740
1730 A$=" VON A.BERGER " :: SCH=1 :: GOTO 1740
1740 RETURN
1750 CALL JOYST(1,A,B) :: CALL JOYST(3,C,D) :: IF(A+B+C+D)=0 THEN 1800
1760 IF(A=0 AND B=4)OR(C=0 AND D=4)THEN 700
1770 IF(A=0 AND B=-4)OR(C=0 AND D=-4)THEN 720
1780 IF(A=4 AND B=0)OR(C=4 AND D=0)THEN 760
1790 IF(A=-4 AND B=0)OR(C=-4 AND D=0)THEN 740
1800 CALL KEY(1,A,B) :: IF B=0 THEN 1820
1810 IF A<>10 THEN 780
1820 CALL KEY(2,A,B) :: IF B=0 THEN 1840
1830 IF A<>9 THEN 780
1840 RETURN
1850 CALL JOYST(1,A,B) :: CALL JOYST(2,C,D) :: IF(A+B+C+D)=0 THEN 1900
1860 IF(A=0 AND B=4)OR(C=0 AND D=4)THEN 960
1870 IF(A=0 AND B=-4)OR(C=0 AND D=-4)THEN 980
1880 IF(A=4 AND B=0)OR(C=4 AND D=0)THEN 1020
1890 IF(A=-4 AND B=0)OR(C=-4 AND D=0)THEN 1000
1900 CALL KEY(1,A,B) :: IF B=0 THEN 1920
1910 IF A<>10 THEN 1040
1920 CALL KEY(2,A,B) :: IF B=0 THEN 1940
1930 IF A<>9 THEN 1040
1940 RETURN
1950 CALL POSITION(#1,A,B) :: CALL POSITION(#2,C,D) :: IF(A=C AND B=D)THEN ROP=0 :: GOTO 930
1960 CALL DELSPRITE(#2) :: DISPLAY AT(1,1):"   FALSCHER ZUG AUFGEHOBEN" :: DISPLAY AT(2,1):"" :: ROP=0 :: GOTO 670
