Солитер (алгоритм)

Многие помнят игру на Windows XP под названием солитер (FreeCell). Код ниже является алгоритмом данного пасьянса. Для корректного отображения в консоли , следует выбрать нужный шрифт , поддерживающий отображение карточных мастей.

Платформы: Windows , Linux
Автор кода: неизвестен

 
Dim Shared As String*13 s_suits = Chr(5,4,3,6), s_nums = "A23456789TJQK"

#DEFINE RMAX32 &h7FFFFFFF

Dim Shared As Integer seed = 1

Function  rnd_() As Integer
    seed = (seed * 214013 + 2531011) And RMAX32
    Return seed Shr 16
End Function

Sub srnd(x As Integer) 
    seed = x
End Sub
 
Sub show(c As Integer Ptr)
    Dim As Integer i
    While i < 52
        Print Chr(s_nums[*c \ 4]);Chr(s_suits[*c Mod 4]),
        i+=1
        If ((i Mod 8) = 0 orelse i = 52) Then Print
    c+=1
    Wend    
End Sub



 
Sub deal(s As Integer, t As Integer Ptr)

    Dim As Integer i, j
    srnd(s)
 
    For i = 0 To 51
        t[i] = 51 - i
    Next
    
    For i = 0 To 50
        j = 51 - rnd_ Mod (52 - i)
        s = t[i]
        t[i] = t[j]
        t[j] = s
    Next
End Sub
 

Dim As Integer s, card(51)
    s = 617
 
    deal(s, @card(0))
    Print "Hand ="; s
    show(@card(0))
Sleep

FreeBasic

Солитер (алгоритм)