' based on an old game named "cresus"
 ' cassiope01 June, 20 2012

    nomainwin
 
    ncx = 16    ' nbr of cells X
    ncy = 8    ' nbr of cells Y
    dc = 60     ' size of a cell in pixels
    MapWidth = ncx*dc+int(dc/ncx)
    MapHeight = ncy*dc+int(dc/ncy)
 
    WindowWidth  = MapWidth + 15
    WindowHeight = MapHeight + 75
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 2
 
   ' mois$ = "January February March April May June July August September October November December"
    mois$ = "Janvier Février Mars Avril Mai Juin Juillet Août Septembre Octobre Novembre Décembre"   ' french
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
   ' jsem$ = word$("Tuesday Wednesday Thursday x Friday Saturday x Sunday Monday",int((j/7-int(j/7))*10)+1)
    jsem$ = word$("Mardi Mercredi Jeudi x Vendredi Samedi x Dimanche Lundi",int((j/7-int(j/7))*10)+1)   ' french
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+" "+right$(today$,4)+"  "+left$(time$(),5)
 
    DIM info$(10,10)
    DIM dirX(8), dirY(8)
    DIM cell(ncx,ncy)
    DIM mem(ncx,ncy)
    DIM score(2)
    DIM amount(8)
    DIM player$(2)
    fcl$ = "62 128 187"
   ' curs.color$ = "green"
    curs.symbol$ = "€"
    ft = int(dc/3)+1
    ft$ = "Courier_New ";ft;" bold"
    player$(1) = "Joueur"
    player$(2) = "Computer"
    dirX(1) = 0  : dirY(1) = -1  'up
    dirX(2) = 1  : dirY(2) = 0   'right
    dirX(3) = 0  : dirY(3) = 1   'down
    dirX(4) = -1 : dirY(4) = 0   'left
    dirX(5) = 1  : dirY(5) = -1  'up right     diagonals
    dirX(6) = 1  : dirY(6) = 1   'down right
    dirX(7) = -1 : dirY(7) = 1   'down left
    dirX(8) = -1 : dirY(8) = -1  'up left
    d2$(1) = "8 1 5"
    d2$(2) = "5 2 6"
    d2$(3) = "6 3 7"
    d2$(4) = "7 4 8"
    d2$(5) = "8 1 5 2 6"    ' second level arround
    d2$(6) = "5 2 6 3 7"
    d2$(7) = "6 3 7 4 8"
    d2$(8) = "7 4 8 1 5"
    player = 1
 
    statictext #w.txt "",5,10,370,25
    statictext #w.sc1 "Joueur :",380,10,200,25
    statictext #w.sc2 "Computer :",600,10,200,25
    button #w.bck "Back",[back],UL,MapWidth-130,6,60,27
    button #w.new "New",[new],UL,MapWidth-55,6,60,27
    graphicbox #w.map, 5, 40, MapWidth, MapHeight
    OPEN "    CHAIN REACTION... "+space$(15)+date$ for window_nf as #w  'graphics_nf_nsb
    #w "trapclose [quit]"
    #w.bck "!font Comic_Sans_MS 12 bold"
    #w.new "!font Comic_Sans_MS 12 bold"
    #w.txt "!font Courier_New 14 bold"
    #w.sc1 "!font Courier_New 14 bold"
    #w.sc2 "!font Courier_New 14 bold"
    #w.map "down; font ";ft$;" ; fill ";fcl$
    #w.map "backcolor ";fcl$ ';" ; color ";curs.color$

    loadbmp "pieces", "pieces.bmp"
    loadbmp "scrat1",  "Scrat_60x60B.bmp"
    loadbmp "scrat2",  "Scrat2_60x60B.bmp"
 
    #w.map "getbmp p0 0 0 ";dc;" ";dc  ' empty cell for deleting
    #w.map "drawbmp pieces ";MapWidth-dc-2;" 2"
    for p = 1 to 8
        #w.map "getbmp p";p;" ";MapWidth-dc-2;" ";2+(p-1)*dc;" ";dc;" ";dc  ' make bmps needed
        amount(p) = val(word$("2 1 0.5 0.2 0.1 0.05 0.02 0.01",p))  ' its values
    next
 
    [new]
    redim score(2)
    #w.sc1 player$(1);" : ";score(1);" ";curs.symbol$
    #w.sc2 player$(2);" : ";score(2);" ";curs.symbol$
    #w.map "fill ";fcl$
    for cy=1 to ncy
        for cx=1 to ncx
            cell(cx,cy) = int(rnd(0)*8)+1 : mem(cx,cy) = cell(cx,cy)
            #w.map "drawbmp p";cell(cx,cy);" ";2+(cx-1)*dc;" ";(cy-1)*dc
        next
    next
    cx = 8 :oldcx = cx
    cy = 5 :oldcy = cy
    cell(cx,cy) = 0
    mem(cx,cy) = 0
    memo$ = nocell$(cx,cy)
    #w.map "drawbmp scrat1 ";2+(cx-1)*dc;" ";(cy-1)*dc
    #w.map "flush ; discard"
 
    #w.map "when leftButtonDown [play]"    ' x,y cell
   ' #w.map "when mouseMove [infos]"    ' x,y cell

    wait
 
    [back]
      if len(memo$)>3 then
        bck = 0  :op = player
        DO
            bck = bck + 1
            x = X(right$(memo$,3))
            y = Y(right$(memo$,3))
            cell(x,y) = mem(x,y)
            op = op + 1 -2 * (op = 2)
            score(op) = score(op) - amount(cell(x,y)) ' re-calc score
            sc$ = "#w.sc";op
            #sc$ player$(op);" : ";score(op);" ";curs.symbol$
            #w.map "drawbmp p";cell(x,y);" ";2+(x-1)*dc;" ";(y-1)*dc  ' restore last
            memo$ = left$(memo$,len(memo$)-3)
            oldcx = X(right$(memo$,3))
            oldcy = Y(right$(memo$,3))
            cell(oldcx,oldcy) = 0
            #w.map "drawbmp scrat1 ";2+(oldcx-1)*dc;" ";(oldcy-1)*dc   ' cursor
            timer 200, [temp2]
            wait
            [temp2]
            timer 0
        LOOP UNTIL bck = 2 or len(memo$) = 3
      end if
    wait
 
    [play]  ' player game
        cx = int(MouseX/dc)+1 :if cx>ncx then cx=ncx
        cy = int(MouseY/dc)+1 :if cy>ncy then cy=ncy
        if cell(cx,cy)>0 and abs(oldcx-cx)<2 and abs(oldcy-cy)<2 then
            gosub [action]
            player = player + 1 -2 * (player = 2)
            gosub [computer]
            #w.map "flush ; discard"
        end if
    wait
 
    [action]  ' play current cx,cy
        #w.map "drawbmp p0 ";2+(oldcx-1)*dc;" ";(oldcy-1)*dc
        if cx-oldcx>0 then
            #w.map "drawbmp scrat2 ";2+(cx-1)*dc;" ";(cy-1)*dc   ' cursor
        else
            #w.map "drawbmp scrat1 ";2+(cx-1)*dc;" ";(cy-1)*dc   ' cursor
        end if
        oldcx = cx
        oldcy = cy
        score(player) = score(player) + amount(cell(cx,cy))
        sc$ = "#w.sc";player
        #sc$ player$(player);" : ";score(player);" ";curs.symbol$
        cell(cx,cy) = 0
        memo$ = memo$ + nocell$(cx,cy)  ' record for back
    return
 
    [computer]
        #w.map "when leftButtonDown"    ' x,y cell
       ' #w.map "when mouseMove"    ' x,y cell
        maxi = 1*-1 : nbs = 0 : redim sx(8) : redim sy(8)
        for arround = 1 to 8
            nx = oldcx+dirX(arround)
            ny = oldcy+dirY(arround)
            if nx>0 and nx<=ncx and ny>0 and ny<=ncy then
                if amount(cell(nx,ny))>=maxi then
                    nbs = nbs + 1
                    if amount(cell(nx,ny))>maxi then nbs = 1
                    sx(nbs) = nx
                    sy(nbs) = ny
                    maxi = amount(cell(nx,ny))
                end if
            end if
        next
        timer 500, [temp]
        wait
        [temp]
        timer 0
        if nbs then
            nbs = int(rnd(0)*nbs)+1
            cx = sx(nbs)
            cy = sy(nbs)
            if cell(cx,cy)>0 then gosub [action]
            player = player + 1 -2 * (player = 2)
        end if
        #w.map "when leftButtonDown [play]"    ' x,y cell
       ' #w.map "when mouseMove [infos]"    ' x,y cell
    return
 
    function nocell$(vx,vy)
        nocell$ = right$(str$(100+vx),2)+str$(vy)  '  "xxy"
    end function
 
    function X(nocell$)
        X = val(left$(nocell$,2))
    end function
 
    function Y(nocell$)
        Y = val(right$(nocell$,1))
    end function
 
    [infos]
        cx = int(MouseX/dc)+1 :if cx>ncx then cx=ncx
        cy = int(MouseY/dc)+1 :if cy>ncy then cy=ncy
        #w.txt MouseX;",";MouseY;"  cell(";cx;",";cy;") = ";amount(cell(cx,cy));" ";curs.symbol$
    wait
 
    function fileExist(path$, filename$)
        files path$, filename$, info$()
        fileExist = val(info$(0, 0))
    end function
 
    [quit]
        CONFIRM "QUIT THE GAME ?"; answer$
        if answer$ = "yes" then
            unloadbmp "pieces"
            unloadbmp "scrat1"
            unloadbmp "scrat2"
            for im = 0 to 8 :unloadbmp "p";im :next
            close #w
            end
        end if
    wait