Power-Programmierung/CD1.mdf/euphoria/ttt.ex

Text File | 1994-01-31 | 19KB | 899 lines

        -------------------------------
        -- 3-Dimensional Tic Tac Toe --
        -------------------------------

-- Play 3 dimensional tic-tac-toe against one of two computer algorithms
-- or against another human -- or let the two computer algorithms play
-- each other. Which algorithm is better?

-- There are two major data structures. positions describes each board
-- position. lines describes each possible winning line of 4 positions
-- in a row.

include graphics.e
include mouse.e

constant TRUE = 1, FALSE = 0
constant ON = 1, OFF = 0

constant GRAY = 8,
     BRIGHT_GREEN = 10,
     BRIGHT_RED = 12,
     BRIGHT_MAGENTA= 13,
     BRIGHT_YELLOW = 14,
     BRIGHT_BLUE = 9,
     BRIGHT_WHITE = 15

constant COLORS = {BRIGHT_RED, BRIGHT_GREEN, BRIGHT_YELLOW, BRIGHT_MAGENTA}

sequence pcolors -- colors of circular markers
pcolors = {BRIGHT_BLUE, BRIGHT_WHITE}

constant SQUARE_SIZE = 24

constant TOP_LEFT = {240, 26}

constant KEYB = 0, SCREEN = 1  -- I/O devices

constant
    NPOSITIONS = 64,  -- number of board positions
    NLINES = 76   -- number of 4-in-a-row lines

type line(integer x)
    return x >= 0 and x <= NLINES
end type

type Position(integer x)
    return x >= 0 or x <= NPOSITIONS
end type

type all_positions(sequence x)
    return length(x) = NPOSITIONS
end type

type all_lines(sequence x)
    return length(x) = NLINES
end type

type boolean(integer x)
    return x = TRUE or x = FALSE
end type

type players(sequence x)
    return length(x) = 4
end type

type player_number(integer x)
    return x = 1 or x = 2
end type

type positive_int(integer x)
    return x >= 1
end type

type natural(integer x)
    return x >= 0
end type

type human_count(integer x)
    return x >=0 and x <= 2
end type

type move_value(integer x)
    return integer(x) and x >= -1
end type

type time_delay(integer x)
    return x >= 0 and x < 1000
end type

type reason_number(integer x)
    return x >= 1 and x <= 10
end type

type three_digits(sequence x)
    return length(x) = 3
end type

type move_number(integer x)
    return x >= 111 and x <= 444
end type

all_positions positions
    -- positions is a list of all the board positions

constant
    -- positions 2-d sequence columns:
    LINES_THRU = 1, -- the number of lines passing through this position
    LINE1 = 2,      -- the first of up to 7 lines passing
            -- through this position
    NLIVE = 9,      -- the number of "live" lines passing through this position
    NEXTP = 10,     -- index of next position (or 0)
    PREVP = 11,     -- index of previous position (or 0)
    AVAIL = 12      -- is this position available, 1 = yes, 0 = no

all_lines lines     -- lines is a list of all the lines of 4 positions in a row
                -- it is indexed from 1 to NLINES

constant
    -- lines 2-d sequence columns:
    COUNT = 1,   -- number of "live" markers on this line
    POS1 = 2,    -- first position of 4
    POS4 = 5,    -- last position
    NEXTL = 6,   -- index of next line (or 0)
    PREVL = 7,   -- index of previous line (or 0)
    STATUS = 8,  -- status of this line
        -- possible status of a line:
        EMPTY = 0,
        COMPUTER = 1,
        HUMAN = 2,
        DEAD = 3

sequence lp       -- L->P format
all_positions pl  -- P->L format
sequence dbl      -- used in 3x3 check
players ptype,    -- player types
        pname     -- player names

line fptr,  -- free position list
     cptr,  -- computer's line list
     hptr,  -- human's line list
     eptr   -- empty line list
player_number player
natural cmoves, hmoves, l2
boolean endgame, found
human_count humans
move_value bestval
atom x

procedure Delay(time_delay t)
-- waste some time
    atom t0

    if humans = 0 and endgame = FALSE then
    return
    end if
    t0 = time()
    while time() < t0 + t/700 do
    end while
end procedure

procedure Why(reason_number reason)
-- show the reason why the computer made its move
    position(22, 11)
    if reason = 1 then
    puts(SCREEN, "BLOCK 3 IN A ROW")
    elsif reason = 2 then
    puts(SCREEN, "FORCE 3X3       ")
    elsif reason = 3 then
    puts(SCREEN, "FORCE 3-2-2-1   ")
    elsif reason = 4 then
    puts(SCREEN, "FORCE 3-2-2     ")
    elsif reason = 5 then
    puts(SCREEN, "PREVENT 3X3     ")
    elsif reason = 6 then
    puts(SCREEN, "PREVENT 3-2-2-1 ")
    elsif reason = 7 then
    puts(SCREEN, "PREVENT 3-2-2   ")
    elsif reason = 8 then
    printf(SCREEN, "VALUE=%d         ", bestval)
    else
    puts(SCREEN, "                ")
    end if
end procedure


function Get4th()
-- grab the final winning 4th position in a line
integer pos
    for z = POS1 to POS4 do
    pos = lines[x][z]
    if positions[lp[pos]][AVAIL] = 0 then
        return pos
    end if
    end for
end function


function Find2()
-- Find two lines that intersect where I have 2 markers on each line.
-- I can take the intersection and create two lines of 3 at once.
integer pos
    for z = POS1 to POS4 do
    pos = lines[x][z]
    if positions[lp[pos]][AVAIL] = 0 then
        dbl[l2] = pos
        l2 = l2 + 1
    end if
    end for
    if l2 < 4 then
    return 0
    end if
    for z = l2 - 2 to l2 - 1 do
    for z1 = 1 to l2 - 3 do
        if dbl[z] = dbl[z1] then
        found = TRUE
        return dbl[z]
        end if
    end for
    end for
    return 0
end function


function FindA()
-- find forcing pattern "A"
integer k, z1, line, zz
    k = 0
    for z = POS1 to POS4 do
    z1 = lp[lines[x][z]]
    for i = LINE1 to positions[z1][LINES_THRU] + 1 do
        line = positions[z1][i]
        if lines[line][STATUS] = l2 then
        if lines[line][COUNT] = 2 then
            k = k + 1
            exit
        end if
        end if
    end for
    if k = 3 then
        zz = z
        exit
    end if
    end for
    if k = 3 then
    found = TRUE
    return lines[x][zz]
    end if
    return 0
end function


function FindB()
-- find forcing pattern "B"
integer k, z1, line
    k = 0
    for z = POS1 to POS4 do
    z1 = lp[lines[x][z]]
    if positions[z1][AVAIL] = 0 then
        for i = LINE1 to positions[z1][LINES_THRU] + 1 do
        line = positions[z1][i]
        if lines[line][STATUS] = l2 then
            if lines[line][COUNT] = 2 then
            k = k + 1
            exit
            end if
        end if
        end for
        if k = 2 then
        found = TRUE
        return lines[x][z]
        end if
    end if
    end for
    return 0
end function


function FindMax()
-- find best free position
integer i, bestm
    i = fptr
    bestval = -1
    while i do
    if positions[i][NLIVE] > bestval then
        bestval = positions[i][NLIVE]
        bestm = i
    elsif positions[i][NLIVE] = bestval then
        if rand(7) = 1 then
        bestm = i
        end if
    end if
    i = positions[i][NEXTP]
    end while
    return pl[bestm]
end function

function mouse_square(sequence spot)
-- map x,y mouse coordinate to plane, row, column
    integer x, y
    natural m

    spot = spot - TOP_LEFT
    x = spot[1]
    y = spot[2]
    -- which plane are we on?
    m = 111
    while y > 4 * SQUARE_SIZE do
    y = y - 4.5 * SQUARE_SIZE
    x = x - 2.5 * SQUARE_SIZE
    m = m + 100
    end while
    -- which row are we on?
    while y > SQUARE_SIZE do
    y = y - SQUARE_SIZE
    m = m + 10
    end while
    if x > 4 * SQUARE_SIZE then
    return 0
    end if
    -- which column are we on?
    while x > SQUARE_SIZE do
    x = x - SQUARE_SIZE
    m = m + 1
    end while
    if x < 0 or y < 0 then
    return 0
    else
    return m
    end if
end function


function GetMove()
-- get human's move via the mouse
    natural m
    object event

    while TRUE do
    position(20, 1)
    puts(SCREEN, repeat(' ', 30))
    position(20, 1)
    puts(SCREEN, ' ' & pname[player])
    puts(SCREEN, "'s move? ")
    event = -1
    while atom(event) do
        event = get_mouse()
    end while
    m = mouse_square(event[2..3])
    if m >= 111 and m <= 444 then
        if lp[m] then
        if positions[lp[m]][AVAIL] = 0 then
            puts(SCREEN, repeat(' ', 30))
            exit
        end if
        end if
    end if
    end while
    return m
end function


procedure AdjValues(integer x, integer delta)
-- adjust the "value" of positions along a line
integer pos
    for z = POS1 to POS4 do
    pos = lp[lines[x][z]]
    positions[pos][NLIVE] = positions[pos][NLIVE] + delta
    end for
end procedure


procedure Relink(integer player, integer x)
-- adjust some data structures after a move
    line prev, next

    next = lines[x][NEXTL]
    prev = lines[x][PREVL]

    if player = COMPUTER then
    AdjValues(x, 1)
    lines[x][NEXTL] = cptr
    lines[x][PREVL] = 0
    if cptr then
        lines[cptr][PREVL] = x
    end if
    cptr = x
    else
    lines[x][NEXTL] = hptr
    lines[x][PREVL] = 0
    if hptr then
        lines[hptr][PREVL] = x
    end if
    hptr = x
    end if
    if prev then
    lines[prev][NEXTL] = next
    if next then
        lines[next][PREVL] = prev
    end if
    else
    eptr = next
    if eptr then
        lines[eptr][PREVL] = 0
    end if
    end if
end procedure

function digits(natural x)
-- return the 3-digits in number x
    three_digits d

    d = {0, 0, 0}
    while x >= 100 do
    d[1] = d[1] + 1
    x = x - 100
    end while

    while x >= 10 do
    d[2] = d[2] + 1
    x = x - 10
    end while

    d[3] = x
    return d
end function


procedure PrintMove(move_number move)
-- print the move that was just made
    three_digits d
    integer px, py

    d = digits(move)
    py = (d[1] - 1) * 4.5 * SQUARE_SIZE + (d[2]-1) * SQUARE_SIZE + TOP_LEFT[2]
    px = (d[1] - 1) * 2.5 * SQUARE_SIZE + (d[3]-1) * SQUARE_SIZE + TOP_LEFT[1]
    mouse_pointer(OFF)
    for i = 1 to 3 do
    ellipse(GRAY, 1, {px+1, py+1},
              {px + SQUARE_SIZE - 2, py + SQUARE_SIZE - 2})
    Delay(70)
    ellipse(pcolors[player], 1, {px+1, py+1},
                    {px + SQUARE_SIZE - 2, py + SQUARE_SIZE - 2})
    Delay(70)
    end for
    mouse_pointer(ON)
    if endgame then
    return
    end if
    if player = COMPUTER then
    cmoves = cmoves + 1
    else
    hmoves = hmoves + 1
    end if
end procedure


procedure Another(line x)
-- add to the number of positions occupied by a player
-- along a line x
    integer inarow

    inarow = lines[x][COUNT] + 1
    lines[x][COUNT] = inarow
    if inarow < 4 then
    return
    end if
    position(21,6)
    text_color(BRIGHT_RED)
    puts(SCREEN, pname[player])
    puts(SCREEN, " WINS!          ")
    text_color(BRIGHT_YELLOW)
    endgame = TRUE
    mouse_pointer(OFF)
    for i = 1 to 4 do
    for j = POS1 to POS4 do
        PrintMove(lines[x][j])
    end for
    Delay(80)
    end for
    mouse_pointer(ON)
end procedure


procedure Delete_c(line x)
-- delete from computer list
    line prev, next

    prev = lines[x][PREVL]
    next = lines[x][NEXTL]
    if prev then
    lines[prev][NEXTL] = next
    else
    cptr = next
    end if
    if next then
    lines[next][PREVL] = prev
    end if
end procedure


procedure Delete_h(line x)
-- delete from human list
    line prev, next

    prev = lines[x][PREVL]
    next = lines[x][NEXTL]
    if prev then
    lines[prev][NEXTL] = next
    else
    hptr = next
    end if
    if next then
    lines[next][PREVL] = prev
    end if
end procedure


procedure init()
-- initialize variables
    integer temp, u, line, t

    clear_screen()
    endgame = FALSE
    cmoves = 0
    hmoves = 0
    for i = 1 to NLINES do
    lines[i][STATUS] = EMPTY
    lines[i][COUNT] = 0
    end for
    for i = 1 to NPOSITIONS do
    positions[i][LINES_THRU] = 0
    positions[i][AVAIL] = 0
    end for
    line = 1
    for i = POS1 to POS4 do
    lines[line][i] = (i-1) * 111
    lines[line+1][i] = (i-1) * 109 + 5
    lines[line+2][i] = (i-1) * 91 + 50
    lines[line+3][i] = (i-1) * 89 + 55
    end for
    line = line + 4
    for i = 1 to 4 do
    for j = POS1 to POS4 do
        lines[line][j] = i * 100 + (j-1) * 11
        lines[line+1][j] = i * 100 + (j-1) * 9 + 5
        lines[line+2][j] = (j-1) * 101 + i * 10
        lines[line+3][j] = (j-1) * 99 + i * 10 + 5
        lines[line+4][j] = (j-1) * 110 + i
        lines[line+5][j] = (j-1) * 90 + 50 + i
    end for
    line = line + 6
    end for
    for i = 1 to 4 do
    for j = 1 to 4 do
        for k = POS1 to POS4 do
        t = 100 * i + 10 * j + k - 1
        u = (i - 1) * 16 + (j - 1) * 4 + k - 1
        lp[t] = u
        pl[u] = t
        lines[line][k] = t
        lines[line+1][k] = 100 * j + 10 * (k-1) + i
        lines[line+2][k] = 100 * (k-1) + 10 * i + j
        end for
        line = line + 3
    end for
    end for
    for i = 1 to NPOSITIONS do
    positions[i][PREVP] = i - 1
    positions[i][NEXTP] = i + 1
    end for
    positions[1][PREVP] = 0
    positions[NPOSITIONS][NEXTP] = 0
    fptr = 1
    for i = 1 to NLINES do
    lines[i][NEXTL] = i + 1
    lines[i][PREVL] = i - 1
    for j = POS1 to POS4 do
        t = lines[i][j]
        u = lp[t]
        temp = positions[u][LINES_THRU] + 1
        positions[u][LINES_THRU] = temp
        positions[u][temp+1] = i
    end for
    end for
    cptr = 0
    hptr = 0
    eptr = 0
    lines[NLINES][NEXTL] = 0
    lines[1][PREVL] = 0
    for i = 1 to NPOSITIONS do
    positions[i][NLIVE] = positions[i][LINES_THRU]
    end for
    position(15, 2)
    text_color(COLORS[1])
    puts(SCREEN, "3-D ")
    text_color(COLORS[2])
    puts(SCREEN, "tic ")
    text_color(COLORS[3])
    puts(SCREEN, "TAC ")
    text_color(COLORS[4])
    puts(SCREEN, "toe ")
end procedure


procedure UpdateMove(move_number m)
-- update data structures after making move m
    Position x1
    line x2
    integer prev, next, val, s

    x1 = lp[m]
    positions[x1][AVAIL] = 1
    prev = positions[x1][PREVP]
    next = positions[x1][NEXTP]
    if prev then
    positions[prev][NEXTP] = next
    if next then
        positions[next][PREVP] = prev
    end if
    else
    fptr = next
    if fptr then
        positions[fptr][PREVP] = 0
    end if
    end if
    for j = LINE1 to 1+positions[x1][LINES_THRU] do
    x2 = positions[x1][j]
    s = lines[x2][STATUS]
    if s = EMPTY then
        lines[x2][STATUS] = player
        lines[x2][COUNT] = 1
        Relink(player, x2)
    elsif s = COMPUTER then
        if player = COMPUTER then
        Another(x2)
        else
        lines[x2][STATUS] = DEAD
        AdjValues(x2, -2)
        Delete_c(x2)
        end if
    elsif s = HUMAN then
        if player = HUMAN then
        Another(x2)
        if lines[x2][COUNT] = 2 then
            val = 4
        else
            val = 0
        end if
        AdjValues(x2, val)
        else
        if lines[x2][COUNT] > 1 then
            val = -5
        else
            val = -1
        end if
        lines[x2][STATUS] = DEAD
        AdjValues(x2, val)
        Delete_h(x2)
        end if
    end if
    end for
end procedure


function Think()
-- pick the best move, return {move, reason for it}
    integer m, mymoves, myptr, me, him, hisptr, hismoves

    found = FALSE
    if player = COMPUTER then
    mymoves = cmoves
    hismoves = hmoves
    myptr = cptr
    hisptr = hptr
    me = COMPUTER
    him = HUMAN
    else
    mymoves = hmoves
    hismoves = cmoves
    myptr = hptr
    hisptr = cptr
    me = HUMAN
    him = COMPUTER
    end if

    -- Have I got 3 in a row?
    if mymoves >= 3 then
    x = myptr
    while x do
        if lines[x][COUNT] = 3 then
        return {Get4th(), 9}
        end if
        x = lines[x][NEXTL]
    end while
    end if

    -- Does the other guy have 3 in a row?
    if hismoves >= 3 then
    x = hisptr
    while x do
        if lines[x][COUNT] = 3 then
        return {Get4th(), 1}
        end if
        x = lines[x][NEXTL]
    end while
    end if

    -- Do I have a 2x2 force?
    if mymoves >= 4 then
    x = myptr
    l2 = 1
    while x do
        if lines[x][COUNT] = 2 then
        m = Find2()
        if found then
            return {m, 2}
        end if
        end if
        x = lines[x][NEXTL]
    end while

    -- Do I have a 3-2-2-1 force ?
    x = eptr
    l2 = me
    while x do
        m = FindA()
        if found then
        return {m, 3}
        end if
        x = lines[x][NEXTL]
    end while

    -- do I have a 3-2-2 force?
    if mymoves >= 5 then
        x = myptr
        while x do
        if lines[x][COUNT] = 1 then
            m = FindB()
            if found then
            return {m, 4}
            end if
        end if
        x = lines[x][NEXTL]
        end while
    end if
    end if

    -- does the other guy have a 2x2 force?
    if hismoves >= 4 then
    x = hisptr
    l2 = 1
    while x do
        if lines[x][COUNT] = 2 then
        m = Find2()
        if found then
            return {m, 5}
        end if
        end if
        x = lines[x][NEXTL]
    end while

    -- does the other guy have a 3-2-2-1 force?
    x = eptr
    l2 = him
    while x do
        m = FindA()
        if found then
        return {m, 6}
        end if
        x = lines[x][NEXTL]
    end while

    -- does the other guy have a 3-2-2 force?
    if hismoves >= 5 then
        x = hisptr
        while x do
        if lines[x][COUNT] = 1 then
            m = FindB()
            if found then
            return {m, 7}
            end if
        end if
        x = lines[x][NEXTL]
        end while
    end if
    end if
    -- just pick the move with the most possibilities
    return {FindMax(), 8}
end function


procedure Setup()
-- create major sequences
    object name

    positions = repeat(repeat(0, 12), NPOSITIONS)
    lines = repeat(repeat(0, 8), NLINES)
    lp = repeat(0, 444)
    pl = repeat(0, 64)
    dbl = repeat(0, 52)
    ptype = repeat(0, 4)
    pname = ptype
    ptype[1] = COMPUTER
    ptype[2] = COMPUTER
    pname[1] = "DEFENDO"
    pname[2] = "AGGRESSO"
    position(15, 1)
    puts(SCREEN, " Name of player 1? (cr for DEFENDO) ")
    name = gets(KEYB)
    name = name[1..length(name)-1]
    humans = 0
    if length(name) > 0 then
    pname[1] = name
    ptype[1] = HUMAN
    humans = humans + 1
    end if
    puts(SCREEN, "\n Name of player 2? (cr for AGGRESSO) ")
    name = gets(KEYB)
    name = name[1..length(name)-1]
    if (length(name) > 0) then
    pname[2] = name
    ptype[2] = HUMAN
    humans = humans + 1
    end if
end procedure

procedure draw_plane(integer color, integer x, integer y)
-- draw one plane of the board
     for i = 0 to 4 do
    draw_line(color, {{x, y+i*SQUARE_SIZE},
              {x+4*SQUARE_SIZE, y+i*SQUARE_SIZE}})
     end for
     for i = 0 to 4 do
    draw_line(color, {{x+i*SQUARE_SIZE, y},
              {x+i*SQUARE_SIZE, y+4*SQUARE_SIZE}})
     end for
end procedure

procedure make_board(sequence top_left)
-- display the board
    bk_color(8)
    for i = 0 to 3 do
    draw_plane(COLORS[i+1], top_left[1]+2.5*SQUARE_SIZE*i,
                top_left[2]+4.5*SQUARE_SIZE*i)
    end for
end procedure

procedure ttt()
-- this is the main routine
    sequence m

    Setup()
    player = rand(2) -- first game is random
             -- loser goes first in subsequent games
    while TRUE do
    mouse_pointer(OFF)
    init()
    make_board(TOP_LEFT)
    mouse_pointer(ON)
    text_color(BRIGHT_YELLOW)
    mouse_events(LEFT_DOWN)
    while endgame = FALSE do
        if fptr then
        if ptype[player] = HUMAN then
            m = {GetMove()}
        else
            m = Think()
            Why(m[2])
        end if
        PrintMove(m[1])
        UpdateMove(m[1])
        player = 3 - player
        else
        position(18,1)
        puts(SCREEN, " A DRAW             ")
        Delay(500)
        exit
        end if
    end while
    position(19, 1)
    text_color(BRIGHT_MAGENTA)
    puts(SCREEN, " Another game? (y or n) ")
    text_color(BRIGHT_YELLOW)
    if find('n', gets(KEYB)) then
        exit
    end if
    end while
end procedure

if graphics_mode(18) then -- VGA
    puts(1, "VGA graphics is required\n")
else
    ttt()
end if

if graphics_mode(-1) then
end if