home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / friendly / othello.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-25  |  8.4 KB  |  134 lines
  1. 10 DEFINT A-Y:DEFSTR Z:DIM MTBL(99),VTBL(99),DIR1(8),DIR(7),Z(2),PLAYER(2),WALLSQ(11):ON KEY(10) GOSUB 1190:DEF SEG:DIM SUB%(150):GOTO 160
  2. 20 DEF SEG:ROUTINE=VARPTR(SUB%(0)):'SUB%(0)=&H55CC
  3. 30 CALL ROUTINE (WALLSQ(0),DIR1(0),MTBL(0),VTBL(0))
  4. 40 MV=VTBL(1)/2:HOLD=MV
  5. 50 LIN=19-((HOLD\10)*2):CSR=(HOLD MOD 10)*6+12:CHR=SCREEN(LIN,CSR):LIN2=LIN:CSR2=CSR:COLOR 31,0:LOCATE LIN2,CSR2:PRINT CHR$(15);:COLOR 15,0
  6. 60 FOR J=1 TO 500:NEXT
  7. 70 VALID=0:IF MV=0 OR MTBL(MV)<>0 THEN RETURN
  8. 80 B=0
  9. 90 IF MTBL(MV+DIR(B))<>PLAYER(T) THEN 150
  10. 100 A=MV+(2*DIR(B))
  11. 110 IF MTBL(A)=3 OR MTBL(A)=0 THEN 150
  12. 120 IF MTBL(A)<>T THEN A=A+DIR(B):GOTO 110
  13. 130 VALID=1:C=MV
  14. 140 IF C<>A THEN MTBL(C)=T:C=C+DIR(B):GOTO 140
  15. 150 B=B+1:IF B<8 THEN 90 ELSE RETURN
  16. 160 CLS:SCREEN 0,0,0
  17. 170 T3=3:T0=0:MV=0:GOSUB 1130
  18. 180 XLIN=1:XPOS=1:GOSUB 900:GOSUB 820:GOSUB 1220:GOSUB 1250
  19. 190 IF Y THEN GOSUB 580:IF LEGAL=0 THEN CT=0 ELSE CT=CT+1:IF CT=2 THEN GOTO 730 ELSE T=PLAYER(T):GOTO 190
  20. 200 TT=TT+1:Y=Y+1:LOCATE 22,1:PRINT SPC(75)
  21. 210 IF T=2 THEN GOSUB 1250
  22. 220 GOSUB 330:GOSUB 240:T=PLAYER(T)
  23. 230 GOSUB 840:GOTO 190
  24. 240 ON T GOTO 250,310
  25. 250 IF MV=11 THEN VTBL(21)=1:VTBL(12)=1
  26. 260 IF MV=18 THEN VTBL(28)=1:VTBL(17)=1
  27. 270 IF MV=81 THEN VTBL(82)=1:VTBL(71)=1
  28. 280 IF MV=88 THEN VTBL(87)=1:VTBL(78)=1
  29. 290 IF MV=14 OR MV=15 OR MV=84 OR MV=85 THEN VTBL(MV+2)=35:VTBL(MV-2)=35
  30. 300 IF MV=41 OR MV=51 OR MV=48 OR MV=58 THEN VTBL(MV+20)=35:VTBL(MV-20)=35
  31. 310 IF T=2 THEN GOSUB 1020
  32. 320 RETURN
  33. 330 IF T=1 THEN 20
  34. 340 IF Y>1 THEN LIN=19-((HOLD\10)*2):CSR=(HOLD MOD 10)*6+12:CHR=SCREEN(LIN,CSR):LIN2=LIN:CSR2=CSR:GOTO 360
  35. 350 CHR=SCREEN(12,36):LIN=13:CSR=36:LIN2=13:CSR2=36:CHR=SCREEN (LIN2,CSR2)
  36. 360 COLOR 31,0:LOCATE LIN2,CSR2:PRINT CHR$(15);:COLOR 15,0
  37. 370 GOSUB 1280:IF Z=CHR$(13) THEN 500 ELSE IF Z>"0" AND Z<="9" THEN ON ASC(Z)-48 GOSUB 390,390,390,420,420,420,380,380,380:ON ASC(Z)-48 GOSUB 400,420,410,400,420,410,400,420,410:GOTO 430 ELSE 370
  38. 380 LIN=LIN-2:RETURN
  39. 390 LIN=LIN+2:RETURN
  40. 400 CSR=CSR-6:RETURN
  41. 410 CSR=CSR+6:RETURN
  42. 420 RETURN
  43. 430 COLOR 15,0:LOCATE LIN2,CSR2:PRINT CHR$(CHR);
  44. 440 IF CSR<18 THEN CSR=60
  45. 450 IF CSR>60 THEN CSR=18
  46. 460 IF LIN<3 THEN LIN=17
  47. 470 IF LIN>17 THEN LIN=3
  48. 480 CHR=SCREEN(LIN,CSR):LOCATE LIN,CSR,0:COLOR 31,0:PRINT CHR$(15);
  49. 490 LIN2=LIN:CSR2=CSR:COLOR 15,0:GOTO 370
  50. 500 B=(19-LIN)\2:A=CSR\6-2
  51. 510 MV=A+B*10:GOSUB 70
  52. 520 IF VALID THEN RETURN
  53. 530 LOCATE 21,1:PRINT SPC(79):LOCATE 21,20
  54. 540 PRINT"  Invalid Reply.    Please Try Again.";
  55. 550 FOR A=1 TO 3500:NEXT:LOCATE 21,1:PRINT SPC(79):GOTO 370
  56. 560 DEF SEG:POKE 106,0:IF INKEY$<>"" THEN 560
  57. 570 Z=INKEY$:IF Z="" THEN 570 ELSE RETURN
  58. 580 LEGAL=0:LOCATE 23,1:PRINT SPC(79)
  59. 590 LOCATE 24,1:PRINT SPC(79);:LOCATE 21,30
  60. 600 A=12
  61. 610 IF MTBL(A)<>0 THEN 690
  62. 620 B=0
  63. 630 IF MTBL(A+DIR(B))<>PLAYER(T) THEN 680
  64. 640 C=A+(2*DIR(B))
  65. 650 IF MTBL(C)=T3 OR MTBL(C)=T0 THEN 680
  66. 660 IF MTBL(C)=T THEN RETURN
  67. 670 C=C+DIR(B):GOTO 650
  68. 680 B=B+1:IF B<8 THEN 630
  69. 690 A=A+1:IF A<90 THEN 610
  70. 700 LOCATE 21,30
  71. 710 LEGAL=1:PRINT T$(T)" Have No Legal Play."
  72. 720 FOR AA=1 TO 2000:NEXT:LOCATE 21,1:PRINT SPC(79):RETURN
  73. 730 C(1)=0:C(2)=0:FOR A=12 TO 89:C(MTBL(A))=C(MTBL(A))+1:NEXT
  74. 740 LOCATE 21,33:COLOR 15,0
  75. 750 IF C(1)=C(2) THEN PRINT"The Game Is A TIE.":GOTO 770
  76. 760 LOCATE 21,35:IF C(2)>C(1) THEN PRINT"You Win." ELSE PRINT"I Win.
  77. 770 LOCATE 22,23:PRINT"Would You Like To Play Again? <Y/N>";:COLOR 3,0
  78. 780 GOSUB 1280:IF Z="Y" THEN RUN ELSE IF Z<>"N" THEN 780
  79. 790 CLEAR:ON ERROR GOTO 800:RUN"MENU2"
  80. 800 CLEAR:ON ERROR GOTO 810:RUN"MENU1"
  81. 810 RUN"MENU3"
  82. 820 CLS:COLOR 3,0:PRINT TAB(20)"F R I E N D L Y W A R E   O T H E L L O":COLOR 4,0:PRINT TAB(15)"╔═════╦═════╦═════╦═════╦═════╦═════╦═════╦═════╗":PRINT TAB(15)"║     ║     ║     ║     ║     ║     ║     ║     ║"
  83. 830 FOR A=7 TO 1 STEP-1:PRINT TAB(15)"╠═════╬═════╬═════╬═════╬═════╬═════╬═════╬═════╣":PRINT TAB(15)"║     ║     ║     ║     ║     ║     ║     ║     ║":NEXT A:PRINT TAB(15)"╚═════╩═════╩═════╩═════╩═════╩═════╩═════╩═════╝"
  84. 840 LOCATE 1,15:COLOR 15,0:FOR A=8 TO 1 STEP-1:LOCATE CSRLIN+2,15:FOR B=1 TO 8:D=A*10+B:LOCATE ,POS(0)+1:PRINT Z(MTBL(D));:NEXT B:NEXT A
  85. 850 C(1)=0:C(2)=0:FOR A=11 TO 88:C(MTBL(A))=C(MTBL(A))+1:NEXT
  86. 860 LOCATE 2,2:PRINT"I Am BLACK":LOCATE 2,67:PRINT"You Are WHITE"
  87. 870 LOCATE 3,2:PRINT" And Have":LOCATE 3,70:PRINT" And Have"
  88. 880 LOCATE 4,1:PRINT C(1)"Squares ":LOCATE 4,69:PRINT C(2)"Squares "
  89. 890 COLOR 3,0:RETURN
  90. 900 FOR A=11 TO 88:READ VTBL(A):NEXT:Z(0)="     ":Z(2)=" ███ ":Z(1)=" ░░░ ":FOR A=0 TO 99:MTBL(A)=0:NEXT:FOR A=0 TO 9:MTBL(A)=3:MTBL(90+A)=3:MTBL(A*10)=3:MTBL(A*10+9)=3:NEXT:MTBL(44)=1:MTBL(45)=2:MTBL(54)=2:MTBL(55)=1:PLAYER(1)=2:PLAYER(2)=1:T=2
  91. 910 FOR A=0 TO 7:READ DIR(A):DIR1(A)=DIR(A)*2:NEXT:FOR A=0 TO 7:READ WALLSQ(A):NEXT:T$(1)="I":T$(2)="You":GOTO 1300
  92. 920 DATA     0, 38, 18, 19, 19, 18, 38,  0,0
  93. 930 DATA 0, 38, 80, 25, 22, 22, 25, 80, 38,0
  94. 940 DATA 0, 18, 25, 20, 15, 15, 20, 25, 18,0
  95. 950 DATA 0, 19, 22, 15, 15, 15, 15, 22, 19,0
  96. 960 DATA 0, 19, 22, 15, 15, 15, 15, 22, 19,0
  97. 970 DATA 0, 18, 25, 20, 15, 15, 20, 25, 18,0
  98. 980 DATA 0, 38, 80, 25, 22, 22, 25, 80, 38,0
  99. 990 DATA 0,  0, 38, 18, 19, 19, 18, 38,  0
  100. 1000 DATA 1,11,10,9,-1,-11,-10,-9
  101. 1010 DATA &h0d0e,&h0f10,&h5354,&h5556,&h1f29,&h333d,&h2630,&h3a44
  102. 1020 IF (MTBL(12) AND MTBL(14))=2 AND ((MTBL(15) OR MTBL(16) OR MTBL(17)) AND 1)<>1 THEN VTBL(13)=1
  103. 1030 IF (MTBL(15) AND MTBL(17))=2 AND ((MTBL(13) OR MTBL(14) OR MTBL(15)) AND 1)<>1 THEN VTBL(16)=1
  104. 1040 IF (MTBL(21) AND MTBL(41))=2 AND ((MTBL(51) OR MTBL(61) OR MTBL(71)) AND 1)<>1 THEN VTBL(31)=1
  105. 1050 IF (MTBL(28) AND MTBL(48))=2 AND ((MTBL(58) OR MTBL(68) OR MTBL(78)) AND 1)<>1 THEN VTBL(38)=1
  106. 1060 IF (MTBL(58) AND MTBL(78))=2 AND ((MTBL(28) OR MTBL(38) OR MTBL(48)) AND 1)<>1 THEN VTBL(68)=1
  107. 1070 IF (MTBL(82) AND MTBL(84))=2 AND ((MTBL(85) OR MTBL(86) OR MTBL(87)) AND 1)<>1 THEN VTBL(83)=1
  108. 1080 IF (MTBL(85) AND MTBL(87))=2 AND ((MTBL(83) OR MTBL(84) OR MTBL(85)) AND 1)<>1 THEN VTBL(86)=1
  109. 1090 IF MV MOD 10=1 OR MV MOD 10=8 THEN VTBL(MV-10)=35:VTBL(MV+10)=35
  110. 1100 IF MV>11 AND MV<19 THEN VTBL(MV-1)=35:VTBL(MV+1)=35
  111. 1110 IF MV>81 AND MV<89 THEN VTBL(MV-1)=35:VTBL(MV+1)=35
  112. 1120 RETURN
  113. 1130 CLS:COLOR 6,0:LOCATE 1,1:PRINT STRING$(80,219):FOR A=2 TO 22:LOCATE A,1:PRINT"█":LOCATE A,80:PRINT"█":NEXT:LOCATE 23,1:PRINT STRING$(80,219);:LOCATE 3,20:COLOR 11,0:PRINT"F R I E N D L Y W A R E   O T H E L L O
  114. 1140 COLOR 15,0:LOCATE 8,23:PRINT"Would You Like Instructions? <Y/N>":GOSUB 1280:IF Z="N" THEN CLS:RETURN ELSE IF Z<>"Y" THEN 1140
  115. 1150 COLOR 7,0:LOCATE 5,20:PRINT"Computer Othello is a game played on an":LOCATE 6,20:PRINT"8  by  8  game board. The object of the":LOCATE 7,20:PRINT"game is to `capture' more  squares than
  116. 1160 LOCATE 8,20:PRINT"the computer by outflanking his squares":LOCATE 9,20:PRINT"with your squares.":LOCATE 11,20:PRINT"The squares along the wall are valuable":LOCATE 12,20:PRINT"because  they  can only be  `outflanked'
  117. 1170 LOCATE 13,20:PRINT"in one direction. The corner can not be":LOCATE 14,20:PRINT"recaptured after it has been taken.  It":LOCATE 15,20:PRINT"is the most important square to capture.":LOCATE 17,20:PRINT"Some strategy to use would be to  avoid
  118. 1180 LOCATE 18,20:PRINT"any square adjacent to the wall,  while":LOCATE 19,20:PRINT"you try to capture wall squares.":LOCATE 25,27:COLOR 15,0:PRINT"Strike Any Key To Continue";:GOSUB 1280:CLS:RETURN
  119. 1190 KEY(10) OFF:XLIN=CSRLIN:XPOS=POS(0):LOCATE 25,1:PRINT SPC(79);
  120. 1200 LOCATE 25,21:PRINT"Do You Wish To Leave This Game? <Y/N>";
  121. 1210 GOSUB 1280:IF Z="Y" THEN 790 ELSE IF Z<>"N" THEN 1210
  122. 1220 LOCATE 25,1:PRINT SPC(79);:LOCATE 25,23:COLOR 0,7
  123. 1230 PRINT" Strike <F10> To Leave This Game ";:COLOR 7,0:LOCATE XLIN,XPOS,0
  124. 1240 KEY(10) ON:RETURN
  125. 1250 COLOR 6,0:LOCATE 23,22:PRINT"Use Cursor Arrows To Pick Your Move
  126. 1260 LOCATE 24,22:PRINT"Strike ENTER  Key To Make Your Play";
  127. 1270 COLOR 15,0:RETURN
  128. 1280 IF INKEY$<>"" THEN 1280
  129. 1290 DEF SEG=&H40:POKE &H17,(PEEK(&H17) OR 96):Z=INKEY$:IF Z="" THEN 1290 ELSE RETURN
  130. 1300 FOR A=0 TO 88:READ SUB%(A):NEXT:RETURN
  131. 1310 DATA &H55FA,&HEC8B,&H768B,&HC706,&H4,&HC700,&H244,&H0,&H44C7,&HF04,&HB027,&HE816,&H2C,&H1575,&H24B0,&H25E8,&H7500,&HB00E,&HE8A2,&H1E,&H775,&HB0B0,&H17E8,&H7400,&H8B07,&H5DEC,&HCAFB,&H8,&H58B9,&H8B00,&HD0C1,&HE8E0,&H4,&HF7E2,&HEBEB,&H5350
  132. 1320 DATA &HB4,&HF08B,&HD08B,&H5E8B,&H8008,&H38,&H4B75,&H7E8B,&H8B0A,&H676,&H44C6,&H1,&HF28B,&H3503,&H3880,&H7502,&H331,&H8035,&H238,&HF974,&H3880,&H7501,&H5325,&H5E8B,&HC706,&H107,&H8B01,&H8BF2,&H5B00,&H3503,&H105,&H8000,&H138,&HF675,&H768B,&H3906
  133. 1330 DATA &H444,&H67C,&H5489,&H8902,&H444,&H4747,&H3D80,&H7500,&H5BBF,&H8B58,&H676,&H7C80,&H101,&H374,&HC032,&HAC3,&HC3C0
  134.