Word Clock

[neil]

This is just a a word clock. It is setup for demo mode. Change debug = 0 for real clock. The real clock only updates every 5 minutes.

Code: Select all

Dim As Integer zoom = 4  '' from 1 to 9 for example

Dim As Integer w = 23 * 8, h = 21 * 8

Dim Shared As String sa,s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12
Dim Shared As String oc,pst,qtr,hpst,s20,s25,t0
Dim As String hr,mn,sec,t,key
Dim Shared As Ubyte hrs,min,i,x,y,n,hnt,mnt,debug
s1 = "O N E":s2 = "T W O":s3 = "T H R E E":s4 = "F O U R":s5 ="F I V E"
s6 = "S I X":s7 = "S E V E N":s8 = "E I G H T":s9 = "N I N E":s10 = "T E N"
s11 ="E L E V E N":s12 = "T W E L V E":oc = "O C L O C K":pst = "P A S T":t0 = "T O"
qtr = "Q U A R T E R":hpst = "H A L F":s20 = "T W E N T Y":s25 = "T W E N T Y F I V E"

'' debug = 1  demo mode
'' debug = 0  real clock
debug = 1

Screenres w * zoom, h * zoom
Sub OClock()
Color 15
If hrs = 1 THEN Locate 12,2: Print s1
If hrs = 2 THEN Locate 14,18: Print s2
If hrs = 3 THEN Locate 12,14:Print s3
If hrs = 4 THEN Locate 14,2: Print s4
If hrs = 5 THEN Locate 14,10: Print s5
If hrs = 6 THEN Locate 12,8: Print s6
If hrs = 7 THEN Locate 18,2: Print s7 
If hrs = 8 THEN Locate 16,2: Print s8
If hrs = 9 THEN Locate 10,16: Print s9
If hrs = 10 THEN Locate 20,2: Print s10
If hrs = 11 THEN Locate 16,12: Print s11
If hrs = 12 THEN Locate 18,12: Print s12
Locate 20,12: Print oc
End Sub

Sub Qtrpst()
If hrs = 12 and min = 45 Then hrs = 0
sa = ""
If min = 30 Then y = 8:x = 2: sa = hpst
If min = 45 Then y = 8:x = 20:sa = t0:hrs += 1
If min = 15 Then y = 10:x = 2: sa = pst
Color 15

if min > 29 and min < 35 Then Locate y,x:Print sa:Locate y + 2,x:Print pst
If sa <> hpst Then Locate 4,2:Print "A":Locate 4,6:Print qtr:Locate y,x:Print sa

If hrs = 1 Then Locate 12,2:Print s1
If hrs = 2 THEN Locate 14,18:Print s2
If hrs = 3 Then Locate 12,14:Print s3
If hrs = 4 Then Locate 14,2:Print s4
If hrs = 5 Then Locate 14,10:Print s5
If hrs = 6 Then Locate 12,8:Print s6
If hrs = 7 Then Locate 18,2:Print s7
If hrs = 8 Then Locate 16,2:Print s8
If hrs = 9 Then Locate 10,16:Print s9
If hrs = 10 Then Locate 20,2:Print s10
If hrs = 11 Then Locate 16,12:Print s11
If hrs = 12 Then Locate 18,12:Print s12
End Sub

Sub Mins()
sa = ""
If hrs = 12 and min > 34 Then hrs = 0
If min > 4 and min < 10 THEN min = 5
If min > 9 and min < 15 THEN min = 10
If min > 19 and min < 25 THEN min = 20
If min > 24 and min < 30 THEN min = 25
If min > 34 and min < 40 THEN min = 35
If min > 39 and min < 45 THEN min = 40
If min > 49 and min < 55 THEN min = 50
If min > 54 THEN min = 55
If min > 34 Then hrs += 1
If min = 5 or min = 55 then sa = s5:y = 6:x = 14
If min = 10 or min = 50 then sa = s10:y = 8:x = 12
If min = 20 or min = 40 then sa = s20:y = 6:x = 2
If min = 25 or min = 35 then sa = s25:y = 6:x = 2
Color 15
If min < 35 Then Locate y,x:Print sa:Locate 10,2:Print pst
If min > 25 Then Locate y,x:Print sa:Locate 10,2:Print t0
If hrs = 1 Then Locate 12,2:Print s1
If hrs = 2 Then Locate 14,18:Print s2
If hrs = 3 Then Locate 12,14:Print s3
If hrs = 4 Then Locate 14,2:Print s4
If hrs = 5 Then Locate 14,10:Print s5
If hrs = 6 Then Locate 12,8:Print s6
If hrs = 7 Then Locate 18,2:Print s7
If hrs = 8 Then Locate 16,2:Print s8
If hrs = 9 Then Locate 10,16:Print s9
If hrs = 10 Then Locate 20,2:Print s10
If hrs = 11 Then Locate 16,12:Print s11
If hrs = 12 Then Locate 18,12:Print s12
End Sub

hnt = 12 '' for demo mode

Do

t = time
sec=Mid(t,7,2):mn=Mid(t,4,2):hr=Mid(t,1,2)
hrs = val(hr):min = val(mn)
If hrs > 12 Then hrs -= 12
If hrs = 0 Then hrs += 12 

ScreenLock
COLOR 1
Cls

LOCATE 2,2:PRINT "I T L I S A S A M P M"
LOCATE 4,2:PRINT "A C Q U A R T E R D C"
LOCATE 6,2:PRINT "T W E N T Y F I V E X"
LOCATE 8,2:PRINT "H A L F S T E N F T O"
LOCATE 10,2:PRINT "P A S T E R U N I N E"
LOCATE 12,2:PRINT "O N E S I X T H R E E"
LOCATE 14,2:PRINT "F O U R F I V E T W O"
LOCATE 16,2:PRINT "E I G H T E L E V E N"
LOCATE 18,2:PRINT "S E V E N T W E L V E"
LOCATE 20,2:PRINT "T E N S E O C L O C K"
LOCATE 2,2:Color 15:print "I T"
LOCATE 2,8:Color 15:print "I S"

If debug = 1 Then
If hnt = 13 Then hnt = 1
hrs = hnt
min = mnt
mnt += 1
sleep 300,1
If mnt = 60 Then mnt = 0:hnt += 1
End If

n = 0
If min > 15 and min < 20 Then min = 15
If min > 30 and min < 35 Then min = 30
If min > 45 and min < 50 Then min = 45

If min = 15 or min = 30 or min = 45 Then n = 1
If min < 5 Then min = 0:OClock
If n = 1 Then Qtrpst
If n = 0 and min > 4 THEN mins

 For x As Integer = w - 1 To 0 Step -1
          For y As Integer = h - 1 To 0 Step -1
             Line(x * zoom, y * zoom)-Step(zoom - 1, zoom - 1), Point(x, y), BF
          Next
    Next
    
    Screenunlock

key = inkey
    
    If (Key >= "1") And (key <= "9") Then
        zoom = Valint(key)
        Screenres w * zoom, h * zoom
    End If

    Sleep 100, 1
    
Loop Until (key = Chr(27)) Or (key = Chr(255) & "k")

[neil]

I changed the background letters to blue. It makes it easier to see the highlighted letters.
I also removed redundant code I didn't need.

[BasicCoder2]

Do you write these programs yourself?
You could try a speaking clock.
My old AmigaBASIC had a SAY command while modern versions of BASIC do not.
SAY TRANSLATE$ ("HELLO WORLD")
This is how it can be done in FreeBASIC.

Code: Select all

' Speak the Clipboard! v1.0
' (C) 2008 Innova and Kristopher Windsor

#define UNICODE
#include once "disphelper/disphelper.bi"
#include once "windows.bi"

Function clipboard () As String
  Dim As Zstring Ptr s_ptr
  Dim As HANDLE hglb
  Dim As String s = ""
  
  If (IsClipboardFormatAvailable(CF_TEXT) = 0) Then Return ""
  
  If OpenClipboard( NULL ) <> 0 Then
    hglb = GetClipboardData(cf_text)
    s_ptr = GlobalLock(hglb)
    If (s_ptr <> NULL) Then
      s = *s_ptr
      GlobalUnlock(hglb)
    End If
    CloseClipboard()
  End If
  
  Return s
End Function

Sub speak (Byref text As String)
  Dim myt As Wstring * 512
  Dim As Integer isSpeaking
  Dim As HRESULT hr
  
  DISPATCH_OBJ(tts)
  
  dhInitialize(TRUE)
  dhToggleExceptions(FALSE) 'set this TRUE to get error codes
  
  myt = "Sapi.SpVoice"
  hr = dhCreateObject(@myt, NULL, @tts)
  If hr <> 0 Then Exit Sub
  
  myt = text
  dhCallMethod(tts, ".Speak(%S)", @myt)
  
  SAFE_RELEASE(tts)
End Sub

Dim As String c, pc

Screenres 320, 240, 32

Do
  pc = c
  c = clipboard()
  If Len(c) And c <> pc Then
    speak(c)
  End If
  Sleep 1000
Loop Until Inkey = Chr(27)
 

[neil]

@BasicCoder2
Yes I wrote the program myself, I got the idea from real hardware word clocks that use LED's to light the letters.
I used fxm's magnify code to make it larger.

[dodicat]

Nice one Neil.
Basiccoder2, here is a windows easy- peasy way to access speak.

Code: Select all

sub speak(text as string) 
      dim as string x="mshta vbscript:Execute(""CreateObject(""""SAPI.SpVoice"""").Speak("""""+text+""""")(window.close)"")"
      print text
      shell x
  end sub
  
 
  speak "The time is "+ time
  speak "press any key to finish"
  sleep
   

[BasicCoder2]

Dodicat that is really neat
Not knowing much about the inner functionality of Windows or what mshta vbscript might be (a visual basic script of some kind) I am unable to write anything like that.

[BasicCoder2]

neil
Does it handle thirteen to nineteen? Or am I missing something.
I couldn't resist trying to convert the time (hours:minutes) into words.
Just keep hitting a key to try a random time or ESC to end the program.

Code: Select all

dim shared as string number(1 to 20)
for i as integer = 1 to 20
    read number(i)
next i

function getWord(n as integer) as string
    dim as string word
    if n<21 then
        word = number(n)
    else
        word = "TWENTY" + number(n-20)
    end if
    return word
end function


dim shared as integer hours,minutes

do
    
    hours = int(rnd(1)*12)+1
    minutes = int(rnd(1)*60)+1
    print hours;":";minutes
    
    
    if minutes = 0 then
        print "IT IS "+getWord(hours)+" O'CLOCK"
    else
        
        if minutes = 30 then
            print "HALF PAST "+getWord(hours)
        else
            
            if minutes < 30 then
        
                if minutes = 15 then
                    print " A QUARTER PAST "+getWord(hours)
                else
                    print getWord(minutes)+" PAST "+getWord(hours)
                end if
        
            else
        
                if minutes = 45 then
                    print "A QUARTER TO "+getWord(hours+1)
                else
                    if hours=12 then hours = 0
                    print getWord(60-minutes)+" TO "+getWord(hours+1)
                end if
        
            end if
        
        end if
    end if
    
    
    sleep
    
loop until multikey(&H01)

data "ONE","TWO","THREE","FOUR","FIVE","SIX","SEVEN","EIGHT","NINE","TEN"
data "ELEVEN","TWELVE","THIRTEEN","FOURTEEN","FIFTEEN","SIXTEEN","SEVENTEEN","EIGHTEEN","NINETEEN","TWENTY"

[BasicCoder2]

Basiccoder2, here is a windows easy- peasy way to access speak.

Does windows have a means to convert speech to text using a microphone?
.

[dodicat]

Basiccoder2, needs must gets me looking around.
Some of these windows shell instructions are very powerful.

I found mshta while working with Albert on his maverick gambling thing.

Code: Select all

'===============================================================================
#ifdef __fb_64bit__
#cmdline "-gen gas64"
#endif

#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 long _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As long 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


 

Albert made some nice contributions to this forum over the years in many different fields.
I was sorry to see him kicked out for over zealous coding, nothing more, nothing less.
I think cortana might handle a microphone, you might get it command line, I have not tried.
NOTE
-gen gas64 saved me here from looking for something -gen gcc 64 bits found as an error.
It is nigh impossible to debug from gcc's report.
Thank you SARG.

[paul doe]

...
Albert made some nice contributions to this forum over the years in many different fields.
I was sorry to see him kicked out for over zealous coding, nothing more, nothing less.
...

Perhaps you might want to follow him at encode.su if you miss him so much? Or to continue helping him with his numerous... contributions to mankind?

Now, take the time to read the entire thread (over a year, ~500 posts). Perhaps when you come back, you'll be able to understand some decisions, and that somebody has to take them, whether people like it or not.

[dodicat]

paul doe
Thanks for the link.
Looks like he is in the proper forum now, for his compressor anyway.
I will not judge his performance, for me to judge elevates me an imaginary superior place.

mariush is tagging along, a bit like Richard was here.
compgt, I think, wants him to get it working so it can be improved on.

No sign of him getting kicked out of the forum!

[SARG]

@dodicat
You are welcome.

I tried the code using gcc without any error. What did you get ?

[dodicat]

SARG
I get a fail with 64 bits fb 1.10.0 (gcc)


Compiler output:
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c: In function 'DRAWSTRINGGFX':
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:278:40: warning: initialization of 'struct $2D2 *' from incompatible pointer type 'struct $2D2 *'
278 | static struct $7FBARRAYI2D2E XY$1 = { (struct $2D2*)0ull, (struct $2D2*)0ull, 0ll, 24ll, 0ll, 8ll, { } };
| ^
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:278:40: note: (near initialization for 'XY$1.DATA')
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:278:60: warning: initialization of 'struct $2D2 *' from incompatible pointer type 'struct $2D2 *'
278 | static struct $7FBARRAYI2D2E XY$1 = { (struct $2D2*)0ull, (struct $2D2*)0ull, 0ll, 24ll, 0ll, 8ll, { } };
| ^
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:278:60: note: (near initialization for 'XY$1.PTR')
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c: In function 'DRAWSTRING':
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:822:42: error: '$SETTEXTURE' undeclared (first use in this function); did you mean 'SETTEXTURE'?
822 | static struct $7FBARRAYI2D2E CPT$1 = { ($SETTEXTURE*)0ull, ($SETTEXTURE*)0ull, 0ll, 8ll, 0ll, 8ll, { } };
| ^~~~~~~~~~~
| SETTEXTURE
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:822:42: note: each undeclared identifier is reported only once for each function it appears in
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:822:54: error: expected expression before ')' token
822 | static struct $7FBARRAYI2D2E CPT$1 = { ($SETTEXTURE*)0ull, ($SETTEXTURE*)0ull, 0ll, 8ll, 0ll, 8ll, { } };
| ^
C:\Users\Computer\Desktop\fb\code\allbas2\FBIDETEMP.c:823:53: error: expected expression before ')' token
823 | static struct $7FBARRAYI2D2E XY$1 = { ($SETTEXTURE*)0ull, ($SETTEXTURE*)0ull, 0ll, 8ll, 0ll, 8ll, { } };
| ^

Results:
Compilation failed
(cannot make heads or tails of it!)

[srvaldez]

in reference to code posted above viewtopic.php?p=298964#p298964
dodicat, the offending code is in line 37 Static As d2 XY()
if you change it to something like redim As d2 XY(0,0) it compiles with gcc, though there are warnings
however, the wheels only show ... no graphics

[SARG]

Thanks.
At first I didn't remove #cmdline "-gen gas64".......
Now I got the errors.