start1:
' 3D-Tic-Tac-Toe
' Armin Vogt

RANDOMIZE TIMER
DEFINT a-z:DEFSNG r,g,b
 GOTO begin
   
du:
   MENU ON:LOCATE 28,1:PRINT "Dein Zug ?       "
mse:   
   WHILE (NOT MOUSE(0)):WEND
     xf=MOUSE(1):yf=MOUSE(2)
   IF yf>50 AND yf<60 OR yf>100 AND yf<110 OR yf>150 AND yf<160 OR yf<10 OR yf>200 THEN mse
     eb=3-INT (yf/51):yf=yf-(3-eb)*50-10
     sp=INT ((xf-260+yf*5)/80.1)   
   IF sp<0 OR sp>3 THEN mse    
     ze=INT (yf/10.1):nr=eb*16+ze*4+sp+1        
   IF set(nr,0)<>0 THEN BEEP:GOTO mse
     GOSUB scrn:MENU OFF
   LOCATE 28,1:PRINT "Ich setze auf...."   
  GOTO strategie
  
setzen:
   IF flag=1 THEN RETURN
   SOUND 850,2,255:SOUND 750,2,255:SOUND 1000,1,255
   FOR f=0 TO 600:NEXT
   IF set(nr,0)<>0 THEN BEEP:STOP
   zug=zug+1
   GOSUB scrn
  GOTO du
  
strategie:
   IF zug<3 THEN vzug
     n=0:m=0:n1=0:n3=0:ni=0
   FOR j=1 TO 76
     su=win(j,0)
     IF su<>0 THEN
       IF su=4 THEN duwin
       IF su=15 THEN ni=ni+1:s1(ni)=j
       IF su=3 THEN n3=n3+1:s3(n3)=j
       IF su=5 THEN n1=n1+1:c1(n1)=j
       IF su=2 OR su=10 THEN szwei
     END IF  
loop:
   NEXT j:GOTO block3
  
szwei:
   IF su=2 THEN
     FOR i=1 TO 4
       IF set(win(j,i),0)=0 THEN n=n+1:sl(n)=win(j,i)
     NEXT i:GOTO loop
   END IF
   
czwei:
   FOR i=1 TO 4
     IF set(win(j,i),0)=0 THEN m=m+1:cl(m)=win(j,i)
   NEXT i:GOTO loop
                               
block3:
   IF ni<>0 AND flag=0 THEN ichwin
   IF ni<>0 AND flag=1 THEN s3(1)=s1(1):n3=1
   IF n3<>0 THEN 
     FOR i=1 TO 4
       IF set(win(s3(1),i),0)=0 THEN nr=win(s3(1),i): GOTO setzen
     NEXT i
   END IF
   
mtest:
   IF (m+n1+n)=0 THEN 
     FOR i=1 TO 76
       IF win(i,0)<=1 THEN vzug
     NEXT i
     GOTO remis
   END IF
   
cdoppel:
   IF m>=4 THEN 
     FOR i=1 TO m-2
       FOR l=i+1+(i MOD 2) TO m
         IF cl(i)=cl(l) THEN nr=cl(i):GOTO setzen
     NEXT l,i
   END IF
   
sdoppel:   
   IF n<4 THEN vzug
   FOR i=1 TO n-2
     FOR l=i+1+(i MOD 2) TO n
       IF sl(i)=sl(l) THEN nr=sl(l):GOTO setzen
   NEXT l,i
      
   FOR i=1 TO m
     FOR l=1 TO n1
       f=c1(l)
       FOR p=1 TO 4
         IF win(f,p)=cl(i) THEN 
           FOR j=1 TO 4
             IF j<>p THEN
              IF set(win(f,j),0)=0 THEN
                 nr=win(f,j):GOTO setzen
               END IF
             END IF  
           NEXT j
         END IF       
   NEXT p,l,i

vzug:
   IF gut(0)=0 THEN
     FOR i=1 TO 16
       IF set(gut(i),0)=0 THEN nr=gut(i):GOTO setzen
     NEXT i:gut(0)=1
   END IF    
   FOR nr=1 TO 64
    IF set(nr,0)=0 THEN setzen
   NEXT
   
remis:
   LOCATE 28,1:PRINT "REMIS !!         ":GOTO klick
   
duwin:
   LOCATE 28,1:PRINT "Du hast gewonnen mit der Reihe:"
  GOTO win
  
ichwin:
   j=s1(ni)
   FOR i=1 TO 4
     IF set(win(j,i),0)<>0 THEN NEXT i
   nr=win(j,i):IF flag=1 THEN setzen 
   LOCATE 28,1:PRINT "Ich setze auf....":GOSUB scrn
   LOCATE 28,1:PRINT "Ich habe gewonnen mit der Reihe:"
   
win:   
   FOR l=1 TO 4
     nr=win(j,l):fa=7:GOSUB scrn
   NEXT l
   
klick:   
   LOCATE 29,1:PRINT "Bitte linken Mausknopf drücken"
   WHILE (NOT MOUSE(0)):WEND
  GOTO quit
  
scrn: 
      eb=INT((nr-1)/16):za=nr-16*eb
      ze=INT((za-1)/4):sp=za-ze*4-1
      yf=161-50*eb+10*ze
      xf=260+80*sp-50*ze    
fill: 
     AREA (xf,yf):AREA STEP(72,0):AREA STEP(-42,8):AREA STEP(-71,0)
     COLOR fa:AREAFILL:COLOR 1
   IF flag=1 THEN RETURN
   set(nr,0)=s
summe:  
   FOR i=1 TO 7
     p=set(nr,i)
     IF p<>0 THEN win(p,0)=win(p,0)+s
   NEXT i
   s=s XOR 4:fa=fa XOR 12:RETURN    
  
begin:
   DIM set(64,7),win(76,4),gut(16),cl(64),sl(64),c1(64)
   SCREEN 1,640,255,4,2
   WINDOW 3,"3-D Tic Tac Toe",(0,0)-(630,240),12,1
   MENU 1,0,1,"  OPTIONS  "
   MENU 1,1,1,"  Best Move"
   MENU 1,2,1,"  Change   "
   MENU 1,3,1,"  New Game "
   MENU 1,4,1,"  Save Game"
   MENU 1,5,1,"  Load Game"
   MENU 1,6,1,"  Quit     "
   MENU 2,0,1,"":MENU 3,0,1,"":MENU 4,0,1,""
     
    DATA 22,43,23,42,26,39,27,38,1,64,13,52,4,61,16,49
   FOR i=1 TO 16
    READ gut(i):NEXT i
    
   DATA  1,22,43,64, 13,26,39,52, 16,27,38,49,  4,23,42,61
   DATA  5,22,39,56,  9,26,43,60,  8,23,38,53, 12,27,42,57
   DATA  2,22,42,62,  3,23,43,63, 14,26,38,50, 15,27,39,51
   DATA 21,22,23,24, 25,26,27,28, 18,22,26,30, 19,23,27,31
   DATA 37,38,39,40, 41,42,43,44, 34,38,42,46, 35,39,43,47
   DATA  6,22,38,54,  7,23,39,55, 10,26,42,58, 11,27,43,59
   DATA 17,22,27,32, 29,26,23,20, 33,38,43,48, 45,42,39,36
   DATA  1,21,41,61, 13,25,37,49,  1,18,35,52,  4,19,34,49
   DATA  4,24,44,64, 16,28,40,52, 16,31,46,61, 13,30,47,64
   DATA  1,17,33,49,  4,20,36,52, 16,32,48,64, 13,29,45,61
   DATA  5,21,37,53,  9,25,41,57,  2,18,34,50,  3,19,35,51
   DATA  8,24,40,56, 12,28,44,60, 15,31,47,63, 14,30,46,62
   DATA  1, 6,11,16, 13,10, 7, 4, 49,54,59,64, 61,58,55,52
   DATA  1, 2, 3, 4,  4, 8,12,16, 13,14,15,16,  1, 5, 9,13
   DATA 49,50,51,52, 52,56,60,64, 61,62,63,64, 49,53,57,61
   DATA  2, 6,10,14,  3, 7,11,15,  5, 6, 7, 8,  9,10,11,12
   DATA 50,54,58,62, 51,55,59,63, 53,54,55,56, 57,58,59,60
   DATA 29,30,31,32, 45,46,47,48, 17,18,19,20, 33,34,35,36
   DATA 17,21,25,29, 33,37,41,45, 20,24,28,32, 36,40,44,48
   FOR i=1 TO 76
     FOR j=1 TO 4
       READ win(i,j):NEXT j,i
       
   DATA 1,1,29,31,37,49,53,56,  4,4,32,33,38,50,53,54
   DATA 13,2,30,36,40,50,55,56, 16,3,34,35,39,49,54,55
   DATA 22,1,5,9,13,15,21,25,   23,4,7,10,13,16,22,26
   DATA 26,2,6,11,14,15,23,26,  27,3,8,12,14,16,24,25
   DATA 38,3,7,11,17,19,21,27,  39,2,5,12,17,20,22,28
   DATA 42,4,8,9,18,19,23,28,   43,1,6,10,18,20,24,27
   DATA 49,3,30,32,37,51,57,60, 52,2,31,34,38,52,57,58
   DATA 61,4,29,35,40,52,59,60, 64,1,33,36,39,51,58,59
   DATA 2,9,43,53,61,  3,10,44,53,62,  5,5,41,56,63,  6,21,49,61,63
   DATA 7,22,50,62,63, 8,7,45,54,63,   9,6,42,56,64,  10,23,50,61,64
   DATA 11,24,49,62,64,12,8,46,54,64,  14,11,48,55,61,15,12,47,55,62
   DATA 17,25,37,71,73,18,15,31,43,71, 19,16,32,44,71,20,26,38,71,75
   DATA 21,13,29,41,73,24,13,33,45,75, 25,14,30,42,73,28,14,34,46,75
   DATA 29,26,40,69,73,30,15,36,48,69, 31,16,35,47,69,32,25,39,69,75
   DATA 33,27,37,72,74,34,19,32,43,72, 35,20,31,44,72,36,28,38,72,76
   DATA 37,17,30,41,74,40,17,34,45,76, 41,18,29,42,74,44,18,33,46,76
   DATA 45,28,40,70,74,46,19,35,48,70, 47,20,36,47,70,48,27,39,70,76
   DATA 50,11,43,57,65,51,12,44,57,66, 53,7,41,60,67, 54,21,51,65,67
   DATA 55,22,52,66,67,56,5,45,58,67,  57,8,42,60,68, 58,23,52,65,68
   DATA 59,24,51,66,68,60,6,46,58,68,  62,9,59,65,48, 63,10,47,59,66
   FOR i=1 TO 16:READ a
     FOR j=1 TO 7
       READ set(a,j):NEXT j,i
   FOR i=1 TO 48:READ a
     FOR j=1 TO 4
       READ set(a,j):NEXT j,i
       
start:
   ON MENU GOSUB menue
   FOR i=4 TO 9
     READ r(i):READ g(i):READ b(i):PALETTE i,r(i),g(i),b(i)
   NEXT i
rgb:   
    DATA 0,.7,1,.77,0,0,1,.35,0,1,1,.27,0,.7,0,.48,.57,.7  
   PALETTE 0,.48,.57,.7:COLOR ,9:CLS
   FOR i=0 TO 3
     j=i*50
      AREA (60,j+50):AREA (380,j+50):AREA (580,j+10):AREA (260,j+10)
     COLOR 2:AREAFILL
      AREA (60,j+50):AREA (60,j+55):AREA (382,j+55):AREA (382,j+50)
     COLOR 6:AREAFILL
      AREA (382,j+55):AREA (382,j+50):AREA (580,j+10):AREA (580,j+15)
     COLOR 5:AREAFILL:COLOR 1
       FOR y=1 TO 5 
         LINE (310-y*50,y*10+j)-STEP(320,0)
         LINE (180+y*80,10+j)-STEP(-200,40)
       NEXT y      
   NEXT i
   MENU ON
   ON ERROR GOTO fehler          
   zug=1:fa=4:flag=0
   LOCATE 28,1:INPUT "1=Du beginnst, sonst der Computer :";s$
   LOCATE 28,1:PRINT SPACE$(75)
   IF s$="1" THEN du
   fa=8:s=5:zz=INT (RND*8+1)
   nr=gut(zz):GOTO setzen
  
menue:
   ON MENU(1) GOSUB best,change,quit,sve,ld,ende
   LINE (0,216)-(600,232),9,bf
   SOUND 1500,4,255:RETURN du
   
quit:
   LINE (0,216)-(600,232),9,bf   
   FOR j=0 TO 3
    FOR i=1 TO 20
       SCROLL (50,10+j*50)-(580,55+j*50),8,-2
   NEXT i,j
   LOCATE 13,29:PRINT "Neues Spiel (J/N) :";    
   IF INPUT$(1)="j" THEN neu

ende:
   MENU RESET
   WINDOW CLOSE 3
   SCREEN CLOSE 1
END   
   
best:   
   LOCATE 28,1:PRINT "Das guenstigste Feld wird gelb gefaerbt...."
   flag=1:fa1=fa
   GOSUB swp
   GOSUB strategie
   fa=7:GOSUB scrn
   GOSUB swp
   LOCATE 29,1:PRINT "Bitte linken Mausknopf druecken"
   WHILE (NOT MOUSE(0)):WEND
   fa=2:GOSUB scrn
   flag=0:fa=fa1:RETURN
   
change:
   LOCATE 28,1:PRINT "Die Felder werden getauscht...."
   SWAP r(4),r(8):SWAP g(4),g(8):SWAP b(4),b(8)
   PALETTE 4,r(4),g(4),b(4):PALETTE 8,r(8),g(8),b(8)
   fa=fa XOR 12

swp:
   FOR i=1 TO 64
     f=set(i,0)
     IF f<>0 THEN set(i,0)=f XOR 4
   NEXT i
    
sum:   
   FOR i=1 TO 76:win(i,0)=0
     FOR j=1 TO 4
       win(i,0)=win(i,0)+set(win(i,j),0)
   NEXT j,i:RETURN       
   
neu:
   FOR i=1 TO 76
     IF i<65 THEN set(i,0)=0
     win(i,0)=0
   NEXT i:RESTORE rgb   
   GOTO start  
   
sve:
   LOCATE 28,1:PRINT "Der Spielstand wird gespeichert...."
   OPEN "df0:ticdat" FOR OUTPUT AS #1
     FOR i=1 TO 64
       WRITE #1,set(i,0)
     NEXT i:WRITE #1,zug
   CLOSE #1
   RETURN 

ld:
   LOCATE 28,1:PRINT "Spielstand wird geladen...."
   flag=1
   OPEN "df0:ticdat" FOR INPUT AS #1
     FOR nr=1 TO 64
       INPUT #1,set(nr,0)
       IF set(nr,0)<>0 THEN fa=set(nr,0)+3:GOSUB scrn
     NEXT nr:INPUT #1,zug
   CLOSE #1   
   GOSUB sum
   flag=0:fa=4
   RETURN 
   
fehler:
   IF ERR<>53 THEN ende
   WINDOW 3
   LOCATE 28,1:PRINT "Datei `ticdat` existiert nicht auf dieser Diskette."
   FOR i=0 TO 10000:NEXT
   LOCATE 28,1:PRINT "                                                   "
   RESUME du   
