I ported me and Dodicats "Five Deck Maverick" to FB Linux 64 bit.
You have to install mesa glu libs for it to compile..
Code: Select all
'Written in FreeBASIC for Linux 64 bit.
'search sourceforge.net for FreeBASIC and click "files" and search for Linux
'download the file and extract it
'then start a superuser console and go into the dir and type ./install.sh -i
'it will say FB installed on usr/local
'
'Download Geany IDE from your package mgr. and set it to FreeBASIC
'
'requires flite for speech to work.... (festival lite from CMU.edu)
' https://software.opensuse.org/package/flite
' click on a version and then click unstable then click on an install button and the distro package mgr. should install it.
'
' Written by Dodocat from Scottland and Albert Redditt.
' search FreeBasic forum for Five Deck Maverick.
'
'===============================================================================
#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=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
shell( "echo " & text & text_w_l & " | flite")
shell( "echo " & text & text_w_l & " " )
end if
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