Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Virtual Keyboard
| Uploader: |  PMedia |
| Datum/Zeit: | 23.10.2007 16:40:08 |
Declare Sub ConOut(S As String)
ConOut "Includes"
#include "fbgfx.bi"
#include once "fmod.bi"
ConOut "Constants"
Const BuffLen = 200
Const False = 0
Const True = Not False
Const flags = (&h2 Or &h00000008 Or &h00000020 Or &h00000080 Or &h00008000 Or &h00010000)
Const Version = "0.1"
Const ChanPerSamples = 32
Const Key_C1 = FB.SC_Q
Const Key_D1 = FB.SC_W
Const Key_E1 = FB.SC_E
Const Key_F1 = FB.SC_R
Const Key_G1 = FB.SC_T
Const Key_A1 = FB.SC_Y
Const Key_H1 = FB.SC_U
Const Key_C2 = FB.SC_A
Const Key_D2 = FB.SC_S
Const Key_E2 = FB.SC_D
Const Key_F2 = FB.SC_F
Const Key_G2 = FB.SC_G
Const Key_A2 = FB.SC_H
Const Key_H2 = FB.SC_J
Const Key_C3 = FB.SC_Z
Const Key_D3 = FB.SC_X
Const Key_E3 = FB.SC_C
Const Key_F3 = FB.SC_V
Const Key_G3 = FB.SC_B
Const Key_A3 = FB.SC_N
Const Key_H3 = FB.SC_M
'-------------------------------------------------------------------------------
Const Ganzton = 33
Const Halbton = 22
ConOut "Enums"
Enum E_Tonleiter
tC1 = 264
tD1 = tC1 + Ganzton
tE1 = tD1 + Halbton
tF1 = tE1 + Ganzton
tG1 = tF1 + Ganzton
tA1 = tG1 + Ganzton
tH1 = tA1 + Halbton
tC2 = tC1 * 2
tD2 = tC2 + Ganzton
tE2 = tD2 + Halbton
tF2 = tE2 + Ganzton
tG2 = tF2 + Ganzton
tA2 = tG2 + Ganzton
tH2 = tA2 + Halbton
tC3 = tC2 * 2
tD3 = tC3 + Ganzton
tE3 = tD3 + Halbton
tF3 = tE3 + Ganzton
tG3 = tF3 + Ganzton
tA3 = tG3 + Ganzton
tH3 = tA3 + Halbton
tC4 = tC3 * 2
tD4 = tC4 + Ganzton
tE4 = tD4 + Halbton
tF4 = tE4 + Ganzton
tG4 = tF4 + Ganzton
tA4 = tG4 + Ganzton
tH4 = tA4 + Halbton
tC5 = tC4 * 2
tD5 = tC5 + Ganzton
tE5 = tD5 + Halbton
tF5 = tE5 + Ganzton
tG5 = tF5 + Ganzton
tA5 = tG5 + Ganzton
tH5 = tA5 + Halbton
End Enum
Enum E_Channames
Chan0 = 0
Chan1
Chan2
Chan3
Chan4
End Enum
Enum E_SampleNames
Smpl0 = 0
Smpl1
Smpl2
Smpl3
Smpl4
End Enum
ConOut "Types"
Type T_Sample
SampleName As String
WaveData(0 to BuffLen) As UByte
Start As Long
Ende As Long
Changed As Byte = True
Sticky As Byte = False
Volume As Byte = 100
Damping As Byte = 100
End Type
Type T_Channel
Av As Byte = True
Chn As Long
Volume As Byte
Handle As Long Ptr
Freq As Long
DeFreq As Long
Sticky As Byte = False
End Type
'-------------------------------------------------------------------------------
ConOut "RGB-Vars"
Dim Shared As UByte R0, G0, B0
Dim Shared As UByte R1, G1, B1
Dim Shared As UByte R2, G2, B2
ConOut "Coord-Vars"
Dim Shared As Long X, Y
Dim Shared As Long X1, Y1
Dim Shared As Long X2, Y2
Dim Shared As Long P, I
Dim Shared As Long Oktave_Chan(2)
ConOut "Noten"
Dim Shared As ZString * 2 Note(2,6) => { _
{"c", "d", "e", "f", "g", "a", "h"}, _
{"c", "d", "e", "f", "g", "a", "h"}, _
{"c", "d", "e", "f", "g", "a", "h"} _
}
ConOut "Tastennamen"
Dim Shared As ZString * 2 Taste(2,6) => { _
{"q", "w", "e", "r", "t", "z", "u"}, _
{"a", "s", "d", "f", "g", "h", "j"}, _
{"y", "x", "c", "v", "b", "n", "m"} _
}
ConOut "Prozentiges"
Dim Shared As UByte Perce(2,6) => { _
{000, 000, 000, 000, 000, 000, 000}, _
{000, 000, 000, 000, 000, 000, 000}, _
{000, 000, 000, 000, 000, 000, 000} _
}
ConOut "Oktaven"
Dim Shared As Long Oktave(6,6) => { _
{tC1, tD1, tE1, tF1, tG1, tA1, tH1}, _
{tC2, tD2, tE2, tF2, tG2, tA2, tH2}, _
{tC3, tD3, tE3, tF3, tG3, tA3, tH3}, _
{tC4, tD4, tE4, tF4, tG4, tA4, tH4}, _
{tC5, tD5, tE5, tF5, tG5, tA5, tH5} _
}
ConOut "Samples"
Dim Shared As T_Sample Sample(2)
ConOut "Channels"
Dim Shared As T_Channel Channel(2, ChanPerSamples)
ConOut "ChanSam, cI, sI, Chan"
Dim Shared As Integer ChanSam(2)
Dim Shared As Integer cI
Dim Shared As Integer sI
Dim Shared As Integer Chan
ConOut "TempBuffer"
Dim Shared As ZString * BuffLen TempBuffer(2)
ConOut "Handle"
Dim Shared As Long Ptr Handle(2)
Dim Shared As Long LoopCtr
'-------------------------------------------------------------------------------
ConOut "Subs"
Sub ConOut(S As String)
Open Cons For Output as #1
print #1, s
close #1
End Sub
Sub KeyPress(Smpl As Byte, Frq As Long)
Dim As Long cI
Dim As Long cF
cF = -1
'ConOut Smpl
'ConOut Frq
If Sample(ChanSam(cF)).Sticky = False Then
For cI = 0 to ChanPerSamples-1
If Channel(Smpl, cI).DeFreq = Frq Then
Channel(Smpl, cI).Volume = 100
Return
End If
If Channel(Smpl, cI).Av = True Then
cF = cI
End If
Next
Else
cF = 0
End If
If cF <> -1 then
Channel(Smpl, cF).Av = False
If Sample(ChanSam(cF)).Sticky = True Then
Channel(Smpl, cF).Sticky = True
Channel(Smpl, cF).DeFreq = Frq
Else
Channel(Smpl, cF).Sticky = False
Channel(Smpl, cF).Freq = Frq
Channel(Smpl, cF).DeFreq = Frq
End If
Channel(Smpl, cF).Volume = 100
Else
ConOut "Too many samples!"
Beep
Sleep
End If
End Sub
Sub Assoc(Chan As Long, Smpl As Long)
Dim sI As Integer
Dim cI As Integer
ChanSam(Chan) = Smpl
For si = Sample(Smpl).Start to Sample(Smpl).Ende
TempBuffer(Chan) += Chr(Sample(Smpl).Wavedata(si))
Next
Handle(Chan) = FSOUND_Sample_Load(FSOUND_FREE ,Byval Varptr(tempbuffer(Chan)),flags,0,Len(TempBuffer(Chan)))
For cI = 0 to ChanPerSamples
FSOUND_StopSound(Channel(Chan, cI).Chn)
Channel(Chan, Ci).Av = True
Channel(Chan, Ci).Volume = 0
Channel(Chan, Ci).Freq = 0
Channel(Chan, cI).Chn = FSOUND_PlaySound (FSOUND_FREE, Handle(Chan))
FSOUND_SetFrequency Channel(Chan, cI).Chn , Channel(Chan, Ci).Freq
FSOUND_SetVolume Channel(Chan, cI).Chn , Channel(Chan, Ci).Volume
Next
End Sub
ConOut "Creating Window"
WindowTitle "PMedia vKeyBoard " + Version
Screen 19, 32
ConOut "Deleting Screen"
Line (0,0) - (800,600), &hFFFFFF, BF
Line (0,0) - (800,600), &hFFFFFF, BF
Randomize Timer
ConOut "Generating Sample 1"
'Sample Preload
Sample(0).Samplename = "Saw"
For i = 0 to BuffLen
Sample(0).WaveData(i) = (i/4) * 256
Next
Sample(0).Start = 0
Sample(0).Ende = 4
'Sample(0).Damping = 1
ConOut "Generating Sample 2"
Sample(1).SampleName = "Saw 2"
For i = 0 to BuffLen
Sample(1).WaveData(i) = (i/8) * 256
Next
Sample(1).Start = 0
Sample(1).Ende = 6
'Sample(1).Damping = 1
ConOut "Generating Sample 3"
Sample(2).SampleName = "Sine"
For i = 0 to BuffLen
Sample(2).WaveData(i) = (Sin(i/1.2)*127)+127
Next
Sample(2).Start = 0
Sample(2).Ende = 97
'Sample(2).Damping = 1
ConOut "Negotiating Version"
If( FSOUND_GetVersion() < FMOD_VERSION ) Then
ConOut "FMOD version " & FMOD_VERSION & " or greater required"
Sleep
End
End If
ConOut "Initializing FMOD"
If( FSOUND_Init(48000, 128, 0) = FALSE ) Then
ConOut "Can't initialize FMOD"
Sleep
End
End If
ConOut "Mapping Samples to Channels (1/3)"
Assoc Chan0, Smpl0
ConOut "Mapping Samples to Channels (2/3)"
Assoc Chan1, Smpl0
ConOut "Mapping Samples to Channels (3/3)"
Assoc Chan2, Smpl0
ConOut "Setting up Octaves"
Oktave_Chan(0) = 0
Oktave_Chan(1) = 1
Oktave_Chan(2) = 2
Do
ConOut "Locking Screen"
ScreenLock
'ScreenRefresh
ConOut "Drawing Keys"
ConOut "sI"
For sI = 0 to 2
ConOut "sI " + str(sI)
ConOut "X"
For X = 0 to 192 Step 32
ConOut "X = " + str(x)
ConOut "sI = " + str(sI)
ConOut "R1, G1, B1"
r1 = 255
g1 = 255
b1 = 255
ConOut "R2, G2, B2"
r2 = 255
g2 = 240
b2 = 128
ConOut "receiving Percentuage"
P = Perce(Si,X/32)
ConOut "Subtract if <> 0"
If P <> 0 then
ConOut "Muahahaha, SUBTRACT!!!!"
Perce(Si,X/32) -= 5
End If
ConOut "Calculating R"
r0 = (r1 / 100 * (100-P)) + (r2 / 100 * p)
ConOut "Calculating G"
g0 = (g1 / 100 * (100-P)) + (g2 / 100 * p)
ConOut "Calculating B"
b0 = (b1 / 100 * (100-P)) + (b2 / 100 * p)
ConOut "Drawing background of key"
Line (X+2,2 + (si * 144)) - (X+30, 130 + (si * 144)), rgb(r0, g0, b0), BF
ConOut "Drawing border of key"
Line (X,0 + (si * 144)) - (X+32, 132 + (si * 144)), rgb(00, 00, 00), B
ConOut "Drawing Note"
Draw String (X + 10, 100 + (si * 144)), Note( Si,X/32), &h000000
ConOut "Drawing Hotkey"
Draw String (X + 10, 115 + (si * 144)), Taste(Si,X/32), &h808080
Next
Next
ConOut "Drawing Wavedata"
For cI = 0 to 2
Si = ChanSam(cI)
'If Sample(sI).Changed = True Then
Line (240, 0 + (ci * 144)) - (768, 136 + (ci * 144)), &h000000, BF
For i = 0 to BuffLen
x1 = ((i / bufflen) * 528) + 240
y1 = (Sample(sI).WaveData(i) / 256) * 120 + (ci * 144)
x2 = (((i+1) / bufflen) * 528) + 240
y2 = (Sample(sI).WaveData(i+1) / 256) * 120 + (ci * 144)
Line (x1, y1) - (x2, y2), &h00c000
Next
For i = Sample(sI).Start to Sample(sI).Ende
x1 = ((i / bufflen) * 528) + 240
y1 = 0 + (ci * 144)
x2 = (((i+1) / bufflen) * 528) + 240
y2 = 120 + (ci * 144)
Line (x1, y1) - (x2, y2), &h005050, BF
Next
For i = Sample(sI).Start to Sample(sI).Ende
x1 = ((i / bufflen) * 528) + 240
y1 = (Sample(sI).WaveData(i) / 256) * 120 + (ci * 144)
x2 = (((i+1) / bufflen) * 528) + 240
y2 = (Sample(sI).WaveData(i+1) / 256) * 120 + (ci * 144)
Line (x1, y1) - (x2, y2), &h00c0c0
Next
Draw String (240, 121 + (ci * 144)), Sample(sI).SampleName + " (Oktave " + Str(Oktave_Chan(cI)) + ", D"+chr(132)+"mpfung " + Str(Sample(ChanSam(cI)).Damping) + "%)", &h00FF00
y1 = (si * 144)
y2 = (si * 144) + 120
x1 = 200
'End iF
Next
ConOut "ScreenUnlock"
ScreenUnlock
ConOut "Synchronisation"
ScreenSync
ConOut "Sleep 10ms"
Sleep 10
ConOut "Processing Input"
If MultiKey(Key_C1) Then
Perce(0,0) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 0))
End If
If MultiKey(Key_D1) Then
Perce(0,1) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 1))
End If
If MultiKey(Key_E1) Then
Perce(0,2) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 2))
End If
If MultiKey(Key_F1) Then
Perce(0,3) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 3))
End If
If MultiKey(Key_G1) Then
Perce(0,4) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 4))
End If
If MultiKey(Key_A1) Then
Perce(0,5) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 5))
End iF
If MultiKey(Key_H1) Then
Perce(0,6) = 100
KeyPress(0, Oktave(Oktave_Chan(0), 6))
End If
If MultiKey(Key_C2) Then
Perce(1,0) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 0))
End If
If MultiKey(Key_D2) Then
Perce(1,1) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 1))
End If
If MultiKey(Key_E2) Then
Perce(1,2) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 2))
End If
If MultiKey(Key_F2) Then
Perce(1,3) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 3))
End If
If MultiKey(Key_G2) Then
Perce(1,4) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 4))
End If
If MultiKey(Key_A2) Then
Perce(1,5) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 5))
End If
If MultiKey(Key_H2) Then
Perce(1,6) = 100
KeyPress(1, Oktave(Oktave_Chan(1), 6))
End If
If MultiKey(Key_C3) Then
Perce(2,0) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 0))
End If
If MultiKey(Key_D3) Then
Perce(2,1) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 1))
End If
If MultiKey(Key_E3) Then
Perce(2,2) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 2))
End If
If MultiKey(Key_F3) Then
Perce(2,3) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 3))
End If
If MultiKey(Key_G3) Then
Perce(2,4) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 4))
End If
If MultiKey(Key_A3) Then
Perce(2,5) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 5))
End If
If MultiKey(Key_H3) Then
Perce(2,6) = 100
KeyPress(2, Oktave(Oktave_Chan(2), 6))
End If
ConOut "Calculating further output"
For Chan = 0 to 2
For cI = 0 to ChanPerSamples
FSOUND_SetFrequency Channel(Chan, cI).Chn , Channel(Chan, Ci).Freq
FSOUND_SetVolume Channel(Chan, cI).Chn , Channel(Chan, Ci).Volume
Channel(Chan, Ci).Volume -= Sample(ChanSam(Chan)).Damping
If Sample(ChanSam(Chan)).sticky = true then
If Channel(Chan, Ci).Freq < Channel(Chan, Ci).DeFreq Then
Channel(Chan, Ci).Freq += 1
ElseIf Channel(Chan, Ci).Freq > Channel(Chan, Ci).DeFreq Then
Channel(Chan, Ci).Freq -= 1
End If
end if
If Channel(Chan, Ci).Volume < 0 then
Channel(Chan, Ci).Av = True
Channel(Chan, Ci).Volume = 0
End If
Next
Next
loopctr += 1
ConOut "Loop completed: #" + str(loopctr)
Loop Until MultiKey(FB.SC_ESCAPE)
FSOUND_Close