I found and converted a program to display a shape from several points from a BBC Micro Advanced Graphics book from 1983.
The program only displayed it and ended.
Once I had replicated that I decided to make it a bit fancier and added some extra bits to it.
Code: (Select All)
Option _Explicit
Screen _NewImage(800, 600, 32)
Dim As Integer x(30), y(30)
Dim As Integer N, XC, YC, size, i, j
Dim As Integer dx, dy, scale, maxsize, minsize, maxdxy, shape
Dim As Integer framecounter
Dim As Single alpha, spinspeed, adif
Dim As Long shapecolor
'##################################
' Setup some default values
'##################################
XC = 300 + Int(Rnd * 200): YC = 200 + Int(Rnd * 200)
N = 10
alpha = 0
spinspeed = 0.005
size = 150: scale = 10: minsize = 50: maxsize = 200
dx = 5 + Int(Rnd * 5) + 1: dy = 5 + Int(Rnd * 5) + 1: maxdxy = 40
shape = 1: shapecolor = _RGB32(240, 240, 240)
framecounter = 0
'#####################################################
'## Main loop
'#####################################################
Do
'##################################################################################################################
'## Calculate a new LIMIT based on the size of the shape,
'## smaller shape faster speed, larger shape slower speed
'##################################################################################################################
_Limit Int((220 - size) * 0.15 + 10)
Cls , _RGB32(0, 0, 0)
Locate 1, 1: Print "Left/Right: Dec/Inc Spin Speed. Down/Up: Dec/Inc. size -/+: Dec/Inc # of Points"
Locate 2, 1: Print "Q/W : Dec/Inc X direction D/E : Dec/Inc Y direction Space: Change Shape"
'##################################
'## Generate new points for the shape
'##################################
adif = (2 * _Pi / N) + spinspeed
For i = 1 To N
x(i) = Cos(alpha) * size + XC: y(i) = Sin(alpha) * size + YC
alpha = alpha + adif
Next i
'##################
'## Draw the shape
'##################
For i = 1 To N - 1
For j = i + 1 To N
If shape = 1 Then
Line (x(i), y(i))-(x(j), y(j)), shapecolor ' Draws only lines
Else
Line (x(i), y(i))-(x(j), y(j)), shapecolor, B ' Draws Boxes
End If
Next j
Next i
_Display
'##############################
' Get new shape screen position
'##############################
XC = XC + dx
YC = YC + dy
'##########################################################################################################################################
'## Process Key presses
'##########################################################################################################################################
If _KeyDown(20480) And size >= minsize And XC >= size + scale And YC >= size + scale Then size = size - scale ' UP Arrow
If _KeyDown(18432) And size <= maxsize Then ' Press DOWN Arrow and Size is not at maxiumum size
If _Width - size - (2 * scale) > XC And _Height - size - (2 * scale) > YC Then ' is not off right or bottom of screen
If XC >= size + (2 * scale) And YC >= size + (2 * scale) Then ' is not off left or top of screen
size = size + scale ' Increase Size of shape
End If
End If
End If
If _KeyDown(19200) And spinspeed > -0.02 Then spinspeed = spinspeed - 0.001 ' Left Arrow Key - Decrease Spin Speed
If _KeyDown(19712) And spinspeed < 0.02 Then spinspeed = spinspeed + 0.001 ' Right Arrow Key - Increase Spin Speed
If (_KeyDown(81) Or _KeyDown(113)) And Abs(dx) > 1 Then ' Press Q, reduce X direction
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) - (Sgn(dx) * 1)
End If
If (_KeyDown(87) Or _KeyDown(119)) And Abs(dx) < maxdxy Then ' Press W, increase X direction
If Abs(dx) >= 1 And Abs(dx) <= maxdxy Then dx = Sgn(dx) * Abs(dx) + (Sgn(dx) * 1)
End If
If (_KeyDown(69) Or _KeyDown(101)) And Abs(dy) < maxdxy Then ' Press E, increase Y direction
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) + (Sgn(dy) * 1)
End If
If (_KeyDown(68) Or _KeyDown(100)) And Abs(dy) > 1 Then ' Press D, decrease Y direction
If Abs(dy) >= 1 And Abs(dy) <= maxdxy Then dy = Sgn(dy) * Abs(dy) - (Sgn(dy) * 1)
End If
If _KeyDown(45) And N > 3 Then N = N - 1 ' Press - key, decrease points on shape
If _KeyDown(43) And N < 30 Then N = N + 1 ' Press + key, increase points on shape
If _KeyDown(32) And framecounter Mod 3 = 0 Then shape = shape * -1 ' Press Space to change shape, only once every 3 frames
'##########################################################################################################################################
'#####################################################################
'## change direction of shape and keep it within the screen boundaries
'#####################################################################
If XC > _Width - size - scale Then dx = -dx
If XC < size Then dx = -dx
If YC >= _Height - size - scale Then dy = -dy
If YC < size Then dy = -dy
framecounter = (framecounter Mod 100) + 1
Loop Until _KeyDown(27)
System
First, the code in question (all wrapped up in one little program for folks to play with, without needing to download BI and BM files.):
Code: (Select All)
$If WIN Then
Declare Library 'function is already used by QB64 so "User32" is not required
Function GetKeyState% (ByVal vkey As Long)
Function GetAsyncKeyState% (ByVal vkey As Long)
End Declare
$End If
Type KeyboardInfo_Type
Index As Long
ASCII As Long
Ctrl As Long
Shift As Long
Alt As Long
AltGr As Long
Repeat As _Float
LastHit As _Float
Down As Long
AltShift As Long
AltCtrl As Long
AltAltGr As Long
CtrlShift As Long
CtrlAlt As Long
CtrlAltGr As Long
ShiftAltGr As Long
CtrlAltShift As Long
End Type
Dim Shared Keys(254) As KeyboardInfo_Type
Dim Shared AltGr(1) As _Unsigned _Byte
_ControlChr Off
Dim Shared As Long ReturnCount, ReturnValues(30), AltGr, Alt, Shift, Ctrl
KeyboardTimer = _FreeTimer
On Timer(KeyboardTimer, 0.01) CheckKeystates
Timer(KeyboardTimer) On
Do
k = KeyHit: k1 = _KeyHit
If k Then
Print k;
If k > 0 And k < 256 Then Print Chr$(k), Else Print ,
Print k1;
If k1 > 0 And k1 < 256 Then Print Chr$(k1) Else Print
End If
_Limit 30
Loop
Sub CheckKeystates
$If WIN Then
If Keys(1).Index = 0 Then Init_KeyCodes "US", 0 'if someone forgets to put the init routine in their code, be certain to initialize the codes before attempting to use them.
If _WindowHasFocus Then
If Keys(16).Down Then Shift = -1 Else Shift = 0
If Keys(17).Down Then Ctrl = -1 Else Ctrl = 0
If Keys(18).Down Then Alt = -1 Else Alt = 0
If AltGr(0) <> 0 And AltGr(1) <> 0 Then
If Keys(AltGr(0)).Down And Keys(AltGr(1)).Down Then AltGr = -1 Else AltGr = 0
ElseIf AltGr(1) <> 0 Then
If Keys(AltGr(1)).Down Then AltGr = -1 Else AltGr = 0
ElseIf AltGr(0) <> 0 Then
If Keys(AltGr(0)).Down Then AltGr = -1 Else AltGr = 0
Else
AltGr = 0
End If
'until Ctrl or Alt status, if the key down was used to help generate AltGr as a modifier key
If AltGr Then
If (AltGr(0) = 18 Or AltGr(1) = 18) Then Alt = 0 'if we use both ALT keys to represent part of AltGr, when AltGr is active, Alt isn't.
If (AltGr(0) = 164 Or AltGr(1) = 164) And Keys(165).Down = 0 Then Alt = 0 'if we use Left ALT keys to represent part of AltGr, when AltGr is active, Left Alt isn't.
If (AltGr(0) = 165 Or AltGr(1) = 165) And Keys(164).Down = 0 Then Alt = 0 'if we use Right ALT keys to represent part of AltGr, when AltGr is active, Right Alt isn't.
If (AltGr(0) = 17 Or AltGr(1) = 17) Then Ctrl = 0 'if we use both CTRL keys to represent part of AltGr, when AltGr is active, Ctrl isn't.
If (AltGr(0) = 162 Or AltGr(1) = 162) And Keys(163).Down = 0 Then Ctrl = 0 'if we use Left CTRL keys to represent part of AltGr, when AltGr is active, Left Ctrl isn't.
If (AltGr(0) = 163 Or AltGr(1) = 163) And Keys(162).Down = 0 Then Ctrl = 0 'if we use Right CTRL keys to represent part of AltGr, when AltGr is active, Right Ctrl isn't.
End If
If Alt And Shift Then AltShift = -1 Else AltShift = 0
If Alt And Ctrl Then AltCtrl = -1 Else AltCtrl = 0
If Alt And AltAltGR Then AltAltGR = -1 Else AltAltGR = 0
If Ctrl And Shift Then CtrlShift = -1 Else CtrlShift = 0
If Shift And AltGr Then ShiftAltGr = -1 Else ShiftAltGr = 0
If Ctrl And Alt And Shift Then CtrlAltShift = -1 Else CtrlAltShift = 0
For i = 1 To 254
r = GetKeyState(Keys(i).Index) And &H8000
If r Then 'the key is down
If Keys(i).LastHit Then
If ExtendedTimer > Keys(i).LastHit Then
If ReturnCount < 30 Then ReturnCount = ReturnCount + 1 'add one to the return buffer
ReturnValues(ReturnCount) = Keys(i).Down 'and put the existing value back in the buffer, as a key repeat
Keys(i).LastHit = ExtendedTimer + Keys(i).Repeat
End If
Else
If Keys(i).Down = 0 Then 'the key was up on the last pass.
If CtrlAltShift <> 0 And Keys(i).CtrlAltShift <> 0 Then 'return the CtrlAltShift value
Keys(i).Down = Keys(i).CtrlAltShift
ElseIf AltAltGR <> 0 And Keys(i).AltAltGr <> 0 Then 'return the AltAltGr value
Keys(i).Down = Keys(i).AltAltGr
ElseIf CtrlAltGr& <> 0 And Keys(i).CtrlAltGr& <> 0 Then 'return the CtrlAltGr& value
Keys(i).Down = Keys(i).CtrlAltGr&
ElseIf ShiftAltGr <> 0 And Keys(i).ShiftAltGr <> 0 Then 'return the ShiftAltGr value
Keys(i).Down = Keys(i).ShiftAltGr
ElseIf CtrlShift <> 0 And Keys(i).CtrlShift <> 0 Then 'return the CtrlShift value
Keys(i).Down = Keys(i).CtrlShift
ElseIf AltCtrl <> 0 And Keys(i).AltCtrl <> 0 Then 'return the AltCtrl value
Keys(i).Down = Keys(i).AltCtrl
ElseIf AltShift <> 0 And Keys(i).AltShift <> 0 Then 'return the AltShift value
Keys(i).Down = Keys(i).AltShift
ElseIf AltGr <> 0 And Keys(i).AltGr <> 0 Then 'return the altgr value
Keys(i).Down = Keys(i).AltGr
ElseIf Shift <> 0 And Keys(i).Shift <> 0 Then 'return the shift value
Keys(i).Down = Keys(i).Shift
If _CapsLock = 0 Then 'caps lock basically reverses the behavior of the shift key with the letters A-Z and a-z
Select Case i
Case 65 To 90: Keys(i).Down = Keys(i).ASCII
End Select
End If
ElseIf (Ctrl <> 0) And (Keys(i).Ctrl <> 0) Then 'return the ctrl value
Keys(i).Down = Keys(i).Ctrl
ElseIf Alt <> 0 And Keys(i).Alt <> 0 Then 'return the alt value
Keys(i).Down = Keys(i).Alt
Else 'all that's left is to return the ASCII value
Keys(i).Down = Keys(i).ASCII
If _CapsLock = 0 Then 'caps lock basically reverses the behavior of the shift key with the letters A-Z and a-z
Select Case i
Case 65 To 90: Keys(i).Down = Keys(i).Shift
End Select
End If
End If
If ReturnCount < 30 Then ReturnCount = ReturnCount + 1 'add one to the return buffer
ReturnValues(ReturnCount) = Keys(i).Down 'and store the value in the buffer
If Keys(i).Repeat = -1 Then 'keys that are set to a -1 on repeat simply toggle state as on, or off.
Keys(i).LastHit = 1E+1000 'such as SHIFT, CTRL, ALT...
Else
Keys(i).LastHit = ExtendedTimer + Keys(i).Repeat 'and record when we hit it for repeat purposes
End If
End If
End If
Else
If Keys(i).Down Then 'the key was down on the last pass
If ReturnCount < 30 Then ReturnCount = ReturnCount + 1
ReturnValues(ReturnCount) = -Keys(i).Down 'mark it as being up on this one
End If
Keys(i).Down = 0 'and set it back down for future passes
Keys(i).LastHit = 0 'once again, set it as being ready to be hit again
End If
Next
End If 'End of IF _WINDOWHASFOCUS
$End If
End Sub
Sub SetAltGr (Key1 As Integer, Key2 As Integer)
AltGr(0) = Key1 'any key from our index (0 says no key)
AltGr(1) = Key2 'PLUS any other key from our index (0 says no additional key)
'Using this, we can set AltGr to become several things.
'AltGr(0) = 165, AltGr(1) = 0 -- This would say we're using the RIGHT Alt key (alone) to simulate the AltGr key. (Windows Onscreen Keyboard does this.)
'AltGr(0) = 17, AltGr(1) = 18 -- This would use any CTRL-ALT combo to simulate a AltGr keypress.
'Some useful values are listed for quick reference below
'0 = NoKey
'17 = ANY Ctrl
'18 = ANY Alt
'162 = Left Control
'163 = Right Control
'164 = Left Alt
'165 = Right Alt
'Default is for AltGr(0) = 165, AltGr(1) = 0, which uses Right-Alt alone as the AltGr key.
'Feel free to customize the setting to your personal preference/need.
End Sub
Sub KeyClear
_Delay .05 'give time for a keyup event to log itself so we can clear it
Do: k = KeyHit: Loop Until k = 0
End Sub
Function KeyHit&
$If WIN Then
If ReturnCount > 0 Then 'If we generated a cue of values last pass, clear those up first, before getting new values.
'The only time we really see this is when we hit a shift, ctrl, alt key, usually.
KeyHit = ReturnValues(1)
For i = 1 To ReturnCount - 1
ReturnValues(i) = ReturnValues(i + 1)
Next
ReturnCount = ReturnCount - 1
Exit Function
End If
$Else
KeyHit = _KEYHIT
$End If
End Function
Sub Remap_KeyCode (Which As Long, ASCII As Long, Ctrl As Long, Shift As Long, Alt As Long, AltGr As Long, Repeat As _Float)
Dim i As Long
i = Which
Keys(i).Index = i
Keys(i).ASCII = ASCII
Keys(i).Ctrl = Ctrl
Keys(i).Shift = Shift
Keys(i).Alt = Alt
Keys(i).AltGr = AltGr
Keys(i).Repeat = Repeat
Keys(i).LastHit = 0
Keys(i).Down = 0
End Sub
Function KeyDown& (Code As Long)
If Code <= 0 Then Exit Function
For i = 1 To 254
If GetAsyncKeyState(i) Then 'first check for actual physical keys down
If Keys(i).ASCII = Code Then KeyDown = -1: Exit Function 'then check to see if the code matches anything we've mapped it to.
If Keys(i).Shift = Code Then KeyDown = -1: Exit Function
If Keys(i).Alt = Code Then KeyDown = -1: Exit Function
If Keys(i).AltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).AltShift = Code Then KeyDown = -1: Exit Function
If Keys(i).AltCtrl = Code Then KeyDown = -1: Exit Function
If Keys(i).AltAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlShift = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).ShiftAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlAltShift = Code Then KeyDown = -1: Exit Function
End If
Next
KeyDown& = 0
End Function
Sub Init_KeyCodes (Language As String, RepeatRate As _Float)
Restore default_keyboard_data
For i = 1 To 254
Read Keys(i).Index, Keys(i).ASCII, Keys(i).Ctrl, Keys(i).Shift, Keys(i).Alt, Keys(i).AltGr, Keys(i).Repeat
If RepeatRate <> 0 And Keys(i).Repeat > 0 Then Keys(i).Repeat = RepeatRate
Keys(i).LastHit = 0: Keys(i).Down = 0
Next
default_keyboard_data:
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 1,900001,0,0,0,0,0.2: 'Left Mouse Button
Data 2,900002,0,0,0,0,0.2: 'Right Mouse Button
Data 3,900003,0,0,0,0,0.2: 'VK_Cancel
Data 4,900004,0,0,0,0,0.2: 'Middle Mouse Button
Data 5,900005,0,0,0,0,0.2: 'Mouse Button 4
Data 6,900006,0,0,0,0,0.2: 'Mouse Button 5
Data 7,900007,0,0,0,0,0.2: 'Undefined
Data 8,8,0,0,0,0,0.2: 'Backspace
Data 9,9,0,0,0,0,0.2: 'Tab
Data 10,900010,0,0,0,0,0.2: 'Reserved
Data 11,900011,0,0,0,0,0.2: 'Reserved
Data 12,19456,0,0,0,0,0.2: 'Clear
Data 13,13,0,0,0,0,0.2: 'Enter
Data 14,900014,0,0,0,0,0.2: 'Undefined
Data 15,900015,0,0,0,0,0.2: 'Undefined
Data 16,100016,0,0,0,0,-1: 'Shift (Notice I set it to simple toddle and report UP/DOWN results for us)
Data 17,100017,0,0,0,0,-1: 'Ctrl (Same)
Data 18,100018,0,0,0,0,-1: 'Alt (Same)
Data 19,100019,0,0,0,0,0.2: 'Pause
Data 20,100301,0,0,0,0,-1: 'Caps Lock
Data 21,900021,0,0,0,0,0.2: 'VK_Hangul
Data 22,900022,0,0,0,0,0.2: 'Undefined
Data 23,900023,0,0,0,0,0.2: 'VK_Junja
Data 24,900024,0,0,0,0,0.2: 'VK_Final
Data 25,900025,0,0,0,0,0.2: 'VK_Hanga//VK_Kanji
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 26,900026,0,0,0,0,0.2: 'Undefined
Data 27,27,0,0,0,0,0.2: 'ESC
Data 28,900028,0,0,0,0,0.2: 'VK_Convert
Data 29,900029,0,0,0,0,0.2: 'VK_NonConvert
Data 30,900030,0,0,0,0,0.2: 'VK_Accept
Data 31,900031,0,0,0,0,0.2: 'VK_ModeChange
Data 32,32,0,0,0,0,0.2: 'VK_Space
Data 33,18688,0,0,0,0,0.2: 'Page Up
Data 34,20736,0,0,0,0,0.2: 'Page Down
Data 35,20224,0,0,0,0,0.2: 'End
Data 36,18176,0,0,0,0,0.2: 'Home
Data 37,19200,0,0,0,0,0.2: 'Left Arrow
Data 38,18432,0,0,0,0,0.2: 'Up Arrow
Data 39,19712,0,0,0,0,0.2: 'Right Arrow
Data 40,20480,0,0,0,0,0.2: 'Down Arrow
Data 41,900041,0,0,0,0,-1: 'VK_SELECT
Data 42,900042,0,0,0,0,-1: 'CK_PRINT
Data 43,900043,0,0,0,0,-1: 'VK_EXECUTE
Data 44,900044,0,0,0,0,-1: 'VK_SNAPSHOT
Data 45,20992,0,0,0,0,0.2: 'INS
Data 46,21248,0,0,0,0,0.2: 'DEL
Data 47,900047,0,0,0,0,0.2: 'VK_HELP
Data 48,48,0,41,0,0,0.2: '0
Data 49,49,0,33,0,0,0.2: '1
Data 50,50,0,64,0,0,0.2: '2
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 51,51,0,35,0,0,0.2: '3
Data 52,52,0,36,0,0,0.2: '4
Data 53,53,0,37,0,0,0.2: '5
Data 54,54,0,94,0,0,0.2: '6
Data 55,55,0,38,0,0,0.2: '7
Data 56,56,0,42,0,0,0.2: '8
Data 57,57,0,40,0,0,0.2: '9
Data 58,900058,0,0,0,0,0.2: 'Undefined
Data 59,900059,0,0,0,0,0.2: 'Undefined
Data 60,900060,0,0,0,0,0.2: 'Undefined
Data 61,900061,0,0,0,0,0.2: 'Undefined
Data 62,900062,0,0,0,0,0.2: 'Undefined
Data 63,900063,0,0,0,0,0.2: 'Undefined
Data 64,900064,0,0,0,0,0.2: 'Undefined
Data 65,65,0,97,0,0,0.2: 'a
Data 66,66,0,98,0,0,0.2: 'b
Data 67,67,0,99,0,0,0.2: 'c
Data 68,68,0,100,0,0,0.2: 'd
Data 69,69,0,101,0,0,0.2: 'e
Data 70,70,0,102,0,0,0.2: 'f
Data 71,71,0,103,0,0,0.2: 'g
Data 72,72,0,104,0,0,0.2: 'h
Data 73,73,0,105,0,0,0.2: 'i
Data 74,74,0,106,0,0,0.2: 'j
Data 75,75,0,107,0,0,0.2: 'k
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 76,76,0,108,0,0,0.2: 'l
Data 77,77,0,109,0,0,0.2: 'm
Data 78,78,0,110,0,0,0.2: 'n
Data 79,79,0,111,0,0,0.2: 'o
Data 80,80,0,112,0,0,0.2: 'p
Data 81,81,0,113,0,0,0.2: 'q
Data 82,82,0,114,0,0,0.2: 'r
Data 83,83,0,115,0,0,0.2: 's
Data 84,84,0,116,0,0,0.2: 't
Data 85,85,0,117,0,0,0.2: 'u
Data 86,86,0,118,0,0,0.2: 'v
Data 87,87,0,119,0,0,0.2: 'w
Data 88,88,0,120,0,0,0.2: 'x
Data 89,89,0,121,0,0,0.2: 'y
Data 90,90,0,122,0,0,0.2: 'z
Data 91,100311,0,0,0,0,-1: 'Left WIN
Data 92,100312,0,0,0,0,-1: 'Right WIN
Data 93,100319,0,0,0,0,-1: 'Applications (Menu)
Data 94,900094,0,0,0,0,0.2: 'Reserved
Data 95,900095,0,0,0,0,0.2: 'VK_SLEEP
Data 96,48,0,0,0,0,0.2: 'Numpad 0
Data 97,49,0,0,0,0,0.2: 'Numpad 1
Data 98,50,0,0,0,0,0.2: 'Numpad 2
Data 99,51,0,0,0,0,0.2: 'Numpad 3
Data 100,52,0,0,0,0,0.2: 'Numpad 4
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 101,53,0,0,0,0,0.2: 'Numpad 5
Data 102,54,0,0,0,0,0.2: 'Numpad 6
Data 103,55,0,0,0,0,0.2: 'Numpad 7
Data 104,56,0,0,0,0,0.2: 'Numpad 8
Data 105,57,0,0,0,0,0.2: 'Numpad 9
Data 106,42,0,0,0,0,0.2: 'Numpad *
Data 107,43,0,0,0,0,0.2: 'Numpad +
Data 108,900108,0,0,0,0,0.2: 'VK_SEPARATOR
Data 109,51,0,0,0,0,0.2: 'Numpad -
Data 110,52,0,0,0,0,0.2: 'Numpad .
Data 111,53,0,0,0,0,0.2: 'Numpad /
Data 112,15104,0,0,0,0,0.2: 'F1
Data 113,15360,0,0,0,0,0.2: 'F2
Data 114,15616,0,0,0,0,0.2: 'F3
Data 115,15872,0,0,0,0,0.2: 'F4
Data 116,16128,0,0,0,0,0.2: 'F5 /
Data 117,16384,0,0,0,0,0.2: 'F6
Data 118,16640,0,0,0,0,0.2: 'F7
Data 119,16896,0,0,0,0,0.2: 'F8
Data 120,17152,0,0,0,0,0.2: 'F9
Data 121,17408,0,0,0,0,0.2: 'F10
Data 122,34048,0,0,0,0,0.2: 'F11
Data 123,34304,0,0,0,0,0.2: 'F12
Data 124,900124,0,0,0,0,0.2: 'F13
Data 125,900125,0,0,0,0,0.2: 'F14
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 126,900126,0,0,0,0,0.2: 'F15
Data 127,900127,0,0,0,0,0.2: 'F16
Data 128,900128,0,0,0,0,0.2: 'F17
Data 129,900129,0,0,0,0,0.2: 'F18
Data 130,900130,0,0,0,0,0.2: 'F19
Data 131,900131,0,0,0,0,0.2: 'F20
Data 132,900132,0,0,0,0,0.2: 'F21
Data 133,900133,0,0,0,0,0.2: 'F22
Data 134,900134,0,0,0,0,0.2: 'F23
Data 135,900135,0,0,0,0,0.2: 'F24
Data 136,900136,0,0,0,0,0.2: 'Unassigned
Data 137,900137,0,0,0,0,0.2: 'Unassigned
Data 138,900138,0,0,0,0,0.2: 'Unassigned
Data 139,900139,0,0,0,0,0.2: 'Unassigned
Data 140,900140,0,0,0,0,0.2: 'Unassigned
Data 141,900141,0,0,0,0,0.2: 'Unassigned
Data 142,900142,0,0,0,0,0.2: 'Unassigned
Data 143,900143,0,0,0,0,0.2: 'Unassigned
Data 144,100300,0,0,0,0,-1: 'NUM LOCK
Data 145,100302,0,0,0,0,-1: 'SCROLL LOCK
Data 146,900146,0,0,0,0,0.2: 'OEM SPECIFIC
Data 147,900147,0,0,0,0,0.2: 'OEM SPECIFIC
Data 148,900148,0,0,0,0,0.2: 'OEM SPECIFIC
Data 149,900149,0,0,0,0,0.2: 'OEM SPECIFIC
Data 150,900150,0,0,0,0,0.2: 'OEM SPECIFIC
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 151,900151,0,0,0,0,0.2: 'Unassigned
Data 152,900152,0,0,0,0,0.2: 'Unassigned
Data 153,900153,0,0,0,0,0.2: 'Unassigned
Data 154,900154,0,0,0,0,0.2: 'Unassigned
Data 155,900155,0,0,0,0,0.2: 'Unassigned
Data 156,900156,0,0,0,0,0.2: 'Unassigned
Data 157,900157,0,0,0,0,0.2: 'Unassigned
Data 158,900158,0,0,0,0,0.2: 'Unassigned
Data 159,900159,0,0,0,0,0.2: 'Unassigned
Data 160,100304,0,0,0,0,-1: 'Left Shift
Data 161,100303,0,0,0,0,-1: 'Right Shift
Data 162,100306,0,0,0,0,-1: 'Left Control
Data 163,100305,0,0,0,0,-1: 'Right Control
Data 164,100308,0,0,0,0,-1: 'Left Alt
Data 165,100309,0,0,0,0,-1: 'Right Alt
Data 166,900166,0,0,0,0,0.2: 'Browser back
Data 167,900167,0,0,0,0,0.2: 'Browser forward
Data 168,900168,0,0,0,0,0.2: 'Browser refresh
Data 169,900169,0,0,0,0,0.2: 'Browser stop
Data 170,900170,0,0,0,0,0.2: 'Browser search
Data 171,900171,0,0,0,0,0.2: 'Browser favorites
Data 172,900172,0,0,0,0,0.2: 'Browser home
Data 173,900173,0,0,0,0,0.2: 'Mute
Data 174,900174,0,0,0,0,0.2: 'Vol Down
Data 175,900175,0,0,0,0,0.2: 'Vol Up
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 176,900176,0,0,0,0,0.2: 'Media Next
Data 177,900177,0,0,0,0,0.2: 'Media prev
Data 178,900178,0,0,0,0,0.2: 'Media stop
Data 179,900179,0,0,0,0,0.2: 'Media Play/Pause
Data 180,900180,0,0,0,0,0.2: 'Launch mail
Data 181,900181,0,0,0,0,0.2: 'Launch media select
Data 182,900182,0,0,0,0,0.2: 'Launch app1
Data 183,900183,0,0,0,0,0.2: 'Launch app2
Data 184,900184,0,0,0,0,0.2: 'Reserved
Data 185,900185,0,0,0,0,0.2: 'Reserved
Data 186,59,0,58,0,0,0.2: ';:
Data 187,61,0,43,0,0,0.2: '=+
Data 188,44,0,60,0,0,0.2: ',<
Data 189,45,0,95,0,0,0.2: '-_
Data 190,46,0,62,0,0,0.2: '.>
Data 191,47,0,63,0,0,0.2: '/?
Data 192,96,0,126,0,0,0.2: '`~
Data 193,900193,0,0,0,0,0.2: 'Reserved
Data 194,900194,0,0,0,0,0.2: 'Reserved
Data 195,900195,0,0,0,0,0.2: 'Reserved
Data 196,900196,0,0,0,0,0.2: 'Reserved
Data 197,900197,0,0,0,0,0.2: 'Reserved
Data 198,900198,0,0,0,0,0.2: 'Reserved
Data 199,900199,0,0,0,0,0.2: 'Reserved
Data 200,900200,0,0,0,0,0.2: 'Reserved
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 201,900201,0,0,0,0,0.2: 'Reserved
Data 202,900202,0,0,0,0,0.2: 'Reserved
Data 203,900203,0,0,0,0,0.2: 'Reserved
Data 204,900204,0,0,0,0,0.2: 'Reserved
Data 205,900205,0,0,0,0,0.2: 'Reserved
Data 206,900206,0,0,0,0,0.2: 'Reserved
Data 207,900207,0,0,0,0,0.2: 'Reserved
Data 208,900208,0,0,0,0,0.2: 'Reserved
Data 209,900209,0,0,0,0,0.2: 'Reserved
Data 210,900210,0,0,0,0,0.2: 'Reserved
Data 211,900211,0,0,0,0,0.2: 'Reserved
Data 212,900212,0,0,0,0,0.2: 'Reserved
Data 213,900213,0,0,0,0,0.2: 'Reserved
Data 214,900214,0,0,0,0,0.2: 'Reserved
Data 215,900215,0,0,0,0,0.2: 'Reserved
Data 216,900216,0,0,0,0,0.2: 'Unassigned
Data 217,900217,0,0,0,0,0.2: 'Unassigned
Data 218,900218,0,0,0,0,0.2: 'Unassigned
Data 219,91,0,123,0,0,0.2: '[{
Data 220,92,0,124,0,0,0.2: '\|
Data 221,93,0,125,0,0,0.2: ']}
Data 222,39,0,34,0,0,0.2: ''"
Data 223,900223,0,0,0,0,0.2: 'OEM SPECIFIC
Data 224,900224,0,0,0,0,0.2: 'Reserved
Data 225,900225,0,0,0,0,0.2: 'OEM SPECIFIC d
Data 226,900226,0,0,0,0,0.2: 'Either the Angle Bracket key,or Backslash on RT 102-key keyboard
Data 227,900227,0,0,0,0,0.2: 'OEM SPECIFIC
Data 228,900228,0,0,0,0,0.2: 'OEM SPECIFIC
Data 229,900229,0,0,0,0,0.2: 'IME PROCESS key (whatever that is)
Data 230,900230,0,0,0,0,0.2: 'OEM SPECIFIC
Data 231,900231,0,0,0,0,0.2: 'Used to pass UNICODE characters (however that works)
Data 232,900232,0,0,0,0,0.2: 'Unassigned
Data 233,900233,0,0,0,0,0.2: 'OEM SPECIFIC
Data 234,900234,0,0,0,0,0.2: 'OEM SPECIFIC
Data 235,900235,0,0,0,0,0.2: 'OEM SPECIFIC
Data 236,900236,0,0,0,0,0.2: 'OEM SPECIFIC
Data 237,900237,0,0,0,0,0.2: 'OEM SPECIFIC
Data 238,900238,0,0,0,0,0.2: 'OEM SPECIFIC
Data 239,900239,0,0,0,0,0.2: 'OEM SPECIFIC
Data 240,900240,0,0,0,0,0.2: 'OEM SPECIFIC
Data 241,900241,0,0,0,0,0.2: 'OEM SPECIFIC
Data 242,900242,0,0,0,0,0.2: 'OEM SPECIFIC
Data 243,900243,0,0,0,0,0.2: 'OEM SPECIFIC
Data 244,900244,0,0,0,0,0.2: 'OEM SPECIFIC
Data 245,900245,0,0,0,0,0.2: 'OEM SPECIFIC
Data 246,900246,0,0,0,0,0.2: 'VK_ATTN
Data 247,900247,0,0,0,0,0.2: 'VK_ATTN
Data 248,900248,0,0,0,0,0.2: 'VK_ATTN
Data 249,900249,0,0,0,0,0.2: 'VK_ATTN
Data 250,900250,0,0,0,0,0.2: 'VK_ATTN
Data 251,900251,0,0,0,0,0.2: 'VK_ATTN
Data 252,900252,0,0,0,0,0.2: 'Reserved
Data 253,900253,0,0,0,0,0.2: 'VK_PA1
Data 254,900253,0,0,0,0,0.2: 'VK_OEM_CLEAR
Data 0,0,0,0,0,0,0.2: 'END OF DATA
AltGr(0) = 165
AltGr(1) = 0
Select Case Language
Case "DE"
Restore Microsoft_windows_cp1250
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
Microsoft_windows_cp1250:
Data 8364,0,8218,0,8222,8230,8224,8225,0,8240,352,8249,346,356,381,377
Data 0,8216,8217,8220,8221,8226,8211,8212,0,8482,353,8250,347,357,382,378
Data 160,711,728,321,164,260,166,167,168,169,350,171,172,173,174,379
Data 176,177,731,322,180,181,182,183,184,261,351,187,317,733,318,380
Data 340,193,194,258,196,313,262,199,268,201,280,203,282,205,206,270
Data 272,323,327,211,212,336,214,215,344,366,218,368,220,221,354,223
Data 341,225,226,259,228,314,263,231,269,233,281,235,283,237,238,271
Data 273,324,328,243,244,337,246,247,345,367,250,369,252,253,355,729
'Remap_KeyCode (Which, ASCII, Ctrl , Shift, Alt, AltGr, Repeat AS _FLOAT)
Remap_KeyCode 226, 60, 0, 62, 124, 92, 0.2 '<>|
Remap_KeyCode 219, 225, 0, 63, 0, 0, 0.2 '-
Remap_KeyCode 48, 48, 0, 61, 0, 125, 0.2 '0
Remap_KeyCode 192, 148, 0, 153, 0, 0, 0.2
Remap_KeyCode 222, 132, 0, 142, 0, 0, 0.2
Remap_KeyCode 50, 50, 0, 34, 0, 253, 0.2: '2 .. I don't see a superscript 3 for AltGr codes for the 3 key.
Remap_KeyCode 51, 51, 0, 35, 0, 0, 0.2: '3 ..I don't see the squiggle for this in the ASCII code. It needs to be changed, but I dunno with what.
Remap_KeyCode 54, 54, 0, 38, 0, 0, 0.2: '6
Remap_KeyCode 55, 55, 0, 47, 0, 123, 0.2: '7
Remap_KeyCode 56, 56, 0, 40, 0, 91, 0.2: '8
Remap_KeyCode 57, 57, 0, 41, 0, 93, 0.2: '9
Remap_KeyCode 186, 129, 0, 154, 0, 0, 0.2: ';:
Remap_KeyCode 187, 43, 0, 42, 0, 126, 0.2: '=+
Remap_KeyCode 191, 35, 0, 249, 0, 0, 0.2: '/?
Remap_KeyCode 81, 81, 0, 113, 0, 64, 0.2: 'q
Remap_KeyCode 69, 69, 0, 101, 0, 238, 0.2: 'e
Remap_KeyCode 77, 77, 0, 109, 0, 0, 0.2: 'm -- again, I failed to find the goofy u which AltGr produces in the 256 ASCII set
Case "WE"
Restore Microsoft_windows_cp1252
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
Microsoft_windows_cp1252:
Data 8364,0,8218,402,8222,8230,8224,8225,710,8240,352,8249,338,0,381,0
Data 0,8216,8217,8220,8221,8226,8211,8212,732,8482,353,8250,339,0,382,376
Data 160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175
Data 176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
Data 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
Data 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
Data 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
Data 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
Restore ASCII_cp850
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
ASCII_cp850:
Data 199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197
Data 201,230,198,244,246,242,251,249,255,214,220,248,163,216,215,402
Data 225,237,243,250,241,209,170,186,191,174,172,189,188,161,171,187
Data 9617,9618,9619,9474,9508,193,194,192,169,9571,9553,9559,9565,162,165,9488
Data 9492,9524,9516,9500,9472,9532,227,195,9562,9556,9577,9574,9568,9552,9580,164
Data 240,208,202,203,200,305,205,206,207,9496,9484,9608,9604,166,204,9600
Data 211,223,212,210,245,213,181,254,222,218,219,217,253,221,175,180
Data 173,177,8215,190,182,167,247,184,176,168,183,185,179,178,9632,160
$If EXTENDEDTIMER = UNDEFINED Then
$Let EXTENDEDTIMER = TRUE
Function ExtendedTimer##
'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.
Static olds As _Float, old_day As _Float, oldt As _Float
Dim m As Integer, d As Integer, y As Integer
Dim s As _Float, day As String
If olds = 0 Then 'calculate the day the first time the extended timer runs
day = Date$
m = Val(Left$(day, 2))
d = Val(Mid$(day, 4, 2))
y = Val(Right$(day, 4)) - 1970
Select Case m 'Add the number of days for each previous month passed
Case 2: d = d + 31
Case 3: d = d + 59
Case 4: d = d + 90
Case 5: d = d + 120
Case 6: d = d + 151
Case 7: d = d + 181
Case 8: d = d + 212
Case 9: d = d + 243
Case 10: d = d + 273
Case 11: d = d + 304
Case 12: d = d + 334
End Select
If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
old_day = s
End If
If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)
old_day = s + 83400 'add another worth of seconds to our counter
End If
oldt = Timer
olds = old_day + oldt
ExtendedTimer## = olds
End Function
$End If
Sub ExtendedInput (prompt$, result$) 'Over Engineered Input
'limit VALUES:
'1 = Unsigned
'2 = Integer
'4 = Float
'8 = Who cares. It's handled via internal variables and we don't need to know a type for it.
'Uses {} at the start of the prompt to limit possible input
'P = Password
'U = Unsigned
'I = Integer
'F = Float
'L## = Length of max ##
'X##, Y## = LOCATE before printing
'D = Disable paste option
'V = Move CTRL-V to AFTER paste
'H = Hide Input after finished. (Won't leave prompt, or user input on the screen.)
PCopy 0, 1
A = _AutoDisplay: X = Pos(0): Y = CsrLin
OX = X: OY = Y 'original x and y positions
CP = 0: OldCP = 0 'Cursor Position
_KeyClear
length_limit = -1 'unlimited length input, by default
If Left$(prompt$, 1) = "{" Then 'possible limiter
i = InStr(prompt$, "}")
If i Then 'yep, we have something!
limiter$ = UCase$(Mid$(prompt$, 2, i - 2))
If InStr(limiter$, "U") Then limit = limit Or 1 'Unsigned
If InStr(limiter$, "I") Then 'can't limit to BOTH an integer AND a float
limit = limit Or 2 'Integer
ElseIf InStr(limiter$, "F") Then
limit = limit Or 4 'Float
float_before_limit = KB_GetValue(limiter$, "F")
float_after_limit = KB_GetValue(Mid$(limiter$, InStr(limiter$, "F") + 1), ".")
End If
End If
If InStr(limiter$, "P") Then password_protected = -1: limit = limit Or 8 'don't show passwords.
If InStr(limiter$, "L") Then 'Length Limitation
limit = limit Or 8
length_limit = KB_GetValue(limiter$, "L")
End If
If InStr(limiter$, "X") Then 'X position on screen
limit = limit Or 8
X = KB_GetValue(limiter$, "X")
End If
If InStr(limiter$, "Y") Then 'Y position on scren
limit = limit Or 8
Y = KB_GetValue(limiter$, "Y")
End If
If InStr(limiter$, "D") Then disable_paste = -1: limit = limit Or 8 'disable paste
If InStr(limiter$, "V") Then cursor_after_paste = -1: limit = limit Or 8 'disable paste
If InStr(limiter$, "H") Then clean_exit = -1: limit = limit Or 8 'hide after finished
End If
If limit <> 0 Then prompt$ = Mid$(prompt$, i + 1)
Do
PCopy 1, 0
If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
k = KeyHit
If AltDown Then
Select Case k 'ignore all keypresses except ALT-number presses
Case -57 To -48: AltWasDown = -1: alt$ = alt$ + Chr$(-k)
End Select
Else
Select Case k 'without alt, add any keypresses to our input
Case 8
oldin$ = in$
If CP > 0 Then OldCP = CP: CP = CP - 1
in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
Case 9
oldin$ = in$
in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
OldCP = CP
CP = CP + 4
Case 32 To 128
If _KeyDown(100305) Or _KeyDown(100306) Then
If k = 118 Or k = 86 Then
If disable_paste = 0 Then
oldin$ = in$
temp$ = _Clipboard$
in$ = Left$(in$, CP) + temp$ + Mid$(in$, CP + 1) 'ctrl-v paste
'CTRL-V leaves cursor in position before the paste, without moving it after.
'Feel free to modify that behavior here, if you want it to move to after the paste.
If cursor_after_paste Then CP = CP + Len(temp$)
End If
End If
If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
Else
check_input:
oldin$ = in$
If limit And 1 Then 'unsigned
If k = 43 Or k = 45 Then _Continue 'remove signs +/-
End If
If limit And 2 Then 'integer
If k = 45 And CP = 0 Then GoTo good_input 'only allow a - sign for the first digit
If k < 48 Or k > 57 Then _Continue 'remove anything non-numeric
End If
If limit And 4 Then 'float
If k = 45 And CP = 0 Then GoTo good_input 'only allow a - sign for the first digit
If k = 46 And InStr(in$, ".") = 0 Then GoTo good_input 'only one decimal point
If k < 48 Or k > 57 Then _Continue 'remove anything non-numeric
If Left$(in$, 1) = "-" Then temp$ = Mid$(in$, 2) Else temp$ = in$
If InStr(in$, ".") = 0 Or CP < InStr(in$, ".") Then
If Len(temp$) < float_before_limit Or float_before_limit = -1 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
Else
temp$ = Mid$(in$, InStr(in$, ".") + 1)
If Len(temp$) < float_after_limit Or float_after_limit = -1 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
End If
_Continue
End If
good_input:
If CP < length_limit Or length_limit < 0 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
End If
Case 18176 'Home
CP = 0
Case 20224 'End
CP = Len(in$)
Case 21248 'Delete
oldin$ = in$
in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
Case 19200 'Left
CP = CP - 1
If CP < 0 Then CP = 0
Case 19712 'Right
CP = CP + 1
If CP > Len(in$) Then CP = Len(in$)
End Select
End If
alt$ = Right$(alt$, 3)
If AltWasDown = -1 And AltDown = 0 Then
v = Val(alt$)
If v >= 0 And v <= 255 Then
k = v
alt$ = "": AltWasDown = 0
GoTo check_input
End If
End If
blink = (blink + 1) Mod 30
Locate Y, X
Print prompt$;
If password_protected Then
Print String$(Len(Left$(in$, CP)), "*");
If blink \ 15 Then Print " "; Else Print "_";
Print String$(Len(Mid$(in$, CP + 1)), "*")
Else
Print Left$(in$, CP);
If blink \ 15 Then Print " "; Else Print "_";
Print Mid$(in$, CP + 1)
End If
_Display
_Limit 30
Loop Until k = 13
PCopy 1, 0
Locate OY, OX
If clean_exit = 0 Then
Locate Y, X
If password_protected Then
Print prompt$; String$(Len(in$), "*")
Else
Print prompt$; in$
End If
End If
result$ = in$
If A Then _AutoDisplay
End Sub
Function KB_GetValue (limiter$, what$)
jstart = InStr(limiter$, what$): j = 0
If Mid$(limiter$, InStr(limiter$, what$) + 1, 1) = "-" Then
GetValue = -1 'unlimited
Exit Function
End If
Do
j = j + 1
m$ = Mid$(limiter$, jstart + j, 1)
Loop Until m$ < "0" Or m$ > "9"
KB_GetValue = Val(Mid$(limiter$, jstart + 1, j - 1))
End Function
Now to explain what's going on with our program here. First, let me just showcase the main routine, once all the library stuff is out of the way:
Do
k = KeyHit: k1 = _KeyHit
If k Then
Print k;
If k > 0 And k < 256 Then Print Chr$(k), Else Print ,
Print k1;
If k1 > 0 And k1 < 256 Then Print Chr$(k1) Else Print
End If
_Limit 30
Loop
So what's different here, than with the old Keyboard Library?
First, we've swapped over to running everything on an ON TIMER loop, where we check and update our keyboard states 100 times a second. This allows us to continue to monitor the keystates even when we insert a pause into our program (think _DELAY 3 or SLEEP 3, though it'd need to be a routine which doesn't lock up execution of timers), and is now generating a keyboard buffer like we're used to seeing with _KEYHIT and INKEY$
Now, why would anyone ever be interested in swapping over to this KeyHit method, instead of just using the simple one we already have?
1) It's customizable. You can configure this to work with *ANY* style keyboard that you might have. Currently, it offers support for "US", "DE", "WE", and "IT" keyboards. (US, German, Western Europe, and Italian, if I remember all those abbreviations right.) Press that key for accented "A" on your keyboard, have that accented "A" pop up on the screen!
2) It reads and responds to keys that _KEYHIT, unfortunately does not. Try the CTRL + TAB combo with the demo and you'll see what I'm talking about fairly easily.
3) It's got a larger keyboard buffer -- 30 keypresses can be stored for future interactions, whereas we normally only have about 8 with _KEYHIT.
Now, I know you guys are all going, "WOW! SOUNDS AWESOME!!"... but there's one thing to keep in mind...
This is a WINDOWS ONLY library. I'm not a Linux/Mac programmer by nature, so I have no idea how the heck to read individual keystates on those OSes, so there's no way I'll be making this a cross-platform library anytime soon.
And with that said, let's talk about the actual little demo here and what you can expect if/when you run it.
First, let me just preface by saying this demo does nothing but print some key codes to the screen for you. (And maybe a few text characters, depending on what keys you hit.)
Run it, hit "A", and you'll notice that both KeyHit and _KEYHIT return the same value for your keypress -- 97 for down, -97 for up.
Hold that A-key for a few seconds, and you might notice something a little odd to you at first. You might see reports of 97 for KeyHit, but 0 for _KEYHIT... Don't be alarmed!! That's just a difference in the repeat rates between the two commands. I've currently got KeyHit configured to repeat keystrokes every 0.1 second (10 times per second). Your OS might have a different repeat rate than that. You can ignore those 0's that might appear on either side of the screen, in this instance.
Now, as I mentioned, try out some combo keys. Hold down CTRL and press TAB... Keyhit will report CTRL going down, and then it will report "9", "9", "9" for the TAB key being down. _KEYHIT, on the other hand, will *ALWAYS* just report "0", "0", "0", ... as it simply doesn't read that key combination!!
Even odder, when you release the TAB key, Keyhit will properly report "-9" for a Tab-UP event. _KEYHIT, on the other hand, reports -105 to us -- which is the code for an "I-key"-UP event!!
_KEYHIT thinks you never pressed any key down, but you let the "I" key up when you were finished holding down the key that never got pressed!!
As far as I can tell, everything here is working as it should now. If anyone has non-US keyboards and wants to give this a test run, just be certain to change the Init_Keyboard language code to whatever suits your keyboard, and then be kind enough to tell me what happens when you try and use it.
Linux/Mac folks can try to use it too. (For you, it should just swap out to a plain old _KEYHIT call -- SORRY!!) If you get some sort of error messages, or it behaves weirder than you'd expect with _KEYHIT, kindly let me know what the heck it might be doing for you. This isn't really supposed to do anything except for Windows-users... If it's not playing nice with other OSes, then something somewhere got wonkered out when I swapped over to putting it all on a timed routine, and I'll need to try and sort out what the heck that was.
I am trying to write a gradebook program to use for myself and using some of the honored libraries on the site, I am having a little trouble understanding why my program is hanging. Seems when I try to restore a prior screen, the program hangs. Even inserting a beep seems to show the program successfully exits the sub in the library but alas.... It is stuck.... I have never had a problem of the sort where I can step through with the debugger (though program execution seemed to be stuck already) but the program is stuck. Any ideas?
I'll upload what I have, the problem seems to be in the main .bas file lines 68 to 76 or in vs GUI.BM in the MainRouter sub (line 75). The only change I made to that is to give an escape from the sub. It *seems* to be working as intended, it does escape and goes beep but then gets stuck.
I really am at a loss..... Thanks for just looking!
Edit: Stripped out the .exe. Sorry about that, I am on Beijing time and it was late when I posted this
Just a basic demo of the Qix 'entity'. I used to enjoy this arcade game back in the day.
Using the mouse, you control a circle that it either follows (blue) or avoids (red). The mouse wheel changes the circle size - larger has a stronger effect.
Cheers!
Code: (Select All)
'Qix interactive demo
'james2464 - Nov 22 2022
'BLUE circle = follow
'RED circle = avoid
'scroll mouse wheel to increase / decrease
Screen _NewImage(800, 600, 32)
Const PI = 3.141592654#
Randomize Timer
'origin
xx = 400: yy = 300
Dim c(10) As Long
c(1) = _RGB(100, 100, 200)
c(2) = _RGB(200, 100, 100)
Type qix
dir As Single
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
xx As Single
yy As Single
len1 As Single
c1 As Integer
c2 As Integer
c3 As Integer
End Type
Dim Shared q(7) As qix
Dim Shared qixtot, qxv, qyv, qpath, f
Dim Shared mx%, my%
qixtot = 7: qpath = 0: f = 1
'start
For t = 1 To qixtot
q(t).xx = xx: q(t).yy = yy: q(t).len1 = 40
Next t
_MouseHide
Do
_Limit 20
Do While _MouseInput
f = f - _MouseWheel * .1
Loop
If f > 2 Then f = 2
If f < -2 Then f = -2
mx% = _MouseX: my% = _MouseY
If mx% < 0 Then mx% = 0
If mx% > 800 Then mx% = 800
If my% < 0 Then my% = 0
If my% > 600 Then my% = 600
For t = 1 To qixtot
c(9) = _RGB(q(t).c1, q(t).c2, q(t).c3)
Line (q(t).x1, q(t).y1)-(q(t).x2, q(t).y2), c(9)
Next t
If f > 0 Then
Circle (mx%, my%), f * 10, c(1)
Else
Circle (mx%, my%), f * 10, c(2)
End If
_Display
Loop
Sub mousepointerfollow
If mx% < q(1).xx Then qxv = qxv - f
If mx% > q(1).xx Then qxv = qxv + f
If my% < q(1).yy Then qyv = qyv - f
If my% > q(1).yy Then qyv = qyv + f
End Sub
Is the following sample using the _KeyClear, _Limit, and _keyhit functions correctly? (not worried about the rest at this point). It seems to be ok, but I'm not sure about placement of _limit, and whether it will be called more times than necessary.
_KeyClear
Print "hit a key"
GetAnAction:
_Limit 30 ' limit resource usage
k = _KeyHit ' get code of key press
Locate 12, 40: Print k; Space$(5) ' erase previous key code
If k < 1 Then GoTo GetAnAction ' if there are no keys pressed, have another look - but only do this max 30 times per second
Locate 13, 1: Print Space$(13); ' erase previous key code announcement
Locate 13, 1
Print "ok, saw"; k ' announce key that was recognized
GoTo GetAnAction ' look for another key press
Hello
For some rather complicated mathematical calculations, I use the # tag to increase the precision. As a result of the calculations, errors arise. A professional astronomer suggested that he use more than 32 bits for his calculations. So the question is how to increase the accuracy of the calculations? Is the # sign already the most accurate option ?.
Regards Chris
A useful little tool for anyone who likes to play Scrabble.
Code: (Select All)
file$ = "Collins Scrabble Words (2019) with definitions.txt"
'279498 words
Type Dict_Type
word As String
definition As String
End Type
ReDim As String Word(1000000), Definition(1000000)
Open file$ For Binary As #1
Do Until EOF(1)
Line Input #1, text$
count = count + 1
p = InStr(text$, Chr$(9))
Word(count) = _Trim$(Left$(text$, p - 1))
Definition(count) = _Trim$(Mid$(text$, p + 1))
Loop
ReDim _Preserve Word(count) As String
ReDim _Preserve Definition(count) As String
Do
Color 4
Input "Give me a word to look up for you =>"; word$
If word$ = "" Then System
i = BinaryStringSearch(UCase$(word$), Word())
Color 15
Print
If i > -1 Then
Print word$; " found! It's definition is: "; Definition(i)
Else
Print word$; " doesn't exist! You big dummy! Cheater! Who's gonna play Scrabble with you?!!"
End If
Print
Loop
Function BinaryStringSearch (search$, Array() As String)
'These routines work with actual indexes, so we can search from Array(-10 to 10), if we want to.
'When the search string is found, it'll return a value = to the index proper.
'When it's not found, it'll return a value LESS THAN the LBOUND limit of the array,
'And the point where the string WOULD'VE appeared, if it existed, is after the shared variable LastIndex
BinaryStringSearch = BinaryStringSearchSome(search$, Array(), LBound(Array), UBound(Array))
End Function
Function BinaryStringSearchSome (search$, Array() As String, StartIndex As Long, EndIndex As Long)
'These routines work with actual indexes, so we can search from Array(-10 to 10), if we want to.
'When the search string is found, it'll return a value = to the index proper.
'When it's not found, it'll return a value LESS THAN the LBOUND limit of the array,
'And the point where the string WOULD'VE appeared, if it existed, is after the shared variable LastIndex
min = StartIndex
max = EndIndex
Do
gap = (max + min) \ 2
compare = _StrCmp(search$, Array(gap))
If compare > 0 Then
min = gap + 1
ElseIf compare < 0 Then
max = gap - 1
Else
BinaryStringSearchSome = gap
Exit Function
End If
If max - min < 1 Then
If search$ = Array(min) Then
BinaryStringSearchSome = min
Else
BinaryStringSearchSome = LBound(Array) - 1
If search$ < Array(min) Then
LastIndex = min - 1
Else
LastIndex = min
End If
End If
found = -1
End If
Loop Until found
End Function
Download and extract the word list/dictionary from below to use with this program.
As there's been several people asking about how to display extended characters (such as greek characters) onto the screen, I thought _MAPUNICODE would be a nice word for today.
First: Download the attached unicode font file and extract it into your qb64pe root directory (the same one with the qb64pe executable).
Then copy and paste the code below into qb64pe, and run it:
Code: (Select All)
Screen _NewImage(1280, 720, 32)
f = _LoadFont("DejaVuSansMono.ttf", 24, "monospace")
_Font f
fw = _FontWidth: fh = _FontHeight 'font width, font height
cpl = _Width \ fw: cpp = _Height \ fh 'characters per line, characters per page
For y = 0 To cpp - 1
For x = 0 To cpl - 1
i = i + 1
_PrintString (x * fw, y * fh), Chr$(i)
If i = 255 Then GoTo skip 'show the first 255 that people are used to seeing usually.
Next 'then exit... This is just lazy formatting
Next
skip:
Sleep
'Just to show all the tons of different unicode symbols inside the unicode file...
i = 0
For y = 4 To cpp - 1
For x = 0 To cpl - 1
i = i + 1
_MapUnicode i To 0
_PrintString (x * fw, y * fh), Chr$(0)
If i = 255 Then Sleep 'show the first 255 that people are used to seeing usually.
Next 'then fill the page with extra junk! (I dunno what any of these are supposed to be. :P )
Next
Sleep
'Greek codes are 913 to 969
'note that there is no greek symbol at 930, so that unicode value has been recycled to be something else.
'pay no attention to it, if you don't need it. (And I don't think most people would.)
Cls
i = 912
Print "The Greek character set:"
For y = 1 To cpp - 1
For x = 0 To cpl - 1
i = i + 1
_MapUnicode i To 0
_PrintString (x * fw, y * fh), Chr$(0)
If i = 969 Then GoTo done
Next
Next
done:
'Latin is 256 to 328
i = 255
Locate 5, 1: Print "The Latin character set:"
For y = 5 To cpp - 1
For x = 0 To cpl - 1
i = i + 1
_MapUnicode i To 0
_PrintString (x * fw, y * fh), Chr$(0)
If i = 328 Then GoTo done2
Next
Next
done2:
Sleep
System
Running the above, we start out with a burst of characters across the screen that everyone should be familiar with -- the 255 ASCII characters that we see and use all the time in QB64!
Hit any key, and then you can see what the unicode characters from 1 to 255 look like. A large portion of the first half maps directly over from our current ASCII set to the UNICODE set of characters (everything from 32 to 128), but, as you can see, there's no symbols defined in our font for unicode characters 1 to 31. Those are/were control codes back in the day, and the vast majority of them were non-printing, so many unicode fonts don't have those characters in them. Our ASCII code actually maps unicode symbols from other values, and puts it in those spots, to make the character set that we're used to seeing.
Now from 128 to 255, there's not a single character which matches up between the unicode values and our ASCII values. We tend to, by default, map the character codes from codepage 437 into those spots, so that our codes will match the same ones QB45 and all other basics used to use by default. Now, one problem with this is that we aren't offering a lot of the specialized characters (such as those with various accents and such), as we're offering the old character sets that were used to build boxes and such in old terminal screens.
So, how would one fix that, if they wanted to display other symbols besides the ones we currently offer??
Hit any key in the demo, and you can see that there's a whole bunch of other characters inside the font we loaded! Even though QB64 only makes use of 256 of those characters, that doesn't mean our font doesn't have a whole lot more than 256 that we can choose from! (After all, if we couldn't use other characters, I'd never be able to create the demo that you're now viewing, now would I??)
To pick and choose our display set, we simply make use of the _MAPUNICODE command. To easily get the most out of this command, I recommend the following steps:
1) Go to ✔️ ❤️ ★ Unicode Character Table (unicode-table.com) -- There's a ton of unicode symbols available out there. Find which code corresponds to the character you want.
2) Find a current ASCII character that you're not using. For my demo, I chose CHR$(0) for all my needs -- you can choose any of the 0 to 255 characters to replace that you want.
3) _MAPUNICDE unicode_number TO ascii_number
It's that simple!!
Now, whenever you need to display that character upon the screen, you can call upon it as needed.
PRINT "Hello World " + CHR$(150) '150 for whatever symbol/character you decided to map to 150.
Note that not every unicode font has every unicode character in it. When you run my demo, you'll see several square boxes -- that's default for "Nope! No symbol here!" If the font you have doesn't support the language/symbols you need, then you'll just have to swap to a different font. After all, you can't print characters that don't exist in your font set!
Posted by: PhilOfPerth - 11-22-2022, 03:03 AM - Forum: Programs
- No Replies
This is an updated version of my Wordfind programme. It now finds and displays all words that can be derived from a given word, using each letter only once, up to 30 characters in length.
Color 14: Locate 6, 35: Print "Word-Find": Color 15
Print Tab(30); "By Phil Taylor (2022)": Print
Print Tab(5); "This programme will find all English words up to 13 letters in length"
Print Tab(5); "that appear in the Collins (2019) dictionary, that can be formed from "
Print Tab(5); "the letters of a word or group of letters, with each letter only being"
Print Tab(5); "used once."
Print: Print Tab(10); "(You can specify minimum and maximum word-lengths to find)."
Print
Color 14: Print Tab(15);: Input "Minimum size of words (ENTER for default of 2)"; min$
If Val(min$) < 2 Then min = 2 Else min = Val(min$)
Color 15: Print Tab(30); "Minimum set at "; min: Color 14
Print
Print Tab(15);: Input "Maximum size of words (ENTER for default of 30)"; max$
If Val(max$) < 2 Then max = 30 Else max = Val(max$)
Color 15: Print Tab(30); "Maximum set at"; max
Print: Color 14: Print Tab(30); "Press a key to start": Color 15
While InKey$ <> "": Wend
While InKey$ = "": Wend
Start:
Cls
While InKey$ <> "": Wend
Locate 10, 20: Color 14: Input "What is the Base-Word (or group)"; base$: Color 15
If base$ < "A" Then base$ = "ANYTHING" ' just a word for demo purposes
base$ = UCase$(base$)
origbase$ = base$
Color 14: Print Tab(9); "Base word:"; origbase$; " Minimum length:"; min; " Maximum length:"; max: Color 15
sort:
swapped = 0
For a = 1 To Len(base$) - 1
If Mid$(base$, a, 1) > Mid$(base$, a + 1, 1) Then
t1$ = Mid$(base$, a, 1): t2$ = Mid$(base$, a + 1, 1)
Mid$(base$, a, 1) = t2$: Mid$(base$, a + 1) = t1$
swapped = 1
End If
Next
If swapped = 1 Then GoTo sort
Print a$
l = Len(base$)
found = 0: totfound = 0
sorted$ = Left$(base$, 1)
Cls
FindUnique
For bletrnum = 1 To l ' for each letter in base$
fileletr$ = Mid$(base$, bletrnum, 1)
po = InStr(unique$, fileletr$)
If po = 0 Then GoTo skip
Mid$(unique$, po, 1) = " "
dictfile$ = "wordlists/" + fileletr$
Close
Open dictfile$ For Input As #1
GetAWord:
While Not EOF(1)
Input #1, dictwrd$
l = Len(dictwrd$): If l < min Or l > max Then GoTo GetAWord
WORDCHECK
Wend
skip:
Next
Print: Color 14: Print Tab(35); "Finished!"
Print Tab(29); "Total words found:"; totfound
Sleep
GoTo Start
Sub WORDCHECK
fail = 0
dummy$ = base$
For a = 1 To l
dictletr$ = Mid$(dictwrd$, a, 1)
po = InStr(dummy$, dictletr$)
If po = 0 Then
fail = 1 ' letter is not in dummy$ so abandon word
Else
Mid$(dummy$, po, 1) = " "
End If
Next
If fail = 1 Then Exit Sub
found = found + 1: totfound = totfound + 1
Print dictwrd$; Space$(1);
If Pos(0) > 70 Then Print
If found = 220 Then
While InKey$ <> "": Wend
Color 14
Print: Print Tab(27); "Press a key for next group"
While InKey$ = "": Wend
found = 0
Cls
Color 14: Print Tab(9); "Base word:"; origbase$; " Minimum length:"; min; " Maximum length:"; max: Color 15
Color 15
End If
End Sub
Sub FindUnique
unique$ = ""
For a = 1 To l
l$ = Mid$(base$, a, 1)
po = InStr(unique$, l$)
If po = 0 Then unique$ = unique$ + l$
Next
End Sub
