美文网首页码农
QB怀旧——25年前的黑白棋程序

QB怀旧——25年前的黑白棋程序

作者: FSS_Sosei | 来源:发表于2020-01-15 21:58 被阅读0次

    最早在电脑学写程序还是用的GW-BASIC,还是带行号的,记得编辑也不方便。

    不久就接触到了QB。只买了套上中下三本Quick Basic 4.0 语言参考手册,开始了QB之旅。

    一晃25年过去了,DOS也早尘封成渣渣。想怀旧,还好现在有几乎完全复现QB那IDE的开源跨平台软件QB64。一起动,那熟悉亲切的大蓝底,看久了眼晕,哈

    当年厂商咋喜欢那个配色呢

    现在派生自QB语法的开源跨平台BASIC编译器,活跃有知名度的还有两家,FreeBASIC和BlitzMax。不过发展下来也是方言了,用来编译原先QB4.0下写的源码就不太灵了。干这活还是得QB64,几乎完全兼容和复现!!!

    好了,贴个我当年写的一个程序,OTHELLO.BAS

    CONST COPYRIGHTNUMBER = "HeiBaiQi V1.0"

    CONST COPYRIGHT = "Copyright (C) sosei"

    CONST NO = "2CFD4E6D12DA4469"

    CONST PROGRAMNAME = "OTHELLO"

    CONST REGCODELEN = 16

    CONST COMPUTERNAME = "Snowman"

    CONST E = 2.718281828459045#

    CONST PI = 3.141592653589793#

    CONST DEGREE = PI / 180

    CONST CIRCLEANGLE = 2 * PI

    CONST SECOND = 1, MINUTE = 60, HOUR = 60, HALFDAY = 12

    CONST DAY = 2& * HALFDAY * HOUR * MINUTE * SECOND

    CONST BOARDSIZE = 8

    CONST MAXUNITIME = 2 * MINUTE, MAXEXTRATIME = 6 * MINUTE

    CONST WARNTIME = 10 * SECOND

    CONST HUMAN = 0, COMPUTER = 1

    CONST OVER = -1, BLACKSIDE = 0, WHITESIDE = 1

    CONST BLACKWIN = -1, EQUAL = 0, WHITEWIN = 1

    CONST BLANK = -1, BLACKSTONE = 0, WHITESTONE = 1

    CONST BEFORETIME = 0, NOWTIME = 1

    CONST ORIGINALSCREEN = -1, BLACKSTATESCREEN = 0, WHITESTATESCREEN = 1, BOARDSCREEN = 2, BUTTONSCREEN = 3

    CONST EVENTOFF = -1, EVENTSTOP = 0, EVENTON = 1

    CONST TRAPINIT = -1, TRAPOFF = 0, TRAPON = 1

    CONST SET = 0, USE = 1

    CONST TRUE = -1, FALSE = 0

    CONST SHOW = 1, DISAPPEAR = 0

    CONST REPOSE = 0, THINK = 1, LOSE = 2, QUIET = 3, WIN = 4

    CONST INIT = 0, REST = 1, TURN = 2

    CONST FINISH = -1, RENEW = 0

    CONST BLACK = 0, WHITE = 3, RED = 2, BLUE = 1

    CONST ZEROOFCLOCKANGLE = PI / 2

    CONST C = 4294967296#

    TYPE playdata

        playname AS STRING * 10

        playtype AS INTEGER

    END TYPE

    DECLARE FUNCTION RandomNum# ()

    DECLARE FUNCTION ERandomNum# (n AS DOUBLE)

    DECLARE FUNCTION PIRandomNum# (n AS DOUBLE)

    DECLARE FUNCTION PasswordSwitch# (password AS DOUBLE)

    DECLARE SUB PasswordToPAB (password AS STRING, passworda AS DOUBLE, passwordb AS DOUBLE)

    DECLARE FUNCTION HexToDec# (hexstr AS STRING)

    DECLARE SUB DataLock (datastring AS STRING, password AS STRING)

    DECLARE SUB DataUnLock (datastring AS STRING, password AS STRING)

    DECLARE FUNCTION Verify$ (filenum AS INTEGER, startadd AS LONG, endadd AS LONG)

    DECLARE FUNCTION TestCode ()

    DECLARE SUB RandomSide (gameorder AS INTEGER, bothname() AS playdata)

    DECLARE SUB InputName (humanside AS INTEGER, bothname() AS playdata)

    DECLARE SUB othelloscreen (screentype AS INTEGER, screenstate AS INTEGER)

    DECLARE SUB trapcontrol (control AS INTEGER)

    DECLARE SUB boardinit (board() AS INTEGER)

    DECLARE SUB stonenumshow (board() AS INTEGER, stonenum() AS INTEGER)

    DECLARE SUB faceshow (nowside AS INTEGER, facetype AS INTEGER)

    DECLARE SUB clock (nowside AS INTEGER, clockstate AS INTEGER, recoverscreen AS INTEGER, unitime() AS LONG, extratime() AS LONG, notime AS INTEGER)

    DECLARE SUB turnstone (board() AS INTEGER, x AS INTEGER, y AS INTEGER)

    DECLARE SUB overjudge (nowside AS INTEGER, board() AS INTEGER)

    DECLARE SUB humanthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

    DECLARE SUB computerthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

    DECLARE SUB stoneshow (stone AS INTEGER, x AS INTEGER, y AS INTEGER)

    DECLARE SUB lightmark (nowside AS INTEGER, background AS INTEGER, x AS INTEGER, y AS INTEGER, cursor AS INTEGER)

    DECLARE FUNCTION CheckPlace (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

    DECLARE FUNCTION winsidejudge (nowside AS INTEGER, notime AS INTEGER, accpetlose AS INTEGER, stonenum() AS INTEGER)

    DECLARE SUB winshow (winside AS INTEGER)

    DECLARE SUB AdmitDefeat (accpetlose AS INTEGER)

    DECLARE SUB Quit (choose AS INTEGER)

    DECLARE SUB Recorder (bothname() AS playdata)

    DIM nn AS STRING

    DIM nowscreen AS INTEGER

    DIM gameorder AS INTEGER

    DIM timetrap AS INTEGER

    DIM keytrap AS INTEGER

    DIM bothname(BLACKSIDE TO WHITESIDE) AS playdata

    DIM stonenum(BLACKSIDE TO WHITESIDE) AS INTEGER

    DIM unitime(BLACKSIDE TO WHITESIDE, BEFORETIME TO NOWTIME) AS LONG

    DIM extratime(BLACKSIDE TO WHITESIDE, BEFORETIME TO NOWTIME) AS LONG

    DIM notime AS INTEGER

    DIM accpetlose AS INTEGER

    DIM board(1 TO BOARDSIZE, 1 TO BOARDSIZE) AS INTEGER

    DIM nowside AS INTEGER

    DIM x AS INTEGER

    DIM y AS INTEGER

    DIM winside AS INTEGER

    DIM choose AS INTEGER

    nn = STRING$(INT(LOG(BOARDSIZE * BOARDSIZE) / LOG(10#)) + 1, "#")

    nowscreen = ORIGINALSCREEN

    gameorder = 0

    SCREEN 1

    PLAY "mb"

    ON TIMER(SECOND) GOSUB clocklabel

    ON KEY(10) GOSUB keylabel

    DO

        CLS

        TIMER OFF

        timetrap = EVENTOFF

        KEY(10) OFF

        keytrap = EVENTOFF

        CALL trapcontrol(TRAPINIT)

        LOCATE 25, 3: PRINT COPYRIGHTNUMBER; "  "; COPYRIGHT;

        CALL RandomSide(gameorder, bothname())

        stonenum(BLACKSIDE) = 0

        stonenum(WHITESIDE) = 0

        LOCATE 1, 1: PRINT "Name:"; bothname(BLACKSIDE).playname

        LOCATE 2, 1: PRINT USING "Stones:" + nn; stonenum(BLACKSIDE);

        CALL othelloscreen(BLACKSTATESCREEN, SET)

        CALL faceshow(BLACKSIDE, REPOSE)

        CALL clock(BLACKSIDE, INIT, FALSE, unitime(), extratime(), notime)

        LOCATE 11, 1: PRINT "Name:"; bothname(WHITESIDE).playname

        LOCATE 12, 1: PRINT USING "Stones:" + nn; stonenum(WHITESIDE);

        CALL othelloscreen(WHITESTATESCREEN, SET)

        CALL faceshow(WHITESIDE, REPOSE)

        CALL clock(WHITESIDE, INIT, FALSE, unitime(), extratime(), notime)

        CALL othelloscreen(BOARDSCREEN, SET)

        LOCATE 21, 1: PRINT "F10=Defeat";

        LOCATE 22, 19: PRINT "No:"; NO;

        IF gameorder = 0 THEN

            IF bothname(BLACKSIDE).playtype = HUMAN THEN

                CALL InputName(BLACKSIDE, bothname())

            END IF

            IF bothname(WHITESIDE).playtype = HUMAN THEN

                CALL InputName(WHITESIDE, bothname())

            END IF

        END IF

        CALL boardinit(board())

        FOR x = 1 TO BOARDSIZE

            FOR y = 1 TO BOARDSIZE

                CALL stoneshow(board(x, y), x, y)

            NEXT y

        NEXT x

        CALL stonenumshow(board(), stonenum())

        nowside = BLACKSIDE

        accpetlose = FALSE

        x = 4

        y = 4

        CALL Recorder(bothname())

        gameorder = gameorder + 1

        keytrap = EVENTON

        KEY(10) ON

        PLAY "c8d8"

        DO UNTIL nowside = OVER

            CALL faceshow(nowside, THINK)

            IF bothname(nowside).playtype = HUMAN THEN

                CALL humanthink(nowside, board(), x, y)

            ELSEIF bothname(nowside).playtype = COMPUTER THEN

                CALL computerthink(nowside, board(), x, y)

            END IF

            CALL clock(nowside, REST, FALSE, unitime(), extratime(), notime)

            CALL faceshow(nowside, REPOSE)

            CALL turnstone(board(), x, y)

            CALL stonenumshow(board(), stonenum())

            CALL overjudge(nowside, board())

        LOOP

        overlabel:

        TIMER OFF

        timetrap = EVENTOFF

        KEY(10) OFF

        keytrap = EVENTOFF

        winside = winsidejudge(nowside, notime, accpetlose, stonenum())

        CALL winshow(winside)

        CALL Recorder(bothname())

        CALL Quit(choose)

    LOOP UNTIL choose = FINISH

    PLAY "mf"

    SCREEN 0

    CLS

    END

    clocklabel:

    timetrap = EVENTSTOP

    CALL clock(nowside, TURN, TRUE, unitime(), extratime(), notime)

    IF notime = FALSE THEN

        timetrap = EVENTON

        RETURN

    ELSEIF notime = TRUE THEN

        timetrap = EVENTOFF

        RETURN overlabel

    END IF

    keylabel:

    keytrap = EVENTOFF

    KEY(10) OFF

    CALL AdmitDefeat(accpetlose)

    IF accpetlose = FALSE THEN

        keytrap = EVENTON

        RETURN

    ELSEIF accpetlose = TRUE THEN

        keytrap = EVENTOFF

        RETURN overlabel

    END IF

    SUB AdmitDefeat (accpetlose AS INTEGER)

        CONST TWINKLETIME = 1 / 6

        DIM RefTime AS SINGLE

        DIM TimeBalance AS SINGLE

        DIM cw AS STRING * 1

        DIM ct AS STRING * 1

        DIM check AS STRING

        LOCATE 23, 1

        PRINT SPACE$(40);

        cw = "?"

        ct = " "

        RefTime = TIMER

        DO

            LOCATE 23, 1: PRINT "Admit defeat(Y/N)" + cw;

            TimeBalance = TIMER - RefTime

            TimeBalance = TimeBalance + DAY

            TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY

            IF TimeBalance >= TWINKLETIME THEN

                SWAP cw, ct

                RefTime = TIMER

            END IF

            check = INKEY$

        LOOP UNTIL check = "Y" OR check = "y" OR check = "N" OR check = "n"

        LOCATE 23, 1: PRINT "Admit defeat(Y/N)?" + check;

        IF check = "Y" OR check = "y" THEN

            accpetlose = TRUE

        ELSEIF check = "N" OR check = "n" THEN

            accpetlose = FALSE

        END IF

        LOCATE 23, 1

        PRINT SPACE$(40);

    END SUB

    SUB boardinit (board() AS INTEGER)

        DIM x AS INTEGER

        DIM y AS INTEGER

        FOR x = 1 TO BOARDSIZE

            FOR y = 1 TO BOARDSIZE

                board(x, y) = BLANK

            NEXT y

        NEXT x

        board(BOARDSIZE / 2, BOARDSIZE / 2 + 1) = BLACKSTONE

        board(BOARDSIZE / 2 + 1, BOARDSIZE / 2 + 1) = WHITESTONE

        board(BOARDSIZE / 2, BOARDSIZE / 2) = WHITESTONE

        board(BOARDSIZE / 2 + 1, BOARDSIZE / 2) = BLACKSTONE

    END SUB

    FUNCTION CheckPlace (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

        DIM stone AS INTEGER

        DIM xplus AS INTEGER

        DIM yplus AS INTEGER

        DIM xpointer AS INTEGER

        DIM ypointer AS INTEGER

        IF nowside = BLACKSIDE THEN

            stone = BLACKSTONE

        ELSEIF nowside = WHITESIDE THEN

            stone = WHITESTONE

        END IF

        FOR xplus = -1 TO 1

            FOR yplus = -1 TO 1

                xpointer = x + xplus

                ypointer = y + yplus

                DO WHILE (xpointer >= 1 AND xpointer <= BOARDSIZE) AND (ypointer >= 1 AND ypointer <= BOARDSIZE)

                    IF board(xpointer, ypointer) = stone THEN

                        IF x + xplus <> xpointer OR y + yplus <> ypointer THEN

                            CheckPlace = TRUE

                            EXIT FUNCTION

                        ELSE

                            EXIT DO

                        END IF

                    ELSEIF board(xpointer, ypointer) = BLANK THEN

                        EXIT DO

                    END IF

                    xpointer = xpointer + xplus

                    ypointer = ypointer + yplus

                LOOP

            NEXT yplus

        NEXT xplus

        CheckPlace = FALSE

    END FUNCTION

    SUB clock (nowside AS INTEGER, clockstate AS INTEGER, recoverscreen AS INTEGER, unitime() AS LONG, extratime() AS LONG, notime AS INTEGER) STATIC

        CONST SA = CIRCLEANGLE / MINUTE

        CONST MA = CIRCLEANGLE / HOUR

        CONST HA = CIRCLEANGLE / HALFDAY

        SHARED nowscreen AS INTEGER

        DIM unitclockface AS INTEGER

        DIM unitclockpointer AS INTEGER

        DIM extraclockface AS INTEGER

        DIM extraclockpointer AS INTEGER

        DIM befscreen AS INTEGER

        DIM a AS SINGLE

        DIM ot AS INTEGER

        DIM nt AS INTEGER

        DIM os AS INTEGER

        DIM om AS INTEGER

        DIM oh AS INTEGER

        DIM unitsecond(BLACKSIDE TO WHITESIDE) AS INTEGER

        DIM unitminute(BLACKSIDE TO WHITESIDE) AS INTEGER

        DIM unithour(BLACKSIDE TO WHITESIDE) AS INTEGER

        DIM extrasecond(BLACKSIDE TO WHITESIDE) AS INTEGER

        DIM extraminute(BLACKSIDE TO WHITESIDE) AS INTEGER

        DIM extrahour(BLACKSIDE TO WHITESIDE) AS INTEGER

        IF clockstate = INIT THEN

            unitime(nowside, BEFORETIME) = -1

            unitime(nowside, NOWTIME) = MAXUNITIME

            extratime(nowside, BEFORETIME) = -1

            extratime(nowside, NOWTIME) = MAXEXTRATIME

            notime = FALSE

            unitclockface = TRUE: unitclockpointer = TRUE

            extraclockface = TRUE: extraclockpointer = TRUE

        ELSEIF clockstate = REST THEN

            unitime(nowside, BEFORETIME) = unitime(nowside, NOWTIME)

            unitime(nowside, NOWTIME) = MAXUNITIME

            unitclockface = FALSE: unitclockpointer = TRUE

            extraclockface = FALSE: extraclockpointer = FALSE

        ELSEIF clockstate = TURN THEN

            IF unitime(nowside, NOWTIME) > 0 THEN

                unitime(nowside, BEFORETIME) = unitime(nowside, NOWTIME)

                unitime(nowside, NOWTIME) = unitime(nowside, NOWTIME) - SECOND

                unitclockface = FALSE: unitclockpointer = TRUE

                extraclockface = FALSE: extraclockpointer = FALSE

            ELSEIF unitime(nowside, NOWTIME) = 0 THEN

                extratime(nowside, BEFORETIME) = extratime(nowside, NOWTIME)

                extratime(nowside, NOWTIME) = extratime(nowside, NOWTIME) - SECOND

                unitclockface = FALSE: unitclockpointer = FALSE

                extraclockface = FALSE: extraclockpointer = TRUE

                IF extratime(nowside, NOWTIME) = 0 THEN

                    notime = TRUE

                END IF

            END IF

        END IF

        IF recoverscreen = TRUE THEN

            befscreen = nowscreen

        END IF

        IF nowside = BLACKSIDE THEN

            CALL othelloscreen(BLACKSTATESCREEN, USE)

        ELSEIF nowside = WHITESIDE THEN

            CALL othelloscreen(WHITESTATESCREEN, USE)

        END IF

        IF unitclockface = TRUE THEN

            CIRCLE (11, 11), 10, WHITE: PAINT (11, 11), BLACK, WHITE

            CIRCLE (11, 11), .5, WHITE

            FOR a = ZEROOFCLOCKANGLE TO ZEROOFCLOCKANGLE - CIRCLEANGLE STEP -(CIRCLEANGLE / HALFDAY)

                LINE (9 * COS(a) + 11, 9 * SIN(a) + 11)-(8.5 * COS(a) + 11, 8.5 * SIN(a) + 11), WHITE

            NEXT a

        END IF

        IF unitclockpointer = TRUE THEN

            IF unitime(nowside, NOWTIME) < WARNTIME THEN

                IF unitime(nowside, NOWTIME) < MAXUNITIME THEN

                    PLAY "c8"

                END IF

            END IF

            ot = unitime(nowside, BEFORETIME)

            nt = unitime(nowside, NOWTIME)

            IF nt <> ot THEN

                os = ot MOD MINUTE

                unitsecond(nowside) = nt MOD MINUTE

                a = ZEROOFCLOCKANGLE - SA * os

                LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(7 * COS(a) + 11, 7 * SIN(a) + 11), BLACK

                ot = INT(ot / MINUTE)

                nt = INT(nt / MINUTE)

                IF nt <> ot THEN

                    om = ot MOD HOUR

                    unitminute(nowside) = nt MOD HOUR

                    a = ZEROOFCLOCKANGLE - MA * om

                    LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(6 * COS(a) + 11, 6 * SIN(a) + 11), BLACK

                    ot = INT(ot / HOUR)

                    nt = INT(nt / HOUR)

                    IF nt <> ot THEN

                        oh = ot MOD HALFDAY

                        unithour(nowside) = nt MOD HALFDAY

                        a = ZEROOFCLOCKANGLE - HA * oh

                        LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(4.5 * COS(a) + 11, 4.5 * SIN(a) + 11), BLACK

                    END IF

                END IF

                a = ZEROOFCLOCKANGLE - SA * unitsecond(nowside)

                LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(7 * COS(a) + 11, 7 * SIN(a) + 11), RED

                a = ZEROOFCLOCKANGLE - MA * unitminute(nowside)

                LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(6 * COS(a) + 11, 6 * SIN(a) + 11), BLUE

                a = ZEROOFCLOCKANGLE - HA * unithour(nowside)

                LINE (1 * COS(a) + 11, 1 * SIN(a) + 11)-(4.5 * COS(a) + 11, 4.5 * SIN(a) + 11), WHITE

            END IF

        END IF

        IF extraclockface = TRUE THEN

            CIRCLE (35, 15.5), 14, WHITE: PAINT (35, 15.5), BLACK, WHITE

            CIRCLE (35, 15.5), .5, WHITE

            FOR a = ZEROOFCLOCKANGLE TO ZEROOFCLOCKANGLE - CIRCLEANGLE STEP -(CIRCLEANGLE / HALFDAY)

                LINE (13.5 * COS(a) + 35, 13.5 * SIN(a) + 15.5)-(12 * COS(a) + 35, 12 * SIN(a) + 15.5), WHITE

            NEXT a

        END IF

        IF extraclockpointer = TRUE THEN

            ot = extratime(nowside, BEFORETIME)

            nt = extratime(nowside, NOWTIME)

            IF nt <> ot THEN

                os = ot MOD MINUTE

                extrasecond(nowside) = nt MOD MINUTE

                IF extrasecond(nowside) = 0 THEN

                    IF extratime(nowside, NOWTIME) < MAXEXTRATIME THEN

                        PLAY "e8"

                    END IF

                END IF

                a = ZEROOFCLOCKANGLE - SA * os

                LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(11 * COS(a) + 35, 11 * SIN(a) + 15.5), BLACK

                ot = INT(ot / MINUTE)

                nt = INT(nt / MINUTE)

                IF nt <> ot THEN

                    om = ot MOD HOUR

                    extraminute(nowside) = nt MOD HOUR

                    a = ZEROOFCLOCKANGLE - MA * om

                    LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(9 * COS(a) + 35, 9 * SIN(a) + 15.5), BLACK

                    ot = INT(ot / HOUR)

                    nt = INT(nt / HOUR)

                    IF nt <> ot THEN

                        oh = ot MOD HALFDAY

                        extrahour(nowside) = nt MOD HALFDAY

                        a = ZEROOFCLOCKANGLE - HA * oh

                        LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(7 * COS(a) + 35, 7 * SIN(a) + 15.5), BLACK

                    END IF

                END IF

                a = ZEROOFCLOCKANGLE - SA * extrasecond(nowside)

                LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(11 * COS(a) + 35, 11 * SIN(a) + 15.5), RED

                a = ZEROOFCLOCKANGLE - MA * extraminute(nowside)

                LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(9 * COS(a) + 35, 9 * SIN(a) + 15.5), BLUE

                a = ZEROOFCLOCKANGLE - HA * extrahour(nowside)

                LINE (1 * COS(a) + 35, 1 * SIN(a) + 15.5)-(7 * COS(a) + 35, 7 * SIN(a) + 15.5), WHITE

            END IF

        END IF

        IF recoverscreen = TRUE THEN

            CALL othelloscreen(befscreen, USE)

        END IF

    END SUB

    SUB computerthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

        SHARED timetrap AS INTEGER

        DIM Place AS INTEGER

        DIM xx AS INTEGER

        DIM yy AS INTEGER

        Place = FALSE

        timetrap = EVENTON

        TIMER ON

        FOR xx = 1 TO BOARDSIZE

            FOR yy = 1 TO BOARDSIZE

                IF board(xx, yy) = BLANK THEN

                    Place = CheckPlace(nowside, board(), xx, yy)

                    IF Place = TRUE THEN

                        TIMER OFF

                        timetrap = EVENTOFF

                        x = xx

                        y = yy

                        IF nowside = BLACKSIDE THEN

                            board(x, y) = BLACKSTONE

                        ELSEIF nowside = WHITESIDE THEN

                            board(x, y) = WHITESTONE

                        END IF

                        CALL stoneshow(board(x, y), x, y)

                        EXIT SUB

                    END IF

                END IF

            NEXT yy

        NEXT xx

    END SUB

    SUB DataLock (datastring AS STRING, password AS STRING)

        DIM passworda AS DOUBLE

        DIM passwordb AS DOUBLE

        DIM datalength AS INTEGER

        DIM tm AS DOUBLE

        DIM i AS INTEGER

        DIM byte AS STRING * 1

        DIM add(1 TO 2) AS INTEGER

        DIM bit(1 TO 2) AS STRING * 1

        CALL PasswordToPAB(password, passworda, passwordb)

        datalength = LEN(datastring)

        tm = PIRandomNum#(PasswordSwitch#((passworda)))

        FOR i = 1 TO datalength

            byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * PIRandomNum#(-1)))

            MID$(datastring, i, 1) = byte

        NEXT i

        tm = ERandomNum#(PasswordSwitch#((passwordb)))

        FOR i = 1 TO datalength

            add(1) = FIX(datalength * ERandomNum#(-1) + 1)

            add(2) = FIX(datalength * ERandomNum#(-1) + 1)

            bit(1) = MID$(datastring, add(1), 1)

            bit(2) = MID$(datastring, add(2), 1)

            MID$(datastring, add(1), 1) = bit(2)

            MID$(datastring, add(2), 1) = bit(1)

        NEXT i

        tm = ERandomNum#(PasswordSwitch#((passworda)))

        FOR i = 1 TO datalength

            byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * ERandomNum#(-1)))

            MID$(datastring, i, 1) = byte

        NEXT i

        tm = PIRandomNum#(PasswordSwitch#((passwordb)))

        FOR i = 1 TO datalength

            add(1) = FIX(datalength * PIRandomNum#(-1) + 1)

            add(2) = FIX(datalength * PIRandomNum#(-1) + 1)

            bit(1) = MID$(datastring, add(1), 1)

            bit(2) = MID$(datastring, add(2), 1)

            MID$(datastring, add(1), 1) = bit(2)

            MID$(datastring, add(2), 1) = bit(1)

        NEXT i

        tm = ERandomNum#((passworda))

        tm = PIRandomNum#((passworda))

        FOR i = 1 TO datalength

            add(1) = FIX(datalength * ERandomNum#(-1) + 1)

            add(2) = FIX(datalength * ERandomNum#(-1) + 1)

            bit(1) = MID$(datastring, add(1), 1)

            bit(2) = MID$(datastring, add(2), 1)

            bit(1) = CHR$(ASC(bit(1)) XOR FIX(256 * PIRandomNum#(-1)))

            bit(2) = CHR$(ASC(bit(2)) XOR FIX(256 * PIRandomNum#(-1)))

            MID$(datastring, add(1), 1) = bit(2)

            MID$(datastring, add(2), 1) = bit(1)

        NEXT i

        tm = PIRandomNum#((passwordb))

        tm = ERandomNum#((passwordb))

        FOR i = 1 TO datalength

            add(1) = FIX(datalength * PIRandomNum#(-1) + 1)

            add(2) = FIX(datalength * PIRandomNum#(-1) + 1)

            bit(1) = MID$(datastring, add(1), 1)

            bit(2) = MID$(datastring, add(2), 1)

            bit(1) = CHR$(ASC(bit(1)) XOR FIX(256 * ERandomNum#(-1)))

            bit(2) = CHR$(ASC(bit(2)) XOR FIX(256 * ERandomNum#(-1)))

            MID$(datastring, add(1), 1) = bit(2)

            MID$(datastring, add(2), 1) = bit(1)

        NEXT i

    END SUB

    SUB DataUnLock (datastring AS STRING, password AS STRING)

        DIM passworda AS DOUBLE

        DIM passwordb AS DOUBLE

        DIM datalength AS INTEGER

        DIM tm AS DOUBLE

        DIM i AS INTEGER

        DIM bit(1 TO 2) AS STRING * 1

        DIM byte AS STRING * 1

        datalength = LEN(datastring)

        DIM add(1 TO datalength, 1 TO 2) AS INTEGER

        DIM rn(1 TO datalength, 1 TO 2) AS STRING * 1

        CALL PasswordToPAB(password, passworda, passwordb)

        tm = PIRandomNum#((passwordb))

        tm = ERandomNum#((passwordb))

        FOR i = 1 TO datalength

            add(1, i) = FIX(datalength * PIRandomNum#(-1) + 1)

            add(2, i) = FIX(datalength * PIRandomNum#(-1) + 1)

            rn(i, 1) = CHR$(FIX(256 * ERandomNum#(-1)))

            rn(i, 2) = CHR$(FIX(256 * ERandomNum#(-1)))

        NEXT i

        FOR i = datalength TO 1 STEP -1

            bit(1) = MID$(datastring, add(i, 2), 1)

            bit(2) = MID$(datastring, add(i, 1), 1)

            bit(1) = CHR$(ASC(bit(1)) XOR ASC(rn(i, 1)))

            bit(2) = CHR$(ASC(bit(2)) XOR ASC(rn(i, 2)))

            MID$(datastring, add(i, 1), 1) = bit(1)

            MID$(datastring, add(i, 2), 1) = bit(2)

        NEXT i

        tm = ERandomNum#((passworda))

        tm = PIRandomNum#((passworda))

        FOR i = 1 TO datalength

            add(i, 1) = FIX(datalength * ERandomNum#(-1) + 1)

            add(i, 2) = FIX(datalength * ERandomNum#(-1) + 1)

            rn(i, 1) = CHR$(FIX(256 * PIRandomNum#(-1)))

            rn(i, 2) = CHR$(FIX(256 * PIRandomNum#(-1)))

        NEXT i

        FOR i = datalength TO 1 STEP -1

            bit(1) = MID$(datastring, add(i, 2), 1)

            bit(2) = MID$(datastring, add(i, 1), 1)

            bit(1) = CHR$(ASC(bit(1)) XOR ASC(rn(i, 1)))

            bit(2) = CHR$(ASC(bit(2)) XOR ASC(rn(i, 2)))

            MID$(datastring, add(i, 1), 1) = bit(1)

            MID$(datastring, add(i, 2), 1) = bit(2)

        NEXT i

        tm = PIRandomNum#(PasswordSwitch#((passwordb)))

        FOR i = 1 TO datalength

            add(i, 1) = FIX(datalength * PIRandomNum#(-1) + 1)

            add(i, 2) = FIX(datalength * PIRandomNum#(-1) + 1)

        NEXT i

        FOR i = datalength TO 1 STEP -1

            bit(1) = MID$(datastring, add(i, 2), 1)

            bit(2) = MID$(datastring, add(i, 1), 1)

            MID$(datastring, add(i, 1), 1) = bit(1)

            MID$(datastring, add(i, 2), 1) = bit(2)

        NEXT i

        tm = ERandomNum#(PasswordSwitch#((passworda)))

        FOR i = 1 TO datalength

            byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * ERandomNum#(-1)))

            MID$(datastring, i, 1) = byte

        NEXT i

        tm = ERandomNum#(PasswordSwitch#((passwordb)))

        FOR i = 1 TO datalength

            add(i, 1) = FIX(datalength * ERandomNum#(-1) + 1)

            add(i, 2) = FIX(datalength * ERandomNum#(-1) + 1)

        NEXT i

        FOR i = datalength TO 1 STEP -1

            bit(1) = MID$(datastring, add(i, 2), 1)

            bit(2) = MID$(datastring, add(i, 1), 1)

            MID$(datastring, add(i, 1), 1) = bit(1)

            MID$(datastring, add(i, 2), 1) = bit(2)

        NEXT i

        tm = PIRandomNum#(PasswordSwitch#((passworda)))

        FOR i = 1 TO datalength

            byte = CHR$(ASC(MID$(datastring, i, 1)) XOR FIX(256 * PIRandomNum#(-1)))

            MID$(datastring, i, 1) = byte

        NEXT i

    END SUB

    FUNCTION ERandomNum# (n AS DOUBLE)

        STATIC x AS DOUBLE

        SELECT CASE n

            CASE IS >= 0

                x = LOG(n + PI)

            CASE IS < 0

                x = LOG(x * C + PI)

        END SELECT

        x = x / 10 ^ INT(LOG(x) / LOG(10#) - 4)

        x = x - FIX(x)

        ERandomNum# = x

    END FUNCTION

    SUB faceshow (nowside AS INTEGER, facetype AS INTEGER)

        DIM forecolor AS INTEGER

        DIM backcolor AS INTEGER

        IF nowside = BLACKSIDE THEN

            CALL othelloscreen(BLACKSTATESCREEN, USE)

        ELSEIF nowside = WHITESIDE THEN

            CALL othelloscreen(WHITESTATESCREEN, USE)

        END IF

        IF nowside = BLACKSIDE THEN

            forecolor = WHITE

            backcolor = BLACK

        ELSEIF nowside = WHITESIDE THEN

            forecolor = BLACK

            backcolor = WHITE

        END IF

        CIRCLE (6, 25), 3.9, RED

        PAINT (6, 25), BLUE, RED

        PAINT (6, 25), backcolor, RED

        IF facetype = THINK THEN

            CIRCLE (4.8, 26), .6, forecolor

            CIRCLE (7.2, 26), .6, forecolor

            LINE (5, 23)-(7, 23), forecolor

        ELSEIF facetype = LOSE THEN

            CIRCLE (4.8, 26), .6, forecolor

            CIRCLE (7.2, 26), .6, forecolor

            CIRCLE (6, 21), 2.4, forecolor, 60 * DEGREE, 120 * DEGREE

        ELSEIF facetype = QUIET THEN

            CIRCLE (4.8, 26), .6, forecolor

            CIRCLE (7.2, 26), .6, forecolor

            CIRCLE (6, 23), 1, forecolor, , , .4

        ELSEIF facetype = WIN THEN

            CIRCLE (4.8, 26), .6, forecolor

            CIRCLE (7.2, 26), .6, forecolor

            CIRCLE (6, 25), 2, forecolor, 240 * DEGREE, 300 * DEGREE

        END IF

    END SUB

    FUNCTION HexToDec# (hexstr AS STRING)

        DIM dec AS DOUBLE

        DIM length AS INTEGER

        DIM i AS INTEGER

        DIM byte AS STRING * 1

        dec = 0

        length = LEN(hexstr)

        FOR i = 1 TO length

            byte = MID$(hexstr, i, 1)

            SELECT CASE byte

                CASE "0" TO "9"

                    dec = dec + (ASC(byte) - 48) * 16# ^ (length - i)

                CASE "A" TO "F"

                    dec = dec + (ASC(byte) - 55) * 16# ^ (length - i)

            END SELECT

        NEXT i

        HexToDec# = dec

    END FUNCTION

    SUB humanthink (nowside AS INTEGER, board() AS INTEGER, x AS INTEGER, y AS INTEGER)

        CONST TWINKLETIME = 1 / 3

        SHARED timetrap AS INTEGER

        DIM LeftKey AS STRING * 2

        DIM RightKey AS STRING * 2

        DIM UpKey AS STRING * 2

        DIM DownKey AS STRING * 2

        DIM EnterKey AS STRING * 1

        DIM State AS INTEGER

        DIM RefTime AS SINGLE

        DIM TimeBalance AS SINGLE

        DIM check AS STRING

        DIM Place AS INTEGER

        LeftKey = CHR$(0) + CHR$(75)

        RightKey = CHR$(0) + CHR$(77)

        UpKey = CHR$(0) + CHR$(72)

        DownKey = CHR$(0) + CHR$(80)

        EnterKey = CHR$(13)

        Place = FALSE

        timetrap = EVENTON

        TIMER ON

        DO

            State = SHOW

            CALL lightmark(nowside, board(x, y), x, y, State)

            RefTime = TIMER

            DO

                TimeBalance = TIMER - RefTime

                TimeBalance = TimeBalance + DAY

                TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY

                IF TimeBalance >= TWINKLETIME THEN

                    IF State = SHOW THEN

                        State = DISAPPEAR

                    ELSEIF State = DISAPPEAR THEN

                        State = SHOW

                    END IF

                    CALL lightmark(nowside, board(x, y), x, y, State)

                    RefTime = TIMER

                END IF

                check = INKEY$

            LOOP WHILE check = ""

            State = DISAPPEAR

            CALL lightmark(nowside, board(x, y), x, y, State)

            LOCATE 23, 1

            PRINT SPACE$(40);

            SELECT CASE check

                CASE LeftKey

                    x = x - 1

                    IF x < 1 THEN

                        x = BOARDSIZE

                    END IF

                CASE RightKey

                    x = x + 1

                    IF x > BOARDSIZE THEN

                        x = 1

                    END IF

                CASE UpKey

                    y = y + 1

                    IF y > BOARDSIZE THEN

                        y = 1

                    END IF

                CASE DownKey

                    y = y - 1

                    IF y < 1 THEN

                        y = BOARDSIZE

                    END IF

                CASE EnterKey

                    IF board(x, y) = BLANK THEN

                        Place = CheckPlace(nowside, board(), x, y)

                        IF Place = TRUE THEN

                            TIMER OFF

                            timetrap = EVENTOFF

                            IF nowside = BLACKSIDE THEN

                                board(x, y) = BLACKSTONE

                            ELSEIF nowside = WHITESIDE THEN

                                board(x, y) = WHITESTONE

                            END IF

                            CALL stoneshow(board(x, y), x, y)

                        ELSEIF Place = FALSE THEN

                            LOCATE 23, 1

                            PRINT "No strones capture.";

                            BEEP

                        END IF

                    ELSE

                        LOCATE 23, 1

                        PRINT "Occupied square.";

                        BEEP

                    END IF

                CASE ELSE

                    BEEP

            END SELECT

        LOOP WHILE Place = FALSE

    END SUB

    SUB InputName (humanside AS INTEGER, bothname() AS playdata)

        CONST BLACKW = 1

        CONST BLACKH = 6

        CONST WHITEW = 11

        CONST WHITEH = 6

        CONST TWINKLETIME = 1 / 6

        DIM w AS INTEGER

        DIM h AS INTEGER

        DIM i AS INTEGER

        DIM RefTime AS SINGLE

        DIM TimeBalance AS SINGLE

        DIM cw AS STRING * 1

        DIM ct AS STRING * 1

        DIM check AS STRING

        DIM humanname AS STRING

        IF humanside = BLACKSIDE THEN

            w = BLACKW

            h = BLACKH

        ELSEIF humanside = WHITESIDE THEN

            w = WHITEW

            h = WHITEH

        END IF

        humanname = ""

        i = 0

        cw = "?"

        ct = " "

        RefTime = TIMER

        DO

            LOCATE w, h: PRINT humanname + cw + SPACE$(10 - i - 1)

            TimeBalance = TIMER - RefTime

            TimeBalance = TimeBalance + DAY

            TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY

            IF TimeBalance >= TWINKLETIME THEN

                SWAP cw, ct

                RefTime = TIMER

            END IF

            check = INKEY$

            IF check >= "A" AND check <= "Z" OR check >= "a" AND check <= "z" OR check = " " OR check = "-" THEN

                humanname = humanname + check

                i = i + 1

            END IF

            IF check = CHR$(8) AND i > 0 THEN

                i = i - 1

                humanname = LEFT$(humanname, i)

            END IF

        LOOP UNTIL i >= 10 OR check = CHR$(13)

        bothname(humanside).playname = humanname

        LOCATE w, h: PRINT bothname(humanside).playname

    END SUB

    SUB lightmark (nowside AS INTEGER, background AS INTEGER, x AS INTEGER, y AS INTEGER, cursor AS INTEGER)

        CALL trapcontrol(TRAPOFF)

        CALL othelloscreen(BOARDSCREEN, USE)

        IF cursor = SHOW THEN

            IF background = BLANK THEN

                IF nowside = BLACKSIDE THEN

                    CIRCLE (x - .5, y - .5), .2, BLACK

                    PAINT (x - .5, y - .5), BLACK, BLACK

                ELSEIF nowside = WHITESIDE THEN

                    CIRCLE (x - .5, y - .5), .2, WHITE

                    PAINT (x - .5, y - .5), WHITE, WHITE

                END IF

            ELSE

                CIRCLE (x - .5, y - .5), .2, RED

                PAINT (x - .5, y - .5), RED, RED

            END IF

        ELSEIF cursor = DISAPPEAR THEN

            IF background = BLANK THEN

                PAINT (x - .5, y - .5), BLUE, BLUE

            ELSEIF background = BLACKSTONE THEN

                PAINT (x - .5, y - .5), BLACK, BLACK

            ELSEIF background = WHITESTONE THEN

                PAINT (x - .5, y - .5), WHITE, WHITE

            END IF

        END IF

        CALL trapcontrol(TRAPON)

    END SUB

    SUB othelloscreen (screentype AS INTEGER, screenstate AS INTEGER)

        SHARED nowscreen AS INTEGER

        DIM i AS INTEGER

        IF screentype = BLACKSTATESCREEN THEN

            IF screenstate = SET THEN

                nowscreen = BLACKSTATESCREEN

                VIEW (1, 18)-(120, 77), BLUE, WHITE

                WINDOW (1, 1)-(50, 30)

            ELSEIF screenstate = USE AND nowscreen <> BLACKSTATESCREEN THEN

                nowscreen = BLACKSTATESCREEN

                VIEW (1, 18)-(120, 77)

                WINDOW (1, 1)-(50, 30)

            END IF

        ELSEIF screentype = WHITESTATESCREEN THEN

            IF screenstate = SET THEN

                nowscreen = WHITESTATESCREEN

                VIEW (1, 98)-(120, 157), BLUE, WHITE

                WINDOW (1, 1)-(50, 30)

            ELSEIF screenstate = USE AND nowscreen <> WHITESTATESCREEN THEN

                nowscreen = WHITESTATESCREEN

                VIEW (1, 98)-(120, 157)

                WINDOW (1, 1)-(50, 30)

            END IF

        ELSEIF screentype = BOARDSCREEN THEN

            IF screenstate = SET THEN

                nowscreen = BOARDSCREEN

                VIEW (126, 1)-(318, 161), BLUE, WHITE

                WINDOW (0, 0)-(BOARDSIZE, BOARDSIZE)

                FOR i = 0 TO BOARDSIZE

                    LINE (i, 0)-(i, BOARDSIZE), BLACK

                NEXT i

                FOR i = 0 TO BOARDSIZE

                    LINE (0, i)-(BOARDSIZE, i), BLACK

                NEXT i

            ELSEIF screenstate = USE AND nowscreen <> BOARDSCREEN THEN

                nowscreen = BOARDSCREEN

                VIEW (126, 1)-(318, 161)

                WINDOW (0, 0)-(BOARDSIZE, BOARDSIZE)

            END IF

        ELSEIF screentype = BUTTONSCREEN THEN

        END IF

    END SUB

    SUB overjudge (nowside AS INTEGER, board() AS INTEGER)

        DIM refnowside AS INTEGER

        DIM x AS INTEGER

        DIM y AS INTEGER

        refnowside = nowside

        DO

            IF nowside = BLACKSIDE THEN

                nowside = WHITESIDE

            ELSEIF nowside = WHITESIDE THEN

                nowside = BLACKSIDE

            END IF

            FOR x = 1 TO BOARDSIZE

                FOR y = 1 TO BOARDSIZE

                    IF board(x, y) = BLANK THEN

                        IF CheckPlace(nowside, board(), x, y) = TRUE THEN

                            EXIT SUB

                        END IF

                    END IF

                NEXT y

            NEXT x

        LOOP UNTIL nowside = refnowside

        nowside = OVER

    END SUB

    FUNCTION PasswordSwitch# (password AS DOUBLE)

        DIM i AS INTEGER

        DIM tm AS DOUBLE

        DIM rn AS DOUBLE

        tm = password - FIX(password / 65536) * 65536

        rn = PIRandomNum#((tm))

        rn = ERandomNum#((tm))

        FOR i = 1 TO 16

            IF PIRandomNum#(-1) * 999999 < 500000 THEN

                password = password + FIX(C * PIRandomNum#(-1))

            END IF

            IF ERandomNum#(-1) * 999999 >= 500000 THEN

                password = password + FIX(C * ERandomNum#(-1))

            END IF

        NEXT i

        PasswordSwitch# = password - FIX(password / C) * C

    END FUNCTION

    SUB PasswordToPAB (password AS STRING, passworda AS DOUBLE, passwordb AS DOUBLE)

        passworda = HexToDec(MID$(password, 1, 4) + MID$(password, 5, 4))

        passwordb = HexToDec(MID$(password, 9, 4) + MID$(password, 13, 4))

    END SUB

    FUNCTION PIRandomNum# (n AS DOUBLE)

        STATIC x AS DOUBLE

        SELECT CASE n

            CASE IS >= 0

                x = (n + E) ^ PI

            CASE IS < 0

                x = (x * C + E) ^ PI

        END SELECT

        x = x / 10 ^ INT(LOG(x) / LOG(10#) - 4)

        x = x - FIX(x)

        PIRandomNum# = x

    END FUNCTION

    SUB Quit (choose AS INTEGER)

        CONST TWINKLETIME = 1 / 6

        DIM RefTime AS SINGLE

        DIM TimeBalance AS SINGLE

        DIM cw AS STRING * 1

        DIM ct AS STRING * 1

        DIM check AS STRING

        cw = "?"

        ct = " "

        RefTime = TIMER

        DO

            LOCATE 23, 1: PRINT "Quit(Y/N)" + cw;

            TimeBalance = TIMER - RefTime

            TimeBalance = TimeBalance + DAY

            TimeBalance = TimeBalance - FIX(TimeBalance / DAY) * DAY

            IF TimeBalance >= TWINKLETIME THEN

                SWAP cw, ct

                RefTime = TIMER

            END IF

            check = INKEY$

        LOOP UNTIL check = "Y" OR check = "y" OR check = "N" OR check = "n"

        LOCATE 23, 1: PRINT "Quit(Y/N)?" + check;

        IF check = "Y" OR check = "y" THEN

            choose = FINISH

        ELSEIF check = "N" OR check = "n" THEN

            choose = RENEW

        END IF

        LOCATE 23, 1

        PRINT SPACE$(40);

    END SUB

    FUNCTION RandomNum#

        DIM rn AS DOUBLE

        DIM rb AS INTEGER

        DIM i AS INTEGER

        DIM j AS LONG

        rn = 0

        RANDOMIZE TIMER

        FOR i = 3 TO 0 STEP -1

            rb = INP(&H40)

            rn = rn + rb * 256# ^ i

            FOR j = 1 TO FIX(65536 * RND + 256)

            NEXT j

        NEXT i

        RandomNum# = rn

    END FUNCTION

    SUB RandomSide (gameorder AS INTEGER, bothname() AS playdata)

        DIM cl AS STRING

        IF gameorder = 0 THEN

            cl = UCASE$(COMMAND$)

            IF cl = "/C-C" THEN

                bothname(BLACKSIDE).playname = COMPUTERNAME

                bothname(BLACKSIDE).playtype = COMPUTER

                bothname(WHITESIDE).playname = COMPUTERNAME

                bothname(WHITESIDE).playtype = COMPUTER

            ELSEIF cl = "/H-H" THEN

                bothname(BLACKSIDE).playname = ""

                bothname(BLACKSIDE).playtype = HUMAN

                bothname(WHITESIDE).playname = ""

                bothname(WHITESIDE).playtype = HUMAN

            ELSE

                RANDOMIZE TIMER

                IF RND < .5 THEN

                    bothname(BLACKSIDE).playname = ""

                    bothname(BLACKSIDE).playtype = HUMAN

                    bothname(WHITESIDE).playname = COMPUTERNAME

                    bothname(WHITESIDE).playtype = COMPUTER

                ELSE

                    bothname(BLACKSIDE).playname = COMPUTERNAME

                    bothname(BLACKSIDE).playtype = COMPUTER

                    bothname(WHITESIDE).playname = ""

                    bothname(WHITESIDE).playtype = HUMAN

                END IF

            END IF

        ELSE

            SWAP bothname(BLACKSIDE).playname, bothname(WHITESIDE).playname

            SWAP bothname(BLACKSIDE).playtype, bothname(WHITESIDE).playtype

        END IF

    END SUB

    SUB Recorder (bothname() AS playdata)

        DIM filename AS STRING

        filename = LEFT$(bothname(BLACKSIDE).playname, 1) + "&" + LEFT$(bothname(WHITESIDE).playname, 1) + "_" + "xxxx" + ".HBQ"

    END SUB

    SUB stonenumshow (board() AS INTEGER, stonenum() AS INTEGER)

        SHARED nn AS STRING

        DIM x AS INTEGER

        DIM y AS INTEGER

        stonenum(BLACKSIDE) = 0

        stonenum(WHITESIDE) = 0

        FOR x = 1 TO BOARDSIZE

            FOR y = 1 TO BOARDSIZE

                IF board(x, y) = BLACKSTONE THEN

                    stonenum(BLACKSIDE) = stonenum(BLACKSIDE) + 1

                ELSEIF board(x, y) = WHITESTONE THEN

                    stonenum(WHITESIDE) = stonenum(WHITESIDE) + 1

                END IF

            NEXT y

        NEXT x

        LOCATE 2, 8: PRINT USING nn; stonenum(BLACKSIDE);

        LOCATE 12, 8: PRINT USING nn; stonenum(WHITESIDE);

    END SUB

    SUB stoneshow (stone AS INTEGER, x AS INTEGER, y AS INTEGER)

        CALL othelloscreen(BOARDSCREEN, USE)

        IF stone = BLACKSTONE THEN

            CIRCLE (x - .5, y - .5), .4, BLACK

            PAINT (x - .5, y - .5), BLACK, BLACK

        ELSEIF stone = WHITESTONE THEN

            CIRCLE (x - .5, y - .5), .4, WHITE

            PAINT (x - .5, y - .5), WHITE, WHITE

        END IF

    END SUB

    SUB trapcontrol (control AS INTEGER) STATIC

        SHARED timetrap AS INTEGER

        SHARED keytrap AS INTEGER

        DIM n AS INTEGER

        DIM timetrapstack(1 TO 64) AS INTEGER

        DIM keytrapstack(1 TO 64) AS INTEGER

        IF control = TRAPINIT THEN

            FOR n = 1 TO 64

                timetrapstack(n) = EVENTOFF

                keytrapstack(n) = EVENTOFF

            NEXT n

            n = 0

        ELSEIF control = TRAPOFF THEN

            n = n + 1

            timetrapstack(n) = timetrap

            IF timetrap = EVENTON THEN

                TIMER STOP

                timetrap = EVENTSTOP

            END IF

            keytrapstack(n) = keytrap

            IF keytrap = EVENTON THEN

                KEY(10) STOP

                keytrap = EVENTSTOP

            END IF

        ELSEIF control = TRAPON THEN

            SELECT CASE timetrapstack(n)

                CASE EVENTOFF

                    TIMER OFF

                    timetrap = EVENTOFF

                CASE EVENTSTOP

                    TIMER STOP

                    timetrap = EVENTSTOP

                CASE EVENTON

                    timetrap = EVENTON

                    TIMER ON

            END SELECT

            SELECT CASE keytrapstack(n)

                CASE EVENTOFF

                    KEY(10) OFF

                    keytrap = EVENTOFF

                CASE EVENTSTOP

                    KEY(10) STOP

                    keytrap = EVENTSTOP

                CASE EVENTON

                    keytrap = EVENTON

                    KEY(10) ON

            END SELECT

            n = n - 1

        END IF

    END SUB

    SUB turnstone (board() AS INTEGER, x AS INTEGER, y AS INTEGER)

        DIM stone AS INTEGER

        DIM xplus AS INTEGER

        DIM yplus AS INTEGER

        DIM xpointer AS INTEGER

        DIM ypointer AS INTEGER

        DIM i AS INTEGER

        DIM j AS INTEGER

        stone = board(x, y)

        FOR xplus = -1 TO 1

            FOR yplus = -1 TO 1

                xpointer = x + xplus

                ypointer = y + yplus

                DO WHILE (xpointer >= 1 AND xpointer <= BOARDSIZE) AND (ypointer >= 1 AND ypointer <= BOARDSIZE)

                    IF board(xpointer, ypointer) = stone THEN

                        i = x + xplus

                        j = y + yplus

                        DO UNTIL i = xpointer AND j = ypointer

                            board(i, j) = stone

                            CALL stoneshow(board(i, j), i, j)

                            i = i + xplus

                            j = j + yplus

                        LOOP

                        EXIT DO

                    ELSEIF board(xpointer, ypointer) = BLANK THEN

                        EXIT DO

                    END IF

                    xpointer = xpointer + xplus

                    ypointer = ypointer + yplus

                LOOP

            NEXT yplus

        NEXT xplus

    END SUB

    FUNCTION Verify$ (filenumber AS INTEGER, startadd AS LONG, endadd AS LONG)

        CONST TEMPSTRINGLEN = 8192

        DIM i AS INTEGER

        DIM p AS LONG

        DIM s AS LONG

        DIM l AS INTEGER

        DIM tempstring AS STRING

        DIM q AS INTEGER

        DIM t AS LONG

        DIM u AS DOUBLE

        DIM tc AS STRING * 2

        DIM verifyhex(0 TO 15) AS LONG

        DIM verifynum(0 TO 15) AS LONG

        DIM verifystring AS STRING

        tc = CHR$(0) + CHR$(0)

        FOR i = 0 TO 15

            verifyhex(i) = 0

            verifynum(i) = 0

        NEXT i

        p = startadd

        i = 0

        DO WHILE p <= endadd

            s = endadd - p + 1

            IF s < TEMPSTRINGLEN THEN

                l = s

            ELSE

                l = TEMPSTRINGLEN

            END IF

            tempstring = STRING$(l, 0)

            GET filenumber, p, tempstring

            IF l MOD 2 = 1 THEN

                l = l + 1

                tempstring = tempstring + CHR$(0)

            END IF

            FOR q = 1 TO l STEP 2

                t = CVL(MID$(tempstring, q, 2) + tc)

                verifyhex(15 - i) = verifyhex(15 - i) XOR t

                u = CDBL(t + 1) * FIX(65536 * RND + 1) + verifynum(i)

                verifynum(i) = u - FIX(u / 65536#) * 65536#

                i = (i + 1) MOD 16

            NEXT q

            p = p + l

        LOOP

        FOR i = 0 TO 15

            verifynum(i) = verifynum(i) XOR verifyhex(i)

        NEXT i

        verifystring = ""

        FOR i = 0 TO 15

            verifystring = verifystring + LEFT$(MKL$(verifynum(i)), 2)

        NEXT i

        Verify$ = verifystring

    END FUNCTION

    SUB winshow (winside AS INTEGER)

        IF winside = BLACKWIN THEN

            CALL faceshow(BLACKSIDE, WIN)

            CALL faceshow(WHITESIDE, LOSE)

        ELSEIF winside = WHITEWIN THEN

            CALL faceshow(BLACKSIDE, LOSE)

            CALL faceshow(WHITESIDE, WIN)

        ELSEIF winside = EQUAL THEN

            CALL faceshow(BLACKSIDE, QUIET)

            CALL faceshow(WHITESIDE, QUIET)

        END IF

    END SUB

    FUNCTION winsidejudge (nowside AS INTEGER, notime AS INTEGER, accpetlose AS INTEGER, stonenum() AS INTEGER)

        IF nowside = OVER THEN

            IF stonenum(BLACKSIDE) > stonenum(WHITESIDE) THEN

                winsidejudge = BLACKWIN

            ELSEIF stonenum(BLACKSIDE) = stonenum(WHITESIDE) THEN

                winsidejudge = EQUAL

            ELSEIF stonenum(BLACKSIDE) < stonenum(WHITESIDE) THEN

                winsidejudge = WHITEWIN

            END IF

        ELSEIF nowside <> OVER THEN

            IF notime = TRUE OR accpetlose = TRUE THEN

                IF nowside = BLACKSIDE THEN

                    winsidejudge = BLACKWIN

                ELSEIF nowside = WHITESIDE THEN

                    winsidejudge = WHITEWIN

                END IF

            END IF

        END IF

    END FUNCTION

    相关文章

      网友评论

        本文标题:QB怀旧——25年前的黑白棋程序

        本文链接:https://www.haomeiwen.com/subject/ntdxzctx.html