Number Trick

General FreeBASIC programming questions.
Stonemonkey
Posts: 649
Joined: Jun 09, 2005 0:08

Re: Number Trick

Postby Stonemonkey » Sep 03, 2020 21:49

@albert

If you want abc² and you want to deal with a,b,c as the individual digits then it's

a²b²c²
+
(a*b)*2000
+
(a*c)*200
+
(b*c)*20

So 123² is

010409
+
(1*2)*2000 -> 4000
+
(1*3)*200 -> 600
+
(2*3)*20 -> 120

=10409+4720=15129

Which is almost what you're last post was, but it comes from what I posted on page 5, just rearranged.
1*12300=(1*1*10000+1*2*1000+1*3*100)
2*1230=(2*1*1000+2*2*100+2*3*10)
3*123=(3*1*100+3*2*10+3*3)
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 03, 2020 22:08

With 4 digits there's two sets of adds..

1234 x 1234 = 1522756

01040916 <-- square each digit and make them all 2 digits.

1522756
-1040916
-------------
481840 <--- difference

first set of adds
1000 x 200 = 200000
1000 x 30 = 30000
1000 x 4 = 4000

second set of adds
200 x 30 = 6000
200 x 4 = 800
30 x 4 = 120

add them all up
200000
30000
4000
6000
800
120
----------
240920
x 2
----------
481840 <--- difference

1040916
+481840
--------------
1522756 <--- correct answer


Got to figure out how to do the squaring on the adders... to get it down to just a couple steps of
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 03, 2020 23:34

Another number trick... I just invented...

12 x 12 = 144

0104 <-- square each digit and make them all 2 digits.

double the value
0104
+0104
---------
208

double firs digit to 20 instead of 10
20
-12 <-- subtract number
-----
8
x8 <-- square the subtraction
----
64 <-- our subtractor

208
- 64
------
144 <--- correct answer

==============================================

Another:

23 x 23 = 529

0409 <-- square each digit and make them all 2 digits.

double the value
0409
+0409
----------
818

double firs digit to 40 instead of 20
40
-23 <--- subtract number
-----
17
x17 <-- square the subtraction
----
289 <-- our subtractor

818
-289
-------
529 <--- correct answer

==============================================

Another:

92 x 92 = 8464

8104 <-- square each digit and make them all 2 digits.

double the value
8104
+8104
----------
16208

double firs digit to 180 instead of 90
180
-92 <--- subtract number
-----
88
x88 <-- square the subtraction
----
7744 <-- our subtractor

16208
-7744
-------
8464 <--- correct answer
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 04, 2020 21:29

Another trick i just learned...

123 x 123 = 15129

123
246
369

Multiply each column: and shift..

3 x 6 x 9 = 162
2 x 4 x 6 = 480
1 x 2 x 3 = 6000

Added up = 6642

6642 x 2 = 13284

246 x 7 = 1722 + 123 = 1845 <-- our adder

13284 + 1845 = 15129 <--- correct answer
Stonemonkey
Posts: 649
Joined: Jun 09, 2005 0:08

Re: Number Trick

Postby Stonemonkey » Sep 04, 2020 21:41

Does that work for other numbers?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 04, 2020 23:48

@StoneMonkey

I tried it on several sets of 3 digits and it doesn't seem to work on other numbers...

Like i said above
I come up with a formula off the top of my head , using just the right numbers to make it work..

I don't know how i do it???

My brain , picks out the formula for a particular set of numbers , and i get the right answer... but only for that particular set of numbers..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 04, 2020 23:52

@everybody

If your playing with numbers , and find a particular set of patterns or something interesting in the values then post it here....

This Topic is for number manipulations and tricks...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 04, 2020 23:59

I came up with an interesting formula...

246 x 246 = 60516

041636 <-- square each digit and make them all 2 digits..

cascade add the square
41636
041636
0041636

Add the diagonals..
124908

124908 x .5 = 62454

62454
-60516
------------
1938 <--- don't know how to get the 1938 value???? 246 x 8 = 1968 <-- off by 30
Stonemonkey
Posts: 649
Joined: Jun 09, 2005 0:08

Re: Number Trick

Postby Stonemonkey » Sep 05, 2020 1:05

@albert
Any chance you could make a game of some sort in freebasic?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 06, 2020 0:24

@StoneMonkey

Here's one me and Dodicat did together.. "Five Deck Maverick"

It uses five decks of cards on a casino type "Slot Machine". Five wheels

Each wheel has a whole deck of cards..

It works on FB 32 bit , not sure of FB 64 bit..

Its Open GL

For some reason , after playing for a while you always come out ahead..

.
Last edited by albert on Sep 06, 2020 2:05, edited 1 time in total.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 06, 2020 2:01

For "Five Deck Maverick"

Here's the "Windows" source

Code: Select all

#include once "windows.bi"
#include once "win/winnt.bi"
#include once "win/objbase.bi"
#inclib "ole32"

Dim shared IID_ISpVoice As GUID => ( &H6c44df74, &H72b9, &H4992, {&Ha1, &Hec, &Hef, &H99, &H6e, &H04, &H22, &Hd4 })
Dim shared CLSID_SpVoice As GUID => ( &H96749377, &H3391, &H11d2, {&H9e, &He3, &H00, &Hc0, &H4f, &H79, &H73, &H96 })

Type ISpVoiceVtbl_ As ISpVoiceVtbl

Type ISpVoice
    lpVtbl As ISpVoiceVtbl_ Ptr
End Type

#define SPF_DEFAULT 0

Type ISpVoiceVtbl
rem iunknown
    QueryInterface As Function(Byval As ISpVoice Ptr, Byval As IID Ptr, Byval As Any Ptr) As HRESULT
    AddRef As Function(Byval As ISpVoice Ptr) As ULONG
    Release As Function(Byval As ISpVoice Ptr) As ULONG

rem stubs
    SetNotifySink As Function() As HRESULT
    SetNotifyWindowMessage As Function() As HRESULT
    SetNotifyCallbackFunction As Function() As HRESULT
    SetNotifyCallbackInterface As Function() As HRESULT
    SetNotifyWin32Event As Function() As HRESULT
    WaitForNotifyEvent As Function() As HRESULT
    GetNotifyEventHandle As Function() As HRESULT
    SetInterest As Function() As HRESULT
    GetEvents As Function() As HRESULT
    GetInfo As Function() As HRESULT
    SetOutput As Function() As HRESULT
    GetOutputObjectToken As Function() As HRESULT
    GetOutputStream As Function() As HRESULT

rem done
    Pause As Function(Byval As ISpVoice Ptr) As HRESULT
    Resume As Function(Byval As ISpVoice Ptr) As HRESULT

rem stubs
    SetVoice As Function() As HRESULT
    GetVoice As Function() As HRESULT

rem done
    Speak As Function(Byval As ISpVoice Ptr, Byval pwcs As Wstring Ptr, Byval dwFlags As DWORD, Byval pulStreamNumber As ULONG Ptr) As HRESULT

rem stubs
    SpeakStream As Function() As HRESULT
    GetStatus As Function() As HRESULT
    Skip As Function() As HRESULT
    SetPriority As Function() As HRESULT
    GetPriority As Function() As HRESULT
    SetAlertBoundary As Function() As HRESULT
    GetAlertBoundary As Function() As HRESULT

rem done
    SetRate As Function(Byval As ISpVoice Ptr, Byval RateAdjust As Integer) As HRESULT
    GetRate As Function(Byval As ISpVoice Ptr, Byval RateAdjust As Integer Ptr) As HRESULT
    SetVolume As Function(Byval As ISpVoice Ptr, Byval usVolume As Ushort) As HRESULT
    GetVolume As Function(Byval As ISpVoice Ptr, Byval pusVolume As Ushort Ptr) As HRESULT
    WaitUntilDone As Function(Byval As ISpVoice Ptr, Byval msTimeout As ULONG) As HRESULT

rem stubs
    SetSyncSpeakTimeout As Function() As HRESULT
    GetSyncSpeakTimeout As Function() As HRESULT
    SpeakCompleteEvent As Function() As HRESULT
    IsUISupported As Function() As HRESULT
    DisplayUI As Function() As HRESULT
End Type

sub Speak ( byref tstring as string, byval rate as integer = 0 )
    Dim voices As ISpVoice Ptr
        CoInitialize(NULL)
        CoCreateInstance(@CLSID_SpVoice, NULL, CLSCTX_ALL, @IID_ISpVoice, Cast (Any Ptr, @voices))
        voices->lpVtbl->SetRate(voices, rate)
        voices->lpVtbl->Speak(voices, tString, 1, NULL)
        voices->lpVtbl->WaitUntilDone(voices, INFINITE)
        voices->lpVtbl->Release(voices)
        CoUninitialize()
end sub

sub Speak_No_Rate ( byval param as any ptr )
    dim as zstring ptr tstring = Cast(zstring ptr, param)
    ? tstring
   
    Dim voices As ISpVoice Ptr
        CoInitialize(NULL)
        CoCreateInstance(@CLSID_SpVoice, NULL, CLSCTX_ALL, @IID_ISpVoice, Cast (Any Ptr, @voices))
        voices->lpVtbl->SetRate(voices, -2)
        voices->lpVtbl->Speak(voices, *tString, SPF_DEFAULT, NULL)
        voices->lpVtbl->WaitUntilDone(voices, INFINITE)
        voices->lpVtbl->Release(voices)
        CoUninitialize()
end sub
'===============================================================================

#Include Once "GL/glu.bi"
#include Once "GL/glext.bi"
#include "windows.bi"
#include "fbgfx.bi"

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
#define Frange(f,l) Rnd*((l)-(f))+(f)

Dim Shared As integer xres,yres
'xres=320
'yres=200
'xres=640
'yres=480
xres=800
yres=600
'xres=1024
'yres=768
Screenres xres,yres,32,2,2 'or 1
screenset 0,0

Dim Shared As GLuint tex(1 To 52)
Dim Shared As Long drums(1 To 5)
Const FS_BOLD = 2
Const FS_ITALIC = 4

Sub DrawFont(Byref BUFFER As Any Ptr=0,Byval POSX As Long, Byval POSY As Long, _
    Byref FTEXT As String, Byref FNAME As String,Byval FSIZE As Long, _
    Byval FCOLOR As Ulong=Rgb(255,255,255),Byval FSTYLE As Long=0,Byval CHARSET As Long=DEFAULT_CHARSET )
   
    Static FINIT As Long
    Static As hdc THEDC
    Static As hbitmap THEBMP
    Static As Any Ptr THEPTR
    Static As fb.image Ptr FBBLK
    Static As Long TXTSZ,RESU,RESUU
    Static As hfont THEFONT
    Static As Long FW,FI,TXYY
    Static DSKWND As hwnd, DSKDC As hdc
    Static MYBMPINFO As BITMAPINFO
    Static As TEXTMETRIC MYTXINFO
    Static As SIZE TXTSIZE
    Static As RECT RCT
    Static As Ubyte Ptr ubp
    ubp=Cptr(Ubyte Ptr,@FCOLOR)
    Swap ubp[0],ubp[2]
    Dim As Ubyte alphaval =ubp[3]
    ubp[3]=0
    #define FontSize(PointSize) -MulDiv(PointSize, GetDeviceCaps(THEDC, LOGPIXELSY), 72)
   
    If FINIT = 0 Then   
        FINIT = 1   
        With MYBMPINFO.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = 2048
            .biHeight = -513
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
        End With   
        DSKWND = GetDesktopWindow()
        DSKDC = GetDC(DSKWND)
        THEDC = CreateCompatibleDC(DSKDC)
        THEBMP = CreateDIBSection(THEDC,@MYBMPINFO,DIB_RGB_COLORS,@THEPTR,null,null)
        ReleaseDC(DSKWND,DSKDC)   
    End If
    If (FSTYLE And FS_BOLD) Then FW = FW_BOLD Else FW = FW_NORMAL   
    If (FSTYLE And FS_ITALIC) Then FI = True Else FI = False   
    THEFONT = CreateFont(FontSize(FSIZE),0,0,0,FW,FI,0,0,CHARSET,0,0,0,0,Cast(Any Ptr,Strptr(FNAME)))   
    SelectObject(THEDC,THEBMP)
    SelectObject(THEDC,THEFONT)
    GetTextMetrics(THEDC,@MYTXINFO)
    GetTextExtentPoint32(THEDC,Strptr(FTEXT),Len(FTEXT),@TXTSIZE)
    TXTSZ = TXTSIZE.CX
    TXYY = TXTSIZE.CY
    If (FSTYLE And FS_ITALIC) Then
        If MYTXINFO.tmOverhang Then
            TXTSZ += MYTXINFO.tmOverhang
        Else
            TXTSZ += 1+(FSIZE/2)
        End If
        TXYY += 1+(FSIZE/8)
    End If
    RCT.LEFT = 0
    RCT.TOP = 1
    RCT.RIGHT = TXTSZ
    RCT.BOTTOM = TXYY+1
    TXTSZ -= 1
    TXYY -= 1
    SetBkColor(THEDC,Rgba(255,0,255,0))
    SetTextColor(THEDC,FCOLOR)
    SystemParametersInfo(SPI_GETFONTSMOOTHING,null,@RESU,null)
    If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,False,@RESUU,null)
    ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)
    If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,True,@RESUU,null)
    FBBLK = THEPTR+(2048*4)-Sizeof(fb.image)
    FBBLK->Type = 7
    FBBLK->bpp = 4
    FBBLK->Width = 2048
    FBBLK->height = 512
    FBBLK->pitch = 2048*4
    Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),Alpha,alphaval
    DeleteObject(THEFONT)
End Sub
Function Filter(Byref tim As Uinteger Pointer,_
    byval rad As Single,_
    byval destroy As Integer=1,_
    byval fade As Integer=0) As Uinteger Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Integer x,y
        As Uinteger col
    End Type
    #macro p_point(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Integer=-ymin To ymax
        For x1 As Integer=-xmin To xmax
            inc=inc+1
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
    Dim As Integer pitch
    Dim  As Any Pointer row
    Dim As Uinteger Pointer pixel
    Dim As Uinteger col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Integer=0 To (_y)-1
        For x As Integer=0 To (_x)-1
            p_point(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Uinteger averagecolour
    Dim As Integer ar,ag,ab
    Dim As Integer xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Integer=0 To _y-1
        For x As Integer=0 To _x-1 
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function

Function settexture(image As Any Ptr) As gluint
    Dim As gluint texture
    glGenTextures(1, @texture)
    glBindTexture( GL_TEXTURE_2D, texture )
    glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
    Return texture
End Function

Dim Shared LightDiffuse(0 To 3) As Single ={1,1,1,1}
Dim Shared LightPosition(0 To 3) As Single ={0,0,1,1}'
Dim Shared As Double textcol(1 To 4 )={.5,.5,1,1}
Dim Shared As Double textcol2(1 To 4 )={1,1,1,1}

Sub glsetup
    glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glEnable GL_ALPHA
    glEnable GL_BLEND
    glViewport(0, 0, xres, yres)       ' Set the viewport
    glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
    glLoadIdentity                     ' Reset View
    gluPerspective(45, xres/yres, 1, 100)
    glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
    glLoadIdentity                     '  Reset View
    glClearColor 0,.2,0,1              'background
    'Set up the light
    Exit Sub
    glLightfv GL_LIGHT1, GL_DIFFUSE, @LightDiffuse(0)
    glLightfv GL_LIGHT1, GL_POSITION, @LightPosition(0)
    glEnable GL_LIGHT1
   
    'Enable lighting
    glEnable GL_LIGHTING
    glEnable GL_COLOR_MATERIAL  'enable  lighting to colours
End Sub
'MY OWN ROTATE TO SET UP THE FACES
Type v3
    As Single x,y,z
End Type
Operator + (v1 As V3,v2 As V3) As V3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator * (f As Single,v1 As V3) As V3 'scalar*V3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator

Function RotatePoint(c As V3,p As v3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)
End Function

'SET UP THE EIGHT FACES
Redim Shared As V3 a(1 To 4) 'For starters
Dim Shared As V3 normals(1 To 52)

Dim As V3 ctr=Type(0,0,0)            'rotate about gl origin
Dim As Double z=1.207106781186547*2+14.4  'z value of first face
Dim As Double r=2*4*Atn(1)/52 'rotate angle (360/8)

'first face (FRONT)
glTexCoord2f( 1,1)
a(1)=Type( 1, 1, z)
glTexCoord2f( 0,1)
a(2)=Type(-1, 1, z)
glTexCoord2f( 0,0)
a(3)=Type(-1,-1, z)
glTexCoord2f( 1,0)
a(4)=Type( 1,-1, z)

Var c=.5*(a(1)+a(3))
normals(1)=c
Dim As v3 sc=(1,1.00,1)
Dim Shared As v3 centroid(1 To 52),rt(1 To 52)
centroid(1)=Type(0,0,z)
For z As Long=1 To 51'7
    Var n=Ubound(a)
    Redim Preserve a(1 To Ubound(a)+4)
    'rotate the faces, four corners at a time around (0,0,0), angle r
    a(n+1)=RotatePoint(ctr,a(n+1-4),Type(r,0,0),sc)
    a(n+2)=RotatePoint(ctr,a(n+2-4),Type(r,0,0),sc)
    a(n+3)=RotatePoint(ctr,a(n+3-4),Type(r,0,0),sc)
    a(n+4)=RotatePoint(ctr,a(n+4-4),Type(r,0,0),sc)
    c=.5*(a(n+1)+a(n+3))
    normals(z+1)=c
    centroid(z+1)=.5*(a(n+1)+a(n+3))
Next z
For n As Long=1 To 52
    Var l=Sqr(normals(n).x^2+normals(n).y^2 +normals(n).z^2)
    normals(n)=(1/l)*normals(n) 'normalize
Next n
'sleep
'NOW WE HAVE EIGHT FACES DONE And THE NORMALS TO EACH FACE.
'three subs to switch from perspective to ortho and back
Sub remember_current_projection
    glMatrixMode GL_PROJECTION
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
End Sub

Sub set_projection_ortho
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    ' gldisable GL_LIGHTING
End Sub

Sub restore_previous_projection
    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
   ' glEnable GL_LIGHTING
End Sub

'gl text
Sub drawstring(xpos As Long,ypos As Long,text As String,colour() As Double,size As Single,textangle As Single=0,charangle As Single=0)
    glColor4f (colour(1),colour(2),colour(3),colour(4))
    glend
    glLineWidth(1.1*size)
    glBegin (GL_LINES)
    Type point2d
        As Single x,y
    End Type
    Dim As Long flag,codenum=256
    If Instr(text,"|") Then flag=1
    Static As Long runflag
    Static As point2d infoarray()
    Redim Preserve As point2d infoarray(64,codenum) '64 = 8 x 8 pixel size
    If runflag=0 Then   '                  'scan codenum of codepage once
        Dim As Ulong background=0
        Screenres 10,10  '8 x 8 pixels on this screen
        Dim count As Long
        For ch As Long=1 To codenum
            Cls
            Draw String(1,1),Chr(ch)
            For x As Long=1 To 8  'scan for characters
                For y As Long=1 To 8
                    If Point(x,y)<>background Then
                        count=count+1
                        infoarray(count,ch)=Type<point2d>(x,y)'save pixel position
                    End If
                Next y
            Next x
            count=0
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As point2d temp(1 To 64,codenum),np
   
    Dim As Single cr=.01745329,sta=Sin(textangle*cr),cta=Cos(textangle*cr), _
    sca=Sin(charangle*cr),cca=Cos(charangle*cr),_
    d_x=(size/2)*cta,d_y=(size/2)*sta
   
    #macro rotate(p1,p2,c,s,d)
    np.x=d*(C*(p2.x-p1.x)-S*(p2.y-p1.y)) +p1.x
    np.y=d*(S*(p2.x-p1.x)+C*(p2.y-p1.y)) +p1.y
    #endmacro
   
   
    Dim As point2d cpt(1 To 64),c=Type<point2d>(xpos,ypos),c2
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        If asci=124 Then
            If charangle<>0 Then xpos=xpos+12*Sin(charangle*cr)
            dx=xpos:dy=dy+12:Goto skip 'pipe | for new line
        End If
        For _x1 As Long=1 To 64
            temp(_x1,asci).x=infoarray(_x1,asci).x+dx
            temp(_x1,asci).y=infoarray(_x1,asci).y+dy
            rotate(c,temp(_x1,asci),cta,sta,size)
            cpt(_x1)=np
            Var copyy=np.y
            If charangle<>0 Then
                Dim As Long p
                If flag Then  p=1 Else  p=(z6-1)
                c2=Type<point2d>(xpos+(size*8)*p*(Cos(textangle*cr)),ypos+(size*8)*p*(Sin(textangle*cr)))
                rotate(c2,cpt(_x1),cca,sca,1)
                If flag Then np.y=copyy
                cpt(_x1)=np
            End If
            If infoarray(_x1,asci).x<>0 Then 'paint only relevant points
                If Abs(size)>0 Then
                    glVertex3f (cpt(_x1).x-d_x,(cpt(_x1).y-d_y),0)
                    glVertex3f (cpt(_x1).x+d_x,(cpt(_x1).y+d_y),0)
                End If
            End If
        Next _x1
        dx=dx+8+4*(Sin(charangle*cr))*flag
        skip:
    Next z6
    glend
End Sub
'initialize the fonts

Sub init Constructor 'automatic loader
    Dim As Double col(1 To 4)
    drawstring(0,0,"",col(),0)
    Screen 0
End Sub

Sub DrawFaces(Byval rotangle As Single,x As Single,y As Single,Byval Z As Single,flag As Long=1)
    glEnable( GL_TEXTURE_2D )
    Dim As Single pi=4*Atn(1)
    glLoadIdentity()
    glTranslatef(x,y,Z)
    glRotatef(rotangle,1,0,0)           ' Rotate
    Dim As Long n=0
    Static As Long i
    i=i+1
    If i>5 Then i=1
    glcolor4f(0,0,0,1)
    For z As Long=1 To 52
        if z>1 and z<=13 then glcolor4f(1,0,0,1)
        if z>=14 and z<=26 then glcolor4f(1,0,0,1)
        if z>=27 and z<=39 then glcolor4f(0,0,0,1)
        if z>=40 and z<=52 then glcolor4f(0,0,0,1)
        glBindTexture(GL_TEXTURE_2D, tex(z))
        glBegin(GL_QUADS)
        rt(z)=RotatePoint(Type(0,0,0),centroid(z),Type(rotangle*pi/180,0,0),Type(1,1,1))
        glNormal3f normals(z).x,normals(z).y,normals(z).z
        If rt(z).z>0 Then
            If rt(z).y<5.5 And rt(z).y>-5.5 Then  '5.5 7.2
                If Abs(rt(z).y)<1 Then drums(i)=z '' A SCORE, THE DRUM IS CENTRAL
                glTexCoord2f( 1,0)'1 0
                glVertex3f(a(n+1).x,a(n+1).y,a(n+1).z)
                glTexCoord2f( 0,0)'0 0
                glVertex3f(a(n+2).x,a(n+2).y,a(n+2).z)
                glTexCoord2f(0,1)'0 1
                glVertex3f(a(n+3).x,a(n+3).y,a(n+3).z)
                glTexCoord2f(1,1)'1 1
                glVertex3f(a(n+4).x,a(n+4).y,a(n+4).z)
            End If
        End If
        n=n+4
        glend
    Next z
   
    glend
    gldisable( GL_TEXTURE_2D )
End Sub


Function nearest(a As Single) As Single
    Dim As Single pts(1 To 52),ctr
    For z As Single=0 To 360 Step (360/52)
        ctr+=1
        If ctr>52 Then Exit For
        pts(ctr)=z
    Next z
    For z As Long=1 To 52
        If Abs(pts(z)-a) <= 6 Then Return pts(z)'45
    Next z
End Function


dim as string card(1 to 13)
card(01) = " A"
card(02) = " 2"
card(03) = " 3"
card(04) = " 4"
card(05) = " 5"
card(06) = " 6"
card(07) = " 7"
card(08) = " 8"
card(09) = " 9"
card(10) = "10"
card(11) = " J"
card(12) = " Q"
card(13) = " K"
dim as any ptr face(52)
dim as string suit(1 to 4) = {chr(3),chr(4),chr(5),chr(6)}
dim as ubyte num=1
for n as integer=1 to ubound(face)
   
    face(n)=imagecreate(128,128,rgba(255,255,255,255))
   
    if n>=1  and n<=13 then DrawFont(face(n),10,35,str(card(num))+""+ suit(1) ,"TERMINAL",40,rgba(200,0,0,254))
    if n>=14 and n<=26 then DrawFont(face(n),10,35,str(card(num))+""+ suit(2) ,"TERMINAL",40,rgba(200,0,0,254))
    if n>=27 and n<=39 then DrawFont(face(n),10,35,str(card(num))+""+ suit(3) ,"TERMINAL",40,rgba(0  ,0,0,254))
    if n>=40 and n<=52 then DrawFont(face(n),10,35,str(card(num))+""+ suit(4) ,"TERMINAL",40,rgba(0  ,0,0,254))
   
    line face(n),(0,0)-(127,127),0,b
   face(n)=filter(face(n),1)
    num+=1
    if num=14 then num=1
   
next n
For n As Long=1 To 52
    tex(n)=settexture(face(n))
Next n

dim shared as string W(1 to 5 , 1 to 52)
W(1,01) = "01-H" : W(2,01) = "01-H" : W(3,01) = "01-H" : W(4,01) = "01-H" : W(5,01) = "01-H"
W(1,02) = "02-H" : W(2,02) = "02-H" : W(3,02) = "02-H" : W(4,02) = "02-H" : W(5,02) = "02-H"
W(1,03) = "03-H" : W(2,03) = "03-H" : W(3,03) = "03-H" : W(4,03) = "03-H" : W(5,03) = "03-H"
W(1,04) = "04-H" : W(2,04) = "04-H" : W(3,04) = "04-H" : W(4,04) = "04-H" : W(5,04) = "04-H"
W(1,05) = "05-H" : W(2,05) = "05-H" : W(3,05) = "05-H" : W(4,05) = "05-H" : W(5,05) = "05-H"
W(1,06) = "06-H" : W(2,06) = "06-H" : W(3,06) = "06-H" : W(4,06) = "06-H" : W(5,06) = "06-H"
W(1,07) = "07-H" : W(2,07) = "07-H" : W(3,07) = "07-H" : W(4,07) = "07-H" : W(5,07) = "07-H"
W(1,08) = "08-H" : W(2,08) = "08-H" : W(3,08) = "08-H" : W(4,08) = "08-H" : W(5,08) = "08-H"
W(1,09) = "09-H" : W(2,09) = "09-H" : W(3,09) = "09-H" : W(4,09) = "09-H" : W(5,09) = "09-H"
W(1,10) = "10-H" : W(2,10) = "10-H" : W(3,10) = "10-H" : W(4,10) = "10-H" : W(5,10) = "10-H"
W(1,11) = "11-H" : W(2,11) = "11-H" : W(3,11) = "11-H" : W(4,11) = "11-H" : W(5,11) = "11-H"
W(1,12) = "12-H" : W(2,12) = "12-H" : W(3,12) = "12-H" : W(4,12) = "12-H" : W(5,12) = "12-H"
W(1,13) = "13-H" : W(2,13) = "13-H" : W(3,13) = "13-H" : W(4,13) = "13-H" : W(5,13) = "13-H"
W(1,14) = "01-D" : W(2,14) = "01-D" : W(3,14) = "01-D" : W(4,14) = "01-D" : W(5,14) = "01-D"
W(1,15) = "02-D" : W(2,15) = "02-D" : W(3,15) = "02-D" : W(4,15) = "02-D" : W(5,15) = "02-D"
W(1,16) = "03-D" : W(2,16) = "03-D" : W(3,16) = "03-D" : W(4,16) = "03-D" : W(5,16) = "03-D"
W(1,17) = "04-D" : W(2,17) = "04-D" : W(3,17) = "04-D" : W(4,17) = "04-D" : W(5,17) = "04-D"
W(1,18) = "05-D" : W(2,18) = "05-D" : W(3,18) = "05-D" : W(4,18) = "05-D" : W(5,18) = "05-D"
W(1,19) = "06-D" : W(2,19) = "06-D" : W(3,19) = "06-D" : W(4,19) = "06-D" : W(5,19) = "06-D"
W(1,20) = "07-D" : W(2,20) = "07-D" : W(3,20) = "07-D" : W(4,20) = "07-D" : W(5,20) = "07-D"
W(1,21) = "08-D" : W(2,21) = "08-D" : W(3,21) = "08-D" : W(4,21) = "08-D" : W(5,21) = "08-D"
W(1,22) = "09-D" : W(2,22) = "09-D" : W(3,22) = "09-D" : W(4,22) = "09-D" : W(5,22) = "09-D"
W(1,23) = "10-D" : W(2,23) = "10-D" : W(3,23) = "10-D" : W(4,23) = "10-D" : W(5,23) = "10-D"
W(1,24) = "11-D" : W(2,24) = "11-D" : W(3,24) = "11-D" : W(4,24) = "11-D" : W(5,24) = "11-D"
W(1,25) = "12-D" : W(2,25) = "12-D" : W(3,25) = "12-D" : W(4,25) = "12-D" : W(5,25) = "12-D"
W(1,26) = "13-D" : W(2,26) = "13-D" : W(3,26) = "13-D" : W(4,26) = "13-D" : W(5,26) = "13-D"
W(1,27) = "01-C" : W(2,27) = "01-C" : W(3,27) = "01-C" : W(4,27) = "01-C" : W(5,27) = "01-C"
W(1,28) = "02-C" : W(2,28) = "02-C" : W(3,28) = "02-C" : W(4,28) = "02-C" : W(5,28) = "02-C"
W(1,29) = "03-C" : W(2,29) = "03-C" : W(3,29) = "03-C" : W(4,29) = "03-C" : W(5,29) = "03-C"
W(1,30) = "04-C" : W(2,30) = "04-C" : W(3,30) = "04-C" : W(4,30) = "04-C" : W(5,30) = "04-C"
W(1,31) = "05-C" : W(2,31) = "05-C" : W(3,31) = "05-C" : W(4,31) = "05-C" : W(5,31) = "05-C"
W(1,32) = "06-C" : W(2,32) = "06-C" : W(3,32) = "06-C" : W(4,32) = "06-C" : W(5,32) = "06-C"
W(1,33) = "07-C" : W(2,33) = "07-C" : W(3,33) = "07-C" : W(4,33) = "07-C" : W(5,33) = "07-C"
W(1,34) = "08-C" : W(2,34) = "08-C" : W(3,34) = "08-C" : W(4,34) = "08-C" : W(5,34) = "08-C"
W(1,35) = "09-C" : W(2,35) = "09-C" : W(3,35) = "09-C" : W(4,35) = "09-C" : W(5,35) = "09-C"
W(1,36) = "10-C" : W(2,36) = "10-C" : W(3,36) = "10-C" : W(4,36) = "10-C" : W(5,36) = "10-C"
W(1,37) = "11-C" : W(2,37) = "11-C" : W(3,37) = "11-C" : W(4,37) = "11-C" : W(5,37) = "11-C"
W(1,38) = "12-C" : W(2,38) = "12-C" : W(3,38) = "12-C" : W(4,38) = "12-C" : W(5,38) = "12-C"
W(1,39) = "13-C" : W(2,39) = "13-C" : W(3,39) = "13-C" : W(4,39) = "13-C" : W(5,39) = "13-C"
W(1,40) = "01-S" : W(2,40) = "01-S" : W(3,40) = "01-S" : W(4,40) = "01-S" : W(5,40) = "01-S"
W(1,41) = "02-S" : W(2,41) = "02-S" : W(3,41) = "02-S" : W(4,41) = "02-S" : W(5,41) = "02-S"
W(1,42) = "03-S" : W(2,42) = "03-S" : W(3,42) = "03-S" : W(4,42) = "03-S" : W(5,42) = "03-S"
W(1,43) = "04-S" : W(2,43) = "04-S" : W(3,43) = "04-S" : W(4,43) = "04-S" : W(5,43) = "04-S"
W(1,44) = "05-S" : W(2,44) = "05-S" : W(3,44) = "05-S" : W(4,44) = "05-S" : W(5,44) = "05-S"
W(1,45) = "06-S" : W(2,45) = "06-S" : W(3,45) = "06-S" : W(4,45) = "06-S" : W(5,45) = "06-S"
W(1,46) = "07-S" : W(2,46) = "07-S" : W(3,46) = "07-S" : W(4,46) = "07-S" : W(5,46) = "07-S"
W(1,47) = "08-S" : W(2,47) = "08-S" : W(3,47) = "08-S" : W(4,47) = "08-S" : W(5,47) = "08-S"
W(1,48) = "09-S" : W(2,48) = "09-S" : W(3,48) = "09-S" : W(4,48) = "09-S" : W(5,48) = "09-S"
W(1,49) = "10-S" : W(2,49) = "10-S" : W(3,49) = "10-S" : W(4,49) = "10-S" : W(5,49) = "10-S"
W(1,50) = "11-S" : W(2,50) = "11-S" : W(3,50) = "11-S" : W(4,50) = "11-S" : W(5,50) = "11-S"
W(1,51) = "12-S" : W(2,51) = "12-S" : W(3,51) = "12-S" : W(4,51) = "12-S" : W(5,51) = "12-S"
W(1,52) = "13-S" : W(2,52) = "13-S" : W(3,52) = "13-S" : W(4,52) = "13-S" : W(5,52) = "13-S"
Function Idx(angle As Single) As Integer
    var q=(angle/(360/52))
    q=53-q
    If q=53 Then q=1
    Return q
End Function

Dim As Long fps
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================

glsetup

START:
   
    Randomize timer
   
    dim as single k1,k2,k3,k4,k5
    dim as integer i(1 to 5)={1,2,3,4,5}
    for n as integer=1 to rnd*100
        swap i(range(1,5)),i(range(1,5))
    next n
    k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)
   
dim as long flag=1,toggle,counter=0,starter=1,cflag
Dim As Single angle1,angle2,angle3,angle4,angle5
Dim As String ink
Dim As Long f1,f2,f3,f4,f5,diff=30
Dim As Long spent,gain,score,check,won
Dim As string t(1 to 5) , text
dim as ubyte v(1 to 5)
dim as integer s(1 to 5)={1,1,1,1,1}
Windowtitle "Five Deck Maverick"

Do
   
    if s(1) then angle1+=k1
    if s(2) then angle2+=k2
    if s(3) then angle3+=k3
    if s(4) then angle4+=k4
    if s(5) then angle5+=k5
   
    If angle1>=360 Then angle1=0
    If angle2>=360 Then angle2=0
    If angle3>=360 Then angle3=0
    If angle4>=360 Then angle4=0
    If angle5>=360 Then angle5=0
   
    glEnable (GL_CULL_FACE)
    glClear(GL_COLOR_BUFFER_BIT)
   
    dim as single zz=-30 - (xres/275)
    DrawFaces(angle1, -4.1  ,0 ,zz ,1)
    DrawFaces(angle2, -2.05 ,0 ,zz ,2)
    DrawFaces(angle3, +-0   ,0 ,zz ,3)
    DrawFaces(angle4, +2.05 ,0 ,zz ,4)
    DrawFaces(angle5, +4.1  ,0 ,zz ,5)

    remember_current_projection
    set_projection_ortho
   
    'glLoadIdentity()
    'glTranslatef(0,0,0)
    glbegin gl_Quads
    glcolor4f  0,.2,0,1
    glvertex2d xres,0
    glvertex2d 0   ,0
    glvertex2d 0   ,yres/6.5
    glvertex2d xres,yres/6.5
   
    glvertex2d xres,yres-yres/6.5
    glvertex2d 0   ,yres-yres/6.5
    glvertex2d 0   ,yres
    glvertex2d xres,yres
   
    glend
   
    drawstring(xres/2.575,yres/1.025 ,"( Press b for payouts. )" , textcol2(),yres/600)
    drawstring(xres/4.35,yres/31,"Spent  = " + str(spent) , textcol(),yres/245)
    drawstring(xres/4.35,yres/12,"Payout = " + Str(gain)  , textcol(),yres/245)
    'drawstring(0,yres-30 ,"Framerate "&fps,textcol(),1)
    drawstring(xres/1.75 , yres/15     ,"Diff = " + Str(gain-spent)  , textcol(),yres/245)
    drawstring(xres/3.20,yres/1.075,"Press ""space bar"" to Spin",textcol(),yres/400)
    If f5 Then
        drawstring(xres/3.75,yres/1.15, str(v(1)) ,textcol2(),yres/245)
        drawstring(xres/2.75,yres/1.15, str(v(2)) ,textcol2(),yres/245)
        drawstring(xres/2.10,yres/1.15, str(v(3)) ,textcol2(),yres/245)
        drawstring(xres/1.70,yres/1.15, str(v(4)) ,textcol2(),yres/245)
        drawstring(xres/1.40,yres/1.15, str(v(5)) ,textcol2(),yres/245)
    end if
    gllinewidth 8
    glbegin gl_lines
    glcolor3f(1,0,0)
    glvertex2f(xres/4.89,yres/1.72): glvertex2f(xres/1.2575,yres/1.72)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/1.2575,yres/2.38)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/4.89  ,yres/1.72)
    glvertex2f(xres/1.2575,yres/2.38): glvertex2f(xres/1.2575,yres/1.72)
    glend
    restore_previous_projection
    Flip
   
    'toggle and spacebar stuff
    If flag Then
        flag=0
        angle1=nearest(angle1)
        angle2=nearest(angle2)
        angle3=nearest(angle3)
        angle4=nearest(angle4)
        angle5=nearest(angle5)
    Else
        counter+=1
        'stop wheels one after the other
        If counter= (45*01) Then f1=1
        If counter= (45*02) Then f2=1
        If counter= (45*03) Then f3=1
        If counter =(45*04) Then f4=1
        If counter =(45*05) Then f5=1 : score=1 'now get scores
        If counter =(45*06) Then speak(text)
       
        If f1=1 and s(1) Then
            var n=nearest(angle1)
            If angle1>n Then k1=-.5 Else  k1=.5
            If Abs(n-angle1)<=2 Then k1=0:angle1=n:s(1)=0
            t(1)= w(1,Idx(n))
        End If
       
        If f2=1 and s(2) Then
            var n=nearest(angle2)
            If angle2>n Then k2=-.5 Else k2=.5
            If Abs(n-angle2)<=2 Then k2=0:angle2=n:s(2)=0
            t(2)= w(2,Idx(n))
        End If
       
        If f3=1 and s(3) Then
            var n=nearest(angle3)
            If angle3>n Then k3= -.5 Else k3=.5
            If Abs(n-angle3)<=2 Then k3=0:angle3=n: s(3)=0
            t(3)= w(3,Idx(n))
        End If
       
        If f4=1 and s(4) Then
            var n=nearest(angle4)
            If angle4>n Then k4= -.5 Else k4=.5
            If Abs(n-angle4)<=2 Then k4=0:angle4=n: s(4)=0
            t(4)= w(4,Idx(n))
        End If
   
        If f5=1 and s(5) Then
            Var n=nearest(angle5)
            If angle5>n Then k5=-.5 else k5=.5
            If Abs(angle5-n)<=2 Then k5=0:angle5=n: s(5)=0
            t(5)= w(5,Idx(n))
        end if
    end if
   
    k1=.995*k1
    k2=.995*k2
    k3=.995*k3
    k4=.995*k4
    k5=.995*k5
   
    if score = 1 then
       
        text = ""
        dim as integer value=0
        dim as ubyte flush=0
       
        'sort lowest to highest
        v(1)=val(left(t(1),2))
        v(2)=val(left(t(2),2))
        v(3)=val(left(t(3),2))
        v(4)=val(left(t(4),2))
        v(5)=val(left(t(5),2))
        for a as longint = 1 to 5
            for b as longint = 1 to 5
                if v(a)<=v(b) then swap v(a),v(b)
            next
        next
       
        'check for flush
        dim as string*1 suit(1 to 5)
        suit(1) = right(t(1),1)
        suit(2) = right(t(2),1)
        suit(3) = right(t(3),1)
        suit(4) = right(t(4),1)
        suit(5) = right(t(5),1)
        if suit(1)=suit(2) and suit(1)=suit(3) and suit(1)=suit(4) and suit(1)=suit(5) then flush=1

        'check for pairs
        for a as longint = 1 to 5
            for b as longint = a+1 to 5
                if v(a) = v(b) then value+=1
            next
        next
       
        'check pair for (tens or better)
        if value = 1 then
            for a as longint = 1 to 5
                for b as longint = a+1 to 5
                    if v(a) = v(b) then
                        if v(a)=1 or v(a)>=10 then
                            value=1
                        else
                            value=0
                            if flush = 0 then text = "you need tens or better to score "
                        end if
                    end if
                next
            next
        end if   
        '    1 pair (tens or better)   = 1
        '    2 pair                    = 5
        '    3 of a kind               = 10
        '    straight                  = 15
        '    skip straight (1,3,5,7,9) = 15
        '    flush (with any hand)     =+25
        '    fullhouse                 = 35
        '    4 of a kind               = 100
        '    royal straight            = 150
        '    straight flush            = 250
        '    5 of a kind               = 1000
        '    5 of a kind flush         = 2000
        '    royal straight flush      = 4000
        if value=1  then value=1    : text = "you got a pair tens or better " : goto DONE
        if value=2  then value=5    : text = "you got two pairs "             : goto DONE
        if value=3  then value=10   : text = "you got three of a kind "       : goto DONE
        if value=4  then value=35   : text = "you got a full house "          : goto DONE
        if value=6  then value=100  : text = "you got four of a kind "        : goto DONE
        if value=10 then value=1000 : text = "you got five of a kind "        : goto DONE
       
        DONE:
       
        'check for straight
        if v(2)=v(1)+1 and v(3)=v(2)+1 and v(4)=v(3)+1 and v(5)=v(4)+1 then
            value=15
            text= "you got a straight "
        end if
       
        'check for even skip straights
        if v(1)=2 and v(2)=4 and v(3)=6 and v(4)=8 and v(5)=10  then
            value=15
            text= "you got a skip straight "  ' 2,4,6,8,10
        end if
        if v(1)=4 and v(2)=6 and v(3)=8 and v(4)=10 and v(5)=12  then
            value=15
            text= "you got a skip straight "  ' 4,6,8,10,12
        end if
        if v(1)=6 and v(2)=8 and v(3)=10 and v(4)=12 and v(5)=1  then
            value=15
            text= "you got a skip straight "  ' 6,8,10,12,1
        end if
       
        'check for odd skip straights
        if v(1)=1 and v(2)=3 and v(3)=5 and v(4)=7 and v(5)=9   then
            value=15
            text= "you got a skip straight "  ' 1,3,5,7,9
        end if
        if v(1)=3 and v(2)=5 and v(3)=7 and v(4)=9  and v(5)=11  then
            value=15
            text= "you got a skip straight "  ' 3,5,7,9,11
        end if
        if v(1)=5 and v(2)=7 and v(3)=9  and v(4)=11 and v(5)=13 then
            value=15
            text= "you got a skip straight "  ' 5,7,9,11,13
        end if
       
        'check for royal straight
        if v(2)=10 and v(3)=11 and v(4)=12 and v(5)=13 and v(1)=1 then
            value=150
            text= "you got a royal straight "
        end if
       
        if flush then
            value+=25
            if text ="you got a royal straight " then value = 4000
            if text ="you got five of a kind "   then value = 2000
            text+= "and it's a flush."
        end if
       
        if value=0 then text+= "You Lost."
        if value>0 then text+= " You Won" + str(value) + "Dollars."
        if  value>0 then gain+=value:value=0
        score=0
    end if

    ink = Inkey
   
    If toggle = 0 Then
        If ink = " " and counter >=(45*06) Then
            for n as integer=1 to 5
                s(n)=1
            next n
            flag=1:toggle=1:counter=0:f1=0:f2=0:f3=0:f4=0:f5=0:diff=range(0,60):spent+=1:cflag=0
            randomize timer
        end if
        toggle=0
    Else
        dim as integer i(1 to 5)={5,4,3,2,1}
        for n as integer=1 to rnd*100
            swap i(range(1,5)),i(range(1,5))
        next n
        k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)
    End If
   
    toggle=Len(ink)
   
    Sleep regulate(40,fps),1
   
    dim as double TT=timer
    dim as long lt
    dim as string dt
    if ink="b" then
        do
        dim as long t=int(timer)
        ink=""
        screenset 1,1
        glEnable (GL_CULL_FACE)
        glClear(GL_COLOR_BUFFER_BIT)
       
        remember_current_projection
        set_projection_ortho
       
            drawstring(0,yres/100 ,"1 Pair (tens or better)   = 1    " , textcol(),yres/350)
            drawstring(0,yres/28  ,"2 Pair                    = 5    " , textcol(),yres/350)
            drawstring(0,yres/14  ,"3 of a kind               = 10   " , textcol(),yres/350)
            drawstring(0,yres/10  ,"Straight                  = 15   " , textcol(),yres/350)
            drawstring(0,yres/7.75,"Skip straight (1,3,5,7,9) = 15   " , textcol(),yres/350)
            drawstring(0,yres/6   ,"Flush (with any hand)     =+25   " , textcol(),yres/350)
            drawstring(0,yres/5   ,"Fullhouse                 = 35   " , textcol(),yres/350)
            drawstring(0,yres/4.25,"4 of a kind               = 100  " , textcol(),yres/350)
            drawstring(0,yres/3.75,"Royal straight            = 150  " , textcol(),yres/350)
            drawstring(0,yres/3.25,"Straight flush            = 250  " , textcol(),yres/350)
            drawstring(0,yres/2.95,"5 of a kind               = 1000 " , textcol(),yres/350)
            drawstring(0,yres/2.65,"5 of a kind flush         = 2000 " , textcol(),yres/350)
            drawstring(0,yres/2.45,"Royal straight flush      = 4000 " , textcol(),yres/350)
        if lt<>t then dt+="."
        lt=t
           drawstring(0,yres/2,"Wait five " &dt , textcol2(),1)
        glend
        restore_previous_projection
        flip
        if (timer-tt)>5 then exit do
        loop
        screenset 0,0
    end if

Loop Until ink=Chr(27)

for a as longint = 1 to 52
    ImageDestroy face(a)
next

END
 
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Number Trick

Postby albert » Sep 06, 2020 2:03

For "Five Deck Maverick"

Here's the "Linux" source
You need to install "Flite" to get the speech engine to work..

Code: Select all


'===============================================================================
#Include Once "GL/glu.bi"
#include Once "GL/glext.bi"
#include "windows.bi"
#include "fbgfx.bi"

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
#define Frange(f,l) Rnd*((l)-(f))+(f)

Dim Shared As integer xres,yres
'xres=320
'yres=200
'xres=640
'yres=480
xres=800
yres=600
'xres=1024
'yres=768
Screenres xres,yres,32,2,2 'or 1
screenset 0,0

Dim Shared As GLuint tex(1 To 52)
Dim Shared As Long drums(1 To 5)
Function Filter(Byref tim As Uinteger Pointer,_
    byval rad As Single,_
    byval destroy As Integer=1,_
    byval fade As Integer=0) As Uinteger Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Integer x,y
        As Uinteger col
    End Type
    #macro p_point(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Integer=-ymin To ymax
        For x1 As Integer=-xmin To xmax
            inc=inc+1
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Uinteger Pointer im=Imagecreate(_x,_y)
    Dim As Integer pitch
    Dim  As Any Pointer row
    Dim As Uinteger Pointer pixel
    Dim As Uinteger col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Integer=0 To (_y)-1
        For x As Integer=0 To (_x)-1
            p_point(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Uinteger averagecolour
    Dim As Integer ar,ag,ab
    Dim As Integer xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Integer=0 To _y-1
        For x As Integer=0 To _x-1
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function

Function settexture(image As Any Ptr) As gluint
    Dim As gluint texture
    glGenTextures(1, @texture)
    glBindTexture( GL_TEXTURE_2D, texture )
    glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
    Return texture
End Function

Dim Shared LightDiffuse(0 To 3) As Single ={1,1,1,1}
Dim Shared LightPosition(0 To 3) As Single ={0,0,1,1}'
Dim Shared As Double textcol(1 To 4 )={.5,.5,1,1}
Dim Shared As Double textcol2(1 To 4 )={1,1,1,1}

Sub glsetup
    glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glEnable GL_ALPHA
    glEnable GL_BLEND
    glViewport(0, 0, xres, yres)       ' Set the viewport
    glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
    glLoadIdentity                     ' Reset View
    gluPerspective(45, xres/yres, 1, 100)
    glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
    glLoadIdentity                     '  Reset View
    glClearColor 0,.2,0,1              'background
    'Set up the light
    Exit Sub
    glLightfv GL_LIGHT1, GL_DIFFUSE, @LightDiffuse(0)
    glLightfv GL_LIGHT1, GL_POSITION, @LightPosition(0)
    glEnable GL_LIGHT1
   
    'Enable lighting
    glEnable GL_LIGHTING
    glEnable GL_COLOR_MATERIAL  'enable  lighting to colours
End Sub
'MY OWN ROTATE TO SET UP THE FACES
Type v3
    As Single x,y,z
End Type
Operator + (v1 As V3,v2 As V3) As V3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator * (f As Single,v1 As V3) As V3 'scalar*V3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator

Function RotatePoint(c As V3,p As v3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)
End Function

'SET UP THE EIGHT FACES
Redim Shared As V3 a(1 To 4) 'For starters
Dim Shared As V3 normals(1 To 52)

Dim As V3 ctr=Type(0,0,0)            'rotate about gl origin
Dim As Double z=1.207106781186547*2+14.4  'z value of first face
Dim As Double r=2*4*Atn(1)/52 'rotate angle (360/8)

'first face (FRONT)
glTexCoord2f( 1,1)
a(1)=Type( 1, 1, z)
glTexCoord2f( 0,1)
a(2)=Type(-1, 1, z)
glTexCoord2f( 0,0)
a(3)=Type(-1,-1, z)
glTexCoord2f( 1,0)
a(4)=Type( 1,-1, z)

Var c=.5*(a(1)+a(3))
normals(1)=c
Dim As v3 sc=(1,1.00,1)
Dim Shared As v3 centroid(1 To 52),rt(1 To 52)
centroid(1)=Type(0,0,z)
For z As Long=1 To 51'7
    Var n=Ubound(a)
    Redim Preserve a(1 To Ubound(a)+4)
    'rotate the faces, four corners at a time around (0,0,0), angle r
    a(n+1)=RotatePoint(ctr,a(n+1-4),Type(r,0,0),sc)
    a(n+2)=RotatePoint(ctr,a(n+2-4),Type(r,0,0),sc)
    a(n+3)=RotatePoint(ctr,a(n+3-4),Type(r,0,0),sc)
    a(n+4)=RotatePoint(ctr,a(n+4-4),Type(r,0,0),sc)
    c=.5*(a(n+1)+a(n+3))
    normals(z+1)=c
    centroid(z+1)=.5*(a(n+1)+a(n+3))
Next z
For n As Long=1 To 52
    Var l=Sqr(normals(n).x^2+normals(n).y^2 +normals(n).z^2)
    normals(n)=(1/l)*normals(n) 'normalize
Next n
'sleep
'NOW WE HAVE EIGHT FACES DONE And THE NORMALS TO EACH FACE.
'three subs to switch from perspective to ortho and back
Sub remember_current_projection
    glMatrixMode GL_PROJECTION
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
End Sub

Sub set_projection_ortho
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    ' gldisable GL_LIGHTING
End Sub

Sub restore_previous_projection
    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
   ' glEnable GL_LIGHTING
End Sub

'gl text
Sub drawstring(xpos As Long,ypos As Long,text As String,colour() As Double,size As Single,textangle As Single=0,charangle As Single=0)
    glColor4f (colour(1),colour(2),colour(3),colour(4))
    glend
    glLineWidth(1.1*size)
    glBegin (GL_LINES)
    Type point2d
        As Single x,y
    End Type
    Dim As Long flag,codenum=256
    If Instr(text,"|") Then flag=1
    Static As Long runflag
    Static As point2d infoarray()
    Redim Preserve As point2d infoarray(64,codenum) '64 = 8 x 8 pixel size
    If runflag=0 Then   '                  'scan codenum of codepage once
        Dim As Ulong background=0
        Screenres 10,10  '8 x 8 pixels on this screen
        Dim count As Long
        For ch As Long=1 To codenum
            Cls
            Draw String(1,1),Chr(ch)
            For x As Long=1 To 8  'scan for characters
                For y As Long=1 To 8
                    If Point(x,y)<>background Then
                        count=count+1
                        infoarray(count,ch)=Type<point2d>(x,y)'save pixel position
                    End If
                Next y
            Next x
            count=0
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As point2d temp(1 To 64,codenum),np
   
    Dim As Single cr=.01745329,sta=Sin(textangle*cr),cta=Cos(textangle*cr), _
    sca=Sin(charangle*cr),cca=Cos(charangle*cr),_
    d_x=(size/2)*cta,d_y=(size/2)*sta
   
    #macro rotate(p1,p2,c,s,d)
    np.x=d*(C*(p2.x-p1.x)-S*(p2.y-p1.y)) +p1.x
    np.y=d*(S*(p2.x-p1.x)+C*(p2.y-p1.y)) +p1.y
    #endmacro
   
   
    Dim As point2d cpt(1 To 64),c=Type<point2d>(xpos,ypos),c2
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        If asci=124 Then
            If charangle<>0 Then xpos=xpos+12*Sin(charangle*cr)
            dx=xpos:dy=dy+12:Goto skip 'pipe | for new line
        End If
        For _x1 As Long=1 To 64
            temp(_x1,asci).x=infoarray(_x1,asci).x+dx
            temp(_x1,asci).y=infoarray(_x1,asci).y+dy
            rotate(c,temp(_x1,asci),cta,sta,size)
            cpt(_x1)=np
            Var copyy=np.y
            If charangle<>0 Then
                Dim As Long p
                If flag Then  p=1 Else  p=(z6-1)
                c2=Type<point2d>(xpos+(size*8)*p*(Cos(textangle*cr)),ypos+(size*8)*p*(Sin(textangle*cr)))
                rotate(c2,cpt(_x1),cca,sca,1)
                If flag Then np.y=copyy
                cpt(_x1)=np
            End If
            If infoarray(_x1,asci).x<>0 Then 'paint only relevant points
                If Abs(size)>0 Then
                    glVertex3f (cpt(_x1).x-d_x,(cpt(_x1).y-d_y),0)
                    glVertex3f (cpt(_x1).x+d_x,(cpt(_x1).y+d_y),0)
                End If
            End If
        Next _x1
        dx=dx+8+4*(Sin(charangle*cr))*flag
        skip:
    Next z6
    glend
End Sub
'initialize the fonts

Sub init Constructor 'automatic loader
    Dim As Double col(1 To 4)
    drawstring(0,0,"",col(),0)
    Screen 0
End Sub

Sub drawfont(byref im as any ptr=0,byval xpos As long,byval ypos As long,byref text As String,byval colour As Ulong,byval size As Single)
    Type D2
        As Double x,y
        As Ulong col
    End Type
    size=abs(size)
    Static As d2 XY()
    Static As long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As long
        For ch As long=1 To 127
            img=Imagecreate(9,17)
            Draw String img,(1,1),Chr(ch)
            For x As long=1 To 8
                For y As long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.col=p2.col
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As long dx=xpos,dy=ypos,f
    If Abs(size)=1.5 Then f=3 Else f=2
    For z6 As long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)         
            Scale(c,t,size)
            If XY(_x1,asci).x<>0 Then
                If size>1 Then
                    line im,(np.x-size/f,np.y-size/f)-(np.x+size/f,np.y+size/f),np.col,bf
                Else
                     Pset im,(np.x,np.y),np.col
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
End Sub
Sub init2 Constructor
    drawfont(,0,0,"",0,0)
    Screen 0
End Sub

Sub DrawFaces(Byval rotangle As Single,x As Single,y As Single,Byval Z As Single,flag As Long=1)
    glEnable( GL_TEXTURE_2D )
    Dim As Single pi=4*Atn(1)
    glLoadIdentity()
    glTranslatef(x,y,Z)
    glRotatef(rotangle,1,0,0)           ' Rotate
    Dim As Long n=0
    Static As Long i
    i=i+1
    If i>5 Then i=1
    glcolor4f(0,0,0,1)
    For z As Long=1 To 52
        if z>1 and z<=13 then glcolor4f(1,0,0,1)
        if z>=14 and z<=26 then glcolor4f(1,0,0,1)
        if z>=27 and z<=39 then glcolor4f(0,0,0,1)
        if z>=40 and z<=52 then glcolor4f(0,0,0,1)
        glBindTexture(GL_TEXTURE_2D, tex(z))
        glBegin(GL_QUADS)
        rt(z)=RotatePoint(Type(0,0,0),centroid(z),Type(rotangle*pi/180,0,0),Type(1,1,1))
        glNormal3f normals(z).x,normals(z).y,normals(z).z
        If rt(z).z>0 Then
            If rt(z).y<5.5 And rt(z).y>-5.5 Then  '5.5 7.2
                If Abs(rt(z).y)<1 Then drums(i)=z '' A SCORE, THE DRUM IS CENTRAL
                glTexCoord2f( 1,0)'1 0
                glVertex3f(a(n+1).x,a(n+1).y,a(n+1).z)
                glTexCoord2f( 0,0)'0 0
                glVertex3f(a(n+2).x,a(n+2).y,a(n+2).z)
                glTexCoord2f(0,1)'0 1
                glVertex3f(a(n+3).x,a(n+3).y,a(n+3).z)
                glTexCoord2f(1,1)'1 1
                glVertex3f(a(n+4).x,a(n+4).y,a(n+4).z)
            End If
        End If
        n=n+4
        glend
    Next z
   
    glend
    gldisable( GL_TEXTURE_2D )
End Sub


Function nearest(a As Single) As Single
    Dim As Single pts(1 To 52),ctr
    For z As Single=0 To 360 Step (360/52)
        ctr+=1
        If ctr>52 Then Exit For
        pts(ctr)=z
    Next z
    For z As Long=1 To 52
        If Abs(pts(z)-a) <= 6 Then Return pts(z)'45
    Next z
End Function


dim as string card(1 to 13)
card(01) = " A"
card(02) = " 2"
card(03) = " 3"
card(04) = " 4"
card(05) = " 5"
card(06) = " 6"
card(07) = " 7"
card(08) = " 8"
card(09) = " 9"
card(10) = "10"
card(11) = " J"
card(12) = " Q"
card(13) = " K"
dim as any ptr face(52)
dim as string suit(1 to 4) = {chr(3),chr(4),chr(5),chr(6)}
dim as ubyte num=1
for n as integer=1 to ubound(face)
   
    face(n)=imagecreate(128,128,rgba(255,255,255,255))
   
   ' if n>=1  and n<=13 then DrawFont(face(n),10,35,str(card(num))+""+ suit(1) ,"TERMINAL",40,rgba(200,0,0,254))
    'if n>=14 and n<=26 then DrawFont(face(n),10,35,str(card(num))+""+ suit(2) ,"TERMINAL",40,rgba(200,0,0,254))
    'if n>=27 and n<=39 then DrawFont(face(n),10,35,str(card(num))+""+ suit(3) ,"TERMINAL",40,rgba(0  ,0,0,254))
    'if n>=40 and n<=52 then DrawFont(face(n),10,35,str(card(num))+""+ suit(4) ,"TERMINAL",40,rgba(0  ,0,0,254))
   
    if n>=1   and n<=13 then Drawfont(face(n),10,35,str(card(num))+""+ suit(1),rgba(200,0,0,254),4)
    if n>=14 and n<=26 then Drawfont(face(n),10,35,str(card(num))+""+ suit(2),rgba(200,0,0,254),4)
    if n>=27 and n<=39 then Drawfont(face(n),10,35,str(card(num))+""+ suit(3),rgba(0    ,0,0,254),4)
    if n>=40 and n<=52 then Drawfont(face(n),10,35,str(card(num))+""+ suit(4),rgba(0    ,0,0,254),4)
   
    line face(n),(0,0)-(127,127),0,b
    face(n)=filter(face(n),1)
    num+=1
    if num=14 then num=1
   
next n
For n As Long=1 To 52
    tex(n)=settexture(face(n))
Next n

dim shared as string W(1 to 5 , 1 to 52)
W(1,01) = "01-H" : W(2,01) = "01-H" : W(3,01) = "01-H" : W(4,01) = "01-H" : W(5,01) = "01-H"
W(1,02) = "02-H" : W(2,02) = "02-H" : W(3,02) = "02-H" : W(4,02) = "02-H" : W(5,02) = "02-H"
W(1,03) = "03-H" : W(2,03) = "03-H" : W(3,03) = "03-H" : W(4,03) = "03-H" : W(5,03) = "03-H"
W(1,04) = "04-H" : W(2,04) = "04-H" : W(3,04) = "04-H" : W(4,04) = "04-H" : W(5,04) = "04-H"
W(1,05) = "05-H" : W(2,05) = "05-H" : W(3,05) = "05-H" : W(4,05) = "05-H" : W(5,05) = "05-H"
W(1,06) = "06-H" : W(2,06) = "06-H" : W(3,06) = "06-H" : W(4,06) = "06-H" : W(5,06) = "06-H"
W(1,07) = "07-H" : W(2,07) = "07-H" : W(3,07) = "07-H" : W(4,07) = "07-H" : W(5,07) = "07-H"
W(1,08) = "08-H" : W(2,08) = "08-H" : W(3,08) = "08-H" : W(4,08) = "08-H" : W(5,08) = "08-H"
W(1,09) = "09-H" : W(2,09) = "09-H" : W(3,09) = "09-H" : W(4,09) = "09-H" : W(5,09) = "09-H"
W(1,10) = "10-H" : W(2,10) = "10-H" : W(3,10) = "10-H" : W(4,10) = "10-H" : W(5,10) = "10-H"
W(1,11) = "11-H" : W(2,11) = "11-H" : W(3,11) = "11-H" : W(4,11) = "11-H" : W(5,11) = "11-H"
W(1,12) = "12-H" : W(2,12) = "12-H" : W(3,12) = "12-H" : W(4,12) = "12-H" : W(5,12) = "12-H"
W(1,13) = "13-H" : W(2,13) = "13-H" : W(3,13) = "13-H" : W(4,13) = "13-H" : W(5,13) = "13-H"
W(1,14) = "01-D" : W(2,14) = "01-D" : W(3,14) = "01-D" : W(4,14) = "01-D" : W(5,14) = "01-D"
W(1,15) = "02-D" : W(2,15) = "02-D" : W(3,15) = "02-D" : W(4,15) = "02-D" : W(5,15) = "02-D"
W(1,16) = "03-D" : W(2,16) = "03-D" : W(3,16) = "03-D" : W(4,16) = "03-D" : W(5,16) = "03-D"
W(1,17) = "04-D" : W(2,17) = "04-D" : W(3,17) = "04-D" : W(4,17) = "04-D" : W(5,17) = "04-D"
W(1,18) = "05-D" : W(2,18) = "05-D" : W(3,18) = "05-D" : W(4,18) = "05-D" : W(5,18) = "05-D"
W(1,19) = "06-D" : W(2,19) = "06-D" : W(3,19) = "06-D" : W(4,19) = "06-D" : W(5,19) = "06-D"
W(1,20) = "07-D" : W(2,20) = "07-D" : W(3,20) = "07-D" : W(4,20) = "07-D" : W(5,20) = "07-D"
W(1,21) = "08-D" : W(2,21) = "08-D" : W(3,21) = "08-D" : W(4,21) = "08-D" : W(5,21) = "08-D"
W(1,22) = "09-D" : W(2,22) = "09-D" : W(3,22) = "09-D" : W(4,22) = "09-D" : W(5,22) = "09-D"
W(1,23) = "10-D" : W(2,23) = "10-D" : W(3,23) = "10-D" : W(4,23) = "10-D" : W(5,23) = "10-D"
W(1,24) = "11-D" : W(2,24) = "11-D" : W(3,24) = "11-D" : W(4,24) = "11-D" : W(5,24) = "11-D"
W(1,25) = "12-D" : W(2,25) = "12-D" : W(3,25) = "12-D" : W(4,25) = "12-D" : W(5,25) = "12-D"
W(1,26) = "13-D" : W(2,26) = "13-D" : W(3,26) = "13-D" : W(4,26) = "13-D" : W(5,26) = "13-D"
W(1,27) = "01-C" : W(2,27) = "01-C" : W(3,27) = "01-C" : W(4,27) = "01-C" : W(5,27) = "01-C"
W(1,28) = "02-C" : W(2,28) = "02-C" : W(3,28) = "02-C" : W(4,28) = "02-C" : W(5,28) = "02-C"
W(1,29) = "03-C" : W(2,29) = "03-C" : W(3,29) = "03-C" : W(4,29) = "03-C" : W(5,29) = "03-C"
W(1,30) = "04-C" : W(2,30) = "04-C" : W(3,30) = "04-C" : W(4,30) = "04-C" : W(5,30) = "04-C"
W(1,31) = "05-C" : W(2,31) = "05-C" : W(3,31) = "05-C" : W(4,31) = "05-C" : W(5,31) = "05-C"
W(1,32) = "06-C" : W(2,32) = "06-C" : W(3,32) = "06-C" : W(4,32) = "06-C" : W(5,32) = "06-C"
W(1,33) = "07-C" : W(2,33) = "07-C" : W(3,33) = "07-C" : W(4,33) = "07-C" : W(5,33) = "07-C"
W(1,34) = "08-C" : W(2,34) = "08-C" : W(3,34) = "08-C" : W(4,34) = "08-C" : W(5,34) = "08-C"
W(1,35) = "09-C" : W(2,35) = "09-C" : W(3,35) = "09-C" : W(4,35) = "09-C" : W(5,35) = "09-C"
W(1,36) = "10-C" : W(2,36) = "10-C" : W(3,36) = "10-C" : W(4,36) = "10-C" : W(5,36) = "10-C"
W(1,37) = "11-C" : W(2,37) = "11-C" : W(3,37) = "11-C" : W(4,37) = "11-C" : W(5,37) = "11-C"
W(1,38) = "12-C" : W(2,38) = "12-C" : W(3,38) = "12-C" : W(4,38) = "12-C" : W(5,38) = "12-C"
W(1,39) = "13-C" : W(2,39) = "13-C" : W(3,39) = "13-C" : W(4,39) = "13-C" : W(5,39) = "13-C"
W(1,40) = "01-S" : W(2,40) = "01-S" : W(3,40) = "01-S" : W(4,40) = "01-S" : W(5,40) = "01-S"
W(1,41) = "02-S" : W(2,41) = "02-S" : W(3,41) = "02-S" : W(4,41) = "02-S" : W(5,41) = "02-S"
W(1,42) = "03-S" : W(2,42) = "03-S" : W(3,42) = "03-S" : W(4,42) = "03-S" : W(5,42) = "03-S"
W(1,43) = "04-S" : W(2,43) = "04-S" : W(3,43) = "04-S" : W(4,43) = "04-S" : W(5,43) = "04-S"
W(1,44) = "05-S" : W(2,44) = "05-S" : W(3,44) = "05-S" : W(4,44) = "05-S" : W(5,44) = "05-S"
W(1,45) = "06-S" : W(2,45) = "06-S" : W(3,45) = "06-S" : W(4,45) = "06-S" : W(5,45) = "06-S"
W(1,46) = "07-S" : W(2,46) = "07-S" : W(3,46) = "07-S" : W(4,46) = "07-S" : W(5,46) = "07-S"
W(1,47) = "08-S" : W(2,47) = "08-S" : W(3,47) = "08-S" : W(4,47) = "08-S" : W(5,47) = "08-S"
W(1,48) = "09-S" : W(2,48) = "09-S" : W(3,48) = "09-S" : W(4,48) = "09-S" : W(5,48) = "09-S"
W(1,49) = "10-S" : W(2,49) = "10-S" : W(3,49) = "10-S" : W(4,49) = "10-S" : W(5,49) = "10-S"
W(1,50) = "11-S" : W(2,50) = "11-S" : W(3,50) = "11-S" : W(4,50) = "11-S" : W(5,50) = "11-S"
W(1,51) = "12-S" : W(2,51) = "12-S" : W(3,51) = "12-S" : W(4,51) = "12-S" : W(5,51) = "12-S"
W(1,52) = "13-S" : W(2,52) = "13-S" : W(3,52) = "13-S" : W(4,52) = "13-S" : W(5,52) = "13-S"
Function Idx(angle As Single) As Integer
    var q=(angle/(360/52))
    q=53-q
    If q=53 Then q=1
    Return q
End Function

Dim As Long fps
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================

glsetup

START:
   
    Randomize timer
   
    dim as single k1,k2,k3,k4,k5
    dim as integer i(1 to 5)={1,2,3,4,5}
    for n as integer=1 to rnd*100
        swap i(range(1,5)),i(range(1,5))
    next n
    k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)
   
dim as long flag=1,toggle,counter=0,starter=1,cflag
Dim As Single angle1,angle2,angle3,angle4,angle5
Dim As String ink
Dim As Long f1,f2,f3,f4,f5,diff=30
Dim As Long spent,gain,score,check,won
Dim As string t(1 to 5)
Dim as string text , text_w_l
dim as ubyte v(1 to 5)
dim as integer s(1 to 5)={1,1,1,1,1}
dim as ubyte flush=0

Windowtitle "Five Deck Maverick"

Do
   
    if s(1) then angle1+=k1
    if s(2) then angle2+=k2
    if s(3) then angle3+=k3
    if s(4) then angle4+=k4
    if s(5) then angle5+=k5
   
    If angle1>=360 Then angle1=0
    If angle2>=360 Then angle2=0
    If angle3>=360 Then angle3=0
    If angle4>=360 Then angle4=0
    If angle5>=360 Then angle5=0
   
    glEnable (GL_CULL_FACE)
    glClear(GL_COLOR_BUFFER_BIT)
   
    dim as single zz=-30 - (xres/275)
    DrawFaces(angle1, -4.1  ,0 ,zz ,1)
    DrawFaces(angle2, -2.05 ,0 ,zz ,2)
    DrawFaces(angle3, +-0   ,0 ,zz ,3)
    DrawFaces(angle4, +2.05 ,0 ,zz ,4)
    DrawFaces(angle5, +4.1  ,0 ,zz ,5)

    remember_current_projection
    set_projection_ortho
   
    'glLoadIdentity()
    'glTranslatef(0,0,0)
    glbegin gl_Quads
    glcolor4f  0,.2,0,1
    glvertex2d xres,0
    glvertex2d 0   ,0
    glvertex2d 0   ,yres/6.5
    glvertex2d xres,yres/6.5
   
    glvertex2d xres,yres-yres/6.5
    glvertex2d 0   ,yres-yres/6.5
    glvertex2d 0   ,yres
    glvertex2d xres,yres
   
    glend
   
    drawstring(xres/2.575,yres/1.025 ,"( Press b for payouts. )" , textcol2(),yres/600)
    drawstring(xres/4.35,yres/31,"Spent  = " + str(spent) , textcol(),yres/245)
    drawstring(xres/4.35,yres/12,"Payout = " + Str(gain)  , textcol(),yres/245)
    'drawstring(0,yres-30 ,"Framerate "&fps,textcol(),1)
    drawstring(xres/1.75 , yres/15     ,"Diff = " + Str(gain-spent)  , textcol(),yres/245)
    drawstring(xres/3.20,yres/1.055,"Press ""space bar"" to Spin",textcol(),yres/400)
   
    If f5 Then
        drawstring(xres/3.75,yres/1.17, str(v(1)) ,textcol(),yres/350)
        drawstring(xres/2.75,yres/1.17, str(v(2)) ,textcol(),yres/350)
        drawstring(xres/2.10,yres/1.17, str(v(3)) ,textcol(),yres/350)
        drawstring(xres/1.70,yres/1.17, str(v(4)) ,textcol(),yres/350)
        drawstring(xres/1.40,yres/1.17, str(v(5)) ,textcol(),yres/350)
       
        If counter =(45*06) Then
             'speak(text)
            dim as string txt1 = text
            dim as string  txt2 = text_w_l
            drawstring( (xres/2) - ((len(txt1)*(yres/350))*4) ,  yres/1.13 , txt1 ,textcol2(),yres/350)
            drawstring( (xres/2) - ((len(txt2)*(yres/350))*4) ,  yres/1.09 , txt2 ,textcol2(),yres/350)
        end if
    end if
   
    gllinewidth 8
    glbegin gl_lines
    glcolor3f(1,0,0)
    glvertex2f(xres/4.89,yres/1.72): glvertex2f(xres/1.2575,yres/1.72)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/1.2575,yres/2.38)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/4.89  ,yres/1.72)
    glvertex2f(xres/1.2575,yres/2.38): glvertex2f(xres/1.2575,yres/1.72)
    glend
    restore_previous_projection
    Flip
   
    If counter = (45*06) Then  sleep 3000
   
    'toggle and spacebar stuff
    If flag Then
        flag=0
        angle1=nearest(angle1)
        angle2=nearest(angle2)
        angle3=nearest(angle3)
        angle4=nearest(angle4)
        angle5=nearest(angle5)
    Else
        counter+=1
        'stop wheels one after the other
        If counter= (45*01) Then f1=1
        If counter= (45*02) Then f2=1
        If counter= (45*03) Then f3=1
        If counter =(45*04) Then f4=1
        If counter =(45*05) Then f5=1 : score=1 'now get scores
        'If counter =(45*06) Then speak(text)
       
        If f1=1 and s(1) Then
            var n=nearest(angle1)
            If angle1>n Then k1=-.5 Else  k1=.5
            If Abs(n-angle1)<=2 Then k1=0:angle1=n:s(1)=0
            t(1)= w(1,Idx(n))
        End If
       
        If f2=1 and s(2) Then
            var n=nearest(angle2)
            If angle2>n Then k2=-.5 Else k2=.5
            If Abs(n-angle2)<=2 Then k2=0:angle2=n:s(2)=0
            t(2)= w(2,Idx(n))
        End If
       
        If f3=1 and s(3) Then
            var n=nearest(angle3)
            If angle3>n Then k3= -.5 Else k3=.5
            If Abs(n-angle3)<=2 Then k3=0:angle3=n: s(3)=0
            t(3)= w(3,Idx(n))
        End If
       
        If f4=1 and s(4) Then
            var n=nearest(angle4)
            If angle4>n Then k4= -.5 Else k4=.5
            If Abs(n-angle4)<=2 Then k4=0:angle4=n: s(4)=0
            t(4)= w(4,Idx(n))
        End If
   
        If f5=1 and s(5) Then
            Var n=nearest(angle5)
            If angle5>n Then k5=-.5 else k5=.5
            If Abs(angle5-n)<=2 Then k5=0:angle5=n: s(5)=0
            t(5)= w(5,Idx(n))
        end if
    end if
   
    k1=.995*k1
    k2=.995*k2
    k3=.995*k3
    k4=.995*k4
    k5=.995*k5
   
    if score = 1 then
       
        text = ""
        dim as integer value=0
       
        'sort lowest to highest
        v(1)=val(left(t(1),2))
        v(2)=val(left(t(2),2))
        v(3)=val(left(t(3),2))
        v(4)=val(left(t(4),2))
        v(5)=val(left(t(5),2))
        for a as longint = 1 to 5
            for b as longint = 1 to 5
                if v(a)<=v(b) then swap v(a),v(b)
            next
        next
       
        'check for flush
        dim as string suite(1 to 5)
        suite(1) = right(t(1),1)
        suite(2) = right(t(2),1)
        suite(3) = right(t(3),1)
        suite(4) = right(t(4),1)
        suite(5) = right(t(5),1)
        if suite(1)=suite(2) and suite(2)=suite(3) and suite(3)=suite(4) and suite(4)=suite(5) then flush=1 else flush = 0
       
        'check for pairs
        for a as longint = 1 to 5
            for b as longint = a+1 to 5
                if v(a) = v(b) then value+=1
            next
        next
       
        'check pair for (tens or better)
        if value = 1 then
            for a as longint = 1 to 5
                for b as longint = a+1 to 5
                    if v(a) = v(b) then
                        if v(a)=1 or v(a)>=10 then
                            value=1
                        else
                            value=0
                            if flush = 0 then text = "You need tens or better to score."
                        end if
                    end if
                next
            next
        end if   
        '    1 pair (tens or better)   = 1
        '    2 pair                    = 5
        '    3 of a kind               = 10
        '    straight                  = 15
        '    skip straight (1,3,5,7,9) = 15
        '    flush (with any hand)     =+25
        '    fullhouse                 = 35
        '    4 of a kind               = 100
        '    royal straight            = 150
        '    straight flush            = 250
        '    5 of a kind               = 1000
        '    5 of a kind flush         = 2000
        '    royal straight flush      = 4000
        if value=1  then value=1    : text = "You got a pair tens or better." : goto DONE
        if value=2  then value=5    : text = "You got two pairs."             : goto DONE
        if value=3  then value=10   : text = "You got three of a kind."       : goto DONE
        if value=4  then value=35   : text = "You got a full house."          : goto DONE
        if value=6  then value=100  : text = "You got four of a kind."        : goto DONE
        if value=10 then value=1000 : text = "You got five of a kind."        : goto DONE
       
        DONE:
       
        'check for straight
        if v(2)=v(1)+1 and v(3)=v(2)+1 and v(4)=v(3)+1 and v(5)=v(4)+1 then
            value=15
            text= "You got a straight."
        end if
       
        'check for even skip straights
        if v(1)=2 and v(2)=4 and v(3)=6 and v(4)=8 and v(5)=10  then
            value=15
            text= "You got a skip straight."  ' 2,4,6,8,10
        end if
        if v(1)=4 and v(2)=6 and v(3)=8 and v(4)=10 and v(5)=12  then
            value=15
            text= "You got a skip straight."  ' 4,6,8,10,12
        end if
        if v(1)=6 and v(2)=8 and v(3)=10 and v(4)=12 and v(5)=1  then
            value=15
            text= "You got a skip straight."  ' 6,8,10,12,1
        end if
       
        'check for odd skip straights
        if v(1)=1 and v(2)=3 and v(3)=5 and v(4)=7 and v(5)=9   then
            value=15
            text= "You got a skip straight."  ' 1,3,5,7,9
        end if
        if v(1)=3 and v(2)=5 and v(3)=7 and v(4)=9  and v(5)=11  then
            value=15
            text= "You got a skip straight."  ' 3,5,7,9,11
        end if
        if v(1)=5 and v(2)=7 and v(3)=9  and v(4)=11 and v(5)=13 then
            value=15
            text= "You got a skip straight."  ' 5,7,9,11,13
        end if
       
        'check for royal straight
        if v(2)=10 and v(3)=11 and v(4)=12 and v(5)=13 and v(1)=1 then
            value=150
            text= "You got a royal straight."
        end if
       
        if flush=1 then
            value+=25
            if text ="You got a royal straight." then value = 4000
            if text ="You got five of a kind."   then value = 2000
            text+= " FLUSH.."
        end if
       
        if value=0 then text_w_l = "You Lost."
        if value>0 then text_w_l = "You Won = " + str(value) + " Dollars."
        if  value>0 then gain+=value:value=0
        score=0
    end if

    ink = Inkey
   
    If toggle = 0 Then
        If ink = " " and counter >=(45*06) Then
            for n as integer=1 to 5
                s(n)=1
            next n
            flag=1:toggle=1:counter=0:f1=0:f2=0:f3=0:f4=0:f5=0:diff=range(0,60):spent+=1:cflag=0
            randomize timer
        end if
        toggle=0
    Else
        dim as integer i(1 to 5)={5,4,3,2,1}
        for n as integer=1 to rnd*100
            swap i(range(1,5)),i(range(1,5))
        next n
        k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)
    End If
   
    toggle=Len(ink)
   
    Sleep regulate(40,fps),1
   
    dim as double TT=timer
    dim as long lt
    dim as string dt
    if ink="b" then
        do
        dim as long t=int(timer)
        ink=""
        screenset 1,1
        glEnable (GL_CULL_FACE)
        glClear(GL_COLOR_BUFFER_BIT)
       
        remember_current_projection
        set_projection_ortho
       
            drawstring(0,yres/100 ,"1 Pair (tens or better)   = 1    " , textcol(),yres/350)
            drawstring(0,yres/28  ,"2 Pair                    = 5    " , textcol(),yres/350)
            drawstring(0,yres/14  ,"3 of a kind               = 10   " , textcol(),yres/350)
            drawstring(0,yres/10  ,"Straight                  = 15   " , textcol(),yres/350)
            drawstring(0,yres/7.75,"Skip straight (1,3,5,7,9) = 15   " , textcol(),yres/350)
            drawstring(0,yres/6   ,"Flush (with any hand)     =+25   " , textcol(),yres/350)
            drawstring(0,yres/5   ,"Fullhouse                 = 35   " , textcol(),yres/350)
            drawstring(0,yres/4.25,"4 of a kind               = 100  " , textcol(),yres/350)
            drawstring(0,yres/3.75,"Royal straight            = 150  " , textcol(),yres/350)
            drawstring(0,yres/3.25,"Straight flush            = 250  " , textcol(),yres/350)
            drawstring(0,yres/2.95,"5 of a kind               = 1000 " , textcol(),yres/350)
            drawstring(0,yres/2.65,"5 of a kind flush         = 2000 " , textcol(),yres/350)
            drawstring(0,yres/2.45,"Royal straight flush      = 4000 " , textcol(),yres/350)
        if lt<>t then dt+="."
        lt=t
           drawstring(0,yres/2,"Wait five " &dt , textcol2(),1)
        glend
        restore_previous_projection
        flip
        if (timer-tt)>5 then exit do
        loop
        screenset 0,0
    end if

Loop Until ink=Chr(27)

for a as longint = 1 to 52
    ImageDestroy face(a)
next

END

Stonemonkey
Posts: 649
Joined: Jun 09, 2005 0:08

Re: Number Trick

Postby Stonemonkey » Sep 06, 2020 15:15

@albert, I like that, it's pretty good.
jj2007
Posts: 1724
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Number Trick

Postby jj2007 » Sep 06, 2020 16:17

Very nice indeed!

albert wrote:Five_Deck_Maverick.bas

Five rotating drums , with a full deck of cards on each drum...no Jokers.

Written mostly by Dodicat from Scottland , I did the scoring section , someone else did the speech section , i can't remember the post i copied the speech engine from. (if its yours then post a reply and i'll give you credit.)
https://www.freebasic.net/forum/viewtopic.php?f=8&t=24683&p=220113
dodicat
Posts: 6723
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Number Trick

Postby dodicat » Sep 06, 2020 17:27

Hi Albert.
I get no text in Win 10,
I have adjusted slightly, no windows include needed.

Code: Select all



'===============================================================================

#Include Once "GL/glu.bi"
#include Once "GL/glext.bi"
#include "fbgfx.bi"

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
#define Frange(f,l) Rnd*((l)-(f))+(f)

Dim Shared As Integer xres,yres

xres=800
yres=600

Screenres xres,yres,32,2,2
Screenset 1,0

Dim Shared As GLuint tex(1 To 52+1)
Dim Shared As Long drums(1 To 5)
Dim Shared As Long spoke

Function speak(text As String) As Long
    Dim As String x="mshta vbscript:Execute(""CreateObject(""""SAPI.SpVoice"""").Speak("""""+text+""""")(window.close)"")"
    Shell x
    Return 1
End Function

Sub drawstringgfx(Byval xpos As Long,Byval ypos As Long,Byref text As String,Byval colour As Ulong,Byval size As Single,Byref im As Any Pointer=0)
    Type D2
        As Double x,y
        As Ulong col
    End Type
    size=Abs(size)
    Static As d2 XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(9,17)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8 
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.col=p2.col
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos,f
    If Abs(size)=1.5 Then f=3 Else f=2
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)         
            Scale(c,t,size)
            If XY(_x1,asci).x<>0 Then
                If size>1 Then
                    Line im,(np.x-size/f,np.y-size/f)-(np.x+size/f,np.y+size/f),np.col,bf
                Else
                    Pset im,(np.x,np.y),np.col
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
End Sub
Sub initgfx Constructor
    drawstringgfx(0,0,"",0,0)
    Screen 0
End Sub

Function Filter(Byref tim As Ulong Pointer,_
    Byval rad As Single,_
    Byval destroy As Long=1,_
    Byval fade As Long=0) As Ulong Pointer
    #define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
    If fade<0 Then fade=0:If fade>100 Then fade=100
    Type p2
        As Long x,y
        As Ulong col
    End Type
    #macro p_point(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+(_x)*4
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As Long=-ymin To ymax
        For x1 As Long=-xmin To xmax
            inc=inc+1
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    If fade=0 Then
        averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    Else
        averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
    End If
    #endmacro
    Dim As Single fd=map(0,100,fade,1,0)
    Dim As Integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As Integer pitch
    Dim  As Any Pointer row
    Dim As Ulong Pointer pixel
    Dim As Ulong col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x-1,_y-1)
    For y As Long=0 To (_y)-1
        For x As Long=0 To (_x)-1
            p_point(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Ulong averagecolour
    Dim As Long ar,ag,ab
    Dim As Long xmin,xmax,ymin,ymax,inc
    Imageinfo im,,,,pitch,row
    For y As Long=0 To _y-1
        For x As Long=0 To _x-1 
            average()
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
        Next x
    Next y
    If destroy Then Imagedestroy tim: tim = 0
    Function= im
End Function

Function settexture(image As Any Ptr) As gluint
    Dim As gluint texture
    glGenTextures(1, @texture)
    glBindTexture( GL_TEXTURE_2D, texture )
    glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
    glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
    Return texture
End Function



Sub glsetup
    glShadeModel(GL_SMOOTH)                 ' Enables Smooth Color Shading
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
    glEnable GL_ALPHA
    glEnable GL_BLEND
    glViewport(0, 0, xres, yres)       ' Set the viewport
    glMatrixMode(GL_PROJECTION)        ' Change Matrix Mode to Projection
    glLoadIdentity                     ' Reset View
    gluPerspective(45, xres/yres, 1, 100)
    glMatrixMode(GL_MODELVIEW)         ' Return to the modelview matrix
    glLoadIdentity                     '  Reset View
    glClearColor 0,.2,0,1              'background
   
   
End Sub
'MY OWN ROTATE TO SET UP THE FACES
Type v3
    As Single x,y,z
End Type
Operator + (v1 As V3,v2 As V3) As V3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator * (f As Single,v1 As V3) As V3 'scalar*V3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator

Function RotatePoint(c As V3,p As v3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
    Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
    Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
    (scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
    (scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z)
End Function

'SET UP THE EIGHT FACES
Redim Shared As V3 a(1 To 4) 'For starters
Dim Shared As V3 normals(1 To 52+1)

Dim As V3 ctr=Type(0,0,0)            'rotate about gl origin
Dim As Double z=1.207106781186547*2+14.4  'z value of first face
Dim As Double r=2*4*Atn(1)/52 'rotate angle (360/8)

'first face (FRONT)
glTexCoord2f( 1,1)
a(1)=Type( 1, 1, z)
glTexCoord2f( 0,1)
a(2)=Type(-1, 1, z)
glTexCoord2f( 0,0)
a(3)=Type(-1,-1, z)
glTexCoord2f( 1,0)
a(4)=Type( 1,-1, z)

Var c=.5*(a(1)+a(3))
normals(1)=c
Dim As v3 sc=(1,1.0,1)
Dim Shared As v3 centroid(1 To 52+1),rt(1 To 52+1)
centroid(1)=Type(0,0,z)
For z As Long=1 To 51'7
    Var n=Ubound(a)
    Redim Preserve a(1 To Ubound(a)+4)
    'rotate the faces, four corners at a time around (0,0,0), angle r
    a(n+1)=RotatePoint(ctr,a(n+1-4),Type(r,0,0),sc)
    a(n+2)=RotatePoint(ctr,a(n+2-4),Type(r,0,0),sc)
    a(n+3)=RotatePoint(ctr,a(n+3-4),Type(r,0,0),sc)
    a(n+4)=RotatePoint(ctr,a(n+4-4),Type(r,0,0),sc)
    c=.5*(a(n+1)+a(n+3))
    normals(z+1)=c
    centroid(z+1)=.5*(a(n+1)+a(n+3))
Next z
For n As Long=1 To 52
    Var l=Sqr(normals(n).x^2+normals(n).y^2 +normals(n).z^2)
    normals(n)=(1/l)*normals(n) 'normalize
Next n
'sleep
'NOW WE HAVE EIGHT FACES DONE And THE NORMALS TO EACH FACE.
'three subs to switch from perspective to ortho and back
Sub remember_current_projection
    glMatrixMode GL_PROJECTION
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
End Sub

Sub set_projection_ortho
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    ' gldisable GL_LIGHTING
End Sub

Sub restore_previous_projection
    glMatrixMode GL_PROJECTION
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
    ' glEnable GL_LIGHTING
End Sub


Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
   
    glMatrixMode GL_PROJECTION 'save projection
    glPushMatrix
    glMatrixMode GL_MODELVIEW
    glPushMatrix
   
    glMatrixMode GL_PROJECTION 'make ortho
    glLoadIdentity
    glOrtho 0, xres, yres, 0,-1, 1
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    #define Red(c) ((c) Shr 16 And 255)
    #define Green(c) ((c) Shr  8 And 255)
    #define Blue(c) ((c) And 255)
    #define Alph(c) ((c) Shr 24)
    glColor4ub Red(col),Green(col),Blue(col),alph(col)
    glend
    glpointsize(1.1*size)
    glBegin (GL_POINTS)
    Type D2
        As Single x,y
    End Type
    Static As d2 cpt(),XY()
    Static As Long runflag
    If runflag=0 Then   
        Redim  XY(128,127)
        Redim cpt(1 To 64*2)
        Screen 8
        Width 640\8,200\16
        Dim As Ulong Pointer img
        Dim count As Long
        For ch As Long=1 To 127
            img=Imagecreate(640,200)
            Draw String img,(1,1),Chr(ch)
            For x As Long=1 To 8
                For y As Long=1 To 16
                    If Point(x,y,img)<>0 Then
                        count=count+1
                        XY(count,ch)=Type<D2>(x,y)
                    End If
                Next y
            Next x
            count=0
            Imagedestroy img
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As D2 np,t
    #macro Scale(p1,p2,d)
    np.x=d*(p2.x-p1.x)+p1.x
    np.y=d*(p2.y-p1.y)+p1.y
    #endmacro
   
    Dim As D2 c=Type<D2>(xpos,ypos)
    Dim As Long dx=xpos,dy=ypos
    For z6 As Long=1 To Len(text)
        Var asci=text[z6-1]
        For _x1 As Long=1 To 64*2
            t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)         
            Scale(c,t,size)
            cpt(_x1)=np
           
            If XY(_x1,asci).x<>0 Then
                If Abs(size)>0 Then
                    glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
                End If
            End If
        Next _x1
        dx=dx+8
    Next z6
    glend
    glMatrixMode GL_PROJECTION 'restore
    glPopMatrix
    glMatrixMode GL_MODELVIEW
    glPopMatrix
End Sub

Sub inittext Constructor
    drawstring(0,0,"",0,0,0,0)
End Sub

Sub DrawFaces(Byval rotangle As Single,x As Single,y As Single,Byval Z As Single,flag As Long=1)
    glEnable( GL_TEXTURE_2D )
    Dim As Single pi=4*Atn(1)
    glLoadIdentity()
    glTranslatef(x,y,Z)
    glRotatef(rotangle,1,0,0)           ' Rotate
    Dim As Long n
    Static As Long i
    i=i+1
    If i>5 Then i=1
    glcolor4f(0,0,0,1)
    For z As Long=1 To 52+1
        If z>1 And z<=13 Then glcolor4f(1,0,0,1)
        If z>=14 And z<=26 Then glcolor4f(1,0,0,1)
        If z>=27 And z<=39 Then glcolor4f(0,0,0,1)
        If z>=40 And z<=52 Then glcolor4f(0,0,0,1)
        glBindTexture(GL_TEXTURE_2D, tex(z))
        glBegin(GL_QUADS)
        rt(z)=RotatePoint(Type(0,0,0),centroid(z),Type(rotangle*pi/180,0,0),Type(1,1,1))
        glNormal3f normals(z).x,normals(z).y,normals(z).z
        If rt(z).z>0 Then
            If rt(z).y<5.5 And rt(z).y>-5.5 Then  '5.5 7.2
                If Abs(rt(z).y)<1 Then drums(i)=z '' A SCORE, THE DRUM IS CENTRAL
                glTexCoord2f( 1,0)'1 0
                glVertex3f(a(n+1).x,a(n+1).y,a(n+1).z)
                glTexCoord2f( 0,0)'0 0
                glVertex3f(a(n+2).x,a(n+2).y,a(n+2).z)
                glTexCoord2f(0,1)'0 1
                glVertex3f(a(n+3).x,a(n+3).y,a(n+3).z)
                glTexCoord2f(1,1)'1 1
                glVertex3f(a(n+4).x,a(n+4).y,a(n+4).z)
            End If
        End If
        n=n+4
        glend
    Next z
   
    glend
    gldisable( GL_TEXTURE_2D )
End Sub


Function nearest(a As Single) As Single
    Dim As Single pts(1 To 52),ctr
    For z As Single=0 To 360 Step (360/52)
        ctr+=1
        If ctr>52 Then Exit For
        pts(ctr)=z
    Next z
    For z As Long=1 To 52
        If Abs(pts(z)-a) <= 6 Then Return pts(z)'45
    Next z
End Function


Dim As String card(1 To 13)
card(01) = " A"
card(02) = " 2"
card(03) = " 3"
card(04) = " 4"
card(05) = " 5"
card(06) = " 6"
card(07) = " 7"
card(08) = " 8"
card(09) = " 9"
card(10) = "10"
card(11) = " J"
card(12) = " Q"
card(13) = " K"
Dim As Any Ptr face(52)
Dim As String suit(1 To 4) = {Chr(3),Chr(4),Chr(5),Chr(6)}
Dim As Ubyte num=1
For n As Long=1 To Ubound(face)
   
    face(n)=Imagecreate(128,128,Rgba(255,255,255,255))
   
    If n>=1  And n<=13 Then Drawstringgfx(10,35,Str(card(num))+""+ suit(1),Rgba(200,0,0,254),4,face(n))
    If n>=14  And n<=26 Then Drawstringgfx(10,35,Str(card(num))+""+ suit(2),Rgba(200,0,0,254),4,face(n))
    If n>=27  And n<=39 Then Drawstringgfx(10,35,Str(card(num))+""+ suit(3),Rgba(0,0,0,254),4,face(n))
    If n>=40  And n<=52 Then Drawstringgfx(10,35,Str(card(num))+""+ suit(4),Rgba(0,0,0,254),4,face(n))
   
    Line face(n),(0,0)-(127,127),0,b
    face(n)=filter(face(n),1)
    num+=1
    If num=14 Then num=1
Next n

For n As Long=1 To 52
    tex(n)=settexture(face(n))
Next n

Dim Shared As String W(1 To 5 , 1 To 52)
W(1,01) = "01-H" : W(2,01) = "01-H" : W(3,01) = "01-H" : W(4,01) = "01-H" : W(5,01) = "01-H"
W(1,02) = "02-H" : W(2,02) = "02-H" : W(3,02) = "02-H" : W(4,02) = "02-H" : W(5,02) = "02-H"
W(1,03) = "03-H" : W(2,03) = "03-H" : W(3,03) = "03-H" : W(4,03) = "03-H" : W(5,03) = "03-H"
W(1,04) = "04-H" : W(2,04) = "04-H" : W(3,04) = "04-H" : W(4,04) = "04-H" : W(5,04) = "04-H"
W(1,05) = "05-H" : W(2,05) = "05-H" : W(3,05) = "05-H" : W(4,05) = "05-H" : W(5,05) = "05-H"
W(1,06) = "06-H" : W(2,06) = "06-H" : W(3,06) = "06-H" : W(4,06) = "06-H" : W(5,06) = "06-H"
W(1,07) = "07-H" : W(2,07) = "07-H" : W(3,07) = "07-H" : W(4,07) = "07-H" : W(5,07) = "07-H"
W(1,08) = "08-H" : W(2,08) = "08-H" : W(3,08) = "08-H" : W(4,08) = "08-H" : W(5,08) = "08-H"
W(1,09) = "09-H" : W(2,09) = "09-H" : W(3,09) = "09-H" : W(4,09) = "09-H" : W(5,09) = "09-H"
W(1,10) = "10-H" : W(2,10) = "10-H" : W(3,10) = "10-H" : W(4,10) = "10-H" : W(5,10) = "10-H"
W(1,11) = "11-H" : W(2,11) = "11-H" : W(3,11) = "11-H" : W(4,11) = "11-H" : W(5,11) = "11-H"
W(1,12) = "12-H" : W(2,12) = "12-H" : W(3,12) = "12-H" : W(4,12) = "12-H" : W(5,12) = "12-H"
W(1,13) = "13-H" : W(2,13) = "13-H" : W(3,13) = "13-H" : W(4,13) = "13-H" : W(5,13) = "13-H"
W(1,14) = "01-D" : W(2,14) = "01-D" : W(3,14) = "01-D" : W(4,14) = "01-D" : W(5,14) = "01-D"
W(1,15) = "02-D" : W(2,15) = "02-D" : W(3,15) = "02-D" : W(4,15) = "02-D" : W(5,15) = "02-D"
W(1,16) = "03-D" : W(2,16) = "03-D" : W(3,16) = "03-D" : W(4,16) = "03-D" : W(5,16) = "03-D"
W(1,17) = "04-D" : W(2,17) = "04-D" : W(3,17) = "04-D" : W(4,17) = "04-D" : W(5,17) = "04-D"
W(1,18) = "05-D" : W(2,18) = "05-D" : W(3,18) = "05-D" : W(4,18) = "05-D" : W(5,18) = "05-D"
W(1,19) = "06-D" : W(2,19) = "06-D" : W(3,19) = "06-D" : W(4,19) = "06-D" : W(5,19) = "06-D"
W(1,20) = "07-D" : W(2,20) = "07-D" : W(3,20) = "07-D" : W(4,20) = "07-D" : W(5,20) = "07-D"
W(1,21) = "08-D" : W(2,21) = "08-D" : W(3,21) = "08-D" : W(4,21) = "08-D" : W(5,21) = "08-D"
W(1,22) = "09-D" : W(2,22) = "09-D" : W(3,22) = "09-D" : W(4,22) = "09-D" : W(5,22) = "09-D"
W(1,23) = "10-D" : W(2,23) = "10-D" : W(3,23) = "10-D" : W(4,23) = "10-D" : W(5,23) = "10-D"
W(1,24) = "11-D" : W(2,24) = "11-D" : W(3,24) = "11-D" : W(4,24) = "11-D" : W(5,24) = "11-D"
W(1,25) = "12-D" : W(2,25) = "12-D" : W(3,25) = "12-D" : W(4,25) = "12-D" : W(5,25) = "12-D"
W(1,26) = "13-D" : W(2,26) = "13-D" : W(3,26) = "13-D" : W(4,26) = "13-D" : W(5,26) = "13-D"
W(1,27) = "01-C" : W(2,27) = "01-C" : W(3,27) = "01-C" : W(4,27) = "01-C" : W(5,27) = "01-C"
W(1,28) = "02-C" : W(2,28) = "02-C" : W(3,28) = "02-C" : W(4,28) = "02-C" : W(5,28) = "02-C"
W(1,29) = "03-C" : W(2,29) = "03-C" : W(3,29) = "03-C" : W(4,29) = "03-C" : W(5,29) = "03-C"
W(1,30) = "04-C" : W(2,30) = "04-C" : W(3,30) = "04-C" : W(4,30) = "04-C" : W(5,30) = "04-C"
W(1,31) = "05-C" : W(2,31) = "05-C" : W(3,31) = "05-C" : W(4,31) = "05-C" : W(5,31) = "05-C"
W(1,32) = "06-C" : W(2,32) = "06-C" : W(3,32) = "06-C" : W(4,32) = "06-C" : W(5,32) = "06-C"
W(1,33) = "07-C" : W(2,33) = "07-C" : W(3,33) = "07-C" : W(4,33) = "07-C" : W(5,33) = "07-C"
W(1,34) = "08-C" : W(2,34) = "08-C" : W(3,34) = "08-C" : W(4,34) = "08-C" : W(5,34) = "08-C"
W(1,35) = "09-C" : W(2,35) = "09-C" : W(3,35) = "09-C" : W(4,35) = "09-C" : W(5,35) = "09-C"
W(1,36) = "10-C" : W(2,36) = "10-C" : W(3,36) = "10-C" : W(4,36) = "10-C" : W(5,36) = "10-C"
W(1,37) = "11-C" : W(2,37) = "11-C" : W(3,37) = "11-C" : W(4,37) = "11-C" : W(5,37) = "11-C"
W(1,38) = "12-C" : W(2,38) = "12-C" : W(3,38) = "12-C" : W(4,38) = "12-C" : W(5,38) = "12-C"
W(1,39) = "13-C" : W(2,39) = "13-C" : W(3,39) = "13-C" : W(4,39) = "13-C" : W(5,39) = "13-C"
W(1,40) = "01-S" : W(2,40) = "01-S" : W(3,40) = "01-S" : W(4,40) = "01-S" : W(5,40) = "01-S"
W(1,41) = "02-S" : W(2,41) = "02-S" : W(3,41) = "02-S" : W(4,41) = "02-S" : W(5,41) = "02-S"
W(1,42) = "03-S" : W(2,42) = "03-S" : W(3,42) = "03-S" : W(4,42) = "03-S" : W(5,42) = "03-S"
W(1,43) = "04-S" : W(2,43) = "04-S" : W(3,43) = "04-S" : W(4,43) = "04-S" : W(5,43) = "04-S"
W(1,44) = "05-S" : W(2,44) = "05-S" : W(3,44) = "05-S" : W(4,44) = "05-S" : W(5,44) = "05-S"
W(1,45) = "06-S" : W(2,45) = "06-S" : W(3,45) = "06-S" : W(4,45) = "06-S" : W(5,45) = "06-S"
W(1,46) = "07-S" : W(2,46) = "07-S" : W(3,46) = "07-S" : W(4,46) = "07-S" : W(5,46) = "07-S"
W(1,47) = "08-S" : W(2,47) = "08-S" : W(3,47) = "08-S" : W(4,47) = "08-S" : W(5,47) = "08-S"
W(1,48) = "09-S" : W(2,48) = "09-S" : W(3,48) = "09-S" : W(4,48) = "09-S" : W(5,48) = "09-S"
W(1,49) = "10-S" : W(2,49) = "10-S" : W(3,49) = "10-S" : W(4,49) = "10-S" : W(5,49) = "10-S"
W(1,50) = "11-S" : W(2,50) = "11-S" : W(3,50) = "11-S" : W(4,50) = "11-S" : W(5,50) = "11-S"
W(1,51) = "12-S" : W(2,51) = "12-S" : W(3,51) = "12-S" : W(4,51) = "12-S" : W(5,51) = "12-S"
W(1,52) = "13-S" : W(2,52) = "13-S" : W(3,52) = "13-S" : W(4,52) = "13-S" : W(5,52) = "13-S"
Function Idx(angle As Single) As Long
    Var q=(angle/(360/52))
    q=53-q
    If q=53 Then q=1
    Return q
End Function

Dim As Long fps
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
'===============================================================================
'===============================================================================
'===============================================================================
'===============================================================================

glsetup

START:

Randomize Timer

Dim As Single k1,k2,k3,k4,k5
Dim As Long i(1 To 5)={1,2,3,4,5}
For n As Long=1 To Rnd*100
    Swap i(range(1,5)),i(range(1,5))
Next n
k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)

Dim As Long flag=1,toggle,counter=0,starter=1,cflag
Dim As Single angle1,angle2,angle3,angle4,angle5
Dim As String ink
Dim As Long f1,f2,f3,f4,f5,diff=30
Dim As Long spent,gain,score,check,won
Dim As String t(1 To 5) , text
Dim As Ubyte v(1 To 5)
Dim As Long s(1 To 5)={1,1,1,1,1}
Windowtitle "Five Deck Maverick"

Do
    If s(1) Then angle1+=k1
    If s(2) Then angle2+=k2
    If s(3) Then angle3+=k3
    If s(4) Then angle4+=k4
    If s(5) Then angle5+=k5
   
    If angle1>=360 Then angle1=0
    If angle2>=360 Then angle2=0
    If angle3>=360 Then angle3=0
    If angle4>=360 Then angle4=0
    If angle5>=360 Then angle5=0
   
    glEnable (GL_CULL_FACE)
    glClear(GL_COLOR_BUFFER_BIT)
   
    Dim As Single zz=-30 - (xres/275)
    DrawFaces(angle1, -4.1  ,0 ,zz ,1)
    DrawFaces(angle2, -2.05 ,0 ,zz ,2)
    DrawFaces(angle3, +-0   ,0 ,zz ,3)
    DrawFaces(angle4, +2.05 ,0 ,zz ,4)
    DrawFaces(angle5, +4.1  ,0 ,zz ,5)
   
    remember_current_projection
    set_projection_ortho
   
    'glLoadIdentity()
    'glTranslatef(0,0,0)
    #macro hold
    glbegin gl_Quads
    glcolor4f  0,.2,0,1
    glvertex2d xres,0
    glvertex2d 0   ,0
    glvertex2d 0   ,yres/6.5
    glvertex2d xres,yres/6.5
   
    glvertex2d xres,yres-yres/6.5
    glvertex2d 0   ,yres-yres/6.5
    glvertex2d 0   ,yres
    glvertex2d xres,yres
   
    glend
    #endmacro
    hold
   
   
    drawstring(xres/4.35,yres/31,"Spent  = " + Str(spent) ,Rgb(200,0,0),yres/245,xres,yres)
    drawstring(xres/4.35,yres/12,"Payout = " + Str(gain)  , Rgb(200,0,0),yres/245,xres,yres)
    'drawstring(0,yres-30 ,"Framerate "&fps,textcol(),1)
    drawstring(xres/1.75 , yres/15     ,"Diff = " + Str(gain-spent)  , Rgb(200,0,0),yres/245,xres,yres)
    If spoke Then
        drawstring(xres/2.575,yres/1.025 ,"( Toggle b for payouts. )" , Rgb(200,0,0),yres/600,xres,yres)
        drawstring(xres/3.20,yres/1.075,"Press ""space bar"" to Spin",Rgb(0,200,0),yres/400,xres,yres)
    End If
    If f5 Then
        'drawstring(xres/3.75,yres/1.15, str(v(1)) ,rgb(0,0,200),yres/245,xres,yres)
        'drawstring(xres/2.75,yres/1.15, str(v(2)) ,rgb(0,0,200),yres/245,xres,yres)
        'drawstring(xres/2.10,yres/1.15, str(v(3)) ,rgb(0,0,200),yres/245,xres,yres)
        'drawstring(xres/1.70,yres/1.15, str(v(4)) ,rgb(0,0,200),yres/245,xres,yres)
        'drawstring(xres/1.40,yres/1.15, str(v(5)) ,rgb(0,0,200),yres/245,xres,yres)
    End If
    gllinewidth 8
    glbegin gl_lines
    glcolor3f(1,0,0)
    glvertex2f(xres/4.89,yres/1.72): glvertex2f(xres/1.2575,yres/1.72)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/1.2575,yres/2.38)
    glvertex2f(xres/4.89,yres/2.38): glvertex2f(xres/4.89  ,yres/1.72)
    glvertex2f(xres/1.2575,yres/2.38): glvertex2f(xres/1.2575,yres/1.72)
    glend
    restore_previous_projection
    Flip
   
    'toggle and spacebar stuff
    If flag Then
        flag=0
        angle1=nearest(angle1)
        angle2=nearest(angle2)
        angle3=nearest(angle3)
        angle4=nearest(angle4)
        angle5=nearest(angle5)
    Else
        counter+=1
        'stop wheels one after the other
        If counter= (45*01) Then f1=1
        If counter= (45*02) Then f2=1
        If counter= (45*03) Then f3=1
        If counter =(45*04) Then f4=1
        If counter =(45*05) Then f5=1 : score=1 'now get scores
        If counter =(45*06) Then spoke=speak(text)
       
        If f1=1 And s(1) Then
            Var n=nearest(angle1)
            If angle1>n Then k1=-.5 Else  k1=.5
            If Abs(n-angle1)<=2 Then k1=0:angle1=n:s(1)=0
            t(1)= w(1,Idx(n))
        End If
       
        If f2=1 And s(2) Then
            Var n=nearest(angle2)
            If angle2>n Then k2=-.5 Else k2=.5
            If Abs(n-angle2)<=2 Then k2=0:angle2=n:s(2)=0
            t(2)= w(2,Idx(n))
        End If
       
        If f3=1 And s(3) Then
            Var n=nearest(angle3)
            If angle3>n Then k3= -.5 Else k3=.5
            If Abs(n-angle3)<=2 Then k3=0:angle3=n: s(3)=0
            t(3)= w(3,Idx(n))
        End If
       
        If f4=1 And s(4) Then
            Var n=nearest(angle4)
            If angle4>n Then k4= -.5 Else k4=.5
            If Abs(n-angle4)<=2 Then k4=0:angle4=n: s(4)=0
            t(4)= w(4,Idx(n))
        End If
       
        If f5=1 And s(5) Then
            Var n=nearest(angle5)
            If angle5>n Then k5=-.5 Else k5=.5
            If Abs(angle5-n)<=2 Then k5=0:angle5=n: s(5)=0
            t(5)= w(5,Idx(n))
        End If
    End If
   
    k1=.995*k1
    k2=.995*k2
    k3=.995*k3
    k4=.995*k4
    k5=.995*k5
   
    If score = 1 Then
       
        text = ""
        Dim As Long value=0
        Dim As Ubyte flush=0
       
        'sort lowest to highest
        v(1)=Val(Left(t(1),2))
        v(2)=Val(Left(t(2),2))
        v(3)=Val(Left(t(3),2))
        v(4)=Val(Left(t(4),2))
        v(5)=Val(Left(t(5),2))
        For a As Longint = 1 To 5
            For b As Longint = 1 To 5
                If v(a)<=v(b) Then Swap v(a),v(b)
            Next
        Next
       
        'check for flush
        Dim As String*1 suit(1 To 5)
        suit(1) = Right(t(1),1)
        suit(2) = Right(t(2),1)
        suit(3) = Right(t(3),1)
        suit(4) = Right(t(4),1)
        suit(5) = Right(t(5),1)
        If suit(1)=suit(2) And suit(1)=suit(3) And suit(1)=suit(4) And suit(1)=suit(5) Then flush=1
       
        'check for pairs
        For a As Longint = 1 To 5
            For b As Longint = a+1 To 5
                If v(a) = v(b) Then value+=1
            Next
        Next
       
        'check pair for (tens or better)
        If value = 1 Then
            For a As Longint = 1 To 5
                For b As Longint = a+1 To 5
                    If v(a) = v(b) Then
                        If v(a)=1 Or v(a)>=10 Then
                            value=1
                        Else
                            value=0
                            If flush = 0 Then text = "you need tens or better to score "
                        End If
                    End If
                Next
            Next
        End If   
        '    1 pair (tens or better)   = 1
        '    2 pair                    = 5
        '    3 of a kind               = 10
        '    straight                  = 15
        '    skip straight (1,3,5,7,9) = 15
        '    flush (with any hand)     =+25
        '    fullhouse                 = 35
        '    4 of a kind               = 100
        '    royal straight            = 150
        '    straight flush            = 250
        '    5 of a kind               = 1000
        '    5 of a kind flush         = 2000
        '    royal straight flush      = 4000
        If value=1  Then value=1    : text = "you got a pair tens or better " : Goto DONE
        If value=2  Then value=5    : text = "you got two pairs "             : Goto DONE
        If value=3  Then value=10   : text = "you got three of a kind "       : Goto DONE
        If value=4  Then value=35   : text = "you got a full house "          : Goto DONE
        If value=6  Then value=100  : text = "you got four of a kind "        : Goto DONE
        If value=10 Then value=1000 : text = "you got five of a kind "        : Goto DONE
       
        DONE:
       
       
        'check for straight
        If v(2)=v(1)+1 And v(3)=v(2)+1 And v(4)=v(3)+1 And v(5)=v(4)+1 Then
            value=15
            text= "you got a straight "
        End If
       
        'check for even skip straights
        If v(1)=2 And v(2)=4 And v(3)=6 And v(4)=8 And v(5)=10  Then
            value=15
            text= "you got a skip straight "  ' 2,4,6,8,10
        End If
        If v(1)=4 And v(2)=6 And v(3)=8 And v(4)=10 And v(5)=12  Then
            value=15
            text= "you got a skip straight "  ' 4,6,8,10,12
        End If
        If v(1)=6 And v(2)=8 And v(3)=10 And v(4)=12 And v(5)=1  Then
            value=15
            text= "you got a skip straight "  ' 6,8,10,12,1
        End If
       
        'check for odd skip straights
        If v(1)=1 And v(2)=3 And v(3)=5 And v(4)=7 And v(5)=9   Then
            value=15
            text= "you got a skip straight "  ' 1,3,5,7,9
        End If
        If v(1)=3 And v(2)=5 And v(3)=7 And v(4)=9  And v(5)=11  Then
            value=15
            text= "you got a skip straight "  ' 3,5,7,9,11
        End If
        If v(1)=5 And v(2)=7 And v(3)=9  And v(4)=11 And v(5)=13 Then
            value=15
            text= "you got a skip straight "  ' 5,7,9,11,13
        End If
       
        'check for royal straight
        If v(2)=10 And v(3)=11 And v(4)=12 And v(5)=13 And v(1)=1 Then
            value=150
            text= "you got a royal straight "
        End If
       
        If flush Then
            value+=25
            If text ="you got a royal straight " Then value = 4000
            If text ="you got five of a kind "   Then value = 2000
            text+= "and it's a flush."
        End If
       
        If value=0 Then text+= "You Lost."
        If value>0 Then text+= " You Won" + Str(value) + "Dollars."
        If  value>0 Then gain+=value:value=0
        score=0
    End If
   
    ink = Inkey
    If ink=" " Then spoke=0
   
    If toggle = 0 Then
        If ink = " " And counter >=(45*06) Then
            For n As Long=1 To 5
                s(n)=1
            Next n
            flag=1:toggle=1:counter=0:f1=0:f2=0:f3=0:f4=0:f5=0:diff=range(0,60):spent+=1:cflag=0
            Randomize Timer
        End If
        toggle=0
    Else
        Dim As Long i(1 To 5)={5,4,3,2,1}
        For n As Long=1 To Rnd*100
            Swap i(range(1,5)),i(range(1,5))
        Next n
        k1=i(1):k2=i(2):k3=i(3):k4=i(4):k5=i(5)
    End If
   
    toggle=Len(ink)
   
    Sleep regulate(40,fps),1
   
    Dim As Double TT=Timer
    Dim As Long lt
    Dim As String dt
    If ink="b" Then
        Do
            Dim As Long t=Int(Timer)
            ink=""
            Screenset 1,1
            glEnable (GL_CULL_FACE)
            glClear(GL_COLOR_BUFFER_BIT)
            'var sz=350
            drawstring(0,yres/100 ,"1 Pair (tens or better)   = 1    " , Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/28  ,"2 Pair                    = 5    " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/14  ,"3 of a kind               = 10   " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/10  ,"Straight                  = 15   " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/7.75,"Skip straight (1,3,5,7,9) = 15   " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/6   ,"Flush (with any hand)     =+25   " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/5   ,"Fullhouse                 = 35   " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/4.25,"4 of a kind               = 100  " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/3.75,"Royal straight            = 150  " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/3.25,"Straight flush            = 250  " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/2.95,"5 of a kind               = 1000 " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/2.65,"5 of a kind flush         = 2000 " ,  Rgb(0,100,200),1.5,xres,yres)
            drawstring(0,yres/2.45,"Royal straight flush      = 4000 " ,  Rgb(0,100,200),1.5,xres,yres)
            If lt<>t Then dt+="."
            lt=t
            '' drawstring(0,yres/2,"Wait five " &dt , textcol2(),1)
            glend
            If Inkey="b" Then Exit Do
           
            Flip
            'if (timer-tt)>5 then exit do
        Loop
        Screenset 0,0
    End If
   
Loop Until ink=Chr(27)

For a As Longint = 1 To 52
    Imagedestroy face(a)
Next

End
 

Return to “General”

Who is online

Users browsing this forum: No registered users and 6 guests