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: 764
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,262
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 316
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
Skipping within a For Loop |
Posted by: Dimster - 10-23-2022, 03:38 PM - Forum: Help Me!
- Replies (26)
|
|
Logically the answer to my question here is NO but embarrassment from asking stupid coding questions is my Forte.
When you have a loop control range, can you skip a specific step within the range? So for example the For Loop is
For x = 50 to -50
if x = 0 then next
Next
or if there may be a couple within the controlled range is there a way to
For x = 50 to -50
if x = 10 or x = 0 or x = -10 then Next
Next
Thanks
|
|
|
ASCII scrollable list with mouse |
Posted by: TempodiBasic - 10-23-2022, 07:35 AM - Forum: Programs
- Replies (4)
|
|
Hi QB64 Fan Community
here a perfectable demo of a Vertical Scrolling List in ASCII mode
Code: (Select All) 'ASCII scrollbar output Demo
Dim Num(1 To 100), First As Integer, Last As Integer, Selected As Integer
Dim Stopp, MB1, MB2, Max, MY, MX
Max = 100
For a = 1 To Max
Num(a) = a * 10
Next
_MouseMove 10, 10
First = 1: Last = 15: Selected = First + 4
While Stopp = 0
While _MouseInput: Wend
MB1 = _MouseButton(1)
MB2 = _MouseButton(2)
MY = _MouseX 'column
MX = _MouseY 'row
If MB1 Then
If Chr$(Screen(MX, MY, 0)) = "Ý" Then ' if leftmousebuttonclick is on the scrollingbar
If MX > (Selected Mod 16) Then ' if mouseclick below selected item it scrolls down
Selected = Selected + 5
If Selected > Last Then ' if scrolling Selected goes below LastitemShown it adjourns pointers of listToShow
First = Selected
Last = First + 15
If Last > Max Then Last = Max - Selected + 1 ' if lastItemShown is more than LastItemList it adjourns pointer of listToShow
End If
Else 'if mouseclick over selected item it scrolls up
Selected = Selected - 5
If Selected < First Then
First = Selected
Last = First + 15
If Selected < 1 Then ' if scrolling up selected goes over FirstItemShown it adjourns pointer of ListToShow
First = 1
Selected = 1
Last = First + 15
End If
End If
End If
End If
If Chr$(Screen(MX, MY, 0)) = "Û" Then ' if leftMouseClick is on ruler of scrollingBar
Do While _MouseInput: Loop ' it waits that MouseInput stops
If MX > _MouseY Then
' if actual vertical position of mouse is less than previous the ruler has been brought up
Selected = Selected - 1
If Selected < 1 Then
First = 1
Selected = 1
Last = First + 15
End If
Else ' if actual vertical position of mouse is more than previous ther ruler has been brought down
Selected = Selected + 1
If Selected > Last Then
First = Selected
Last = Selected + 15
If Last > Max Then Last = Max - Selected
End If
End If
End If
End If
If MB2 Then Stopp = 1
Do While _MouseInput: Loop ' it waits that MouseInput stops
Cls
For a = First To Last
If a = Selected Then Color 14, 1
Print Num(a); Space$(5 - Len(LTrim$(Str$(a))));
If a = Selected Then Print "Û" Else Print "Ý"
Color 7, 0
Next
_Limit 5
Wend
End
It's a start and can be expanded to support mouse Drag & Drop, Keyboard shortcuts, and moreover the customizable setting (i.e. how many rows to show on screen, position on the screen, colors for text and background).
Moreover it can become a function that return the selected item.
|
|
|
Program Real Line Counter. Anyone want to jump in? |
Posted by: Pete - 10-22-2022, 08:10 PM - Forum: Works in Progress
- Replies (35)
|
|
Mark asked about this, so I thought I whip up a little something to find out how many real line numbers are in a program. By real line numbers I'm talking about excluding spaces, but adding a line number count for the proper use of colons to separate statements on a single line.
I haven't goof proofed this yet, but I was hoping before going any further I could get some feedback or if anyone would like to modify it, etc. that's fine too. It might be fun for contests, etc. to have an "OFFICIAL" (ha ha) QB64 program line counter.
So basically it roots out trailing colons, REM statements with colons, both ' and REM, and any colons enclosed in quotes like PRINT statements. Did I miss anything? For instance, this routine counts...
CASE 1: PRINT "foo"
That colon is counted as an extra line.
CASE 1
PRINT "foo"
If you think more conditions apply, it might be easy to add in the select case portion.
To try, just copy a forum post program or IDE program to the clipboard and run this code.
Code: (Select All) PRINT "Line count analysis...": PRINT
x$ = _CLIPBOARD$
DO
' parse clipboard
statement$ = UCASE$(MID$(x$, 1, INSTR(x$, CHR$(13)) - 1))
x$ = MID$(x$, INSTR(x$, CHR$(10)) + 1)
IF LEN(_TRIM$(statement$)) THEN
program_ide_lines = program_ide_lines + 1
FOR i = 1 TO 3
SELECT CASE i
CASE 1: mychr$ = CHR$(34)
CASE 2: mychr$ = "'"
CASE 3: mychr$ = "REM"
END SELECT
SELECT CASE i
CASE 1 ' Double polling for enclosed quotes.
DO UNTIL INSTR(statement$, mychr$) = 0
IF INSTR(statement$, mychr$) THEN
statement$ = MID$(statement$, 1, INSTR(statement$, mychr$) - 1) + MID$(statement$, INSTR(INSTR(statement$, mychr$) + 1, statement$, mychr$) + 1)
END IF
LOOP
CASE ELSE
DO UNTIL INSTR(statement$, mychr$) = 0
IF INSTR(statement$, mychr$) THEN
statement$ = MID$(statement$, 1, INSTR(statement$, mychr$) - 1)
END IF
LOOP
END SELECT
NEXT
IF RIGHT$(RTRIM$(statement$), 1) = ":" THEN statement$ = MID$(RTRIM$(statement$), 1, LEN(RTRIM$(statement$)) - 1)
REM PRINT statement$,
' count colons
seed% = 0: linecnt = linecnt + 1: real_line_cnt = real_line_cnt + 1
DO UNTIL INSTR(seed%, statement$, ":") = 0
seed% = INSTR(seed%, statement$, ":") + 1
real_line_cnt = real_line_cnt + 1
LOOP
ELSE
program_ide_lines = program_ide_lines + 1
END IF
IF INSTR(x$, CHR$(10)) = 0 THEN myexit = myexit + 1
LOOP UNTIL myexit = 2
PRINT "Program IDE lines ="; program_ide_lines; " Line count ="; linecnt; " Real line count ="; real_line_cnt
Pete
|
|
|
QB64PE Winter/Christmas Banner Contest! |
Posted by: SMcNeill - 10-22-2022, 12:43 PM - Forum: General Discussion
- Replies (39)
|
|
Well guys, here's something which I'd been wanting to do for a while, that I unfortunately hadn't been able to implement due to the state of my health and having to prepare and undergo the open-heart surgery that I went though -- a banner contest for our forums!
Not everyone likes what we have at the top of the screen -- (I know! I know! Some peoples are krazy!) -- so nows their chance to attempt to replace it with something they'd like better for the holidays! It's too late to design and vote on a Halloween theme for this year, and by the time people got their designs and voting in, a Thanksgiving theme would just about be outdated, so what folks will be designing and competing over is a CHRISTMAS THEME BANNER for the QB64 Phoenix Edition Forums!
Rules are simple:
1) Design a banner which represents the winter/Christmas spirit and QB64PE.
2) Share your banner in a new topic where everyone can find it and see and comment on your great work.
3) Work is editable, changeable until November 16, when all calls for official entries will be finalized.
4) Starting from November 17th until November 24th, all registered users will have a chance to log in and vote on what they think is the best banner for us.
5) On November 25th (the day after Thanksgiving), our banner will change to become the one created and chosen by our users!!
NOTE: The current banner is 1400x256 in size, and is formatted so that the background is transparent, with both a black and white highlight around the logos and letters. This is so that no matter which forum theme the end user decides to use, everything stays visible and pops out nicely. Replacement banners will be temporary and don't *have* to follow this spirit of obsessive inclusivity, but they should end up being the same size for ease of plugging in and replacing the old banner, without admin having to go in and twiddle with any settings elsewhere to make it fit and interact properly.
|
|
|
using the clipboard for communicatign between programs |
Posted by: James D Jarvis - 10-22-2022, 03:05 AM - Forum: Programs
- Replies (13)
|
|
a simple example of using the clipboard to communicate between programs.
This example requires three programs Clipmaster ,cliptalk1, and cliptalk2.
Compile all three and save them in the same directory to see how this works.
I almost certainly lifted the idea from somewhere else but I can't recall where, sorry if I'm failing to give proper credit.
Clipmaster
Code: (Select All) 'Clipmaster
'clipboard communication sample
'
'CTA talk to all the cliptalk programs
'CT1 talk to cliptalk1
'CT2 talk to cliptalk2
'QUITALL ends all the programs
_Title "CLIPMaster"
Shell _DontWait "cliptalk1.exe /RUN"
Shell _DontWait "cliptalk2.exe /RUN"
Do
Line Input "Enter some text to send to other program: ", text$
If text$ = "QUITALL" Then Exit Do
If UCase$(text$) = "CLEAR" Then _Clipboard$ = ""
_Clipboard$ = text$
Loop
_Clipboard$ = "CTAQUITALL"
System
Cliptalk1
Code: (Select All) 'cliptalk1
Screen _NewImage(40, 20, 0)
_Title "CLIPTALK1"
Print "Reading text from clipboard."
Print " Esc key quits!"
MYID$ = "CT1"
Do: _Limit 100
text$ = _Clipboard$ 'function returns clipboard contents
If Len(text$) And text$ <> lasttext$ Then
If text$ = "CTAQUITALL" Then GoTo QEXIT
If Left$(UCase$(text$), 3) = "CTA" Then lasttext$ = text$
If Left$(UCase$(text$), 3) = MYID$ Or Left$(UCase$(text$), 3) = "CTA" Then
tt$ = Left$(UCase$(text$), 3)
text$ = Right$(text$, Len(text$) - 3)
Print text$
If tt$ = MYID$ Then _Clipboard$ = "" 'clear clipboard after a read
End If
End If
Loop Until InKey$ = Chr$(27)
QEXIT:
System
End
cliptalk2
Code: (Select All) 'cliptalk2
Screen _NewImage(40, 20, 0)
_Title "CLIPTALK2"
Color 0, 15
Cls
Print "Reading text from clipboard."
Print " Esc key quits!"
MYID$ = "CT2"
Do: _Limit 100
text$ = _Clipboard$ 'function returns clipboard contents
If Len(text$) And text$ <> lasttext$ Then
If Left$(UCase$(text$), 3) = "CTA" Then lasttext$ = text$
If text$ = "CTAQUITALL" Then GoTo QEXIT
If Left$(UCase$(text$), 3) = MYID$ Or Left$(UCase$(text$), 3) = "CTA" Then
tt$ = Left$(UCase$(text$), 3)
text$ = Right$(text$, Len(text$) - 3)
Print text$
If tt$ = MYID$ Then _Clipboard$ = "" 'clear clipboard after a read
End If
End If
Loop Until InKey$ = Chr$(27)
QEXIT:
System
End
|
|
|
Shadowing |
Posted by: MasterGy - 10-21-2022, 06:31 PM - Forum: MasterGy
- Replies (15)
|
|
Back when I made the "tree house" game, a few years ago. It's 3D and you can only walk around. At that time, I remember Galleon rewrote the program and added something to the display part to shade the textures. Everything got darker in proportion to the distance. I didn't understand then. I looked for the code, but I couldn't find it, and the old forum is not available. Since then, I have solved the distance-proportional darkening of games by generating lots of textures. That's a lot of memory, and it doesn't work on a large surface, because if one vertex of a triangle is close to you and another vertex is far away, then what shade should it get? So it's only good for displaying small textures.
In the past few days, I've been thinking about how Galleon solved the problem of placing a texture of any size on the screen in any way. Then he told me that a black mask with an alpha distance proportional to the texture should be drawn. That's when I understood that by switching _depthbuffer on and off, it can be solved by dragging the alpha texture after each texture. And I understood why I didn't use it then. Very good, fast, practical, only switching the z-buffer on and off slows down the program significantly.
I was wondering how it could be solved without switching on the z-buffer.
Suppose _maptriangle gets a 3d point. be x,y,z. it should be 20,10,30. This point in the plane will be where, for example, 200,100,300 or 2,1,3 or 40,20,60. This simple realization helped. Simply, after drawing the texture, x,y,z must be multiplied by 0.999999, and then the mask can be drawn on it. That way, you don't have to switch on the z-buffer.
I thank Galleon several times already! If it doesn't show it then, I won't think about how it could be operated faster.
Code: (Select All) picture$ = "" '<-------- enter an image or leave the field blank
'texture
If _FileExists(picture$) Then
text = _LoadImage(picture$, 33)
Else
temp = _NewImage(1, 1, 32): _Dest temp: Cls , _RGB32(255, 255, 255): text = _CopyImage(temp, 33): _FreeImage temp
End If
'window
monx = 800: mony = Int(monx / _DesktopWidth * _DesktopHeight): monm = monx * .008: mon = _NewImage(monx, mony, 32): Screen mon: _FullScreen: _DisplayOrder _Hardware , _Software
Const pip180 = 3.141592 / 180
Dim Shared me(9), cosrotz, sinrotz, cosrotx, sinrotx, sinrot_cs, cosrot_cs
'cube locations, sizes
Randomize Timer
cube_res = 1000: cube_deep = 1000
temp = _NewImage(cube_res - 1, cube_deep - 1, 32): _Dest temp: For t = 0 To cube_res - 1: For t2 = 0 To cube_deep - 1
PSet (t, t2), _RGBA32(0, 0, 0, Int(255 / (cube_deep - 1) * t2) - 3)
Next t2, t: cube_text = _CopyImage(temp, 33): _FreeImage temp
'mask distance behind texture
Dim shdw_m(15000): For t = 0 To 15000: shdw_m(t) = Interpolate(.999, .97, 1 / 15000 * t): Next t
mapdim = 1000
'make cubes
obj_c = 200
Dim obj(obj_c - 1, 9): _Source deep_text: For t = 0 To obj_c - 2: For t2 = 0 To 2: obj(t, t2) = mapdim * Rnd: obj(t, t2 + 3) = 10 + 40 * Rnd: Next t2, t
For t = 0 To 2: obj(obj_c - 1, 3 + t) = mapdim / 2: obj(obj_c - 1, t) = mapdim / 2: Next t
For t = 0 To 2: me(t) = mapdim / 2: Next t: light = .2: me(4) = -.2: ut_me4 = -.2: ylook_limit = 80 'radian
_Dest mon
Locate 1, 1: Print "moving:WASD looking:mouse light adjust : mousewheel"
Dim p(3, 2), p2(3, 2), pc(7, 9)
Do: _Limit 30
'control
mouse_sens_xy = .01: mouse_sens_z = .01
mousex = 0: mousey = 0: mousew = 0: While _MouseInput: mousex = mousex + _MouseMovementX: mousey = mousey + _MouseMovementY: mousew = mousew + _MouseWheel: Wend
me(3) = me(3) + mousex * mouse_sens_xy: me(4) = me(4) + mousey * mouse_sens_z
ylook_deg = ((me(4) / pip180) + 90): If Abs(ylook_deg) > ylook_limit Then me(4) = ut_me4 Else ut_me4 = me(4)
rot_cs = (rot_cs + mousex * .001 * Abs(Sin(me(4)))) * .9
light = light - mousew * 0.005: If light < 0 Then light = 0 Else If light > 1 Then light = 1
Locate 2, 1: Print "light:"; Int(light * 100); "% "
position_speed = 5
kw = _KeyDown(119): ks = _KeyDown(115): ka = _KeyDown(97): kd = _KeyDown(100): new_direction = (Abs(ka Or kd Or kw) Or -Abs(ks)) * position_speed
deg_XY = -90 * Abs(ka) + 90 * Abs(kd): szog_xy = me(3) + deg_XY * pip180: szog_z = me(4)
me(0) = me(0) - Sin(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(1) = me(1) - Cos(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(2) = me(2) - Cos(szog_z + _Pi) * new_direction
cosrotz = Cos(me(3)): sinrotz = Sin(me(3)): cosrotx = Cos(me(4)): sinrotx = Sin(me(4)): cosrot_cs = Cos(rot_cs): sinrot_cs = Sin(rot_cs) 'to rotating angles
'draw cubes
px1 = cube_res / 2: px2 = cube_res - 2
dl = cube_deep - 3: c_dis = Interpolate(50, 2500, light): temp = cube_deep / c_dis
For a_obj = 0 To obj_c - 1: For t = 0 To 7
For t2 = 0 To 2: pc(t, t2) = (obj(a_obj, 3 + t2) * (Sgn(t And 2 ^ t2) * 2 - 1) + (obj(a_obj, t2) - me(t2))): Next t2
rotate pc(t, 0), pc(t, 1), pc(t, 2)
pc(t, 3) = Sqr(pc(t, 0) * pc(t, 0) + pc(t, 1) * pc(t, 1) + pc(t, 2) * pc(t, 2))
sm = shdw_m(Abs(Int(pc(t, 2))))
For t2 = 0 To 2: pc(t, 4 + t2) = pc(t, t2) * sm: Next t2
Next t
For t = 0 To 5: For t2 = 0 To 3: side(t2) = Val(Mid$("024623673175105445670123", 1 + t * 4 + t2, 1)): For t3 = 0 To 2: p(t2, t3) = pc(side(t2), t3): p2(t2, t3) = pc(side(t2), t3 + 4): Next t3, t2
'texture
_MapTriangle (0, 0)-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(0, 0), p(0, 1), p(0, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
_MapTriangle (_Width(text), _Height(text))-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(3, 0), p(3, 1), p(3, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
'shadow mask
For t2 = 0 To 3: py(t2) = Int(temp * pc(side(t2), 3)): If py(t2) > dl Then py(t2) = dl
Next t2
_MapTriangle (1, py(0))-(px1, py(1))-(px2, py(2)), cube_text To(p2(0, 0), p2(0, 1), p2(0, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
_MapTriangle (1, py(3))-(px1, py(1))-(px2, py(2)), cube_text To(p2(3, 0), p2(3, 1), p2(3, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
Next t, a_obj
_Display
Loop
Function Interpolate (a, b, x): Interpolate = a + (b - a) * x: End Function
Sub rotate (px, py, pz2): px3 = px * cosrotz - py * sinrotz: py2 = px * sinrotz + py * cosrotz: py3 = py2 * cosrotx - pz2 * sinrotx: pz3 = py2 * sinrotx + pz2 * cosrotx
px4 = px3 * cosrot_cs - py3 * sinrot_cs: py4 = px3 * sinrot_cs + py3 * cosrot_cs: px = -px4: py = -py4: pz2 = -pz3: End Sub
|
|
|
Referencing variables via pointers |
Posted by: SMcNeill - 10-21-2022, 03:49 PM - Forum: Works in Progress
- Replies (8)
|
|
A little proof of concept method for a bigger program that I'm playing around with, which allows us to reference variables by offset rather than by name.
Code: (Select All) Dim foo As Integer
Dim foo2 As _Unsigned _Byte
Dim foo3 As Long
Print foo, foo2, foo3
ToggleVar _Offset(foo), Len(foo)
ToggleVar _Offset(foo2), Len(foo2)
ToggleVar _Offset(foo3), Len(foo3)
Print foo, foo2, foo3
ToggleVar _Offset(foo), Len(foo)
ToggleVar _Offset(foo2), Len(foo2)
ToggleVar _Offset(foo3), Len(foo3)
Print foo, foo2, foo3
Sub ToggleVar (variable_offset As _Offset, variable_size As _Byte)
Static m As _MEM
m = _Mem(variable_offset, variable_size)
Select Case variable_size
Case 1
temp%% = _MemGet(m, m.OFFSET, _Byte)
_MemPut m, m.OFFSET, Not temp%% As _BYTE
Case 2
temp% = _MemGet(m, m.OFFSET, Integer)
_MemPut m, m.OFFSET, Not temp% As INTEGER
Case 4
temp& = _MemGet(m, m.OFFSET, Long)
_MemPut m, m.OFFSET, Not temp& As LONG
Case 8
temp&& = _MemGet(m, m.OFFSET, _Integer64)
_MemPut m, m.OFFSET, Not temp&& As _INTEGER64
End Select
End Sub
Take a moment and be certain to notice that these are 3 different type variables all being processed and altered via the same SUB.
|
|
|
Drop Down Menu |
Posted by: Dimster - 10-21-2022, 03:29 PM - Forum: Help Me!
- Replies (7)
|
|
Here is a bare bones of a drop down menu which I have been using. I have had to use a Slowing value to smooth out the speed at which the drop down occurs. I was wondering if there might be a better way to control the speed.
Cls
Screen _NewImage(1200, 900, 32)
Dim Shared DarkGreen&
Dim Shared Yellow&
Dim Shared Pink&
DarkGreen& = _RGB32(0, 129, 0)
Yellow& = _RGB(255, 255, 0)
Pink& = _RGB(216, 50, 166)
'Large background box
Line (0, 0)-(1199, 50), Pink&, BF
Sleep
c1 = 7
r1 = 7
c2 = 126
r2 = 46
'The 5 smaller box
Line (c1, r1)-(c2, r2), DarkGreen&, BF
r1 = 51
r2 = 93
'The Drop Down
For DDwn = 1 To 25
Color Yellow&
_PrintString (12, 15), "Opening Info"
Line (c1, r1)-(c2, r2), DarkGreen&, BF
For slow = 1 To 10000000: Next
r1 = r1 + DDwn
r2 = r2 + DDwn
Next
Sleep
|
|
|
|