| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 731
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 24
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 24
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 1,848
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,138
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 301
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 112
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,306
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 223
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 133
|
|
|
| Lost in Jungle |
|
Posted by: bplus - 08-16-2023, 08:50 PM - Forum: Programs
- Replies (8)
|
 |
This was ported by me to QB64 from felixp7 port to FB from somewhere else:
@johnno56 you might like this.
Code: (Select All) Option _Explicit
' Lost in the Jungle: a silly little survival game.
' 2023-08-10 Felix PleÅŸoianu <https://felix.plesoianu.ro/>
' Use as you like, and enjoy!
' port to QB64pe b+ 2023-08-14
_Title "Lost in Jungle - port felixp7 port to FB to QB64pe"
Randomize Timer
Dim Shared nl$: nl$ = Chr$(10)
Dim Shared fatigue: fatigue = 0.0
Dim Shared health: health = 5.0
Dim Shared bullets: bullets = 6
Dim Shared skill: skill = 0.15
Dim Shared distance: distance = 50.0
Dim Shared hours: hours = 0
Dim Shared chances(0 To 7)
Print "You survived the plane crash."
Print
Print "With all your gear intact, too:"
Print
Print "Gun, knife, compass, lighter."
Print
Print "But you have no food or water."
Print
Print "And a big bad jungle to cross."
Dim GameMenu$(1 To 3)
GameMenu$(1) = "Play"
GameMenu$(2) = "Help"
GameMenu$(3) = "Quit"
again:
Select Case menu&(GameMenu$())
Case 1: startGame: playGame
Case 2: Print: help: GoTo again
Case 3: Print: Print "See you around!"
End Select
Print: Print "(press any key)"
Sleep
Sub startGame
fatigue = 0.0
health = 5.0
bullets = 6
skill = 0.15
distance = 45 + Int(Rnd * 11)
hours = 0
Dim i
For i = 0 To 7
chances(i) = 0.0
Next
End Sub
Function tiredness$ (fatigue, health)
Dim energy
energy = health - fatigue
If energy <= 1 Then
tiredness$ = "drained"
ElseIf energy <= 3 Then
tiredness$ = "tired"
Else
tiredness$ = "fresh"
End If
End Function
Function healthLevel$ (health)
If health < 2 Then
healthLevel$ = "bad"
ElseIf health < 4 Then
healthLevel$ = "decent"
Else
healthLevel$ = "good"
End If
End Function
Sub setStatus (status1 As String, status2 As String)
Cls
status1 = "In " + healthLevel$(health) + " health; " + tiredness$(fatigue, health) + nl$ + _
" Bullets:" + Str$(bullets) + nl$ + " Time:" + Str$(hours) + " hrs." + nl$
If distance >= 35 Then
status2 = " Can't see the sky for the forest canopy."
ElseIf distance >= 15 Then
status2 = " Shafts of sunlight mark the path ahead."
Else
status2 = " The trees are growing farther apart now."
End If
End Sub
Function menu& (options() As String)
Print
Dim i
For i = LBound(options) To UBound(options)
Print i; ") "; options(i)
Next
Print
Dim result As Long
Do
Input ; result
Loop Until result >= LBound(options) And result <= UBound(options)
Print
menu& = result
End Function
Sub noEncounter
Print " Around you, the jungle looms."
Dim QuietMenu$(1 To 2)
QuietMenu$(1) = "March on"
QuietMenu$(2) = "Get some rest"
Select Case menu&(QuietMenu$())
Case 1: doWalk
Case 2: doRest
End Select
End Sub
Sub doWalk
If fatigue >= health Then
Print "You can't take another step."
doRest
Else
Dim walked
walked = health - fatigue
distance = distance - walked
fatigue = fatigue - 1
hours = hours + 1
If walked <= 1 Then
Print "You crawl along tiredly."
ElseIf walked <= 3 Then
Print "You march on, making steady progress."
Else
Print "You advance quickly for now..."
End If
End If
End Sub
Sub doRest
hours = hours + 1
If health < 5 Then
health = health + 0.5
If health > 5 Then health = 5
If fatigue >= health Then
fatigue = fatigue - 1
Else
fatigue = fatigue - 0.5
End If
If fatigue < 0 Then fatigue = 0
Print "You rest and heal a little."
Else
If fatigue >= health Then
fatigue = fatigue - 2
Else
fatigue = fatigue - 1
End If
If fatigue < 0 Then fatigue = 0
Print "You get some good rest."
End If
Select Case Rnd
Case Is < 0.15
Print "But while you were sleeping..." ' what is !"But
fightMonkeys
Case Is < 0.3
Print "But while you were sleeping..." ' what is !"But
itsVenomous
End Select
End Sub
Sub findWater
Print "You find a pool of water."
Dim water_menu(1 To 2) As String
water_menu(1) = "Drink some"
water_menu(2) = "Leave it"
Select Case menu&(water_menu())
Case 1: drinkWater
Case 2: noDrinking
End Select
End Sub
Sub drinkWater
fatigue = fatigue - 2
If fatigue < 0 Then fatigue = 0
Print "The water is cool. You feel refreshed."
If Rnd >= skill Then
Print "But drinking from the pool soon makes you ill."
Print "At least you learn the signs better."
health = health - 1
skill = skill + 0.05
End If
End Sub
Sub noDrinking
Print "Better not chance taking a drink at this time."
End Sub
Sub findFruit
Print "You find strange fruit."
Dim fruit_menu(1 To 2) As String
fruit_menu(1) = "Eat some"
fruit_menu(2) = "Leave it"
Select Case menu&(fruit_menu())
Case 1: eatFruit
Case 2: noEating
End Select
End Sub
Sub eatFruit
health = health + 1
If health > 5 Then health = 5
Print "The fruit is tasty. You recover some strength."
If Rnd >= skill Then
Print "But soon after eating it you feel drowsy."
Print "At least you learn the signs better."
fatigue = fatigue + 2
skill = skill + 0.05
End If
End Sub
Sub noEating
Print "Better not chance taking a bite at this time."
End Sub
Sub huntGame
Dim critter(0 To 2) As String
critter(0) = "A small herbivore"
critter(1) = "Some large rodent"
critter(2) = "A flightless bird"
Dim action(0 To 1) As String
action(0) = " hears your steps and bolts."
action(1) = " stumbles out of the bushes."
Dim hunt_menu(1 To 3) As String
hunt_menu(1) = "Shoot it"
hunt_menu(2) = "Run after it"
hunt_menu(3) = "Just move on"
Print critter(Int(Rnd * 3)); action(Int(Rnd * 2))
Select Case menu&(hunt_menu())
Case 1: shootGame
Case 2: chaseGame
Case 3: ignoreGame
End Select
End Sub
Sub shootGame
If bullets < 1 Then
Print "Click! Click! No more bullets..."
Print "The lucky creature soon vanishes."
Else
bullets = bullets - 1
Print "You carefully take aim and... BANG!"
eatGame
End If
End Sub
Sub chaseGame
If fatigue >= health Then
Print "You're too tired to give chase."
ElseIf Rnd < skill Then
fatigue = fatigue + 1
Print "You hunt it down and catch it."
eatGame
Else
fatigue = fatigue + 1
skill = skill + 0.05
Print "You chase after it, but it's too fast."
Print "At least you learn new tricks."
End If
End Sub
Sub eatGame
hours = hours + 1
health = health + 2
If health > 5 Then health = 5
Print "Poor critter is tasty roasted on a tiny fire."
Print "You recover much of your strength."
End Sub
Sub ignoreGame
Print "You decide against playing hunter right now."
End Sub
Sub fightMonkeys
Print "Screaming monkeys come out of nowhere to harass you!"
Dim monkey_menu(1 To 3) As String
monkey_menu(1) = "Shoot at them"
monkey_menu(2) = "Look scary"
monkey_menu(3) = "Run away"
Select Case menu&(monkey_menu())
Case 1: shootMonkeys
Case 2: scareMonkeys
Case 3: runAway
End Select
End Sub
Sub shootMonkeys
If bullets < 1 Then
Print "Click! Click! No more bullets..."
getMauled
Else
bullets = bullets - 1
Print "BANG! Your bullet goes crashing through the foliage."
Print "The monkeys scatter, shrieking even more loudly."
End If
End Sub
Sub scareMonkeys
Print "You shout and wave a branch, trying to look bigger."
If Rnd < skill Then
Print "The monkeys laugh mockingly at you as they scatter."
Else
skill = skill + 0.05
Print "It doesn't seem to be working very well at all."
getMauled
End If
End Sub
Sub getMauled
health = health - 2
Print "A rain of kicks and bites descends upon you!"
Print "At long last, the monkeys scatter, shrieking."
End Sub
Sub runAway
hours = hours + 1
fatigue = fatigue + 1 ' Should be less bad than what we're risking.
Print "You run away blindly, until your lungs burn."
Print "The chorus of shrieks slowly remains behind."
End Sub
Sub itsVenomous
Dim crawlie(0 To 2) As String
crawlie(0) = "giant centipede"
crawlie(1) = "big hairy spider"
crawlie(2) = "colorful snake"
Print "A "; crawlie(Int(Rnd * 3)); " falls on you from above!"
Dim crawlie_menu(1 To 2) As String
crawlie_menu(1) = "Remove it carefully"
crawlie_menu(2) = "Stand still"
Select Case menu&(crawlie_menu())
Case 1: removeCrawlie
Case 2: waitOutCrawlie
End Select
End Sub
Sub removeCrawlie
If Rnd < skill Then
Print "The crawlie wriggles wetly in your grasp. Yuck!"
Else
skill = skill + 0.05
health = health - 1.5
Print "You carefully try to pick up the crawlie, but... OW!"
Print "It bites! You're poisoned. Burns pretty badly, too."
End If
Print "At least it's gone now. Hopefully."
End Sub
Sub waitOutCrawlie
hours = hours + 1
fatigue = fatigue + 1 ' Should be less bad than what we're risking.
Print "You wait tensely for what seems like hours."
Print "In the end, it's gone, and you're sweating."
End Sub
Sub findRuins
Print "You discover ancient ruins..."
Dim ruins_menu(1 To 3) As String
ruins_menu(1) = "Rest here"
ruins_menu(2) = "Search the place"
ruins_menu(3) = "Just move on"
Select Case menu&(ruins_menu())
Case 1: restAtRuins
Case 2: searchRuins
Case 3: leaveRuins
End Select
End Sub
Sub restAtRuins
fatigue = fatigue - 1
If fatigue < 0 Then fatigue = 0
health = health + 1
If health > 5 Then health = 5
hours = hours + 2
Print "You sleep undisturbed for once, before moving on."
End Sub
Sub searchRuins
hours = hours + 1
Select Case Rnd
Case Is < 0.3
skill = skill + 0.05
Print "You find old inscriptions teaching about the jungle."
Case Is < 0.6
Print "You find gold and diamonds. Not much use right now."
Case Else
Print "You find nothing of interest this time around."
End Select
End Sub
Sub leaveRuins
hours = hours + 1
fatigue = fatigue + 1
distance = distance - 3 ' Not too much, because it's for free.
Print "You march on, emboldened, covering a good distance."
End Sub
Sub reachSwamp
Print "A vast swamp bars your way."
Dim swamp_menu(1 To 2) As String
swamp_menu(1) = "Risk a crossing"
swamp_menu(2) = "Go around it"
Select Case menu&(swamp_menu())
Case 1: crossSwamp
Case 2: avoidSwamp
End Select
End Sub
Sub crossSwamp
If Rnd < skill Then
Print "Somehow you navigate the maze more or less safely."
Else
' Probably too harsh since you get tired either way.
' fatigue++;
health = health - 1
skill = skill + 0.05
Print "Mud pulls at your feet, and you nearly drown once."
Print "Mosquitos besiege you; their bites make you ill."
End If
hours = hours + 1
fatigue = fatigue + 1
distance = distance - 5
Print "It's a scary shortcut to take, but it saves a lot of travel."
End Sub
Sub avoidSwamp
fatigue = fatigue + 1.5 ' Should be bad, but not too bad.
hours = hours + 2
Print "A long, tiresome detour. Safe, but no closer to your goal."
End Sub
Sub triggerPlant
Print "Creeping vines entangle your limbs and drag you down."
Print "Oh no! It's a man-eating mandragore, and it's hungry!"
Dim plant_menu(1 To 3) As String
plant_menu(1) = "Shoot it"
plant_menu(2) = "Wrestle free"
plant_menu(3) = "Cut the vines"
Select Case menu&(plant_menu())
Case 1: shootPlant
Case 2: wrestlePlant
Case 3: cutPlant
End Select
End Sub
Sub shootPlant
If bullets < 1 Then
Print "Click! Click! No more bullets..."
getChewedOn
Else
bullets = bullets - 1
Print "BANG! You hit the plant's smelly flower dead center."
Print "It wilts away with a horrible squelching sound."
End If
End Sub
Sub wrestlePlant
Dim energy
energy = (health - fatigue) * 2 / 10
If Rnd < energy Then
Print "You vigorously pull at the vines, breaking a few."
Print "The plant soon decides to wait for easier prey."
Else
Print "You pull tiredly at the vines. It's not enough."
getChewedOn
End If
fatigue = fatigue + 1
End Sub
Sub cutPlant
fatigue = fatigue + 1
If Rnd < skill Then
Print "You expertly hack at the vines with your knife."
Print "The plant soon decides to wait for easier prey."
Else
skill = skill + 0.05
Print "You clumsily hack at the vines with your knife."
getChewedOn
End If
End Sub
Sub getChewedOn
health = health - 1
Print "The plants chews on you with its toothless maw,";
Print " burning you with digestive juices before you escape."
End Sub
'dim shared encounters(0 to 7) as sub = { _
' @findWater, @findFruit, @huntGame, @fightMonkeys, _
' @itsVenomous, @findRuins, @reachSwamp, @triggerPlant}
Sub pickEncounter
Dim i
For i = 0 To 7
If Rnd < chances(i) Then
chances(i) = chances(i) / 5
Select Case i
Case 0: findWater
Case 1: findFruit
Case 2: huntGame
Case 3: fightMonkeys
Case 4: itsVenomous
Case 5: findRuins
Case 6: reachSwamp
Case 7: triggerPlant
End Select
'return encounters(i)
Else
chances(i) = chances(i) + 0.05
End If
Next
noEncounter
End Sub
Sub playGame
While health > 0 And distance > 0
Dim status1 As String, status2 As String
setStatus status1, status2
Print status1; status2;
pickEncounter
'encounter()
Wend
If health <= 0 Then
Print "You died in the jungle, after ";
Print hours; " hours of struggle."
Print "No more than "; distance; "km away from safety."
If bullets = 6 Then
Print "Without as much as firing a single bullet."
End If
Print "Oh well, better luck next time."
ElseIf distance <= 0 Then
Print "At last, the trees open up. You see a village. Saved!"
Print "Unless it's a hostile tribe? Just kidding. You win!"
Print "(In "; hours; " hours, with ";
Print bullets; " bullets left.)"
Else
Print "Game ended abnormally."
End If
End Sub
Sub help
Print "The goal is to cross the 50Km or so separating you from safety."
Print "The exact distance varies every time you play."
Print
Print "Advance in the game by marching on whenever you get the chance."
Print "But you have to balance your health and fatigue."
Print
Print "The worse your health, the easier you get tired."
Print "It's not possible to die from exhaustion."
Print
Print "But being tired all the time will hold you up,"
Print "allowing more dangers to catch up with you and sap your health."
Print
Print "Hope this helps. Enjoy!"
End Sub
My best game least hours and bullets used was 7 hours and 5 bullets left (I used only 1 on the hungry man eating plant.)
|
|
|
| QUEST-A |
|
Posted by: James D Jarvis - 08-16-2023, 06:42 PM - Forum: Programs
- Replies (7)
|
 |
I literally stumbled across this clicking links a half hour ago. It was originally written for use on the SpectraVideo CompuMate, A system that had maybe 2K of RAM. Other than editing the command words I have done no editing of note. I did add the comments. Apparently if the original code was 1 or 2 lines larger it would have been too large for the original editor. This is just a little programming archeology.
Code: (Select All) 'QUEST-A
'BASIC PROGRAMME FOR THE SPECTRAVIDEO CompuMate
'AUTHOR: Graham.J.Percy
'25th September, 1998.
'edited to work in QB but otherwise unchanged
1 Q$ = "+---------+"
2 Print Q$, " QUEST-A", Q$, " BY"
3 Print "GRAHAM PERCY", "1=PLAY"
4 Input C
5 R$ = "[ ]"
6 S$ = "+--- ---+"
7 T$ = " ]"
9 V$ = "+---+-+---+"
10 W$ = "[ O++ ]"
11 Y$ = "1=DOWN 2=RIGHT"
12 Print S$, R$, R$, T$, R$, Q$
13 Print "A BIG ROOM", "1=LEFT 2=UP"
14 Input "ACTION=", B
15 If B = 1 Then GoTo 32
16 If B <> 2 Then GoTo 14
18 If K <> 1 Then Print Q$, W$
20 If K = 1 Then Print Q$, R$
21 Print T$, R$, S$, "LONG HALL"
23 Print "1=LEFT 2=DOWN"
24 If K <> 1 Then Print "3=GET KEY"
25 Input "ACTION=", B
26 If B = 2 Then GoTo 12
27 If B = 1 Then GoTo 48
28 If B <> 3 Then GoTo 25
29 If K = 0 Then Print "YOU GOT KEY"
30 Let K = 1
31 GoTo 18
32 Print S$, R$, "[", Q$, "A DARK HALL"
33 If P = 1 Then GoTo 38
34 G = Int(1 + Rnd * 2): F = Int(1 + Rnd * 3)
35 If G <> 2 Then GoTo 38
36 Print "OGRE HERE", "1=UP 2=RIGHT", "3=FIGHT"
37 GoTo 39
38 Print "1=UP 2=RIGHT"
39 Input "ACTION=", B
40 If B = 3 And G = 2 And F = 3 Then GoTo 96
41 If B = 2 Then GoTo 12
42 If B = 1 Then GoTo 48
43 If B <> 3 Then GoTo 39
44 Print "GOT THE OGREGOT ARMOUR"
45 Let P = 1
46 GoTo 32
48 If D = 1 Then If E = 3 Then GoTo 70
49 If D = 0 Then If E = 3 Then GoTo 77
50 Print V$, R$, "[", R$, S$
51 Print "TROLL, DOOR", Y$, "3=OPEN 4=FIGHT"
52 Input "ACTION=", B
53 If B = 1 Then GoTo 32
54 If B = 2 Then GoTo 18
55 If B = 3 Then If K = 1 Then GoTo 60
56 If B = 3 Then Print "NEED A KEY"
57 If B = 4 Then GoSub 88
59 GoTo 48
60 Print "TROL SAY NO"
61 GoTo 48
70 Print S$, R$, "[", R$, S$, "OPEN DOOR", Y$, "3=UP"
71 Input "ACTION=", B
72 If B = 1 Then GoTo 32
73 If B = 2 Then GoTo 18
74 If B <> 3 Then GoTo 71
75 Print "* * *", " *", "", R$, R$, S$, "YOU,RE FREE"
76 GoTo 97
77 Print V$, R$, "[", R$, S$, "A DOOR", Y$, "3=OPEN DOOR"
79 Input "ACTION=", B
80 If B = 1 Then GoTo 32
81 If B = 2 Then GoTo 18
82 If B = 3 Then If K = 1 Then GoTo 85
83 If B = 3 Then Print "NEED A KEY"
84 GoTo 79
85 Print "YOU OPEN IT"
86 Let D = 1
87 GoTo 70
88 If P = 0 Then Let F = Int(Rnd * 1): E = E + 1
89 If P = 1 Then Let F = Int(Rnd * 14): E = E + 1
90 Print "YOU ATTACK,"
91 If F = 0 Then GoTo 96
92 If E = 3 Then Print "GOT HIM"
93 Return
96 Print "HE GOT YOU"
97 Print "BYE"
|
|
|
|
| Declaring Functions AS TYPEs |
|
Posted by: TerryRitchie - 08-16-2023, 02:26 AM - Forum: General Discussion
- Replies (14)
|
 |
So many times I have wished for this:
TYPE TYPE_VECTOR
x AS SINGLE
y AS SINGLE
END TYPE
FUNCTION AddVector(v1 AS TYPE_VECTOR, v2 AS TYPE_VECTOR) AS TYPE_VECTOR
AddVector.x = v1.x + v2.x
AddVector.y = v1.y + v2.y
END FUNCTION
Or even this would be awesome
DIM v1 AS TYPE_VECTOR
DIM v2 AS TYPE_VECTOR
DIM v3 AS TYPE_VECTOR
v1.x = 10: v1.y = 20
v2.x = 15: v2.y = 15
v3 = v1 + v2
( v3.x now = 25, v3.y now = 35 )
I realize neither of these concepts are in the spirit of QB64, but just imagine.
|
|
|
|
| Detect when mouse leaves program window |
|
Posted by: TerryRitchie - 08-16-2023, 01:11 AM - Forum: Help Me!
- Replies (20)
|
|
I could have swore there was a discussion about this before, either on this forum or previous forums, but my searches have come up empty.
How can I detect when the mouse pointer has left the program window?
I seem to remember someone showing how to use an API call ( @SpriggsySpriggs ?) but I didn't have the foresight to add it to my tool box of goodies.
Any suggestions?
|
|
|
|
| Memory Use Guidelines |
|
Posted by: NakedApe - 08-15-2023, 09:22 PM - Forum: Help Me!
- Replies (5)
|
|
I'm wondering if there are any practical limits to how many sounds, fonts, images and arrays I can have open in a QB64 program before it starts to bog down. I'm working on a space game on a Mac, and the Activity Monitor tells me I'm using about 150 MB of memory, and with the program running I'm using from 36% to 98% of the CPU. It runs fine right now, just wondering if I need to be very careful with the resources. Thanks.
|
|
|
|
| QBJS Swimming fish with Kelp |
|
Posted by: bplus - 08-15-2023, 02:37 AM - Forum: QBJS, BAM, and Other BASICs
- Replies (20)
|
|
@dbox once again I am stumped trying to get this going on QBJS
Code: (Select All) 'Option _Explicit
'_Title " Fish: press m for more, l for less" 'b+ 2021-12-03
'
Dim Shared sw, sh, LHead$, LBody$, LTail$, RHead$, RBody$, RTail$
sw = 1024: sh = 700
LHead$ = "<*": LBody$ = ")": LTail$ = ">{"
RHead$ = "*>": RBody$ = "(": RTail$ = "}<"
Type fish
As Integer LFish, X, Y, DX
As String fish
As _Unsigned Long Colr
End Type
Screen _NewImage(sw, sh, 32)
Color _RGB32(220), _RGB32(0, 0, 60)
Cls
'_PrintMode _KeepBackground
Dim As Integer i, nFish
Dim k$
nFish = 40
'restart:
ReDim Shared school(1 To nFish) As fish, kelp(sw, sh) As _Unsigned Long
growKelp
For i = 1 To nFish
NewFish i, -1
Next
Do
Cls
k$ = InKey$
'If k$ = "m" Then ' more fish
' nFish = nFish * 2
' If nFish > 300 Then Beep: nFish = 300
' 'GoTo restart
'End If
'If k$ = "l" Then ' less fish
' nFish = nFish / 2
' If nFish < 4 Then Beep: nFish = 4
' 'GoTo restart
'End If
For i = 1 To nFish ' draw fish behind kelp
If _Red32(school(i).Colr) < 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
showKelp
For i = 1 To nFish ' draw fish in from of kelp
If _Red32(school(i).Colr) >= 160 Then
Color school(i).Colr
_PrintString (school(i).X, school(i).Y), school(i).fish 'draw fish
school(i).X = school(i).X + school(i).DX
If school(i).LFish Then
If school(i).X + Len(school(i).fish) * 8 < 0 Then NewFish i, 0
Else
If school(i).X - Len(school(i).fish) * 8 > _Width Then NewFish i, 0
End If
End If
Next
_Display
_Limit 10
Loop Until _KeyDown(27)
Sub NewFish (i, initTF)
Dim gray
gray = Rnd * 200 + 55
school(i).Colr = _RGB32(gray) ' color
If Rnd > .5 Then
school(i).LFish = -1
school(i).fish = LHead$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, LBody$) + LTail$
Else
school(i).LFish = 0
school(i).fish = RTail$ + String$(Int(Rnd * 5) + -2 * (gray > 160) + 1, RBody$) + RHead$
End If
If initTF Then
school(i).X = _Width * Rnd
Else
If school(i).LFish Then school(i).X = _Width + Rnd * 35 Else school(i).X = -35 * Rnd - Len(school(i).fish) * 8
End If
If gray > 160 Then
If school(i).LFish Then school(i).DX = -18 * Rnd - 3 Else school(i).DX = 18 * Rnd + 3
Else
If school(i).LFish Then school(i).DX = -6 * Rnd - 1 Else school(i).DX = 6 * Rnd + 1
End If
school(i).Y = _Height * Rnd
End Sub
Sub growKelp
Dim kelps, x, y, r
ReDim kelp(sw, sh) As _Unsigned Long
kelps = Int(Rnd * 20) + 20
For x = 1 To kelps
kelp(Int(Rnd * sw / 8), (sh - 16) / 16) = _RGB32(0, Rnd * 128, 0)
Next
For y = sh / 16 To 0 Step -1
For x = 0 To sw / 8
If kelp(x, y + 1) Then
r = Int(Rnd * 23) + 1
Select Case r
Case 1, 2, 3, 18 '1 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
Case 4, 5, 6, 7, 8, 9, 21 '1 branch node
kelp(x, y) = kelp(x, y + 1)
Case 10, 11, 12, 20 '1 branch node
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
Case 13, 14, 15, 16, 17, 19 '2 branch node
If x - 1 >= 0 Then kelp(x - 1, y) = kelp(x, y + 1)
If x + 1 <= sw Then kelp(x + 1, y) = kelp(x, y + 1)
End Select
End If
Next
Next
End Sub
Sub showKelp
Dim y, x
For y = 0 To sh / 16
For x = 0 To sw / 8
If kelp(x, y) Then
Color kelp(x, y)
_PrintString (x * 8, y * 16), Mid$("kelp", Int(Rnd * 4) + 1, 1)
End If
Next
Next
End Sub
|
|
|
|
_FULLSCREEN behaves weird in some Linux OS installations... |
|
Posted by: mnrvovrfc - 08-15-2023, 12:09 AM - Forum: General Discussion
- No Replies
|
 |
... and combinations of budget computers. This was on Spiral Linux purposely upgraded to "Bookworm". In other words, this was a Debian clone which had v11 "Bullseye" base, and I upgraded it to v12 "Bookworm" base which has been on since mid-June.
This was tried with bplus' program with the fish. See screenshot below.
This is from a 1-1/2-year-old "ewaste" candidate:
Code: (Select All) [~]$ inxi -SCMm -x -I
System:
Host: xxxxxxxx Kernel: 6.1.0-10-amd64 arch: x86_64 bits: 64 compiler: gcc
v: 12.2.0 Desktop: Xfce v: 4.18.1 Distro: Debian GNU/Linux 12 (bookworm)
Machine:
Type: Laptop System: ASUSTeK product: VivoBook_ASUSLaptop E410MAB_E410MA
v: 1.0 serial: <superuser required>
Mobo: ASUSTeK model: E410MAB v: 1.0 serial: <superuser required>
UEFI: American Megatrends v: E410MAB.300 date: 07/23/2021
Memory:
RAM: total: 3.65 GiB used: 961.4 MiB (25.7%)
RAM Report: permissions: Unable to run dmidecode. Root privileges
required.
CPU:
Info: dual core model: Intel Celeron N4020 bits: 64 type: MCP
arch: Goldmont Plus rev: 8 cache: L1: 112 KiB L2: 4 MiB
Speed (MHz): avg: 814 high: 833 min/max: 800/2800 cores: 1: 796 2: 833
bogomips: 4377
Flags: ht lm nx pae sse sse2 sse3 sse4_1 sse4_2 ssse3 vmx
Info:
Processes: 166 Uptime: 28m Init: systemd target: graphical (5) Compilers:
gcc: 12.2.0 Packages: 1834 Shell: Bash v: 5.2.15 inxi: 3.3.26
"ewaste" means do not buy from ASUS, or at least do not buy this particular model because it has a poor battery. This could be the last time I could use this computer, for its possible refusal to deal with the battery if it can't charge it. I had another laptop with SSD crap out on me in this manner but I could still use it without the battery. I cannot use this ASUS computer without the battery because... I have to remove the screws on the bottom of the bulk side of the unit to get to it. :O
![[Image: bplus-fish-n-kelp-bad-fullscreen.png]](https://i.ibb.co/GRfZ7z4/bplus-fish-n-kelp-bad-fullscreen.png)
|
|
|
|
| DIM AT -- feature request |
|
Posted by: Jack - 08-14-2023, 03:49 PM - Forum: General Discussion
- Replies (2)
|
 |
PowerBasic has a very handy feature, the ability to dim at a certain address, for example suppose that you want to use a fixed-length string as a memory buffer
DIM buff As String * 256
DIM m(31) AS _Unsigned Long AT VARPTR(buff)
then you could access the array as usual but the values of the array m would be stored in the string buff
since QB64pe lacks arrays in Type, you could almost have that flexibility if you had Dim At
|
|
|
|
| Mouse Routines to Use and Hack |
|
Posted by: TerryRitchie - 08-13-2023, 08:21 PM - Forum: Works in Progress
- Replies (3)
|
|
In another post I created some quick and dirty mouse code that set up mouse zones. I started playing around with the code some more last night and ended up writing the start of a library.
I wanted to see how efficiently I could incorporate detecting clicks, double clicks, and mouse tracking along with the mouse zone functions. Below is what I ended up with.
The two subroutines that drive the new functionality are UpdateMouse and CheckMouseButton. I coded them to have the double clicks timed in such a way as to be independent of the frames per second any loop is running at.
The code also includes the 15 system default mouse pointer icons to choose from.
There is complete documentation located at the bottom of the source code detailing how to use it. There is also an example code section highlighting most of the functions and subroutines in use.
I figured someone could use this code as a basis for a GUI or mouse driven game project. As always it's free to use as you wish and hack away at.
Code: (Select All) '+--------------------------------------------------------------+
'| Ritchie's mouse routines |
'| 08/13/23 |
'| Written in QB64 Phoenix Edition v3.8.0 |
'| Should function correctly in any version of QB64 however. |
'| |
'| Just playing around one day and came up with these routines. |
'| Use them as a basis for your project, such as a GUI or a |
'| mouse driven game. |
'| Hack and use these routines as you wish. |
'| |
'| Code includes a simple program section showing use. |
'| |
'| Scroll to the bottom of the code for documentation. |
'+--------------------------------------------------------------+
OPTION _EXPLICIT ' declare those variables son!
CONST FALSE = 0, TRUE = NOT FALSE ' truth detectors
CONST NORMALSELECT = 0 ' mouse pointer names and their associated value
CONST HELPSELECT = 1
CONST WORKINGINBACKGROUND = 2
CONST BUSY = 3
CONST PRECISIONSELECT = 4
CONST TEXTSELECT = 5
CONST HANDWRITING = 6
CONST UNAVAILABLE = 7
CONST VERTICALRESIZE = 8
CONST HORIZONTALRESIZE = 9
CONST DIAGONALRESIZE1 = 10
CONST DIAGONALRESIZE2 = 11
CONST MOVE = 12
CONST ALTERNATESELECT = 13
CONST LINKSELECT = 14
TYPE TYPE_VECTOR ' VECTOR PROPERTIES
x AS SINGLE ' x coordinate
y AS SINGLE ' y coordinate
END TYPE
TYPE TYPE_AREA ' AREA PROPERTIES
Min AS TYPE_VECTOR ' upper left coordinate
Max AS TYPE_VECTOR ' lower right coordinate
END TYPE
TYPE TYPE_ZONE ' ZONE PROPERTIES
Area AS TYPE_AREA ' zone area
Active AS INTEGER ' zone is available to mouse (t/f)
END TYPE
TYPE TYPE_POINTER ' MOUSE POINTER PROPERTIES
Value AS INTEGER ' pointer number
Image AS LONG ' pointer image
Offset AS TYPE_VECTOR ' pointer image offset from mousex, mousey
END TYPE
TYPE TYPE_MOUSEBUTTON ' MOUSE BUTTON PROPERTIES
Button AS INTEGER ' _MOUSEBUTTON(1-3)
Held AS INTEGER ' button held down (t/f)
DCTime AS DOUBLE ' double click time interval
DCTimer AS DOUBLE ' time between 2 subsequent clicks
Clicked AS INTEGER ' button clicked (t/f)
DoubleClicked AS INTEGER ' button double clicked (t/f)
END TYPE
TYPE TYPE_MOUSE ' MOUSE PROPERTIES
Location AS TYPE_VECTOR ' current mouse location
Previous AS TYPE_VECTOR ' previous mouse location
Right AS TYPE_MOUSEBUTTON ' right mouse button properties
Left AS TYPE_MOUSEBUTTON ' left mouse button properties
Middle AS TYPE_MOUSEBUTTON ' middle mouse button properties
Vector AS TYPE_VECTOR ' vector from previous location to current
Normal AS TYPE_VECTOR ' normalized vector from previous location to current
Degree AS SINGLE ' angle from previous location to current
Speed AS SINGLE ' speed of mouse from previous location to current
Wheel AS INTEGER ' wheel turns counted
Pointer AS TYPE_POINTER ' mouse pointer properties
ZoneTrap AS INTEGER ' zone area mouse trapped in (0 for none)
Hovering AS INTEGER ' zone area mouse is hovering (0 for none)
Area AS TYPE_AREA ' area mouse is trapped within (if ZoneTrap > 0)
END TYPE
REDIM Zone(0) AS TYPE_ZONE ' mouse zones
DIM Mouse AS TYPE_MOUSE ' mouse properties
DIM Pointer(14) AS TYPE_POINTER ' mouse pointer images
'+------------------------+
'| Begin demo use of code | <<------------------------------------------------------------------------------------------------------------------------
'+------------------------+
DIM AS INTEGER Zone1, Zone2, Zone3, Zone4, Zone5 ' handles for mouse zone areas
SCREEN _NEWIMAGE(800, 600, 32) ' graphics screen
Initialize ' initialize mouse
_TITLE "Mouse Utilities" ' window title
_MOUSEHIDE ' hide system mouse
'+--------------------------+
'| Create a few mouse zones |
'+--------------------------+
Zone1 = DefineMouseZone(10, 10, 80, 80, TRUE) ' (x1, y1, width, height, Active)
Zone2 = DefineMouseZone(100, 10, 80, 80, TRUE)
Zone3 = DefineMouseZone(10, 100, 170, 80, TRUE)
Zone4 = DefineMouseZone(190, 10, 170, 170, TRUE)
Zone5 = DefineMouseZone(10, 190, 350, 350, TRUE)
'+-----------+
'| Main loop |
'+-----------+
DO
_LIMIT 15 ' stay at or above 15 or greater for best results (sometimes double click gets missed with a lower frame rate)
CLS
UpdateMouse ' update mouse information
DrawBorder 0 ' draw borders around all zones
IF AnyClick THEN SOUND 440, 1 ' sound when click occurs
IF AnyDoubleClick THEN SOUND 880, 1 ' sound octave higher when double click occurs
IF SGN(MouseWheel) THEN SetMousePointer MousePointer + SGN(MouseWheel) ' select mouse pointer
LOCATE 2, 50: PRINT "AnyClick : "; AnyClick
LOCATE 3, 50: PRINT "AnyDoubleClick : "; AnyDoubleClick
LOCATE 4, 50: PRINT "Click : "; Click ' default left click (same as LeftClick)
LOCATE 5, 50: PRINT "DoubleClick : "; DoubleClick ' default left double click (same as LeftDoubleClick)
LOCATE 6, 50: PRINT "LeftClick : "; LeftClick
LOCATE 7, 50: PRINT "MiddleClick : "; MiddleClick
LOCATE 8, 50: PRINT "RightClick : "; RightClick
LOCATE 9, 50: PRINT "LeftDoubleClick : "; LeftDoubleClick
LOCATE 10, 50: PRINT "MiddleDoubleClick: "; MiddleDoubleClick
LOCATE 11, 50: PRINT "RightDoubleClick : "; RightDoubleClick
LOCATE 12, 50: PRINT "AnyHold : "; AnyHold
LOCATE 13, 50: PRINT "ClickAndHold : "; ClickAndHold ' default left click and hold (same as LeftHold)
LOCATE 14, 50: PRINT "LeftHold : "; LeftHold
LOCATE 15, 50: PRINT "MiddleHold : "; MiddleHold
LOCATE 16, 50: PRINT "RightHold : "; RightHold
LOCATE 17, 50: PRINT "MouseAngle : "; MouseAngle
LOCATE 18, 50: PRINT "MouseVectorX : "; MouseVectorX
LOCATE 19, 50: PRINT "MouseVectorY : "; MouseVectorY
LOCATE 20, 50: PRINT "MouseX : "; MouseX
LOCATE 21, 50: PRINT "MouseY : "; MouseY
LOCATE 22, 50: PRINT "MousePreviousX : "; MousePreviousX
LOCATE 23, 50: PRINT "MousePreviousY : "; MousePreviousY
LOCATE 24, 50: PRINT "MouseWheel : "; MouseWheel
LOCATE 25, 50: PRINT "MouseSpeed : "; MouseSpeed
LOCATE 26, 50: PRINT "MousePointer : "; MousePointer;
SELECT CASE MousePointer
CASE 0: PRINT "Normal Select"
CASE 1: PRINT "Help Select"
CASE 2: PRINT "Working in Background"
CASE 3: PRINT "Busy"
CASE 4: PRINT "Precision Select"
CASE 5: PRINT "Text Select"
CASE 6: PRINT "Handwriting"
CASE 7: PRINT "Unavailable"
CASE 8: PRINT "Vertical Resize"
CASE 9: PRINT "Horizontal Resize"
CASE 10: PRINT "Diagonal Resize 1"
CASE 11: PRINT "Diagonal Resize 2"
CASE 12: PRINT "Move"
CASE 13: PRINT "Alternate Select"
CASE 14: PRINT "Link Select"
END SELECT
IF MouseHovering(0) THEN
LOCATE 27, 50: PRINT "MouseHovering : Zone"; MouseHovering(0)
ELSE
LOCATE 27, 50: PRINT "MouseHovering : Not hovering"
END IF
IF MouseTrapped(0) THEN
LOCATE 28, 50: PRINT "MouseTrapped : Zone"; MouseTrapped(0)
ELSE
LOCATE 28, 50: PRINT "MouseTrapped : Not trapped"
END IF
LOCATE 30, 50: PRINT "- Move mouse pointer to select zone area."
LOCATE 31, 50: PRINT "- Left click inside zone area to trap pointer."
LOCATE 32, 50: PRINT "- Right click to release pointer from zone."
LOCATE 33, 50: PRINT "- Rotate mouse wheel to select mouse pointer."
LOCATE 34, 50: PRINT "- ESC to exit."
LINE (600, 20)-(770, 200), _RGB32(255, 255, 255), BF ' icon viewing area
IF LeftClick AND MouseHovering(0) THEN TrapMouse MouseHovering(0) ' trap mouse in zone
IF MouseTrapped(0) AND RightClick THEN FreeMouse ' free trapped mouse
DrawMousePointer ' display mouse pointer
_DISPLAY ' udate screen with changes (no flicker)
LOOP UNTIL _KEYDOWN(27) ' leave when ESC pressed
SYSTEM ' return to OS
'+----------------------+
'| End demo use of code | <<--------------------------------------------------------------------------------------------------------------------------
'+----------------------+
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB UpdateMouse () ' UpdateMouse |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Updates the mouse properties. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
DIM z AS INTEGER ' zone counter
Mouse.Wheel = 0 ' reset mouse wheel value
WHILE _MOUSEINPUT ' while mouse input exists
Mouse.Wheel = Mouse.Wheel + _MOUSEWHEEL ' get all cumulative wheel updates
WEND
CheckMouseButton Mouse.Left, _MOUSEBUTTON(1) ' update status of mouse buttons
CheckMouseButton Mouse.Right, _MOUSEBUTTON(2)
CheckMouseButton Mouse.Middle, _MOUSEBUTTON(3)
Mouse.Previous.x = Mouse.Location.x ' record previous mouse location
Mouse.Previous.y = Mouse.Location.y
Mouse.Location.x = _MOUSEX ' record current mouse location
Mouse.Location.y = _MOUSEY
IF UBOUND(Zone) THEN ' are any mouse zones defined?
IF Mouse.ZoneTrap THEN ' yes, is mouse trapped in a zone?
IF Mouse.Location.x < Mouse.Area.Min.x THEN Mouse.Location.x = Mouse.Area.Min.x ' yes, confine mouse to zone area
IF Mouse.Location.x > Mouse.Area.Max.x THEN Mouse.Location.x = Mouse.Area.Max.x
IF Mouse.Location.y < Mouse.Area.Min.y THEN Mouse.Location.y = Mouse.Area.Min.y
IF Mouse.Location.y > Mouse.Area.Max.y THEN Mouse.Location.y = Mouse.Area.Max.y
_MOUSEMOVE Mouse.Location.x, Mouse.Location.y ' force mouse to any updated coordinates
ELSE ' no, mouse is free
Mouse.Hovering = 0 ' assume mouse is not hovering a zone
z = 0 ' reset zone counter
DO ' cycle through zones
z = z + 1 ' increment zone counter
IF MouseZone(z) THEN Mouse.Hovering = z ' if mouse interacting with zone then record it hovering
LOOP UNTIL z = UBOUND(Zone) OR Mouse.Hovering ' leave when all zones checked or mouse is hovering
END IF
END IF
Mouse.Vector.x = Mouse.Location.x - Mouse.Previous.x ' calculate mouse vector movement from last position
Mouse.Vector.y = Mouse.Location.y - Mouse.Previous.y
Mouse.Degree = Vector2Degree(Mouse.Vector) ' calculate mouse degree movement from last position
Normalize Mouse.Vector, Mouse.Normal ' calculate normalized vector quantities
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB CheckMouseButton (Button AS TYPE_MOUSEBUTTON, Pressed AS INTEGER) ' CheckMouseButton |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Checks a mouse button for hold, click, and double click conditions and sets the appropriate mouse properties. This subroutine uses TIMER |
'| to determine double click intervals therefore it is independent of any FPS limit set by _LIMIT. However, this subroutine should be called at |
'| least 15 times per second for best results. |
'| |
'| Button - the mouse button UDT to check (Note: values are changed and passed back) |
'| Pressed - the related _MOUSEBUTTON() status |
'\_______________________________________________________________________________________________________________________________________________/
Button.Clicked = 0 ' reset button click flag
Button.DoubleClicked = 0 ' reset button double click flag
IF Pressed THEN ' is button pressed?
Button.Held = -1 ' yes, button is held down
ELSEIF Button.Held THEN ' no, was button previously down?
Button.Held = 0 ' yes, no longer being held
Button.Clicked = -1 ' button was single clicked
IF Button.DCTimer = 0 THEN ' first click of a possible double click?
Button.DCTimer = TIMER(.001) + Button.DCTime ' yes, set future double click time
ELSEIF TIMER(.001) <= Button.DCTimer THEN ' no, was second click within double click time?
Button.DoubleClicked = -1 ' yes, button was double clicked
Button.Clicked = 0 ' not a single click
Button.DCTimer = 0 ' reset double click timer
END IF
ELSEIF Button.DCTimer THEN ' no, is double click timer set?
IF TIMER(.001) > Button.DCTimer THEN ' yes, has time been exceeded for a double click?
Button.DCTimer = 0 ' yes, reset double click timer
END IF
END IF
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB DrawMousePointer () ' DrawMousePointer |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Draws the mouse pointer at the current mouse coordinates. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
_PUTIMAGE (MouseX - Mouse.Pointer.Offset.x, MouseY - Mouse.Pointer.Offset.y), Mouse.Pointer.Image ' draw the pointer
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB SetMousePointer (p AS INTEGER) ' SetMousePointer |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Set the mouse pointer (0 to 14) |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
SHARED Pointer() AS TYPE_POINTER ' need access to pointer images
IF p < 0 THEN p = 14 ELSE IF p > 14 THEN p = 0 ' keep mouse pointer within limits
Mouse.Pointer = Pointer(p) ' set mouse pointer
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB SetLeftDoubleClickTime (dc AS SINGLE) ' SetLeftDoubleClickTime |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Sets the maximum time delay between two left button clicks to be considered a double click. |
'| |
'| dc - the time between two left clicks |
'| |
'| NOTE: dc is given in milliseconds, therefore a value such as .3 = 300 milliseconds or approximately 1/3rd of a second. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
Mouse.Left.DCTime = dc ' record left button double click time
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB SetMiddleDoubleClickTime (dc AS SINGLE) ' SetMiddleDoubleClickTime |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Sets the maximum time delay between two middle button clicks to be considered a double click. |
'| |
'| dc - the time between two middle clicks |
'| |
'| NOTE: dc is given in milliseconds, therefore a value such as .3 = 300 milliseconds or approximately 1/3rd of a second. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
Mouse.Middle.DCTime = dc ' record middle button double click time
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB SetRightDoubleClickTime (dc AS SINGLE) ' SetRightDoubleClickTime |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Sets the maximum time delay between two right button clicks to be considered a double click. |
'| |
'| dc - the time between two right clicks |
'| |
'| NOTE: dc is given in milliseconds, therefore a value such as .3 = 300 milliseconds or approximately 1/3rd of a second. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
Mouse.Right.DCTime = dc ' record right button double click time
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB Normalize (vin AS TYPE_VECTOR, vout AS TYPE_VECTOR) ' Normalize |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Normalizes a vector passed in (0 to 1 for both quantities) and passes the result back. |
'| |
'| vin - the vector quantity pair to normalize |
'| vout - the normalized vector quantity pair result |
'\_______________________________________________________________________________________________________________________________________________/
DIM VectorLength AS SINGLE ' vector length (hypotenuse)
VectorLength = _HYPOT(vin.x, vin.y) ' calculate vector length
vout.x = vin.x / VectorLength ' normalize x quantity and pass back
vout.y = vin.y / VectorLength ' normalize y quantity and pass back
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION Vector2Degree (v AS TYPE_VECTOR) ' Vector2Degree |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Converts a vector quantity pair to a degree heading (0 to 359) |
'| |
'| Degree = Vector2Degree(Vector) |
'| |
'| v - the vector quantity pair |
'| .x = x quantity |
'| .y = y quantity |
'| |
'| Returns an integer degree value from 0 to 359 |
'\_______________________________________________________________________________________________________________________________________________/
DIM v2d AS SINGLE ' vector converted to degree
IF v.x = 0 AND v.y = 0 THEN ' vector passed in?
Vector2Degree = 0 ' no, return no degree
ELSEIF v.x = 0 THEN ' horizontal direction?
IF v.y > 0 THEN ' no, vertical downward direction?
Vector2Degree = 180 ' yes, must be 180 degrees
ELSEIF v.y < 0 THEN ' vertical upward direction?
Vector2Degree = 0 ' yes, must be 0 degrees
ELSE ' no, no vertical direction
Vector2Degree = 0 ' return no degree
END IF
ELSEIF v.y = 0 THEN ' no, vertical direction?
IF v.x > 0 THEN ' no, right horizontal direction?
Vector2Degree = 90 ' yes, must be 90 degrees
ELSEIF v.x < 0 THEN ' left horizontal direction?
Vector2Degree = 270 ' yes, must be 270 degrees
ELSE ' no, no horizontal direction
Vector2Degree = 0 ' return no degree
END IF
ELSE ' no, horizontal and vertical direction
v2d = _R2D(_ATAN2(v.y, v.x)) + 90 ' calculate radian converted to degree (rotated 90 for 0 degrees up)
IF v.x < 0 AND v.y < 0 THEN v2d = v2d + 360 ' add 360 if in 4th quadrant
Vector2Degree = INT(v2d) ' return degree
END IF
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB HideZone (z AS INTEGER) ' HideZone |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Hide a zone from being detected by the mouse pointer. |
'| |
'| z - the zone handle to hide |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
Zone(z).Active = 0 ' hide zone from mouse
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB ShowZone (z AS INTEGER) ' ShowZone |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Reveal a previously hidden zone from the mouse pointer. |
'| |
'| z - the zone handle to reveal |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
Zone(z).Active = -1 ' reveal zone to mouse
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB DrawBorder (z AS INTEGER) ' DrawBorder |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Draws a border around a zone area depecting the current state: |
'| Bright white - mouse is trapped in this zone |
'| White - mouse is hovering over this zone |
'| Gray - mouse has no interation with this zone |
'| |
'| z - The zone to draw a border around |
'| Supply the value of 0 to have borders drawn around all zones |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
STATIC Colour(2) AS _UNSIGNED LONG ' border colors
DIM c AS INTEGER ' zone counter (start of count)
DIM Finish AS INTEGER ' end of zone counter
DIM Border AS INTEGER ' border color
IF UBOUND(Zone) = 0 OR z > UBOUND(Zone) THEN EXIT SUB ' leave if no defined zone areas
IF NOT Colour(0) THEN ' set border colors if not set yet
Colour(0) = _RGB32(127, 127, 127) ' not hovering (gray)
Colour(1) = _RGB32(192, 192, 192) ' hovering (white)
Colour(2) = _RGB32(255, 255, 255) ' trapped (bright white)
END IF
IF z = 0 THEN ' draw borders around all zones?
c = 0 ' yes, start at the beginning of zone array
Finish = UBOUND(Zone) ' finish at the end of the zone array
ELSE ' no, just a single zone
c = z - 1 ' start at the individual zone in array
Finish = z ' finish at the individual zone in array
END IF
DO ' cycle through chosen zone(s)
c = c + 1 ' increment zone counter
IF Zone(c).Active THEN ' is tis zone active?
Border = 0 ' yes, assume no interaction with zone
IF MouseHovering(c) THEN Border = 1 ' white border if mouse is hovering this zone
IF MouseTrapped(c) THEN Border = 2 ' bright white border if mouse is trapped in this zone
LINE (Zone(c).Area.Min.x, Zone(c).Area.Min.y)-(Zone(c).Area.Max.x, Zone(c).Area.Max.y), Colour(Border), B ' draw border
END IF
LOOP UNTIL c = Finish ' leave when zone(s) processed
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION MouseHovering (z AS INTEGER) ' MouseHovering |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Report mouse hovering status over a zone(s) |
'| |
'| z - the zone's handle to check for a hovering mouse (>0) |
'| supplying a value of 0 will simply return the zone handle where the mouse is hovering (0) |
'| Returns -1 (TRUE) if the mouse is hovering on the requested zone (-1) |
'| Returns a zone handle value if the zone requested is 0 and the mouse is hovering somewhere (>=0) |
'| Returns 0 (FALSE) if the mouse is not hovering in either scenario (0) |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
MouseHovering = 0 ' assume mouse is not hovering (0 FALSE return)
IF Mouse.Hovering THEN ' is the mouse hovering over a zone?
IF z > 0 THEN ' yes, was a zone requested? (>0)
IF z = Mouse.Hovering THEN ' yes, is mouse hovering over the zone requested?
MouseHovering = z ' yes, report that mouse is hovering over requested zone (-1 TRUE return)
END IF
ELSE ' no, a zone was not requested
MouseHovering = Mouse.Hovering ' report any zone handle the mouse may be hovering over (>=0 TRUE or FALSE return)
END IF
END IF
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION MouseZone (z AS INTEGER) ' MouseZone |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Report interaction status of mouse and zone area |
'| |
'| z - the zone's handle |
'| Returns -1 (TRUE) if interaction, 0 (FALSE) otherwise |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
DIM Trapped AS INTEGER ' mouse trapped status
IF NOT Zone(z).Active THEN EXIT FUNCTION ' leave is zone is inactive
MouseZone = 0 ' assume mouse not interacting with zone (0 FALSE return)
Trapped = MouseTrapped(0) ' record zone mouse may be trapped in
IF Trapped THEN ' is mouse trapped in a zone?
IF z = Trapped THEN ' yes, is it this zone?
MouseZone = -1 ' yes, report the only interaction that can happen (-1 TRUE return)
END IF
ELSE ' no, mouse if currently free
IF MouseHover(Zone(z).Area) THEN ' is mouse interacting with this zone?
MouseZone = -1 ' yes, report that mouse is in this zone (-1 TRUE return)
END IF
END IF
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB TrapMouse (z AS INTEGER) ' TrapMouse |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Trap mouse within a zone's area |
'| |
'| z - the handle of the zone to trap mouse in |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
IF NOT Zone(z).Active THEN EXIT SUB ' can't trap mouse in inactive zone
Mouse.Area = Zone(z).Area ' define trapped area
Mouse.ZoneTrap = z ' mouse trapped in this zone (>0)
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB FreeMouse () ' FreeMouse |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Releases a trapped mouse. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
Mouse.ZoneTrap = 0
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION MouseTrapped (z AS INTEGER) ' MouseTrapped |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Report mouse trapped status |
'| |
'| z - the zone's handle to check for a trapped mouse (>0) |
'| supplying a value of 0 will simply return the zone handle where the mouse is trapped (0) |
'| Returns -1 (TRUE) if the mouse is trapped in the requested zone (-1) |
'| Returns a zone handle value if the zone requested is 0 and the mouse is trapped somewhere (>=0) |
'| Returns 0 (FALSE) if the mouse is not trapped in either scenario (0) |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to mouse zones
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
MouseTrapped = 0 ' assume mouse is not trapped (0 FALSE return)
IF Mouse.ZoneTrap THEN ' is the mouse trapped in a zone?
IF z > 0 THEN ' yes, was a zone requested? (>0)
IF z = Mouse.ZoneTrap THEN ' yes, is mouse trapped in zone requested?
MouseTrapped = -1 ' yes, report that mouse is trapped in requested zone (-1 TRUE return)
END IF
ELSE ' no, a zone was not requested (0)
MouseTrapped = Mouse.ZoneTrap ' report any zone handle the mouse may be trapped in (>=0 TRUE or FALSE return)
END IF
END IF
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION MouseHover (Area AS TYPE_AREA) ' MouseHover |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Returns a value of 1 if the mouse is hovering over the given area, 0 otherwise |
'| |
'| Area = the rectangular area |
'\_______________________________________________________________________________________________________________________________________________/
MouseHover = 0 ' assume mouse not hovering over area
WHILE _MOUSEINPUT: WEND ' get latest mouse updates
IF _MOUSEX >= Area.Min.x THEN ' is mouse pointer currently within area limits?
IF _MOUSEX <= Area.Max.x THEN
IF _MOUSEY >= Area.Min.y THEN
IF _MOUSEY <= Area.Max.y THEN
MouseHover = 1 ' yes, report that mouse is hovering this area
END IF
END IF
END IF
END IF
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION DefineMouseZone (x1 AS INTEGER, y1 AS INTEGER, w AS INTEGER, h AS INTEGER, Active AS INTEGER) ' DefineMouseZone |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Defines mouse zones within the main screen |
'| |
'| x1,y1 - upper left coordinate of zone area |
'| w - width of zone area |
'| h - height of zone area |
'| Active - mouse can see zone area (t/f) |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Zone() AS TYPE_ZONE ' need access to zone areas
REDIM _PRESERVE Zone(UBOUND(Zone) + 1) AS TYPE_ZONE ' increase array size
Zone(UBOUND(Zone)).Area.Min.x = x1 ' set new zone area coordinates
Zone(UBOUND(Zone)).Area.Max.x = x1 + w - 1
Zone(UBOUND(Zone)).Area.Min.y = y1
Zone(UBOUND(Zone)).Area.Max.y = y1 + h - 1
Zone(UBOUND(Zone)).Active = Active ' set active status
DefineMouseZone = UBOUND(Zone) ' return handle of zone area
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB MakePointer (p AS INTEGER, c AS STRING, d AS TYPE_VECTOR, Offset AS TYPE_VECTOR) ' MakePointer |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Used by the Initialize() subroutine to create mouse pointers. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Pointer() AS TYPE_POINTER ' need access to pointer images
DIM clr(2) AS _UNSIGNED LONG ' colors used to draw pointers
DIM x AS INTEGER ' horizontal counter
DIM y AS INTEGER ' vertical counter
DIM Cpos AS INTEGER ' character position counter within string
DIM ch AS STRING * 1 ' current character within string
DIM Odest AS LONG ' calling destination
Odest = _DEST ' save calling destination
clr(0) = _RGB32(0, 0, 0) ' set colors
clr(1) = _RGB32(255, 255, 255)
clr(2) = _RGB32(43, 47, 55)
Pointer(p).Value = p ' record pointer handle
Pointer(p).Image = _NEWIMAGE(d.x, d.y, 32) ' create image canvas for pointer
Pointer(p).Offset = Offset ' record pointer offset values
_DEST Pointer(p).Image ' draw on pointer image
Cpos = 0 ' reset character position counter
FOR y = 0 TO d.y - 1 ' cycle through vertical pixels
FOR x = 0 TO d.x - 1 ' cycle through horizontal pixels
Cpos = Cpos + 1 ' increment character position counter
ch = MID$(c, Cpos, 1) ' get character from within string
IF ch <> " " THEN PSET (x, y), clr(VAL(ch)) ' draw pixel if one exists
NEXT x
NEXT y
_DEST Odest ' restore calling destination
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
SUB Initialize () ' Initialize |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Draw the pointer icons and initialize mouse variables. |
'\_______________________________________________________________________________________________________________________________________________/
SHARED Mouse AS TYPE_MOUSE ' need access to mouse properties
SHARED Pointer() AS TYPE_POINTER ' need access to pointer images
DIM c(14) AS STRING ' ASCII representation of pointer image
DIM d(14) AS TYPE_VECTOR ' pointer dimensions
DIM o(14) AS TYPE_VECTOR ' pointer image offset from mousex and mousey
DIM p AS INTEGER ' pointer counter
'---------------------------- ---------------------------- -------------------------------------- --------------------------------------
' Busy 13x22 Normal Select 12x21 Working in Background 22x21 Help Select 22x19
'---------------------------- ---------------------------- -------------------------------------- --------------------------------------
c(3) = c(3) + "0000000000000": c(0) = c(0) + "0 ": c(2) = c(2) + "0 ": c(1) = c(1) + "0 "
c(3) = c(3) + "0011111111100": c(0) = c(0) + "00 ": c(2) = c(2) + "00 0000000000": c(1) = c(1) + "00 1111111 "
c(3) = c(3) + "0000000000000": c(0) = c(0) + "010 ": c(2) = c(2) + "010 0011111100": c(1) = c(1) + "010 100000001 "
c(3) = c(3) + " 01111111110 ": c(0) = c(0) + "0110 ": c(2) = c(2) + "0110 0000000000": c(1) = c(1) + "0110 10001100001 "
c(3) = c(3) + " 01111111110 ": c(0) = c(0) + "01110 ": c(2) = c(2) + "01110 01111110 ": c(1) = c(1) + "01110 10001 100001"
c(3) = c(3) + " 01101010110 ": c(0) = c(0) + "011110 ": c(2) = c(2) + "011110 01111110 ": c(1) = c(1) + "011110 10001 100001"
c(3) = c(3) + " 01110101110 ": c(0) = c(0) + "0111110 ": c(2) = c(2) + "0111110 01110110 ": c(1) = c(1) + "0111110 10001 100001"
c(3) = c(3) + " 00111011100 ": c(0) = c(0) + "01111110 ": c(2) = c(2) + "01111110 00101100 ": c(1) = c(1) + "01111110 10001 10001 "
c(3) = c(3) + " 001111100 ": c(0) = c(0) + "011111110 ": c(2) = c(2) + "011111110 001100 ": c(1) = c(1) + "01111111011111 10001 "
c(3) = c(3) + " 0010100 ": c(0) = c(0) + "0111111110 ": c(2) = c(2) + "0111111110 0010 ": c(1) = c(1) + "0111111110 10001 "
c(3) = c(3) + " 00100 ": c(0) = c(0) + "01111111110 ": c(2) = c(2) + "01111111110 001100 ": c(1) = c(1) + "01111100000 10001 "
c(3) = c(3) + " 00100 ": c(0) = c(0) + "011111100000": c(2) = c(2) + "011111100000 00111100 ": c(1) = c(1) + "0110110 10001 "
c(3) = c(3) + " 0011100 ": c(0) = c(0) + "01110110 ": c(2) = c(2) + "01110110 01101110 ": c(1) = c(1) + "010 0110 10001 "
c(3) = c(3) + " 001101100 ": c(0) = c(0) + "01100110 ": c(2) = c(2) + "01100110 01010110 ": c(1) = c(1) + "00 0110 111 "
c(3) = c(3) + " 00111111100 ": c(0) = c(0) + "010 0110 ": c(2) = c(2) + "010 0110 00101010 ": c(1) = c(1) + "0 0110 10001 "
c(3) = c(3) + " 01111011110 ": c(0) = c(0) + "00 0110 ": c(2) = c(2) + "00 0110 0000000000": c(1) = c(1) + " 0110 1000001 "
c(3) = c(3) + " 01110101110 ": c(0) = c(0) + "0 0110 ": c(2) = c(2) + "0 0110 0011111100": c(1) = c(1) + " 0110 10001 "
c(3) = c(3) + " 01101010110 ": c(0) = c(0) + " 0110 ": c(2) = c(2) + " 0110 0000000000": c(1) = c(1) + " 0110 111 "
c(3) = c(3) + " 01010101010 ": c(0) = c(0) + " 0110 ": c(2) = c(2) + " 0110 ": c(1) = c(1) + " 00 "
c(3) = c(3) + "0000000000000": c(0) = c(0) + " 0110 ": c(2) = c(2) + " 0110 "
c(3) = c(3) + "0011111111100": c(0) = c(0) + " 00 ": c(2) = c(2) + " 00 "
c(3) = c(3) + "0000000000000"
'--------------------------------------- ---------------------------------------- ----------------------------------- ---------------------------------------
' Precision Select 24x24 Handwriting 24x24 Link Select 17x22 Move 21x21
'--------------------------------------- ---------------------------------------- ----------------------------------- ---------------------------------------
c(4) = c(4) + " 22 ": c(6) = c(6) + "11 ": c(14) = c(14) + " 00 ": c(12) = c(12) + " 1 "
c(4) = c(4) + " 22 ": c(6) = c(6) + "1011 ": c(14) = c(14) + " 0110 ": c(12) = c(12) + " 101 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 10011 ": c(14) = c(14) + " 0110 ": c(12) = c(12) + " 10001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 100001 ": c(14) = c(14) + " 0110 ": c(12) = c(12) + " 1000001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 100101 ": c(14) = c(14) + " 0110 ": c(12) = c(12) + " 100000001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000101 ": c(14) = c(14) + " 011000 ": c(12) = c(12) + " 111101111 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001101 ": c(14) = c(14) + " 011011000 ": c(12) = c(12) + " 11 101 11 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001101 ": c(14) = c(14) + " 01101101100 ": c(12) = c(12) + " 101 101 101 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001101 ": c(14) = c(14) + " 011011011010 ": c(12) = c(12) + " 1001 101 1001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001101 ": c(14) = c(14) + "000 0110110110110": c(12) = c(12) + " 1000111110111110001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001101 ": c(14) = c(14) + "01100111111110110": c(12) = c(12) + "100000000000000000001"
c(4) = c(4) + "222222222222222222222222": c(6) = c(6) + " 1001101 1 ": c(14) = c(14) + "01110111111111110": c(12) = c(12) + " 1000111110111110001 "
c(4) = c(4) + "222222222222222222222222": c(6) = c(6) + " 1001101101 ": c(14) = c(14) + " 0110111111111110": c(12) = c(12) + " 1001 101 1001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1010101001 ": c(14) = c(14) + " 010111111111110": c(12) = c(12) + " 101 101 101 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000100001 ": c(14) = c(14) + " 011111111111110": c(12) = c(12) + " 11 101 11 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000101001 ": c(14) = c(14) + " 01111111111110": c(12) = c(12) + " 111101111 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000101001 ": c(14) = c(14) + " 0111111111110 ": c(12) = c(12) + " 100000001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000101001": c(14) = c(14) + " 011111111110 ": c(12) = c(12) + " 1000001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 100010101": c(14) = c(14) + " 011111111110 ": c(12) = c(12) + " 10001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 10001001": c(14) = c(14) + " 0111111110 ": c(12) = c(12) + " 101 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1000101": c(14) = c(14) + " 0111111110 ": c(12) = c(12) + " 1 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 100001": c(14) = c(14) + " 0000000000 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 1001 "
c(4) = c(4) + " 22 ": c(6) = c(6) + " 11 "
'------------------------ ------------------------------------ --------------------------- -----------------------
' Vertical Resize 9x21 Unavailable 20x20 Alternate Select 9x19 Text Select 7x16
'------------------------ ------------------------------------ --------------------------- -----------------------
c(8) = c(8) + " 1 ": c(7) = c(7) + " 111111 ": c(13) = c(13) + " 1 ": c(5) = c(5) + "222 222"
c(8) = c(8) + " 101 ": c(7) = c(7) + " 1100000011 ": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 10001 ": c(7) = c(7) + " 100000000001 ": c(13) = c(13) + " 10001 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 1000001 ": c(7) = c(7) + " 10000111100001 ": c(13) = c(13) + " 1000001 ": c(5) = c(5) + " 2 "
c(8) = c(8) + "100000001": c(7) = c(7) + " 100011 110001 ": c(13) = c(13) + "100000001": c(5) = c(5) + " 2 "
c(8) = c(8) + "111101111": c(7) = c(7) + " 1000001 10001 ": c(13) = c(13) + "111101111": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + " 10010001 1001 ": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "1000110001 10001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "1001 10001 1001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "1001 10001 1001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "1001 10001 1001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "1001 10001 1001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + "10001 1000110001": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + " 1001 10001001 ": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + " 101 ": c(7) = c(7) + " 10001 1000001 ": c(13) = c(13) + " 101 ": c(5) = c(5) + " 2 "
c(8) = c(8) + "111101111": c(7) = c(7) + " 100011 110001 ": c(13) = c(13) + " 101 ": c(5) = c(5) + "222 222"
c(8) = c(8) + "100000001": c(7) = c(7) + " 10000111100001 ": c(13) = c(13) + " 101 "
c(8) = c(8) + " 1000001 ": c(7) = c(7) + " 100000000001 ": c(13) = c(13) + " 101 "
c(8) = c(8) + " 10001 ": c(7) = c(7) + " 1100000011 ": c(13) = c(13) + " 111 "
c(8) = c(8) + " 101 ": c(7) = c(7) + " 111111 "
c(8) = c(8) + " 1 "
'-------------------------------- --------------------------------- -------------------------------------
' Diagonal Resize 2 15x15 Diagonal Resize 1 15x15 Horizontal Resize 21x9
'-------------------------------- --------------------------------- -------------------------------------
c(11) = c(11) + " 1111111": c(10) = c(10) + "1111111 ": c(9) = c(9) + " 11 11 "
c(11) = c(11) + " 1000001": c(10) = c(10) + "1000001 ": c(9) = c(9) + " 101 101 "
c(11) = c(11) + " 100001": c(10) = c(10) + "100001 ": c(9) = c(9) + " 1001 1001 "
c(11) = c(11) + " 10001": c(10) = c(10) + "10001 ": c(9) = c(9) + " 1000111111111110001 "
c(11) = c(11) + " 101001": c(10) = c(10) + "100101 ": c(9) = c(9) + "100000000000000000001"
c(11) = c(11) + " 101 101": c(10) = c(10) + "101 101 ": c(9) = c(9) + " 1000111111111110001 "
c(11) = c(11) + " 101 11": c(10) = c(10) + "11 101 ": c(9) = c(9) + " 1001 1001 "
c(11) = c(11) + " 101 ": c(10) = c(10) + " 101 ": c(9) = c(9) + " 101 101 "
c(11) = c(11) + "11 101 ": c(10) = c(10) + " 101 11": c(9) = c(9) + " 11 11 "
c(11) = c(11) + "101 101 ": c(10) = c(10) + " 101 101"
c(11) = c(11) + "100101 ": c(10) = c(10) + " 101001"
c(11) = c(11) + "10001 ": c(10) = c(10) + " 10001"
c(11) = c(11) + "100001 ": c(10) = c(10) + " 100001"
c(11) = c(11) + "1000001 ": c(10) = c(10) + " 1000001"
c(11) = c(11) + "1111111 ": c(10) = c(10) + " 1111111"
d(0).x = 12: d(0).y = 21: o(0).x = 0: o(0).y = 0 ' Normal Select Mouse pointer widths and heights ( d().x and d().y )
d(1).x = 22: d(1).y = 19: o(1).x = 0: o(1).y = 0 ' Help Select
d(2).x = 22: d(2).y = 21: o(2).x = 0: o(2).y = 0 ' Working in Background Mouse pointer offsets ( o().x and o().y )
d(3).x = 13: d(3).y = 22: o(3).x = 6: o(3).y = 11 ' Busy
d(4).x = 24: d(4).y = 24: o(4).x = 12: o(4).y = 12 ' Precision Select
d(5).x = 7: d(5).y = 16: o(5).x = 3: o(5).y = 8 ' Text Select
d(6).x = 24: d(6).y = 24: o(6).x = 0: o(6).y = 0 ' Handwriting
d(7).x = 20: d(7).y = 20: o(7).x = 10: o(7).y = 10 ' Unavailable
d(8).x = 9: d(8).y = 21: o(8).x = 4: o(8).y = 10 ' Vertical Resize
d(9).x = 21: d(9).y = 9: o(9).x = 10: o(9).y = 4 ' Horizontal Resize
d(10).x = 15: d(10).y = 15: o(10).x = 7: o(10).y = 7 ' Diagonal Resize 1
d(11).x = 15: d(11).y = 15: o(11).x = 7: o(11).y = 7 ' Diagonal Resize 2
d(12).x = 21: d(12).y = 21: o(12).x = 10: o(12).y = 10 ' Move
d(13).x = 9: d(13).y = 19: o(13).x = 4: o(13).y = 0 ' Alternate Select
d(14).x = 17: d(14).y = 22: o(14).x = 5: o(14).y = 0 ' Link Select
FOR p = 0 TO 14 ' create mouse pointer images
MakePointer p, c(p), d(p), o(p) ' value, string representation, dimensions, offset
NEXT p
Mouse.Left.DCTime = .3 ' set button double click times
Mouse.Right.DCTime = .3
Mouse.Middle.DCTime = .3
Mouse.Pointer = Pointer(0) ' default pointer (normal select)
END SUB
' ______________________________________________________________________________________________________________________________________________
'/ \
'| Mouse property reporting functions |
'|______________________________________________________________________________________________________________________________________________|____
'| \
'| The following functions return the various mouse properties available. |
'\___________________________________________________________________________________________________________________________________________________/
FUNCTION MousePointer () ' report the current mouse pointer number
SHARED Mouse AS TYPE_MOUSE
MousePointer = Mouse.Pointer.Value
END FUNCTION
FUNCTION MouseSpeed () ' report speed of mouse as it moves from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseSpeed = INT(_HYPOT(Mouse.Vector.x, Mouse.Vector.y))
END FUNCTION
FUNCTION MouseWheel () ' report cumulative wheel value between updates
SHARED Mouse AS TYPE_MOUSE
MouseWheel = Mouse.Wheel
END FUNCTION
FUNCTION MouseVectorX () ' report the x vector quantity change from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseVectorX = Mouse.Vector.x
END FUNCTION
FUNCTION MouseVectorY () ' report the y vector quantity change from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseVectorY = Mouse.Vector.y
END FUNCTION
FUNCTION MouseNormalX () ' report the normalized x vector quantity change from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseNormalX = Mouse.Normal.x
END FUNCTION
FUNCTION MouseNormalY () ' report the normalized y vector quantity change from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseNormalY = Mouse.Normal.y
END FUNCTION
FUNCTION AnyClick () ' report any button that has been clicked
AnyClick = LeftClick OR MiddleClick OR RightClick
END FUNCTION
FUNCTION AnyDoubleClick () ' report any button that has been double clicked
AnyDoubleClick = LeftDoubleClick OR MiddleDoubleClick OR RightDoubleClick
END FUNCTION
FUNCTION Click () ' report if the left button has been clicked
Click = LeftClick
END FUNCTION
FUNCTION DoubleClick () ' report if the left button has been double clicked
DoubleClick = LeftDoubleClick
END FUNCTION
FUNCTION LeftClick () ' report if the left button has been clicked
SHARED Mouse AS TYPE_MOUSE
LeftClick = Mouse.Left.Clicked
END FUNCTION
FUNCTION LeftDoubleClick () ' report if the left button has been double clicked
SHARED Mouse AS TYPE_MOUSE
LeftDoubleClick = Mouse.Left.DoubleClicked
END FUNCTION
FUNCTION RightClick () ' report if the right button has been clicked
SHARED Mouse AS TYPE_MOUSE
RightClick = Mouse.Right.Clicked
END FUNCTION
FUNCTION RightDoubleClick () ' report if the right button has been double clicked
SHARED Mouse AS TYPE_MOUSE
RightDoubleClick = Mouse.Right.DoubleClicked
END FUNCTION
FUNCTION MiddleClick () ' report if the middle button has been clicked
SHARED Mouse AS TYPE_MOUSE
MiddleClick = Mouse.Middle.Clicked
END FUNCTION
FUNCTION MiddleDoubleClick () ' report if the middle button has been double clicked
SHARED Mouse AS TYPE_MOUSE
MiddleDoubleClick = Mouse.Middle.DoubleClicked
END FUNCTION
FUNCTION MouseAngle () ' report the degree angle the mouse moved in from one position to the next
SHARED Mouse AS TYPE_MOUSE
MouseAngle = Mouse.Degree
END FUNCTION
FUNCTION ClickAndHold () ' report if the left button is being held down
ClickAndHold = LeftHold
END FUNCTION
FUNCTION AnyHold () ' report if any button is being held down
SHARED Mouse AS TYPE_MOUSE
AnyHold = LeftHold OR MiddleHold OR RightHold
END FUNCTION
FUNCTION LeftHold () ' report if the left button is being held down
SHARED Mouse AS TYPE_MOUSE
LeftHold = Mouse.Left.Held
END FUNCTION
FUNCTION MiddleHold () ' report if the middle button is being held down
SHARED Mouse AS TYPE_MOUSE
MiddleHold = Mouse.Middle.Held
END FUNCTION
FUNCTION RightHold () ' report if the right button is being held down
SHARED Mouse AS TYPE_MOUSE
RightHold = Mouse.Right.Held
END FUNCTION
FUNCTION MouseX () ' report the current x coordinate of the pointer
SHARED Mouse AS TYPE_MOUSE
MouseX = Mouse.Location.x
END FUNCTION
FUNCTION MouseY () ' report the current y coordinate of the pointer
SHARED Mouse AS TYPE_MOUSE
MouseY = Mouse.Location.y
END FUNCTION
FUNCTION MousePreviousX () ' report the previous x coodinate of the pointer
SHARED Mouse AS TYPE_MOUSE
MousePreviousX = Mouse.Previous.x
END FUNCTION
FUNCTION MousePreviousY () ' report the previous y coordinate of the pointer
SHARED Mouse AS TYPE_MOUSE
MousePreviousY = Mouse.Previous.y
END FUNCTION
' ______________________________________________________________________________________________________________________________________________
'/ \
'| Documentation Documentation |
'|______________________________________________________________________________________________________________________________________________|____
'| \
'| This set of functions and subroutines is used to track all mouse and mouse button activity and give the ability to report on the status of all |
'| that activity. This code also gives you the ability to set up predefined mouse zones that the mouse pointer can interact with and get trapped |
'| within. |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| ---------------- |
'| Basic Mouse Use: |
'| ---------------- |
'| |
'| The snippet of code below will give you access to the status of the mouse buttons and mouse pointer coordinate related functions. |
'| |
'| SCREEN _NEWIMAGE(640, 480, 32) ' these mouse routines only work in a graphics screen |
'| _MOUSEHIDE ' hide system mouse pointer |
'| Initialize ' initialize the mouse pointers and settings |
'| DO ' main program loop |
'| CLS |
'| _LIMIT 30 ' optional frames per second limit (keep at >=15 for best results) |
'| UpdateMouse ' update mouse values |
'| |
'| '+----------------+ |
'| '| Your code here | |
'| '+----------------+ |
'| |
'| DrawMousePointer ' draw the mouse pointer at the current x and y coordinates |
'| LOOP |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| --------------------- |
'| Basic Mouse Zone Use: |
'| --------------------- |
'| |
'| The snippet of code below will create a single mouse zone and give you access to the status of the mouse interacting with zone related functions. |
'| |
'| DIM Zone AS INTEGER ' create handle to hold mouse zone properties |
'| |
'| Zone = DefineMouseZone(10, 10, 100, 100, TRUE) ' create a mouse zone that is visible to the mouse |
'| |
'| SCREEN _NEWIMAGE(640, 480, 32) ' these mouse routines only work in a graphics screen |
'| _MOUSEHIDE ' hide system mouse pointer |
'| Initialize ' initialize the mouse pointers and settings |
'| DO ' main program loop |
'| CLS |
'| _LIMIT 30 ' optional frames per second limit (keep at >=15 for best results) |
'| UpdateMouse ' update mouse values |
'| |
'| '+----------------+ |
'| '| Your code here | |
'| '+----------------+ |
'| |
'| DrawBorder Zone ' draw a border around the mouse zone (optional) |
'| DrawMousePointer ' draw the mouse pointer at the current x and y coordinates |
'| LOOP |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| ---------------------------------------- |
'| Mouse related subroutines and functions: |
'| ---------------------------------------- |
'| |
'| UpdateMouse |
'| |
'| - Updates the mouse properties. Must be called at the beginning of the main program loop. |
'| |
'| DrawMousePointer |
'| |
'| - Draws the current mouse pointer to the current x,y coordinate of the mouse on screen. Use this subroutine in your main program loop after all |
'| other drawing to the screen has been done. |
'| |
'| SetMousePointer PointerValue |
'| |
'| - Sets the mouse pointer to one of 15 different mouse pointer icons. |
'| - PointerValue - can be any value from 0 to 14. |
'| |
'| Pointer = MousePointer |
'| |
'| - Returns the current icon pointer value. |
'| - Pointer - will contain a value from 0 to 14. |
'| |
'| SetLeftDoubleClickTime DCTime |
'| |
'| - Sets the maximum time interval between two left button clicks to be considered a double click. |
'| - The default time, as set by Initialize, is 300 milliseconds. |
'| - DCTime - the time in milliseconds (i.e. .3 = 300 Milliseconds or approximatly 1/3rd of a second) |
'| |
'| SetMiddleDoubleClickTime DCTime |
'| |
'| - Sets the maximum time interval between two middle button clicks to be considered a double click. |
'| - The default time, as set by Initialize, is 300 milliseconds. |
'| - DCTime - the time in milliseconds (i.e. .3 = 300 Milliseconds or approximatly 1/3rd of a second) |
'| |
'| SetRightDoubleClickTime DCTime |
'| |
'| - Sets the maximum time interval between two right button clicks to be considered a double click. |
'| - The default time, as set by Initialize, is 300 milliseconds. |
'| - DCTime - the time in milliseconds (i.e. .3 = 300 Milliseconds or approximatly 1/3rd of a second) |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| --------------------------------------------- |
'| Mouse zone related subroutines and functions: |
'| --------------------------------------------- |
'| |
'| DefineMouseZone x1, y1, Width, Height, Active |
'| |
'| - Creates an area on screen that the mouse will actively monitor for activity. |
'| - x1, y1 - the upper left corner of the area |
'| - Width - the width of the area |
'| - Height - the height of the area |
'| - Active - zone is visible to the mouse pointer (-1 (TRUE) or 0 (FALSE)) |
'| |
'| DrawBorder Zone |
'| |
'| - Draws a border around a visible (active) defined mouse zone. The border will change color according to mouse pointer activity: |
'| : Gray - no mouse pointer interaction. |
'| : White - mouse pointer is hovering over the mouse zone. |
'| : Bright White - mouse pointer is trapped within the mouse zone. |
'| - Zone - the mouse zone to draw a border around. |
'| - supplying a value of 0 (zero) will draw borders around all defined and visible mouse zones. |
'| |
'| Hovering = MouseHovering(Zone) |
'| |
'| - Returns the status of the mouse pointer hovering over a zone. |
'| - Zone - the mouse zone to check for the mouse pointer hovering over. |
'| - supplying a value of 0 (zero) will check all mouse zones for mouse pointer hovering. |
'| - Hovering - will return -1 (TRUE), 0 (FALSE), or a mouse zone handle depending on the setting of Zone. |
'| - -1 (TRUE) when the mouse pointer is hovering over the Zone specified. |
'| - 0 (FALSE) when the mouse is not hovering over the Zone specified. |
'| - a zone handle value if the value of 0 (zero) was passed in for Zone and the mouse is hovering a defined and visible mouse zone. |
'| - 0 (FALSE) if the value of 0 (zero) was passed in for Zone and the mouse is not hovering a defined and visible mouse zone. |
'| |
'| Trapped = MouseTrapped(Zone) |
'| |
'| - Returns the status of a mouse trapped within a zone. |
'| - Zone - the mouse zone to check for the mouse pointer trapped in. |
'| - supplying a value of 0 (zero) will check all mouse zones for a trapped mouse pointer. |
'| - Trapped - will return -1 (TRUE), 0 (FALSE), or a mouse zone handle depending on the setting of Zone. |
'| - -1 (TRUE) when the mouse pointer is trapped in the Zone specified. |
'| - 0 (FALSE) when the mouse pointer is not trapped within the Zone specified. |
'| - a zone handle value if the value of 0 (zero) was passed in for Zone and the mouse is trapped in a defined and visible mouse zone. |
'| - 0 (FALSE) if the value of 0 (zero) was passed in for Zone and the mouse is not trapped in a defined and visible mouse zone. |
'| |
'| Status = MouseZone(Zone) |
'| |
'| - Returns the status of any type of interaction with the mouse pointer an a defined visible zone. |
'| - Status - -1 (TRUE) if mouse pointer interaction with Zone, 0 (FALSE) otherwise. |
'| - Zone - the mouse to check for mouse pointer interation. |
'| |
'| HideZone Zone |
'| |
'| - Hides a zone from the moue pointer. |
'| - Zone - the zone to hide the mouse from. |
'| |
'| ShowZone Zone |
'| |
'| - Reveals a mouse zone previously hidden to the mouse pointer. |
'| - Zone - the zone to reveal to the mouse pointer. |
'| |
'| TrapMouse Zone |
'| |
'| - Traps a mouse pointer within the confines of a defined mouse zone. |
'| - Zone - the zone to trap the mouse pointer in. |
'| |
'| FreeMouse |
'| |
'| - Frees a trapped mouse from within any mouse zone. |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| --------------------------------------------------------------- |
'| The following functions return the status of the mouse buttons: |
'| --------------------------------------------------------------- |
'| |
'| AnyClick - returns -1 (TRUE) when the left, middle, or right button is clicked. |
'| AnyDoubleClick - returns -1 (TRUE) when the left, middle, or right button is double clicked. |
'| Click - returns -1 (TRUE) when the left button is clicked (same as LeftClick). |
'| DoubleClick - returns -1 (TRUE) when the left button is double clicked (same as LeftDoubleClick). |
'| LeftClick - returns -1 (TRUE) when the left button is clicked. |
'| LeftDoubleClick - returns -1 (TRUE) when the left button is double clicked. |
'| RightClick - returns -1 (TRUE) when the right button is clicked. |
'| RightDoubleClick - returns -1 (TRUE) when the right button is double clicked. |
'| MiddleClick - returns -1 (TRUE) when the middle button is clicked. |
'| MiddleDoubleClick - returns -1 (TRUE) when the middle button is double clicked. |
'| AnyHold - Returns -1 (TRUE) when the left, middle, or right button is held down. |
'| ClickAndHold - returns -1 (TRUE) when the left button is held down (same as LeftHold). |
'| LeftHold - returns -1 (TRUE) when the left button is held down. |
'| MiddleHold - returns -1 (TRUE) when the middle button is held down. |
'| RightHold - returns -1 (TRUE) when the right button is held down. |
'| MouseWheel - returns the cumulative result of mouse wheel turns from the previous mouse update to the current mouse update. |
'|___________________________________________________________________________________________________________________________________________________|
'| |
'| --------------------------------------------------------------------------- |
'| The following functions return the status of the mouse pointer coordinates: |
'| --------------------------------------------------------------------------- |
'| |
'| MouseX - the current x coordinate location of the mouse pointer. |
'| MouseY - the current y coordinate location of the mouse pointer. |
'| MousePreviousX - the x coordinate location of the mouse pointer during the previous mouse update. |
'| MousePreviousY - the y coordinate location of the mouse pointer during the previous mouse update. |
'| MouseVectorX - the x movement vector of the mouse pointer from the previous coordinate location to the current coordinate location. |
'| MouseVectorY - the y movement vector of the mouse pointer from the previous coordinate location to the current coordinate location. |
'| MouseNormalX - the normalized value of MouseVectorX (-1 to 1). |
'| MouseNormalY - the normalized value of MouseVectorY (-1 to 1). |
'| MouseAngle - the degree angle of mouse pointer movement from the previous coordinate location to the current coordinate location (0 to 359). |
'| MouseSpeed - the speed of mouse pointer movement from the previous coordinate location to the current coordinate location. |
'\___________________________________________________________________________________________________________________________________________________/
|
|
|
|
|
