Import raw bitmaps to project
[shogivar.git] / SHOGI155.TXT
blob9f862185fa1a30e8455132d1da33f23241f185e0
1 Global OldComputer, Threat, FirstScore, SecondScore As String\r
2 Global FirstInitFile, FirstInitRank, LionAttack, FirstSeeMove, Reload, PawnMate, AA, Suggest, EndMove, Eval, CheckLooked, NoLionCapture, Checked, OriginalPiece, RightClick, OriginalFile, OriginalRank, FirstFile, FirstRank, Influence, CheckTest As Integer\r
3 Global CompLionTest, OldNewFile, OldNewRank, ChuLionTest, ProtectLion, XXX, YYY, BlackKingX, BlackKingY, WhiteKingX, WhiteKingY, Changed, FirstTime, MakeMove, CompFile, CompRank, CompMove, LegalMoves, Evaluate, DropTest, OldSeeMove, BestMove As Integer\r
4 Global OldThreat, ScoreFormat, PromPiece$, OldChoice, GameName, LionName$, CMove$, Nxt$, Turn, Turn2, Choice As String\r
5 Global Computer, SaveTitle$, NewTurn, ExtraPiece, Elapsed$, SpecPower$, Loaded$, Saved$, Datafile, Direct, Cap, Boardbmp, Grade As String\r
6 Global Replaying, OldInitRank, OldInitFile, EmperorTest, WhiteEmperor, BlackEmperor, Boardsize, Notate, Graphnum, Pixels, XCorner, SeeFile, SeeRank, PromGraf, Reverse, CapturedPiece As Integer\r
7 Global Count As Single\r
8 Global Forwards, Tabbing, PieceSizes, ClickPiece, OldLast, OldRank, OldFile, YCorner, Totpiece, PieceNum, J, I, Demon, XStart, LookMate, GameOver As Integer\r
9 Global Tilde, Blink, Blocked, MicroCap, BoardSizeX, BoardSizeY, Setup, Reduce, WhiteKing, BlackKing, WhitePrince, BlackPrince, LionPro As Integer\r
10 Global ForceProm, AutoPromote, Notice, Backwards, TurnCount, Handicap, Display, NewButton, PromDotY, NewIndex, Rank, File, TotGraph, InitRank, InitFile, Prom As Integer\r
11 Global Testing123, Timing, NewGraf, HandGame, Loading, NoPro, GameNo, MoveCount, NewRank, NewFile, Weaker, TeachVer, Teach, CaptPiece As Integer\r
12 Global Other, LionTest, NewGame, GeneralInfo, LastWhite, LastBlack, Hook, Range, N, R, F, Area, M, Drop, Dropped, C, D, Capture, RealLion, LionPiece As Integer\r
13 Global EndTurn, MovePiece, Selection, WhiteLion, BlackLion, Mate, Taken, P, MoveTest, MoveData, FileInc, RankInc, Last, SeeMove, LionHawkVer As Integer\r
14 Global NewX, NewY As Single\r
15 Global Board As Form\r
16 Global AllBack, Ligui, XA, LastPieceX, LastPieceY, CCC, ShowLast, BlackInfluence, WhiteInfluence, WhiteEmpX, WhiteEmpY, BlackEmpX, BlackEmpY, Level, RealLevel, Depth, TestDepth, FirstLegal As Integer\r
17 Global BestTally(26) As Long\r
18 Global BestScore, WhiteTally, BlackTally As Long\r
19 Global FinalTally(26) As Long\r
20 Global TestBoard() As Integer\r
21 Global OldHand()  As Integer\r
23 Type LegalList\r
24     StartFile As Integer\r
25     StartRank As Integer\r
26     EndFile As Integer\r
27     EndRank As Integer\r
28     StartPiece As Integer\r
29     EndPiece As Integer\r
30 End Type\r
31 Type MoveRecord\r
32     Caption  As String\r
33     IDStart As Integer\r
34     IDEnd As Integer\r
35     PosStart As Integer\r
36     PosEnd As Integer\r
37 End Type\r
38 Type CaptiveRecord\r
39     number As Integer\r
40     Positions(1 To 12)  As Integer\r
41     PieceNum(1 To 12) As Integer\r
42 End Type\r
43 Type Layout\r
44     File As Integer\r
45     Rank As Integer\r
46     Piece As Integer\r
47 End Type\r
48 Type Empty\r
49     File As Integer\r
50     Rank As Integer\r
51 End Type\r
52 Type Map\r
53     WhiteNum As Integer\r
54     BlackNum As Integer\r
55     WhiteValue As Integer\r
56     BlackValue As Integer\r
57     Info(1 To 512) As Layout\r
58 End Type\r
59 Type Piece\r
60     number As Integer\r
61     Name As String\r
62     sname As String * 4\r
63     Value As Integer\r
64     PrValue As Integer\r
65     Promotes As Integer\r
66     Graphic As Integer\r
67     PrGraphic As Integer\r
68     Moves(1 To 8)  As Integer\r
69     special As String * 1\r
70     Mask As Integer\r
71     Range As Integer\r
72 End Type\r
73 Global MoveList(26) As LegalList\r
74 Global Clearing() As Empty\r
75 Global ShortScore() As String\r
76 Global BlackDrop(1 To 2) As String\r
77 Global WhiteDrop(1 To 2) As String\r
78 Global CompLegal() As LegalList\r
79 Global ExtraCapture(2000) As Layout\r
80 Global ECapture(21) As Layout\r
81 Global LionVictim As Layout\r
82 Global Pieces() As Piece\r
83 Global LowBlack() As Integer\r
84 Global LowWhite() As Integer\r
85 Global PieceMask() As Integer\r
86 Global Squares() As Integer\r
87 Global Comp() As Integer\r
88 Global CompHeld() As Integer\r
89 Global Legal() As Integer\r
90 Global OldLegal() As Integer\r
91 Global Grafix() As Integer\r
92 Global InHand() As Integer\r
93 Global TempHand() As Integer\r
94 Global CapRef() As Integer\r
95 Global AreaOK() As Integer\r
96 Global Camps() As Integer\r
97 Global Attacker() As Integer\r
98 Global OldAttack() As Integer\r
99 Global BanMap() As Map\r
100 Global BackMap() As Map\r
101 Global Score() As MoveRecord\r
102 Global Captures() As CaptiveRecord\r
103 Global KingTally() As Long\r
104 Global OldKingTally(26) As Long\r
106 Sub ActingPieces ()\r
108 If InitFile > 0 Then\r
109     BlackInfluence = 0: WhiteInfluence = 0\r
110     OriginalPiece = Squares(InitFile, InitRank)\r
111     OriginalFile = InitFile: OriginalRank = InitRank\r
112     Influence = 1\r
113     For AB = 1 To BoardSizeY\r
114         For CD = 1 To BoardSizeX\r
115             If Squares(CD, AB) <> 0 Then\r
116                 If OriginalPiece <> 0 And Sgn(Squares(CD, AB)) <> Sgn(OriginalPiece) Then\r
117                     Squares(OriginalFile, OriginalRank) = OriginalPiece\r
118                 Else\r
119                     If CheckTest <> 1 Then Squares(OriginalFile, OriginalRank) = 0\r
120                 End If\r
121                 InitFile = CD: InitRank = AB\r
122                 If CheckTest <> 1 Or (Sgn(OriginalPiece) <> Sgn(Squares(CD, AB))) Then Validate\r
123             End If\r
124         Next CD\r
125     Next AB\r
126     If CheckTest <> 1 And (Choice = "Maka" Or Choice = "Tai") Then\r
127         If OriginalPiece = 0 Then\r
128             If WhiteEmperor = 1 Then InitFile = WhiteEmpX: InitRank = WhiteEmpY: EmperorInfluence\r
129             If BlackEmperor = 1 Then InitFile = BlackEmpX: InitRank = BlackEmpY: EmperorInfluence\r
130         Else\r
131             If OriginalPiece < 0 And WhiteEmperor = 1 And Pieces(Abs(OriginalPiece)).Name <> "Emperor" Then\r
132                 InitFile = WhiteEmpX: InitRank = WhiteEmpY: EmperorInfluence\r
133             End If\r
134             If OriginalPiece > 0 And WhiteEmperor = 1 And BlackEmperor = 0 And BlackInfluence = 0 Then\r
135                 InitFile = WhiteEmpX: InitRank = WhiteEmpY: EmperorInfluence\r
136             End If\r
137             If OriginalPiece > 0 And BlackEmperor = 1 And Pieces(Abs(OriginalPiece)).Name <> "Emperor" Then\r
138                 InitFile = BlackEmpX: InitRank = BlackEmpY: EmperorInfluence\r
139             End If\r
140             If OriginalPiece < 0 And BlackEmperor = 1 And WhiteEmperor = 0 And WhiteInfluence = 0 Then\r
141                 InitFile = BlackEmpX: InitRank = BlackEmpY: EmperorInfluence\r
142             End If\r
144         End If\r
145     End If\r
146     Influence = 0\r
147     Squares(OriginalFile, OriginalRank) = OriginalPiece\r
148 End If\r
149 End Sub\r
151 Sub AddEmperorAttack ()\r
153 LegalMoves = LegalMoves + 1\r
154 If Turn = "White" Then\r
155     CompLegal(LegalMoves).StartFile = WhiteEmpX\r
156     CompLegal(LegalMoves).StartRank = WhiteEmpY\r
157     CompLegal(LegalMoves).EndFile = BlackEmpX\r
158     CompLegal(LegalMoves).EndRank = BlackEmpY\r
159     CompLegal(LegalMoves).StartPiece = Squares(WhiteEmpX, WhiteEmpY)\r
160     CompLegal(LegalMoves).EndPiece = Squares(WhiteEmpX, WhiteEmpY)\r
161 Else\r
162     CompLegal(LegalMoves).StartFile = BlackEmpX\r
163     CompLegal(LegalMoves).StartRank = BlackEmpY\r
164     CompLegal(LegalMoves).EndFile = WhiteEmpX\r
165     CompLegal(LegalMoves).EndRank = WhiteEmpY\r
166     CompLegal(LegalMoves).StartPiece = Squares(BlackEmpX, BlackEmpY)\r
167     CompLegal(LegalMoves).EndPiece = Squares(BlackEmpX, BlackEmpY)\r
168 End If\r
169 End Sub\r
171 Sub AddEmperorMove ()\r
173 LegalMoves = LegalMoves + 1\r
174 CompLegal(LegalMoves).StartFile = InitFile\r
175 CompLegal(LegalMoves).StartRank = InitRank\r
176 CompLegal(LegalMoves).EndFile = SeeFile\r
177 CompLegal(LegalMoves).EndRank = SeeRank\r
178 CompLegal(LegalMoves).StartPiece = Squares(InitFile, InitRank)\r
179 CompLegal(LegalMoves).EndPiece = Squares(InitFile, InitRank)\r
181 End Sub\r
183 Sub AddHand ()\r
185 For X = 1 To Capture\r
186     If CapRef(X) = CaptPiece Then\r
187         InHand(X) = InHand(X) + 1\r
188         Board.HandPic(X).Visible = True\r
189         If InHand(X) > 1 Then Board.Held(X).Caption = InHand(X)\r
190         If Choice = "Micro" Then\r
191             MicroCap = X\r
192             MicroAdd\r
193         End If\r
194     Else\r
195         If CapRef(X) = 0 - CaptPiece Then\r
196             InHand(Capture + X) = InHand(Capture + X) + 1\r
197             Board.HandPic(Capture + X).Visible = True\r
198             If InHand(Capture + X) > 1 Then Board.Held(Capture + X).Caption = InHand(Capture + X)\r
199             If Choice = "Micro" Then\r
200                 MicroCap = Capture + X\r
201                 MicroAdd\r
202             End If\r
203         End If\r
204     End If\r
205 Next X\r
207 End Sub\r
209 Sub AddHand2 ()\r
210 If MovePiece <> 1 Then\r
211     For X = 1 To Capture\r
212         If CapRef(X) = Selection Then\r
213             InHand(X) = InHand(X) + 1\r
214             Board.Held(X).Caption = InHand(X)\r
215             If Choice = "Micro" Then\r
216                 MicroCap = X\r
217                 MicroAdd\r
218             End If\r
219         Else\r
220             If CapRef(X) = 0 - Selection Then\r
221                 InHand(Capture + X) = InHand(Capture + X) + 1\r
222                 Board.Held(Capture + X).Caption = InHand(Capture + X)\r
223                 If Choice = "Micro" Then\r
224                     MicroCap = Capture + X\r
225                     MicroAdd\r
226                 End If\r
227             End If\r
228         End If\r
229     Next X\r
230     CheckAdd\r
231 End If\r
232 End Sub\r
234 Sub AddHand3 ()\r
235 For X = 1 To Capture\r
236     If CapRef(X) = CaptPiece Then\r
237         InHand(X) = InHand(X) + 1\r
238         If Choice = "Micro" Then\r
239             MicroCap = X\r
240             If (MicroCap > 4 And MicroCap < 9) Or MicroCap > 12 Then InHand(MicroCap - 4) = InHand(MicroCap - 4) + 1 Else InHand(MicroCap + 4) = InHand(MicroCap + 4) + 1\r
241         End If\r
242     Else\r
243         If CapRef(X) = 0 - CaptPiece Then\r
244             InHand(Capture + X) = InHand(Capture + X) + 1\r
245             If Choice = "Micro" Then\r
246                 MicroCap = Capture + X\r
247                 If (MicroCap > 4 And MicroCap < 9) Or MicroCap > 12 Then InHand(MicroCap - 4) = InHand(MicroCap - 4) + 1 Else InHand(MicroCap + 4) = InHand(MicroCap + 4) + 1\r
248             End If\r
249         End If\r
250     End If\r
251 Next X\r
253 End Sub\r
255 Sub AddLegalMove ()\r
257 LegalMoves = LegalMoves + 1\r
258 CompLegal(LegalMoves).StartFile = InitFile\r
259 CompLegal(LegalMoves).StartRank = InitRank\r
260 CompLegal(LegalMoves).EndFile = SeeFile\r
261 CompLegal(LegalMoves).EndRank = SeeRank\r
262 If InitFile = 0 Then\r
263     CompLegal(LegalMoves).StartPiece = CapRef(I)\r
264     CompLegal(LegalMoves).EndPiece = CapRef(I)\r
265 Else\r
266     CompLegal(LegalMoves).StartPiece = Squares(InitFile, InitRank)\r
267     CompLegal(LegalMoves).EndPiece = Squares(InitFile, InitRank)\r
268     CompPromote\r
269 End If\r
270 End Sub\r
272 Sub AddLionMove ()\r
274 LegalMoves = LegalMoves + 1\r
275 CompLegal(LegalMoves).StartFile = InitFile\r
276 CompLegal(LegalMoves).StartRank = InitRank\r
277 CompLegal(LegalMoves).EndFile = XXX\r
278 CompLegal(LegalMoves).EndRank = YYY\r
279 CompLegal(LegalMoves).StartPiece = Squares(NewFile, NewRank)\r
280 CompLegal(LegalMoves).EndPiece = Squares(NewFile, NewRank)\r
282 End Sub\r
284 Sub AddSomePieces ()\r
286 For K = PieceNum / 2 To 1 Step -1\r
287     A$ = Pieces(K).Name + " " + Pieces(K).sname + Str$(Pieces(K).number)\r
288     If AddPieces.NewPiece.List(AddPieces.NewPiece.ListIndex) = ExtraPiece + " " + Pieces(K).Name + " " + Pieces(K).sname + Space(38 - Len(A$)) + Str$(Pieces(K).number) Then\r
289         Selection = Pieces(K).number\r
290         If ExtraPiece = "White" Then Selection = 0 - Selection\r
291     End If\r
292 Next K\r
293 AddPieces.Visible = False\r
294 Board.Caption = "Adding " + ExtraPiece + " " + Pieces(Abs(Selection)).Name + "s - [Press Right Button When Finished]"\r
295 Board.BlackClock.Caption = "00:00:00"\r
296 Board.WhiteClock.Caption = "00:00:00"\r
297 Board.Timer1.Enabled = False\r
298 Board.LastMove.Caption = ""\r
299 If Drop = 1 Then\r
300     For X = 1 To Capture\r
301     If ExtraPiece = "Black" Then\r
302         If CapRef(X) = Selection Then\r
303             Board.HandPic(X).Visible = True\r
304             Board.Held(X).Caption = InHand(X)\r
305         End If\r
306     Else\r
307         If CapRef(X) = 0 - Selection Then\r
308             Board.HandPic(Capture + X).Visible = True\r
309             Board.Held(Capture + X).Caption = InHand(Capture + X)\r
310         End If\r
311     End If\r
312     Next X\r
313 End If\r
314 Unload AddPieces\r
316 End Sub\r
318 Sub AddTally ()\r
319     BestTally(1) = -999999: CompMove = 0: Influence = 3: Evaluate = 1\r
320     WhiteTally = 0: BlackTally = 0\r
321     MakeMap\r
322     For DD = 1 To BoardSizeY\r
323         For EE = 1 To BoardSizeX\r
324             If Squares(EE, DD) < 0 Then WhiteTally = WhiteTally + (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
325             If Squares(EE, DD) > 0 Then BlackTally = BlackTally + (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
326             If BanMap(EE, DD).BlackNum = 0 And BanMap(EE, DD).WhiteNum > 0 Then\r
327                 WhiteTally = 1 + Abs((BoardSizeY / 2) - DD) + WhiteTally\r
328                 If Squares(EE, DD) > 0 And Turn = "Black" Then BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
329             End If\r
330             If BanMap(EE, DD).WhiteNum = 0 And BanMap(EE, DD).BlackNum > 0 Then\r
331                 BlackTally = Abs((BoardSizeY / 2) - DD) + BlackTally\r
332                 If Squares(EE, DD) < 0 And Turn = "White" Then WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
333             End If\r
334             If BanMap(EE, DD).WhiteNum > 0 And BanMap(EE, DD).BlackNum > 0 Then\r
335                 If Squares(EE, DD) > 0 And Turn = "Black" Then\r
336                     For QQ = 1 To Attacker(EE, DD)\r
337                         If BanMap(EE, DD).Info(QQ).Piece < 0 And (Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowWhite(EE, DD) Or LowWhite(EE, DD) = 0) Then LowWhite(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
338                     Next QQ\r
339                     BlackLoss = ((Pieces(Abs(Squares(EE, DD))).Value - LowWhite(EE, DD)) * 10)\r
340                     If BlackLoss > HighBlackLoss Then HighBlackLoss = BlackLoss\r
341                 End If\r
342                 If Squares(EE, DD) < 0 And Turn = "White" Then\r
343                     For QQ = 1 To Attacker(EE, DD)\r
344                         If BanMap(EE, DD).Info(QQ).Piece > 0 And (Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowBlack(EE, DD) Or LowBlack(EE, DD) = 0) Then LowBlack(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
345                     Next QQ\r
346                     WhiteLoss = ((Pieces(Abs(Squares(EE, DD))).Value - LowBlack(EE, DD)) * 10)\r
347                     If WhiteLoss > HighWhiteLoss Then HighWhiteLoss = WhiteLoss\r
348                 End If\r
349             End If\r
350             LowWhite(EE, DD) = 0: LowBlack(EE, DD) = 0\r
351          Next EE\r
352     Next DD\r
353     If Drop = 1 Then\r
354         For FF = 1 To Capture\r
355             BlackTally = BlackTally + (Pieces(Abs(CapRef(FF))).Value * 11) * (InHand(FF))\r
356             WhiteTally = WhiteTally + (Pieces(Abs(CapRef(FF + Capture))).Value * 11) * (InHand(FF + Capture))\r
357         Next FF\r
358     End If\r
359     BlackTally = BlackTally - HighBlackLoss: HighBlackLoss = 0\r
360     WhiteTally = WhiteTally - HighWhiteLoss: HighWhiteLoss = 0\r
361     If Turn = "White" Then BestTally(1) = WhiteTally - BlackTally Else BestTally(1) = BlackTally - WhiteTally\r
362 End Sub\r
364 Sub AreaMove ()\r
365 AreaMove2\r
366 For X = 1 To Area - 1\r
367     For N = InitRank - X To InitRank + X\r
368         If N > 0 And N <= BoardSizeY Then\r
369             For P = InitFile - X To InitFile + X\r
370                 If P > 0 And P <= BoardSizeX Then\r
371                     If AreaOK(P, N) = 1 And (Abs(P - InitFile) <= X And Abs(N - InitRank) <= X) Then AreaMove2\r
372                 End If\r
373             Next P\r
374         End If\r
375     Next N\r
376 Next X\r
377 End Sub\r
379 Sub AreaMove2 ()\r
380 Evaluate = 0\r
381 For Q = N - 1 To N + 1\r
382     If Q > 0 And Q <= BoardSizeY Then\r
383         For S = P - 1 To P + 1\r
384             If S > 0 And S <= BoardSizeX Then\r
385                 If Squares(S, Q) = 0 Then\r
386                     Board.FillColor = &HFFFFFF\r
387                     If SeeMove = 1 Then SeeFile = S: SeeRank = Q: LookMove\r
388                     Legal(S, Q) = 1\r
389                     AreaOK(S, Q) = 1\r
390                     NewFile = S: NewRank = Q: CheckBurn\r
391                     If Demon = 1 Then FireDemon\r
392                 Else\r
393                     If Sgn(Squares(S, Q)) <> Sgn(Squares(InitFile, InitRank)) Or ((Influence > 0) And (S <> InitFile Or Q <> InitRank)) Then\r
394                         Board.FillColor = &HFF&\r
395                         If SeeMove = 1 Then SeeFile = S: SeeRank = Q: LookMove\r
396                         Legal(S, Q) = 1\r
397                         NewFile = S: NewRank = Q: CheckBurn\r
398                         If Demon = 1 Then FireDemon\r
399                     End If\r
400                 End If\r
401             End If\r
402         Next S\r
403     End If\r
404 Next Q\r
405 End Sub\r
407 Sub AskMate ()\r
409 If (Pieces(Abs(CapRef(I))).Name = "Pawn" Or Pieces(Abs(CapRef(I))).Name = "Sparrow Pawn" Or Pieces(Abs(CapRef(I))).Name = "Swallow" Or Pieces(Abs(CapRef(I))).Name = "Dolphin") And (Choice <> "Micro" And Choice <> "Yari") Then\r
410     CheckDrop = 0\r
411     If Turn = "Black" And WhiteKingY < BoardSizeY Then\r
412         If Legal(WhiteKingX, WhiteKingY + 1) = 1 Then Squares(WhiteKingX, WhiteKingY + 1) = CapRef(I): File = WhiteKingX: Rank = WhiteKingY + 1: CheckDrop = 1\r
413     End If\r
414     If Turn = "White" And BlackKingY > 1 Then\r
415         If Legal(BlackKingX, BlackKingY - 1) = 1 Then Squares(BlackKingX, BlackKingY - 1) = CapRef(I): File = BlackKingX: Rank = BlackKingY - 1: CheckDrop = 1\r
416     End If\r
417     If CheckDrop = 1 Then\r
418         For CC = 1 To BoardSizeY\r
419             For BB = 1 To BoardSizeX\r
420                 Comp(BB, CC) = Squares(BB, CC)\r
421                 OldLegal(BB, CC) = Legal(BB, CC)\r
422             Next BB\r
423         Next CC\r
424         OldInfluence = Influence: OldEvaluate = Evaluate: OldCompMove = CompMove\r
425         OldSeeMove = SeeMove: Influence = 3: Evaluate = 1: CompMove = 0: SeeMove = 1\r
426         TestFile = File: TestRank = Rank\r
427         MakeMap\r
428         File = TestFile: Rank = TestRank\r
429         For CC = 1 To BoardSizeY\r
430             For BB = 1 To BoardSizeX\r
431                 Squares(BB, CC) = Comp(BB, CC)\r
432             Next BB\r
433         Next CC\r
434         Influence = OldInfluence: Evaluate = OldEvaluate: CompMove = OldCompMove\r
435         If Turn = "Black" Then\r
436             If BanMap(File, Rank).WhiteNum < 2 And BanMap(File, Rank).BlackNum > 0 Then\r
437                 PawnMate = 1\r
438                 For SS = Rank - 2 To Rank\r
439                     For TT = File - 1 To File + 1\r
440                         If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (SS <> Rank Or TT <> File) And (SS <> WhiteKingX Or TT <> WhiteKingY) Then\r
441                             If BanMap(TT, SS).BlackNum = 0 And Squares(TT, SS) >= 0 Then PawnMate = 0\r
442                         End If\r
443                     Next TT\r
444                 Next SS\r
445                 If PawnMate = 1 Then OldLegal(File, Rank) = 0\r
446             End If\r
447         Else\r
448             If BanMap(File, Rank).BlackNum < 2 And BanMap(File, Rank).WhiteNum > 0 Then\r
449                 PawnMate = 1\r
450                 For SS = Rank To Rank + 2\r
451                     For TT = File - 1 To File + 1\r
452                         If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (SS <> Rank Or TT <> File) And (SS <> BlackKingY Or TT <> BlackKingX) Then\r
453                             If BanMap(TT, SS).WhiteNum = 0 And Squares(TT, SS) <= 0 Then PawnMate = 0\r
454                         End If\r
455                     Next TT\r
456                 Next SS\r
457                 If PawnMate = 1 Then OldLegal(File, Rank) = 0\r
458             End If\r
459         End If\r
460         SeeMove = OldSeeMove\r
461         For AA = 1 To BoardSizeY\r
462             For BB = 1 To BoardSizeX\r
463                 Squares(BB, AA) = Comp(BB, AA)\r
464                 Legal(BB, AA) = OldLegal(BB, AA)\r
465             Next BB\r
466         Next AA\r
467         Squares(File, Rank) = 0\r
468     End If\r
469 End If\r
470 PawnMate = 0\r
471 End Sub\r
473 Sub AutoMessage ()\r
475 Board.PieceID.ForeColor = &H8000&\r
476 Board.PieceID.Caption = PromPiece$ + " promotes"\r
477 If Game <> "Micro" And Game <> "Tori" And Game <> "Whale" And Game <> "Maka" And Game <> "DaiDai" And Game <> "Tai" And Computer <> Turn And Computer <> "Both" Then\r
478     Notice = 1\r
479     Board.Caption = "Double Click on new " + Pieces(Abs(Squares(File, Rank))).Name + " if not promoting."\r
480 End If\r
481 End Sub\r
483 Sub BugFix ()\r
485 Count = 0: Backwards = 0: BugNo = 64\r
486 Select Case Choice\r
487     Case "HShogi": BugNo = 40\r
488     Case "Wa": BugNo = 69\r
489     Case "Chu": BugNo = 93\r
490     Case "Dai": BugNo = 132\r
491     Case "Tenjiku": BugNo = 158\r
492     Case "DaiDai": BugNo = 192\r
493     Case "Maka": BugNo = 192\r
494     Case "Tai": BugNo = 356\r
495     Case "Heian": BugNo = 92\r
496 End Select\r
497 For A = 0 To BugNo\r
498     If Board.showpic(A).Visible = False Then Count = Count + 1\r
499 Next A\r
500 For A = 0 To BugNo\r
501     Board.showpic(A).Visible = False\r
502     For B = 1 To BoardSizeY\r
503         For C = 1 To BoardSizeX\r
504             If Grafix(C, B) = A Then Board.showpic(A).Visible = True\r
505         Next C\r
506     Next B\r
507 Next A\r
508 Setup = 0\r
510 End Sub\r
512 Sub ChangeGame ()\r
513 Unload Start\r
514 Unload Board\r
515 Unload PieceHelp\r
516 Unload RulesHelp\r
517 Main\r
518 End Sub\r
520 Sub ChangeSides ()\r
521 If Pieces(Abs(Squares(File, Rank))).Name = "Porpoise" Then\r
522     Board.Caption = "Captured Porpoise becomes a Killer Whale"\r
523     Notice = 1\r
524 End If\r
525 If Pieces(Abs(Squares(File, Rank))).Promotes = 0 And Pieces(Abs(Squares(File, Rank))).PrGraphic > 0 Then\r
526     CaptPiece = Pieces(Abs(Squares(File, Rank))).PrGraphic\r
527     If Squares(File, Rank) > 0 Then\r
528         CaptPiece = 0 - CaptPiece\r
529     End If\r
530 Else\r
531     CaptPiece = 0 - Squares(File, Rank)\r
532 End If\r
533 AddHand\r
534 End Sub\r
536 Sub ChangeTurn ()\r
537     \r
538 If NewTurn = "Black" Then\r
539     Board.LastMove.Caption = ""\r
540     MoveCount = 0: TurnCount = 0\r
541     Board.NextMove.Caption = "Black to Move"\r
542     Turn = "Black"\r
543     Board.BlackClock.Caption = "00:00:00"\r
544     Board.WhiteClock.Caption = "00:00:00"\r
545 End If\r
546 If NewTurn = "White" Then\r
547     Board.LastMove.Caption = ""\r
548     MoveCount = 1: TurnCount = 0\r
549     Turn = "White"\r
550     Board.NextMove.Caption = "White to Move"\r
551     Board.BlackClock.Caption = "00:00:00"\r
552     Board.WhiteClock.Caption = "00:00:00"\r
553 End If\r
554 End Sub\r
556 Sub CheckAdd ()\r
557 Board.LastMove.Caption = ""\r
558 Count = 0: Setup = 1\r
559 For K = 1 To BoardSizeY\r
560     For L = 1 To BoardSizeX\r
561         If Squares(L, K) <> 0 Then Count = Count + 1\r
562     Next L\r
563 Next K\r
564 If Drop = 1 Then\r
565     For K = 1 To Capture * 2\r
566         Count = Count + InHand(K)\r
567         If Choice = "Micro" Then Count = Count - (InHand(K) / 2)\r
568     Next K\r
569 End If\r
570 If Count >= Totpiece Then\r
571     Board.Caption = "You can not add any more pieces!"\r
572     Notice = 1\r
573     Selection = 0: MovePiece = 0\r
574     Board.Timer1.Enabled = True\r
575     TurnCount = 0: MoveCount = 0\r
576     If Drop = 1 Then ResetHand\r
577     If Turn = "White" Then MoveCount = 1\r
578     BugFix\r
579 Else\r
580     If Selection = 0 Then Load AddPieces\r
581 End If\r
582 End Sub\r
584 Sub CheckBurn ()\r
585 Evaluate = 0\r
586 For K = NewRank - 1 To NewRank + 1\r
587     For L = NewFile - 1 To NewFile + 1\r
588         If L > 0 And L <= BoardSizeX And K > 0 And K <= BoardSizeY Then\r
589             If (K <> NewRank Or L <> NewFile) And Squares(L, K) <> 0 Then\r
590                 If Pieces(Abs(Squares(L, K))).special = "F" And Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(L, K)) Then\r
591                     Board.FillColor = &H0&\r
592                     If SeeMove = 1 Then SeeFile = NewFile: SeeRank = NewRank: LookMove\r
593                     Legal(NewFile, NewRank) = 3\r
594                 End If\r
595             End If\r
596         End If\r
597     Next L\r
598 Next K\r
599 End Sub\r
601 Sub CheckEmperor ()\r
602 OldInfluence = Influence: ProtectLion = 0: OldSeeMove = SeeMove: SeeMove = 1\r
603 Influence = 1: ChuLionTest = 1: OldInitFile = InitFile: OldInitRank = InitRank\r
604 OldNewFile = NewFile: OldNewRank = NewRank: OldSeeFile = SeeFile: OldSeeRank = SeeRank: OldFile = File: OldRank = Rank\r
605 For FFF = 1 To BoardSizeY\r
606     For GGG = 1 To BoardSizeX\r
607         OldLegal(GGG, FFF) = Legal(GGG, FFF)\r
608     Next GGG\r
609 Next FFF\r
610 For FFF = 1 To BoardSizeY\r
611     For GGG = 1 To BoardSizeX\r
612         If Sgn(Squares(GGG, FFF)) = Sgn(Squares(OldNewFile, OldNewRank)) Then\r
613             InitFile = GGG: InitRank = FFF: Validate\r
614             If ProtectLion = 1 Then OldLegal(OldNewFile, OldNewRank) = 0: Exit For\r
615         End If\r
616     Next GGG\r
617 If ProtectLion = 1 Then Exit For\r
618 Next FFF\r
619 For FFF = 1 To BoardSizeY\r
620     For GGG = 1 To BoardSizeX\r
621         Legal(GGG, FFF) = OldLegal(GGG, FFF)\r
622     Next GGG\r
623 Next FFF\r
624 Influence = OldInfluence\r
625 ChuLionTest = 0: InitFile = OldInitFile: InitRank = OldInitRank\r
626 NewFile = OldNewFile: NewRank = OldNewRank: SeeFile = OldSeeFile: SeeRank = OldSeeRank: File = OldFile: Rank = OldRank\r
627 SeeMove = OldSeeMove\r
628 End Sub\r
630 Sub CheckMate ()\r
632 If Turn = "White" Then\r
633     If Abs(Squares(File, Rank)) = 1 Or Pieces(Abs(Squares(File, Rank))).Name = "Emperor" Then BlackKing = 1\r
634     If Pieces(Abs(Squares(File, Rank))).Name = "Crown Prince" Or Pieces(Abs(Squares(File, Rank))).Name = "Prince" Then BlackPrince = BlackPrince - 1\r
635     If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" Then BlackEmperor = 0\r
636 Else\r
637     If Turn = "Black" Then\r
638         If Abs(Squares(File, Rank)) = 1 Or Pieces(Abs(Squares(File, Rank))).Name = "Emperor" Then WhiteKing = 1\r
639         If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" Then WhiteEmperor = 0\r
640         If Pieces(Abs(Squares(File, Rank))).Name = "Crown Prince" Or Pieces(Abs(Squares(File, Rank))).Name = "Prince" Then WhitePrince = WhitePrince - 1\r
641     End If\r
642 End If\r
643 If Choice = "Tenjiku" Or Choice = "Maka" Or Choice = "Tai" Then\r
644     If BlackKing = 1 And BlackPrince = 0 Then Mate = 1: GameOver = 1\r
645     If WhiteKing = 1 And WhitePrince = 0 Then Mate = 1: GameOver = 1\r
646 End If\r
647 End Sub\r
649 Sub ChuLion ()\r
651 OldInfluence = Influence: ProtectLion = 0: OldSeeMove = SeeMove: SeeMove = 1\r
652 Influence = 1: ChuLionTest = 1: OldInitFile = InitFile: OldInitRank = InitRank\r
653 OldNewFile = NewFile: OldNewRank = NewRank: OldSeeFile = SeeFile: OldSeeRank = SeeRank: OldFile = File: OldRank = Rank\r
654 For FFF = 1 To BoardSizeY\r
655     For GGG = 1 To BoardSizeX\r
656         OldLegal(GGG, FFF) = Legal(GGG, FFF)\r
657     Next GGG\r
658 Next FFF\r
659 For FFF = 1 To BoardSizeY\r
660     For GGG = 1 To BoardSizeX\r
661         If Sgn(Squares(GGG, FFF)) = Sgn(Squares(OldNewFile, OldNewRank)) Then\r
662             InitFile = GGG: InitRank = FFF: Validate\r
663             If ProtectLion = 1 Then OldLegal(OldNewFile, OldNewRank) = 0: Exit For\r
664         End If\r
665     Next GGG\r
666 If ProtectLion = 1 Then Exit For\r
667 Next FFF\r
668 For FFF = 1 To BoardSizeY\r
669     For GGG = 1 To BoardSizeX\r
670         Legal(GGG, FFF) = OldLegal(GGG, FFF)\r
671     Next GGG\r
672 Next FFF\r
673 Influence = OldInfluence\r
674 ChuLionTest = 0: InitFile = OldInitFile: InitRank = OldInitRank: SeeMove = OldSeeMove\r
675 NewFile = OldNewFile: NewRank = OldNewRank: SeeFile = OldSeeFile: SeeRank = OldSeeRank: File = OldFile: Rank = OldRank\r
677 End Sub\r
679 Sub ClearBoard ()\r
680 Response% = MsgBox("Are You Sure ?", 36, "Clear the Board")\r
681 If Response% = 6 Then\r
682     For A = 1 To BoardSizeY\r
683         For B = 1 To BoardSizeX\r
684             If Squares(B, A) <> 0 Then\r
685                 Board.showpic(Grafix(B, A)).Visible = False\r
686                 Board.showpic(Grafix(B, A)).Move 0, 0\r
687                 Squares(B, A) = 0\r
688             End If\r
689             Grafix(B, A) = -1\r
690         Next B\r
691     Next A\r
692     If Drop = 1 Then\r
693         For A = 1 To Capture * 2\r
694             InHand(A) = 0\r
695             Board.HandPic(A).Visible = False\r
696             Board.Held(A).Caption = ""\r
697         Next A\r
698     End If\r
699     WhitePrince = 0: BlackPrince = 0\r
700     Board.LastMove.Caption = ""\r
701     MoveCount = 0: TurnCount = 0\r
702     Board.BlackClock.Caption = "00:00:00"\r
703     Board.WhiteClock.Caption = "00:00:00"\r
704     Board.Timer1.Enabled = False\r
705 End If\r
706 End Sub\r
708 Sub ClearInfo ()\r
710 If CapturedPiece <> 1 Then\r
711     Changed = Changed + 1\r
712     Clearing(Changed).File = File\r
713     Clearing(Changed).Rank = Rank\r
714 End If\r
715 CapturedPiece = 0\r
716 For JJ = 1 To BoardSizeY\r
717     For KK = 1 To BoardSizeX\r
718         For MM = 1 To Attacker(KK, JJ)\r
719             If BanMap(KK, JJ).Info(MM).File = File And BanMap(KK, JJ).Info(MM).Rank = Rank Then\r
720                 If Attacker(KK, JJ) = 1 Then\r
721                     BanMap(KK, JJ).Info(MM).File = 0\r
722                     BanMap(KK, JJ).Info(MM).Rank = 0\r
723                     BanMap(KK, JJ).Info(MM).Piece = 0\r
724                 Else\r
725                 For NN = MM To Attacker(KK, JJ) - 1\r
726                     BanMap(KK, JJ).Info(NN).File = BanMap(KK, JJ).Info(NN + 1).File\r
727                     BanMap(KK, JJ).Info(NN).Rank = BanMap(KK, JJ).Info(NN + 1).Rank\r
728                     BanMap(KK, JJ).Info(NN).Piece = BanMap(KK, JJ).Info(NN + 1).Piece\r
729                 Next NN\r
730                 End If\r
731                 Attacker(KK, JJ) = Attacker(KK, JJ) - 1\r
732                 If Squares(File, Rank) < 0 Then\r
733                     BanMap(KK, JJ).WhiteNum = BanMap(KK, JJ).WhiteNum - 1\r
734                 Else\r
735                     If Squares(File, Rank) > 0 Then\r
736                         BanMap(KK, JJ).BlackNum = BanMap(KK, JJ).BlackNum - 1\r
737                     End If\r
738                 End If\r
739             End If\r
740         Next MM\r
741     Next KK\r
742 Next JJ\r
744 End Sub\r
746 Sub ClearLegal ()\r
748 If Notice = 0 And Checked <> 1 Then Board.PieceID.Caption = ""\r
749 If GameOver = 1 Then\r
750     Board.NextMove.Caption = "Game Over"\r
751 Else\r
752     If Turn = "White" Then Board.NextMove.Caption = "White to Move" Else Board.NextMove.Caption = "Black to Move"\r
753 End If\r
754 If SeeMove = 1 Then Board.Refresh\r
755 For A = 1 To BoardSizeY\r
756    For B = 1 To BoardSizeX\r
757        Legal(B, A) = 0\r
758        AreaOK(B, A) = 0\r
759    Next B\r
760 Next A\r
761 End Sub\r
763 Sub Clock ()\r
764 If Timing = 0 And GameOver <> 1 Then\r
765     If (Turn = "White" And Level > 0) Or (Turn = "Black" And Level = 0) Then\r
766         Elapsed$ = Board.WhiteClock.Caption\r
767         SetClock\r
768         Board.WhiteClock.Caption = Elapsed$\r
769     Else\r
770         Elapsed$ = Board.BlackClock.Caption\r
771         SetClock\r
772         Board.BlackClock.Caption = Elapsed$\r
773     End If\r
774 End If\r
775 End Sub\r
777 Sub ClocksOff ()\r
779 Board.Timer1.Enabled = False\r
780 Board.WhiteClock.Caption = "00:00:00"\r
781 Board.BlackClock.Caption = "00:00:00"\r
782 Timing = 1\r
783 Board.WhiteClock.Visible = False\r
784 Board.BlackClock.Visible = False\r
785 Board.MnuClockOff.Enabled = False\r
786 Board.MnuClockOn.Enabled = True\r
787 Board.MnuClockOff.Checked = True\r
788 Board.MnuClockOn.Checked = False\r
790 End Sub\r
792 Sub ClocksOn ()\r
794 Board.Timer1.Enabled = True\r
795 Board.WhiteClock.Caption = "00:00:00"\r
796 Board.BlackClock.Caption = "00:00:00"\r
797 Timing = 0\r
798 Board.WhiteClock.Visible = True\r
799 Board.BlackClock.Visible = True\r
800 Board.MnuClockOff.Enabled = True\r
801 Board.MnuClockOn.Enabled = False\r
802 Board.MnuClockOn.Checked = True\r
803 Board.MnuClockOff.Checked = False\r
805 End Sub\r
807 Sub CompLion ()\r
809 CompLionTest = 1\r
810 AddLegalMove\r
811 DeadPiece = Squares(NewFile, NewRank)\r
812 Squares(NewFile, NewRank) = Squares(InitFile, InitRank)\r
813 Squares(InitFile, InitRank) = 0\r
814 For YYY = NewRank - 1 To NewRank + 1\r
815     For XXX = NewFile - 1 To NewFile + 1\r
816         If XXX > 0 And XXX <= BoardSizeX And YYY > 0 And YYY <= BoardSizeY Then\r
817             If Squares(XXX, YYY) = 0 Or Sgn(Squares(XXX, YYY)) <> Sgn(Squares(NewFile, NewRank)) Then\r
818                 AddLionMove\r
819                 ExtraCapture(LegalMoves).Piece = DeadPiece\r
820                 ExtraCapture(LegalMoves).File = NewFile\r
821                 ExtraCapture(LegalMoves).Rank = NewRank\r
822             End If\r
823         End If\r
824     Next XXX\r
825 Next YYY\r
826 Squares(InitFile, InitRank) = Squares(NewFile, NewRank)\r
827 Squares(NewFile, NewRank) = DeadPiece\r
829 End Sub\r
831 Sub CompLionPower ()\r
833 CompLionTest = 1\r
834 AddLegalMove\r
835 DeadPiece = Squares(NewFile, NewRank)\r
836 Squares(NewFile, NewRank) = Squares(InitFile, InitRank)\r
837 Squares(InitFile, InitRank) = 0\r
838 For WWW = -1 To 1 Step 2\r
839     XXX = NewFile + (FileInc * WWW)\r
840     YYY = NewRank + (RankInc * WWW)\r
841     If XXX > 0 And XXX <= BoardSizeX And YYY > 0 And YYY <= BoardSizeY Then\r
842         If Squares(XXX, YYY) = 0 Or Sgn(Squares(XXX, YYY)) <> Sgn(Squares(NewFile, NewRank)) Then\r
843             AddLionMove\r
844             ExtraCapture(LegalMoves).Piece = DeadPiece\r
845             ExtraCapture(LegalMoves).File = NewFile\r
846             ExtraCapture(LegalMoves).Rank = NewRank\r
847         End If\r
848     End If\r
849 Next WWW\r
850 Squares(InitFile, InitRank) = Squares(NewFile, NewRank)\r
851 Squares(NewFile, NewRank) = DeadPiece\r
853 End Sub\r
855 Sub CompMain ()\r
857 If Level <> 0 And (Computer = "White" Or Computer = "Black") Then Board.MnuSwitch.Enabled = True Else Board.MnuSwitch.Enabled = False\r
859 ' Find Legal Moves\r
861 If GameOver = 1 Then Exit Sub\r
862 For AA = 1 To BoardSizeY\r
863     For BB = 1 To BoardSizeX\r
864         Comp(BB, AA) = Squares(BB, AA)\r
865     Next BB\r
866 Next AA\r
867 CompMove = 1: LegalMoves = 0\r
868 For YZ = 1 To BoardSizeY\r
869     For VX = 1 To BoardSizeX\r
870         If Turn = "White" Then\r
871             If Squares(VX, YZ) < 0 Then\r
872                 InitFile = VX: InitRank = YZ\r
873                 I = Grafix(VX, YZ)\r
874                 Validate\r
875                 Taken = 0\r
876             End If\r
877         Else\r
878             If Squares(VX, YZ) > 0 Then\r
879                 InitFile = VX: InitRank = YZ\r
880                 I = Grafix(VX, YZ)\r
881                 Validate\r
882                 Taken = 0\r
883             End If\r
884         End If\r
885     Next VX\r
886 DoEvents\r
887 Next YZ\r
889 ' Find Legal Drops\r
891 If Drop = 1 Then\r
892     If (Turn = "Black" And Reverse = 0) Or (Turn = "White" And Reverse = 1) Then\r
893         For TU = 1 To Capture\r
894             ResetLegal\r
895             If InHand(TU) > 0 Then\r
896                 I = TU: InitFile = 0: InitRank = 0\r
897                 HeldValid\r
898                 DoEvents\r
899             End If\r
900         Next TU\r
901     Else\r
902         For TU = Capture + 1 To Capture * 2\r
903             If InHand(TU) > 0 Then\r
904                 ResetLegal\r
905                 I = TU: InitFile = 0: InitRank = 0\r
906                 HeldValid\r
907                 DoEvents\r
908             End If\r
909         Next TU\r
910     End If\r
911 End If\r
913 ' Find Legal Emperor Moves\r
915 If Choice = "Tai" Or Choice = "Maka" Then\r
916     OldInfluence = Influence: CompMove = 0\r
917     If WhiteEmperor = 1 And BlackEmperor = 1 Then AddEmperorAttack\r
918     If (Turn = "White" And WhiteEmperor = 1) Or (Turn = "Black" And BlackEmperor = 1) Then\r
919         Influence = 2\r
920         For AB = 1 To BoardSizeY\r
921             For CD = 1 To BoardSizeX\r
922                 InitFile = CD: InitRank = AB: Validate\r
923             Next CD\r
924         Next AB\r
925         FindEmperorMove\r
926     End If\r
927 Influence = OldInfluence: CompMove = 1\r
928 End If\r
930 FirstLegal = LegalMoves\r
931 If FirstLegal < Level Then TestDepth = FirstLegal Else TestDepth = Level\r
932 If LookMate = 1 Then ConsiderMate Else ConsiderMove\r
933 Evaluate = 0: CompMove = 0: Influence = 0: EndMove = 0\r
934 If Suggest = 1 Then SuggestMove: Exit Sub\r
935 If GameOver = 1 Then Exit Sub\r
936 If Level > 1 Then LookAhead\r
937     \r
938 ' Make Best Move\r
940 For AA = 1 To BoardSizeY\r
941     For BB = 1 To BoardSizeX\r
942         Squares(BB, AA) = Comp(BB, AA)\r
943     Next BB\r
944 Next AA\r
945 For A = 1 To BoardSizeY\r
946     For B = 1 To BoardSizeX\r
947         Legal(B, A) = 0\r
948         AreaOK(B, A) = 0\r
949     Next B\r
950 Next A\r
951 OldSeeMove = SeeMove: SeeMove = 0\r
952 If LookMate = 1 Then Exit Sub\r
953 If CompLegal(BestMove).StartFile = 0 Then\r
954     InitFile = 0\r
955     DropTest = 1\r
956     TestDrop\r
957 Else\r
958     InitRank = CompLegal(BestMove).StartRank\r
959     InitFile = CompLegal(BestMove).StartFile\r
960     I = Grafix(InitFile, InitRank)\r
961     If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then Legal(CompLegal(BestMove).EndFile, CompLegal(BestMove).EndRank) = 1\r
962     Validate\r
963 End If\r
964 SeeMove = OldSeeMove: CompMove = 1: Evaluate = 0: MakeMove = 1\r
965 File = CompLegal(BestMove).EndFile\r
966 Rank = CompLegal(BestMove).EndRank\r
967 If InitFile = 0 Then\r
968     MakeDrop\r
969     DropTest = 0\r
970 Else\r
971     If Pieces(Abs(Squares(InitFile, InitRank))).special = "L" Or Pieces(Abs(Squares(InitFile, InitRank))).Name = "Horned Falcon" Or Pieces(Abs(Squares(InitFile, InitRank))).Name = "Soaring Eagle" Then Legal(InitFile, InitRank) = 1\r
972     I = Grafix(InitFile, InitRank)\r
973     If Squares(File, Rank) = 0 Then\r
974         FormDrop\r
975     Else\r
976         NewIndex = Grafix(File, Rank)\r
977         PicDrop\r
978     End If\r
979 End If\r
980 If Taken = 1 And (Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai") Then\r
981     I = Grafix(File, Rank)\r
982     Promote\r
983 Else\r
984 If CompLegal(BestMove).StartPiece <> CompLegal(BestMove).EndPiece And Squares(File, Rank) <> 0 Then\r
985     I = Grafix(File, Rank)\r
986     Promote\r
987 End If\r
988 End If\r
989 CompMove = 0: Evaluate = 0: LegalMoves = 0\r
990 If Mate <> 1 Then NextTurn2\r
992 End Sub\r
994 Sub CompMate ()\r
996 If Squares(File, Rank) = 1 And Turn = "White" Then\r
997     If (Abs(File - CompLegal(AA).EndFile) < 2 And Abs(Rank - CompLegal(AA).EndRank) < 2) And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).BlackNum < 2 And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).WhiteNum > 0 And BanMap(File, Rank).WhiteNum > 0 And CompLegal(AA).EndPiece <> -1 Then\r
998         MateCheck = 1\r
999         For SS = Rank - 1 To Rank + 1\r
1000             For TT = File - 1 To File + 1\r
1001                 If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (SS <> Rank Or TT <> File) Then\r
1002                     If BanMap(TT, SS).WhiteNum = 0 And Squares(TT, SS) <= 0 Then MateCheck = 0\r
1003                 End If\r
1004             Next TT\r
1005         Next SS\r
1006         If MateCheck = 1 Then WhiteTally = WhiteTally + 8888 Else WhiteTally = WhiteTally + 20\r
1007     Else\r
1008         If BanMap(File, Rank).WhiteNum > 0 And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).BlackNum = 0 And CompLegal(AA).EndPiece <> -1 Then WhiteTally = WhiteTally + 20\r
1009     End If\r
1010 End If\r
1011 If Squares(File, Rank) = -1 And Turn = "Black" Then\r
1012     If Abs(File - CompLegal(AA).EndFile) < 2 And Abs(Rank - CompLegal(AA).EndRank) < 2 And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).WhiteNum < 2 And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).BlackNum > 0 And BanMap(File, Rank).BlackNum > 0 And CompLegal(AA).EndPiece <> 1 Then\r
1013         MateCheck = 1\r
1014         For SS = Rank - 1 To Rank + 1\r
1015             For TT = File - 1 To File + 1\r
1016                 If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (SS <> Rank Or TT <> File) Then\r
1017                     If BanMap(TT, SS).BlackNum = 0 And Squares(TT, SS) >= 0 Then MateCheck = 0\r
1018                 End If\r
1019             Next TT\r
1020         Next SS\r
1021         If MateCheck = 1 Then BlackTally = BlackTally + 8888 Else BlackTally = BlackTally + 20\r
1022     Else\r
1023         If BanMap(File, Rank).BlackNum > 0 And BanMap(CompLegal(AA).EndFile, CompLegal(AA).EndRank).WhiteNum = 0 And CompLegal(AA).EndPiece <> 1 Then BlackTally = BlackTally + 20\r
1024     End If\r
1025 End If\r
1026             \r
1028 End Sub\r
1030 Sub CompPromote ()\r
1032 ForceProm = 0: Taken = 0\r
1033 If Choice = "Micro" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai" Then\r
1034     If Squares(SeeFile, SeeRank) <> 0 Then\r
1035         If Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(SeeFile, SeeRank)) Then\r
1036             Taken = 1: ForceProm = 1\r
1037             CompPromote2\r
1038         End If\r
1039     End If\r
1040 Else\r
1041     If Pieces(Abs(Squares(InitFile, InitRank))).special = "1" Then\r
1042         If Squares(InitFile, InitRank) > 0 And SeeRank = 1 Then ForceProm = 1: CompPromote2\r
1043         If Squares(InitFile, InitRank) < 0 And SeeRank = BoardSizeY Then ForceProm = 1: CompPromote2\r
1044     End If\r
1045     If Pieces(Abs(Squares(InitFile, InitRank))).special = "2" Then\r
1046         If Squares(InitFile, InitRank) > 0 And SeeRank < 3 Then ForceProm = 1: CompPromote2\r
1047         If Squares(InitFile, InitRank) < 0 And SeeRank > BoardSizeY - 2 Then ForceProm = 1: CompPromote2\r
1048     End If\r
1049     If Squares(InitFile, InitRank) > 0 And (SeeRank <= PromDotY Or InitRank <= PromDotY) Then CompPromote2\r
1050     If Squares(InitFile, InitRank) < 0 And (SeeRank > BoardSizeY - PromDotY Or InitRank > BoardSizeY - PromDotY) Then CompPromote2\r
1051 End If\r
1052 End Sub\r
1054 Sub CompPromote2 ()\r
1056 If (Choice <> "Micro" And Choice <> "Tai" And Choice <> "Maka" And Choice <> "DaiDai") Or (Taken = 1) Then\r
1057     If (ForceProm = 1 And Pieces(Abs(Squares(InitFile, InitRank))).Promotes <> 0) Or Prom = 1 Then\r
1058         CompLegal(LegalMoves).EndPiece = Pieces(Abs(Squares(InitFile, InitRank))).Promotes\r
1059         If CompLegal(LegalMoves).StartPiece < 0 Then CompLegal(LegalMoves).EndPiece = 0 - CompLegal(LegalMoves).EndPiece\r
1060     Else\r
1061         If (Pieces(Abs(Squares(InitFile, InitRank))).Promotes <> 0) Then\r
1062             LegalMoves = LegalMoves + 1\r
1063             CompLegal(LegalMoves).StartFile = InitFile\r
1064             CompLegal(LegalMoves).StartRank = InitRank\r
1065             CompLegal(LegalMoves).EndFile = SeeFile\r
1066             CompLegal(LegalMoves).EndRank = SeeRank\r
1067             CompLegal(LegalMoves).StartPiece = Squares(InitFile, InitRank)\r
1068             CompLegal(LegalMoves).EndPiece = Pieces(Abs(Squares(InitFile, InitRank))).Promotes\r
1069             If Squares(InitFile, InitRank) < 0 Then CompLegal(LegalMoves).EndPiece = 0 - CompLegal(LegalMoves).EndPiece\r
1070         End If\r
1071     End If\r
1072 End If\r
1073 End Sub\r
1075 Sub CompTeach ()\r
1077 Board.MnuVer2.Enabled = False\r
1078 Board.MnuVer1.Enabled = False\r
1079 Board.MnuVer1.Checked = True\r
1080 Board.MnuVer2.Checked = False\r
1081 TeachVer = 1\r
1082 If Choice = "Tai" Then\r
1083     Pieces(29).PrValue = 28: Pieces(100).Value = 28\r
1084 Else\r
1085     Pieces(29).PrValue = 28: Pieces(76).Value = 28\r
1086 End If\r
1087 End Sub\r
1089 Sub CompTurn ()\r
1091 If LegalMoves = 0 Then\r
1092     Board.Caption = Cap\r
1093     If Computer = Turn Then\r
1094         FirstSeeMove = SeeMove\r
1095         SeeMove = 1\r
1096         CompMain\r
1097     End If\r
1098 End If\r
1099 End Sub\r
1101 Sub CompVComp ()\r
1102 Do\r
1103 CompMain\r
1104 Loop Until GameOver = 1 Or Mate = 1\r
1105 If GameOver = 1 Then NextTurn2\r
1106 GameOver = 0\r
1107 End Sub\r
1109 Sub ConfigLoad ()\r
1111 If Loading <> 1 Then\r
1112     Open Direct + "/" + "Shogi.cfg" For Input As #4\r
1113     Input #4, SeeMove, Timing, Computer, Threat, AutoPromote, Notate, LionHawkVer, TeachVer, Eval, Grade, ShowLast\r
1114     Close #4\r
1115 End If\r
1116 If SeeMove = 1 Then\r
1117     Board.MnuShowOn.Enabled = False\r
1118     Board.MnuShowOn.Checked = True\r
1119     Board.MnuShowOff.Enabled = True\r
1120     Board.MnuShowOff.Checked = False\r
1121 Else\r
1122     Board.MnuShowOn.Enabled = True\r
1123     Board.MnuShowOn.Checked = False\r
1124     Board.MnuShowOff.Enabled = False\r
1125     Board.MnuShowOff.Checked = True\r
1126 End If\r
1127 ConfigLoad2\r
1128 If ShowLast = 1 Then\r
1129     Board.MnuShowLastOn.Enabled = False\r
1130     Board.MnuShowLastOn.Checked = True\r
1131     Board.MnuShowLastOff.Enabled = True\r
1132     Board.MnuShowLastOff.Checked = False\r
1133 Else\r
1134     Board.MnuShowLastOn.Enabled = True\r
1135     Board.MnuShowLastOn.Checked = False\r
1136     Board.MnuShowLastOff.Enabled = False\r
1137     Board.MnuShowLastOff.Checked = True\r
1138 End If\r
1139 If Threat = "On" Then\r
1140     Board.MnuThreatOn.Enabled = False\r
1141     Board.MnuThreatOn.Checked = True\r
1142     Board.MnuThreatOff.Enabled = True\r
1143     Board.MnuThreatOff.Checked = False\r
1144 Else\r
1145     Board.MnuThreatOn.Enabled = True\r
1146     Board.MnuThreatOn.Checked = False\r
1147     Board.MnuThreatOff.Enabled = False\r
1148     Board.MnuThreatOff.Checked = True\r
1149 End If\r
1151 If Choice <> "Whale" And Choice <> "Maka" And Choice <> "Tai" And Choice <> "DaiDai" And Choice <> "Tori" And Choice <> "Micro" Then\r
1152     If AutoPromote = 1 Then\r
1153         Board.MnuAutoOn.Enabled = False\r
1154         Board.MnuAutoOn.Checked = True\r
1155         Board.MnuAutoOff.Enabled = True\r
1156         Board.MnuAutoOff.Checked = False\r
1157     Else\r
1158         Board.MnuAutoOn.Enabled = True\r
1159         Board.MnuAutoOn.Checked = False\r
1160         Board.MnuAutoOff.Enabled = False\r
1161         Board.MnuAutoOff.Checked = True\r
1162     End If\r
1163 End If\r
1165 If Eval = 1 Then\r
1166     Board.MnuEvalOn.Enabled = False\r
1167     Board.MnuEvalOn.Checked = True\r
1168     Board.MnuEvalOff.Enabled = True\r
1169     Board.MnuEvalOff.Checked = False\r
1170 Else\r
1171     Board.MnuEvalOn.Enabled = True\r
1172     Board.MnuEvalOn.Checked = False\r
1173     Board.MnuEvalOff.Enabled = False\r
1174     Board.MnuEvalOff.Checked = True\r
1175 End If\r
1177 If Choice = "Tenjiku" Then Board.MnuEvalOn.Enabled = False\r
1178 If Choice = "Tenjiku" Then\r
1179     If LionHawkVer = 1 Then\r
1180         Board.MnuLVer1.Enabled = False\r
1181         Board.MnuLVer1.Checked = True\r
1182         Board.MnuLVer2.Enabled = True\r
1183         Board.MnuLVer2.Checked = False\r
1184     Else\r
1185         Board.MnuLVer1.Enabled = True\r
1186         Board.MnuLVer1.Checked = False\r
1187         Board.MnuLVer2.Enabled = False\r
1188         Board.MnuLVer2.Checked = True\r
1189     End If\r
1190 End If\r
1191 If Choice = "Maka" Or Choice = "Tai" Then\r
1192     If TeachVer = 1 Then\r
1193         Board.MnuVer1.Enabled = False\r
1194         Board.MnuVer1.Checked = True\r
1195         Board.MnuVer2.Enabled = True\r
1196         Board.MnuVer2.Checked = False\r
1197     Else\r
1198         Board.MnuVer1.Enabled = True\r
1199         Board.MnuVer1.Checked = False\r
1200         Board.MnuVer2.Enabled = False\r
1201         Board.MnuVer2.Checked = True\r
1202     End If\r
1203 End If\r
1204 If Notate = 1 Then\r
1205     Board.NotTop.Visible = True\r
1206     Board.NotSide.Visible = True\r
1207     Board.MnuNotOff.Enabled = True\r
1208     Board.MnuNotOff.Checked = False\r
1209     Board.MnuNotOn.Enabled = False\r
1210     Board.MnuNotOn.Checked = True\r
1211 Else\r
1212     Board.NotTop.Visible = False\r
1213     Board.NotSide.Visible = False\r
1214     Board.MnuNotOff.Enabled = False\r
1215     Board.MnuNotOff.Checked = True\r
1216     Board.MnuNotOn.Enabled = True\r
1217     Board.MnuNotOn.Checked = False\r
1218 End If\r
1219 SetDifficulty\r
1221 End Sub\r
1223 Sub ConfigLoad2 ()\r
1225 If Choice = "Tenjiku" Then Computer = "None"\r
1226 If Computer = "White" Or Computer = "Both" Then\r
1227     Board.MnuWhitePlayer.Enabled = True\r
1228     Board.MnuWhitePlayer.Checked = False\r
1229     Board.MnuWhiteComp.Enabled = False\r
1230     Board.MnuWhiteComp.Checked = True\r
1231     Board.MnuBlackPlayer.Enabled = False\r
1232     Board.MnuBlackPlayer.Checked = True\r
1233     Board.MnuBlackComp.Enabled = True\r
1234     Board.MnuBlackComp.Checked = False\r
1235 End If\r
1236 If Computer = "Black" Then\r
1237     Board.MnuWhitePlayer.Enabled = False\r
1238     Board.MnuWhitePlayer.Checked = True\r
1239     Board.MnuWhiteComp.Enabled = True\r
1240     Board.MnuWhiteComp.Checked = False\r
1241     Board.MnuBlackPlayer.Enabled = True\r
1242     Board.MnuBlackPlayer.Checked = False\r
1243     Board.MnuBlackComp.Enabled = False\r
1244     Board.MnuBlackComp.Checked = True\r
1245 End If\r
1246 If Computer = "" Or Computer = "None" Then\r
1247     Board.MnuWhitePlayer.Enabled = False\r
1248     Board.MnuWhitePlayer.Checked = True\r
1249     Board.MnuWhiteComp.Enabled = True\r
1250     Board.MnuWhiteComp.Checked = False\r
1251     Board.MnuBlackPlayer.Enabled = False\r
1252     Board.MnuBlackPlayer.Checked = True\r
1253     Board.MnuBlackComp.Enabled = True\r
1254     Board.MnuBlackComp.Checked = False\r
1255 End If\r
1256 If Choice = "Tenjiku" Then\r
1257     Eval = 0\r
1258     Board.MnuWhiteComp.Enabled = False\r
1259     Board.MnuBlackComp.Enabled = False\r
1260 End If\r
1261 End Sub\r
1263 Sub ConfigSave ()\r
1265 Response% = MsgBox("Do you wish to save your Game Preferences?", 36)\r
1266 If Response% = 6 Then\r
1267     Open Direct + "\" + "Shogi.cfg" For Output As #4\r
1268     Write #4, SeeMove, Timing, Computer, Threat, AutoPromote, Notate, LionHawkVer, TeachVer, Eval, Grade, ShowLast\r
1269     Close #4\r
1270 End If\r
1271 End Sub\r
1273 Sub ConsiderMate ()\r
1275 BestTally(0) = -999999: CompMove = 0: Influence = 3: Evaluate = 1\r
1276 MakeMap\r
1277 If Turn = "Black" Then\r
1278     Steps = -1\r
1279     StartAA = LegalMoves\r
1280     EndAA = 1\r
1281 Else\r
1282     Steps = 1\r
1283     StartAA = 1\r
1284     EndAA = LegalMoves\r
1285 End If\r
1286 For AA = StartAA To EndAA Step Steps\r
1287     WhiteTally = 0: BlackTally = 0\r
1288     DoEvents\r
1289     Evaluate = 1\r
1290     For JJ = 1 To BoardSizeY\r
1291         For KK = 1 To BoardSizeX\r
1292             Squares(KK, JJ) = Comp(KK, JJ)\r
1293         Next KK\r
1294     Next JJ\r
1295     InitFile = CompLegal(AA).StartFile\r
1296     InitRank = CompLegal(AA).StartRank\r
1297     CompFile = CompLegal(AA).EndFile\r
1298     CompRank = CompLegal(AA).EndRank\r
1299     Evaluate = 0\r
1300     FindInfluence\r
1301     If InitFile <> 0 Then Squares(InitFile, InitRank) = 0\r
1302     Squares(CompFile, CompRank) = CompLegal(AA).EndPiece\r
1303     Evaluate = 1\r
1304     For PP = 1 To Changed\r
1305         InitFile = Clearing(PP).File\r
1306         InitRank = Clearing(PP).Rank\r
1307         If Squares(InitFile, InitRank) <> 0 Then Validate\r
1308     Next PP\r
1309     Evaluate = 0\r
1310     For DD = 1 To BoardSizeY\r
1311         For EE = 1 To BoardSizeX\r
1312             If Squares(EE, DD) <> 0 Then\r
1313                 If BanMap(EE, DD).WhiteNum > 0 And (Squares(EE, DD) = 1 Or (Squares(EE, DD) > 0 And BlackKing = 1 And (Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince"))) Then BlackTally = -99999\r
1314                 If BanMap(EE, DD).BlackNum > 0 And (Squares(EE, DD) = -1 Or (Squares(EE, DD) < 0 And WhiteKing = 1 And (Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince"))) Then WhiteTally = -99999\r
1315             End If\r
1316         Next EE\r
1317     Next DD\r
1318     If Turn = "White" And WhiteTally = 0 Then BestTally(0) = 0: Exit Sub\r
1319     If Turn = "Black" And BlackTally = 0 Then BestTally(0) = 0: Exit Sub\r
1320     RestoreMap\r
1321 Next AA\r
1322 LegalMoves = 0\r
1323 End Sub\r
1325 Sub ConsiderMove ()\r
1327 ' Evaluate Legal Moves\r
1329 BestTally(0) = -999999: CompMove = 0: Influence = 3: Evaluate = 1\r
1330 If Level > 0 Then\r
1331     For BB = 1 To Level + 1\r
1332         BestTally(BB) = -999999\r
1333         OldKingTally(BB) = 0\r
1334         ECapture(BB).Piece = 0\r
1335     Next BB\r
1336 End If\r
1337 MakeMap\r
1338 For AA = 1 To LegalMoves\r
1339     KingTally(AA) = 0: WhiteTally = 0: BlackTally = 0\r
1340     DoEvents\r
1341     Evaluate = 1\r
1342     For JJ = 1 To BoardSizeY\r
1343         For KK = 1 To BoardSizeX\r
1344             Squares(KK, JJ) = Comp(KK, JJ)\r
1345         Next KK\r
1346     Next JJ\r
1347     InitFile = CompLegal(AA).StartFile\r
1348     InitRank = CompLegal(AA).StartRank\r
1349     CompFile = CompLegal(AA).EndFile\r
1350     CompRank = CompLegal(AA).EndRank\r
1351     If Choice = "Maka" Or Choice = "Tai" Then\r
1352         If Turn = "Black" And Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then BlackTally = BlackTally - 20\r
1353         If Turn = "White" And Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then WhiteTally = WhiteTally - 20\r
1354     End If\r
1355     If Choice = "Shogi" And TurnCount <= 1 Then\r
1356         If InitFile = 6 And InitRank = 1 Then KingTally(AA) = KingTally(AA) - 5\r
1357         If InitFile = 5 And InitRank = 1 Then KingTally(AA) = KingTally(AA) - 2\r
1358         If (InitRank = 3 Or InitRank = 7) Then KingTally(AA) = KingTally(AA) + 1\r
1359         If InitFile = 4 And InitRank = 9 Then KingTally(AA) = KingTally(AA) - 5\r
1360         If InitFile = 5 And InitRank = 9 Then KingTally(AA) = KingTally(AA) - 2\r
1361         If (InitFile = 2 And InitRank = 3) Or (InitFile = 8 And InitRank = 7) Then KingTally(AA) = KingTally(AA) + 4\r
1362     End If\r
1363     If Drop = 1 And Level = 0 Then\r
1364         If Turn = "Black" And Squares(CompFile, CompRank) < 0 Then\r
1365             If Pieces(Abs(Squares(CompFile, CompRank))).Promotes = 0 And Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic > 0 Then BlackTally = BlackTally + (Pieces(Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic).Value * 10) Else BlackTally = BlackTally + (Pieces(Abs(Squares(CompFile, CompRank))).Value * 10)\r
1366         End If\r
1367         If Turn = "White" And Squares(CompFile, CompRank) > 0 Then\r
1368             If Pieces(Abs(Squares(CompFile, CompRank))).Promotes = 0 And Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic > 0 Then WhiteTally = WhiteTally + (Pieces(Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic).Value * 10) Else WhiteTally = WhiteTally + (Pieces(Abs(Squares(CompFile, CompRank))).Value * 10)\r
1369         End If\r
1370     End If\r
1371     If Drop = 1 And Level > 1 Then\r
1372         If Turn = "Black" And Squares(CompFile, CompRank) < 0 Then\r
1373             If Pieces(Abs(Squares(CompFile, CompRank))).Promotes = 0 And Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic > 0 Then KingTally(AA) = KingTally(AA) + (Pieces(Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic).Value * 10) Else KingTally(AA) = KingTally(AA) + (Pieces(Abs(Squares(CompFile, CompRank))).Value * 10)\r
1374         End If\r
1375         If Turn = "White" And Squares(CompFile, CompRank) > 0 Then\r
1376             If Pieces(Abs(Squares(CompFile, CompRank))).Promotes = 0 And Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic > 0 Then KingTally(AA) = KingTally(AA) + (Pieces(Pieces(Abs(Squares(CompFile, CompRank))).PrGraphic).Value * 10) Else KingTally(AA) = KingTally(AA) + (Pieces(Abs(Squares(CompFile, CompRank))).Value * 10)\r
1377         End If\r
1378     End If\r
1379     If (TurnCount < 4 And BoardSizeY > 7) Or TurnCount < 2 Then KingTally(AA) = KingTally(AA) + 4 - (Rnd * 8)\r
1380     KingSafety\r
1381     Evaluate = 0\r
1382     FindInfluence\r
1383     If InitFile <> 0 Then Squares(InitFile, InitRank) = 0\r
1384     If ExtraCapture(AA).Piece <> 0 Then Squares(ExtraCapture(AA).File, ExtraCapture(AA).Rank) = 0\r
1385     Squares(CompFile, CompRank) = CompLegal(AA).EndPiece\r
1386     Evaluate = 1\r
1387     For PP = 1 To Changed\r
1388         InitFile = Clearing(PP).File\r
1389         InitRank = Clearing(PP).Rank\r
1390         If Squares(InitFile, InitRank) <> 0 Then Validate\r
1391     Next PP\r
1392     Evaluate = 0\r
1393     PawnMates\r
1394     If Turn = "Black" And BanMap(CompFile, CompRank).WhiteNum > 0 And BanMap(CompFile, CompRank).BlackNum = 0 And Comp(CompFile, CompRank) >= 0 Then BlackTally = BlackTally - 999\r
1395     If Turn = "White" And BanMap(CompFile, CompRank).BlackNum > 0 And BanMap(CompFile, CompRank).WhiteNum = 0 And Comp(CompFile, CompRank) <= 0 Then WhiteTally = WhiteTally - 999\r
1396     For DD = 1 To BoardSizeY\r
1397         For EE = 1 To BoardSizeX\r
1398             If Squares(EE, DD) <> 0 Then\r
1399                 If Squares(EE, DD) = 1 Or (Squares(EE, DD) > 1 And Pieces(Abs(Squares(EE, DD))).Name = "Emperor") Or (Squares(EE, DD) > 0 And BlackKing = 1 And (Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince")) Then BlackTally = BlackTally + 9999\r
1400                 If Squares(EE, DD) = -1 Or (Squares(EE, DD) < -1 And Pieces(Abs(Squares(EE, DD))).Name = "Emperor") Or (Squares(EE, DD) < 0 And WhiteKing = 1 And (Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince")) Then WhiteTally = WhiteTally + 9999\r
1401             End If\r
1402             If ExtraCapture(AA).Piece = 0 Or ExtraCapture(AA).File <> EE Or ExtraCapture(AA).Rank <> DD Then\r
1403                 If Squares(EE, DD) < 0 Then WhiteTally = WhiteTally + (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1404                 If Squares(EE, DD) > 0 Then BlackTally = BlackTally + (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1405             End If\r
1406             If Choice = "Tai" Or Choice = "Maka" Then\r
1407                 If Turn = "Black" Then\r
1408                     If Squares(EE, DD) > 0 Then\r
1409                         If BlackEmperor = 0 And WhiteEmperor = 1 And BanMap(EE, DD).BlackNum = 0 Then BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1410                         If Pieces(Abs(Squares(EE, DD))).Name = "Emperor" And BanMap(EE, DD).WhiteNum > 0 Then BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 20)\r
1411                         If Pieces(Abs(Squares(EE, DD))).Name = "Emperor" And WhiteEmperor = 1 And (EE <> WhiteEmpX Or DD <> WhiteEmpY) And BanMap(EE, DD).BlackNum = 0 Then BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 20)\r
1412                     End If\r
1413                 Else\r
1414                     If Squares(EE, DD) < 0 Then\r
1415                         If WhiteEmperor = 0 And BlackEmperor = 1 And BanMap(EE, DD).WhiteNum = 0 Then WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1416                         If Pieces(Abs(Squares(EE, DD))).Name = "Emperor" And BanMap(EE, DD).BlackNum > 0 Then WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 20)\r
1417                         If Pieces(Abs(Squares(EE, DD))).Name = "Emperor" And BlackEmperor = 1 And (EE <> BlackEmpX Or DD <> BlackEmpY) And BanMap(EE, DD).WhiteNum = 0 Then WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 20)\r
1418                     End If\r
1419                 End If\r
1420             End If\r
1421             If BanMap(EE, DD).BlackNum = 0 And BanMap(EE, DD).WhiteNum > 0 Then\r
1422                 WhiteTally = 1 + Abs((BoardSizeY / 2) + .5 - DD) / 2 + WhiteTally\r
1423                 If Squares(EE, DD) < 0 Then WhiteTally = WhiteTally + 1\r
1424                 If Squares(EE, DD) > 0 And Turn = "Black" Then BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1425                 If Squares(EE, DD) = 1 And Turn = "Black" And Level > 1 Then KingTally(AA) = -99999\r
1426                 If Squares(EE, DD) > 0 And Turn = "Black" And Level = 0 Then BlackTally = BlackTally + (Pieces(Abs(Squares(EE, DD))).Value)\r
1427             End If\r
1428             If BanMap(EE, DD).WhiteNum = 0 And BanMap(EE, DD).BlackNum > 0 Then\r
1429                 BlackTally = 1 + Abs((BoardSizeY / 2) + .5 - DD) / 2 + BlackTally\r
1430                 If Squares(EE, DD) > 0 Then BlackTally = BlackTally + 1\r
1431                 If Squares(EE, DD) = -1 And Turn = "White" And Level > 1 Then KingTally(AA) = -99999\r
1432                 If Squares(EE, DD) < 0 And Turn = "White" Then WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1433                 If Squares(EE, DD) < 0 And Turn = "White" And Level = 0 Then WhiteTally = WhiteTally + (Pieces(Abs(Squares(EE, DD))).Value)\r
1434             End If\r
1435             If BanMap(EE, DD).WhiteNum > 0 And BanMap(EE, DD).BlackNum > 0 Then\r
1436                 If Squares(EE, DD) > 0 And Turn = "Black" Then\r
1437                     LionAttack = 0\r
1438                     If (Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai") Then\r
1439                         For JJJ = DD - 1 To DD + 1\r
1440                             For KKK = EE - 1 To EE + 1\r
1441                                 If JJJ > 0 And JJJ < BoardSizeY And KKK > 0 And KKK < BoardSizeX Then\r
1442                                     If Squares(KKK, JJJ) < 0 Then\r
1443                                         If Pieces(Abs(Squares(KKK, JJJ))).special = "L" Then LionAttack = 1\r
1444                                     End If\r
1445                                 End If\r
1446                             Next KKK\r
1447                         Next JJJ\r
1448                     End If\r
1449                     If LionAttack = 1 Then\r
1450                         BlackTally = BlackTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1451                         LionAttack = 0\r
1452                     Else\r
1453                     For QQ = 1 To Attacker(EE, DD)\r
1454                         If BanMap(EE, DD).Info(QQ).Piece <> 0 Then\r
1455                             If BanMap(EE, DD).Info(QQ).Piece < 0 And (Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowWhite(EE, DD) Or LowWhite(EE, DD) = 0) Then\r
1456                                 LowWhite(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
1457                                 If Level < 2 Then LowWhite(EE, DD) = LowWhite(EE, DD) - 1\r
1458                             End If\r
1459                             If BanMap(EE, DD).WhiteNum > 1 And BanMap(EE, DD).Info(QQ).Piece > 0 And Level > 0 Then\r
1460                                 If Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowBlack(EE, DD) Or LowBlack(EE, DD) = 0 Then LowBlack(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
1461                             End If\r
1462                         End If\r
1463                     Next QQ\r
1464                     BlackLoss = ((Pieces(Abs(Squares(EE, DD))).Value + LowBlack(EE, DD) - LowWhite(EE, DD)) * 10)\r
1465                     If Squares(EE, DD) = 1 Or Pieces(Abs(Squares(EE, DD))).Name = "Emperor" Or (BlackKing = 1 And Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince") Then BlackLoss = 29999: If Level > 0 Then KingTally(AA) = -99999\r
1466                     If BlackLoss > HighBlackLoss Then HighBlackLoss = BlackLoss\r
1467                     End If\r
1468                 End If\r
1469                 If Squares(EE, DD) < -1 And Turn = "Black" Then BlackTally = BlackTally + (Pieces(Abs(Squares(EE, DD))).Value / 4)\r
1470                 If Squares(EE, DD) < 0 And Turn = "White" Then\r
1471                     LionAttack = 0\r
1472                     If (Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai") Then\r
1473                         For JJJ = DD - 1 To DD + 1\r
1474                             For KKK = EE - 1 To EE + 1\r
1475                                 If JJJ > 0 And JJJ < BoardSizeY And KKK > 0 And KKK < BoardSizeX Then\r
1476                                     If Squares(KKK, JJJ) > 0 Then\r
1477                                         If Pieces(Abs(Squares(KKK, JJJ))).special = "L" Then LionAttack = 1\r
1478                                     End If\r
1479                                 End If\r
1480                             Next KKK\r
1481                         Next JJJ\r
1482                     End If\r
1483                     If LionAttack = 1 Then\r
1484                         WhiteTally = WhiteTally - (Pieces(Abs(Squares(EE, DD))).Value * 10)\r
1485                         LionAttack = 0\r
1486                     Else\r
1487                     For QQ = 1 To Attacker(EE, DD)\r
1488                         If BanMap(EE, DD).Info(QQ).Piece <> 0 Then\r
1489                             If BanMap(EE, DD).Info(QQ).Piece > 0 And (Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowBlack(EE, DD) Or LowBlack(EE, DD) = 0) Then\r
1490                                 LowBlack(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
1491                                 If Level < 2 Then LowWhite(EE, DD) = LowWhite(EE, DD) - 1\r
1492                             End If\r
1493                             If BanMap(EE, DD).BlackNum > 1 And BanMap(EE, DD).Info(QQ).Piece < 0 And Level > 0 Then\r
1494                                 If Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value < LowWhite(EE, DD) Or LowWhite(EE, DD) = 0 Then LowWhite(EE, DD) = Pieces(Abs(BanMap(EE, DD).Info(QQ).Piece)).Value\r
1495                             End If\r
1496                         End If\r
1497                     Next QQ\r
1498                     WhiteLoss = ((Pieces(Abs(Squares(EE, DD))).Value + LowWhite(EE, DD) - LowBlack(EE, DD)) * 10)\r
1499                     If Squares(EE, DD) = -1 Or Pieces(Abs(Squares(EE, DD))).Name = "Emperor" Or (WhiteKing = 1 And Pieces(Abs(Squares(EE, DD))).Name = "Crown Prince" Or Pieces(Abs(Squares(EE, DD))).Name = "Prince") Then WhiteLoss = 29999: If Level > 0 Then KingTally(AA) = -99999\r
1500                     If WhiteLoss > HighWhiteLoss Then HighWhiteLoss = WhiteLoss\r
1501                 End If\r
1502                 End If\r
1503                 If Squares(EE, DD) > 1 And Turn = "White" Then WhiteTally = WhiteTally + (Pieces(Abs(Squares(EE, DD))).Value / 4)\r
1504             End If\r
1505             File = EE: Rank = DD: CompMate\r
1506             LowWhite(EE, DD) = 0: LowBlack(EE, DD) = 0\r
1507         Next EE\r
1508     Next DD\r
1509     If Drop = 1 Then\r
1510         For FF = 1 To Capture\r
1511             BlackTally = BlackTally + (Pieces(Abs(CapRef(FF))).Value * 10.5) * (InHand(FF))\r
1512             WhiteTally = WhiteTally + (Pieces(Abs(CapRef(FF + Capture))).Value * 10.5) * (InHand(FF + Capture))\r
1513         Next FF\r
1514         If CompLegal(AA).StartFile = 0 Then\r
1515             If Turn = "White" Then\r
1516                 WhiteTally = WhiteTally - Pieces(Abs(CompLegal(AA).StartPiece)).Value * 10.5\r
1517             Else\r
1518                 BlackTally = BlackTally - Pieces(Abs(CompLegal(AA).StartPiece)).Value * 10.5\r
1519             End If\r
1520         End If\r
1521     End If\r
1522     BlackTally = BlackTally - HighBlackLoss: HighBlackLoss = 0\r
1523     WhiteTally = WhiteTally - HighWhiteLoss: HighWhiteLoss = 0\r
1524     If Level > 0 And Rnd < .5 Then\r
1525         If Turn = "White" Then WhiteTally = WhiteTally + Int(Rnd * 2) + 1 Else BlackTally = BlackTally + Int(Rnd * 2) + 1\r
1526     End If\r
1527     If Level > 1 Then\r
1528         If Turn = "White" And (WhiteTally - BlackTally) + KingTally(AA) > BestTally(TestDepth) Then\r
1529             BestTally(Level + 1) = (WhiteTally - BlackTally) + KingTally(AA): BestMove = AA: ReorderMoves\r
1530         End If\r
1531         If Turn = "Black" And (BlackTally - WhiteTally) + KingTally(AA) > BestTally(TestDepth) Then\r
1532             BestTally(Level + 1) = (BlackTally - WhiteTally) + KingTally(AA): BestMove = AA: ReorderMoves\r
1533         End If\r
1534     Else\r
1535         If Level = 1 Then\r
1536             If Turn = "White" And WhiteTally - BlackTally + KingTally(AA) > BestTally(1) Then\r
1537                 BestTally(1) = WhiteTally - BlackTally + KingTally(AA): BestMove = AA\r
1538                 If (Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai") And ExtraCapture(AA).Piece <> 0 Then\r
1539                     LionVictim.Piece = ExtraCapture(AA).Piece\r
1540                     LionVictim.File = ExtraCapture(AA).File\r
1541                     LionVictim.Rank = ExtraCapture(AA).Rank\r
1542                 Else\r
1543                     LionVictim.Piece = 0\r
1544                 End If\r
1545             End If\r
1546             If Turn = "Black" And BlackTally - WhiteTally + KingTally(AA) > BestTally(1) Then\r
1547                 BestTally(1) = BlackTally - WhiteTally + KingTally(AA): BestMove = AA\r
1548                 If (Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai") And ExtraCapture(AA).Piece <> 0 Then\r
1549                     LionVictim.Piece = ExtraCapture(AA).Piece\r
1550                     LionVictim.File = ExtraCapture(AA).File\r
1551                     LionVictim.Rank = ExtraCapture(AA).Rank\r
1552                 Else\r
1553                     LionVictim.Piece = 0\r
1554                 End If\r
1555             End If\r
1556         Else\r
1557             If Turn = "White" And WhiteTally - BlackTally + KingTally(AA) > BestTally(0) Then\r
1558                 BestTally(0) = WhiteTally - BlackTally + KingTally(AA)\r
1559             End If\r
1560             If Turn = "Black" And BlackTally - WhiteTally + KingTally(AA) > BestTally(0) Then\r
1561                 BestTally(0) = BlackTally - WhiteTally + KingTally(AA)\r
1562             End If\r
1563         End If\r
1564     End If\r
1565     RestoreMap\r
1566     ExtraCapture(AA).Piece = 0\r
1567 Next AA\r
1569 End Sub\r
1571 Sub Convert ()\r
1573 ClearLegal\r
1574 DropTest = 0: Strip = 0: NoStrip = 0\r
1575 I = TurnCount + 1\r
1576 ShortScore(I) = CMove$\r
1577 K = Len(ShortScore(I))\r
1578 If InStr(ShortScore(I), "*") = 0 Or Right(ShortScore(I), 1) = "*" Then\r
1579     For AB = 1 To BoardSizeY\r
1580         For CD = 1 To BoardSizeX\r
1581             If Squares(CD, AB) = Score(TurnCount).IDStart And Score(TurnCount).IDStart <> 0 And (File <> CD Or Rank <> AB) Then\r
1582                 If Pieces(Abs(Squares(CD, AB))).sname = Pieces(Abs(Score(TurnCount).IDStart)).sname Then\r
1583                     FirstFile = CD: FirstRank = AB\r
1584                     TestOther\r
1585                 End If\r
1586             End If\r
1587         Next CD\r
1588     Next AB\r
1589     If Testing123 <> 1 Then\r
1590     For J = 1 To K\r
1591         If Mid(ShortScore(I), J, 1) > Chr$(47) And Mid(ShortScore(I), J, 1) < Chr$(58) And NoStrip = 0 And Strip = 0 Then\r
1592         Strip = 1\r
1593         LeftBit = Left(ShortScore(I), J - 1)\r
1594         End If\r
1595         If Strip = 1 And Mid(ShortScore(I), J, 1) > Chr$(96) And Mid(ShortScore(I), J, 1) < Chr$(123) Then\r
1596         NoStrip = 1: Strip = 0\r
1597         RightBit = Right(ShortScore(I), K - J)\r
1598         End If\r
1599     Next J\r
1600     ShortScore(I) = LeftBit + RightBit\r
1601     End If\r
1602     Testing123 = 0\r
1603 End If\r
1604  \r
1605 End Sub\r
1607 Sub ConvertScore ()\r
1609 For I = 1 To TurnCount\r
1610     Strip = 0: NoStrip = 0\r
1611     ShortScore(I) = Score(I).Caption\r
1612     For J = 1 To Len(ShortScore(I))\r
1613       If Mid(ShortScore(I), J, 1) = " " Then ShortScore(I) = Right(ShortScore(I), Len(ShortScore(I)) - J): OldScore = 1\r
1614     Next J\r
1615     If OldScore = 1 Then\r
1616         K = Len(ShortScore(I))\r
1617         If InStr(ShortScore(I), "*") = 0 Or Right(ShortScore(I), 1) = "*" Then\r
1618             For J = 1 To K\r
1619                 If Mid(ShortScore(I), J, 1) > Chr$(47) And Mid(ShortScore(I), J, 1) < Chr$(58) And NoStrip = 0 And Strip = 0 Then\r
1620                     Strip = 1\r
1621                     LeftBit = Left(ShortScore(I), J - 1)\r
1622                 End If\r
1623                 If Strip = 1 And Mid(ShortScore(I), J, 1) > Chr$(96) And Mid(ShortScore(I), J, 1) < Chr$(123) Then\r
1624                     NoStrip = 1: Strip = 0\r
1625                     RightBit = Right(ShortScore(I), K - J)\r
1626                 End If\r
1627             Next J\r
1628             ShortScore(I) = LeftBit + RightBit\r
1629         End If\r
1630     End If\r
1631     OldScore = 0\r
1632     Score(I).Caption = ShortScore(I)\r
1633 Next I\r
1634 End Sub\r
1636 Sub DiagramDrop ()\r
1638 BlackDrop(1) = "|": BlackDrop(2) = "|": Z = 1\r
1639 If Reverse = 0 Then\r
1640     J = 1: K = Capture\r
1641     L = K + 1: M = K * 2\r
1642 Else\r
1643     L = 1: M = Capture\r
1644     J = M + 1: K = M * 2\r
1645 End If\r
1646 For I = J To K\r
1647     If InHand(I) > 0 Then\r
1648         BlackDrop(Z) = BlackDrop(Z) + " " + Left(Pieces(Abs(CapRef(I))).sname, Len(Trim$(Pieces(Abs(CapRef(I))).sname)))\r
1649         If InHand(I) > 1 Then BlackDrop(Z) = BlackDrop(Z) + "x" + Trim$(Str$(InHand(I)))\r
1650         If Len(BlackDrop(Z)) > 12 Then Z = 2\r
1651     End If\r
1652 Next I\r
1653 WhiteDrop(2) = "|": WhiteDrop(1) = "|": Z = 1\r
1654 For I = L To M\r
1655     If InHand(I) > 0 Then\r
1656         WhiteDrop(Z) = WhiteDrop(Z) + " " + Left(Pieces(Abs(CapRef(I))).sname, Len(Trim$(Pieces(Abs(CapRef(I))).sname)))\r
1657         If InHand(I) > 1 Then WhiteDrop(Z) = WhiteDrop(Z) + "x" + Trim$(Str$(InHand(I)))\r
1658         If Len(WhiteDrop(Z)) > 13 Then Z = 2\r
1659     End If\r
1660 Next I\r
1661 If WhiteDrop(1) = "|" Then WhiteDrop(1) = WhiteDrop(1) + " Nothing"\r
1662 If BlackDrop(1) = "|" Then BlackDrop(1) = BlackDrop(1) + " Nothing"\r
1663 For I = 1 To 2\r
1664     WhiteDrop(I) = WhiteDrop(I) + Space(17 - Len(WhiteDrop(I))) + "|"\r
1665     BlackDrop(I) = BlackDrop(I) + Space(17 - Len(BlackDrop(I))) + "|"\r
1666 Next I\r
1667 End Sub\r
1669 Sub DiagramFile ()\r
1671 On Error Resume Next\r
1672 Board.CMDiagram.DialogTitle = "Create Text Diagram"\r
1673 Board.CMDiagram.Flags = &H400& Or &H800& Or &H4&\r
1674 Board.CMDiagram.Action = 2\r
1675 If Err = 32755 Then Exit Sub\r
1676 Saved$ = Board.CMDiagram.Filename\r
1678 Open Saved$ For Output As #3\r
1680 If GameName = "Whale" Or GameName = "Early" Or GameName = "Bird" Or GameName = "Micro" Or GameName = "Mini" Or GameName = "" Then Short = 1 Else Short = 0\r
1681 If Drop = 1 Then DiagramDrop\r
1682 DropStart = 0: DropEnd = 0\r
1683 If Drop = 1 Then\r
1684     DropStart = 1\r
1685     DropEnd = BoardSizeY - 1\r
1686 End If\r
1687 If GameName <> "" Then\r
1688     Print #3, GameName; " Shogi"\r
1689     For I = 1 To Len(GameName) + 6\r
1690         Print #3, "=";\r
1691     Next I\r
1692 End If\r
1693 Print #3,\r
1694 Print #3, " ";\r
1695 For I = BoardSizeX To 1 Step -1\r
1696     If I < 10 Then Print #3, " ";\r
1697     If Short = 0 Then Print #3, " ";\r
1698     Print #3, I; " ";\r
1699 Next I\r
1700 Print #3,\r
1701 For J = 1 To BoardSizeY\r
1702     Print #3, "+";\r
1703     For I = 1 To BoardSizeX - 1\r
1704         If Short = 0 Then Print #3, "------";  Else Print #3, "-----";\r
1705     Next I\r
1706     If Short = 0 Then Print #3, "-----+";  Else Print #3, "----+";\r
1707     If Drop = 1 Then\r
1708         If J = DropStart Then Print #3, "      White in hand:";\r
1709         If J = DropStart + 1 Then Print #3, "      "; WhiteDrop(1);\r
1710         If J = DropEnd + 1 Then Print #3, "      "; BlackDrop(1);\r
1711         If J = DropEnd Then Print #3, "      Black in hand:";\r
1712         If J = DropStart + 2 Then Print #3, "      +----------------+";\r
1713     End If\r
1714     Print #3,\r
1715     For I = 1 To BoardSizeX\r
1716         Print #3, "|";\r
1717         If Squares(I, J) <> 0 Then\r
1718             If Squares(I, J) > 0 Then Print #3, " b";  Else Print #3, " w";\r
1719             Print #3, Left$(Pieces(Abs(Squares(I, J))).sname, 3 - Short);\r
1720         Else\r
1721             If Short = 0 Then Print #3, "     ";  Else Print #3, "    ";\r
1722         End If\r
1723     Next I\r
1724     Print #3, "| "; Chr$(96 + J);\r
1725     If J = DropStart Or J = DropEnd Then Print #3, "    +----------------+";\r
1726     If J = DropStart + 1 Then Print #3, "    "; WhiteDrop(2);\r
1727     If J = DropEnd + 1 Then Print #3, "    "; BlackDrop(2);\r
1728     Print #3,\r
1729 Next J\r
1730 Print #3, "+";\r
1731 For I = 1 To BoardSizeX - 1\r
1732     If Short = 0 Then Print #3, "------";  Else Print #3, "-----";\r
1733 Next I\r
1734 If Short = 0 Then Print #3, "-----+";  Else Print #3, "----+";\r
1735 If DropEnd > 0 Then Print #3, "      +----------------+";\r
1736 Print #3,\r
1737 Print #3,\r
1738 Print #3, Turn; " to move."\r
1739 Board.Caption = "Diagram text file " + Board.CMDiagram.Filename + " created.": Notice = 1\r
1740 Close #3\r
1741 End Sub\r
1743 Sub DiagramSmall ()\r
1745 On Error Resume Next\r
1746 Board.CMDiagram.DialogTitle = "Create Small Text Diagram"\r
1747 Board.CMDiagram.Flags = &H400& Or &H800& Or &H4&\r
1748 Board.CMDiagram.Action = 2\r
1749 If Err = 32755 Then Exit Sub\r
1750 Saved$ = Board.CMDiagram.Filename\r
1752 Open Saved$ For Output As #3\r
1754 If GameName = "Whale" Or GameName = "Early" Or GameName = "Bird" Or GameName = "Micro" Or GameName = "Mini" Or GameName = "" Then Short = 1 Else Short = 0\r
1755 If Drop = 1 Then DiagramDrop\r
1756 DropStart = 0: DropEnd = 0\r
1757 If Drop = 1 Then\r
1758     DropStart = 1\r
1759     DropEnd = BoardSizeY - 1\r
1760 End If\r
1761 If GameName <> "" Then\r
1762     Print #3, GameName; " Shogi"\r
1763     For I = 1 To Len(GameName) + 6\r
1764         Print #3, "=";\r
1765     Next I\r
1766 End If\r
1767 Print #3,\r
1768 For I = BoardSizeX To 1 Step -1\r
1769     If I < 10 Then Print #3, " ";\r
1770     If Short = 0 Then Print #3, " ";\r
1771     Print #3, Trim$(Str$(I));\r
1772     Print #3, " ";\r
1773 Next I\r
1774 Print #3,\r
1775 Print #3, "+";\r
1776 For I = 1 To BoardSizeX - 1\r
1777     If Short = 0 Then Print #3, "----";  Else Print #3, "---";\r
1778 Next I\r
1779 If Short = 0 Then Print #3, "----+";  Else Print #3, "---+";\r
1780 If DropStart = 1 Then Print #3, "    White in hand:";\r
1781 Print #3,\r
1782 For J = 1 To BoardSizeY\r
1783     Print #3, "|";\r
1784     For I = 1 To BoardSizeX\r
1785         If Squares(I, J) <> 0 Then\r
1786             If Squares(I, J) > 0 Then Print #3, "b";  Else Print #3, "w";\r
1787             Print #3, Left$(Pieces(Abs(Squares(I, J))).sname, 3 - Short);\r
1788         Else\r
1789             If Short = 0 Then Print #3, " *  ";  Else Print #3, " * ";\r
1790         End If\r
1791     Next I\r
1792     Print #3, "|"; Chr$(96 + J);\r
1793     If J = DropStart Then Print #3, "  "; Mid(WhiteDrop(1), 2, 16);\r
1794     If J = DropStart + 1 Then Print #3, "  "; Mid(WhiteDrop(2), 2, 16);\r
1795     If J = DropEnd + 1 Then Print #3, "  "; Mid(BlackDrop(1), 2, 16);\r
1796     If J = DropEnd Then Print #3, "   Black in hand:";\r
1797     Print #3,\r
1798 Next J\r
1799 Print #3, "+";\r
1800 For I = 1 To BoardSizeX - 1\r
1801     If Short = 0 Then Print #3, "----";  Else Print #3, "---";\r
1802 Next I\r
1803 If Short = 0 Then Print #3, "----+";  Else Print #3, "---+";\r
1804 If DropEnd > 0 Then Print #3, "    "; Mid(BlackDrop(2), 2, 16);\r
1805 Print #3,\r
1806 Print #3, Turn; " to move."\r
1807 Board.Caption = "Diagram text file " + Board.CMDiagram.Filename + " created.": Notice = 1\r
1808 Close #3\r
1810 End Sub\r
1812 Sub DisplayEmperor ()\r
1814 For K = 1 To BoardSizeY\r
1815     For J = 1 To BoardSizeX\r
1816         Board.ForeColor = &HFF8080\r
1817         Legal(J, K) = 1: L = 0\r
1818         If Turn = "Black" And Squares(J, K) < 0 And ((Camps(J, K) = 1 Or Camps(J, K) = 3) Or WhiteEmperor = 1) Then Legal(J, K) = 0\r
1819         If Turn = "White" And Squares(J, K) > 0 And (Camps(J, K) > 1 Or BlackEmperor = 1) Then Legal(J, K) = 0\r
1820         If Turn = "Black" And Squares(J, K) < 0 And Legal(J, K) = 1 Then Board.ForeColor = &HC0\r
1821         If Turn = "White" And Squares(J, K) > 0 And Legal(J, K) = 1 Then Board.ForeColor = &HC0\r
1822         If FirstInitRank = K And FirstInitFile = J Then Legal(J, K) = 0\r
1823         If Squares(J, K) <> 0 Then\r
1824             If Pieces(Abs(Squares(J, K))).Name = "Emperor" And Sgn(Squares(J, K)) <> Sgn(Squares(FirstInitFile, FirstInitRank)) Then\r
1825                 NewRank = K: NewFile = J: Legal(J, K) = 1: CheckEmperor\r
1826                 K = NewRank: J = NewFile\r
1827                 If Legal(J, K) = 1 Then Board.ForeColor = &HC0\r
1828             End If\r
1829         End If\r
1830         If SeeMove = 1 And Legal(J, K) = 1 Then\r
1831             If Squares(J, K) = 0 Then\r
1832                 If Reverse = 0 Then\r
1833                     Board.Line (XStart + ((J - 1) * Pixels), 11 + ((K - 1) * Pixels))-(XStart + (J * Pixels) - 2, 9 + (K * Pixels)), , BF\r
1834                 Else\r
1835                     Board.Line (XStart + ((BoardSizeX - J) * Pixels), 11 + ((BoardSizeY - K) * Pixels))-(XStart - 2 + ((BoardSizeX - J + 1) * Pixels), 9 + ((BoardSizeY - K + 1) * Pixels) + L), , BF\r
1836                 End If\r
1837             Else\r
1838                 For EF = 2 To Pixels\r
1839                     If Reverse = 0 Then\r
1840                         If Squares(J, K) > 0 Then\r
1841                            Board.Line (XStart + ((J - 1) * Pixels) + EF - 2, 11 + ((K - 1) * Pixels))-(XStart + ((J - 1) * Pixels) + EF - 2, 11 + ((K - 1) * Pixels) + PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF) + 1)\r
1842                         Else\r
1843                            Board.Line (XStart + ((J - 1) * Pixels) + (Pixels - EF), 9 + (K * Pixels))-(XStart + ((J - 1) * Pixels) + (Pixels - EF), 8 + (K * Pixels) - (PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF)))\r
1844                         End If\r
1845                     Else\r
1846                         If Squares(J, K) > 0 Then\r
1847                            Board.Line (XStart + ((BoardSizeX - J) * Pixels + (Pixels - EF)), 8 + ((BoardSizeY - K + 1) * Pixels) + 1)-(XStart + ((BoardSizeX - J) * Pixels) + (Pixels - EF), 8 + ((BoardSizeY - K + 1) * Pixels) - PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF))\r
1848                         Else\r
1849                            Board.Line (XStart + ((BoardSizeX - J) * Pixels) + EF - 2, 10 + ((BoardSizeY - K) * Pixels) + 1)-(XStart + ((BoardSizeX - J) * Pixels) + EF - 2, 12 + ((BoardSizeY - K) * Pixels) + PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF))\r
1850                         End If\r
1851                     End If\r
1852                 Next EF\r
1853             End If\r
1854         End If\r
1855         Camps(J, K) = 0\r
1856     Next J\r
1857 Next K\r
1858 Influence = 0\r
1859 Board.ForeColor = &H0&\r
1860 Board.FillColor = &HFFFFFF\r
1862 End Sub\r
1864 Sub DisplayTerritory ()\r
1866 For K = 1 To BoardSizeY\r
1867     For J = 1 To BoardSizeX\r
1868         L = 0\r
1869         Select Case Choice\r
1870             Case "Heian", "Chu", "Dai", "Tenjiku": L = 1\r
1871         End Select\r
1872         Select Case Camps(J, K)\r
1873             Case 1: Board.ForeColor = &HFFFFFF\r
1874             Case 2: Board.ForeColor = &H606060\r
1875             Case 3: Board.ForeColor = &HC0C0C0\r
1876         End Select\r
1877         If Camps(J, K) > 0 Then\r
1878             If Squares(J, K) = 0 Then\r
1879                 If Reverse = 0 Then\r
1880                     Board.Line (XStart + L + ((J - 1) * Pixels), 11 + L + ((K - 1) * Pixels))-(XStart + (J * Pixels) - 2 + L, 9 + L + (K * Pixels)), , BF\r
1881                 Else\r
1882                     Board.Line (XStart + L + ((BoardSizeX - J) * Pixels), 11 + ((BoardSizeY - K) * Pixels) + L)-(XStart - 2 + L + ((BoardSizeX - J + 1) * Pixels), 9 + ((BoardSizeY - K + 1) * Pixels) + L), , BF\r
1883                 End If\r
1884             Else\r
1885                 If Squares(J, K) > 0 And Camps(J, K) = 1 Then Board.ForeColor = &HFF8080\r
1886                 If Squares(J, K) < 0 And Camps(J, K) = 2 Then Board.ForeColor = &HFF8080\r
1887                 If Squares(J, K) < 0 Then\r
1888                     If (Squares(J, K) = -1 Or Pieces(Abs(Squares(J, K))).Name = "Crown Prince" Or Pieces(Abs(Squares(J, K))).Name = "Prince") And Camps(J, K) > 1 Then Board.ForeColor = &HC0&\r
1889                 Else\r
1890                     If (Squares(J, K) = 1 Or Pieces(Abs(Squares(J, K))).Name = "Crown Prince" Or Pieces(Abs(Squares(J, K))).Name = "Prince") And (Camps(J, K) = 1 Or Camps(J, K) = 3) Then Board.ForeColor = &HC0&\r
1891                 End If\r
1892                 For EF = 2 To Pixels\r
1893                     If Reverse = 0 Then\r
1894                         If Squares(J, K) > 0 Then\r
1895                            Board.Line (XStart + ((J - 1) * Pixels) + EF - 2 + L, 11 + ((K - 1) * Pixels) + L)-(XStart + ((J - 1) * Pixels) + EF - 2 + L, 11 + ((K - 1) * Pixels) + PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF) + 1)\r
1896                         Else\r
1897                            Board.Line (XStart + ((J - 1) * Pixels) + (Pixels - EF) + L, 9 + (K * Pixels) + L)-(XStart + ((J - 1) * Pixels) + (Pixels - EF) + L, 8 + (K * Pixels) - (PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF) - (L * 2)))\r
1898                         End If\r
1899                     Else\r
1900                         If Squares(J, K) > 0 Then\r
1901                            Board.Line (XStart + ((BoardSizeX - J) * Pixels + (Pixels - EF)) + L, 8 + ((BoardSizeY - K + 1) * Pixels) + 1 + L)-(XStart + ((BoardSizeX - J) * Pixels) + (Pixels - EF) + L, 8 + ((BoardSizeY - K + 1) * Pixels) - PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF) + (L * 2))\r
1902                         Else\r
1903                            Board.Line (XStart + ((BoardSizeX - J) * Pixels) + EF - 2 + L, 10 + ((BoardSizeY - K) * Pixels) + 1 + L)-(XStart + ((BoardSizeX - J) * Pixels) + EF - 2 + L, 12 + ((BoardSizeY - K) * Pixels) + PieceMask(Pieces(Abs(Squares(J, K))).Mask, EF))\r
1904                         End If\r
1905                     End If\r
1906                 Next EF\r
1907             End If\r
1908         End If\r
1909         Camps(J, K) = 0\r
1910     Next J\r
1911 Next K\r
1912 Board.ForeColor = &H0&\r
1913 Board.FillColor = &HFFFFFF\r
1914 End Sub\r
1916 Sub DolphinMove ()\r
1918 If (Squares(InitFile, InitRank) > 0 And InitRank = 1) Or (Squares(InitFile, InitRank) < 0 And InitRank = 6) Then\r
1919     Pieces(Abs(Squares(InitFile, InitRank))).Moves(7) = 64\r
1920     Pieces(Abs(Squares(InitFile, InitRank))).Moves(8) = 64\r
1921 End If\r
1923 End Sub\r
1925 Sub DoubleMove ()\r
1927 ClearLegal\r
1928 LionName$ = Pieces(Abs(Squares(File, Rank))).Name\r
1929 Board.Caption = "Extra " + LionName$ + " move - Double Click on Piece to End Move."\r
1930 LionPiece = I\r
1931 Teach = Teach - 1\r
1932 If Reverse = 0 Then\r
1933     Board.Frame.Move XStart + (File - 1) * Pixels, 11 + (Rank - 1) * Pixels\r
1934 Else\r
1935     Board.Frame.Move XStart + (BoardSizeX - File) * Pixels, 11 + (BoardSizeY - Rank) * Pixels\r
1936 End If\r
1937 Board.Frame.Visible = True\r
1939 End Sub\r
1941 Sub DropPiece ()\r
1943 If NewButton = 1 Then\r
1944     Board.PieceID.Caption = ""\r
1945     Board.showpic(I).Drag 0\r
1946 Else\r
1947     Board.PieceID.Caption = ""\r
1948     Board.PieceID.ForeColor = &HFF0000\r
1949     RightClick = 0\r
1950 End If\r
1951 If LegalMoves = 0 Then ClearLegal\r
1953 End Sub\r
1955 Sub DropPiece2 ()\r
1956 If NewButton = 1 Then\r
1957     Board.PieceID.Caption = ""\r
1958     Board.HandPic(I).Drag 0\r
1959     If LegalMoves = 0 Then ClearLegal\r
1960 Else\r
1961     Board.PieceID.Caption = ""\r
1962     Board.PieceID.ForeColor = &HFF0000\r
1963     If LegalMoves = 0 Then ClearLegal\r
1964 End If\r
1965 End Sub\r
1967 Sub Emperor ()\r
1969 FirstInitFile = InitFile: FirstInitRank = InitRank: EmperorTest = 1\r
1970 Influence = 2\r
1971 For AB = 1 To BoardSizeY\r
1972     For CD = 1 To BoardSizeX\r
1973         If (Turn = "Black" And Squares(CD, AB) < 0) Or (Turn = "White" And Squares(CD, AB) > 0) Then\r
1974             InitFile = CD: InitRank = AB\r
1975             Validate\r
1976         End If\r
1977     Next CD\r
1978 Next AB\r
1979 DisplayEmperor\r
1980 Influence = 0: EmperorTest = 0\r
1981 InitRank = FirstInitRank: InitFile = FirstInitFile\r
1982 End Sub\r
1984 Sub EmperorCheck ()\r
1986 OldInfluence = Influence: OldCompMove = CompMove: OldSeeMove = SeeMove: SeeMove = 1\r
1987 CompMove = 0: Influence = 2\r
1988 For AB = 1 To BoardSizeY\r
1989    For CD = 1 To BoardSizeX\r
1990        InitFile = CD: InitRank = AB: Validate\r
1991    Next CD\r
1992 Next AB\r
1993 If Camps(BlackEmpX, BlackEmpY) = 0 Then\r
1994     If Turn = "White" Then\r
1995         Response% = MsgBox("You have left your Emperor in Check! ", 0, "Black")\r
1996     Else\r
1997         Board.PieceID.Caption = "Black Emperor is in Check!": Notice = 1\r
1998     End If\r
1999 Else\r
2000     If Camps(WhiteEmpX, WhiteEmpY) = 0 Then\r
2001         If Turn = "Black" Then\r
2002             Response% = MsgBox("You have left your Emperor in Check! ", 0, "White")\r
2003         Else\r
2004             Board.PieceID.Caption = "White Emperor is in Check!": Notice = 1\r
2005         End If\r
2006     End If\r
2007 End If\r
2008 For AB = 1 To BoardSizeY\r
2009     For CD = 1 To BoardSizeX\r
2010         Camps(CD, AB) = 0\r
2011     Next CD\r
2012 Next AB\r
2013 Influence = OldInfluence: CompMove = OldCompMove: SeeMove = OldSeeMove\r
2015 End Sub\r
2017 Sub EmperorInfluence ()\r
2019 If Squares(InitFile, InitRank) > 0 Then\r
2020      Board.ForeColor = &H606060\r
2021 Else\r
2022      Board.ForeColor = &HFFFFFF\r
2023 End If\r
2024 For EF = 2 To Pixels\r
2025     If Reverse = 0 Then\r
2026         If Squares(InitFile, InitRank) <> 0 Then\r
2027             If Squares(InitFile, InitRank) > 0 Then\r
2028                 Board.Line (XStart + ((InitFile - 1) * Pixels) + EF - 2, 11 + ((InitRank - 1) * Pixels))-(XStart + ((InitFile - 1) * Pixels) + EF - 2, 11 + ((InitRank - 1) * Pixels) + PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF) + 1)\r
2029             Else\r
2030                 Board.Line (XStart + ((InitFile - 1) * Pixels) + (Pixels - EF), 9 + (InitRank * Pixels))-(XStart + ((InitFile - 1) * Pixels) + (Pixels - EF), 8 + (InitRank * Pixels) - (PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF)))\r
2031             End If\r
2032         End If\r
2033     Else\r
2034         If Squares(InitFile, InitRank) <> 0 Then\r
2035             If Squares(InitFile, InitRank) > 0 Then\r
2036                 Board.Line (XStart + ((BoardSizeX - InitFile) * Pixels + (Pixels - EF)), 8 + ((BoardSizeY - InitRank + 1) * Pixels) + 1)-(XStart + ((BoardSizeX - InitFile) * Pixels) + (Pixels - EF), 8 + ((BoardSizeY - InitRank + 1) * Pixels) - PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF))\r
2037             Else\r
2038                 Board.Line (XStart + ((BoardSizeX - InitFile) * Pixels) + EF - 2, 10 + ((BoardSizeY - InitRank) * Pixels) + 1)-(XStart + ((BoardSizeX - InitFile) * Pixels) + EF - 2, 12 + ((BoardSizeY - InitRank) * Pixels) + PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF))\r
2039             End If\r
2040         End If\r
2041     End If\r
2042 Next EF\r
2043 Board.ForeColor = &H0&\r
2044 Board.FillColor = &HFFFFFF\r
2046 End Sub\r
2048 Sub EndLionMove ()\r
2049 If LionPiece = I Then\r
2050     K = 1\r
2051     Do\r
2052         L = 1\r
2053         Do\r
2054             If Grafix(L, K) = I Then\r
2055                 PieceName = Pieces(Abs(Squares(L, K))).Name\r
2056                 Board.PieceID.Caption = PieceName\r
2057                 File = L\r
2058                 Rank = K\r
2059                 Found = 1\r
2060             End If\r
2061             L = L + 1\r
2062         Loop Until L > BoardSizeX Or Found = 1\r
2063         K = K + 1\r
2064     Loop Until K > BoardSizeY Or Found = 1\r
2065     Found = 0\r
2066     Board.Frame.Visible = False\r
2067     LionPiece = -1\r
2068     LionBurn\r
2069     NextTurn\r
2070 Else\r
2071     UnPromote\r
2072 End If\r
2073 End Sub\r
2075 Sub EndSelect ()\r
2076 If MovePiece = 1 Then\r
2077     Board.Caption = Cap\r
2078     MovePiece = 0: Handicap = 0: Reduce = 0\r
2079     Board.Timer1.Enabled = True\r
2080     MoveCount = 0: TurnCount = 0\r
2081     If Turn = "White" Then MoveCount = 1\r
2082     Board.LastMove.Caption = ""\r
2083 Else\r
2084     Handicap = 0: Reduce = 0: MovePiece = 0\r
2085     If Drop = 1 Then ResetHand\r
2086     If Turn = "White" Then MoveCount = 1\r
2087     Load AddPieces\r
2088 End If\r
2089 BugFix\r
2090 End Sub\r
2092 Sub EndSetup ()\r
2094 MovePiece = 0: Selection = 0: Reduce = 0: Handicap = 0: ExtraPiece = ""\r
2096 End Sub\r
2098 Sub EndTilde ()\r
2099 If Tilde = 1 Then\r
2100     ClearLegal\r
2101     Board.Refresh\r
2102     Tilde = 0\r
2103 End If\r
2104 End Sub\r
2106 Sub FillSquare ()\r
2107 If Computer <> Turn And Computer <> "Both" And Level <> 0 And GameOver <> 1 Then\r
2108 If Selection <> 0 Then\r
2109     If NewX > XStart And NewX < XStart + (BoardSizeX * Pixels) And NewY > 11 And NewY < 11 + (BoardSizeY * Pixels) Then\r
2110         GetSquare\r
2111         Squares(InitFile, InitRank) = Selection\r
2112         NewGraf = 0\r
2113         Do While Board.showpic(NewGraf).Visible = True\r
2114             NewGraf = NewGraf + 1\r
2115         Loop\r
2116         SetGrafix\r
2117     End If\r
2118     Reduce = 0: Handicap = 0: MovePiece = 0\r
2119     CheckAdd\r
2120 Else\r
2121     Territory\r
2122 End If\r
2123 End If\r
2124 End Sub\r
2126 Sub FindEmperorMove ()\r
2128 BestCapture = 0: Vacant = 0\r
2129 If Turn = "Black" Then\r
2130     KStart = BoardSizeY: JStart = BoardSizeX: KEnd = 1: JEnd = 1: Steps = -1\r
2131 Else\r
2132     KStart = 1: JStart = 1: KEnd = BoardSizeY: JEnd = BoardSizeX: Steps = 1\r
2133 End If\r
2134 For K = KStart To KEnd Step Steps\r
2135     For J = JStart To JEnd Step Steps\r
2136         If Turn = "Black" And Squares(J, K) < 0 And Camps(J, K) <> 1 And Camps(J, K) <> 3 And WhiteEmperor <> 1 Then\r
2137            If Pieces(Abs(Squares(J, K))).Value > BestCapture Then\r
2138                BestCapture = Pieces(Abs(Squares(J, K))).Value: CaptureX = J: CaptureY = K\r
2139            End If\r
2140         End If\r
2141         If Turn = "White" And Squares(J, K) > 0 And Camps(J, K) < 2 And BlackEmperor <> 1 Then\r
2142            If Pieces(Abs(Squares(J, K))).Value > BestCapture Then\r
2143                BestCapture = Pieces(Abs(Squares(J, K))).Value: CaptureX = J: CaptureY = K\r
2144            End If\r
2145         End If\r
2146         If Turn = "Black" And Squares(J, K) = 0 And Camps(J, K) <> 1 And Camps(J, K) <> 3 And WhiteEmperor <> 1 And Vacant <> 1 Then\r
2147             VacantX = J: VacantY = K: Vacant = 1\r
2148         End If\r
2149         If Turn = "White" And Squares(J, K) = 0 And Camps(J, K) < 2 And BlackEmperor <> 1 And Vacant <> 1 Then\r
2150             VacantX = J: VacantY = K: Vacant = 1\r
2151         End If\r
2152         If Turn = "Black" And Squares(J, K) = 0 And Camps(J, K) = 2 And Vacant <> 1 Then\r
2153             VacantX = J: VacantY = K: Vacant = 1\r
2154         End If\r
2155         If Turn = "White" And Squares(J, K) = 0 And Camps(J, K) = 1 And Vacant <> 1 Then\r
2156             VacantX = J: VacantY = K: Vacant = 1\r
2157         End If\r
2158         Camps(J, K) = 0\r
2159     Next J\r
2160 Next K\r
2161 If Turn = "Black" Then InitFile = BlackEmpX: InitRank = BlackEmpY\r
2162 If Turn = "White" Then InitFile = WhiteEmpX: InitRank = WhiteEmpY\r
2163 If BestCapture > 0 Then\r
2164     SeeFile = CaptureX: SeeRank = CaptureY: AddEmperorMove\r
2165 End If\r
2166 SeeFile = VacantX: SeeRank = VacantY: AddEmperorMove\r
2167 Influence = 0\r
2168 End Sub\r
2170 Sub FindInfluence ()\r
2172 Changed = 1\r
2173 If LookMate = 1 Then\r
2174     Clearing(1).File = LastPieceX\r
2175     Clearing(1).Rank = LastPieceY\r
2176     File = LastPieceX: Rank = LastPieceY\r
2177     ClearInfo\r
2178 End If\r
2179 Clearing(Changed).File = CompFile\r
2180 Clearing(Changed).Rank = CompRank\r
2181 File = InitFile: Rank = InitRank\r
2182 If InitFile <> 0 Then ClearInfo\r
2183 If Squares(CompFile, CompRank) <> 0 Then\r
2184     File = CompFile: Rank = CompRank: CapturedPiece = 1: ClearInfo\r
2185 Else\r
2186     For LL = 1 To Attacker(CompFile, CompRank)\r
2187         File = BanMap(CompFile, CompRank).Info(LL).File\r
2188         Rank = BanMap(CompFile, CompRank).Info(LL).Rank\r
2189         If File <> 0 And (InitFile <> File Or InitRank <> Rank) Then\r
2190             If Pieces(Abs(Squares(File, Rank))).Range <> 0 Then ClearInfo\r
2191         End If\r
2192     Next LL\r
2193 End If\r
2194 If ExtraCapture(AA).Piece <> 0 Then\r
2195     File = ExtraCapture(AA).File: Rank = ExtraCapture(AA).Rank:  ClearInfo\r
2196     For LL = 1 To Attacker(ExtraCapture(AA).File, ExtraCapture(AA).Rank)\r
2197         File = BanMap(ExtraCapture(AA).File, ExtraCapture(AA).Rank).Info(LL).File\r
2198         Rank = BanMap(ExtraCapture(AA).File, ExtraCapture(AA).Rank).Info(LL).Rank\r
2199         If Pieces(Abs(Squares(File, Rank))).Range <> 0 Then ClearInfo\r
2200     Next LL\r
2201 End If\r
2202 For LL = 1 To Attacker(InitFile, InitRank)\r
2203     File = BanMap(InitFile, InitRank).Info(LL).File\r
2204     Rank = BanMap(InitFile, InitRank).Info(LL).Rank\r
2205     If File <> 0 Then\r
2206         If Pieces(Abs(Squares(File, Rank))).Range <> 0 Then ClearInfo\r
2207     End If\r
2208 Next LL\r
2210 End Sub\r
2212 Sub FireDemon ()\r
2213 Evaluate = 0\r
2214 If SeeMove = 1 And Other <> 1 Then\r
2215     If (Influence = 0) Or (Squares(NewFile, NewRank) = 0 Or Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(NewFile, NewRank))) Then\r
2216     For K = NewRank - 1 To NewRank + 1\r
2217     For L = NewFile - 1 To NewFile + 1\r
2218         If L > 0 And L <= BoardSizeX And K > 0 And K <= BoardSizeY Then\r
2219             If ((Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(L, K))) And Squares(L, K) <> 0 And Legal(L, K) <> 1) Then\r
2220                 If (K <> NewRank Or L <> NewFile) And Pieces(Abs(Squares(L, K))).special <> "F" Then\r
2221                     Board.FillColor = &HFFFF&\r
2222                     If Legal(L, K) < 1 Then SeeFile = L: SeeRank = K: LookMove\r
2223                 End If\r
2224             End If\r
2225             If (Influence <> 0) And (Squares(L, K) = 0) Then\r
2226                 SeeFile = L: SeeRank = K: LookMove\r
2227             End If\r
2228         End If\r
2229     Next L\r
2230     Next K\r
2231 End If\r
2232 End If\r
2233 End Sub\r
2235 Sub Flame ()\r
2236 W = 0\r
2237 For K = Rank - 1 To Rank + 1\r
2238     For L = File - 1 To File + 1\r
2239         If L > 0 And L <= BoardSizeX And K > 0 And K <= BoardSizeY Then\r
2240             If (Sgn(Squares(File, Rank)) <> Sgn(Squares(L, K))) And Squares(L, K) <> 0 Then\r
2241                 If Pieces(Abs(Squares(L, K))).Name <> "Fire Demon" Then\r
2242                     If Abs(Squares(L, K)) = 1 Or (Pieces(Abs(Squares(L, K))).Name = "Crown Prince" And King = 1) Then\r
2243                         File = L: Rank = K\r
2244                         CheckMate\r
2245                     End If\r
2246                     If Mate = 1 Then Exit Sub\r
2247                     If W = 0 Then CMove$ = CMove$ + Chr$(13) + Chr$(10) + "    x!" Else CMove$ = CMove$ + ","\r
2248                     If W = 3 Then CMove$ = CMove$ + Chr$(13) + Chr$(10) + "    "\r
2249                     CMove$ = CMove$ + Format$((BoardSizeX - L) + 1) + Chr$(K + 96)\r
2250                     Captures(TurnCount).number = Captures(TurnCount).number + 1\r
2251                     Captures(TurnCount).Positions(Captures(TurnCount).number) = (K * (BoardSizeX + 1)) + L\r
2252                     Captures(TurnCount).PieceNum(Captures(TurnCount).number) = Squares(L, K)\r
2253                     Squares(L, K) = 0\r
2254                     Board.showpic(Grafix(L, K)).Visible = False\r
2255                     Board.showpic(Grafix(L, K)).Move 0, 0\r
2256                     Grafix(L, K) = -1\r
2257                     W = W + 1\r
2258                 End If\r
2259             End If\r
2260         End If\r
2261     Next L\r
2262 Next K\r
2263 End Sub\r
2265 Sub FlashPiece ()\r
2267 If LastPieceX > -1 And LastPieceY > -1 Then\r
2268     If Grafix(LastPieceX, LastPieceY) > -1 Then\r
2269         CCC = 0: XA = 0: Blink = 0: PPP = 2\r
2270         Board.Timer2.Interval = 200\r
2271         Do\r
2272             If Blink / 2 = Int(Blink / 2) And PPP <> 2 Then\r
2273                 Board.showpic(Grafix(LastPieceX, LastPieceY)).Visible = False: PPP = PPP + 1\r
2274                 PPP = 2\r
2275                 Board.Refresh\r
2276             End If\r
2277             If Blink / 2 <> Int(Blink / 2) And PPP <> 1 Then\r
2278                 Board.showpic(Grafix(LastPieceX, LastPieceY)).Visible = True\r
2279                 PPP = 1\r
2280                 Board.Refresh\r
2281             End If\r
2282             DoEvents\r
2283         Loop Until (CCC = 1 Or Blink = 14)\r
2284         CCC = 0: XA = 0: Blink = 0: Board.Timer2.Interval = 0\r
2285         Board.showpic(Grafix(LastPieceX, LastPieceY)).Visible = True\r
2286     End If\r
2287 End If\r
2289 End Sub\r
2291 Sub FormActing ()\r
2292   \r
2293 If Threat = "On" And SeeMove = 1 And GameOver <> 1 Then\r
2294     GetSquare\r
2295     ActingPieces\r
2296 End If\r
2297 End Sub\r
2299 Sub FormDrop ()\r
2301 If MovePiece = 1 Then MoveFormDrop\r
2302 If InitRank = 0 Then HeldDrop\r
2303 If (NewX > XStart And NewX < XStart + (BoardSizeX * Pixels) And NewY > 11 And NewY < 11 + (BoardSizeY * Pixels)) Or CompMove = 1 Then\r
2304     GetSquare2\r
2305     If Legal(File, Rank) > 0 And RightClick <> 1 Then\r
2306         If LionPiece <> I Then\r
2307             Score(TurnCount).IDStart = Squares(InitFile, InitRank)\r
2308             Score(TurnCount).PosStart = (InitRank * (BoardSizeX + 1)) + InitFile\r
2309             CMove$ = CMove$ + Trim$(Pieces(Abs(Squares(InitFile, InitRank))).sname)\r
2310             CMove$ = CMove$ + Format$((BoardSizeX - InitFile) + 1) + Chr$(96 + InitRank)\r
2311             If (Computer = Turn Or Computer = "Both") And LionVictim.Piece <> 0 Then\r
2312                 CMove$ = CMove$ + "x" + Format$((BoardSizeX - LionVictim.File) + 1) + Chr$(96 + LionVictim.Rank)\r
2313             End If\r
2314         End If\r
2315         CMove$ = CMove$ + "-" + Format$((BoardSizeX - File) + 1) + Chr$(Rank + 96)\r
2316         If Legal(File, Rank) = 1 Then LionPiece = -1\r
2317         Board.Frame.Visible = False\r
2318         Squares(File, Rank) = Squares(InitFile, InitRank)\r
2319         If Squares(File, Rank) = 1 Then BlackKingX = File: BlackKingY = Rank\r
2320         If Squares(File, Rank) = -1 Then WhiteKingX = File: WhiteKingY = Rank\r
2321         If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" And Squares(File, Rank) > 0 Then BlackEmpX = File: BlackEmpY = Rank\r
2322         If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" And Squares(File, Rank) < 0 Then WhiteEmpX = File: WhiteEmpY = Rank\r
2323         Score(TurnCount).PosEnd = (Rank * (BoardSizeX + 1)) + File\r
2324         Score(TurnCount).IDEnd = Squares(File, Rank)\r
2325         If LionVictim.Piece <> 0 Then\r
2326             Captures(TurnCount).number = Captures(TurnCount).number + 1\r
2327             Captures(TurnCount).Positions(Captures(TurnCount).number) = (LionVictim.Rank * (BoardSizeX + 1)) + LionVictim.File\r
2328             Captures(TurnCount).PieceNum(Captures(TurnCount).number) = Squares(LionVictim.File, LionVictim.Rank)\r
2329             Taken = 1\r
2330         End If\r
2331         Grafix(File, Rank) = I\r
2332         If InitFile <> File Or InitRank <> Rank Then Grafix(InitFile, InitRank) = -1\r
2333         If InitFile <> File Or InitRank <> Rank Then Squares(InitFile, InitRank) = 0\r
2334         If LionVictim.Piece <> 0 Then\r
2335             Squares(LionVictim.File, LionVictim.Rank) = 0\r
2336             Board.showpic(Grafix(LionVictim.File, LionVictim.Rank)).Visible = False\r
2337             Board.showpic(Grafix(LionVictim.File, LionVictim.Rank)).Move 0, 0\r
2338             Grafix(LionVictim.File, LionVictim.Rank) = -1\r
2339         End If\r
2340         If Legal(File, Rank) = 3 Then\r
2341             Score(TurnCount).IDEnd = 0\r
2342             Grafix(File, Rank) = -1\r
2343             Board.showpic(I).Visible = False\r
2344             Board.showpic(I).Move 0, 0\r
2345             Squares(File, Rank) = 0\r
2346             LionPiece = -1\r
2347         Else\r
2348             If Reverse = 0 Then\r
2349                 Board.showpic(I).Move XStart + ((File - 1) * Pixels), 11 + ((Rank - 1) * Pixels)\r
2350             Else\r
2351                 Board.showpic(I).Move XStart + ((BoardSizeX - File) * Pixels), 11 + ((BoardSizeY - Rank) * Pixels)\r
2352             End If\r
2353         End If\r
2354         If Demon = 1 Then Flame\r
2355         If Mate <> 1 Then\r
2356              If Legal(File, Rank) = 3 Then CMove$ = CMove$ + "*"\r
2357              If Legal(File, Rank) = 6 Then Teach = 3\r
2358              If Legal(File, Rank) = 2 Then Teach = 2 Else Teach = 1\r
2359              If Legal(L, K) = 2 Or Legal(L, K) = 6 Then\r
2360                  DoubleMove\r
2361              Else\r
2362                  LastPieceX = File: LastPieceY = Rank\r
2363                  If CompMove <> 1 Then NextTurn\r
2364              End If\r
2365          End If\r
2366     End If\r
2367 End If\r
2368 ClearLegal\r
2369 If Mate = 1 Then\r
2370     GameOver = 1\r
2371     Response% = MsgBox("        Checkmate!          ", 0, Turn + " Wins!"): NextTurn\r
2372 End If\r
2373 End Sub\r
2375 Sub GetSquare ()\r
2376 If Reverse = 0 Then\r
2377     InitFile = Int((NewX - XStart) / Pixels) + 1\r
2378     InitRank = Int((NewY - 11) / Pixels) + 1\r
2379 Else\r
2380     InitFile = Int((BoardSizeX * Pixels - (NewX - XStart)) / Pixels) + 1\r
2381     InitRank = Int((BoardSizeY * Pixels - (NewY - 11)) / Pixels) + 1\r
2382 End If\r
2383 If InitRank < 1 Or InitRank > BoardSizeY Or InitFile < 1 Or InitFile > BoardSizeX Then\r
2384     InitRank = 0: InitFile = 0\r
2385 End If\r
2386 End Sub\r
2388 Sub GetSquare2 ()\r
2390 If CompMove <> 1 And DropTest <> 1 Then\r
2391     If Reverse = 0 Then\r
2392         File = Int((NewX - XStart) / Pixels) + 1\r
2393         Rank = Int((NewY - 11) / Pixels) + 1\r
2394     Else\r
2395         File = Int((BoardSizeX * Pixels - (NewX - XStart)) / Pixels) + 1\r
2396         Rank = Int((BoardSizeY * Pixels - (NewY - 11)) / Pixels) + 1\r
2397     End If\r
2398 End If\r
2399 End Sub\r
2401 Sub HeldDown ()\r
2403 If Computer <> Turn And Computer <> "Both" And Level <> 0 And GameOver <> 1 Then\r
2404 Notice = 0\r
2405 Board.PieceID.ForeColor = &HFF0000\r
2406 If Selection <> 0 Or MovePiece = 1 Then\r
2407     AddHand2\r
2408 Else\r
2409     If Reduce = 1 Then\r
2410         InHand(I) = InHand(I) - 1\r
2411         If InHand(I) < 2 Then Board.Held(I).Caption = "" Else Board.Held(I).Caption = InHand(I)\r
2412         If InHand(I) < 1 Then Board.HandPic(I).Visible = False\r
2413     Else\r
2414         Board.Caption = Cap\r
2415         Board.PieceID.Caption = Pieces(Abs(CapRef(I))).Name\r
2416         If (I > Capture And Turn = "White" And Reverse = 0) Or (I <= Capture And Turn = "Black" And Reverse = 0) Or (I > Capture And Turn = "Black" And Reverse = 1) Or (I <= Capture And Turn = "White" And Reverse = 1) Then\r
2417             Board.HandPic(I).Drag 1\r
2418             HeldValid\r
2419         Else\r
2420             Board.FillStyle = 1: Other = 1\r
2421             Board.ForeColor = &HC00000\r
2422             HeldValid\r
2423             Board.ForeColor = &H0\r
2424             Board.FillStyle = 0: Other = 0\r
2425         End If\r
2426     End If\r
2427 End If\r
2428 End If\r
2429 End Sub\r
2431 Sub HeldDrop ()\r
2433 If (NewX > XStart And NewX < XStart + (BoardSizeX * Pixels) And NewY > 11 And NewY < 11 + (BoardSizeY * Pixels)) Or DropTest = 1 Then\r
2434     GetSquare2\r
2435     If Legal(File, Rank) = 1 Then\r
2436         Squares(File, Rank) = CapRef(I)\r
2437         NewGraf = 0\r
2438         Do While Board.showpic(NewGraf).Visible = True\r
2439             NewGraf = NewGraf + 1\r
2440         Loop\r
2441         Score(TurnCount).IDStart = Squares(File, Rank)\r
2442         Score(TurnCount).IDEnd = Squares(File, Rank)\r
2443         Score(TurnCount).PosStart = 0\r
2444         Score(TurnCount).PosEnd = (Rank * (BoardSizeX + 1)) + File\r
2445         CMove$ = Trim$(Pieces(Abs(Squares(File, Rank))).sname)\r
2446         CMove$ = CMove$ + "*" + Format$((BoardSizeX - File) + 1) + Chr$(Rank + 96)\r
2447         Grafix(File, Rank) = NewGraf\r
2448         Board.showpic(NewGraf) = Board.HandPic(I)\r
2449         If Reverse = 0 Then\r
2450             Board.showpic(NewGraf).Move XStart + (File - 1) * Pixels, 11 + (Rank - 1) * Pixels\r
2451         Else\r
2452             Board.showpic(NewGraf).Move XStart + (BoardSizeX - File) * Pixels, 11 + (BoardSizeY - Rank) * Pixels\r
2453         End If\r
2454         Board.showpic(NewGraf).Visible = True\r
2455         InHand(I) = InHand(I) - 1\r
2456         If InHand(I) < 1 Then Board.HandPic(I).Visible = False\r
2457         If InHand(I) < 2 Then Board.Held(I).Caption = "" Else Board.Held(I).Caption = InHand(I)\r
2458         If Choice = "Micro" Then MicroDrop\r
2459         InitRank = 0: InitFile = 0\r
2460         Dropped = 1\r
2461         LastPieceX = File: LastPieceY = Rank\r
2462         If CompMove <> 1 Then NextTurn\r
2463     End If\r
2464 End If\r
2465 ClearLegal\r
2466 End Sub\r
2468 Sub HeldProm ()\r
2470 If Computer <> Turn And Computer <> "Both" And Level <> 0 And GameOver <> 1 Then\r
2471     Board.PieceID.Caption = ""\r
2472     Board.PieceID.ForeColor = &H8000&\r
2473     If Pieces(Abs(CapRef(I))).Promotes > 0 And Pieces(Abs(CapRef(I))).Name <> "Killer Whale" Then PromName = Pieces(Abs(Pieces(Abs(CapRef(I))).Promotes)).Name Else PromName = "None"\r
2474     Board.PieceID.Caption = "Promotes to " + PromName\r
2475 End If\r
2476 End Sub\r
2478 Sub HeldShow ()\r
2479 If SeeMove = 1 Or CompMove = 1 Then\r
2480     Board.FillColor = &HFFFFFF\r
2481     For K = 1 To BoardSizeY\r
2482         For L = 1 To BoardSizeX\r
2483             If Legal(L, K) = 1 Then SeeFile = L: SeeRank = K: LookMove\r
2484         Next L\r
2485     Next K\r
2486 End If\r
2487 If Evaluate <> 1 And DropTest <> 1 Then InitRank = 0\r
2488 End Sub\r
2490 Sub HeldValid ()\r
2491 For K = 1 To BoardSizeY\r
2492     For L = 1 To BoardSizeX\r
2493         If Squares(L, K) = 0 Then Legal(L, K) = 1\r
2494         If Pieces(Abs(CapRef(I))).special = "1" Then\r
2495             If CapRef(I) > 0 And K = 1 Then Legal(L, K) = 0\r
2496             If CapRef(I) < 0 And K = BoardSizeY Then Legal(L, K) = 0\r
2497         End If\r
2498         If Pieces(Abs(CapRef(I))).special = "2" Then\r
2499             If CapRef(I) > 0 And K < 3 Then Legal(L, K) = 0\r
2500             If CapRef(I) < 0 And K > BoardSizeY - 2 Then Legal(L, K) = 0\r
2501         End If\r
2502     Next L\r
2503 Next K\r
2504 If (Choice <> "Micro") And (Pieces(Abs(CapRef(I))).Name = "Pawn" Or Pieces(Abs(CapRef(I))).Name = "Sparrow Pawn") Then\r
2505     For N = 1 To BoardSizeY\r
2506         For P = 1 To BoardSizeX\r
2507             If Squares(P, N) <> 0 Then\r
2508                 If (Pieces(Abs(Squares(P, N))).Name = "Pawn" Or Pieces(Abs(Squares(P, N))).Name = "Sparrow Pawn") And Sgn(Squares(P, N)) = Sgn(CapRef(I)) Then\r
2509                     For X = 1 To BoardSizeY\r
2510                         Legal(P, X) = 0\r
2511                     Next X\r
2512                 End If\r
2513             End If\r
2514         Next P\r
2515     Next N\r
2516 End If\r
2517 If Choice = "Tori" And Pieces(Abs(CapRef(I))).Name = "Swallow" Then\r
2518     For N = 1 To BoardSizeX\r
2519         C = 0\r
2520         For P = 1 To BoardSizeY\r
2521             If Squares(N, P) <> 0 Then\r
2522                 If Pieces(Abs(Squares(N, P))).Name = "Swallow" And Sgn(Squares(N, P)) = Sgn(CapRef(I)) Then\r
2523                     C = C + 1\r
2524                     If C = 2 Then\r
2525                         For X = 1 To BoardSizeY\r
2526                             Legal(N, X) = 0\r
2527                         Next X\r
2528                     End If\r
2529                 End If\r
2530             End If\r
2531         Next P\r
2532     Next N\r
2533 End If\r
2534 If Choice = "Whale" And Pieces(Abs(CapRef(I))).Name = "Dolphin" Then\r
2535     For N = 1 To BoardSizeX\r
2536         C = 0\r
2537         For P = 1 To BoardSizeY\r
2538             If Squares(N, P) <> 0 Then\r
2539                 If Pieces(Abs(Squares(N, P))).Name = "Dolphin" And Sgn(Squares(N, P)) = Sgn(CapRef(I)) Then\r
2540                     C = C + 1\r
2541                     If C = 2 Then\r
2542                         For X = 1 To BoardSizeY\r
2543                             Legal(N, X) = 0\r
2544                         Next X\r
2545                     End If\r
2546                 End If\r
2547             End If\r
2548         Next P\r
2549     Next N\r
2550 End If\r
2551 If CompMove <> 1 Then AskMate\r
2552 If Dropping <> 1 Then HeldShow\r
2553 End Sub\r
2555 Sub HookMove ()\r
2556 OldLast = Last: OldFile = NewFile: OldRank = NewRank\r
2557 While NewFile - RankInc > 0 And NewFile - RankInc <= BoardSizeX And NewRank + FileInc > 0 And NewRank + FileInc <= BoardSizeY And Last = 0\r
2558     NewFile = NewFile - RankInc\r
2559     NewRank = NewRank + FileInc\r
2560     ShowMove\r
2561 Wend\r
2562 NewFile = OldFile: NewRank = OldRank: Last = 0\r
2563 While NewFile + RankInc > 0 And NewFile + RankInc <= BoardSizeX And NewRank - FileInc > 0 And NewRank - FileInc <= BoardSizeY And Last = 0\r
2564     NewFile = NewFile + RankInc\r
2565     NewRank = NewRank - FileInc\r
2566     ShowMove\r
2567 Wend\r
2568 NewFile = OldFile: NewRank = OldRank: Last = OldLast\r
2569 End Sub\r
2571 Sub Igui ()\r
2572 For K = InitRank - 1 To InitRank + 1\r
2573     For L = InitFile - 1 To InitFile + 1\r
2574         If K > 0 And K <= BoardSizeY And L > 0 And L <= BoardSizeX Then\r
2575             If Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(L, K)) Or (Squares(L, K) = 0 And Influence > 0) Then\r
2576                 Board.FillColor = &H8000&\r
2577                 If SeeMove = 1 Then SeeFile = L: SeeRank = K: LookMove\r
2578                 Legal(L, K) = 4\r
2579             End If\r
2580         End If\r
2581     Next L\r
2582 Next K\r
2583 End Sub\r
2585 Sub Jumping ()\r
2586 NewFile = InitFile + (FileInc * 2): NewRank = InitRank + (RankInc * 2)\r
2587 If NewFile > 0 And NewFile <= BoardSizeX And NewRank > 0 And NewRank <= BoardSizeY Then ShowMove\r
2588 End Sub\r
2590 Sub KingSafety ()\r
2591     \r
2592 ' King Safety \ Attacks\r
2594 If Choice <> "Micro" And Choice <> "Mini" And Choice <> "Judkin" And Choice <> "Yari" And Choice <> "Tori" And Choice <> "Whale" Then\r
2595     If CompLegal(AA).EndPiece = 1 Then\r
2596         If Abs(InitFile - ((BoardSizeX / 2) + .5)) < Abs(CompFile - ((BoardSizeX / 2) + .5)) Then KingTally(AA) = KingTally(AA) + 3\r
2597         KingTally(AA) = KingTally(AA) - (BoardSizeY - CompRank)\r
2598     End If\r
2599     If CompLegal(AA).EndPiece = -1 Then\r
2600         If Abs(((BoardSizeX / 2) + .5) - InitFile) < Abs(((BoardSizeX / 2) + .5) - CompFile) Then KingTally(AA) = KingTally(AA) + 3\r
2601         KingTally(AA) = KingTally(AA) - (CompRank - 1)\r
2602     End If\r
2603     If Turn = "Black" And Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Gold" And Abs(CompFile - BlackKingX) > 1 And Abs(CompRank - BlackKingY) > 1 And (Abs(CompFile - BlackKingX) > Abs(InitFile - BlackKingX) Or Abs(CompRank - BlackKingY) > Abs(InitRank - BlackKingY)) Then KingTally(AA) = KingTally(AA) - 2\r
2604     If Turn = "White" And Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Gold" And Abs(CompFile - WhiteKingX) > 1 And Abs(CompRank - WhiteKingY) > 1 And (Abs(CompFile - WhiteKingX) > Abs(InitFile - WhiteKingX) Or Abs(CompRank - WhiteKingY) > Abs(InitRank - WhiteKingY)) Then KingTally(AA) = KingTally(AA) - 2\r
2605 End If\r
2606 If Turn = "Black" And CompRank <= PromDotY Then KingTally(AA) = KingTally(AA) + 3\r
2607 If Turn = "White" And CompRank > BoardSizeY - PromDotY Then KingTally(AA) = KingTally(AA) + 3\r
2608 If BoardSizeY > 11 Then\r
2609     If Turn = "Black" And Pieces(Abs(CompLegal(AA).EndPiece)).Range <> 1 And InitRank > CompRank Then KingTally(AA) = KingTally(AA) + 3\r
2610     If Turn = "White" And Pieces(Abs(CompLegal(AA).EndPiece)).Range <> 1 And InitRank < CompRank Then KingTally(AA) = KingTally(AA) + 3\r
2611     If Turn = "Black" And Pieces(Abs(CompLegal(AA).EndPiece)).Range = 1 And InitRank < CompRank Then KingTally(AA) = KingTally(AA) + 2\r
2612     If Turn = "White" And Pieces(Abs(CompLegal(AA).EndPiece)).Range = 1 And InitRank > CompRank Then KingTally(AA) = KingTally(AA) + 2\r
2613 End If\r
2614 If Turn = "Black" And InitRank < BoardSizeY * .35 Then\r
2615     If Abs(InitFile - WhiteKingX) > Abs(CompFile - WhiteKingX) Or Abs(InitRank - WhiteKingY) > Abs(CompRank - WhiteKingY) Then KingTally(AA) = KingTally(AA) + 5\r
2616 End If\r
2617 If Turn = "White" And InitRank > BoardSizeY * .65 Then\r
2618     If Abs(InitFile - BlackKingX) > Abs(CompFile - BlackKingX) Or Abs(InitRank - BlackKingY) > Abs(CompRank - BlackKingY) Then KingTally(AA) = KingTally(AA) + 5\r
2619 End If\r
2621 End Sub\r
2623 Sub KnightJump ()\r
2624 If Abs(RankInc) = 1 Then\r
2625     NewFile = InitFile + 1: NewRank = InitRank + (RankInc * 2)\r
2626     If NewFile <= BoardSizeX And NewRank > 0 And NewRank <= BoardSizeY Then ShowMove\r
2627     NewFile = InitFile - 1\r
2628     If NewFile > 0 And NewRank > 0 And NewRank <= BoardSizeY Then ShowMove\r
2629 End If\r
2630 If Abs(FileInc) = 1 Then\r
2631     NewRank = InitRank + 1: NewFile = InitFile + (FileInc * 2)\r
2632     If NewRank <= BoardSizeY And NewFile > 0 And NewFile <= BoardSizeX Then ShowMove\r
2633     NewRank = InitRank - 1\r
2634     If NewRank > 0 And NewFile > 0 And NewFile <= BoardSizeX Then ShowMove\r
2635 End If\r
2636 End Sub\r
2638 Sub Lion ()\r
2639 If Teach = 1 Then\r
2640     Lion2\r
2641 Else\r
2642     For Y = InitRank - 2 To InitRank + 2\r
2643         For X = InitFile - 2 To InitFile + 2\r
2644             If X > 0 And X <= BoardSizeX And Y > 0 And Y <= BoardSizeY Then\r
2645                 If Squares(X, Y) = 0 Or Sgn(Squares(X, Y)) <> Sgn(Squares(InitFile, InitRank)) Or (Influence > 0 And (Y <> InitRank Or X <> InitFile)) Then\r
2646                     If Abs(Y - InitRank) <= 1 And Abs(X - InitFile) <= 1 Then\r
2647                         Board.FillColor = &HFF0000\r
2648                         NewRank = Y: NewFile = X\r
2649                         If Choice = "Tenjiku" Then CheckBurn\r
2650                         If LegalMoves > 0 And Squares(X, Y) <> 0 And Pieces(Abs(Squares(InitFile, InitRank))).Name <> "Teaching King" Then\r
2651                             If Evaluate = 0 And CompMove = 1 And Influence <> 1 Then CompLion\r
2652                             Legal(X, Y) = 1\r
2653                         Else\r
2654                             Legal(X, Y) = 2\r
2655                         End If\r
2656                     Else\r
2657                         Legal(X, Y) = 1\r
2658                         NewRank = Y: NewFile = X\r
2659                         If Choice = "Chu" And Squares(X, Y) <> 0 And ChuLionTest <> 1 Then\r
2660                             If Pieces(Abs(Squares(X, Y))).Name = "Lion" Then ChuLion\r
2661                         End If\r
2662                         Board.FillColor = &HFFFF00\r
2663                         If Choice = "Tenjiku" Then CheckBurn\r
2664                     End If\r
2665                     If SeeMove = 1 And ProtectLion <> 1 And CompLionTest <> 1 And Legal(X, Y) > 0 Then SeeFile = X: SeeRank = Y: LookMove\r
2666                     ProtectLion = 0: CompLionTest = 0\r
2667                 End If\r
2668             End If\r
2669         Next X\r
2670     Next Y\r
2671 End If\r
2672 End Sub\r
2674 Sub Lion2 ()\r
2675 For Y = InitRank - 1 To InitRank + 1\r
2676     For X = InitFile - 1 To InitFile + 1\r
2677         If X > 0 And X <= BoardSizeX And Y > 0 And Y <= BoardSizeY Then\r
2678             If Squares(X, Y) = 0 Or Sgn(Squares(X, Y)) <> Sgn(Squares(InitFile, InitRank)) Or Influence = 2 Then\r
2679                 Legal(X, Y) = 1\r
2680                 Board.FillColor = &HFFFF00\r
2681                 If SeeMove = 1 Then SeeFile = X: SeeRank = Y: LookMove\r
2682                 NewFile = X: NewRank = Y\r
2683                 If Choice = "Tenjiku" Then CheckBurn\r
2684             End If\r
2685         End If\r
2686     Next X\r
2687 Next Y\r
2688 End Sub\r
2690 Sub LionBurn ()\r
2692 For K = Rank - 1 To Rank + 1\r
2693     For L = File - 1 To File + 1\r
2694         If LionTest <> 1 And L > 0 And L <= BoardSizeX And K > 0 And K <= BoardSizeY Then\r
2695             If (K <> Rank Or L <> File) And Squares(L, K) <> 0 Then\r
2696                 If Pieces(Abs(Squares(L, K))).special = "F" And Sgn(Squares(File, Rank)) <> Sgn(Squares(L, K)) Then LionBurn2\r
2697             End If\r
2698         End If\r
2699     Next L\r
2700 Next K\r
2701 LionTest = 0\r
2702 End Sub\r
2704 Sub LionBurn2 ()\r
2706 Score(TurnCount).IDEnd = 0\r
2707 CMove$ = CMove$ + "*"\r
2708 Grafix(File, Rank) = -1\r
2709 Board.showpic(I).Visible = False\r
2710 Board.showpic(I).Move 0, 0\r
2711 Squares(File, Rank) = 0\r
2712 LionTest = 1\r
2713 End Sub\r
2715 Sub LionIgui ()\r
2716         \r
2717 If BoardSizeY > 11 Then\r
2718     MMM = 0\r
2719     For K = 1 To BoardSizeY\r
2720         For L = 1 To BoardSizeX\r
2721             If Grafix(L, K) = I Then File = L: Rank = K: MMM = 1: Exit For\r
2722         Next L\r
2723         If MMM = 1 Then Exit For\r
2724     Next K\r
2725     If MMM = 1 And ((Turn = "Black" And Squares(File, Rank) > 0) Or (Turn = "White" And Squares(File, Rank) < 0)) Then\r
2726         If Pieces(Abs(Squares(File, Rank))).special = "L" Or Pieces(Abs(Squares(File, Rank))).Name = "Horned Falcon" Or Pieces(Abs(Squares(File, Rank))).Name = "Soaring Eagle" Or (Pieces(Abs(Squares(File, Rank))).Name = "Teaching King" And TeachVer = 2) Then\r
2727             InitFile = File: InitRank = Rank\r
2728             Score(TurnCount).IDStart = Squares(File, Rank)\r
2729             Score(TurnCount).IDEnd = Squares(File, Rank)\r
2730             Score(TurnCount).PosStart = (InitRank * (BoardSizeX + 1)) + InitFile\r
2731             Score(TurnCount).PosEnd = (InitRank * (BoardSizeX + 1)) + InitFile\r
2732             CMove$ = CMove$ + Trim$(Pieces(Abs(Squares(InitFile, InitRank))).sname) + "!"\r
2733             LastPieceX = File: LastPieceY = Rank\r
2734             Ligui = 1\r
2735             ShortScore(TurnCount + 1) = CMove$\r
2736             NextTurn\r
2737         End If\r
2738     End If\r
2739 End If\r
2740 End Sub\r
2742 Sub LionPower ()\r
2743 For K = 1 To 2\r
2744     C = InitFile: D = InitRank\r
2745     NewFile = InitFile + (FileInc * K): NewRank = InitRank + (RankInc * K)\r
2746     If NewFile > 0 And NewFile <= BoardSizeX And NewRank > 0 And NewRank <= BoardSizeY Then\r
2747         If Squares(NewFile, NewRank) = 0 Or Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(NewFile, NewRank)) Or (Influence > 0 And (NewFile <> InitFile Or NewRank <> InitRank)) Then\r
2748             If K = 1 Then\r
2749                 Board.FillColor = &HFF0000\r
2750                 If Choice = "Tenjiku" Then CheckBurn\r
2751                 If LegalMoves > 0 And Squares(NewFile, NewRank) <> 0 Then\r
2752                     If CompMove = 1 And Evaluate = 0 And Influence <> 1 Then CompLionPower\r
2753                     Legal(NewFile, NewRank) = 1\r
2754                 Else\r
2755                     Legal(NewFile, NewRank) = 2\r
2756                 End If\r
2757             Else\r
2758                 Board.FillColor = &HFFFF00\r
2759                 Legal(NewFile, NewRank) = 1\r
2760                 If Choice = "Tenjiku" Then CheckBurn\r
2761             End If\r
2762             If SeeMove = 1 And CompLionTest <> 1 And Legal(NewFile, NewRank) <> 0 Then SeeFile = NewFile: SeeRank = NewRank: LookMove\r
2763             CompLionTest = 0\r
2764         End If\r
2765     End If\r
2766 Next K\r
2767 End Sub\r
2769 Sub LionPower2 ()\r
2770 Legal(C, D) = 1\r
2771 Board.FillColor = &HFFFF00\r
2772 SeeFile = C: SeeRank = D: LookMove\r
2773 X = InitFile + (InitFile - C)\r
2774 Y = InitRank + (InitRank - D)\r
2775 If X > 0 And X <= BoardSizeX And Y > 0 And Y <= BoardSizeY Then\r
2776     If Squares(X, Y) = 0 Or Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(X, Y)) Or (Influence = 2 And (NewFile <> InitFile Or NewRank <> InitRank)) Then\r
2777         Legal(X, Y) = 1\r
2778         If SeeMove = 1 Then SeeFile = X: SeeRank = Y: LookMove\r
2779         NewFile = X: NewRank = Y\r
2780         If Choice = "Tenjiku" Then CheckBurn\r
2781     End If\r
2782 End If\r
2783 End Sub\r
2785 Sub LoadGame ()\r
2786 On Error Resume Next\r
2787 Board.CMSave.DialogTitle = "Load Game"\r
2788 Board.CMSave.Flags = &H1000&\r
2789 Board.CMSave.Action = 1\r
2790 If Err = 32755 Then Exit Sub\r
2791 Loaded$ = Board.CMSave.Filename\r
2792 Loading = 1\r
2793 OldChoice = Choice\r
2794 Open Loaded$ For Input As #2\r
2795 Input #2, Choice\r
2796 If Choice = "Tai" And Display < 800 Then\r
2797     TooSmall\r
2798     Choice = OldChoice\r
2799     Loading = 0\r
2800     Close #2\r
2801 Else\r
2802     Unload PieceHelp\r
2803     Unload RulesHelp\r
2804     Board.MousePointer = 11\r
2805     If Choice = OldChoice Then Unload Board\r
2806     StartUp\r
2807     Input #2, SaveTitle$\r
2808     If SaveTitle$ <> "" Then\r
2809         Cap = SaveTitle$\r
2810         Board.Caption = Cap\r
2811     End If\r
2812     Input #2, Computer\r
2813     Input #2, Level\r
2814     Input #2, GameOver\r
2815     Input #2, Threat\r
2816     Close #2\r
2817     EndTurn = TurnCount\r
2818     ConfigLoad\r
2819     Loading = 0\r
2820     Board.MnuHandicap.Enabled = False\r
2821     If GameOver <> 1 Then ConvertScore\r
2822     If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
2823         Board.LastMove.Caption = Score(TurnCount).Caption\r
2824     Else\r
2825         Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
2826     End If\r
2827     If TurnCount > 0 Then\r
2828         Location = Score(TurnCount - 1).PosEnd\r
2829         If Location > 0 Then\r
2830             Rank = Int(Location / (BoardSizeX + 1))\r
2831             File = Location - (Rank * (BoardSizeX + 1))\r
2832         End If\r
2833         LastPieceX = File: LastPieceY = Rank\r
2834     Else\r
2835         LastPieceX = -1: LastPieceY = -1\r
2836     End If\r
2837 End If\r
2838 End Sub\r
2840 Sub LoadGame2 ()\r
2841 On Error Resume Next\r
2842 Start.CMSave.DialogTitle = "Load Game"\r
2843 Start.CMSave.Flags = &H1000&\r
2844 Start.CMSave.Action = 1\r
2845 If Err = 32755 Then Exit Sub\r
2846 Loaded$ = Start.CMSave.Filename\r
2847 Start.MousePointer = 11\r
2848 Loading = 1\r
2849 OldChoice = Choice\r
2850 Open Loaded$ For Input As #2\r
2851 Input #2, Choice\r
2852 If Choice = "Tai" And Display < 800 Then\r
2853     TooSmall\r
2854     Choice = OldChoice\r
2855     Loading = 0\r
2856     Close #2\r
2857 Else\r
2858 Unload PieceHelp\r
2859 Unload RulesHelp\r
2860 Unload Board\r
2861 StartUp\r
2862 Input #2, SaveTitle$\r
2863 If SaveTitle$ <> "" Then Board.Caption = SaveTitle$\r
2864 Input #2, Computer\r
2865 Input #2, Level\r
2866 Input #2, GameOver\r
2867 Input #2, Threat\r
2868 Close #2\r
2869 Start.Hide\r
2870 Start.MousePointer = 0\r
2871 ConfigLoad\r
2872 Loading = 0\r
2873 EndTurn = TurnCount\r
2874 Board.MnuHandicap.Enabled = False\r
2875 If GameOver <> 1 Then ConvertScore\r
2876 If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
2877     Board.LastMove.Caption = Score(TurnCount).Caption\r
2878 Else\r
2879     Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
2880 End If\r
2881 If TurnCount > 0 Then\r
2882     Location = Score(TurnCount - 1).PosEnd\r
2883     If Location > 0 Then\r
2884         Rank = Int(Location / (BoardSizeX + 1))\r
2885         File = Location - (Rank * (BoardSizeX + 1))\r
2886     End If\r
2887     LastPieceX = File: LastPieceY = Rank\r
2888 Else\r
2889     LastPieceX = -1: LastPieceY = -1\r
2890 End If\r
2891 End If\r
2892 End Sub\r
2894 Sub LookAhead ()\r
2896 If Turn = "White" Then Turn = "Black" Else Turn = "White"\r
2897 RealLevel = Level: Level = 0\r
2898 For YYY = 1 To BoardSizeY\r
2899     For XXX = 1 To BoardSizeX\r
2900         TestBoard(XXX, YYY) = Comp(XXX, YYY)\r
2901     Next XXX\r
2902 Next YYY\r
2903 If Drop = 1 Then\r
2904     For DDD = 1 To Capture * 2\r
2905         OldHand(DDD) = InHand(DDD)\r
2906     Next DDD\r
2907 End If\r
2908 For Depth = 1 To TestDepth\r
2909     If MoveList(Depth).StartFile <> 0 Then Comp(MoveList(Depth).StartFile, MoveList(Depth).StartRank) = 0\r
2910     Comp(MoveList(Depth).EndFile, MoveList(Depth).EndRank) = MoveList(Depth).EndPiece\r
2911     If MoveList(Depth).StartFile = 0 Then\r
2912         For DDD = 1 To Capture * 2\r
2913             If MoveList(Depth).EndPiece = CapRef(DDD) Then InHand(DDD) = InHand(DDD) - 1\r
2914         Next DDD\r
2915     End If\r
2916     TestAhead\r
2917     FinalTally(Depth) = BestTally(0) - OldKingTally(Depth)\r
2918     For YYY = 1 To BoardSizeY\r
2919         For XXX = 1 To BoardSizeX\r
2920             Comp(XXX, YYY) = TestBoard(XXX, YYY)\r
2921         Next XXX\r
2922     Next YYY\r
2923     If Drop = 1 Then\r
2924         For DDD = 1 To Capture * 2\r
2925             InHand(DDD) = OldHand(DDD)\r
2926         Next DDD\r
2927     End If\r
2928 Next Depth\r
2929 Level = RealLevel: BestMove = TestDepth: BestScore = FinalTally(TestDepth)\r
2930 If Turn = "White" Then Turn = "Black" Else Turn = "White"\r
2931 For ZZZZ = 1 To TestDepth - 1\r
2932     If FinalTally(ZZZZ) < BestScore Then\r
2933         BestMove = ZZZZ\r
2934         BestScore = FinalTally(ZZZZ)\r
2935     End If\r
2936 Next ZZZZ\r
2937 CompLegal(BestMove).StartFile = MoveList(BestMove).StartFile\r
2938 CompLegal(BestMove).StartRank = MoveList(BestMove).StartRank\r
2939 CompLegal(BestMove).StartPiece = MoveList(BestMove).StartPiece\r
2940 CompLegal(BestMove).EndFile = MoveList(BestMove).EndFile\r
2941 CompLegal(BestMove).EndRank = MoveList(BestMove).EndRank\r
2942 CompLegal(BestMove).EndPiece = MoveList(BestMove).EndPiece\r
2943 If Choice = "Dai" Or Choice = "Chu" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai" Then\r
2944     LionVictim.Piece = ECapture(BestMove).Piece\r
2945     LionVictim.File = ECapture(BestMove).File\r
2946     LionVictim.Rank = ECapture(BestMove).Rank\r
2947 End If\r
2949 End Sub\r
2951 Sub LookCheck ()\r
2953 If Turn = "White" And BlackKing = 0 Then\r
2954     OriginalPiece = Squares(BlackKingX, BlackKingY)\r
2955     OriginalFile = BlackKingX: OriginalRank = BlackKingY\r
2956 Else\r
2957     If Turn = "Black" And WhiteKing = 0 Then\r
2958         OriginalPiece = Squares(WhiteKingX, WhiteKingY)\r
2959         OriginalFile = WhiteKingX: OriginalRank = WhiteKingY\r
2960     End If\r
2961 End If\r
2962 Influence = 0\r
2963 CheckTest = 1\r
2964 CheckLooked = 0\r
2965 LookCheck2\r
2966 CheckTest = 0\r
2967 If GameOver = 1 Or Checked > 0 Then Exit Sub\r
2968 For GHH = 1 To BoardSizeY\r
2969     For EFF = 1 To BoardSizeX\r
2970         If Squares(EFF, GHH) <> 0 Then\r
2971             If Abs(Squares(EFF, GHH)) = 1 Or Pieces(Abs(Squares(EFF, GHH))).Name = "Emperor" Or Pieces(Abs(Squares(EFF, GHH))).Name = "Crown Prince" Or Pieces(Abs(Squares(EFF, GHH))).Name = "Prince" Then\r
2972                 OriginalPiece = Squares(EFF, GHH)\r
2973                 OriginalFile = EFF: OriginalRank = GHH\r
2974                 Influence = 0\r
2975                 CheckTest = 1\r
2976                 CheckLooked = 0\r
2977                 LookCheck2\r
2978                 CheckTest = 0\r
2979                 If GameOver = 1 Or Checked > 0 Then Exit Sub\r
2980             End If\r
2981         End If\r
2982     Next EFF\r
2983 Next GHH\r
2984 CheckTest = 0\r
2985 End Sub\r
2987 Sub LookCheck2 ()\r
2989 For ABB = 1 To BoardSizeY\r
2990     For CDD = 1 To BoardSizeX\r
2991         If Squares(CDD, ABB) <> 0 Then\r
2992             If Sgn(OriginalPiece) <> Sgn(Squares(CDD, ABB)) And Pieces(Abs(Squares(CDD, ABB))).Name <> "Emperor" Then\r
2993                 InitFile = CDD: InitRank = ABB\r
2994                 Validate\r
2995                 If GameOver = 1 Or Checked > 0 Then Influence = 0: Exit Sub\r
2996             End If\r
2997         End If\r
2998     Next CDD\r
2999 Next ABB\r
3000 Influence = 0\r
3002 End Sub\r
3004 Sub LookComp ()\r
3006 Attacker(SeeFile, SeeRank) = Attacker(SeeFile, SeeRank) + 1\r
3007 BanMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).File = InitFile\r
3008 BanMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).Rank = InitRank\r
3009 BanMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).Piece = Squares(InitFile, InitRank)\r
3010 If Squares(InitFile, InitRank) < 0 Then\r
3011     BanMap(SeeFile, SeeRank).WhiteNum = BanMap(SeeFile, SeeRank).WhiteNum + 1\r
3012 Else\r
3013     BanMap(SeeFile, SeeRank).BlackNum = BanMap(SeeFile, SeeRank).BlackNum + 1\r
3014 End If\r
3015 DoEvents\r
3016 If FirstTime = 1 Then LookComp2\r
3017 End Sub\r
3019 Sub LookComp2 ()\r
3021 OldAttack(SeeFile, SeeRank) = Attacker(SeeFile, SeeRank)\r
3022 BackMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).File = InitFile\r
3023 BackMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).Rank = InitRank\r
3024 BackMap(SeeFile, SeeRank).Info(Attacker(SeeFile, SeeRank)).Piece = Squares(InitFile, InitRank)\r
3025 If Squares(InitFile, InitRank) < 0 Then\r
3026     BackMap(SeeFile, SeeRank).WhiteNum = BanMap(SeeFile, SeeRank).WhiteNum\r
3027 Else\r
3028     BackMap(SeeFile, SeeRank).BlackNum = BanMap(SeeFile, SeeRank).BlackNum\r
3029 End If\r
3030 End Sub\r
3032 Sub LookForMate ()\r
3033 LookMate = 1\r
3034 OldComputer = Computer\r
3035 Computer = Turn2: OldTurn = Turn: Turn = Turn2\r
3036 RealLevel = Level: Level = 0\r
3037 CompMain\r
3038 Level = RealLevel\r
3039 LookMate = 0: LegalMoves = 0: Turn = OldTurn\r
3040 Computer = OldComputer\r
3041 End Sub\r
3043 Sub LookMove ()\r
3045 If ChuLionTest = 1 Then\r
3046     If SeeFile = OldNewFile And SeeRank = OldNewRank Then ProtectLion = 1: Exit Sub\r
3047 Else\r
3048 If Evaluate = 1 Then\r
3049     LookComp\r
3050 Else\r
3051 If CompMove = 1 And Influence <> 2 And Evaluate = 0 Then\r
3052      AddLegalMove\r
3053 Else\r
3054 If (Influence < 1 And CheckTest <> 1) Then\r
3055     If Reverse = 0 Then\r
3056         Board.Circle (XStart + ((SeeFile - 1) * Pixels) + (Pixels / 2), 11 + ((SeeRank - 1) * Pixels) + (Pixels / 2)), Pixels / 4\r
3057     Else\r
3058         Board.Circle (XStart + ((BoardSizeX - SeeFile) * Pixels) + (Pixels / 2), 11 + ((BoardSizeY - SeeRank) * Pixels) + (Pixels / 2)), Pixels / 4\r
3059     End If\r
3060 Else\r
3061     If Influence = 2 Then\r
3062         If Legal(SeeFile, SeeRank) > 0 Then\r
3063             If Squares(InitFile, InitRank) < 0 Then\r
3064                 If (Camps(SeeFile, SeeRank) <> 2 And Camps(SeeFile, SeeRank) <> 3) Then Camps(SeeFile, SeeRank) = 1 Else Camps(SeeFile, SeeRank) = 3\r
3065             Else\r
3066                 If (Camps(SeeFile, SeeRank) <> 1 And Camps(SeeFile, SeeRank) <> 3) Then Camps(SeeFile, SeeRank) = 2 Else Camps(SeeFile, SeeRank) = 3\r
3067             End If\r
3068         End If\r
3069     Else\r
3070         If OriginalFile = SeeFile And OriginalRank = SeeRank Then\r
3071             If CheckTest = 1 And CheckLooked = 0 Then\r
3072                 Response% = 0\r
3073                 If OriginalPiece > 0 And Turn = "White" And Computer <> "Black" And Computer <> "Both" And ((BlackKing = 0 And BlackPrince > 0) Or (Choice = "Tenjiku" Or Choice = "Maka" Or Choice = "Tai")) Then Response% = MsgBox("You have left your " + Pieces(Abs(OriginalPiece)).Name + " in Check! ", 0, "Black"): Response% = 6\r
3074                 If OriginalPiece < 0 And Turn = "Black" And Computer <> "White" And Computer <> "Both" And ((WhiteKing = 0 And WhitePrince > 0) Or (Choice = "Tenjiku" Or Choice = "Maka" Or Choice = "Tai")) Then Response% = MsgBox("You have left your " + Pieces(Abs(OriginalPiece)).Name + " in Check! ", 0, "White"): Response% = 6\r
3075                 If Choice <> "Tenjiku" And Choice <> "Maka" And Choice <> "Tai" Then\r
3076                     If OriginalPiece > 0 And Turn = "White" And Computer <> "Black" And Computer <> "Both" And (BlackKing = 1 Or BlackPrince = 0) Then Response% = MsgBox("You can't leave your " + Pieces(Abs(OriginalPiece)).Name + " in Check! ", 0, "Black"): Response% = 7\r
3077                     If OriginalPiece < 0 And Turn = "Black" And Computer <> "White" And Computer <> "Both" And (WhiteKing = 1 Or WhitePrince = 0) Then Response% = MsgBox("You can't leave your " + Pieces(Abs(OriginalPiece)).Name + " in Check! ", 0, "White"): Response% = 7\r
3078                 End If\r
3079                 Legal(SeeFile, SeeRank) = 0\r
3080                 CheckLooked = 1\r
3081                 If Response% <> 7 Then\r
3082                     If (OriginalPiece > 0 And (BlackKing = 1 Or BlackPrince = 0)) Or (OriginalPiece < 0 And (WhiteKing = 1 Or WhitePrince = 0)) And Choice <> "Tenjiku" And Choice <> "Maka" And Choice <> "Tai" Then\r
3083                         If OriginalPiece < 0 Then Turn2 = "White" Else Turn2 = "Black"\r
3084                         LookForMate\r
3085                     End If\r
3086                     SeeMove = OldSeeMove\r
3087                     If Choice = "Tenjiku" Or Choice = "Maka" Or Choice = "Tai" Then BestTally(0) = 0: Turn2 = Turn\r
3088                     If BestTally(0) = -999999 Then\r
3089                         If Turn2 = "Black" Then Board.PieceID.Caption = "Checkmate!  White wins." Else Board.PieceID.Caption = "Checkmate!  Black wins."\r
3090                         Notice = 5: BestTally(0) = -99999\r
3091                         GameOver = 1\r
3092                         Exit Sub\r
3093                     Else\r
3094                         If Response% <> 6 Then\r
3095                             Board.PieceID.Caption = Turn2 + " " + Pieces(Abs(OriginalPiece)).Name + " is in Check!"\r
3096                             Notice = 1\r
3097                         End If\r
3098                         Checked = 1\r
3099                         Exit Sub\r
3100                     End If\r
3101                 Else\r
3102                     Checked = 2\r
3103                     SeeMove = OldSeeMove\r
3104                 End If\r
3105             Else\r
3106                 If CheckTest <> 1 Then\r
3107                 L = 0\r
3108                 Select Case Choice\r
3109                     Case "Heian", "Chu", "Dai", "Tenjiku": L = 1\r
3110                 End Select\r
3111                 If Squares(InitFile, InitRank) > 0 Then\r
3112                     BlackInfluence = 1\r
3113                     Board.ForeColor = &H606060\r
3114                 Else\r
3115                     WhiteInfluence = 1\r
3116                     Board.ForeColor = &HFFFFFF\r
3117                 End If\r
3118                 Legal(SeeFile, SeeRank) = 0\r
3119                 For EF = 2 To Pixels\r
3120                     If Reverse = 0 Then\r
3121                         If Squares(InitFile, InitRank) > 0 Then\r
3122                            Board.Line (XStart + ((InitFile - 1) * Pixels) + EF - 2 + L, 11 + ((InitRank - 1) * Pixels) + L)-(XStart + ((InitFile - 1) * Pixels) + EF - 2 + L, 11 + ((InitRank - 1) * Pixels) + PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF) + 1)\r
3123                         Else\r
3124                            Board.Line (XStart + ((InitFile - 1) * Pixels) + (Pixels - EF) + L, 9 + (InitRank * Pixels) + L)-(XStart + ((InitFile - 1) * Pixels) + (Pixels - EF) + L, 8 + (InitRank * Pixels) - (PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF) - (L * 2)))\r
3125                         End If\r
3126                     Else\r
3127                         If Squares(InitFile, InitRank) > 0 Then\r
3128                            Board.Line (XStart + ((BoardSizeX - InitFile) * Pixels + (Pixels - EF)) + L, 8 + ((BoardSizeY - InitRank + 1) * Pixels) + 1 + L)-(XStart + ((BoardSizeX - InitFile) * Pixels) + (Pixels - EF) + L, 8 + ((BoardSizeY - InitRank + 1) * Pixels) - PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF) + (L * 2))\r
3129                         Else\r
3130                            Board.Line (XStart + ((BoardSizeX - InitFile) * Pixels) + EF - 2 + L, 10 + ((BoardSizeY - InitRank) * Pixels) + 1 + L)-(XStart + ((BoardSizeX - InitFile) * Pixels) + EF - 2 + L, 12 + ((BoardSizeY - InitRank) * Pixels) + PieceMask(Pieces(Abs(Squares(InitFile, InitRank))).Mask, EF))\r
3131                         End If\r
3132                     End If\r
3133                 Next EF\r
3134                 End If\r
3135             End If\r
3136             Legal(SeeFile, SeeRank) = 0\r
3137             Board.ForeColor = &H0&\r
3138             Board.FillColor = &HFFFFFF\r
3139         End If\r
3140     End If\r
3141 End If\r
3142 End If\r
3143 End If\r
3144 End If\r
3145 End Sub\r
3147 Sub Main ()\r
3148 If screen.Width / screen.TwipsPerPixelY > 650 Then Display = 800 Else Display = 640\r
3149 If screen.Width / screen.TwipsPerPixelY > 810 Then Display = 1240\r
3150 Load Start\r
3151 If Start.ScaleWidth > 640 Then\r
3152     Unload Start\r
3153     Response% = MsgBox("This program will not run with LARGE FONTS. You must change your display settings to SMALL FONTS before running the program.", 0, "Shogi Variants 1.55a")\r
3154 End If\r
3155 End Sub\r
3157 Sub MakeDrop ()\r
3159 File = CompLegal(BestMove).EndFile\r
3160 Rank = CompLegal(BestMove).EndRank\r
3161 For DD = 1 To Capture * 2\r
3162     If CompLegal(BestMove).EndPiece = CapRef(DD) Then I = DD\r
3163 Next DD\r
3164 HeldDrop\r
3165 End Sub\r
3167 Sub MakeMap ()\r
3168 For FF = 1 To BoardSizeY\r
3169     For GG = 1 To BoardSizeX\r
3170         Attacker(GG, FF) = 0: OldAttack(GG, FF) = 0\r
3171         BanMap(GG, FF).WhiteNum = 0: BackMap(GG, FF).WhiteNum = 0\r
3172         BanMap(GG, FF).BlackNum = 0: BackMap(GG, FF).BlackNum = 0\r
3173         BanMap(GG, FF).WhiteValue = 0: BackMap(GG, FF).WhiteValue = 0\r
3174         BanMap(GG, FF).BlackValue = 0: BackMap(GG, FF).BlackValue = 0\r
3175     Next GG\r
3176 Next FF\r
3177 FirstTime = 1\r
3178 For FF = 1 To BoardSizeY\r
3179     For GG = 1 To BoardSizeX\r
3180         If Squares(GG, FF) <> 0 Then\r
3181             InitFile = GG: InitRank = FF\r
3182             Validate\r
3183         End If\r
3184     Next GG\r
3185 Next FF\r
3186 FirstTime = 0\r
3188 End Sub\r
3190 Sub MicroAdd ()\r
3192 If (MicroCap > 4 And MicroCap < 9) Or MicroCap > 12 Then\r
3193    InHand(MicroCap - 4) = InHand(MicroCap - 4) + 1\r
3194    Board.HandPic(MicroCap - 4).Visible = True\r
3195    If InHand(MicroCap - 4) > 1 Then Board.Held(MicroCap - 4).Caption = InHand(MicroCap - 4)\r
3196 Else\r
3197    InHand(MicroCap + 4) = InHand(MicroCap + 4) + 1\r
3198    Board.HandPic(MicroCap + 4).Visible = True\r
3199    If InHand(MicroCap + 4) > 1 Then Board.Held(MicroCap + 4).Caption = InHand(MicroCap + 4)\r
3200 End If\r
3202 End Sub\r
3204 Sub MicroDrop ()\r
3206 If (I < 5) Or (I > 8 And I < 13) Then\r
3207     InHand(I + 4) = InHand(I + 4) - 1\r
3208     If InHand(I + 4) < 1 Then Board.HandPic(I + 4).Visible = False\r
3209     If InHand(I + 4) < 2 Then Board.Held(I + 4).Caption = "" Else Board.Held(I - 4).Caption = InHand(I - 4)\r
3210 Else\r
3211     InHand(I - 4) = InHand(I - 4) - 1\r
3212     If InHand(I - 4) < 1 Then Board.HandPic(I - 4).Visible = False\r
3213     If InHand(I - 4) < 2 Then Board.Held(I - 4).Caption = "" Else Board.Held(I - 4).Caption = InHand(I - 4)\r
3214 End If\r
3216 End Sub\r
3218 Sub Move2 ()\r
3219 For K = 1 To BoardSizeY\r
3220     For L = 1 To BoardSizeX\r
3221         If Grafix(L, K) = I Then\r
3222             InitFile = L\r
3223             InitRank = K\r
3224         End If\r
3225     Next L\r
3226 Next K\r
3227 Board.showpic(Grafix(InitFile, InitRank)).Drag 1\r
3228 Board.PieceID.Caption = Pieces(Abs(Squares(InitFile, InitRank))).Name\r
3229 End Sub\r
3231 Sub MoveFormDrop ()\r
3232 If NewX > XStart And NewX < XStart + (BoardSizeX * Pixels) And NewY > 11 And NewY < 11 + (BoardSizeY * Pixels) Then\r
3233     GetSquare2\r
3234     Squares(File, Rank) = Squares(InitFile, InitRank)\r
3235     Squares(InitFile, InitRank) = 0\r
3236     Grafix(File, Rank) = I\r
3237     Grafix(InitFile, InitRank) = -1\r
3238     If Reverse = 0 Then\r
3239         Board.showpic(I).Move XStart + ((File - 1) * Pixels), 11 + ((Rank - 1) * Pixels)\r
3240     Else\r
3241         Board.showpic(I).Move XStart + ((BoardSizeX - File) * Pixels), 11 + ((BoardSizeY - Rank) * Pixels)\r
3242     End If\r
3243     ClearLegal\r
3244 End If\r
3245 End Sub\r
3247 Sub MovePicDrop ()\r
3248 For K = 1 To BoardSizeY\r
3249     For L = 1 To BoardSizeX\r
3250         File = L: Rank = K\r
3251         If Grafix(L, K) = NewIndex Then\r
3252             If (L <> InitFile) Or (K <> InitRank) Then\r
3253                 Board.showpic(I).Visible = False\r
3254                 Grafix(L, K) = I\r
3255                 Grafix(InitFile, InitRank) = -1\r
3256                 Board.showpic(NewIndex).Visible = False\r
3257                 Board.showpic(NewIndex).Move 0, 0\r
3258                 If Reverse = 0 Then\r
3259                     Board.showpic(I).Move XStart + ((L - 1) * Pixels), 11 + ((K - 1) * Pixels)\r
3260                 Else\r
3261                     Board.showpic(I).Move XStart + ((BoardSizeX - L) * Pixels), 11 + ((BoardSizeY - K) * Pixels)\r
3262                 End If\r
3263                 Board.showpic(I).Visible = True\r
3264                 Victim$ = Pieces(Abs(Squares(File, Rank))).Name\r
3265                 If Squares(File, Rank) > 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then BlackPrince = BlackPrince - 1\r
3266                 If Squares(File, Rank) < 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then WhitePrince = WhitePrince - 1\r
3267                 Squares(L, K) = Squares(InitFile, InitRank)\r
3268                 Squares(InitFile, InitRank) = 0\r
3269             End If\r
3270         End If\r
3271     Next L\r
3272 Next K\r
3273 End Sub\r
3275 Sub MovePieces ()\r
3276 Board.Refresh\r
3277 Board.Caption = "Move Pieces with Left Mouse Button  (Press Right Mouse Button to Finish)"\r
3278 MovePiece = 1\r
3279 Board.BlackClock.Caption = "00:00:00"\r
3280 Board.WhiteClock.Caption = "00:00:00"\r
3281 Board.Timer1.Enabled = False\r
3283 End Sub\r
3285 Sub NextTurn ()\r
3287 If CompMove = 1 Then\r
3288     NextTurn2\r
3289 Else\r
3290     If Notice < 1 Then Board.Caption = Cap\r
3291     Board.MnuHandicap.Enabled = False\r
3292     If (Choice = "Micro" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai") And Taken = 1 Then Promessage\r
3293     If Choice = "Chu" Then\r
3294         If Squares(File, Rank) = 2 And (Rank = 2 Or Rank = 3) Then NoPro = 1\r
3295         If Squares(File, Rank) = -2 And (Rank = 10 Or Rank = 11) Then NoPro = 1\r
3296         If Squares(File, Rank) = LastBlack And Taken <> 1 Then\r
3297             NoPro = 1\r
3298             LastBlack = 0\r
3299         End If\r
3300         If Squares(File, Rank) = LastWhite And Taken <> 1 Then\r
3301             NoPro = 1\r
3302             LastWhite = 0\r
3303         End If\r
3304         If Squares(File, Rank) > 0 Then LastBlack = 0 Else LastWhite = 0\r
3305     End If\r
3306     If Dropped <> 1 And NoPro <> 1 And Choice <> "Micro" Then\r
3307         If Squares(File, Rank) > 0 And (Rank <= PromDotY Or InitRank <= PromDotY) Then Promessage\r
3308         If Squares(File, Rank) < 0 And (Rank > BoardSizeY - PromDotY Or InitRank > BoardSizeY - PromDotY) Then Promessage\r
3309         If LionPro = 1 Then Promessage\r
3310     End If\r
3311     If Eval = 1 Then AddTally: Board.Caption = Cap + Space(90 - Len(Cap)) + "Evaluation: " + Str$(BestTally(1))\r
3312     NextTurn2\r
3313 End If\r
3314 End Sub\r
3316 Sub NextTurn2 ()\r
3318 LionVictim.Piece = 0\r
3319 If Computer = Turn Then SeeMove = FirstSeeMove\r
3320 If Eval = 1 Then Board.Caption = Cap + Space(90 - Len(Cap)) + "Evaluation: " + Str$(Int(BestTally(1)))\r
3321 MakeMove = 0: Dropped = 0: NoPro = 0: LionPro = 0: CompMove = 0: Evaluate = 0\r
3322 SetKings\r
3323 If Turn = "Black" Then\r
3324     MoveCount = MoveCount + 1\r
3325     Turn = "White"\r
3326     WhiteLion = 0\r
3327     Board.MnuNextBlack.Enabled = True\r
3328     Board.MnuNextWhite.Enabled = False\r
3329     Board.MnuNextBlack.Checked = False\r
3330     Board.MnuNextWhite.Checked = True\r
3331  Else\r
3332     Turn = "Black"\r
3333     BlackLion = 0\r
3334     Board.MnuNextBlack.Enabled = False\r
3335     Board.MnuNextWhite.Enabled = True\r
3336     Board.MnuNextBlack.Checked = True\r
3337     Board.MnuNextWhite.Checked = False\r
3338 End If\r
3339 If Ligui <> 1 Then Convert\r
3340 TurnCount = TurnCount + 1: EndTurn = TurnCount\r
3341 Captures(TurnCount).number = 0\r
3342 InitFile = 0: InitRank = 0: Teach = 0: Taken = 0: Ligui = 0\r
3343 Board.LastMove.Caption = Format$(MoveCount) + ". " + ShortScore(TurnCount)\r
3344 Score(TurnCount).Caption = ShortScore(TurnCount): CMove$ = ""\r
3345 Board.Refresh\r
3346 If (Turn = "White" And Squares(File, Rank) = 1 And BlackPrince = 0) Or (Turn = "Black" And Squares(File, Rank) = -1 And WhitePrince = 0) Then TwoKings\r
3347 If Checked <> 2 Then\r
3348     OrigSeeMove = SeeMove: SeeMove = 1\r
3349     LookCheck\r
3350     SeeMove = OrigSeeMove\r
3351 End If\r
3352 If GameOver = 1 Then\r
3353     Score(TurnCount).Caption = Format$(MoveCount) + ". " + ShortScore(TurnCount) + " mate"\r
3354     Board.LastMove.Caption = Format$(MoveCount) + ". " + ShortScore(TurnCount) + " mate"\r
3355 End If\r
3356 If Checked = 2 Then TakeBack\r
3357 If PawnMate = 1 Then TakeBack\r
3358 Checked = 0: CheckTest = 0: CheckLooked = 0: PawnMate = 0: Mate = 0\r
3359 If (Backwards = 1) Or (Choice <> "Chu" And Choice <> "Dai" And Choice <> "Tenjiku" And Choice <> "Maka" And Choice <> "DiaDai" And Choice <> "Tai") Then BugFix\r
3360 If BlackEmperor = 1 And WhiteEmperor = 1 Then EmperorCheck\r
3361 If ShowLast = 1 And Computer <> Turn Then FlashPiece\r
3362 If Computer = Turn Then\r
3363     FirstSeeMove = SeeMove\r
3364     SeeMove = 1\r
3365     CompMain\r
3366 End If\r
3367 End Sub\r
3369 Sub NoCompTeach ()\r
3371 Board.MnuVer2.Enabled = True\r
3372 Board.MnuVer1.Enabled = False\r
3373 Board.MnuVer1.Checked = True\r
3374 Board.MnuVer2.Checked = False\r
3375 TeachVer = 1\r
3376 End Sub\r
3378 Sub Notation ()\r
3379 If Notate = 0 Then\r
3380     Board.NotTop.Visible = False\r
3381     Board.NotSide.Visible = False\r
3382 Else\r
3383     Board.NotTop.Visible = True\r
3384     Board.NotSide.Visible = True\r
3385 End If\r
3386 If Board.MnuNotOn.Enabled = False Then Board.MnuNotOn.Enabled = True Else Board.MnuNotOn.Enabled = False\r
3387 If Board.MnuNotOff.Enabled = False Then Board.MnuNotOff.Enabled = True Else Board.MnuNotOff.Enabled = False\r
3388 If Board.MnuNotOn.Checked = False Then Board.MnuNotOn.Checked = True Else Board.MnuNotOn.Checked = False\r
3389 If Board.MnuNotOff.Checked = False Then Board.MnuNotOff.Checked = True Else Board.MnuNotOff.Checked = False\r
3390 End Sub\r
3392 Sub NotSet ()\r
3393 Board.AutoRedraw = True\r
3394 For K = 1 To BoardSizeX\r
3395     Board.CurrentX = (XStart - 3) + ((K - 1) * Pixels) + Int(Pixels / 3)\r
3396     Board.CurrentY = 0\r
3397     If Choice <> "Chu" And Choice <> "Heian" And Choice <> "Dai" And Choice <> "Tenjiku" Then\r
3398         Board.CurrentX = Board.CurrentX - 1\r
3399         Board.CurrentY = Board.CurrentY - 1\r
3400     End If\r
3401     If Reverse = 0 Then Board.Print BoardSizeX - K + 1 Else Board.Print K\r
3402     Board.CurrentX = (XStart + 2) + (BoardSizeX * Pixels)\r
3403     Board.CurrentY = 11 + (K - 1) * Pixels + Int(Pixels / 3)\r
3404     If Choice <> "Chu" And Choice <> "Heian" And Choice <> "Dai" And Choice <> "Tenjiku" Then\r
3405         Board.CurrentX = Board.CurrentX - 1\r
3406         Board.CurrentY = Board.CurrentY - 1\r
3407     End If\r
3408     If K <= BoardSizeY Then\r
3409         If Reverse = 0 Then Board.Print Chr$(96 + K) Else Board.Print Chr$(96 + (BoardSizeY - K + 1))\r
3410     End If\r
3411 Next K\r
3412 If Choice = "Yari" Then\r
3413     Board.CurrentX = (XStart + 1) + (BoardSizeX * Pixels)\r
3414     Board.CurrentY = 11 + 7 * Pixels + Int(Pixels / 3)\r
3415     If Reverse = 0 Then Board.Print Chr$(104) Else Board.Print Chr$(98)\r
3416     Board.CurrentX = (XStart + 1) + (BoardSizeX * Pixels)\r
3417     Board.CurrentY = 11 + 8 * Pixels + Int(Pixels / 3)\r
3418     If Reverse = 0 Then Board.Print Chr$(105) Else Board.Print Chr$(97)\r
3419 End If\r
3420 If Choice = "Micro" Then\r
3421     Board.CurrentY = 270\r
3422     Board.CurrentX = 441\r
3423     If Reverse = 0 Then Board.Print Chr$(101) Else Board.Print Chr$(97)\r
3424 End If\r
3425 Board.AutoRedraw = False\r
3426 End Sub\r
3428 Sub PawnMates ()\r
3429     \r
3430 If CompLegal(AA).EndPiece <> 0 Then\r
3431     If (Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Pawn" Or Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Sparrow Pawn" Or Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Swallow" Or Pieces(Abs(CompLegal(AA).EndPiece)).Name = "Dolphin") And CompLegal(AA).StartFile = 0 And Choice <> "Micro" And Choice <> "Yari" Then\r
3432         If Turn = "Black" And CompLegal(AA).EndRank > 1 Then\r
3433             If Squares(CompLegal(AA).EndFile, CompLegal(AA).EndRank - 1) = -1 Then\r
3434                 PawnMate = 1\r
3435                 For SS = CompLegal(AA).EndRank - 2 To CompLegal(AA).EndRank\r
3436                     For TT = CompLegal(AA).EndFile - 1 To CompLegal(AA).EndFile + 1\r
3437                         If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (TT <> CompLegal(AA).EndFile Or SS <> CompLegal(AA).EndRank) Then\r
3438                             If BanMap(TT, SS).BlackNum = 0 And Squares(TT, SS) >= 0 Then PawnMate = 0\r
3439                         End If\r
3440                     Next TT\r
3441                 Next SS\r
3442                 If PawnMate = 1 Then WhiteTally = WhiteTally + 999999\r
3443             End If\r
3444         End If\r
3445         If Turn = "White" And CompLegal(AA).EndRank < BoardSizeY Then\r
3446             If Squares(CompLegal(AA).EndFile, CompLegal(AA).EndRank + 1) = 1 Then\r
3447                 PawnMate = 1\r
3448                 For SS = CompLegal(AA).EndRank To CompLegal(AA).EndRank + 2\r
3449                     For TT = CompLegal(AA).EndFile - 1 To CompLegal(AA).EndFile + 1\r
3450                         If TT > 0 And TT <= BoardSizeX And SS > 0 And SS <= BoardSizeY And (SS <> CompLegal(AA).EndRank Or TT <> CompLegal(AA).EndFile) Then\r
3451                             If BanMap(TT, SS).WhiteNum = 0 And Squares(TT, SS) <= 0 Then PawnMate = 0\r
3452                         End If\r
3453                     Next TT\r
3454                 Next SS\r
3455                 If PawnMate = 1 Then BlackTally = BlackTally + 999999\r
3456             End If\r
3457         End If\r
3458         PawnMate = 0\r
3459     End If\r
3460 End If\r
3462 End Sub\r
3464 Sub PicDown ()\r
3465 If Computer <> Turn And Computer <> "Both" And Level <> 0 And GameOver <> 1 Then\r
3466 Notice = 0\r
3467 Board.PieceID.ForeColor = &HFF0000\r
3468 If Handicap = 1 Or Reduce = 1 Or Selection <> 0 Or MovePiece = 1 Then\r
3469     RemovePiece\r
3470 Else\r
3471     If LionPiece = -1 Then Board.Caption = Cap\r
3472     If LionPiece = I Or LionPiece = -1 Then\r
3473         K = 1\r
3474         Do\r
3475             L = 1\r
3476             Do\r
3477                 If Grafix(L, K) = I Then\r
3478                     PieceName = Pieces(Abs(Squares(L, K))).Name\r
3479                     Board.PieceID.Caption = PieceName\r
3480                     InitFile = L\r
3481                     InitRank = K\r
3482                     Found = 1\r
3483                 End If\r
3484                 L = L + 1\r
3485             Loop Until L > BoardSizeX Or Found = 1\r
3486             K = K + 1\r
3487         Loop Until K > BoardSizeY Or Found = 1\r
3488         Found = 0\r
3489         If (Squares(InitFile, InitRank) > 0 And Turn = "Black") Or (Squares(InitFile, InitRank) < 0 And Turn = "White") Then\r
3490             Board.showpic(I).Drag 1\r
3491             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then Emperor Else Validate\r
3492         Else\r
3493             Board.FillStyle = 1: Other = 1\r
3494             Board.ForeColor = &HC00000\r
3495             Validate\r
3496             Board.ForeColor = &H0\r
3497             Board.FillStyle = 0: Other = 0\r
3498         End If\r
3499     Else\r
3500         Board.PieceID.ForeColor = &HFF&\r
3501         Board.PieceID.Caption = "You must move your " + LionName$ + " !"\r
3502         Notice = 1\r
3503     End If\r
3504 End If\r
3505 End If\r
3506 End Sub\r
3508 Sub PicDrop ()\r
3509 If ShowLast = 1 Then Board.Refresh\r
3510 Found = 0\r
3511 If InitRank = 0 Then ClearLegal\r
3512 If InitRank <> 0 And MovePiece <> 1 Then\r
3513 K = 1\r
3514 Do\r
3515     L = 1\r
3516     Do\r
3517         If Grafix(L, K) = NewIndex Then\r
3518             Found = 1: File = L: Rank = K\r
3519             If Legal(L, K) > 0 Then\r
3520                 If LionPiece <> I Then\r
3521                     Score(TurnCount).IDStart = Squares(InitFile, InitRank)\r
3522                     Score(TurnCount).PosStart = (InitRank * (BoardSizeX + 1)) + InitFile\r
3523                     CMove$ = CMove$ + Trim$(Pieces(Abs(Squares(InitFile, InitRank))).sname)\r
3524                     CMove$ = CMove$ + Format$((BoardSizeX - InitFile) + 1) + Chr$(96 + InitRank)\r
3525                     If (Computer = Turn Or Computer = "Both") And LionVictim.Piece <> 0 Then\r
3526                         CMove$ = CMove$ + "x" + Format$((BoardSizeX - LionVictim.File) + 1) + Chr$(96 + LionVictim.Rank)\r
3527                     End If\r
3528                 End If\r
3529                 If Choice = "Chu" And Pieces(Abs(Squares(L, K))).Name = "Lion" And Pieces(Abs(Squares(InitFile, InitRank))).Name <> "Lion" Then\r
3530                     If Turn = "Black" Then BlackLion = 1 Else WhiteLion = 1\r
3531                 End If\r
3532                 If Legal(L, K) = 1 Then LionPiece = -1\r
3533                 Board.Frame.Visible = False\r
3534                 If Legal(L, K) = 4 Then\r
3535                     Score(TurnCount).IDEnd = Squares(InitFile, InitRank)\r
3536                     Score(TurnCount).PosEnd = Score(TurnCount).PosStart\r
3537                     CMove$ = CMove$ + "x!"\r
3538                 Else\r
3539                     Score(TurnCount).IDEnd = Squares(File, Rank)\r
3540                     Score(TurnCount).PosEnd = (Rank * (BoardSizeX + 1)) + File\r
3541                     Board.showpic(I).Visible = False\r
3542                     Grafix(L, K) = I\r
3543                     If InitFile <> File Or InitRank <> Rank Then Grafix(InitFile, InitRank) = -1\r
3544                 End If\r
3545                 If Legal(L, K) <> 4 Then\r
3546                     If (InitFile <> File Or InitRank <> Rank) Then CMove$ = CMove$ + "x" Else CMove$ = CMove$ + "-"\r
3547                 End If\r
3548                 CMove$ = CMove$ + Format$((BoardSizeX - File) + 1) + Chr$(Rank + 96)\r
3549                 Captures(TurnCount).number = Captures(TurnCount).number + 1\r
3550                 Captures(TurnCount).Positions(Captures(TurnCount).number) = (Rank * (BoardSizeX + 1)) + File\r
3551                 Captures(TurnCount).PieceNum(Captures(TurnCount).number) = Squares(File, Rank)\r
3552                 If LionVictim.Piece <> 0 Then\r
3553                     Captures(TurnCount).number = Captures(TurnCount).number + 1\r
3554                     Captures(TurnCount).Positions(Captures(TurnCount).number) = (LionVictim.Rank * (BoardSizeX + 1)) + LionVictim.File\r
3555                     Captures(TurnCount).PieceNum(Captures(TurnCount).number) = Squares(LionVictim.File, LionVictim.Rank)\r
3556                 End If\r
3557                 Board.showpic(NewIndex).Visible = False\r
3558                 Board.showpic(NewIndex).Move 0, 0\r
3559                 If Abs(Squares(L, K)) = 1 Or Pieces(Abs(Squares(L, K))).Name = "Emperor" Or Pieces(Abs(Squares(L, K))).Name = "Crown Prince" Or Pieces(Abs(Squares(L, K))).Name = "Prince" Then CheckMate\r
3560                 Taken = 1\r
3561                 If Drop = 1 Then ChangeSides\r
3562                 If Legal(File, Rank) = 3 Then\r
3563                     Score(TurnCount).IDEnd = 0\r
3564                     Grafix(File, Rank) = -1\r
3565                     Board.showpic(I).Move 0, 0\r
3566                     Squares(InitFile, InitRank) = 0\r
3567                     Squares(File, Rank) = 0\r
3568                     NoPro = 1\r
3569                  Else\r
3570                     If Legal(File, Rank) <> 4 Then\r
3571                         Squares(File, Rank) = Squares(InitFile, InitRank)\r
3572                         If Squares(File, Rank) = 1 Then BlackKingX = File: BlackKingY = Rank\r
3573                         If Squares(File, Rank) = -1 Then WhiteKingX = File: WhiteKingY = Rank\r
3574                         If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" And Squares(File, Rank) > 0 Then BlackEmpX = File: BlackEmpY = Rank\r
3575                         If Pieces(Abs(Squares(File, Rank))).Name = "Emperor" And Squares(File, Rank) < 0 Then WhiteEmpX = File: WhiteEmpY = Rank\r
3576                         If Reverse = 0 Then\r
3577                             Board.showpic(I).Move XStart + ((File - 1) * Pixels), 11 + ((Rank - 1) * Pixels)\r
3578                         Else\r
3579                             Board.showpic(I).Move XStart + ((BoardSizeX - File) * Pixels), 11 + ((BoardSizeY - Rank) * Pixels)\r
3580                         End If\r
3581                         Board.showpic(I).Visible = True\r
3582                         If InitFile <> File Or InitRank <> Rank Then Squares(InitFile, InitRank) = 0\r
3583                         If LionVictim.Piece <> 0 Then\r
3584                             Squares(LionVictim.File, LionVictim.Rank) = 0\r
3585                             Board.showpic(Grafix(LionVictim.File, LionVictim.Rank)).Visible = False\r
3586                             Board.showpic(Grafix(LionVictim.File, LionVictim.Rank)).Move 0, 0\r
3587                             Grafix(LionVictim.File, LionVictim.Rank) = -1\r
3588                         End If\r
3589                     End If\r
3590                 End If\r
3591                 If Legal(L, K) = 4 Then Squares(L, K) = 0: Grafix(L, K) = -1: File = InitFile: Rank = InitRank\r
3592                 If Demon = 1 Then Flame\r
3593                 If Legal(L, K) = 3 Then CMove$ = CMove$ + "*"\r
3594                 If Legal(L, K) = 6 Then Teach = 3\r
3595                 If Legal(L, K) = 2 Then Teach = 2 Else Teach = 1\r
3596                 If Mate <> 1 Then\r
3597                     If Legal(L, K) = 2 Or Legal(L, K) = 6 Then\r
3598                         DoubleMove\r
3599                     Else\r
3600                         LastPieceX = File: LastPieceY = Rank\r
3601                         If CompMove <> 1 Then NextTurn\r
3602                     End If\r
3603                 End If\r
3604             End If\r
3605         End If\r
3606         L = L + 1\r
3607     Loop Until L > BoardSizeX Or Found = 1\r
3608     K = K + 1\r
3609 Loop Until K > BoardSizeY Or Found = 1\r
3610 Found = 0\r
3611 ClearLegal\r
3612 If Mate = 1 Then GameOver = 1: Response% = MsgBox("        Checkmate!          ", 0, Turn + " Wins!"): NextTurn\r
3613 Else\r
3614     If MovePiece = 1 Then MovePicDrop\r
3615 End If\r
3616 End Sub\r
3618 Sub PrintScore ()\r
3619     \r
3620 Printer.Print GameName + " Shogi -  Game Record"\r
3621 Printer.Print "____________________________________"\r
3622 Printer.Print\r
3624 PrintMax = 4\r
3625 PrintInc = 20\r
3626 If Choice = "Chu" Or Choice = "Dai" Or Choice = "Maka" Or Choice = "DaiDai" Or Choice = "Tai" Then\r
3627     PrintMax = 3\r
3628     PrintInc = 27\r
3629 End If\r
3630 If Choice = "Tenjiku" Then\r
3631     PrintMax = 2\r
3632     PrintInc = 40\r
3633 End If\r
3634 K = 0: J = 0\r
3635 For W = 1 To TurnCount Step 2\r
3636     K = K + 1: J = J + 1\r
3637     FirstScore = Score(W).Caption\r
3638     SecondScore = Score(W + 1).Caption\r
3639     If InStr(FirstScore, " ") > 0 Then TenjikuScore1\r
3640     If InStr(SecondScore, " ") > 0 Then TenjikuScore2\r
3641     If HandGame = 1 And W = 1 Then\r
3642     Printer.Print "1.  -  " + SecondScore; Tab(PrintInc);\r
3643     Else\r
3644     Printer.Print K + ". " + FirstScore + " " + SecondScore; Tab(J * PrintInc);\r
3645     End If\r
3646 If J = PrintMax Then Printer.Print : J = 0\r
3647 Next W\r
3648 Board.Caption = "Printing...": Notice = 1\r
3649 Printer.EndDoc\r
3650 End Sub\r
3652 Sub Promessage ()\r
3653 ClearLegal\r
3654 ForceProm = 0: Taken = 0\r
3655 If Choice = "Micro" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai" Then ForceProm = 1\r
3656 If Pieces(Abs(Squares(File, Rank))).special = "1" Then\r
3657     If Squares(File, Rank) > 0 And Rank = 1 Then ForceProm = 1\r
3658     If Squares(File, Rank) < 0 And Rank = BoardSizeY Then ForceProm = 1\r
3659 End If\r
3660 If Pieces(Abs(Squares(File, Rank))).special = "2" Then\r
3661     If Squares(File, Rank) > 0 And Rank < 3 Then ForceProm = 1\r
3662     If Squares(File, Rank) < 0 And Rank > BoardSizeY - 2 Then ForceProm = 1\r
3663 End If\r
3664 If Prom = 0 And ForceProm <> 1 Then\r
3665     If Pieces(Abs(Squares(File, Rank))).Promotes > 0 Then\r
3666         If AutoPromote <> 1 Then\r
3667             L$ = Pieces(Pieces(Abs(Squares(File, Rank))).Promotes).Name\r
3668             K$ = Pieces(Abs(Squares(File, Rank))).Name\r
3669             Message$ = "Promote to " & L$ & " ?"\r
3670             Response% = MsgBox(Message$, 36, K$)\r
3671             If Response% = 6 Then\r
3672                 Promote\r
3673             Else\r
3674                 CMove$ = CMove$ + "="\r
3675                 If Turn = "White" And InitRank < 9 Then LastWhite = Squares(File, Rank)\r
3676                 If Turn = "Black" And InitRank > 4 Then LastBlack = Squares(File, Rank)\r
3677             End If\r
3678         Else\r
3679             Promote\r
3680         End If\r
3681     End If\r
3682 End If\r
3683 If Prom = 1 Or ForceProm = 1 Then\r
3684     If Pieces(Abs(Squares(File, Rank))).Promotes > 0 Then\r
3685         Board.PieceID.ForeColor = &H8000&\r
3686         K$ = Pieces(Abs(Squares(File, Rank))).Name\r
3687         Board.PieceID.Caption = K$ + " promotes"\r
3688         Notice = 1\r
3689         Promote\r
3690     End If\r
3691 End If\r
3692 End Sub\r
3694 Sub Promote ()\r
3696 If Reverse = 0 Then PromGraf = (TotGraph / 2) - 1 Else PromGraf = -1\r
3697 If Squares(File, Rank) < 0 And Pieces(Abs(Squares(File, Rank))).Promotes <> 0 Then\r
3698     If Choice = "Tai" Then\r
3699         Board.showpic(I).Picture = TaiPieces.Pix(PromGraf + Pieces(Abs(Squares(File, Rank))).PrGraphic).Picture\r
3700     Else\r
3701         Board.showpic(I).Picture = Board.Pix(PromGraf + Pieces(Abs(Squares(File, Rank))).PrGraphic).Picture\r
3702     End If\r
3703     PromPiece$ = Pieces(Abs(Squares(File, Rank))).Name\r
3704     If PromPiece$ = "Drunk Elephant" Then WhitePrince = WhitePrince + 1\r
3705     If PromPiece$ = "King" Then\r
3706         WhiteEmperor = 1: WhiteEmpX = File: WhiteEmpY = Rank\r
3707     End If\r
3708     Squares(File, Rank) = 0 - Pieces(Abs(Squares(File, Rank))).Promotes\r
3709     Score(TurnCount).IDEnd = Squares(File, Rank)\r
3710     Board.showpic(I).Visible = True\r
3711     CMove$ = CMove$ + "+"\r
3712     If AutoPromote = 1 And ForceProm <> 1 Then AutoMessage\r
3713 End If\r
3714 If Reverse = 1 Then PromGraf = (TotGraph / 2) - 1 Else PromGraf = -1\r
3715 If Squares(File, Rank) > 0 And Pieces(Abs(Squares(File, Rank))).Promotes <> 0 Then\r
3716     If Choice = "Tai" Then\r
3717         Board.showpic(I).Picture = TaiPieces.Pix(PromGraf + Pieces(Squares(File, Rank)).PrGraphic).Picture\r
3718     Else\r
3719         Board.showpic(I).Picture = Board.Pix(PromGraf + Pieces(Squares(File, Rank)).PrGraphic).Picture\r
3720     End If\r
3721     PromPiece$ = Pieces(Abs(Squares(File, Rank))).Name\r
3722     If PromPiece$ = "Drunk Elephant" Then BlackPrince = BlackPrince + 1\r
3723     If PromPiece$ = "King" Then\r
3724         BlackEmperor = 1: BlackEmpX = File: BlackEmpY = Rank\r
3725     End If\r
3726     Squares(File, Rank) = Pieces(Abs(Squares(File, Rank))).Promotes\r
3727     Score(TurnCount).IDEnd = Squares(File, Rank)\r
3728     Board.showpic(I).Visible = True\r
3729     CMove$ = CMove$ + "+"\r
3730     If AutoPromote = 1 And ForceProm <> 1 Then AutoMessage\r
3731 End If\r
3732 End Sub\r
3734 Sub RangeJump ()\r
3735 M = 64: Range = 1\r
3736 SingleStep\r
3737 End Sub\r
3739 Sub ReduceHand ()\r
3741 If Replaying = 1 Then\r
3742     CaptPiece = Score(TurnCount).IDEnd\r
3743     OldPiece = Squares(InitFile, InitRank)\r
3744     Squares(InitFile, InitRank) = 0 - CaptPiece\r
3745 Else\r
3746 If Pieces(Abs(Squares(InitFile, InitRank))).Promotes = 0 And Pieces(Abs(Squares(InitFile, InitRank))).PrGraphic > 0 Then\r
3747     CaptPiece = Pieces(Abs(Squares(InitFile, InitRank))).PrGraphic\r
3748     If Squares(InitFile, InitRank) > 0 Then CaptPiece = 0 - CaptPiece\r
3749 Else\r
3750     CaptPiece = 0 - Squares(InitFile, InitRank)\r
3751 End If\r
3752 End If\r
3753 For Z = 1 To Capture\r
3754     If (Squares(InitFile, InitRank) < 0 And Reverse = 0) Or (Squares(InitFile, InitRank) > 0 And Reverse = 1) Then\r
3755         If CapRef(Z) = CaptPiece Then\r
3756             InHand(Z) = InHand(Z) - 1\r
3757             If InHand(Z) < 2 Then Board.Held(Z).Caption = "" Else Board.Held(Z).Caption = InHand(Z)\r
3758             If InHand(Z) < 1 Then Board.HandPic(Z).Visible = False\r
3759             If Choice = "Micro" Then\r
3760                 I = Z: MicroDrop\r
3761             End If\r
3762         End If\r
3763     Else\r
3764         If CapRef(Z) = 0 - CaptPiece Then\r
3765             InHand(Capture + Z) = InHand(Capture + Z) - 1\r
3766             If InHand(Capture + Z) < 2 Then Board.Held(Capture + Z).Caption = "" Else Board.Held(Capture + Z).Caption = InHand(Capture + Z)\r
3767             If InHand(Capture + Z) < 1 Then Board.HandPic(Capture + Z).Visible = False\r
3768             If Choice = "Micro" Then\r
3769                 I = Capture + Z: MicroDrop\r
3770             End If\r
3771          End If\r
3772     End If\r
3773 Next Z\r
3774 If Replaying = 1 Then Squares(InitFile, InitRank) = OldPiece\r
3775 End Sub\r
3777 Sub ReduceHand2 ()\r
3778 If Replaying = 1 Then\r
3779     CaptPiece = Score(TurnCount).IDEnd\r
3780     OldPiece = Squares(InitFile, InitRank)\r
3781     Squares(InitFile, InitRank) = 0 - CaptPiece\r
3782 Else\r
3783 If Pieces(Abs(Squares(InitFile, InitRank))).Promotes = 0 And Pieces(Abs(Squares(InitFile, InitRank))).PrGraphic > 0 Then\r
3784     CaptPiece = Pieces(Abs(Squares(InitFile, InitRank))).PrGraphic\r
3785     If Squares(InitFile, InitRank) > 0 Then CaptPiece = 0 - CaptPiece\r
3786 Else\r
3787     CaptPiece = 0 - Squares(InitFile, InitRank)\r
3788 End If\r
3789 End If\r
3790 For Z = 1 To Capture\r
3791     If (Squares(InitFile, InitRank) < 0 And Reverse = 0) Or (Squares(InitFile, InitRank) > 0 And Reverse = 1) Then\r
3792         If CapRef(Z) = CaptPiece Then\r
3793             InHand(Z) = InHand(Z) - 1\r
3794             If Choice = "Micro" Then\r
3795                 I = Z\r
3796                 If (I < 5) Or (I > 8 And I < 13) Then InHand(I + 4) = InHand(I + 4) - 1 Else InHand(I - 4) = InHand(I - 4) - 1\r
3797             End If\r
3798         End If\r
3799     Else\r
3800         If CapRef(Z) = 0 - CaptPiece Then\r
3801             InHand(Capture + Z) = InHand(Capture + Z) - 1\r
3802             If Choice = "Micro" Then\r
3803                 I = Capture + Z\r
3804                 If (I < 5) Or (I > 8 And I < 13) Then InHand(I + 4) = InHand(I + 4) - 1 Else InHand(I - 4) = InHand(I - 4) - 1\r
3805             End If\r
3806          End If\r
3807     End If\r
3808 Next Z\r
3809 If Replaying = 1 Then Squares(InitFile, InitRank) = OldPiece\r
3811 End Sub\r
3813 Sub RemovePiece ()\r
3814 If Selection <> 0 Or MovePiece = 1 Then\r
3815     SquareReplace\r
3816 Else\r
3817 K = 1\r
3818 Do\r
3819     L = 1\r
3820     Do\r
3821         If Grafix(L, K) = I Then\r
3822             PieceName = Pieces(Abs(Squares(L, K))).Name\r
3823             Board.PieceID.Caption = PieceName\r
3824             File = L\r
3825             Rank = K\r
3826         End If\r
3827         L = L + 1\r
3828     Loop Until L > BoardSizeX Or Found = 1\r
3829     K = K + 1\r
3830 Loop Until K > BoardSizeY Or Found = 1\r
3831 Found = 0\r
3832 If Handicap = 1 Then\r
3833     If Squares(File, Rank) > 0 Then\r
3834         Board.PieceID.ForeColor = &HFF&\r
3835         Board.PieceID.Caption = "Select a White piece"\r
3836         Notice = 1\r
3837     End If\r
3838     If Squares(File, Rank) < 0 Then\r
3839         Victim$ = Pieces(Abs(Squares(File, Rank))).Name\r
3840         If Abs(Squares(File, Rank)) = 1 Or Victim$ = "Emperor" Or Victim$ = "Prince" Or Victim$ = "Crown Prince" Then\r
3841             Board.PieceID.ForeColor = &HFF&\r
3842             Board.PieceID.Caption = "The White " + Victim$ + "can not be removed"\r
3843             Notice = 1\r
3844         Else\r
3845             Board.PieceID.Caption = Pieces(Abs(Squares(File, Rank))).Name + " removed"\r
3846             Notice = 1\r
3847             Squares(File, Rank) = 0\r
3848             Board.showpic(Grafix(File, Rank)).Visible = False\r
3849             Board.showpic(Grafix(File, Rank)).Move 0, 0\r
3850             Grafix(File, Rank) = -1\r
3851             Turn = "White"\r
3852             Board.NextMove.Caption = "White to Move"\r
3853             MoveCount = 1: HandGame = 1\r
3854         End If\r
3855     End If\r
3856 Else\r
3857     Board.PieceID.Caption = ""\r
3858     Victim$ = Pieces(Abs(Squares(File, Rank))).Name\r
3859     If Squares(File, Rank) > 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then BlackPrince = BlackPrince - 1\r
3860     If Squares(File, Rank) < 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then WhitePrince = WhitePrince - 1\r
3861     Squares(File, Rank) = 0\r
3862     Board.showpic(Grafix(File, Rank)).Visible = False\r
3863     Board.showpic(Grafix(File, Rank)).Move 0, 0\r
3864     Grafix(File, Rank) = -1\r
3865     MoveCount = 0: TurnCount = 0\r
3866     If Turn = "White" Then MoveCount = 1\r
3867     Board.LastMove.Caption = ""\r
3868 End If\r
3869 End If\r
3870 End Sub\r
3872 Sub ReorderMoves ()\r
3874 If Level > 1 Then\r
3875     For XX = 1 To TestDepth\r
3876         If BestTally(Level + 1) > BestTally(XX) Then\r
3877             For YY = TestDepth - 1 To XX Step -1\r
3878                 BestTally(YY + 1) = BestTally(YY)\r
3879                 MoveList(YY + 1).StartPiece = MoveList(YY).StartPiece\r
3880                 MoveList(YY + 1).EndPiece = MoveList(YY).EndPiece\r
3881                 MoveList(YY + 1).StartFile = MoveList(YY).StartFile\r
3882                 MoveList(YY + 1).EndFile = MoveList(YY).EndFile\r
3883                 MoveList(YY + 1).StartRank = MoveList(YY).StartRank\r
3884                 MoveList(YY + 1).EndRank = MoveList(YY).EndRank\r
3885                 OldKingTally(YY + 1) = OldKingTally(YY)\r
3886                 If Choice = "Dai" Or Choice = "Chu" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai" Then\r
3887                     ECapture(YY + 1).Piece = ECapture(YY).Piece\r
3888                     ECapture(YY + 1).File = ECapture(YY).File\r
3889                     ECapture(YY + 1).Rank = ECapture(YY).Rank\r
3890                 End If\r
3891             Next YY\r
3892             BestTally(XX) = BestTally(Level + 1)\r
3893             MoveList(XX).StartPiece = CompLegal(BestMove).StartPiece\r
3894             MoveList(XX).EndPiece = CompLegal(BestMove).EndPiece\r
3895             MoveList(XX).StartFile = CompLegal(BestMove).StartFile\r
3896             MoveList(XX).EndFile = CompLegal(BestMove).EndFile\r
3897             MoveList(XX).StartRank = CompLegal(BestMove).StartRank\r
3898             MoveList(XX).EndRank = CompLegal(BestMove).EndRank\r
3899             OldKingTally(XX) = KingTally(BestMove)\r
3900             If Choice = "Dai" Or Choice = "Chu" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tenjiku" Or Choice = "Tai" Then\r
3901                 ECapture(XX).Piece = ExtraCapture(BestMove).Piece\r
3902                 ECapture(XX).File = ExtraCapture(BestMove).File\r
3903                 ECapture(XX).Rank = ExtraCapture(BestMove).Rank\r
3904             End If\r
3905             Exit Sub\r
3906         End If\r
3907         DoEvents\r
3908     Next XX\r
3909 End If\r
3911 End Sub\r
3913 Sub Replay ()\r
3915 If (LegalMoves = 0 Or Checked = 2) And LionPiece <> I And XA = 0 Then\r
3916 Notice = 0\r
3917 Board.PieceID.Caption = ""\r
3918 If Forwards <> 1 Then Board.Caption = Cap\r
3919 BugFix\r
3920 If TurnCount >= EndTurn Then\r
3921     Board.PieceID.ForeColor = &HFF&\r
3922     Board.PieceID.Caption = "No moves to replay!"\r
3923     Notice = 1\r
3924 Else\r
3925     Replaying = 1\r
3926     For V = 1 To Captures(TurnCount).number\r
3927        Location = Captures(TurnCount).Positions(V)\r
3928        InitRank = Int(Location / (BoardSizeX + 1))\r
3929        InitFile = Location - (InitRank * (BoardSizeX + 1))\r
3930        NewGraf = Grafix(InitFile, InitRank)\r
3931        Grafix(InitFile, InitRank) = -1\r
3932        Board.showpic(NewGraf).Visible = False\r
3933        Board.showpic(NewGraf).Move 0, 0\r
3934        Squares(InitFile, InitRank) = 0\r
3935     Next V\r
3936     If Drop = 1 And Captures(TurnCount).number > 0 Then\r
3937          CaptPiece = Captures(TurnCount).PieceNum(1)\r
3938          If Pieces(Abs(CaptPiece)).Promotes = 0 And Pieces(Abs(CaptPiece)).PrGraphic > 0 Then\r
3939             CaptPiece = Pieces(Abs(CaptPiece)).PrGraphic\r
3940             If Captures(TurnCount).PieceNum(1) > 0 Then CaptPiece = 0 - CaptPiece\r
3941          Else\r
3942             CaptPiece = 0 - CaptPiece\r
3943          End If\r
3944          AddHand\r
3945     End If\r
3946     Location = Score(TurnCount).PosStart\r
3947     If Location > 0 Then\r
3948         Rank = Int(Location / (BoardSizeX + 1))\r
3949         File = Location - (Rank * (BoardSizeX + 1))\r
3950         Squares(File, Rank) = 0\r
3951         NewGraf = Grafix(File, Rank)\r
3952         Grafix(File, Rank) = -1\r
3953         Board.showpic(NewGraf).Visible = False\r
3954         Board.showpic(NewGraf).Move 0, 0\r
3955     End If\r
3956     Location = Score(TurnCount).PosEnd\r
3957     If Location > 0 Then\r
3958         InitRank = Int(Location / (BoardSizeX + 1))\r
3959         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
3960         Squares(InitFile, InitRank) = Score(TurnCount).IDStart\r
3961         If Sgn(Score(TurnCount).IDStart) = Sgn(Score(TurnCount).IDEnd) And Score(TurnCount).IDEnd <> Score(TurnCount).IDStart Then Squares(InitFile, InitRank) = Score(TurnCount).IDEnd\r
3962         If Squares(InitFile, InitRank) < 0 Then\r
3963             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then WhiteEmpX = InitFile: WhiteEmpY = InitRank\r
3964             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then WhiteKingX = InitFile: WhiteKingY = InitRank\r
3965         End If\r
3966         If Squares(InitFile, InitRank) > 0 Then\r
3967             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then BlackEmpX = InitFile: BlackEmpY = InitRank\r
3968             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then BlackKingX = InitFile: BlackKingY = InitRank\r
3969         End If\r
3970         If Score(TurnCount).IDEnd <> 0 Then\r
3971             NewGraf = 0\r
3972             Do While Board.showpic(NewGraf).Visible = True\r
3973                 NewGraf = NewGraf + 1\r
3974             Loop\r
3975             SetGrafix\r
3976         End If\r
3977     End If\r
3978     If Drop = 1 And Score(TurnCount).PosStart = 0 Then ReduceHand\r
3979     If Turn = "Black" Then\r
3980         Turn = "White"\r
3981         Board.NextMove.Caption = "White to Move"\r
3982         MoveCount = MoveCount + 1\r
3983     Else\r
3984         Turn = "Black"\r
3985         Board.NextMove.Caption = "Black to Move"\r
3986     End If\r
3987     TurnCount = TurnCount + 1\r
3988     Board.MnuHandicap.Enabled = False\r
3989     If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
3990         Board.LastMove.Caption = Score(TurnCount).Caption\r
3991     Else\r
3992         Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
3993     End If\r
3994     Backwards = 1\r
3995     SetKings\r
3996     Location = Score(TurnCount - 1).PosEnd\r
3997     If Location > 0 Then\r
3998         Rank = Int(Location / (BoardSizeX + 1))\r
3999         File = Location - (Rank * (BoardSizeX + 1))\r
4000     End If\r
4001     LastPieceX = File: LastPieceY = Rank\r
4002     If Computer = "Black" Or Computer = "White" Then\r
4003         Board.Caption = "Move Replayed (" + Str$(TurnCount) + " of" + Str$(EndTurn) + " ) : Press [ESC] to continue play."\r
4004     Else\r
4005         Board.Caption = "Move Replayed (" + Str$(TurnCount) + " of" + Str$(EndTurn) + " )"\r
4006     End If\r
4007 End If\r
4008 Replaying = 0\r
4009 End If\r
4011 End Sub\r
4013 Sub Replay2 ()\r
4014 If (LegalMoves = 0 Or Checked = 2) And LionPiece <> I And XA = 0 Then\r
4015 If TurnCount < EndTurn Then\r
4016     Replaying = 1\r
4017     For V = 1 To Captures(TurnCount).number\r
4018        Location = Captures(TurnCount).Positions(V)\r
4019        InitRank = Int(Location / (BoardSizeX + 1))\r
4020        InitFile = Location - (InitRank * (BoardSizeX + 1))\r
4021        Squares(InitFile, InitRank) = 0\r
4022     Next V\r
4023     If Drop = 1 And Captures(TurnCount).number > 0 Then\r
4024          CaptPiece = Captures(TurnCount).PieceNum(1)\r
4025          If Pieces(Abs(CaptPiece)).Promotes = 0 And Pieces(Abs(CaptPiece)).PrGraphic > 0 Then\r
4026             CaptPiece = Pieces(Abs(CaptPiece)).PrGraphic\r
4027             If Captures(TurnCount).PieceNum(1) > 0 Then CaptPiece = 0 - CaptPiece\r
4028          Else\r
4029             CaptPiece = 0 - CaptPiece\r
4030          End If\r
4031          AddHand3\r
4032     End If\r
4033     Location = Score(TurnCount).PosStart\r
4034     If Location > 0 Then\r
4035         Rank = Int(Location / (BoardSizeX + 1))\r
4036         File = Location - (Rank * (BoardSizeX + 1))\r
4037         Squares(File, Rank) = 0\r
4038     End If\r
4039     Location = Score(TurnCount).PosEnd\r
4040     If Location > 0 Then\r
4041         InitRank = Int(Location / (BoardSizeX + 1))\r
4042         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
4043         Squares(InitFile, InitRank) = Score(TurnCount).IDStart\r
4044         If Sgn(Score(TurnCount).IDStart) = Sgn(Score(TurnCount).IDEnd) And Score(TurnCount).IDEnd <> Score(TurnCount).IDStart Then Squares(InitFile, InitRank) = Score(TurnCount).IDEnd\r
4045         If Squares(InitFile, InitRank) < 0 Then\r
4046             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then WhiteEmpX = InitFile: WhiteEmpY = InitRank\r
4047             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then WhiteKingX = InitFile: WhiteKingY = InitRank\r
4048         End If\r
4049         If Squares(InitFile, InitRank) > 0 Then\r
4050             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then BlackEmpX = InitFile: BlackEmpY = InitRank\r
4051             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then BlackKingX = InitFile: BlackKingY = InitRank\r
4052         End If\r
4053     End If\r
4054     If Drop = 1 And Score(TurnCount).PosStart = 0 Then ReduceHand2\r
4055     If Turn = "Black" Then\r
4056         Turn = "White"\r
4057         Board.NextMove.Caption = "White to Move"\r
4058         MoveCount = MoveCount + 1\r
4059     Else\r
4060         Turn = "Black"\r
4061         Board.NextMove.Caption = "Black to Move"\r
4062     End If\r
4063     TurnCount = TurnCount + 1\r
4064     Board.MnuHandicap.Enabled = False\r
4065     If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
4066         Board.LastMove.Caption = Score(TurnCount).Caption\r
4067     Else\r
4068         Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
4069     End If\r
4070     Board.MnuHandicap.Enabled = False\r
4071     Backwards = 1\r
4072     If Location > 0 Then\r
4073         Rank = Int(Location / (BoardSizeX + 1))\r
4074         File = Location - (Rank * (BoardSizeX + 1))\r
4075     End If\r
4076     LastPieceX = File: LastPieceY = Rank\r
4077 End If\r
4078 Replaying = 0\r
4079 End If\r
4081 End Sub\r
4083 Sub ReplayAll ()\r
4084 If LegalMoves = 0 Then\r
4085     Do While TurnCount < EndTurn\r
4086         Replay2\r
4087     Loop\r
4088     Board.Caption = Cap\r
4089     RestoreGrafix\r
4090     SetKings\r
4091 End If\r
4092 End Sub\r
4094 Sub ResetBoard ()\r
4096 Board.Hide\r
4097 If Choice = "Wa" Then\r
4098     For W = 1 To Capture * 2\r
4099        Board.Held(W).Caption = ""\r
4100        Board.HandPic(W).Visible = False\r
4101     Next W\r
4102 End If\r
4103 NewGame = 1\r
4104 SetPieces\r
4106 End Sub\r
4108 Sub ResetHand ()\r
4109 For X = 1 To Capture\r
4110     If InHand(X) < 1 Then Board.HandPic(X).Visible = False\r
4111     If InHand(X) < 2 Then Board.Held(X).Caption = ""\r
4112     If InHand(Capture + X) < 1 Then Board.HandPic(Capture + X).Visible = False\r
4113     If InHand(Capture + X) < 2 Then Board.Held(Capture + X).Caption = ""\r
4114 Next X\r
4115 End Sub\r
4117 Sub ResetLegal ()\r
4119 For MM = 1 To BoardSizeY\r
4120     For NN = 1 To BoardSizeX\r
4121         Legal(NN, MM) = 0\r
4122     Next NN\r
4123 Next MM\r
4125 End Sub\r
4127 Sub RestoreGrafix ()\r
4128      \r
4129  \r
4130  Board.Hide\r
4131  Count = 0: M = 0\r
4132  For J = 1 To BoardSizeY\r
4133     For I = 1 To BoardSizeX\r
4134         Grafix(I, J) = -1\r
4135         If Squares(I, J) <> 0 Then\r
4136             Graphnum = Pieces(Abs(Squares(I, J))).Graphic\r
4137             If (Squares(I, J) < 0 And Reverse = 0) Or (Squares(I, J) > 0 And Reverse = 1) Then Graphnum = Graphnum + (TotGraph / 2)\r
4138             If Choice = "Tai" Then Board.showpic(Count) = TaiPieces.Pix(Graphnum - 1) Else Board.showpic(Count) = Board.Pix(Graphnum - 1)\r
4139             If Reverse = 0 Then\r
4140                 Board.showpic(Count).Move XStart + ((I - 1) * Pixels), 11 + ((J - 1) * Pixels)\r
4141             Else\r
4142                 Board.showpic(Count).Move XStart + ((BoardSizeX - I) * Pixels), 11 + ((BoardSizeY - J) * Pixels)\r
4143             End If\r
4144             Board.showpic(Count).Visible = True\r
4145             Grafix(I, J) = Count\r
4146             Count = Count + 1\r
4147         End If\r
4148     Next I\r
4149  Next J\r
4150  If Drop = 1 Or Choice = "Wa" Then\r
4151      For I = 1 To Capture * 2\r
4152         Graphnum = Pieces(Abs(CapRef(I))).Graphic\r
4153         If I > Capture Then Graphnum = Graphnum + (TotGraph / 2)\r
4154         Board.HandPic(I) = Board.Pix(Graphnum - 1)\r
4155         Board.HandPic(I).Visible = False\r
4156         Board.Held(I).Caption = ""\r
4157         If InHand(I) > 0 Then Board.HandPic(I).Visible = True\r
4158         If InHand(I) > 1 Then Board.Held(I).Caption = InHand(I)\r
4159     Next I\r
4160 End If\r
4161 BugFix\r
4162 Board.Show\r
4163 If Choice = "Tai" Or Choice = "Maka" Then\r
4164     For ABC = 1 To BoardSizeY\r
4165         For DEF = 1 To BoardSizeX\r
4166             If Squares(DEF, ABC) > 0 Then\r
4167                 If Pieces(Abs(Squares(DEF, ABC))).Name = "Emperor" Then BlackEmpX = DEF: BlackEmpY = ABC: BlackEmperor = 1\r
4168             End If\r
4169             If Squares(DEF, ABC) < 0 Then\r
4170                 If Pieces(Abs(Squares(DEF, ABC))).Name = "Emperor" Then WhiteEmpX = DEF: WhiteEmpY = ABC: WhiteEmperor = 1\r
4171             End If\r
4172         Next DEF\r
4173     Next ABC\r
4174 End If\r
4176 End Sub\r
4178 Sub RestoreMap ()\r
4179 For JJ = 1 To BoardSizeY\r
4180     For KK = 1 To BoardSizeX\r
4181         BanMap(KK, JJ).WhiteNum = BackMap(KK, JJ).WhiteNum\r
4182         BanMap(KK, JJ).BlackNum = BackMap(KK, JJ).BlackNum\r
4183         Attacker(KK, JJ) = OldAttack(KK, JJ)\r
4184         For LL = 1 To OldAttack(KK, JJ)\r
4185             BanMap(KK, JJ).Info(LL).File = BackMap(KK, JJ).Info(LL).File\r
4186             BanMap(KK, JJ).Info(LL).Rank = BackMap(KK, JJ).Info(LL).Rank\r
4187             BanMap(KK, JJ).Info(LL).Piece = BackMap(KK, JJ).Info(LL).Piece\r
4188         Next LL\r
4189     Next KK\r
4190     DoEvents\r
4191 Next JJ\r
4193 End Sub\r
4195 Sub Rotate ()\r
4197 If LegalMoves = 0 Then\r
4198 Board.Picture = LoadPicture(Direct + "\Data\" + Boardbmp)\r
4199 If Reverse = 1 Then\r
4200     Reverse = 0\r
4201     Board.White.Picture = LoadPicture(Direct + "\Data\" + "WhiteDn.bmp")\r
4202     Board.Black.Picture = LoadPicture(Direct + "\Data\" + "BlackUp.bmp")\r
4203 Else\r
4204     Reverse = 1\r
4205     Board.White.Picture = LoadPicture(Direct + "\Data\" + "WhiteUp.bmp")\r
4206     Board.Black.Picture = LoadPicture(Direct + "\Data\" + "BlackDn.bmp")\r
4207 End If\r
4208 For J = 1 To BoardSizeY\r
4209     For I = 1 To BoardSizeX\r
4210         If Squares(I, J) <> 0 Then\r
4211             Board.showpic(Grafix(I, J)).Visible = False\r
4212             Graphnum = Pieces(Abs(Squares(I, J))).Graphic\r
4213             If (Squares(I, J) < 0 And Reverse = 0) Or (Squares(I, J) > 0 And Reverse = 1) Then Graphnum = Graphnum + (TotGraph / 2)\r
4214             If Choice = "Tai" Then Board.showpic(Grafix(I, J)) = TaiPieces.Pix(Graphnum - 1) Else Board.showpic(Grafix(I, J)) = Board.Pix(Graphnum - 1)\r
4215             If Reverse = 0 Then\r
4216                 Board.showpic(Grafix(I, J)).Move XStart + ((I - 1) * Pixels), 11 + ((J - 1) * Pixels)\r
4217             Else\r
4218                 Board.showpic(Grafix(I, J)).Move XStart + ((BoardSizeX - I) * Pixels), 11 + ((BoardSizeY - J) * Pixels)\r
4219             End If\r
4220             Board.showpic(Grafix(I, J)).Visible = True\r
4221         End If\r
4222     Next I\r
4223 Next J\r
4224 If Drop = 1 Then\r
4225     ReDim TempHand(Capture * 2) As Integer\r
4226     For I = 1 To Capture * 2\r
4227         Board.HandPic(I).Visible = False\r
4228         Board.Held(I).Caption = ""\r
4229         CapRef(I) = 0 - CapRef(I)\r
4230         If I > Capture Then TempHand(I) = InHand(I - Capture) Else TempHand(I) = InHand(I + Capture)\r
4231     Next I\r
4232     For I = 1 To Capture * 2\r
4233         InHand(I) = TempHand(I)\r
4234         If InHand(I) > 0 Then Board.HandPic(I).Visible = True\r
4235         If InHand(I) > 1 Then Board.Held(I).Caption = InHand(I)\r
4236     Next I\r
4237 End If\r
4238 NotSet\r
4239 End If\r
4240 End Sub\r
4242 Sub SaveGame ()\r
4244 On Error Resume Next\r
4245 Board.CMSave.DialogTitle = "Save Game"\r
4246 Board.CMSave.Flags = &H400& Or &H800& Or &H4&\r
4247 Board.CMSave.Action = 2\r
4248 If Err = 32755 Then Exit Sub\r
4249 Saved$ = Board.CMSave.Filename\r
4251 Open Saved$ For Output As #2\r
4252 Write #2, Choice, Drop, MoveCount, Turn, Notate, SeeMove, TurnCount, WhiteKing, BlackKing\r
4253 Write #2, WhiteLion, BlackLion, WhitePrince, BlackPrince, WhiteEmperor, BlackEmperor, Board.LastMove.Caption\r
4254 Write #2, Board.WhiteClock.Caption, Board.BlackClock.Caption, HandGame, Reverse\r
4255 For W = 0 To TurnCount\r
4256     Write #2, Score(W).Caption, Score(W).IDStart, Score(W).IDEnd, Score(W).PosStart, Score(W).PosEnd\r
4257     Write #2, Captures(W).number\r
4258     For V = 1 To Captures(W).number\r
4259         Write #2, Captures(W).Positions(V)\r
4260         Write #2, Captures(W).PieceNum(V)\r
4261     Next V\r
4262 Next W\r
4263 For W = 1 To BoardSizeY\r
4264     For Z = 1 To BoardSizeX\r
4265         Write #2, Squares(Z, W)\r
4266     Next Z\r
4267 Next W\r
4268 If Drop = 1 Then\r
4269     For W = 1 To Capture * 2\r
4270         Write #2, InHand(W)\r
4271     Next W\r
4272 End If\r
4273 Answer$ = InputBox$("Please enter a short description of the game.", "Saved Game Description", SaveTitle$)\r
4274 If Answer$ <> "" Then Write #2, Answer$ Else Write #2, "Saved Game - No Title"\r
4275 Write #2, Computer\r
4276 Write #2, Level\r
4277 Write #2, GameOver\r
4278 Write #2, Threat\r
4279 Close #2\r
4280 End Sub\r
4282 Sub SeeMoves ()\r
4284 If Board.MnuShowOn.Enabled = False Then Board.MnuShowOn.Enabled = True Else Board.MnuShowOn.Enabled = False\r
4285 If Board.MnuShowOff.Enabled = False Then Board.MnuShowOff.Enabled = True Else Board.MnuShowOff.Enabled = False\r
4286 If Board.MnuShowOn.Checked = False Then Board.MnuShowOn.Checked = True Else Board.MnuShowOn.Checked = False\r
4287 If Board.MnuShowOff.Checked = False Then Board.MnuShowOff.Checked = True Else Board.MnuShowOff.Checked = False\r
4288 If SeeMove = 1 Then\r
4289     Board.PieceID.Caption = "Show Legal Moves - On"\r
4290     Board.MnuThreatOn.Enabled = True\r
4291     If OldThreat = "On" Then\r
4292         Threat = "On"\r
4293         SetThreat\r
4294         OldThreat = "None"\r
4295     Else\r
4296         Threat = "Off"\r
4297         Board.MnuThreatOn.Enabled = False\r
4298         SetThreat\r
4299         OldThreat = "None"\r
4300     End If\r
4301 Else\r
4302     Board.PieceID.Caption = "Show Legal Moves - Off"\r
4303     OldThreat = Threat\r
4304     Threat = "Off"\r
4305     SetThreat\r
4306     Board.MnuThreatOn.Enabled = False\r
4307 End If\r
4308 Notice = 1\r
4309 End Sub\r
4311 Sub SetAutoPromote ()\r
4312 If Board.MnuAutoOn.Enabled = False Then Board.MnuAutoOn.Enabled = True Else Board.MnuAutoOn.Enabled = False\r
4313 If Board.MnuAutoOff.Enabled = False Then Board.MnuAutoOff.Enabled = True Else Board.MnuAutoOff.Enabled = False\r
4314 If Board.MnuAutoOn.Checked = False Then Board.MnuAutoOn.Checked = True Else Board.MnuAutoOn.Checked = False\r
4315 If Board.MnuAutoOff.Checked = False Then Board.MnuAutoOff.Checked = True Else Board.MnuAutoOff.Checked = False\r
4316 If AutoPromote = 1 Then\r
4317     Board.PieceID.Caption = "Auto-Promote On"\r
4318 Else\r
4319     Board.PieceID.Caption = "Auto-Promote Off"\r
4320 End If\r
4321 Notice = 1\r
4322 End Sub\r
4324 Sub SetBlackPlayer ()\r
4326 If Board.MnuBlackPlayer.Enabled = False Then Board.MnuBlackPlayer.Enabled = True Else Board.MnuBlackPlayer.Enabled = False\r
4327 If Board.MnuBlackComp.Enabled = False Then Board.MnuBlackComp.Enabled = True Else Board.MnuBlackComp.Enabled = False\r
4328 If Board.MnuBlackPlayer.Checked = False Then Board.MnuBlackPlayer.Checked = True Else Board.MnuBlackPlayer.Checked = False\r
4329 If Board.MnuBlackComp.Checked = False Then Board.MnuBlackComp.Checked = True Else Board.MnuBlackComp.Checked = False\r
4330 If Choice = "Tai" Or Choice = "Maka" Then\r
4331     If Computer = "White" Or Computer = "Black" Or Computer = "Both" Then CompTeach Else NoCompTeach\r
4332 End If\r
4333 If Computer = "Both" Then CompVComp\r
4335 End Sub\r
4337 Sub SetClock ()\r
4338 If Notice > 0 Then Notice = Notice + 1\r
4339 If Notice = 4 And Checked <> 1 Then\r
4340     Board.PieceID.Caption = ""\r
4341     Notice = 0\r
4342     If Board.Caption <> SaveTitle$ Then Board.Caption = Cap\r
4343 End If\r
4344 Secs = Val(Right$(Elapsed$, 2))\r
4345 Mins = Val(Mid$(Elapsed$, 4, 2))\r
4346 Hrs = Val(Left$(Elapsed$, 2))\r
4347 Secs = Secs + 1\r
4348 If Secs = 60 Then Secs = 0: Mins = Mins + 1\r
4349 If Mins = 60 Then Mins = 0: Hrs = Hrs + 1\r
4350 If Hrs = 100 Then Hrs = 0\r
4351 Hours$ = LTrim$(Str$(Hrs))\r
4352 Minutes$ = LTrim$(Str$(Mins))\r
4353 Seconds$ = LTrim$(Str$(Secs))\r
4354 If Len(Hours$) = 1 Then Hours$ = "0" + Hours$\r
4355 If Len(Minutes$) = 1 Then Minutes$ = "0" + Minutes$\r
4356 If Len(Seconds$) = 1 Then Seconds$ = "0" + Seconds$\r
4357 Elapsed$ = Hours$ + ":" + Minutes$ + ":" + Seconds$\r
4358 End Sub\r
4360 Sub SetDifficulty ()\r
4362 If Grade = "Weak" Then\r
4363     Board.MnuWeak.Enabled = False\r
4364     Board.MnuWeak.Checked = True\r
4365     Board.MnuBest.Visible = False\r
4366     Board.MnuLessWeak.Enabled = True\r
4367     Board.MnuLessWeak.Checked = False\r
4368 End If\r
4369 If Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai" Then Board.MnuLessWeak.Visible = False\r
4370 If Grade = "LessWeak" Then\r
4371     Board.MnuWeak.Enabled = True\r
4372     Board.MnuWeak.Checked = False\r
4373     Board.MnuBest.Visible = False\r
4374     Board.MnuLessWeak.Enabled = False\r
4375     Board.MnuLessWeak.Checked = True\r
4376 End If\r
4377 Board.MnuBest.Visible = False\r
4378 SetGrade\r
4379 End Sub\r
4381 Sub SetEval ()\r
4383 If Board.MnuEvalOn.Enabled = False Then Board.MnuEvalOn.Enabled = True Else Board.MnuEvalOn.Enabled = False\r
4384 If Board.MnuEvalOff.Enabled = False Then Board.MnuEvalOff.Enabled = True Else Board.MnuEvalOff.Enabled = False\r
4385 If Board.MnuEvalOn.Checked = False Then Board.MnuEvalOn.Checked = True Else Board.MnuEvalOn.Checked = False\r
4386 If Board.MnuEvalOff.Checked = False Then Board.MnuEvalOff.Checked = True Else Board.MnuEvalOff.Checked = False\r
4388 End Sub\r
4390 Sub SetGeneral ()\r
4391 If GeneralInfo = 0 Then Unload RulesHelp\r
4392 GeneralInfo = 1\r
4393 For Z = 0 To 17\r
4394     RulesHelp.Title(Z).Visible = False\r
4395 Next Z\r
4396 RulesHelp.Title(9).Visible = True\r
4397 RulesHelp.CmdPiece.Visible = False\r
4398 RulesHelp.Show\r
4399 End Sub\r
4401 Sub SetGrade ()\r
4403 Select Case Grade\r
4404     Case "Weak": Level = 1\r
4405     Case "LessWeak": Level = 5\r
4406 End Select\r
4407 If Grade = "LessWeak" Then\r
4408     Select Case Choice\r
4409         Case "Micro", "Mini": Level = 12\r
4410         Case "Judkin", "Whale", "Yari", "Tori", "HeianSho": Level = 7\r
4411         Case "Wa", "Chu", "Dai", "DaiDai", "Maka", "Tai": Level = 4\r
4412         Case "Tenjiku": Level = 3\r
4413     End Select\r
4414 End If\r
4416 End Sub\r
4418 Sub SetGrafix ()\r
4420 Grafix(InitFile, InitRank) = NewGraf\r
4421 Graphnum = Pieces(Abs(Squares(InitFile, InitRank))).Graphic\r
4422 If (Squares(InitFile, InitRank) < 0 And Reverse = 0) Or (Squares(InitFile, InitRank) > 0 And Reverse = 1) Then Graphnum = Graphnum + (TotGraph / 2)\r
4423 If Choice = "Tai" Then Board.showpic(NewGraf) = TaiPieces.Pix(Graphnum - 1) Else Board.showpic(NewGraf) = Board.Pix(Graphnum - 1)\r
4424 If Reverse = 0 Then\r
4425     Board.showpic(NewGraf).Move XStart + ((InitFile - 1) * Pixels), 11 + ((InitRank - 1) * Pixels)\r
4426 Else\r
4427     Board.showpic(NewGraf).Move XStart + ((BoardSizeX - InitFile) * Pixels), 11 + ((BoardSizeY - InitRank) * Pixels)\r
4428 End If\r
4429 Board.showpic(NewGraf).Visible = True\r
4431 End Sub\r
4433 Sub SetHandicap ()\r
4434 If Reduce <> 1 Then\r
4435     Board.Caption = "Select Handicap Pieces - (Press Right Mouse Button to Start Game)"\r
4436 Else\r
4437     Board.Caption = "Select Pieces to Remove - (Press Right Mouse Button When Finished)"\r
4438 End If\r
4439 If Reduce <> 1 Then Handicap = 1\r
4440 Board.BlackClock.Caption = "00:00:00"\r
4441 Board.WhiteClock.Caption = "00:00:00"\r
4442 Board.Timer1.Enabled = False\r
4443 End Sub\r
4445 Sub SetKings ()\r
4447 BlackPrince = 0: BlackKing = 1: BlackEmperor = 0\r
4448 WhitePrince = 0: WhiteKing = 1: WhiteEmperor = 0\r
4449 For GG = 1 To BoardSizeY\r
4450     For HH = 1 To BoardSizeX\r
4451         If Squares(HH, GG) = 1 Then BlackKing = 0: BlackKingX = HH: BlackKingY = GG\r
4452         If Squares(HH, GG) = -1 Then WhiteKing = 0: WhiteKingX = HH: WhiteKingY = GG\r
4453         If Squares(HH, GG) > 0 Then\r
4454             If Pieces(Abs(Squares(HH, GG))).Name = "Prince" Or Pieces(Abs(Squares(HH, GG))).Name = "Crown Prince" Then BlackPrince = BlackPrince + 1\r
4455             If Pieces(Abs(Squares(HH, GG))).Name = "Emperor" Then BlackEmperor = 1: BlackEmpX = HH: BlackEmpY = GG\r
4456         End If\r
4457         If Squares(HH, GG) < 0 Then\r
4458             If Pieces(Abs(Squares(HH, GG))).Name = "Prince" Or Pieces(Abs(Squares(HH, GG))).Name = "Crown Prince" Then WhitePrince = WhitePrince + 1\r
4459             If Pieces(Abs(Squares(HH, GG))).Name = "Emperor" Then WhiteEmperor = 1: WhiteEmpX = HH: WhiteEmpY = GG\r
4460         End If\r
4461     Next HH\r
4462 Next GG\r
4463 End Sub\r
4465 Sub SetLastMove ()\r
4467 If Board.MnuShowLastOn.Enabled = False Then Board.MnuShowLastOn.Enabled = True Else Board.MnuShowLastOn.Enabled = False\r
4468 If Board.MnuShowLastOff.Enabled = False Then Board.MnuShowLastOff.Enabled = True Else Board.MnuShowLastOff.Enabled = False\r
4469 If Board.MnuShowLastOn.Checked = False Then Board.MnuShowLastOn.Checked = True Else Board.MnuShowLastOn.Checked = False\r
4470 If Board.MnuShowLastOff.Checked = False Then Board.MnuShowLastOff.Checked = True Else Board.MnuShowLastOff.Checked = False\r
4471 End Sub\r
4473 Sub SetLionHawk ()\r
4474     If Board.MnuLVer1.Enabled = False Then Board.MnuLVer1.Enabled = True Else Board.MnuLVer1.Enabled = False\r
4475     If Board.MnuLVer2.Enabled = False Then Board.MnuLVer2.Enabled = True Else Board.MnuLVer2.Enabled = False\r
4476     If Board.MnuLVer1.Checked = False Then Board.MnuLVer1.Checked = True Else Board.MnuLVer1.Checked = False\r
4477     If Board.MnuLVer2.Checked = False Then Board.MnuLVer2.Checked = True Else Board.MnuLVer2.Checked = False\r
4478 End Sub\r
4480 Sub SetPieces ()\r
4481    \r
4482    Randomize\r
4483    XA = 0: GameOver = 0: LegalMoves = 0: OldThreat = "None"\r
4484    If Reload <> 1 Then ConfigLoad Else ConfigLoad2\r
4485    Reload = 1: Influence = 0: CompMove = 0: Evaluate = 0\r
4486    LionPiece = -1: CheckTest = 0: Checked = 0\r
4487    Datafile = Direct + "\Data\" + Choice + ".dat"\r
4488    Turn = "Black": LionPiece = -1: WhiteKing = 0: BlackKing = 0: WhitePrince = 0: BlackPrince = 0: RealLion = 0\r
4489    HandGame = 0: WhiteLion = 0: BlackLion = 0: WhiteEmperor = 0: BlackEmperor = 0: Taken = 0: Mate = 0\r
4490    CMove$ = "": TurnCount = 0: EndTurn = 0: MoveCount = 0\r
4491    Board.LastMove.Caption = "": Board.NextMove.Caption = "Black to Move"\r
4492    If Reverse <> 1 Then Reverse = 0\r
4493    XStart = 110\r
4494    If Choice = "Tenjiku" Then Computer = "None"\r
4495    If Choice = "Chu" Or Choice = "Dai" Or Choice = "DaiDai" Or Choice = "Maka" Or Choice = "Tai" Then Grade = "Weak": SetDifficulty\r
4496    If Choice = "Whale" Or Choice = "Judkin" Then XStart = 140\r
4497    If Choice = "Mini" Then XStart = 170\r
4498    If Choice = "Micro" Then XStart = 200\r
4499    If Choice = "Yari" Then XStart = 157\r
4500    ReDim ShortScore(4000)\r
4501    ReDim Score(4000)\r
4502    ReDim Captures(4000)\r
4504    Open Datafile For Input As #1\r
4505      \r
4506      '  load general game data\r
4508      Input #1, Cap, Boardbmp, Drop, Boardsize, Prom, PromDotY\r
4509      Input #1, XCorner, YCorner, Pixels, Totpiece, PieceNum, TotGraph\r
4510      BoardSizeX = Boardsize: BoardSizeY = Boardsize\r
4511      If Choice = "HShogi" Then BoardSizeY = 8\r
4512      If Choice = "Micro" Then BoardSizeY = 5\r
4513      If Choice = "Yari" Then BoardSizeY = 9: BoardSizeX = 7\r
4514      If Loading = 1 Then\r
4515          Input #2, Drop, MoveCount, Turn, Notate, SeeMove, TurnCount, WhiteKing, BlackKing\r
4516          Input #2, WhiteLion, BlackLion, WhitePrince, BlackPrince, WhiteEmperor, BlackEmperor, LastGo$\r
4517          Input #2, WhiteTime$, BlackTime$, HandGame, Reverse\r
4518          EndTurn = TurnCount\r
4519          Board.LastMove.Caption = LastGo$\r
4520          Board.WhiteClock.Caption = WhiteTime$\r
4521          Board.BlackClock.Caption = BlackTime$\r
4522          If GameOver = 1 Then\r
4523             Board.NextMove.Caption = "Game Ended"\r
4524          Else\r
4525             If Turn = "White" Then Board.NextMove.Caption = "White to Move"\r
4526          End If\r
4527          For W = 0 To TurnCount\r
4528              Input #2, Score(W).Caption, Score(W).IDStart, Score(W).IDEnd, Score(W).PosStart, Score(W).PosEnd\r
4529              Input #2, Captures(W).number\r
4530              For V = 1 To Captures(W).number\r
4531                  Input #2, Captures(W).Positions(V)\r
4532                  Input #2, Captures(W).PieceNum(V)\r
4533              Next V\r
4534          Next W\r
4535      Else\r
4536          Board.MnuHandicap.Enabled = True\r
4537      End If\r
4538      ReDim Pieces(1 To PieceNum / 2) As Piece\r
4539      ReDim TestBoard(BoardSizeX, BoardSizeY) As Integer\r
4540      ReDim Grafix(BoardSizeX, BoardSizeY) As Integer\r
4541      ReDim Squares(BoardSizeX, BoardSizeY) As Integer\r
4542      ReDim Legal(BoardSizeX, BoardSizeY) As Integer\r
4543      ReDim OldLegal(BoardSizeX, BoardSizeY) As Integer\r
4544      ReDim AreaOK(BoardSizeX, BoardSizeY) As Integer\r
4545      ReDim Camps(BoardSizeX, BoardSizeY) As Integer\r
4546      ReDim Comp(BoardSizeX, BoardSizeY) As Integer\r
4547      ReDim Clearing(200) As Empty\r
4548      ReDim BanMap(BoardSizeX, BoardSizeY) As Map\r
4549      ReDim BackMap(BoardSizeX, BoardSizeY) As Map\r
4550      ReDim Attacker(BoardSizeX, BoardSizeY) As Integer\r
4551      ReDim OldAttack(BoardSizeX, BoardSizeY) As Integer\r
4552      ReDim PieceMask(6, Pixels)\r
4553      ReDim CompLegal(2000) As LegalList\r
4554      ReDim KingTally(2000) As Long\r
4555      ReDim LowBlack(BoardSizeX, BoardSizeY) As Integer\r
4556      ReDim LowWhite(BoardSizeX, BoardSizeY) As Integer\r
4557      If Choice = "Wa" And Loading <> 1 Then WaDrop\r
4558      If Choice = "Wa" And Drop = 1 Then Boardbmp = "WaBoard2.bmp"\r
4559      Board.Picture = LoadPicture(Direct + "\Data\" + Boardbmp)\r
4560      Board.Caption = Cap\r
4561      \r
4562      ' load piece data\r
4564      For I = 1 To PieceNum / 2\r
4565         Input #1, Pieces(I).number, Pieces(I).Name\r
4566         Input #1, Pieces(I).sname, Pieces(I).Value\r
4567         Input #1, Pieces(I).PrValue, Pieces(I).Promotes, Pieces(I).Graphic\r
4568         Input #1, Pieces(I).PrGraphic\r
4569         For J = 1 To 8\r
4570             Input #1, Pieces(I).Moves(J)\r
4571         Next J\r
4572         Input #1, Pieces(I).special\r
4573         Input #1, Pieces(I).Mask\r
4574         Input #1, Pieces(I).Range\r
4575      Next I\r
4577      ' load board data\r
4579      Count = 0: M = 0\r
4580      For J = 1 To BoardSizeY\r
4581         For I = 1 To BoardSizeX\r
4582             Input #1, Squares(I, J)\r
4583             If Loading = 1 Then Input #2, Squares(I, J)\r
4584             Grafix(I, J) = -1\r
4585             If Squares(I, J) <> 0 Then\r
4586                 Graphnum = Pieces(Abs(Squares(I, J))).Graphic\r
4587                 If (Squares(I, J) < 0 And Reverse = 0) Or (Squares(I, J) > 0 And Reverse = 1) Then Graphnum = Graphnum + (TotGraph / 2)\r
4588                 If Choice = "Tai" Then Board.showpic(Count) = TaiPieces.Pix(Graphnum - 1) Else Board.showpic(Count) = Board.Pix(Graphnum - 1)\r
4589                 If Reverse = 0 Then\r
4590                     Board.showpic(Count).Move XStart + ((I - 1) * Pixels), 11 + ((J - 1) * Pixels)\r
4591                 Else\r
4592                     Board.showpic(Count).Move XStart + ((BoardSizeX - I) * Pixels), 11 + ((BoardSizeY - J) * Pixels)\r
4593                 End If\r
4594                 Board.showpic(Count).Visible = True\r
4595                 Grafix(I, J) = Count\r
4596                 Count = Count + 1\r
4597             End If\r
4598         Next I\r
4599      Next J\r
4601 'Load Drop Data\r
4603   If Drop = 1 Or Choice = "Wa" Then\r
4604      If Loading = 1 Then\r
4605          For K = Count To Totpiece\r
4606              Board.showpic(K).Visible = False\r
4607          Next K\r
4608      End If\r
4609      Input #1, Capture\r
4610      ReDim CapRef(Capture * 2) As Integer\r
4611      ReDim InHand(Capture * 2) As Integer\r
4612      ReDim CompHeld(Capture * 2) As Integer\r
4613      ReDim OldHand(Capture * 2) As Integer\r
4614      For I = 1 To Capture\r
4615         Input #1, CapRef(I)\r
4616         CapRef(I + Capture) = 0 - CapRef(I)\r
4617      Next I\r
4618      If Reverse = 0 Then\r
4619          Board.White.Picture = LoadPicture(Direct + "\Data\" + "WhiteDn.bmp")\r
4620          Board.Black.Picture = LoadPicture(Direct + "\Data\" + "BlackUp.bmp")\r
4621      Else\r
4622          Board.White.Picture = LoadPicture(Direct + "\Data\" + "WhiteUp.bmp")\r
4623          Board.Black.Picture = LoadPicture(Direct + "\Data\" + "BlackDn.bmp")\r
4624          For I = 1 To Capture * 2\r
4625             CapRef(I) = 0 - CapRef(I)\r
4626          Next I\r
4627      End If\r
4628      For I = 1 To Capture * 2\r
4629         InHand(I) = 0\r
4630         If Loading = 1 Then Input #2, InHand(I)\r
4631         Graphnum = Pieces(Abs(CapRef(I))).Graphic\r
4632         If I > Capture Then Graphnum = Graphnum + (TotGraph / 2)\r
4633         Board.HandPic(I) = Board.Pix(Graphnum - 1)\r
4634         Board.HandPic(I).Visible = False\r
4635         Board.Held(I).Caption = ""\r
4636         If Loading = 1 And InHand(I) > 0 Then Board.HandPic(I).Visible = True\r
4637         If Loading = 1 And InHand(I) > 1 Then Board.Held(I).Caption = InHand(I)\r
4638         If Choice <> "Wa" And Choice <> "Micro" Then\r
4639             If I <= Capture Then\r
4640                 X = 629 - Pixels\r
4641                 Y = 11 + (I - 1) * Pixels\r
4642             Else\r
4643                 X = 10\r
4644                 Y = 11 + (Capture - I + Capture) * Pixels\r
4645             End If\r
4646             Board.HandPic(I).Move X, Y\r
4647         End If\r
4648         If Choice = "Wa" Or Choice = "Micro" Then\r
4649             If I <= Capture Then\r
4650                 If I <= Capture / 2 Then\r
4651                     X = 629 - Pixels\r
4652                     Y = 11 + (I - 1) * Pixels\r
4653                 Else\r
4654                     X = 629 - (Pixels * 2)\r
4655                     Y = 11 + (I - (Capture / 2) - 1) * Pixels\r
4656                 End If\r
4657             Else\r
4658                 If I <= Capture * 1.5 Then\r
4659                     X = 10\r
4660                     Y = 11 + (Capture - I + (Capture / 2)) * Pixels\r
4661                 Else\r
4662                     X = 10 + Pixels\r
4663                     Y = 11 + (Capture - (I - (Capture / 2)) + (Capture / 2)) * Pixels\r
4664                 End If\r
4665             End If\r
4666         Board.HandPic(I).Move X, Y\r
4667         End If\r
4668      Next I\r
4669   End If\r
4670   Input #1, PieceSizes\r
4671   For J = 1 To PieceSizes\r
4672       For K = 1 To Pixels\r
4673           Input #1, PieceMask(J, K)\r
4674       Next K\r
4675   Next J\r
4676   Close #1\r
4677   SetKings\r
4678   NotSet\r
4679   Notation\r
4680   If Board.WindowState <> 2 Then\r
4681       If Choice <> "Tai" Then\r
4682         Board.Left = (screen.Width / 2) - 4860\r
4683         Board.Top = (screen.Height / 2) - 3650\r
4684       Else\r
4685         Board.Left = (screen.Width / 2) - 6075\r
4686         Board.Top = (screen.Height / 2) - 4562\r
4687       End If\r
4688   End If\r
4689   If (Display = 640 Or Choice = "Tai") And NewGame <> 1 Then\r
4690     Board.Left = 5\r
4691     Board.Top = 5\r
4692     Board.WindowState = 2\r
4693   Else\r
4694     Board.WindowState = 0\r
4695   End If\r
4696   If Choice = "Tai" Then Board.WindowState = 2\r
4697   If Loading <> 1 And Timing <> 1 Then ClocksOn\r
4698   If Board.WhiteClock.Caption <> "00:00:00" Or Board.BlackClock.Caption <> "00:00:00" Then Board.Timer1.Enabled = True\r
4699   If Timing = 1 Then ClocksOff\r
4700   If Choice = "Tai" Or Choice = "Maka" Then\r
4701     If Computer = "White" Or Computer = "Black" Or Computer = "Both" Then CompTeach Else NoCompTeach\r
4702   End If\r
4703   Board.MnuBest.Visible = False\r
4704   Board.Show\r
4705   Start.MousePointer = 0\r
4706   Start.Hide\r
4707   If Computer = "White" Or Computer = "Black" Then\r
4708     Board.MnuSwitch.Enabled = True\r
4709     Board.PieceID.Caption = "Computer plays " + Computer: Notice = 1\r
4710   Else\r
4711     Board.MnuSwitch.Enabled = False\r
4712   End If\r
4713   If Computer = Turn Or Computer = "Both" Then CompMain\r
4714 End Sub\r
4716 Sub SetRules ()\r
4717 If GeneralInfo = 1 Then Unload RulesHelp\r
4718 GeneralInfo = 0\r
4719 For Z = 0 To 17\r
4720     RulesHelp.Title(Z).Visible = False\r
4721 Next Z\r
4722 If GameNo < 10 Then RulesHelp.Title(GameNo - 1).Visible = True Else RulesHelp.Title(GameNo).Visible = True\r
4723 RulesHelp.CmdPiece.Visible = True\r
4724 RulesHelp.Show\r
4725 End Sub\r
4727 Sub SetSuggest ()\r
4728 Suggest = 1\r
4729 OldSeeMove = SeeMove\r
4730 OldComputer = Computer\r
4731 Computer = Turn\r
4732 Board.Caption = "The Computer suggests....": Notice = 5\r
4733 RealLevel = Level: Level = 1\r
4734 CompMain\r
4735 Level = RealLevel\r
4736 LegalMoves = 0\r
4738 End Sub\r
4740 Sub SetTeach ()\r
4741     If Board.MnuVer1.Enabled = False Then Board.MnuVer1.Enabled = True Else Board.MnuVer1.Enabled = False\r
4742     If Board.MnuVer2.Enabled = False Then Board.MnuVer2.Enabled = True Else Board.MnuVer2.Enabled = False\r
4743     If Board.MnuVer1.Checked = False Then Board.MnuVer1.Checked = True Else Board.MnuVer1.Checked = False\r
4744     If Board.MnuVer2.Checked = False Then Board.MnuVer2.Checked = True Else Board.MnuVer2.Checked = False\r
4745 End Sub\r
4747 Sub SetThreat ()\r
4748     If Board.MnuThreatOn.Enabled = False Then Board.MnuThreatOn.Enabled = True Else Board.MnuThreatOn.Enabled = False\r
4749     If Board.MnuThreatOff.Enabled = False Then Board.MnuThreatOff.Enabled = True Else Board.MnuThreatOff.Enabled = False\r
4750     If Board.MnuThreatOn.Checked = False Then Board.MnuThreatOn.Checked = True Else Board.MnuThreatOn.Checked = False\r
4751     If Board.MnuThreatOn.Checked = False Then Board.MnuThreatOff.Checked = True Else Board.MnuThreatOff.Checked = False\r
4752     If SeeMove = 1 And OldThreat <> "On" And OldThreat <> "Off" Then\r
4753         If Board.MnuThreatOff.Enabled = False Then Board.PieceID.Caption = "Show Influence or Threats Off"\r
4754     End If\r
4755     If OldThreat <> "On" And OldThreat <> "Off" Then\r
4756         If Board.MnuThreatOff.Enabled = True Then Board.PieceID.Caption = "Show Influence or Threats On"\r
4757     End If\r
4758     Notice = 1\r
4759 End Sub\r
4761 Sub SetWhitePlayer ()\r
4763 If Board.MnuWhitePlayer.Enabled = False Then Board.MnuWhitePlayer.Enabled = True Else Board.MnuWhitePlayer.Enabled = False\r
4764 If Board.MnuWhiteComp.Enabled = False Then Board.MnuWhiteComp.Enabled = True Else Board.MnuWhiteComp.Enabled = False\r
4765 If Board.MnuWhitePlayer.Checked = False Then Board.MnuWhitePlayer.Checked = True Else Board.MnuWhitePlayer.Checked = False\r
4766 If Board.MnuWhiteComp.Checked = False Then Board.MnuWhiteComp.Checked = True Else Board.MnuWhiteComp.Checked = False\r
4767 If Choice = "Tai" Or Choice = "Maka" Then\r
4768     If Computer = "White" Or Computer = "Black" Or Computer = "Both" Then CompTeach Else NoCompTeach\r
4769 End If\r
4770 If Computer = "Both" Then CompVComp\r
4771 End Sub\r
4773 Sub ShowMove ()\r
4775 If GameOver = 1 Or Checked > 0 Then Exit Sub\r
4776 If Squares(NewFile, NewRank) = 0 And (Range <> 1 Or Influence > 0) Then\r
4777     If Pieces(Abs(Squares(InitFile, InitRank))).special <> "T" Or M <> 1 Then\r
4778         If Pieces(Abs(Squares(InitFile, InitRank))).special = "T" Then Tetrarchs\r
4779         If Blocked <> 1 Then\r
4780             Legal(NewFile, NewRank) = 1\r
4781             Board.FillColor = &HFFFFFF\r
4782             If SeeMove = 1 Or CompMove = 1 Or Evaluate = 1 Then SeeFile = NewFile: SeeRank = NewRank: LookMove\r
4783             If Demon = 1 Then FireDemon\r
4784         End If\r
4785         Blocked = 0\r
4786     End If\r
4787     If Choice = "Tenjiku" Then CheckBurn\r
4788 Else\r
4789     If Pieces(Abs(Squares(InitFile, InitRank))).special <> "T" Or M <> 1 Then Last = 1\r
4790     If Pieces(Abs(Squares(InitFile, InitRank))).special = "T" Then Tetrarchs\r
4791     If Blocked <> 1 Then\r
4792         If (Sgn(Squares(InitFile, InitRank)) <> Sgn(Squares(NewFile, NewRank)) Or Influence > 0) And Legal(NewFile, NewRank) <> 4 And Squares(NewFile, NewRank) <> 0 Then\r
4793             If Squares(NewFile, NewRank) <> 0 And Range = 1 Then TestStrength\r
4794             If Choice = "Chu" And Pieces(Abs(Squares(NewFile, NewRank))).Name = "Lion" And Pieces(Abs(Squares(InitFile, InitRank))).Name <> "Lion" Then\r
4795                 NoLionCapture = 0\r
4796                 If Turn = "Black" Then\r
4797                     If WhiteLion = 1 Then NoLionCapture = 1\r
4798                 Else\r
4799                     If BlackLion = 1 Then NoLionCapture = 1\r
4800                 End If\r
4801             End If\r
4802             If Weaker <> 1 And NoLionCapture <> 1 Then\r
4803                 Board.FillColor = &HFF&\r
4804                 Legal(NewFile, NewRank) = 1\r
4805                 If SeeMove = 1 Then SeeFile = NewFile: SeeRank = NewRank: LookMove\r
4806                 If Demon = 1 Then FireDemon\r
4807                 If Choice = "Tenjiku" Then CheckBurn\r
4808             End If\r
4809             NoLionCapture = 0\r
4810         End If\r
4811     End If\r
4812     Blocked = 0\r
4813 End If\r
4814 End Sub\r
4816 Sub ShowProm ()\r
4818 If Computer <> Turn And Computer <> "Both" And Level <> 0 And GameOver <> 1 Then\r
4819 If Selection <> 0 Or MovePiece = 1 Then\r
4820     EndSelect\r
4821 Else\r
4822     If Handicap = 1 Or Reduce = 1 Then\r
4823         Board.Caption = Cap\r
4824         Handicap = 0: Reduce = 0\r
4825         Board.Timer1.Enabled = True\r
4826     Else\r
4827         If ClickPiece = 1 Then\r
4828             RightClick = 1\r
4829             Board.PieceID.Caption = ""\r
4830             Board.PieceID.ForeColor = &H8000&\r
4831             For K = 1 To BoardSizeY\r
4832                 For L = 1 To BoardSizeX\r
4833                     If Grafix(L, K) = I Then\r
4834                         If Pieces(Abs(Squares(L, K))).Promotes > 0 And Pieces(Abs(Squares(L, K))).Name <> "Killer Whale" Then PromName = "Promotes to " + Pieces(Abs(Pieces(Abs(Squares(L, K))).Promotes)).Name Else PromName = "Does not promote"\r
4835                         If Pieces(Abs(Squares(L, K))).Name = "Porpoise" Then PromName = "Promotes to Killer Whale"\r
4836                         Board.PieceID.Caption = PromName\r
4837                         InitFile = L: InitRank = K\r
4838                         If SeeMove = 1 And Threat = "On" Then ActingPieces\r
4839                     End If\r
4840                 Next L\r
4841             Next K\r
4842             ClickPiece = 0\r
4843         Else\r
4844             FormActing\r
4845         End If\r
4846     End If\r
4847 End If\r
4848 End If\r
4849 End Sub\r
4851 Sub SingleStep ()\r
4852 Last = 0: M = 0: NewFile = InitFile: NewRank = InitRank\r
4853 While NewFile + FileInc > 0 And NewFile + FileInc <= BoardSizeX And NewRank + RankInc > 0 And NewRank + RankInc <= BoardSizeY And M < MoveTest And Last = 0\r
4854     NewFile = NewFile + FileInc\r
4855     NewRank = NewRank + RankInc\r
4856     M = M + 1\r
4857     ShowMove\r
4858     If NewRank <= BoardSizeY And NewRank > 0 And NewFile > 0 And NewFile <= BoardSizeX Then\r
4859         If Range = 1 And Squares(NewFile, NewRank) <> 0 Then TestStrength\r
4860         If Range = 1 And Weaker = 0 Then Last = 0\r
4861     End If\r
4862     If Hook = 1 And Last <> 1 Then HookMove\r
4863 Wend\r
4864 Range = 0: Weaker = 0: Hook = 0\r
4865 End Sub\r
4867 Sub SpecialMove ()\r
4868 Select Case Pieces(Abs(Squares(InitFile, InitRank))).special\r
4869     Case "L": If LionPiece = I Then Lion2 Else Lion\r
4870     Case "T": Igui\r
4871     Case "D": Area = 2: P = InitFile: N = InitRank: AreaMove\r
4872     Case "F": Area = 3: P = InitFile: N = InitRank: AreaMove\r
4873     'Case "E":  Emperor\r
4874 End Select\r
4875 If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Vice General" Then\r
4876     Area = 3: N = InitRank: P = InitFile\r
4877     AreaMove\r
4878 End If\r
4879 End Sub\r
4881 Sub SquareReplace ()\r
4882 If MovePiece = 1 Then\r
4883     Move2\r
4884 Else\r
4885 K = 1\r
4886 Do\r
4887     L = 1\r
4888     Do\r
4889         If Grafix(L, K) = I Then\r
4890             InitFile = L\r
4891             InitRank = K\r
4892             Found = 1\r
4893        End If\r
4894        L = L + 1\r
4895     Loop Until L > BoardSizeX Or Found = 1\r
4896     K = K + 1\r
4897 Loop Until K > BoardSizeY Or Found = 1\r
4898 Found = 0\r
4899 Victim$ = Pieces(Abs(Squares(InitFile, InitRank))).Name\r
4900 If Squares(InitFile, InitRank) > 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then BlackPrince = BlackPrince - 1\r
4901 If Squares(InitFile, InitRank) < 0 And (Victim$ = "Prince" Or Victim$ = "Crown Prince") Then WhitePrince = WhitePrince - 1\r
4902 Squares(InitFile, InitRank) = Selection\r
4903 Board.showpic(Grafix(InitFile, InitRank)).Visible = False\r
4904 Board.showpic(Grafix(InitFile, InitRank)).Move 0, 0\r
4905 NewGraf = Grafix(InitFile, InitRank)\r
4906 SetGrafix\r
4907 Reduce = 0: MovePiece = 0\r
4908 End If\r
4909 End Sub\r
4911 Sub StartUp ()\r
4912 Select Case Choice\r
4913   Case "Micro": GameName = "Micro": GameNo = 14: Load Micro: Set Board = Micro\r
4914   Case "Whale": GameName = "Whale": GameNo = 15: Load Whale: Set Board = Whale\r
4915   Case "Shogi": GameName = "": GameNo = 2: Load Shogi: Set Board = Shogi\r
4916   Case "Tori": GameName = "Bird": GameNo = 1: Load Tori: Set Board = Tori\r
4917   Case "Sho": GameName = "Little": GameNo = 11: Load Shogi: Set Board = Shogi\r
4918   Case "Wa": GameName = "Wa": GameNo = 3: Load Wa: Set Board = Wa\r
4919   Case "Chu": GameName = "Middle": GameNo = 4: Load Chu: Set Board = Chu\r
4920   Case "Dai": GameName = "Great": GameNo = 5: Load Dai: Set Board = Dai\r
4921   Case "Tenjiku": GameName = "Exotic": GameNo = 6: Load Tenjiku: Set Board = Tenjiku\r
4922   Case "DaiDai": GameName = "Great Great": GameNo = 7: Load DaiDai: Set Board = DaiDai\r
4923   Case "Maka": GameName = "Ultra Great Great": GameNo = 8: Load Maka: Set Board = Maka\r
4924   Case "Tai": GameName = "Grand": GameNo = 9: Load Tai: Set Board = Tai\r
4925   Case "HShogi": GameName = "Early": GameNo = 12: Load HeianSho: Set Board = HeianSho\r
4926   Case "Heian": GameName = "Early Great": GameNo = 10: Load Heian: Set Board = Heian\r
4927   Case "Mini": GameName = "Mini": GameNo = 13: Load Mini: Set Board = Mini\r
4928   Case "Yari": GameName = "Yari": GameNo = 16: Load Yari: Set Board = Yari\r
4929   Case "Judkin": GameName = "Judkin's": GameNo = 17: Load Judkin: Set Board = Judkin\r
4930 End Select\r
4931 SetPieces\r
4932 If OldChoice <> Choice Then\r
4933   Select Case OldChoice\r
4934     Case "Micro": Unload Micro\r
4935     Case "Whale": Unload Whale\r
4936     Case "Sho": Unload Shogi\r
4937     Case "Shogi": Unload Shogi\r
4938     Case "Tori": Unload Tori\r
4939     Case "Wa": Unload Wa\r
4940     Case "Chu": Unload Chu\r
4941     Case "Dai": Unload Dai\r
4942     Case "Tenjiku": Unload Tenjiku\r
4943     Case "DaiDai": Unload DaiDai\r
4944     Case "Maka": Unload Maka\r
4945     Case "Tai": Unload Tai: Unload TaiPieces\r
4946     Case "Heian": Unload Heian\r
4947     Case "HShogi": Unload HeianSho\r
4948     Case "Mini": Unload Mini\r
4949     Case "Yari": Unload Yari\r
4950     Case "Judkin": Unload Judkin\r
4951 End Select\r
4952 Else\r
4953     Board.MousePointer = 0\r
4954 End If\r
4955 End Sub\r
4957 Sub SuggestMove ()\r
4959 SeeMove = OldSeeMove\r
4960 Suggest = 0\r
4961 Computer = OldComputer\r
4962 Board.ForeColor = &HFF&\r
4963 Board.FillStyle = 1\r
4964 Board.DrawWidth = 2\r
4965 Board.ForeColor = &HFFFFFF\r
4966 If CompLegal(BestMove).StartFile <> 0 Then\r
4967     If Reverse = 0 Then\r
4968         Board.Line (XStart - 1 + ((CompLegal(BestMove).StartFile - 1) * Pixels), 10 + ((CompLegal(BestMove).StartRank - 1) * Pixels))-(XStart - 1 + (CompLegal(BestMove).StartFile * Pixels), 10 + (CompLegal(BestMove).StartRank * Pixels)), , B\r
4969     Else\r
4970         Board.Line (XStart - 1 + (BoardSizeX - CompLegal(BestMove).StartFile) * Pixels, 10 + ((BoardSizeY - CompLegal(BestMove).StartRank) * Pixels))-(XStart - 1 + ((BoardSizeX - CompLegal(BestMove).StartFile + 1) * Pixels), 10 + ((BoardSizeY - CompLegal(BestMove).StartRank + 1) * Pixels)), , B\r
4971     End If\r
4972 Else\r
4973     For HH = 1 To Capture * 2\r
4974         If CapRef(HH) = CompLegal(BestMove).EndPiece Then II = HH\r
4975     Next HH\r
4976     If Choice <> "Wa" And Choice <> "Micro" Then\r
4977         If II <= Capture Then\r
4978             X = 629 - Pixels\r
4979             Y = 11 + (II - 1) * Pixels\r
4980         Else\r
4981             X = 10\r
4982             Y = 11 + (Capture - II + Capture) * Pixels\r
4983         End If\r
4984         Board.Line (X, Y)-(X + Pixels, Y + Pixels), , B\r
4985     End If\r
4986     If Choice = "Wa" Or Choice = "Micro" Then\r
4987     If II <= Capture Then\r
4988         If II <= Capture / 2 Then\r
4989             X = 629 - Pixels\r
4990             Y = 11 + (II - 1) * Pixels\r
4991         Else\r
4992             X = 629 - (Pixels * 2)\r
4993             Y = 11 + (II - (Capture / 2) - 1) * Pixels\r
4994         End If\r
4995     Else\r
4996         If II <= Capture * 1.5 Then\r
4997             X = 10\r
4998             Y = 11 + (Capture - II + (Capture / 2)) * Pixels\r
4999         Else\r
5000             X = 10 + Pixels\r
5001             Y = 11 + (Capture - (II - (Capture / 2)) + (Capture / 2)) * Pixels\r
5002         End If\r
5003     End If\r
5004     Board.Line (X, Y)-(X + Pixels, Y + Pixels), , B\r
5005 End If\r
5006 End If\r
5007 Board.FillStyle = 0\r
5008 Board.DrawWidth = 1\r
5009 Board.ForeColor = &H0&\r
5010 If Reverse = 0 Then\r
5011     Board.Circle (XStart + ((CompLegal(BestMove).EndFile - 1) * Pixels) + (Pixels / 2), 11 + ((CompLegal(BestMove).EndRank - 1) * Pixels) + (Pixels / 2)), Pixels / 4\r
5012 Else\r
5013     Board.Circle (XStart + ((BoardSizeX - CompLegal(BestMove).EndFile) * Pixels) + (Pixels / 2), 11 + ((BoardSizeY - CompLegal(BestMove).EndRank) * Pixels) + (Pixels / 2)), Pixels / 4\r
5014 End If\r
5015 For MM = 1 To BoardSizeY\r
5016     For GG = 1 To BoardSizeX\r
5017         Squares(GG, MM) = Comp(GG, MM)\r
5018     Next GG\r
5019 Next MM\r
5020 ResetLegal\r
5021 End Sub\r
5023 Sub SwitchCompPlayer ()\r
5025 If LegalMoves = 0 Then\r
5026     If Computer = "White" Then\r
5027         Computer = "Black"\r
5028         Board.MnuWhitePlayer.Enabled = False: Board.MnuBlackPlayer.Enabled = True\r
5029         Board.MnuWhitePlayer.Checked = True:  Board.MnuBlackPlayer.Checked = False\r
5030         Board.MnuWhiteComp.Enabled = True: Board.MnuBlackComp.Enabled = False\r
5031         Board.MnuBlackComp.Checked = True: Board.MnuWhiteComp.Checked = False\r
5032         Board.PieceID.Caption = "Computer plays Black": Notice = 1\r
5033         If Turn = "Black" Then\r
5034             FirstSeeMove = SeeMove\r
5035             SeeMove = 1\r
5036             CompMain\r
5037             SeeMove = FirstSeeMove\r
5038         End If\r
5039     Else\r
5040         Computer = "White"\r
5041         Board.MnuWhitePlayer.Enabled = True: Board.MnuBlackPlayer.Enabled = False\r
5042         Board.MnuWhitePlayer.Checked = False:  Board.MnuBlackPlayer.Checked = True\r
5043         Board.MnuWhiteComp.Enabled = False: Board.MnuBlackComp.Enabled = True\r
5044         Board.MnuBlackComp.Checked = False: Board.MnuWhiteComp.Checked = True\r
5045         Board.PieceID.Caption = "Computer plays White": Notice = 1\r
5046         If Turn = "White" Then\r
5047             FirstSeeMove = SeeMove\r
5048             SeeMove = 1\r
5049             CompMain\r
5050             SeeMove = FirstSeeMove\r
5051         End If\r
5052     End If\r
5053 End If\r
5054 End Sub\r
5056 Sub Take2 ()\r
5057 If (LegalMoves = 0 Or Checked = 2) And LionPiece <> I And XA = 0 Then\r
5058 If TurnCount > 0 Then\r
5059     GameOver = 0\r
5060     TurnCount = TurnCount - 1\r
5061     Location = Score(TurnCount).PosEnd\r
5062     If Location > 0 Then\r
5063         Rank = Int(Location / (BoardSizeX + 1))\r
5064         File = Location - (Rank * (BoardSizeX + 1))\r
5065         Squares(File, Rank) = Score(TurnCount).IDEnd\r
5066     End If\r
5067     Location = Score(TurnCount).PosStart\r
5068     If Location > 0 Then\r
5069         InitRank = Int(Location / (BoardSizeX + 1))\r
5070         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5071         Squares(InitFile, InitRank) = Score(TurnCount).IDStart\r
5072         If Squares(InitFile, InitRank) < 0 Then\r
5073             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then WhiteEmpX = InitFile: WhiteEmpY = InitRank\r
5074             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then WhiteKingX = InitFile: WhiteKingY = InitRank\r
5075         End If\r
5076         If Squares(InitFile, InitRank) > 0 Then\r
5077             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then BlackEmpX = InitFile: BlackEmpY = InitRank\r
5078             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then BlackKingX = InitFile: BlackKingY = InitRank\r
5079         End If\r
5080    End If\r
5081    If InitFile <> File Or InitRank <> Rank Then Squares(File, Rank) = 0\r
5082    If Score(TurnCount).IDEnd <> 0 Then\r
5083         If Score(TurnCount).PosStart = 0 Then\r
5084             CaptPiece = Score(TurnCount).IDEnd\r
5085             Squares(File, Rank) = 0\r
5086             AddHand3\r
5087         End If\r
5088     End If\r
5089     For V = 1 To Captures(TurnCount).number\r
5090         Location = Captures(TurnCount).Positions(V)\r
5091         InitRank = Int(Location / (BoardSizeX + 1))\r
5092         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5093         Squares(InitFile, InitRank) = Captures(TurnCount).PieceNum(V)\r
5094     Next V\r
5095     If Drop = 1 And Captures(TurnCount).number > 0 Then ReduceHand2\r
5096     If Turn = "Black" Then\r
5097         Turn = "White"\r
5098         Board.NextMove.Caption = "White to Move"\r
5099     Else\r
5100         MoveCount = MoveCount - 1: Turn = "Black"\r
5101         Board.NextMove.Caption = "Black to Move"\r
5102     End If\r
5103     If TurnCount = 0 Then\r
5104         Board.LastMove.Caption = ""\r
5105         If HandGame <> 1 And Turn = "Black" Then Board.MnuHandicap.Enabled = True\r
5106         If Turn = "Black" Then MoveCount = 0\r
5107     Else\r
5108         If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
5109             Board.LastMove.Caption = Score(TurnCount).Caption\r
5110         Else\r
5111             Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
5112         End If\r
5113     End If\r
5114     Backwards = 1\r
5115 End If\r
5116 End If\r
5118 End Sub\r
5120 Sub TakeAll ()\r
5122 If LegalMoves = 0 Then\r
5123     Do While TurnCount > 0 Or (TurnCount > 1 And HandGame <> 1)\r
5124         Take2\r
5125     Loop\r
5126     Board.Caption = Cap\r
5127     RestoreGrafix\r
5128     SetKings\r
5129 End If\r
5130 End Sub\r
5132 Sub TakeBack ()\r
5133 If (LegalMoves = 0 Or Checked = 2) And LionPiece <> I And XA = 0 Then\r
5134 Notice = 0\r
5135 Board.PieceID.Caption = ""\r
5136 If Tabbing <> 1 Then Board.Caption = Cap\r
5137 BugFix\r
5138 If TurnCount < 1 Then\r
5139     Board.PieceID.ForeColor = &HFF&\r
5140     Board.PieceID.Caption = "No moves to take back!"\r
5141     Notice = 1\r
5142 Else\r
5143     GameOver = 0\r
5144     TurnCount = TurnCount - 1\r
5145     Location = Score(TurnCount).PosEnd\r
5146     If Location > 0 Then\r
5147         Rank = Int(Location / (BoardSizeX + 1))\r
5148         File = Location - (Rank * (BoardSizeX + 1))\r
5149         Squares(File, Rank) = Score(TurnCount).IDEnd\r
5150     End If\r
5151     Location = Score(TurnCount).PosStart\r
5152     If Location > 0 Then\r
5153         InitRank = Int(Location / (BoardSizeX + 1))\r
5154         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5155         Squares(InitFile, InitRank) = Score(TurnCount).IDStart\r
5156         If Squares(InitFile, InitRank) < 0 Then\r
5157             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then WhiteEmpX = InitFile: WhiteEmpY = InitRank\r
5158             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then WhiteKingX = InitFile: WhiteKingY = InitRank\r
5159         End If\r
5160         If Squares(InitFile, InitRank) > 0 Then\r
5161             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Emperor" Then BlackEmpX = InitFile: BlackEmpY = InitRank\r
5162             If Pieces(Abs(Squares(InitFile, InitRank))).Name = "King" Then BlackKingX = InitFile: BlackKingY = InitRank\r
5163         End If\r
5164    End If\r
5165     If InitFile <> File Or InitRank <> Rank Then Squares(File, Rank) = 0\r
5166     If Score(TurnCount).IDEnd = 0 Then\r
5167         NewGraf = 0\r
5168         Do While Board.showpic(NewGraf).Visible = True\r
5169             NewGraf = NewGraf + 1\r
5170         Loop\r
5171         SetGrafix\r
5172     Else\r
5173         NewGraf = Grafix(File, Rank)\r
5174         Grafix(File, Rank) = -1\r
5175         Board.showpic(NewGraf).Visible = False\r
5176         Board.showpic(NewGraf).Move 0, 0\r
5177         If Score(TurnCount).PosStart > 0 Then\r
5178             SetGrafix\r
5179         Else\r
5180             CaptPiece = Score(TurnCount).IDEnd\r
5181             Squares(File, Rank) = 0\r
5182             AddHand\r
5183         End If\r
5184     End If\r
5185     For V = 1 To Captures(TurnCount).number\r
5186         Location = Captures(TurnCount).Positions(V)\r
5187         InitRank = Int(Location / (BoardSizeX + 1))\r
5188         InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5189         Squares(InitFile, InitRank) = Captures(TurnCount).PieceNum(V)\r
5190         NewGraf = 0\r
5191         Do While Board.showpic(NewGraf).Visible = True\r
5192             NewGraf = NewGraf + 1\r
5193         Loop\r
5194         SetGrafix\r
5195     Next V\r
5196     If Drop = 1 And Captures(TurnCount).number > 0 Then ReduceHand\r
5197     If Turn = "Black" Then\r
5198         Turn = "White"\r
5199         Board.NextMove.Caption = "White to Move"\r
5200     Else\r
5201         MoveCount = MoveCount - 1: Turn = "Black"\r
5202         Board.NextMove.Caption = "Black to Move"\r
5203     End If\r
5204     If TurnCount = 0 Then\r
5205         Board.LastMove.Caption = ""\r
5206         If HandGame <> 1 And Turn = "Black" Then Board.MnuHandicap.Enabled = True\r
5207         If Turn = "Black" Then MoveCount = 0\r
5208     Else\r
5209         If Asc(Score(TurnCount).Caption) > 47 And Asc(Score(TurnCount).Caption) < 58 Then\r
5210             Board.LastMove.Caption = Score(TurnCount).Caption\r
5211         Else\r
5212             Board.LastMove.Caption = Format$(MoveCount) + ". " + Score(TurnCount).Caption\r
5213         End If\r
5214     End If\r
5215     Backwards = 1\r
5216     SetKings\r
5217     If TurnCount > 0 Then\r
5218         Location = Score(TurnCount - 1).PosEnd\r
5219         If Location > 0 Then\r
5220             Rank = Int(Location / (BoardSizeX + 1))\r
5221             File = Location - (Rank * (BoardSizeX + 1))\r
5222         End If\r
5223         LastPieceX = File: LastPieceY = Rank\r
5224     Else\r
5225         LastPieceX = -1: LastPieceY = -1\r
5226     End If\r
5227     If Turn = Computer And Tabbing <> 1 Then\r
5228         If TurnCount > 0 Then\r
5229             TakeBack\r
5230         Else\r
5231             FirstSeeMove = SeeMove\r
5232             SeeMove = 1\r
5233             CompMain\r
5234         End If\r
5235     End If\r
5236     If Tabbing = 1 Then\r
5237         If Computer = "Black" Or Computer = "White" Then\r
5238             Board.Caption = "Move Taken Back (" + Str$(TurnCount) + " of" + Str$(EndTurn) + " ) : Press [ESC] to continue play."\r
5239         Else\r
5240             Board.Caption = "Move Taken Back (" + Str$(TurnCount) + " of" + Str$(EndTurn) + " )"\r
5241         End If\r
5242     End If\r
5243 End If\r
5244             \r
5245 End If\r
5246 End Sub\r
5248 Sub TeachingKing ()\r
5249 For Y = InitRank - 3 To InitRank + 3\r
5250     For X = InitFile - 3 To InitFile + 3\r
5251         If X > 0 And X <= BoardSizeX And Y > 0 And Y <= BoardSizeY Then\r
5252             If Squares(X, Y) = 0 Or Sgn(Squares(X, Y)) <> Sgn(Squares(InitFile, InitRank)) Then\r
5253                 If Abs(Y - InitRank) <= 1 And Abs(X - InitFile) <= 1 Then\r
5254                     Board.FillColor = &H800080\r
5255                     Legal(X, Y) = 6\r
5256                  Else\r
5257                     If Abs(Y - InitRank) = 3 Or Abs(X - InitFile) = 3 Then\r
5258                         Board.FillColor = &HFFFF00\r
5259                         Legal(X, Y) = 1\r
5260                     Else\r
5261                         Board.FillColor = &HFF0000\r
5262                         Legal(X, Y) = 2\r
5263                     End If\r
5264                 End If\r
5265                 If SeeMove = 1 Then SeeFile = X: SeeRank = Y: LookMove\r
5266             End If\r
5267         End If\r
5268     Next X\r
5269 Next Y\r
5270 End Sub\r
5272 Sub TenjikuScore1 ()\r
5273 CD = Len(FirstScore)\r
5274 For AB = 1 To CD\r
5275     If Mid(FirstScore, AB, 1) = " " Or Mid(FirstScore, AB, 1) = Chr$(10) Or Mid(FirstScore, AB, 1) = Chr$(13) Then\r
5276         FirstScore = Left(FirstScore, AB - 1) + Right(FirstScore, Len(FirstScore) - AB)\r
5277     End If\r
5278 Next AB\r
5279 End Sub\r
5281 Sub TenjikuScore2 ()\r
5282 CD = Len(SecondScore)\r
5283 For AB = 1 To CD\r
5284     If Mid(SecondScore, AB, 1) = " " Or Mid(SecondScore, AB, 1) = Chr$(10) Or Mid(SecondScore, AB, 1) = Chr$(13) Then\r
5285         FirstScore = Left(SecondScore, AB - 1) + Right(SecondScore, Len(SecondScore) - AB)\r
5286     End If\r
5287 Next AB\r
5288 End Sub\r
5290 Sub Territory ()\r
5293 If (Threat = "On" And Tilde = 0) Or (Tilde = 1 And LegalMoves = 0) Then\r
5294     If Tilde = 1 Then\r
5295         OldSeeMove = SeeMove\r
5296         SeeMove = 1\r
5297     End If\r
5298     If Tilde <> 1 Then GetSquare Else InitFile = 1\r
5299     If InitFile > 0 Then\r
5300         Influence = 2\r
5301         For AB = 1 To BoardSizeY\r
5302             For CD = 1 To BoardSizeX\r
5303                 If Squares(CD, AB) <> 0 Then\r
5304                     InitFile = CD: InitRank = AB\r
5305                     Validate\r
5306                 End If\r
5307             Next CD\r
5308         Next AB\r
5309         DisplayTerritory\r
5310         Influence = 0\r
5311     End If\r
5312     If Tilde = 1 Then SeeMove = OldSeeMove\r
5313 End If\r
5315 End Sub\r
5318 Sub TestAhead ()\r
5320 ' Find Legal Moves\r
5322 For AA = 1 To BoardSizeY\r
5323     For BB = 1 To BoardSizeX\r
5324         Squares(BB, AA) = Comp(BB, AA)\r
5325     Next BB\r
5326 Next AA\r
5327 CompMove = 1: LegalMoves = 0\r
5328 For YZ = 1 To BoardSizeY\r
5329     For VX = 1 To BoardSizeX\r
5330     If Turn = "White" Then\r
5331         If Squares(VX, YZ) < 0 Then\r
5332         InitFile = VX: InitRank = YZ\r
5333         I = Grafix(VX, YZ)\r
5334         Validate\r
5335         End If\r
5336     Else\r
5337         If Squares(VX, YZ) > 0 Then\r
5338         InitFile = VX: InitRank = YZ\r
5339         I = Grafix(VX, YZ)\r
5340         Validate\r
5341         End If\r
5342     End If\r
5343     Next VX\r
5344 DoEvents\r
5345 Next YZ\r
5347 ' Find Legal Drops\r
5349 If Drop = 1 Then\r
5350     If (Turn = "Black" And Reverse = 0) Or (Turn = "White" And Reverse = 1) Then\r
5351     For TU = 1 To Capture\r
5352         ResetLegal\r
5353         If InHand(TU) > 0 Then\r
5354         I = TU: InitFile = 0: InitRank = 0\r
5355         HeldValid\r
5356         DoEvents\r
5357         End If\r
5358     Next TU\r
5359     Else\r
5360     For TU = Capture + 1 To Capture * 2\r
5361         If InHand(TU) > 0 Then\r
5362         ResetLegal\r
5363         I = TU: InitFile = 0: InitRank = 0\r
5364         HeldValid\r
5365         DoEvents\r
5366         End If\r
5367     Next TU\r
5368     End If\r
5369 End If\r
5370 ConsiderMove\r
5371 Evaluate = 0: CompMove = 0: Influence = 0: EndMove = 0\r
5373 End Sub\r
5375 Sub TestDrop ()\r
5377 For DD = 1 To Capture * 2\r
5378     If CompLegal(BestMove).StartPiece = CapRef(DD) Then I = DD\r
5379 Next DD\r
5380 Legal(CompLegal(BestMove).EndFile, CompLegal(BestMove).EndRank) = 1\r
5382 End Sub\r
5384 Sub TestOther ()\r
5386 A$ = Pieces(Abs(Score(TurnCount).IDStart)).Name\r
5387 If A$ <> "Pawn" And A$ <> "Sparrow" And A$ <> "Sparrow Pawn" And A$ <> "Swallow" And A$ <> "Dolphin" Then\r
5388     OriginalRank = Rank: OriginalFile = File\r
5389     OldSeeMove = SeeMove: SeeMove = 0\r
5390     OriginalPiece = Squares(File, Rank): Squares(File, Rank) = 0\r
5391     Location = Score(TurnCount).PosStart\r
5392     InitRank = Int(Location / (BoardSizeX + 1))\r
5393     InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5394     Squares(InitFile, InitRank) = Score(TurnCount).IDStart\r
5395     InitFile = FirstFile: InitRank = FirstRank\r
5396     Validate\r
5397     Rank = OriginalRank: File = OriginalFile\r
5398     Location = Score(TurnCount).PosStart\r
5399     InitRank = Int(Location / (BoardSizeX + 1))\r
5400     InitFile = Location - (InitRank * (BoardSizeX + 1))\r
5401     Squares(InitFile, InitRank) = 0: Squares(File, Rank) = OriginalPiece\r
5402     SeeMove = OldSeeMove\r
5403     If Legal(File, Rank) > 0 Then Testing123 = 1 Else Testing123 = 0\r
5404 End If\r
5405 End Sub\r
5407 Sub TestStrength ()\r
5408 Weaker = 0\r
5409 If Pieces(Abs(Squares(NewFile, NewRank))).special = "G" Or Pieces(Abs(Squares(NewFile, NewRank))).special = "C" Then\r
5410     If Pieces(Abs(Squares(InitFile, InitRank))).Value <= Pieces(Abs(Squares(NewFile, NewRank))).Value Or Pieces(Abs(Squares(InitFile, InitRank))).Name = "Rook General" Then\r
5411           Weaker = 1\r
5412     End If\r
5413 End If\r
5414 End Sub\r
5416 Sub Tetrarchs ()\r
5418 If InitFile < BoardSizeX Then\r
5419 If FileInc = 1 And RankInc = 0 And M = 3 And Legal(InitFile + 1, InitRank) = 4 Then Blocked = 1\r
5420 End If\r
5421 If InitFile > 1 Then\r
5422 If FileInc = -1 And RankInc = 0 And M = 3 And Legal(InitFile - 1, InitRank) = 4 Then Blocked = 1\r
5423 End If\r
5424 End Sub\r
5426 Sub TextScore ()\r
5427 On Error Resume Next\r
5428 Board.CMDiagram.DialogTitle = "Create Text Score"\r
5429 Board.CMDiagram.Flags = &H400& Or &H800& Or &H4&\r
5430 Board.CMDiagram.Action = 2\r
5431 If Err = 32755 Then Exit Sub\r
5432 Saved$ = Board.CMDiagram.Filename\r
5434 Open Saved$ For Output As #3\r
5435 If GameName <> "" Then\r
5436     Print #3, GameName; " Shogi"\r
5437     For I = 1 To Len(GameName) + 6\r
5438     Print #3, "=";\r
5439     Next I\r
5440 Print #3,\r
5441 End If\r
5442 Print #3, SaveTitle$\r
5443 K = 0\r
5444 For W = 1 To TurnCount Step 2\r
5445     K = K + 1\r
5446     FirstScore = Score(W).Caption\r
5447     SecondScore = Score(W + 1).Caption\r
5448     Board.Caption = InStr(FirstScore, " ")\r
5449     If InStr(FirstScore, Chr$(13)) > 0 Then TenjikuScore1\r
5450     If InStr(SecondScore, Chr$(13)) > 0 Then TenjikuScore2\r
5451     If HandGame = 1 And W = 1 Then\r
5452     Print #3, "1. -  " + SecondScore + "  ";\r
5453     Else\r
5454     Print #3, K + "." + FirstScore + " " + SecondScore + "  ";\r
5455     End If\r
5456 Next W\r
5457 Close #3\r
5458 Board.Caption = "Score text file " + Board.CMDiagram.Filename + " created.": Notice = 1\r
5459 End Sub\r
5461 Sub TooSmall ()\r
5462 Response% = MsgBox("A screen size of at least 800x600 is required to play this variant. You should use Windows 'Setup' to change your screen size before attempting to play Tai Shogi.", 0, "Tai Shogi (Grand Shogi)")\r
5463 Start.Game(10).Enabled = False\r
5464 Start.Game(10).Value = False\r
5465 Start.Game(0).Value = True\r
5466 Start.MousePointer = 0\r
5467 End Sub\r
5469 Sub TwoKings ()\r
5470 For K = Rank - 1 To Rank + 1\r
5471     For L = File - 1 To File + 1\r
5472         If L > 0 And L <= BoardSizeX And K > 0 And K <= BoardSizeY Then\r
5473             If (K <> Rank Or L <> File) Then\r
5474                 If Abs(Squares(L, K)) = 1 Then\r
5475                     If Squares(L, K) = 1 Then Turn2 = "White" Else Turn2 = "Black"\r
5476                     Response% = MsgBox("You can't leave your " + Pieces(Abs(Squares(File, Rank))).Name + " in Check! ", 0, Turn2)\r
5477                     Checked = 2\r
5478                 End If\r
5479             End If\r
5480         End If\r
5481     Next L\r
5482 Next K\r
5484 End Sub\r
5486 Sub UnPromote ()\r
5487 If Computer <> Turn And Computer <> "Both" Then\r
5488 DoubleProm = 0\r
5489 If AutoPromote = 1 And ForceProm <> 1 Then\r
5490     If (Score(TurnCount - 1).IDStart <> Score(TurnCount - 1).IDEnd) And (Score(TurnCount - 1).IDEnd <> 0) Then\r
5491         For K = 1 To BoardSizeY\r
5492             For L = 1 To BoardSizeX\r
5493                 If Grafix(L, K) = I Then\r
5494                     Location = Score(TurnCount - 1).PosEnd\r
5495                     Rank = Int(Location / (BoardSizeX + 1))\r
5496                     File = Location - (Rank * (BoardSizeX + 1))\r
5497                     If L = File And K = Rank Then\r
5498                         DoubleProm = 1\r
5499                         Squares(L, K) = Score(TurnCount - 1).IDStart\r
5500                         Score(TurnCount - 1).IDEnd = Score(TurnCount - 1).IDStart\r
5501                         Graphnum = Pieces(Abs(Squares(L, K))).Graphic\r
5502                         If (Squares(L, K) < 0 And Reverse = 0) Or (Squares(L, K) > 0 And Reverse = 1) Then Graphnum = Graphnum + (TotGraph / 2)\r
5503                         If Choice = "Tai" Then Board.showpic(I) = TaiPieces.Pix(Graphnum - 1) Else Board.showpic(I) = Board.Pix(Graphnum - 1)\r
5504                         Score(TurnCount).Caption = Left(Score(TurnCount).Caption, Len(Score(TurnCount).Caption) - 1) + "="\r
5505                         ShortScore(TurnCount) = Score(TurnCount).Caption\r
5506                         Board.LastMove.Caption = Format$(MoveCount) + ". " + ShortScore(TurnCount)\r
5507                     End If\r
5508                 End If\r
5509             Next L\r
5510         Next K\r
5511     End If\r
5512 End If\r
5513 If DoubleProm = 0 Then LionIgui\r
5514 End If\r
5515 End Sub\r
5517 Sub Validate ()\r
5519 If Squares(InitFile, InitRank) <> 0 Then\r
5520     If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Dolphin" Then DolphinMove\r
5521     SpecPower$ = Pieces(Abs(Squares(InitFile, InitRank))).special\r
5522     If SpecPower$ = "F" Then Demon = 1 Else Demon = 0\r
5523     If SpecPower$ <> "" And SpecPower$ <> "L" Then SpecialMove\r
5524     If SpecPower$ <> "L" And D <> 0 And LionPiece = I And Pieces(Abs(Squares(InitFile, InitRank))).Name <> "Teaching King" Then\r
5525         LionPower2\r
5526     Else\r
5527         If LionPiece <> I Then\r
5528             For N = 1 To 8\r
5529                 Select Case N\r
5530                     Case 1: FileInc = 0: RankInc = -1\r
5531                     Case 2: FileInc = 0: RankInc = 1\r
5532                     Case 3: FileInc = -1: RankInc = 0\r
5533                     Case 4: FileInc = 1: RankInc = 0\r
5534                     Case 5: FileInc = -1: RankInc = -1\r
5535                     Case 6: FileInc = 1: RankInc = -1\r
5536                     Case 7: FileInc = -1: RankInc = 1\r
5537                     Case 8: FileInc = 1: RankInc = 1\r
5538                 End Select\r
5539                 If Squares(InitFile, InitRank) < 0 Then\r
5540                     FileInc = 0 - FileInc\r
5541                     RankInc = 0 - RankInc\r
5542                 End If\r
5543                 MoveData = Pieces(Abs(Squares(InitFile, InitRank))).Moves(N)\r
5544                 MoveTest = ((MoveData / 128) - Int(MoveData / 128)) * 128\r
5545                 If MoveTest > 0 Then SingleStep\r
5546                 MoveTest = ((MoveData / 256) - Int(MoveData / 256)) * 256\r
5547                 If MoveTest >= 128 Then Jumping\r
5548                 MoveTest = ((MoveData / 512) - Int(MoveData / 512)) * 512\r
5549                 If MoveTest >= 256 Then RangeJump\r
5550                 MoveTest = ((MoveData / 1024) - Int(MoveData / 1024)) * 1024\r
5551                 If MoveTest >= 512 Then LionPower\r
5552                 MoveTest = ((MoveData / 2048) - Int(MoveData / 2048)) * 2048\r
5553                 If MoveTest >= 1024 Then KnightJump\r
5554                 If MoveData >= 2048 Then\r
5555                     Hook = 1\r
5556                     MoveTest = 64\r
5557                     SingleStep\r
5558                 End If\r
5559             Next N\r
5560         End If\r
5561     End If\r
5562     If GameOver = 1 Or Checked > 0 Then Exit Sub\r
5563     If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Dolphin" Then\r
5564         Pieces(Abs(Squares(InitFile, InitRank))).Moves(7) = 0\r
5565         Pieces(Abs(Squares(InitFile, InitRank))).Moves(8) = 0\r
5566     End If\r
5567     If SpecPower$ = "L" Then SpecialMove\r
5568     If Pieces(Abs(Squares(InitFile, InitRank))).Name = "Teaching King" And TeachVer = 2 Then\r
5569         If LionPiece = I Then Lion Else TeachingKing\r
5570     End If\r
5571 End If\r
5572 End Sub\r
5574 Sub WaDrop ()\r
5575 Response% = MsgBox("Play Game with Drops?", 36, "Wa Shogi")\r
5576 If Response% = 6 Then\r
5577     Drop = 1\r
5578     Boardbmp = "Waboard2.bmp"\r
5579 End If\r
5580 End Sub\r