I want to automate some commands in a CMD window. I need to capture output and input "only from that window" (text only in this case).
I expect this would require a third party program to help me.
My problem:
I need to repeatedly send commands to Raspberry PI's on my network. I can use SSH to remotely send commands to each PI. I can even automate some keystrokes using AUTOHOTKEY. But all this is repetitive. Very boring and time consuming. I am by nature lazy as f*ck. The torturous part it's not as simple to sending a one line ssh command. I may want to do more than one thing in that window. All requiring input and outputs, of various natures.
Why reinvent that wheel. When I am almost 100% sure someone here already found that wheel and is using it. Care to share ?
As you guys can probably tell, bplus had me digging around in old drives and such looking for 2048 (Double Up) related code, and I've ran into a lot of old junk which I thought I'd share that someone might like. Here's an old gear-clock that used to connect to the internet and get the weather and temperature and such for Steve's Place, back in the day. Unfortunately the website I used to connect to to get that info no longer exists, so it can't tell you that anymore. Now, it's just a funny looking clock, missing out on the important bits that I liked the most with it.
FunctionDrawSecondGear (Kolor As_UnsignedLong)
D = _Dest
DrawSecondGeartemp = _NewImage(640, 480, 32) _Dest DrawSecondGeartemp
OldFont = _Font
W = _Width \ 2: h = _Height \ 2
F = _LoadFont("OLDENGL.TTF", 18) If F > 0Then_Font F Else_Font16 If W > h Then R = h * .6Else R = W * .6
FH = _FontHeight \ 2 CircleFill W, h, R, Kolor Color&HFF000000, 0 For i = 0To59
X = W + R * .9 * Cos(_D2R(i * 6 - 90))
Y = h + R * .9 * Sin(_D2R(i * 6 - 90))
t$ = _Trim$(Str$(i \ 10))
tempimage = TextToImage&(t$, F, &HFF000000, 0, 0) DisplayImage tempimage, X, Y, -i * 6, 0 _FreeImage tempimage
X = W + R * .8 * Cos(_D2R(i * 6 - 90))
Y = h + R * .8 * Sin(_D2R(i * 6 - 90))
t$ = _Trim$(Str$(i Mod10))
tempimage = TextToImage&(t$, F, &HFF000000, 0, 0) DisplayImage tempimage, X, Y, -i * 6, 0 _FreeImage tempimage Next _Font OldFont 'CircleFill W, H, 10, &HFF000000 _Dest D DrawSecondGear = DrawSecondGeartemp End Function
SubCircleFill (CX AsInteger, CY AsInteger, R AsInteger, C As_UnsignedLong) ' CX = center x coordinate ' CY = center y coordinate ' R = radius ' C = fill color Dim Radius AsInteger, RadiusError AsInteger Dim X AsInteger, Y AsInteger
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0 If Radius = 0ThenPSet (CX, CY), C: Exit Sub Line (CX - X, CY)-(CX + X, CY), C, BF While X > Y
RadiusError = RadiusError + Y * 2 + 1 If RadiusError >= 0Then If X <> Y + 1Then Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF End If
X = X - 1
RadiusError = RadiusError - X * 2 End If
Y = Y + 1 Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF Wend End Sub
SubDisplayImage (Image AsLong, x AsInteger, y AsInteger, angle AsSingle, mode As_Byte) 'Image is the image handle which we use to reference our image. 'x,y is the X/Y coordinates where we want the image to be at on the screen. 'angle is the angle which we wish to rotate the image. 'mode determines HOW we place the image at point X,Y. 'Mode 0 we center the image at point X,Y 'Mode 1 we place the Top Left corner of oour image at point X,Y 'Mode 2 is Bottom Left 'Mode 3 is Top Right 'Mode 4 is Bottom Right
Dim px(3) AsInteger, py(3) AsInteger, w AsInteger, h AsInteger Dim sinr AsSingle, cosr AsSingle, i As_Byte
w = _Width(Image): h = _Height(Image) Select Case mode Case0'center
px(0) = -w \ 2: py(0) = -h \ 2: px(3) = w \ 2: py(3) = -h \ 2
px(1) = -w \ 2: py(1) = h \ 2: px(2) = w \ 2: py(2) = h \ 2 Case1'top left
px(0) = 0: py(0) = 0: px(3) = w: py(3) = 0
px(1) = 0: py(1) = h: px(2) = w: py(2) = h Case2'bottom left
px(0) = 0: py(0) = -h: px(3) = w: py(3) = -h
px(1) = 0: py(1) = 0: px(2) = w: py(2) = 0 Case3'top right
px(0) = -w: py(0) = 0: px(3) = 0: py(3) = 0
px(1) = -w: py(1) = h: px(2) = 0: py(2) = h Case4'bottom right
px(0) = -w: py(0) = -h: px(3) = 0: py(3) = -h
px(1) = -w: py(1) = 0: px(2) = 0: py(2) = 0 End Select
sinr = Sin(angle / 57.2957795131): cosr = Cos(angle / 57.2957795131) For i = 0To3
x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y
px(i) = x2: py(i) = y2 Next _MapTriangle (0, 0)-(0, h - 1)-(w - 1, h - 1), Image To(px(0), py(0))-(px(1), py(1))-(px(2), py(2)) _MapTriangle (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image To(px(0), py(0))-(px(3), py(3))-(px(2), py(2)) End Sub
FunctionTextToImage& (text$, font&, fc&, bfc&, mode As_Byte) 'text$ is the text that we wish to transform into an image. 'font& is the handle of the font we want to use. 'fc& is the color of the font we want to use. 'bfc& is the background color of the font.
'Mode 1 is print forwards 'Mode 2 is print backwards 'Mode 3 is print from top to bottom 'Mode 4 is print from bottom up 'Mode 0 got lost somewhere, but it's OK. We check to see if our mode is < 1 or > 4 and compensate automatically if it is to make it one (default).
Select Case mode Case1 'Print text forward _PrintString (0, 0), text$ Case2 'Print text backwards
temp$ = "" For i = 0ToLen(text$) - 1
temp$ = temp$ + Mid$(text$, Len(text$) - i, 1) Next _PrintString (0, 0), temp$ Case3 'Print text upwards 'first lets reverse the text, so it's easy to place
temp$ = "" For i = 0ToLen(text$) - 1
temp$ = temp$ + Mid$(text$, Len(text$) - i, 1) Next 'then put it where it belongs For i = 1ToLen(text$)
fx = (w& - _PrintWidth(Mid$(temp$, i, 1))) / 2 + .99'This is to center any non-monospaced letters so they look better _PrintString (fx, _FontHeight * (i - 1)), Mid$(temp$, i, 1) Next Case4 'Print text downwards For i = 1ToLen(text$)
fx = (w& - _PrintWidth(Mid$(text$, i, 1))) / 2 + .99'This is to center any non-monospaced letters so they look better _PrintString (fx, _FontHeight * (i - 1)), Mid$(text$, i, 1) Next End Select _Dest D Color dc&, bgc& _Font F TextToImage& = tempTextToImage& End Function
FunctionGetDay$ (mm, dd, yyyy) 'use 4 digit year 'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence If mm < 3Then mm = mm + 12: yyyy = yyyy - 1
century = yyyy Mod100
zerocentury = yyyy \ 100
result = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod7 Select Case result Case0: GetDay$ = "Saturday" Case1: GetDay$ = "Sunday" Case2: GetDay$ = "Monday" Case3: GetDay$ = "Tuesday" Case4: GetDay$ = "Wednesday" Case5: GetDay$ = "Thursday" Case6: GetDay$ = "Friday" End Select End Function
SubSafeLoadFont (font#) 'Safely loads a font without destroying our current print location and making it revert to the top left corner.
A little card game where the goal is to remove all the cards from the screen.
Game play is simple, click on a card with an open face to remove it, but doing so will FLIP the cards beside it. You can pick and choose which cards to flip (as long as they're face up), and the goal is to flip them all until you can remove them all from the screen.
Do
NumOfCards = ChooseDifficulty Shuffle For i = 1To NumOfCards DisplayCards If Result = 0ThenExit For Next If i = NumOfCards + 1ThenDisplayCards: Result = -1'flip the last card and win WinOrLose Loop
For i = 0To NumOfCards - 1 If Visible(i) = -1Then
suit = Deck(i) \ 13: value = Deck(i) Mod13 _PutImage (xstep * i, ystart)-Step(xstep, CardHigh * scale), CardImage, 0, (value * CardWide, suit * CardHigh)-Step(CardWide, CardHigh) ElseIf Visible(i) = 0Then Line (xstep * i, ystart)-Step(xstep, CardHigh * scale), White, BF Line (xstep * i + 2, ystart + 2)-Step(xstep - 4, CardHigh * scale - 4), Blue, BF Else 'We don't draw squat. The card has been removed from play End If Next
Result = 0 For i = 0To NumOfCards - 1 If Visible(i) < 0Then Result = -1: Exit For'there's still visible cards to play with Next If Result = 0ThenExit Sub
oldmouse = -1'cycle one to make certain mouse is up before we count a down event Do While_MouseInput: Wend
mb = _MouseButton(1) If oldmouse = 0And mb Then If_MouseY >= ystart And_MouseY <= ystart + CardHigh * scale Then'we're in the right rows for a valid mouse click
choice = _MouseX \ xstep If choice >= 0And choice <= NumOfCards And Visible(choice) = -1Then finished = -1 End If End If
oldmouse = mb _Limit30 Loop Until finished
Visible(choice) = 1 If choice > 0Then If Visible(choice - 1) < 1Then Visible(choice - 1) = Not Visible(choice - 1) End If If choice < NumOfCards Then If Visible(choice + 1) < 1Then Visible(choice + 1) = Not Visible(choice + 1) End If End Sub
RegisterToolTip"Cheese is tasty and made from moo moo cows!", 245, 100 RegisterToolTip"A fridge is the cold thing which folks hold their cheeses in!", 380, 100 Do Cls _PrintString (100, 100), "People like cheese in their fridge ." While_MouseInput: Wend DisplayToolTips _Limit30'don't melt my damn CPU _Display Loop Until_KeyDown(27)
SubRegisterToolTip (what$, x, y) If what$ = ""ThenExit Sub'can't register nothing If x < 0Or y < 0ThenExit Sub'don't put your tooltip off the damn screen! If x > _Width - _FontWidthOr y > _Height - _FontHeightThenExit Sub'honestly, I say, don't put your tooltip off the damn screen! For i = 1To100 If RegisteredTips(i).text = ""Then'it's a free tooltip spot
RegisteredTips(i).text = what$
RegisteredTips(i).x = x
RegisteredTips(i).y = y Exit Sub'We're done. We've registered! End If Next 'If we make it to here, we failed. Some dummy probably has more than 100 tooltips, or else they registered them inside a loop, or such. '(Note, this dummy could be your's truly...) End Sub
SubFreeToolTip (x, y) For i = 1To100 If RegisteredTips(i).x = x And RegisteredTips(i).y = y Then'it's a free tooltip spot
RegisteredTips(i).text = ""
RegisteredTips(i).x = -1
RegisteredTips(i).y = -1 Exit Sub'We're done. We've registered! End If Next End Sub
ip$ = GetPublicIP$ Print"Your IP Address is:"; ip$ Print Lat_Long ip$, lat, lon Print"Your Latitude and Longitude is: "; lat, lon Print Print"For your location, the following is true for Xmas day:" SunStuff lat, lon, 12, 25, 2020
Dim m As_MEM, m1 As_MEM
m = _MemImage(0) 'a memblock pointing to our screen
m1 = _MemNew(Len(temp1$) / 2) 'a memblock to hold the data HexToMem temp1$, m1 'unhex it back to a memblock
temp$ = Space$(m1.SIZE) _MemGet m1, m1.OFFSET, temp$ 'get the unhexed data into a string to hold the unhexed, but still compressed data _MemPut m, m.OFFSET, _Inflate$(temp$) 'put that uncompressed image onto the screen. Sleep
For a project I need to store an array of variable length strings.
Let's say
Code: (Select All)
Dim Shared as String s(100000)
But the issue is that the string lengths could vary from several bytes up to 2 GB
Code: (Select All)
For i% = 1 To 100
s(i%) = String$(100000000, 42) ' 100MB
Next i%
As soon as the arrays total size is above a couple of GB it aborts the program...
I'd like to find a way to make max use of internal memory (>=32GB)
What would be the best approach to define this?
I think _Mem is not very suitable for variable length strings
I could do one big _Mem and keep track of indexes/blocks but that's complicating the code quite a bit
Any better suggestions?
Did you ever notice there are 32 symbols on the standard 102-key natural keyboard and only 1 can be used in a variable name!?
Code: (Select All)
Rem all 32 symbolic characters.
'dim x~.a as inetegr
'dim x.a` as intrger
'dim x!.a as integer
'dim x@.a as integer
'dim x#.a as integer
'dim x$.a as integer
'dim x%.a as integer
'dim x^.a as integer
'dim x&.a as integer
'dim x*.a as integer
'dim x(.a as integer
'dim x).a as integer
'dim x_.a as integer
'dim x-.a as integer
'dim x+.a as integer
'dim x=.a as integer
'dim x|.a as integer
'dim x\.a as integer
'dim x{.a as integer
'dim x[.a as integer
'dim x}.a as integer
'dim x].a as integer
'dim x:.a as integer
'dim x;.a as integer
'dim x".a as integer
'dim x<.a as integer
'dim x,.a as integer
'dim x>.a as integer
'dim x'.a as integer
Dim x.a As Integer
'dim x?.a as integer
'dim x/.a as integer
Posted by: Dav - 10-17-2024, 02:19 AM - Forum: Games
- Replies (42)
Classic 2048 game. Use arrows to move numbers. Goal is to combine same numbers until a 2048 number is made.
Still working on this, but it's fully playable already. Lots of code bloat. I need to rethink how I'm handling/drawing the board. I didn't want to post this version now, but my wrist is starting to bother me a little from too much coding and piano gigs lately, so I'm going to rest from coding for a while and post this as is. Will pick it up a later time.
'Use arrow keys to move numbers on board.
'Score is shown in title bar.
'ESC quits
Screen _NewImage(800, 800, 32)
ReDim Shared board(3, 3), flash(3, 3), score
GetNewNumber
GetNewNumber
Do
DrawBoard
If MovesLeft = 0 Then
Rbox 150, 150, 650, 450, 30, _RGBA(0, 0, 0, 150), 1
Rbox 150, 150, 650, 450, 30, _RGBA(255, 255, 255, 255), 0
Text 200 + 2, 200 + 2, 60, _RGB(0, 0, 0), "NO MORE MOVES!"
Text 200, 200, 60, _RGB(255, 255, 255), "NO MORE MOVES!"
Text 200 + 2, 300 + 2, 60, _RGB(0, 0, 0), "SCORE:" + _Trim$(Str$(score))
Text 200, 300, 60, _RGB(255, 255, 255), "SCORE:" + _Trim$(Str$(score))
_Display: Beep: _Delay 3: Exit Do
End If
Do
key$ = InKey$
_Limit 30
Loop Until key$ <> ""
Select Case key$
Case Chr$(0) + "K": DoLeft 'left arrow
Case Chr$(0) + "M": DoRight 'right arrow
Case Chr$(0) + "H": DoUp 'up arrow
Case Chr$(0) + "P": DoDown 'down arrow
End Select
_KeyClear
GetNewNumber
Loop Until key$ = Chr$(27)
Sleep
End
Sub GetNewNumber
'=== get a list of places to make a number
ReDim temp(15)
c = 0
For x = 0 To 3
For y = 0 To 3
If board(x, y) = 0 Then
temp(c) = x * 4 + y
c = c + 1
End If
Next
Next
'=== choose one place to make a number
If c > 0 Then
i = Int(Rnd * c)
If Rnd < .8 Then
DrawBoard
x1 = Int(temp(i) / 4): y1 = temp(i) Mod 4
For s = 100 To 0 Step -20
Rbox (x1 * 200) + s, (y1 * 200) + s, ((x1 * 200) + 200) - s, ((y1 * 200) + 200) - s, 30, _RGB(239, 229, 218), 1
_Display
_Delay .025
Next
board(x1, y1) = 2
Else
DrawBoard
x1 = Int(temp(i) / 4): y1 = temp(i) Mod 4
For s = 100 To 0 Step -20
Rbox (x1 * 200) + s, (y1 * 200) + s, ((x1 * 200) + 200) - s, ((y1 * 200) + 200) - s, 30, _RGB(239, 229, 218), 1
_Display
_Delay .025
Next
board(x1, y1) = 4
End If
End If
End Sub
Sub DrawBoard
Cls , _RGB(187, 173, 160)
Color _RGB(255, 255, 255)
For x = 0 To 3
For y = 0 To 3
Select Case board(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
If flash(x, y) <> 0 Then
'skip for now
Else
Rbox x * 200 + 5, y * 200 + 5, (x * 200) + 200 - 5, (y * 200) + 200 - 5, 30, bg&, 1
Rbox x * 200 + 5, y * 200 + 5, (x * 200) + 200 - 5, (y * 200) + 200 - 5, 30, _RGB(255, 255, 255), 0
If board(x, y) > 0 Then
num$ = _Trim$(Str$(board(x, y)))
If Val(num$) < 8 Then fg& = _RGB(128, 128, 128) Else fg& = _RGB(255, 255, 255)
size = 200 / 2: ts = size: tx = size / 2 + (size / 4): ty = size / 2
Select Case Len(num$)
Case 2: tx = size / 2: ty = size / 2
Case 3: ts = 200 / 2.5: tx = size / 2.5: ty = size / 1.75
Case 4: ts = 200 / 3: tx = size / 3: ty = size / 1.50
Case 5: ts = 200 / 3.5: tx = size / 3.5: ty = size / 1.36
End Select
Text x * 200 + tx + 2, y * 200 + ty + 2, ts, _RGB(0, 0, 0), num$
Text x * 200 + tx, y * 200 + ty, ts, fg&, num$
End If
End If
Next
Next
'do flash board
For s = 100 To 0 Step -20
For x = 0 To 3
For y = 0 To 3
If flash(x, y) <> 0 Then
Select Case flash(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
Rbox (x * 200) + s, (y * 200) + s, ((x * 200) + 200) - s, ((y * 200) + 200) - s, 30, bg&, 1
End If
Next
Next
_Display
_Delay .025
Next
'do regular board next
For x = 0 To 3
For y = 0 To 3
Select Case board(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
Rbox x * 200 + 5, y * 200 + 5, (x * 200) + 200 - 5, (y * 200) + 200 - 5, 30, bg&, 1
Rbox x * 200 + 5, y * 200 + 5, (x * 200) + 200 - 5, (y * 200) + 200 - 5, 30, _RGB(255, 255, 255), 0
If board(x, y) > 0 Then
num$ = _Trim$(Str$(board(x, y)))
If Val(num$) < 8 Then fg& = _RGB(128, 128, 128) Else fg& = _RGB(255, 255, 255)
size = 200 / 2: ts = size: tx = size / 2 + (size / 4): ty = size / 2
Select Case Len(num$)
Case 2: tx = size / 2: ty = size / 2
Case 3: ts = 200 / 2.5: tx = size / 2.5: ty = size / 1.75
Case 4: ts = 200 / 3: tx = size / 3: ty = size / 1.50
Case 5: ts = 200 / 3.5: tx = size / 3.5: ty = size / 1.36
End Select
Text x * 200 + tx + 2, y * 200 + ty + 2, ts, _RGB(0, 0, 0), num$
Text x * 200 + tx, y * 200 + ty, ts, fg&, num$
End If
Next
Next
For y = 0 To 3
ReDim row(3)
p = 0
For x = 0 To 3
If board(x, y) <> 0 Then
If row(p) = board(x, y) Then
row(p) = row(p) + board(x, y)
score = score + row(p)
flash(p, y) = row(p) '+ board(x, y)
p = p + 1
ElseIf row(p) = 0 Then
row(p) = board(x, y)
Else
p = p + 1
If p < 4 Then row(p) = board(x, y)
End If
End If
Next
For x = 0 To 3
board(x, y) = row(x)
Next
Next
End Sub
Sub DoRight
ReDim flash(3, 3)
For y = 0 To 3
ReDim row(3)
p = 3
For x = 3 To 0 Step -1
If board(x, y) <> 0 Then
If row(p) = board(x, y) Then
row(p) = row(p) + board(x, y)
score = score + row(p)
flash(p, y) = row(p)
p = p - 1
ElseIf row(p) = 0 Then
row(p) = board(x, y)
Else
p = p - 1
If p >= 0 Then
row(p) = board(x, y)
End If
End If
End If
Next
For x = 0 To 3
board(x, y) = row(x)
Next
Next
End Sub
Sub DoUp
ReDim flash(3, 3)
For x = 0 To 3
ReDim col(3)
p = 0
For y = 0 To 3
If board(x, y) <> 0 Then
If col(p) = board(x, y) Then
col(p) = col(p) + board(x, y)
score = score + col(p)
flash(x, p) = col(p)
p = p + 1
ElseIf col(p) = 0 Then
col(p) = board(x, y)
Else
p = p + 1
If p < 4 Then col(p) = board(x, y)
End If
End If
Next
For y = 0 To 3
board(x, y) = col(y)
Next
Next
End Sub
Sub DoDown
ReDim flash(3, 3)
For x = 0 To 3
ReDim col(3)
p = 3
For y = 3 To 0 Step -1
If board(x, y) <> 0 Then
If col(p) = board(x, y) Then
col(p) = col(p) + board(x, y)
score = score + col(p)
flash(x, p) = col(p)
p = p - 1
ElseIf col(p) = 0 Then
col(p) = board(x, y)
Else
p = p - 1
If p >= 0 Then col(p) = board(x, y)
End If
End If
Next
For y = 3 To 0 Step -1
board(x, y) = col(y)
Next
Next
End Sub
Function MovesLeft
MovesLeft = 0
For x = 0 To 3
For y = 0 To 3
If board(x, y) = 0 Then
MovesLeft = 1
End If
If y < 3 Then
If board(x, y) = board(x, y + 1) Then
MovesLeft = 1
End If
End If
If x < 3 Then
If board(x, y) = board(x + 1, y) Then
MovesLeft = 1
End If
End If
Next
Next
End Function
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
'Text SUB by bplus.
Dim fg As _Unsigned Long, cur&, I&, multi, xlen
fg = _DefaultColor
cur& = _Dest
I& = _NewImage(8 * Len(txt$), 16, 32)
_Dest I&
Color K, _RGBA32(0, 0, 0, 0)
_PrintString (0, 0), txt$
multi = textHeight / 16
xlen = Len(txt$) * 8 * multi
_PutImage (x, y)-Step(xlen, textHeight), I&, cur&
Color fg
_FreeImage I&
_Dest cur&
End Sub
Sub Rbox (x1, y1, x2, y2, r, clr~&, fill)
'x1/y1, y2/y2 = placement of box
'r = radius of rounded corner
'clr~& = color of box
'fill = 1 for filled, 0 for just an edge
ReDim filled(_Width + x2, _Height + y2) As Integer
If fill = 1 Then
Line (x1 + r + 1, y1)-(x2 - r - 1, y1 + r), clr~&, BF 'top
Line (x1 + r + 1, y2 - r)-(x2 - r - 1, y2), clr~&, BF 'bottom
Line (x1, y1 + r + 1)-(x1 + r, y2 - r - 1), clr~&, BF 'left
Line (x2 - r, y1 + r + 1)-(x2, y2 - r - 1), clr~&, BF 'right
Line (x1 + r + 1, y1 + r + 1)-(x2 - r - 1, y2 - r - 1), clr~&, BF 'middle
Else
Line (x1 + r, y1)-(x2 - r, y1), clr~& 'top
Line (x1 + r, y2)-(x2 - r, y2), clr~& 'bottom
Line (x1, y1 + r)-(x1, y2 - r), clr~& 'left
Line (x2, y1 + r)-(x2, y2 - r), clr~& 'right
End If
'top left corner
For angle = 180 To 270
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'top right corner
For angle = 270 To 360
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom left corner
For angle = 90 To 180
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom right corner
For angle = 0 To 90
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
