' http://libertybasic.fr/forum/topic-204-0-2292+un-tour-de-carte.php#m2292

    nomainwin
 
    WindowWidth = 800
    WindowHeight = 700
    UpperLeftX = (DisplayWidth-WindowWidth) / 3
    UpperLeftY = (DisplayHeight-WindowHeight) / 3
 
    mois$ = "Jan Fév Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc"
    today$ = date$("mm/dd/yyyy")
    j = date$(today$)
    jsem$ = word$("Mar Mer Jeu x Ven Sam x Dim Lun",int((j/7-int(j/7))*10)+1)
    date$ = jsem$+" "+mid$(today$,4,2)+" "+word$(mois$, val(today$))+"   "+left$(time$(),5)'right$(today$,4)

    DIM info$(10,10), cards(52)
    GLOBAL xdeck, ydeck, lc, hc, xd, yd, stepp, cht$, NTL, NTC, nRedistrib
 
    ' couleur = "Trèfle Carreau Coeur Pique"
    ' valeur = "1(As) 2 3 4 5 6 7 8 9 10 11(Valet) 12(Dame) 13(Roi)"
    ' une carte est définie comme suit : Couleur * 100 + valeur
    ' ex : 205 = 5 de Carreau
    '      401 = As de Pique

    lc = 70    ' dimension d'une carte
    hc = 101
    xdeck = 10  ' position du paquet
    ydeck = 38
    dim distrib(1,1)
 
    graphicbox #g.map, 5, 5, WindowWidth-16, WindowHeight-152
    graphicbox #g.txt, 5, WindowHeight-152, WindowWidth-16, 121
    open "    Petit tour de cartes..."+space$(20)+date$ for window_nf as #g  'graphics_nf_nsb
    #g "trapclose quit"
    #g.map "down ;fill darkgreen"  ' "buttonface" = couleur du background actuel de Windows.
    #g.txt "down ;fill darkgreen"
    #g.txt "font Comic_Sans_MS 14"' bold"
    #g.txt "backcolor darkgreen ; color yellow"
    #g.map "getbmp tapis 0 0 ";WindowWidth-16;" ";WindowHeight-132
    #g.map "background tapis"
 
    if fileExists(DefaultDir$, "Cartes\Card0.bmp") then
        n = 0
        for couleur=1 to 4
            for valeur=1 to 13
                n = n + 1
                cards(n) = couleur*100+valeur  ' cartes stockée dans cards(52)
                loadbmp "SpriteCard", "Cartes\card";cards(n);".bmp"
                #g.map "addsprite Sprite";cards(n);" SpriteCard"
                #g.map "spritexy Sprite";cards(n);" ";xdeck;" ";ydeck
               ' #g.map "drawsprites"
            next
        next
        loadbmp "Dos", "Cartes\card0.bmp"
        #g.map "addsprite Sprite0 Dos"
        #g.map "spritexy Sprite0 ";xdeck;" ";ydeck
        #g.map "drawsprites"
    else
        notice "Pas de fichiers BMPs"
        call quit "#g"
    end if
 
    [new]
    disposition = int(rnd(0)*3)+1
   ' disposition = 3     ' tests...
    NTL = val(left$(word$("3x9 5x5 3x3",disposition),1))    ' nbre de lignes
    NTC = val(right$(word$("3x9 5x5 3x3",disposition),1))    ' nbre de cartes par lignes
    redim distrib(NTC,NTL)
    select case disposition
    case 1
        yd = 80-50*(NTL>3)        ' coordonnée de la première carte distribuée.
        xd = 120+((9-NTC)/3)*lc
        nRedistrib = 3   ' = click du joueur
    case 2
        yd = 80-50*(NTL>3)
        xd = 120+((9-NTC)/3)*lc
        nRedistrib = 2   ' = click du joueur
    case 3
        yd = 80-50*(NTL>3)
        xd = 120+((9-NTC)/3)*lc
        nRedistrib = 2   ' = click du joueur
    end select
    stepp = 1
    #g.map "cls ; fill darkgreen"
    #g.txt "cls ; fill darkgreen"
    call message "Choisissez une carte,", "puis cliquez sur la ligne sur laquelle elle se trouve.", ""
    call shuffleDeck  'mélange le paquet de 52 cartes
    call distrib
 
    #g.map "when leftButtonDown [click]"
 
    WAIT
 
    [click]
        #g.txt "cls ;fill darkgreen"
        if stepp > nRedistrib then call slide distrib(int(NTC/2)+1,int(NTL/2)+1), (WindowWidth-lc)/2, (WindowHeight-152-hc)/2, xdeck, ydeck : goto [new]
        mX = MouseX
        mY = MouseY
        #g.map "when leftButtonDown"
        if mY > yd and mY < yd+NTL*hc then ligne = int((mY-yd)/hc)+1 else [outa] ' défini le n° de la ligne cliquée.
        select case
        case NTL = 3                                ' ordre de stockage des lignes
            select case ligne
            case 1 : cht$ = ch$(3)+ch$(1)+ch$(2)
            case 2 : cht$ = ch$(1)+ch$(2)+ch$(3)
            case 3 : cht$ = ch$(2)+ch$(3)+ch$(1)
            end select
        case NTL = 5
            select case ligne
            case 1 : cht$ = ch$(2)+ch$(3)+ch$(1)+ch$(4)+ch$(5)
            case 2 : cht$ = ch$(1)+ch$(4)+ch$(2)+ch$(3)+ch$(5)
            case 3 : cht$ = ch$(5)+ch$(2)+ch$(3)+ch$(4)+ch$(1)
            case 4 : cht$ = ch$(2)+ch$(5)+ch$(4)+ch$(1)+ch$(3)
            case 5 : cht$ = ch$(1)+ch$(4)+ch$(5)+ch$(2)+ch$(3)
            end select
        end select
        stepp = stepp + 1
        if stepp <= nRedistrib then
            t1$ = "cliquez sur la ligne sur laquelle"
            t2$ = "votre carte se trouve."
            t3$ = ""
        else
            t1$ = ""
            t2$ = "voici votre carte.   "
            t3$ = ""
        end if
        call recup
        if stepp > nRedistrib then    ' SOLUTION
            call slide distrib(int(NTC/2)+1,int(NTL/2)+1), xdeck, ydeck, (WindowWidth-lc)/2, (WindowHeight-152-hc)/2
        else
            call distrib
        end if
        call message t1$, t2$, t3$
        [outa]
        #g.map "when leftButtonDown [click]"
    wait
 
    sub recup   ' remise sur le paquet
        for y = 1 to NTL
            for x = 1 to NTC
                #g.map "spritexy? Sprite";distrib(x,y);" spx spy"
                call slide distrib(x,y), spx, spy, xdeck, ydeck
            next
        next
        nc = 1 : n = 1    ' réorganisation astucieuse de distrib(x,y) à l'aide de cht$ constituée dans [clic].
        for y = 1 to NTL
            for x = 1 to NTC
                distrib(x,y) = val(word$(cht$,nc))
                nc = nc + NTC
                if nc > NTL*NTC then n=n+1 : nc = n
            next
        next
    end sub
 
    sub distrib   ' distribution des cartes.
        redim ch$(NTL)
        for y = 1 to NTL
            for x = 1 to NTC
                call slide distrib(x,y), xdeck, ydeck, xd+(x-1)*lc, yd+(y-1)*hc
               ' mémorise le contenu complet de cette ligne (y) dans la chaine de caractères correspondante (tableau)
                ch$(y) = ch$(y);distrib(x,y);" "
            next
        next
    end sub
 
    sub slide carte, dx, dy, ax, ay  'déplace la carte du paquet vers arx,ary
        steps = 8  'pas
        ecx = (dx - ax)/steps
        ecy = (dy - ay)/steps
        for s = 1 to steps
            #g.map "spritexy Sprite";carte;" ";dx-s*ecx;" ";dy-s*ecy
            #g.map "drawsprites"
            call pause 10
        next
    end sub
 
    Sub shuffleDeck        'mélange les 52 cartes, puis mémorise les 27 premières dans un tableau.
        For i = 52 to 1 Step -1
            x = Int(Rnd(1) * i) + 1
            temp = cards(x)
            cards(x) = cards(i)
            cards(i) = temp
        Next i
        for y = 1 to NTL      ' mémorise les NTL*NTC premières dans distrib(x,y)
            for x = 1 to NTC
                n = n + 1
                distrib(x,y) = cards(n)
            next
        next
    End Sub
 
    sub message txt1$, txt2$, txt3$
        #g.txt "cls ;fill darkgreen"
        L1 = len(txt1$)
        L2 = len(txt2$)
        L3 = len(txt3$)
        #g.txt "place ";(WindowWidth-(L1*9))/2;" 35 ;|";txt1$
        #g.txt "place ";(WindowWidth-(L2*9))/2;" 65 ;|";txt2$
        #g.txt "place ";(WindowWidth-(L3*9))/2;" 95 ;|";txt3$
        #g.txt "flush ; discard"
    end sub
 
    function fileExists(path$, filename$)
        'DIM info$(10,10) 'doit avoir été déclaré en début de prog
        files path$, filename$, info$(  ' path$ = DefaultDir$ en général...
        fileExists = val(info$(0, 0))  'non zéro si vrai
    end function
 
    sub pause temp   'pause en millisecondes
        timer temp, [temps]
        wait
        [temps]
        timer 0
    end sub
 
    sub quit handle$
        unloadbmp "SpriteCard"
        unloadbmp "Dos"
        unloadbmp "tapis"
        close #handle$
        END
    end sub