请选择 进入手机版 | 继续访问电脑版
查看: 257|回复: 0

[.NET开发] QB黑白棋

3万

主题

3万

帖子

10万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
100197
发表于 2015-11-23 17:52:07
QB 4.0环境编写
  1. CONST COPYRIGHTNUMBER = "HeiBaiQi V1.0"
  2. CONST COPYRIGHT = "Copyright (C) sosei"
  3. CONST NO = "2CFD4E6D12DA4469"
  4. CONST PROGRAMNAME = "OTHELLO"
  5. CONST REGCODELEN = 16
  6. CONST VERIFYLENGTH = 32
  7. CONST COMPUTERNAME = "Snowman"
  8. CONST E = 2.718281828459045#
  9. CONST PI = 3.141592653589793#
  10. CONST DEGREE = PI / 180
  11. CONST CIRCLEANGLE = 2 * PI
  12. CONST SECOND = 1, MINUTE = 60, HOUR = 60, HALFDAY = 12
  13. CONST DAY = 2& * HALFDAY * HOUR * MINUTE * SECOND
  14. CONST BOARDSIZE = 8
  15. CONST MAXUNITIME = 2 * MINUTE, MAXEXTRATIME = 6 * MINUTE
  16. CONST WARNTIME = 10 * SECOND
  17. CONST HUMAN = 0, COMPUTER = 1
  18. CONST OVER = -1, BLACKSIDE = 0, WHITESIDE = 1
  19. CONST BLACKWIN = -1, EQUAL = 0, WHITEWIN = 1
  20. CONST BLANK = -1, BLACKSTONE = 0, WHITESTONE = 1
  21. CONST BEFORETIME = 0, NOWTIME = 1
  22. CONST ORIGINALSCREEN = -1, BLACKSTATESCREEN = 0, WHITESTATESCREEN = 1, BOARDSCREEN = 2, BUTTONSCREEN = 3
  23. CONST EVENTOFF = -1, EVENTSTOP = 0, EVENTON = 1
  24. CONST TRAPINIT = -1, TRAPOFF = 0, TRAPON = 1
  25. CONST SET = 0, USE = 1
  26. CONST TRUE = -1, FALSE = 0
  27. CONST SHOW = 1, DISAPPEAR = 0
  28. CONST REPOSE = 0, THINK = 1, LOSE = 2, QUIET = 3, WIN = 4
  29. CONST INIT = 0, REST = 1, TURN = 2
  30. CONST FINISH = -1, RENEW = 0
  31. CONST BLACK = 0, WHITE = 3, RED = 2, BLUE = 1
  32. CONST ZEROOFCLOCKANGLE = PI / 2
  33. CONST C = 4294967296#
  34. TYPE playdata
  35. playname AS STRING * 10
  36. playtype AS INTEGER
  37. END TYPE
  38. DECLARE SUB Install ()
  39. DECLARE FUNCTION RandomNum# ()
  40. DECLARE FUNCTION ERandomNum# (n AS DOUBLE)
  41. DECLARE FUNCTION PIRandomNum# (n AS DOUBLE)
  42. DECLARE FUNCTION PasswordSwitch# (password AS DOUBLE)
  43. DECLARE SUB PasswordToPAB (password AS STRING, passworda AS DOUBLE, passwordb AS DOUBLE)
  44. DECLARE FUNCTION HexToDec# (hex AS STRING)
  45. DECLARE SUB DataLock (datastring AS STRING, password AS STRING)
  46. DECLARE SUB DataUnLock (datastring AS STRING, password AS STRING)
  47. DECLARE FUNCTION Verify$ (filenum AS INTEGER, startadd AS LONG, endadd AS LONG)
  48. DECLARE FUNCTION CheckBit ()
  49. DECLARE FUNCTION TestCode ()
  50. DECLARE SUB RandomSide (gameorder AS INTEGER, bothname() AS playdata)
  51. DECLARE SUB InputName (humanside AS INTEGER, bothname() AS playdata)
  52. DECLARE SUB othelloscreen (screentype AS INTEGER, screenstate AS INTEGER)
  53. DECLARE SUB trapcontrol (control AS INTEGER)
  54. DECLARE SUB boardinit (board() AS INTEGER)
  55. DECLARE SUB stonenumshow (board() AS INTEGER, stonenum() AS INTEGER)
  56. DECLARE SUB faceshow (nowside AS INTEGER, facetype AS INTEGER)
  57. DECLARE SUB clock (nowside AS INTEGER, clockstate AS INTEGER, recoverscreen AS INTEGER, unitime() AS LONG, extratime() AS LONG, notime AS INTEGER)
  58. DECLARE SUB turnstone (board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  59. DECLARE SUB overjudge (nowside AS INTEGER, board() AS INTEGER)
  60. DECLARE SUB humanthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  61. DECLARE SUB computerthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  62. DECLARE SUB stoneshow (stone AS INTEGER, x AS INTEGER, y AS INTEGER)
  63. DECLARE SUB lightmark (nowside AS INTEGER, background AS INTEGER, x AS INTEGER, y AS INTEGER, cursor AS INTEGER)
  64. DECLARE FUNCTION CheckPlace (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  65. DECLARE FUNCTION winsidejudge (nowside AS INTEGER, notime AS INTEGER, accpetlose AS INTEGER, stonenum() AS INTEGER)
  66. DECLARE SUB winshow (winside AS INTEGER)
  67. DECLARE SUB AdmitDefeat (accpetlose AS INTEGER)
  68. DECLARE SUB Quit (choose AS INTEGER)
  69. DECLARE SUB Recorder (bothname() AS playdata)
  70. DIM nn AS STRING
  71. DIM nowscreen AS INTEGER
  72. DIM gameorder AS INTEGER
  73. DIM timetrap AS INTEGER
  74. DIM keytrap AS INTEGER
  75. DIM bothname(BLACKSIDE TO WHITESIDE) AS playdata
  76. DIM stonenum(BLACKSIDE TO WHITESIDE) AS INTEGER
  77. DIM unitime(BLACKSIDE TO WHITESIDE, BEFORETIME TO NOWTIME) AS LONG
  78. DIM extratime(BLACKSIDE TO WHITESIDE, BEFORETIME TO NOWTIME) AS LONG
  79. DIM notime AS INTEGER
  80. DIM accpetlose AS INTEGER
  81. DIM board(1 TO BOARDSIZE, 1 TO BOARDSIZE) AS INTEGER
  82. DIM nowside AS INTEGER
  83. DIM x AS INTEGER
  84. DIM y AS INTEGER
  85. DIM winside AS INTEGER
  86. DIM choose AS INTEGER
  87. IF CheckBit = TRUE THEN
  88. IF UCASE$(COMMAND$) = "/INSTALL" THEN
  89. CALL Install
  90. END IF
  91. IF TestCode = TRUE THEN
  92. nn = STRING$(INT(LOG(BOARDSIZE * BOARDSIZE) / LOG(10#)) + 1, "#")
  93. nowscreen = ORIGINALSCREEN
  94. gameorder = 0
  95. SCREEN 1
  96. PLAY "mb"
  97. ON TIMER(SECOND) GOSUB clocklabel
  98. ON KEY(10) GOSUB keylabel
  99. DO
  100. CLS
  101. TIMER OFF
  102. timetrap = EVENTOFF
  103. KEY(10) OFF
  104. keytrap = EVENTOFF
  105. CALL trapcontrol(TRAPINIT)
  106. LOCATE 25, 3: PRINT COPYRIGHTNUMBER; " "; COPYRIGHT;
  107. CALL RandomSide(gameorder, bothname())
  108. stonenum(BLACKSIDE) = 0
  109. stonenum(WHITESIDE) = 0
  110. LOCATE 1, 1: PRINT "Name:"; bothname(BLACKSIDE).playname
  111. LOCATE 2, 1: PRINT USING "Stones:" + nn; stonenum(BLACKSIDE);
  112. CALL othelloscreen(BLACKSTATESCREEN, SET)
  113. CALL faceshow(BLACKSIDE, REPOSE)
  114. CALL clock(BLACKSIDE, INIT, FALSE, unitime(), extratime(), notime)
  115. LOCATE 11, 1: PRINT "Name:"; bothname(WHITESIDE).playname
  116. LOCATE 12, 1: PRINT USING "Stones:" + nn; stonenum(WHITESIDE);
  117. CALL othelloscreen(WHITESTATESCREEN, SET)
  118. CALL faceshow(WHITESIDE, REPOSE)
  119. CALL clock(WHITESIDE, INIT, FALSE, unitime(), extratime(), notime)
  120. CALL othelloscreen(BOARDSCREEN, SET)
  121. LOCATE 21, 1: PRINT "F10=Defeat";
  122. LOCATE 22, 19: PRINT "No:"; NO;
  123. IF gameorder = 0 THEN
  124. IF bothname(BLACKSIDE).playtype = HUMAN THEN
  125. CALL InputName(BLACKSIDE, bothname())
  126. END IF
  127. IF bothname(WHITESIDE).playtype = HUMAN THEN
  128. CALL InputName(WHITESIDE, bothname())
  129. END IF
  130. END IF
  131. CALL boardinit(board())
  132. FOR x = 1 TO BOARDSIZE
  133. FOR y = 1 TO BOARDSIZE
  134. CALL stoneshow(board(x, y), x, y)
  135. NEXT y
  136. NEXT x
  137. CALL stonenumshow(board(), stonenum())
  138. nowside = BLACKSIDE
  139. accpetlose = FALSE
  140. x = 4
  141. y = 4
  142. CALL Recorder(bothname())
  143. gameorder = gameorder + 1
  144. keytrap = EVENTON
  145. KEY(10) ON
  146. PLAY "c8d8"
  147. DO UNTIL nowside = OVER
  148. CALL faceshow(nowside, THINK)
  149. IF bothname(nowside).playtype = HUMAN THEN
  150. CALL humanthink(nowside, board(), x, y)
  151. ELSEIF bothname(nowside).playtype = COMPUTER THEN
  152. CALL computerthink(nowside, board(), x, y)
  153. END IF
  154. CALL clock(nowside, REST, FALSE, unitime(), extratime(), notime)
  155. CALL faceshow(nowside, REPOSE)
  156. CALL turnstone(board(), x, y)
  157. CALL stonenumshow(board(), stonenum())
  158. CALL overjudge(nowside, board())
  159. LOOP
  160. overlabel:
  161. TIMER OFF
  162. timetrap = EVENTOFF
  163. KEY(10) OFF
  164. keytrap = EVENTOFF
  165. winside = winsidejudge(nowside, notime, accpetlose, stonenum())
  166. CALL winshow(winside)
  167. CALL Recorder(bothname())
  168. CALL Quit(choose)
  169. LOOP UNTIL choose = FINISH
  170. PLAY "mf"
  171. SCREEN 0
  172. CLS
  173. ELSE
  174. BEEP
  175. PRINT "time code!"
  176. END IF
  177. ELSE
  178. BEEP
  179. PRINT "Found Virus!"
  180. END IF
  181. END
  182. clocklabel:
  183. timetrap = EVENTSTOP
  184. CALL clock(nowside, TURN, TRUE, unitime(), extratime(), notime)
  185. IF notime = FALSE THEN
  186. timetrap = EVENTON
  187. RETURN
  188. ELSEIF notime = TRUE THEN
  189. timetrap = EVENTOFF
  190. RETURN overlabel
  191. END IF
  192. keylabel:
  193. keytrap = EVENTOFF
  194. KEY(10) OFF
  195. CALL AdmitDefeat(accpetlose)
  196. IF accpetlose = FALSE THEN
  197. keytrap = EVENTON
  198. RETURN
  199. ELSEIF accpetlose = TRUE THEN
  200. keytrap = EVENTOFF
  201. RETURN overlabel
  202. END IF
  203. SUB AdmitDefeat (accpetlose AS INTEGER)
  204. CONST TWINKLETIME = 1 / 6
  205. DIM RefTime AS SINGLE
  206. DIM TimeBalance AS SINGLE
  207. DIM cw AS STRING * 1
  208. DIM ct AS STRING * 1
  209. DIM check AS STRING
  210. LOCATE 23, 1
  211. PRINT SPACE$(40);
  212. cw = "?"
  213. ct = " "
  214. RefTime = TIMER
  215. DO
  216. LOCATE 23, 1: PRINT "Admit defeat(Y/N)" + cw;
  217. TimeBalance = TIMER - RefTime
  218. TimeBalance = TimeBalance + DAY
  219. TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY
  220. IF TimeBalance >= TWINKLETIME THEN
  221. SWAP cw, ct
  222. RefTime = TIMER
  223. END IF
  224. check = INKEY$
  225. LOOP UNTIL check = "Y" OR check = "y" OR check = "N" OR check = "n"
  226. LOCATE 23, 1: PRINT "Admit defeat(Y/N)?" + check;
  227. IF check = "Y" OR check = "y" THEN
  228. accpetlose = TRUE
  229. ELSEIF check = "N" OR check = "n" THEN
  230. accpetlose = FALSE
  231. END IF
  232. LOCATE 23, 1
  233. PRINT SPACE$(40);
  234. END SUB
  235. SUB boardinit (board() AS INTEGER)
  236. DIM x AS INTEGER
  237. DIM y AS INTEGER
  238. FOR x = 1 TO BOARDSIZE
  239. FOR y = 1 TO BOARDSIZE
  240. board(x, y) = BLANK
  241. NEXT y
  242. NEXT x
  243. board(BOARDSIZE / 2, BOARDSIZE / 2 + 1) = BLACKSTONE
  244. board(BOARDSIZE / 2 + 1, BOARDSIZE / 2 + 1) = WHITESTONE
  245. board(BOARDSIZE / 2, BOARDSIZE / 2) = WHITESTONE
  246. board(BOARDSIZE / 2 + 1, BOARDSIZE / 2) = BLACKSTONE
  247. END SUB
  248. FUNCTION CheckBit
  249. DIM filenumber AS INTEGER
  250. DIM length AS LONG
  251. DIM newvdc AS STRING * VERIFYLENGTH
  252. DIM oldvdc AS STRING * VERIFYLENGTH
  253. filenumber = FREEFILE
  254. OPEN PROGRAMNAME + ".EXE" FOR BINARY AS filenumber
  255. length = LOF(filenumber)
  256. newvdc = Verify$(filenumber, 1, length)
  257. CLOSE filenumber
  258. filenumber = FREEFILE
  259. OPEN PROGRAMNAME + ".VDC" FOR BINARY AS filenumber
  260. length = LOF(filenumber)
  261. IF length = VERIFYLENGTH THEN
  262. GET filenumber, 1, oldvdc
  263. END IF
  264. CLOSE filenumber
  265. IF length = VERIFYLENGTH
  266. CALL DataUnLock(oldvdc, NO)
  267. IF oldvdc = newvdc THEN
  268. CheckBit = TRUE
  269. ELSE
  270. CheckBit = FALSE
  271. END IF
  272. ELSE
  273. CheckBit = FALSE
  274. END IF
  275. END FUNCTION
  276. FUNCTION CheckPlace (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  277. DIM stone AS INTEGER
  278. DIM xplus AS INTEGER
  279. DIM yplus AS INTEGER
  280. DIM xpointer AS INTEGER
  281. DIM ypointer AS INTEGER
  282. IF nowside = BLACKSIDE THEN
  283. stone = BLACKSTONE
  284. ELSEIF nowside = WHITESIDE THEN
  285. stone = WHITESTONE
  286. END IF
  287. FOR xplus = -1 TO 1
  288. FOR yplus = -1 TO 1
  289. xpointer = x + xplus
  290. ypointer = y + yplus
  291. DO WHILE (xpointer >= 1 AND xpointer <= BOARDSIZE) AND (ypointer >= 1 AND ypointer <= BOARDSIZE)
  292. IF board(xpointer, ypointer) = stone THEN
  293. IF x + xplus <> xpointer OR y + yplus <> ypointer THEN
  294. CheckPlace = TRUE
  295. EXIT FUNCTION
  296. ELSE
  297. EXIT DO
  298. END IF
  299. ELSEIF board(xpointer, ypointer) = BLANK THEN
  300. EXIT DO
  301. END IF
  302. xpointer = xpointer + xplus
  303. ypointer = ypointer + yplus
  304. LOOP
  305. NEXT yplus
  306. NEXT xplus
  307. CheckPlace = FALSE
  308. END FUNCTION
  309. SUB clock (nowside AS INTEGER, clockstate AS INTEGER, recoverscreen AS INTEGER, unitime() AS LONG, extratime() AS LONG, notime AS INTEGER) STATIC
  310. CONST SA = CIRCLEANGLE / MINUTE
  311. CONST MA = CIRCLEANGLE / HOUR
  312. CONST HA = CIRCLEANGLE / HALFDAY
  313. SHARED nowscreen AS INTEGER
  314. DIM unitclockface AS INTEGER
  315. DIM unitclockpointer AS INTEGER
  316. DIM extraclockface AS INTEGER
  317. DIM extraclockpointer AS INTEGER
  318. DIM befscreen AS INTEGER
  319. DIM a AS SINGLE
  320. DIM ot AS INTEGER
  321. DIM nt AS INTEGER
  322. DIM os AS INTEGER
  323. DIM om AS INTEGER
  324. DIM oh AS INTEGER
  325. DIM unitsecond(BLACKSIDE TO WHITESIDE) AS INTEGER
  326. DIM unitminute(BLACKSIDE TO WHITESIDE) AS INTEGER
  327. DIM unithour(BLACKSIDE TO WHITESIDE) AS INTEGER
  328. DIM extrasecond(BLACKSIDE TO WHITESIDE) AS INTEGER
  329. DIM extraminute(BLACKSIDE TO WHITESIDE) AS INTEGER
  330. DIM extrahour(BLACKSIDE TO WHITESIDE) AS INTEGER
  331. IF clockstate = INIT THEN
  332. unitime(nowside, BEFORETIME) = -1
  333. unitime(nowside, NOWTIME) = MAXUNITIME
  334. extratime(nowside, BEFORETIME) = -1
  335. extratime(nowside, NOWTIME) = MAXEXTRATIME
  336. notime = FALSE
  337. unitclockface = TRUE: unitclockpointer = TRUE
  338. extraclockface = TRUE: extraclockpointer = TRUE
  339. ELSEIF clockstate = REST THEN
  340. unitime(nowside, BEFORETIME) = unitime(nowside, NOWTIME)
  341. unitime(nowside, NOWTIME) = MAXUNITIME
  342. unitclockface = FALSE: unitclockpointer = TRUE
  343. extraclockface = FALSE: extraclockpointer = FALSE
  344. ELSEIF clockstate = TURN THEN
  345. IF unitime(nowside, NOWTIME) > 0 THEN
  346. unitime(nowside, BEFORETIME) = unitime(nowside, NOWTIME)
  347. unitime(nowside, NOWTIME) = unitime(nowside, NOWTIME) - SECOND
  348. unitclockface = FALSE: unitclockpointer = TRUE
  349. extraclockface = FALSE: extraclockpointer = FALSE
  350. ELSEIF unitime(nowside, NOWTIME) = 0 THEN
  351. extratime(nowside, BEFORETIME) = extratime(nowside, NOWTIME)
  352. extratime(nowside, NOWTIME) = extratime(nowside, NOWTIME) - SECOND
  353. unitclockface = FALSE: unitclockpointer = FALSE
  354. extraclockface = FALSE: extraclockpointer = TRUE
  355. IF extratime(nowside, NOWTIME) = 0 THEN
  356. notime = TRUE
  357. END IF
  358. END IF
  359. END IF
  360. IF recoverscreen = TRUE THEN
  361. befscreen = nowscreen
  362. END IF
  363. IF nowside = BLACKSIDE THEN
  364. CALL othelloscreen(BLACKSTATESCREEN, USE)
  365. ELSEIF nowside = WHITESIDE THEN
  366. CALL othelloscreen(WHITESTATESCREEN, USE)
  367. END IF
  368. IF unitclockface = TRUE THEN
  369. CIRCLE (11, 11), 10, WHITE: PAINT (11, 11), BLACK, WHITE
  370. CIRCLE (11, 11), .5, WHITE
  371. FOR a = ZEROOFCLOCKANGLE TO ZEROOFCLOCKANGLE - CIRCLEANGLE STEP -(CIRCLEANGLE / HALFDAY)
  372. LINE (9 * COS(a) + 11, 9 * SIN(a) + 11)-(8.5 * COS(a) + 11, 8.5 * SIN(a) + 11), WHITE
  373. NEXT a
  374. END IF
  375. IF unitclockpointer = TRUE THEN
  376. IF unitime(nowside, NOWTIME) < WARNTIME THEN
  377. IF unitime(nowside, NOWTIME) < MAXUNITIME THEN
  378. PLAY "c8"
  379. END IF
  380. END IF
  381. ot = unitime(nowside, BEFORETIME)
  382. nt = unitime(nowside, NOWTIME)
  383. IF nt <> ot THEN
  384. os = ot MOD MINUTE
  385. unitsecond(nowside) = nt MOD MINUTE
  386. a = ZEROOFCLOCKANGLE - SA * os
  387. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(7 * COS(a) + 11, 7 * SIN(a) + 11), BLACK
  388. ot = INT(ot / MINUTE)
  389. nt = INT(nt / MINUTE)
  390. IF nt <> ot THEN
  391. om = ot MOD HOUR
  392. unitminute(nowside) = nt MOD HOUR
  393. a = ZEROOFCLOCKANGLE - MA * om
  394. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(6 * COS(a) + 11, 6 * SIN(a) + 11), BLACK
  395. ot = INT(ot / HOUR)
  396. nt = INT(nt / HOUR)
  397. IF nt <> ot THEN
  398. oh = ot MOD HALFDAY
  399. unithour(nowside) = nt MOD HALFDAY
  400. a = ZEROOFCLOCKANGLE - HA * oh
  401. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(4.5 * COS(a) + 11, 4.5 * SIN(a) + 11), BLACK
  402. END IF
  403. END IF
  404. a = ZEROOFCLOCKANGLE - SA * unitsecond(nowside)
  405. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(7 * COS(a) + 11, 7 * SIN(a) + 11), RED
  406. a = ZEROOFCLOCKANGLE - MA * unitminute(nowside)
  407. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(6 * COS(a) + 11, 6 * SIN(a) + 11), BLUE
  408. a = ZEROOFCLOCKANGLE - HA * unithour(nowside)
  409. LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(4.5 * COS(a) + 11, 4.5 * SIN(a) + 11), WHITE
  410. END IF
  411. END IF
  412. IF extraclockface = TRUE THEN
  413. CIRCLE (35, 15.5), 14, WHITE: PAINT (35, 15.5), BLACK, WHITE
  414. CIRCLE (35, 15.5), .5, WHITE
  415. FOR a = ZEROOFCLOCKANGLE TO ZEROOFCLOCKANGLE - CIRCLEANGLE STEP -(CIRCLEANGLE / HALFDAY)
  416. LINE (13.5 * COS(a) + 35, 13.5 * SIN(a) + 15.5)-(12 * COS(a) + 35, 12 * SIN(a) + 15.5), WHITE
  417. NEXT a
  418. END IF
  419. IF extraclockpointer = TRUE THEN
  420. ot = extratime(nowside, BEFORETIME)
  421. nt = extratime(nowside, NOWTIME)
  422. IF nt <> ot THEN
  423. os = ot MOD MINUTE
  424. extrasecond(nowside) = nt MOD MINUTE
  425. IF extrasecond(nowside) = 0 THEN
  426. IF extratime(nowside, NOWTIME) < MAXEXTRATIME THEN
  427. PLAY "e8"
  428. END IF
  429. END IF
  430. a = ZEROOFCLOCKANGLE - SA * os
  431. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(11 * COS(a) + 35, 11 * SIN(a) + 15.5), BLACK
  432. ot = INT(ot / MINUTE)
  433. nt = INT(nt / MINUTE)
  434. IF nt <> ot THEN
  435. om = ot MOD HOUR
  436. extraminute(nowside) = nt MOD HOUR
  437. a = ZEROOFCLOCKANGLE - MA * om
  438. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(9 * COS(a) + 35, 9 * SIN(a) + 15.5), BLACK
  439. ot = INT(ot / HOUR)
  440. nt = INT(nt / HOUR)
  441. IF nt <> ot THEN
  442. oh = ot MOD HALFDAY
  443. extrahour(nowside) = nt MOD HALFDAY
  444. a = ZEROOFCLOCKANGLE - HA * oh
  445. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(7 * COS(a) + 35, 7 * SIN(a) + 15.5), BLACK
  446. END IF
  447. END IF
  448. a = ZEROOFCLOCKANGLE - SA * extrasecond(nowside)
  449. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(11 * COS(a) + 35, 11 * SIN(a) + 15.5), RED
  450. a = ZEROOFCLOCKANGLE - MA * extraminute(nowside)
  451. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(9 * COS(a) + 35, 9 * SIN(a) + 15.5), BLUE
  452. a = ZEROOFCLOCKANGLE - HA * extrahour(nowside)
  453. LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(7 * COS(a) + 35, 7 * SIN(a) + 15.5), WHITE
  454. END IF
  455. END IF
  456. IF recoverscreen = TRUE THEN
  457. CALL othelloscreen(befscreen, USE)
  458. END IF
  459. END SUB
  460. SUB computerthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  461. SHARED timetrap AS INTEGER
  462. DIM Place AS INTEGER
  463. DIM xx AS INTEGER
  464. DIM yy AS INTEGER
  465. Place = FALSE
  466. timetrap = EVENTON
  467. TIMER ON
  468. FOR xx = 1 TO BOARDSIZE
  469. FOR yy = 1 TO BOARDSIZE
  470. IF board(xx, yy) = BLANK THEN
  471. Place = CheckPlace(nowside, board(), xx, yy)
  472. IF Place = TRUE THEN
  473. TIMER OFF
  474. timetrap = EVENTOFF
  475. x = xx
  476. y = yy
  477. IF nowside = BLACKSIDE THEN
  478. board(x, y) = BLACKSTONE
  479. ELSEIF nowside = WHITESIDE THEN
  480. board(x, y) = WHITESTONE
  481. END IF
  482. CALL stoneshow(board(x, y), x, y)
  483. EXIT SUB
  484. END IF
  485. END IF
  486. NEXT yy
  487. NEXT xx
  488. END SUB
  489. SUB DataLock (datastring AS STRING, password AS STRING)
  490. DIM passworda AS DOUBLE
  491. DIM passwordb AS DOUBLE
  492. DIM datalength AS INTEGER
  493. DIM tm AS DOUBLE
  494. DIM i AS INTEGER
  495. DIM byte AS STRING * 1
  496. DIM add(1 TO 2) AS INTEGER
  497. DIM bit(1 TO 2) AS STRING * 1
  498. CALL PasswordToPAB(password, passworda, passwordb)
  499. datalength = LEN(datastring)
  500. tm = PIRandomNum#(PasswordSwitch#((passworda)))
  501. FOR i = 1 TO datalength
  502. byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * PIRandomNum#(-1)))
  503. MID$(datastring, i, 1) = byte
  504. NEXT i
  505. tm = ERandomNum#(PasswordSwitch#((passwordb)))
  506. FOR i = 1 TO datalength
  507. add(1) = FIX(datalength * ERandomNum#(-1) + 1)
  508. add(2) = FIX(datalength * ERandomNum#(-1) + 1)
  509. bit(1) = MID$(datastring, add(1), 1)
  510. bit(2) = MID$(datastring, add(2), 1)
  511. MID$(datastring, add(1), 1) = bit(2)
  512. MID$(datastring, add(2), 1) = bit(1)
  513. NEXT i
  514. tm = ERandomNum#(PasswordSwitch#((passworda)))
  515. FOR i = 1 TO datalength
  516. byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * ERandomNum#(-1)))
  517. MID$(datastring, i, 1) = byte
  518. NEXT i
  519. tm = PIRandomNum#(PasswordSwitch#((passwordb)))
  520. FOR i = 1 TO datalength
  521. add(1) = FIX(datalength * PIRandomNum#(-1) + 1)
  522. add(2) = FIX(datalength * PIRandomNum#(-1) + 1)
  523. bit(1) = MID$(datastring, add(1), 1)
  524. bit(2) = MID$(datastring, add(2), 1)
  525. MID$(datastring, add(1), 1) = bit(2)
  526. MID$(datastring, add(2), 1) = bit(1)
  527. NEXT i
  528. tm = ERandomNum#((passworda))
  529. tm = PIRandomNum#((passworda))
  530. FOR i = 1 TO datalength
  531. add(1) = FIX(datalength * ERandomNum#(-1) + 1)
  532. add(2) = FIX(datalength * ERandomNum#(-1) + 1)
  533. bit(1) = MID$(datastring, add(1), 1)
  534. bit(2) = MID$(datastring, add(2), 1)
  535. bit(1) = CHR$(ASC(bit(1)) XOR FIX(256 * PIRandomNum#(-1)))
  536. bit(2) = CHR$(ASC(bit(2)) XOR FIX(256 * PIRandomNum#(-1)))
  537. MID$(datastring, add(1), 1) = bit(2)
  538. MID$(datastring, add(2), 1) = bit(1)
  539. NEXT i
  540. tm = PIRandomNum#((passwordb))
  541. tm = ERandomNum#((passwordb))
  542. FOR i = 1 TO datalength
  543. add(1) = FIX(datalength * PIRandomNum#(-1) + 1)
  544. add(2) = FIX(datalength * PIRandomNum#(-1) + 1)
  545. bit(1) = MID$(datastring, add(1), 1)
  546. bit(2) = MID$(datastring, add(2), 1)
  547. bit(1) = CHR$(ASC(bit(1)) XOR FIX(256 * ERandomNum#(-1)))
  548. bit(2) = CHR$(ASC(bit(2)) XOR FIX(256 * ERandomNum#(-1)))
  549. MID$(datastring, add(1), 1) = bit(2)
  550. MID$(datastring, add(2), 1) = bit(1)
  551. NEXT i
  552. END SUB
  553. SUB DataUnLock (datastring AS STRING, password AS STRING)
  554. DIM passworda AS DOUBLE
  555. DIM passwordb AS DOUBLE
  556. DIM datalength AS INTEGER
  557. DIM tm AS DOUBLE
  558. DIM i AS INTEGER
  559. DIM bit(1 TO 2) AS STRING * 1
  560. DIM byte AS STRING * 1
  561. datalength = LEN(datastring)
  562. DIM add(1 TO datalength, 1 TO 2) AS INTEGER
  563. DIM rn(1 TO datalength, 1 TO 2) AS STRING * 1
  564. CALL PasswordToPAB(password, passworda, passwordb)
  565. tm = PIRandomNum#((passwordb))
  566. tm = ERandomNum#((passwordb))
  567. FOR i = 1 TO datalength
  568. add(1, i) = FIX(datalength * PIRandomNum#(-1) + 1)
  569. add(2, i) = FIX(datalength * PIRandomNum#(-1) + 1)
  570. rn(i, 1) = CHR$(FIX(256 * ERandomNum#(-1)))
  571. rn(i, 2) = CHR$(FIX(256 * ERandomNum#(-1)))
  572. NEXT i
  573. FOR i = datalength TO 1 STEP -1
  574. bit(1) = MID$(datastring, add(i, 2), 1)
  575. bit(2) = MID$(datastring, add(i, 1), 1)
  576. bit(1) = CHR$(ASC(bit(1)) XOR ASC(rn(i, 1)))
  577. bit(2) = CHR$(ASC(bit(2)) XOR ASC(rn(i, 2)))
  578. MID$(datastring, add(i, 1), 1) = bit(1)
  579. MID$(datastring, add(i, 2), 1) = bit(2)
  580. NEXT i
  581. tm = ERandomNum#((passworda))
  582. tm = PIRandomNum#((passworda))
  583. FOR i = 1 TO datalength
  584. add(i, 1) = FIX(datalength * ERandomNum#(-1) + 1)
  585. add(i, 2) = FIX(datalength * ERandomNum#(-1) + 1)
  586. rn(i, 1) = CHR$(FIX(256 * PIRandomNum#(-1)))
  587. rn(i, 2) = CHR$(FIX(256 * PIRandomNum#(-1)))
  588. NEXT i
  589. FOR i = datalength TO 1 STEP -1
  590. bit(1) = MID$(datastring, add(i, 2), 1)
  591. bit(2) = MID$(datastring, add(i, 1), 1)
  592. bit(1) = CHR$(ASC(bit(1)) XOR ASC(rn(i, 1)))
  593. bit(2) = CHR$(ASC(bit(2)) XOR ASC(rn(i, 2)))
  594. MID$(datastring, add(i, 1), 1) = bit(1)
  595. MID$(datastring, add(i, 2), 1) = bit(2)
  596. NEXT i
  597. tm = PIRandomNum#(PasswordSwitch#((passwordb)))
  598. FOR i = 1 TO datalength
  599. add(i, 1) = FIX(datalength * PIRandomNum#(-1) + 1)
  600. add(i, 2) = FIX(datalength * PIRandomNum#(-1) + 1)
  601. NEXT i
  602. FOR i = datalength TO 1 STEP -1
  603. bit(1) = MID$(datastring, add(i, 2), 1)
  604. bit(2) = MID$(datastring, add(i, 1), 1)
  605. MID$(datastring, add(i, 1), 1) = bit(1)
  606. MID$(datastring, add(i, 2), 1) = bit(2)
  607. NEXT i
  608. tm = ERandomNum#(PasswordSwitch#((passworda)))
  609. FOR i = 1 TO datalength
  610. byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * ERandomNum#(-1)))
  611. MID$(datastring, i, 1) = byte
  612. NEXT i
  613. tm = ERandomNum#(PasswordSwitch#((passwordb)))
  614. FOR i = 1 TO datalength
  615. add(i, 1) = FIX(datalength * ERandomNum#(-1) + 1)
  616. add(i, 2) = FIX(datalength * ERandomNum#(-1) + 1)
  617. NEXT i
  618. FOR i = datalength TO 1 STEP -1
  619. bit(1) = MID$(datastring, add(i, 2), 1)
  620. bit(2) = MID$(datastring, add(i, 1), 1)
  621. MID$(datastring, add(i, 1), 1) = bit(1)
  622. MID$(datastring, add(i, 2), 1) = bit(2)
  623. NEXT i
  624. tm = PIRandomNum#(PasswordSwitch#((passworda)))
  625. FOR i = 1 TO datalength
  626. byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * PIRandomNum#(-1)))
  627. MID$(datastring, i, 1) = byte
  628. NEXT i
  629. END SUB
  630. FUNCTION ERandomNum# (n AS DOUBLE)
  631. STATIC x AS DOUBLE
  632. SELECT CASE n
  633. CASE IS >= 0
  634. x = LOG(n + PI)
  635. CASE IS < 0
  636. x = LOG(x * C + PI)
  637. END SELECT
  638. x = x / 10 ^ INT(LOG(x) / LOG(10#) - 4)
  639. x = x - FIX(x)
  640. ERandomNum# = x
  641. END FUNCTION
  642. SUB faceshow (nowside AS INTEGER, facetype AS INTEGER)
  643. DIM forecolor AS INTEGER
  644. DIM backcolor AS INTEGER
  645. IF nowside = BLACKSIDE THEN
  646. CALL othelloscreen(BLACKSTATESCREEN, USE)
  647. ELSEIF nowside = WHITESIDE THEN
  648. CALL othelloscreen(WHITESTATESCREEN, USE)
  649. END IF
  650. IF nowside = BLACKSIDE THEN
  651. forecolor = WHITE
  652. backcolor = BLACK
  653. ELSEIF nowside = WHITESIDE THEN
  654. forecolor = BLACK
  655. backcolor = WHITE
  656. END IF
  657. CIRCLE (6, 25), 3.9, RED
  658. PAINT (6, 25), BLUE, RED
  659. PAINT (6, 25), backcolor, RED
  660. IF facetype = THINK THEN
  661. CIRCLE (4.8, 26), .6, forecolor
  662. CIRCLE (7.2, 26), .6, forecolor
  663. LINE (5, 23)-(7, 23), forecolor
  664. ELSEIF facetype = LOSE THEN
  665. CIRCLE (4.8, 26), .6, forecolor
  666. CIRCLE (7.2, 26), .6, forecolor
  667. CIRCLE (6, 21), 2.4, forecolor, 60 * DEGREE, 120 * DEGREE
  668. ELSEIF facetype = QUIET THEN
  669. CIRCLE (4.8, 26), .6, forecolor
  670. CIRCLE (7.2, 26), .6, forecolor
  671. CIRCLE (6, 23), 1, forecolor, , , .4
  672. ELSEIF facetype = WIN THEN
  673. CIRCLE (4.8, 26), .6, forecolor
  674. CIRCLE (7.2, 26), .6, forecolor
  675. CIRCLE (6, 25), 2, forecolor, 240 * DEGREE, 300 * DEGREE
  676. END IF
  677. END SUB
  678. FUNCTION HexToDec# (hex AS STRING)
  679. DIM dec AS DOUBLE
  680. DIM length AS INTEGER
  681. DIM i AS INTEGER
  682. DIM byte AS STRING * 1
  683. dec = 0
  684. length = LEN(hex)
  685. FOR i = 1 TO length
  686. byte = MID$(hex, i, 1)
  687. SELECT CASE byte
  688. CASE "0" TO "9"
  689. dec = dec + (ASC(byte) - 48) * 16# ^ (length - i)
  690. CASE "A" TO "F"
  691. dec = dec + (ASC(byte) - 55) * 16# ^ (length - i)
  692. END SELECT
  693. NEXT i
  694. HexToDec# = dec
  695. END FUNCTION
  696. SUB humanthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  697. CONST TWINKLETIME = 1 / 3
  698. SHARED timetrap AS INTEGER
  699. DIM Left AS STRING * 2
  700. DIM Right AS STRING * 2
  701. DIM Up AS STRING * 2
  702. DIM Down AS STRING * 2
  703. DIM Enter AS STRING * 1
  704. DIM State AS INTEGER
  705. DIM RefTime AS SINGLE
  706. DIM TimeBalance AS SINGLE
  707. DIM check AS STRING
  708. DIM Place AS INTEGER
  709. Left = CHR$(0) + CHR$(75)
  710. Right = CHR$(0) + CHR$(77)
  711. Up = CHR$(0) + CHR$(72)
  712. Down = CHR$(0) + CHR$(80)
  713. Enter = CHR$(13)
  714. Place = FALSE
  715. timetrap = EVENTON
  716. TIMER ON
  717. DO
  718. State = SHOW
  719. CALL lightmark(nowside, board(x, y), x, y, State)
  720. RefTime = TIMER
  721. DO
  722. TimeBalance = TIMER - RefTime
  723. TimeBalance = TimeBalance + DAY
  724. TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY
  725. IF TimeBalance >= TWINKLETIME THEN
  726. IF State = SHOW THEN
  727. State = DISAPPEAR
  728. ELSEIF State = DISAPPEAR THEN
  729. State = SHOW
  730. END IF
  731. CALL lightmark(nowside, board(x, y), x, y, State)
  732. RefTime = TIMER
  733. END IF
  734. check = INKEY$
  735. LOOP WHILE check = ""
  736. State = DISAPPEAR
  737. CALL lightmark(nowside, board(x, y), x, y, State)
  738. LOCATE 23, 1
  739. PRINT SPACE$(40);
  740. SELECT CASE check
  741. CASE Left
  742. x = x - 1
  743. IF x < 1 THEN
  744. x = BOARDSIZE
  745. END IF
  746. CASE Right
  747. x = x + 1
  748. IF x > BOARDSIZE THEN
  749. x = 1
  750. END IF
  751. CASE Up
  752. y = y + 1
  753. IF y > BOARDSIZE THEN
  754. y = 1
  755. END IF
  756. CASE Down
  757. y = y - 1
  758. IF y < 1 THEN
  759. y = BOARDSIZE
  760. END IF
  761. CASE Enter
  762. IF board(x, y) = BLANK THEN
  763. Place = CheckPlace(nowside, board(), x, y)
  764. IF Place = TRUE THEN
  765. TIMER OFF
  766. timetrap = EVENTOFF
  767. IF nowside = BLACKSIDE THEN
  768. board(x, y) = BLACKSTONE
  769. ELSEIF nowside = WHITESIDE THEN
  770. board(x, y) = WHITESTONE
  771. END IF
  772. CALL stoneshow(board(x, y), x, y)
  773. ELSEIF Place = FALSE THEN
  774. LOCATE 23, 1
  775. PRINT "No strones capture.";
  776. BEEP
  777. END IF
  778. ELSE
  779. LOCATE 23, 1
  780. PRINT "Occupied square.";
  781. BEEP
  782. END IF
  783. CASE ELSE
  784. BEEP
  785. END SELECT
  786. LOOP WHILE Place = FALSE
  787. END SUB
  788. SUB InputName (humanside AS INTEGER, bothname() AS playdata)
  789. CONST BLACKW = 1
  790. CONST BLACKH = 6
  791. CONST WHITEW = 11
  792. CONST WHITEH = 6
  793. CONST TWINKLETIME = 1 / 6
  794. DIM w AS INTEGER
  795. DIM h AS INTEGER
  796. DIM i AS INTEGER
  797. DIM RefTime AS SINGLE
  798. DIM TimeBalance AS SINGLE
  799. DIM cw AS STRING * 1
  800. DIM ct AS STRING * 1
  801. DIM check AS STRING
  802. DIM humanname AS STRING
  803. IF humanside = BLACKSIDE THEN
  804. w = BLACKW
  805. h = BLACKH
  806. ELSEIF humanside = WHITESIDE THEN
  807. w = WHITEW
  808. h = WHITEH
  809. END IF
  810. humanname = ""
  811. i = 0
  812. cw = "?"
  813. ct = " "
  814. RefTime = TIMER
  815. DO
  816. LOCATE w, h: PRINT humanname + cw + SPACE$(10 - i - 1)
  817. TimeBalance = TIMER - RefTime
  818. TimeBalance = TimeBalance + DAY
  819. TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY
  820. IF TimeBalance >= TWINKLETIME THEN
  821. SWAP cw, ct
  822. RefTime = TIMER
  823. END IF
  824. check = INKEY$
  825. IF check >= "A" AND check <= "Z" OR check >= "a" AND check <= "z" OR check = " " OR check = "-" THEN
  826. humanname = humanname + check
  827. i = i + 1
  828. END IF
  829. IF check = CHR$(8) AND i > 0 THEN
  830. i = i - 1
  831. humanname = LEFT$(humanname, i)
  832. END IF
  833. LOOP UNTIL i >= 10 OR check = CHR$(13)
  834. bothname(humanside).playname = humanname
  835. LOCATE w, h: PRINT bothname(humanside).playname
  836. END SUB
  837. SUB Install
  838. END SUB
  839. SUB lightmark (nowside AS INTEGER, background AS INTEGER, x AS INTEGER, y AS INTEGER, cursor AS INTEGER)
  840. CALL trapcontrol(TRAPOFF)
  841. CALL othelloscreen(BOARDSCREEN, USE)
  842. IF cursor = SHOW THEN
  843. IF background = BLANK THEN
  844. IF nowside = BLACKSIDE THEN
  845. CIRCLE (x - .5, y - .5), .2, BLACK
  846. PAINT (x - .5, y - .5), BLACK, BLACK
  847. ELSEIF nowside = WHITESIDE THEN
  848. CIRCLE (x - .5, y - .5), .2, WHITE
  849. PAINT (x - .5, y - .5), WHITE, WHITE
  850. END IF
  851. ELSE
  852. CIRCLE (x - .5, y - .5), .2, RED
  853. PAINT (x - .5, y - .5), RED, RED
  854. END IF
  855. ELSEIF cursor = DISAPPEAR THEN
  856. IF background = BLANK THEN
  857. PAINT (x - .5, y - .5), BLUE, BLUE
  858. ELSEIF background = BLACKSTONE THEN
  859. PAINT (x - .5, y - .5), BLACK, BLACK
  860. ELSEIF background = WHITESTONE THEN
  861. PAINT (x - .5, y - .5), WHITE, WHITE
  862. END IF
  863. END IF
  864. CALL trapcontrol(TRAPON)
  865. END SUB
  866. SUB othelloscreen (screentype AS INTEGER, screenstate AS INTEGER)
  867. SHARED nowscreen AS INTEGER
  868. DIM i AS INTEGER
  869. IF screentype = BLACKSTATESCREEN THEN
  870. IF screenstate = SET THEN
  871. nowscreen = BLACKSTATESCREEN
  872. VIEW (1, 18)-(120, 77), BLUE, WHITE
  873. WINDOW (1, 1)-(50, 30)
  874. ELSEIF screenstate = USE AND nowscreen <> BLACKSTATESCREEN THEN
  875. nowscreen = BLACKSTATESCREEN
  876. VIEW (1, 18)-(120, 77)
  877. WINDOW (1, 1)-(50, 30)
  878. END IF
  879. ELSEIF screentype = WHITESTATESCREEN THEN
  880. IF screenstate = SET THEN
  881. nowscreen = WHITESTATESCREEN
  882. VIEW (1, 98)-(120, 157), BLUE, WHITE
  883. WINDOW (1, 1)-(50, 30)
  884. ELSEIF screenstate = USE AND nowscreen <> WHITESTATESCREEN THEN
  885. nowscreen = WHITESTATESCREEN
  886. VIEW (1, 98)-(120, 157)
  887. WINDOW (1, 1)-(50, 30)
  888. END IF
  889. ELSEIF screentype = BOARDSCREEN THEN
  890. IF screenstate = SET THEN
  891. nowscreen = BOARDSCREEN
  892. VIEW (126, 1)-(318, 161), BLUE, WHITE
  893. WINDOW (0, 0)-(BOARDSIZE, BOARDSIZE)
  894. FOR i = 0 TO BOARDSIZE
  895. LINE (i, 0)-(i, BOARDSIZE), BLACK
  896. NEXT i
  897. FOR i = 0 TO BOARDSIZE
  898. LINE (0, i)-(BOARDSIZE, i), BLACK
  899. NEXT i
  900. ELSEIF screenstate = USE AND nowscreen <> BOARDSCREEN THEN
  901. nowscreen = BOARDSCREEN
  902. VIEW (126, 1)-(318, 161)
  903. WINDOW (0, 0)-(BOARDSIZE, BOARDSIZE)
  904. END IF
  905. ELSEIF screentype = BUTTONSCREEN THEN
  906. END IF
  907. END SUB
  908. SUB overjudge (nowside AS INTEGER, board() AS INTEGER)
  909. DIM refnowside AS INTEGER
  910. DIM x AS INTEGER
  911. DIM y AS INTEGER
  912. refnowside = nowside
  913. DO
  914. IF nowside = BLACKSIDE THEN
  915. nowside = WHITESIDE
  916. ELSEIF nowside = WHITESIDE THEN
  917. nowside = BLACKSIDE
  918. END IF
  919. FOR x = 1 TO BOARDSIZE
  920. FOR y = 1 TO BOARDSIZE
  921. IF board(x, y) = BLANK THEN
  922. IF CheckPlace(nowside, board(), x, y) = TRUE THEN
  923. EXIT SUB
  924. END IF
  925. END IF
  926. NEXT y
  927. NEXT x
  928. LOOP UNTIL nowside = refnowside
  929. nowside = OVER
  930. END SUB
  931. FUNCTION PasswordSwitch# (password AS DOUBLE)
  932. DIM i AS INTEGER
  933. DIM tm AS DOUBLE
  934. DIM rn AS DOUBLE
  935. tm = password - FIX(password / 65536) * 65536
  936. rn = PIRandomNum#((tm))
  937. rn = ERandomNum#((tm))
  938. FOR i = 1 TO 16
  939. IF PIRandomNum#(-1) * 999999 < 500000 THEN
  940. password = password + FIX(C * PIRandomNum#(-1))
  941. END IF
  942. IF ERandomNum#(-1) * 999999 >= 500000 THEN
  943. password = password + FIX(C * ERandomNum#(-1))
  944. END IF
  945. NEXT i
  946. PasswordSwitch# = password - FIX(password / C) * C
  947. END FUNCTION
  948. SUB PasswordToPAB (password AS STRING, passworda AS DOUBLE, passwordb AS DOUBLE)
  949. passworda = HexToDec(MID$(password, 1, 4) + MID$(password, 5, 4))
  950. passwordb = HexToDec(MID$(password, 9, 4) + MID$(password, 13, 4))
  951. END SUB
  952. FUNCTION PIRandomNum# (n AS DOUBLE)
  953. STATIC x AS DOUBLE
  954. SELECT CASE n
  955. CASE IS >= 0
  956. x = (n + E) ^ PI
  957. CASE IS < 0
  958. x = (x * C + E) ^ PI
  959. END SELECT
  960. x = x / 10 ^ INT(LOG(x) / LOG(10#) - 4)
  961. x = x - FIX(x)
  962. PIRandomNum# = x
  963. END FUNCTION
  964. SUB Quit (choose AS INTEGER)
  965. CONST TWINKLETIME = 1 / 6
  966. DIM RefTime AS SINGLE
  967. DIM TimeBalance AS SINGLE
  968. DIM cw AS STRING * 1
  969. DIM ct AS STRING * 1
  970. DIM check AS STRING
  971. cw = "?"
  972. ct = " "
  973. RefTime = TIMER
  974. DO
  975. LOCATE 23, 1: PRINT "Quit(Y/N)" + cw;
  976. TimeBalance = TIMER - RefTime
  977. TimeBalance = TimeBalance + DAY
  978. TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY
  979. IF TimeBalance >= TWINKLETIME THEN
  980. SWAP cw, ct
  981. RefTime = TIMER
  982. END IF
  983. check = INKEY$
  984. LOOP UNTIL check = "Y" OR check = "y" OR check = "N" OR check = "n"
  985. LOCATE 23, 1: PRINT "Quit(Y/N)?" + check;
  986. IF check = "Y" OR check = "y" THEN
  987. choose = FINISH
  988. ELSEIF check = "N" OR check = "n" THEN
  989. choose = RENEW
  990. END IF
  991. LOCATE 23, 1
  992. PRINT SPACE$(40);
  993. END SUB
  994. FUNCTION RandomNum#
  995. DIM rn AS DOUBLE
  996. DIM rb AS INTEGER
  997. DIM i AS INTEGER
  998. DIM j AS LONG
  999. rn = 0
  1000. RANDOMIZE TIMER
  1001. FOR i = 3 TO 0 STEP -1
  1002. rb = INP(&H40)
  1003. rn = rn + rb * 256# ^ i
  1004. FOR j = 1 TO FIX(65536 * RND + 256)
  1005. NEXT j
  1006. NEXT i
  1007. RandomNum# = rn
  1008. END FUNCTION
  1009. SUB RandomSide (gameorder AS INTEGER, bothname() AS playdata)
  1010. DIM cl AS STRING
  1011. IF gameorder = 0 THEN
  1012. cl = UCASE$(COMMAND$)
  1013. IF cl = "/C-C" THEN
  1014. bothname(BLACKSIDE).playname = COMPUTERNAME
  1015. bothname(BLACKSIDE).playtype = COMPUTER
  1016. bothname(WHITESIDE).playname = COMPUTERNAME
  1017. bothname(WHITESIDE).playtype = COMPUTER
  1018. ELSEIF cl = "/H-H" THEN
  1019. bothname(BLACKSIDE).playname = ""
  1020. bothname(BLACKSIDE).playtype = HUMAN
  1021. bothname(WHITESIDE).playname = ""
  1022. bothname(WHITESIDE).playtype = HUMAN
  1023. ELSE
  1024. RANDOMIZE TIMER
  1025. IF RND < .5 THEN
  1026. bothname(BLACKSIDE).playname = ""
  1027. bothname(BLACKSIDE).playtype = HUMAN
  1028. bothname(WHITESIDE).playname = COMPUTERNAME
  1029. bothname(WHITESIDE).playtype = COMPUTER
  1030. ELSE
  1031. bothname(BLACKSIDE).playname = COMPUTERNAME
  1032. bothname(BLACKSIDE).playtype = COMPUTER
  1033. bothname(WHITESIDE).playname = ""
  1034. bothname(WHITESIDE).playtype = HUMAN
  1035. END IF
  1036. END IF
  1037. ELSE
  1038. SWAP bothname(BLACKSIDE).playname, bothname(WHITESIDE).playname
  1039. SWAP bothname(BLACKSIDE).playtype, bothname(WHITESIDE).playtype
  1040. END IF
  1041. END SUB
  1042. SUB Recorder (bothname() AS playdata)
  1043. DIM filename AS STRING
  1044. filename = LEFT$(bothname(BLACKSIDE).playname, 1) + "&" + LEFT$(bothname(WHITESIDE).playname, 1) + "_" + "xxxx" + ".HBQ"
  1045. END SUB
  1046. SUB stonenumshow (board() AS INTEGER, stonenum() AS INTEGER)
  1047. SHARED nn AS STRING
  1048. DIM x AS INTEGER
  1049. DIM y AS INTEGER
  1050. stonenum(BLACKSIDE) = 0
  1051. stonenum(WHITESIDE) = 0
  1052. FOR x = 1 TO BOARDSIZE
  1053. FOR y = 1 TO BOARDSIZE
  1054. IF board(x, y) = BLACKSTONE THEN
  1055. stonenum(BLACKSIDE) = stonenum(BLACKSIDE) + 1
  1056. ELSEIF board(x, y) = WHITESTONE THEN
  1057. stonenum(WHITESIDE) = stonenum(WHITESIDE) + 1
  1058. END IF
  1059. NEXT y
  1060. NEXT x
  1061. LOCATE 2, 8: PRINT USING nn; stonenum(BLACKSIDE);
  1062. LOCATE 12, 8: PRINT USING nn; stonenum(WHITESIDE);
  1063. END SUB
  1064. SUB stoneshow (stone AS INTEGER, x AS INTEGER, y AS INTEGER)
  1065. CALL othelloscreen(BOARDSCREEN, USE)
  1066. IF stone = BLACKSTONE THEN
  1067. CIRCLE (x - .5, y - .5), .4, BLACK
  1068. PAINT (x - .5, y - .5), BLACK, BLACK
  1069. ELSEIF stone = WHITESTONE THEN
  1070. CIRCLE (x - .5, y - .5), .4, WHITE
  1071. PAINT (x - .5, y - .5), WHITE, WHITE
  1072. END IF
  1073. END SUB
  1074. FUNCTION TestCode
  1075. DIM filenumber AS INTEGER
  1076. DIM length AS LONG
  1077. DIM pdc AS STRING * PDCLENGTH
  1078. DIM datastring AS STRING
  1079. DIM regcod AS STRING
  1080. filenumber = FREEFILE
  1081. OPEN PROGRAMNAME + ".PDC" FOR BINARY AS filenumber
  1082. length = LOF(filenumber)
  1083. IF length = PDCLENGTH THEN
  1084. GET filenumber, 1, pdc
  1085. END IF
  1086. CLOSE filenumber
  1087. IF length = PDCLENGTH THEN
  1088. datastring = pdc
  1089. CALL DataUnLock(datastring, NO)
  1090. regcod = MID$(datastring, 1, REGCODELEN)
  1091. datastring = MID$(datastring, REGCODELEN + 1)
  1092. CALL DataUnLock(datastring, NO)
  1093. CALL DataUnLock(datastring, regcod)
  1094. ELSE
  1095. TestCode = FALSE
  1096. END IF
  1097. END FUNCTION
  1098. SUB trapcontrol (control AS INTEGER) STATIC
  1099. SHARED timetrap AS INTEGER
  1100. SHARED keytrap AS INTEGER
  1101. DIM n AS INTEGER
  1102. DIM timetrapstack(1 TO 64) AS INTEGER
  1103. DIM keytrapstack(1 TO 64) AS INTEGER
  1104. IF control = TRAPINIT THEN
  1105. FOR n = 1 TO 64
  1106. timetrapstack(n) = EVENTOFF
  1107. keytrapstack(n) = EVENTOFF
  1108. NEXT n
  1109. n = 0
  1110. ELSEIF control = TRAPOFF THEN
  1111. n = n + 1
  1112. timetrapstack(n) = timetrap
  1113. IF timetrap = EVENTON THEN
  1114. TIMER STOP
  1115. timetrap = EVENTSTOP
  1116. END IF
  1117. keytrapstack(n) = keytrap
  1118. IF keytrap = EVENTON THEN
  1119. KEY(10) STOP
  1120. keytrap = EVENTSTOP
  1121. END IF
  1122. ELSEIF control = TRAPON THEN
  1123. SELECT CASE timetrapstack(n)
  1124. CASE EVENTOFF
  1125. TIMER OFF
  1126. timetrap = EVENTOFF
  1127. CASE EVENTSTOP
  1128. TIMER STOP
  1129. timetrap = EVENTSTOP
  1130. CASE EVENTON
  1131. timetrap = EVENTON
  1132. TIMER ON
  1133. END SELECT
  1134. SELECT CASE keytrapstack(n)
  1135. CASE EVENTOFF
  1136. KEY(10) OFF
  1137. keytrap = EVENTOFF
  1138. CASE EVENTSTOP
  1139. KEY(10) STOP
  1140. keytrap = EVENTSTOP
  1141. CASE EVENTON
  1142. keytrap = EVENTON
  1143. KEY(10) ON
  1144. END SELECT
  1145. n = n - 1
  1146. END IF
  1147. END SUB
  1148. SUB turnstone (board() AS INTEGER, x AS INTEGER, y AS INTEGER)
  1149. DIM stone AS INTEGER
  1150. DIM xplus AS INTEGER
  1151. DIM yplus AS INTEGER
  1152. DIM xpointer AS INTEGER
  1153. DIM ypointer AS INTEGER
  1154. DIM i AS INTEGER
  1155. DIM j AS INTEGER
  1156. stone = board(x, y)
  1157. FOR xplus = -1 TO 1
  1158. FOR yplus = -1 TO 1
  1159. xpointer = x + xplus
  1160. ypointer = y + yplus
  1161. DO WHILE (xpointer >= 1 AND xpointer <= BOARDSIZE) AND (ypointer >= 1 AND ypointer <= BOARDSIZE)
  1162. IF board(xpointer, ypointer) = stone THEN
  1163. i = x + xplus
  1164. j = y + yplus
  1165. DO UNTIL i = xpointer AND j = ypointer
  1166. board(i, j) = stone
  1167. CALL stoneshow(board(i, j), i, j)
  1168. i = i + xplus
  1169. j = j + yplus
  1170. LOOP
  1171. EXIT DO
  1172. ELSEIF board(xpointer, ypointer) = BLANK THEN
  1173. EXIT DO
  1174. END IF
  1175. xpointer = xpointer + xplus
  1176. ypointer = ypointer + yplus
  1177. LOOP
  1178. NEXT yplus
  1179. NEXT xplus
  1180. END SUB
  1181. FUNCTION Verify$ (filenumber AS INTEGER, startadd AS LONG, endadd AS LONG)
  1182. CONST TEMPSTRINGLEN = 8192
  1183. DIM i AS INTEGER
  1184. DIM p AS LONG
  1185. DIM s AS LONG
  1186. DIM l AS INTEGER
  1187. DIM tempstring AS STRING
  1188. DIM q AS INTEGER
  1189. DIM t AS LONG
  1190. DIM u AS DOUBLE
  1191. DIM tc AS STRING * 2
  1192. DIM verifyhex(0 TO 15) AS LONG
  1193. DIM verifynum(0 TO 15) AS LONG
  1194. DIM verifystring AS STRING
  1195. tc = CHR$(0) + CHR$(0)
  1196. FOR i = 0 TO 15
  1197. verifyhex(i) = 0
  1198. verifynum(i) = 0
  1199. NEXT i
  1200. p = startadd
  1201. i = 0
  1202. DO WHILE p <= endadd
  1203. s = endadd - p + 1
  1204. IF s < TEMPSTRINGLEN THEN
  1205. l = s
  1206. ELSE
  1207. l = TEMPSTRINGLEN
  1208. END IF
  1209. tempstring = STRING$(l, 0)
  1210. GET filenumber, p, tempstring
  1211. IF l MOD 2 = 1 THEN
  1212. l = l + 1
  1213. tempstring = tempstring + CHR$(0)
  1214. END IF
  1215. FOR q = 1 TO l STEP 2
  1216. t = CVL(MID$(tempstring, q, 2) + tc)
  1217. verifyhex(15 - i) = verifyhex(15 - i) XOR t
  1218. u = CDBL(t + 1) * FIX(65536 * RND + 1) + verifynum(i)
  1219. verifynum(i) = u - FIX(u / 65536#) * 65536#
  1220. i = (i + 1) MOD 16
  1221. NEXT q
  1222. p = p + l
  1223. LOOP
  1224. FOR i = 0 TO 15
  1225. verifynum(i) = verifynum(i) XOR verifyhex(i)
  1226. NEXT i
  1227. verifystring = ""
  1228. FOR i = 0 TO 15
  1229. verifystring = verifystring + LEFT$(MKL$(verifynum(i)), 2)
  1230. NEXT i
  1231. Verify$ = verifystring
  1232. END FUNCTION
  1233. SUB winshow (winside AS INTEGER)
  1234. IF winside = BLACKWIN THEN
  1235. CALL faceshow(BLACKSIDE, WIN)
  1236. CALL faceshow(WHITESIDE, LOSE)
  1237. ELSEIF winside = WHITEWIN THEN
  1238. CALL faceshow(BLACKSIDE, LOSE)
  1239. CALL faceshow(WHITESIDE, WIN)
  1240. ELSEIF winside = EQUAL THEN
  1241. CALL faceshow(BLACKSIDE, QUIET)
  1242. CALL faceshow(WHITESIDE, QUIET)
  1243. END IF
  1244. END SUB
  1245. FUNCTION winsidejudge (nowside AS INTEGER, notime AS INTEGER, accpetlose AS INTEGER, stonenum() AS INTEGER)
  1246. IF nowside = OVER THEN
  1247. IF stonenum(BLACKSIDE) > stonenum(WHITESIDE) THEN
  1248. winsidejudge = BLACKWIN
  1249. ELSEIF stonenum(BLACKSIDE) = stonenum(WHITESIDE) THEN
  1250. winsidejudge = EQUAL
  1251. ELSEIF stonenum(BLACKSIDE) < stonenum(WHITESIDE) THEN
  1252. winsidejudge = WHITEWIN
  1253. END IF
  1254. ELSEIF nowside <> OVER THEN
  1255. IF notime = TRUE OR accpetlose = TRUE THEN
  1256. IF nowside = BLACKSIDE THEN
  1257. winsidejudge = BLACKWIN
  1258. ELSEIF nowside = WHITESIDE THEN
  1259. winsidejudge = WHITEWIN
  1260. END IF
  1261. END IF
  1262. END IF
  1263. END FUNCTION
复制代码


回复

使用道具 举报