Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - TempodiBasic

Pages: [1] 2 3 ... 120
1
Hi Daniel3D
fine this function extracting name of car from file of car.
I'll try it so in a second moment I can integrate it.

Soon final version of installer. I'm testing it in Qbasic in DosBox for windows.
See Later

2
Hi
in pure QBasic
here a simple demonstration about how to do a scroll-list with selection of some elements.
The input of list is from a file, but it can be changed at your need.
The input of user is keyboard, but it can be expanded at your need to mouse and joystick.
The output is an ASCII boxed scrollable list, but it can be changed in graphic primitive or graphic images at your need.
 
in this case I use this method to show the files of a folder.

Code: QB64: [Select]
  1. DECLARE SUB AllList (Max AS INTEGER)
  2. Const Max = 500
  3. Dim F(1 To Max) As String, S(1 To Max) As String * 2
  4. n = 0
  5. NameFile$ = "filedir.tmp"
  6. On Error GoTo Nofile
  7. Color 7, 0
  8. Shell "dir  /b> " + NameFile$
  9. Open NameFile$ For Input As #1
  10.     n = n + 1
  11.     Line Input #1, F(n)
  12.     S(n) = "  "
  13.     If wide < Len(F(n)) Then wide = Len(F(n))
  14.  
  15. Kill NameFile$
  16. Upper = n
  17.  
  18. 'AllList Upper
  19. ChoiceList Upper, wide
  20.  
  21.  
  22. Nofile:
  23. Print " Error "; FileName$ + " not found!"
  24.  
  25.  
  26. Sub ChoiceList (Umax As Integer, wid As Integer)
  27.     Shared F() As String, S() As String * 2
  28.     a = 0
  29.     k$ = ""
  30.     If i = 0 Then i = 1: n = i
  31.     ' 183 · 186º 189 ½ 196 Ä 211 Ó 214  Ö
  32.  
  33.     Do
  34.         ' here is the output of list
  35.         Color 7, 0
  36.         If i < n Or i > (n + 15) Then n = i
  37.         Locate 4, 23
  38.         Print "Ö" + String$(wid + 3, "Ä") + "·"
  39.         For a = n To n + 15 Step 1
  40.             If a > Umax Then M$ = Space$(wid + 3) Else M$ = " " + F(a) + S(a) + Space$(wid - Len(F(a)))
  41.             If a = i Then Color 15, 0
  42.             Locate , 23
  43.             Print "º" + M$ + "º"
  44.             If a = i Then Color 7, 0
  45.         Next a
  46.         Locate , 23
  47.         Print "Ó" + String$(wid + 3, "Ä") + "½"
  48.         Locate , 23
  49.         Print Chr$(24) + Chr$(25) + " move, S select, D done"
  50.  
  51.  
  52.  
  53.         ' here is the user input from keyboard
  54.         Do
  55.             k$ = UCase$(InKey$)
  56.             ' it switches the selector
  57.             If k$ = "S" Then If S(i) = "  " Then S(i) = "<-" Else S(i) = "  "
  58.             ' down
  59.             If k$ = Chr$(0) + "P" Then If i < Umax Then i = i + 1
  60.             'up
  61.             If k$ = Chr$(0) + "H" Then If i > 1 Then i = i - 1
  62.             If k$ = "D" Then Exit Sub 'Return ' all selection has been done
  63.         Loop Until k$ <> ""
  64.     Loop
  65.     'Return
  66.  
  67. Sub AllList (UMax As Integer)
  68.     Shared F() As String, S() As String * 2
  69.     ' debug SUB to show the whole list
  70.     For a = 1 To UMax Step 1
  71.         Print F(a) + S(a)
  72.         If a Mod 15 = 0 Then Sleep 2
  73.     Next a
  74.  

Happy Coding in the New Year!

PS: QB64 beats QBasic for NOT get back a QBasic Parser bug:
If you DIM a string array suffix, if you SHARED that string array from into the SUB, you cannot use the suffix for define datatype but you must use AS.
Doing so you fall in Parser error that alert you; SUB shared variable isn't declared at main module! LOL

Instead QB64 recognizes that the same name with or without suffix  are the same if declared as the same type of data.
Here the issue of Qbasic showed in code.
Code: QB64: [Select]
  1. DIM Me$ (1 to 10)
  2.  
  3. 'main
  4.  
  5. SUB foo

3
Happy New Year Daniel5

ok
1. you needn't to use interrupt (how much time you and I have saved because I have no pre-built library for DOS interrupt and I have to build it from stratch)

2. for now MAX = 500

3.
this is the options: actual state, one kind of file at time,  multiple files at time
see screenshot
  [ You are not allowed to view this attachment ]  

let me know your preferences

Waiting your feedback  again Happy New Year

4
QB64 Discussion / Re: Project looking for Programmer (I can't do it myself)
« on: December 29, 2021, 05:12:52 pm »
Hi Daniel3D
fine for getting your feedbacks...

1. About using interrupt in DOS mode:
I prefer to use SHELL command because it is speeder than  getting files of folder using 16 bit interrupts
(as you already know using interrupt we must use some DOS services in a specific order for getting the list of files = much code for reaching the same point)
moreover there is FILES keyword in QBasic (see here https://wiki.qb64.org/wiki/FILES) that it uses to print on the screen the result of its calling.

2. arrays too huge

1000 is a generic target. The original files are about 120 plus mod files = (about) 400 ?! In other words 400 files are a good upper limit about the amount of files that can be in the main folder of the game ?

3. using 4 groups for the scrollListbox
      Game Files are in the list that you have posted before
      getting files list in the folder we can extract the 3 different lists: Tracks, Cars and Mods
please think about this and gimme a confirm to let me go on.


5
QB64 Discussion / Re: Locate:
« on: December 28, 2021, 03:14:55 am »
Quote
K$=RIGHT$(INKEY$,1)
IF INSTR(KEYLIST$,K$) < 1 THEN EXIT DO
WOW
that is the first time that I see a code that shows why  returning TRUE (-1) from INSTR is useful when the searched string is void ("").

Thanks random1

PostScriptum 1: is it less complicated than the use of IMP?  Maybe it is.

PostScriptum 2: surely here you write
Quote
locatexy(10,10), input n$
  but you would type
Code: QB64: [Select]
  1. locatexy(10,10): input n$
  2.  
because locatexy moves the position of cursor, and it is for input and output.

6
QB64 Discussion / Re: Project looking for Programmer (I can't do it myself)
« on: December 26, 2021, 03:54:16 pm »
@Daniel3D
Merry Christmas


there are further development.
This is my function to search files and show them into a ScrollList and let to the user to select them.

Now you see it as a single program, but I must only integrate it into the original program (I must see for duplicating of name of variables and of labels, moreover I must test that it doesn't run into memory overflow/ out of stack as in previous  experience).

Code: QB64: [Select]
  1. DIM F$(1 TO 1000), S(1 TO 1000) AS STRING * 2, n AS INTEGER, a AS INTEGER, i AS INTEGER, max AS INTEGER
  2. n = 0
  3. NameFile$ = "filedir.tmp"
  4. ON ERROR GOTO Nofile
  5. COLOR 7, 0
  6. SHELL "dir  /b> " + NameFile$
  7. OPEN NameFile$ FOR INPUT AS #1
  8.  n = n + 1
  9.    LINE INPUT #1, F$(n)
  10.    S(n) = "  "
  11. KILL NameFile$
  12.  max = n
  13.  
  14. GOSUB AllList
  15. GOSUB ChoiceList
  16.  
  17.  
  18. Nofile:
  19.  PRINT " Error "; FileName$ + " not found!"
  20.  END
  21.  
  22. AllList:
  23. ' debug GOSUB to show the whole list
  24. FOR a = 1 TO max STEP 1
  25. PRINT F$(a) + S(a)
  26. IF a MOD 15 = 0 THEN SLEEP 2
  27.  
  28. ChoiceList:
  29. a = 0
  30. k$ = ""
  31. IF i = 0 THEN i = 1: n = i
  32. ' 183 · 186º 189 ½ 196 Ä 211 Ó 214  Ö                                                                      
  33.  
  34.  ' here is the output of list
  35.  COLOR 7, 0
  36.  IF i < n OR i > (n + 15) THEN n = i
  37.  LOCATE 4, 23
  38.  PRINT "ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·"
  39.  FOR a = n TO n + 15 STEP 1
  40.    IF a > max THEN M$ = SPACE$(15) ELSE M$ = " " + F$(a) + S(a) + SPACE$(15 - LEN(F$(a)) - 3)
  41.    IF a = i THEN COLOR 15, 0
  42.    LOCATE , 23
  43.    PRINT "º" + M$ + "º"
  44.    IF a = i THEN COLOR 7, 0
  45.  NEXT a
  46.  LOCATE , 23
  47.  PRINT "ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ"
  48.  LOCATE , 23
  49.  PRINT CHR$(24) + CHR$(25) + " move, S select, D done"
  50.  
  51.  
  52.  
  53.  ' here is the user input from keyboard
  54.  DO
  55.     k$ = UCASE$(INKEY$)
  56.  ' it switches the selector
  57.     IF k$ = "S" THEN IF S(i) = "  " THEN S(i) = "<-" ELSE S(i) = "  "
  58.     ' down
  59.     IF k$ = CHR$(0) + "P" THEN IF i < max THEN i = i + 1
  60.      'up
  61.     IF k$ = CHR$(0) + "H" THEN IF i > 1 THEN i = i - 1
  62.     IF k$ = "D" THEN RETURN ' all selection has been done
  63.  LOOP UNTIL k$ <> ""
  64.  
  65.  


please run it under DOSBox in the a folder that is DOS compatible,  you can run also it into QB64 BUT you'll get the long name of files if you don't run into a DOS folder, so the ScrollList will be a bit messing up!
Otherwise you must use the right switch of DIR command to get the short name of files into the list created.

Let me know what do you think about this.

7
QB64 Discussion / Re: 🎄🎁✨ Holiday Season Code Sampler 2021
« on: December 26, 2021, 02:01:27 pm »
@johnno56
Yeah, you're right! Too many misteries on this lighting picture

@QB64 World

Enjoy yourself boys and girls of Qb64 world!

I have discovered this fine lyric of Alan Parson Project.
Soirèè Fantastique
https://www.youtube.com/watch?v=JeWZqC5kdv4&list=RDLI8NDA_-zOo&index=7
That is my old time, but strangely I have never heard them except for some quickly apparition in the Sunday music show on TV!
So I'm discovering them again.

8
QB64 Discussion / Re: Lacking QB4.5 error catch
« on: December 24, 2021, 05:21:42 am »
@Cobalt
Is there  a price also for sand of Gobi desert?


@FellippeHeitor

Quote
Back in QB4.5 these two commands wouldn't take parameters. Microsoft only fixed that with v7.1.

it seems that Microsoft QuickBasic project managers had made changes so much in QuickBasic going from 4.5 to 7.1 (ISAM, memory allocation and managment, some features about string variables, and now you teach me also about END and SYSTEM).

Seeing the matter from a C pointview (using the glasses of C concepts) I can agree that these news about END and SYSTEM are a fix (the application when returns no value is like a SUB, while when the application returns a value to the OS it is like a FUNCTION... it seems like  main VOID vs main INT).
In this perspective QB64 is nearer to QB PDS than QB4.5, like for _PRESERVE that is a keyword of QB PDS.

PS:
@ FellippeHetoir
again that issue on replying to a post. If I go out of time, going to login again I find myself into a page for NewThread post .
I report this if it can be useful.

9
QB64 Discussion / Re: 🎄🎁✨ Holiday Season Code Sampler 2021
« on: December 24, 2021, 04:59:42 am »
@johnno56

thanks Johnno56

but there is a bug! peas are on the snow not on the Earth!

This is my handmade fix
  [ You are not allowed to view this attachment ]  
:-)

Thanks for hoping and joking ... it is a good light in this 4rth wave of Covid19!

10
QB64 Discussion / Re: 🎄🎁✨ Holiday Season Code Sampler 2021
« on: December 23, 2021, 07:34:46 pm »
Hi boys and girls of QB64land,

here my wishes
an OpenGl wish for health, peace and funny moments
Code: QB64: [Select]
  1.  Dim Shared GlInit As Integer, s As Single, Glactive As Integer
  2.  
  3. A = _NewImage(800, 600, 32)
  4.  
  5.  
  6. Const Yellow1 = _RGB32(200, 200, 10, 255), Yellow2 = _RGB32(200, 200, 60, 255), Black = _RGB32(0, 0, 0, 255), Red = _RGB32(230, 0, 0, 255)
  7. _Title "Happy Christmas QB64 community!"
  8.  
  9. Locate 2, ((_Width / 2) - 80) / 8: Print "Opengl graphic demo"
  10. GlInit = -1
  11. Glactive = -1
  12. r = 1
  13. z = 10
  14. s = _Pi(2) / z
  15.     If r > 0.35 Then r = r - 0.05
  16.     For w = 0 To _Pi(2) Step s / 2
  17.  
  18.         _Delay .15
  19.     Next w
  20. Color Yellow1
  21. Print " Happy Christmas QB64 community"
  22.  
  23. 'area subs-------------
  24.  
  25. 'area GL --------------------
  26. Sub _GL ()
  27.     Shared w As Single
  28.     If Not Glactive Then Exit Sub
  29.     If GlInit Then
  30.         _glViewport 0, 0, _Width, _Height
  31.         _glClearColor 0, 0, 1, 1
  32.         GlInit = 0
  33.     End If
  34.     _glClear _GL_COLOR_BUFFER_BIT
  35.     RotatingStarsFull 0, -0.2, r, -w
  36.     IncrDrawPoint 0, -0.2, r, 10, -w
  37.     IncrRotStarsvoid 0, -0.2, r, -w
  38.     'Q
  39.     RotatingStarsFull -0.7, 0.8, 0.05, -w
  40.     RotatingStarsFull -0.8, 0.8, 0.05, -w
  41.     RotatingStarsFull -0.9, 0.7, 0.05, -w
  42.     RotatingStarsFull -0.9, 0.6, 0.05, -w
  43.     RotatingStarsFull -0.9, 0.5, 0.05, -w
  44.     RotatingStarsFull -0.8, 0.4, 0.05, -w
  45.     RotatingStarsFull -0.7, 0.4, 0.05, -w
  46.     RotatingStarsFull -0.6, 0.7, 0.05, -w
  47.     RotatingStarsFull -0.6, 0.6, 0.05, -w
  48.     RotatingStarsFull -0.6, 0.5, 0.05, -w
  49.     RotatingStarsFull -0.55, 0.4, 0.05, -w
  50.     'B
  51.  
  52.     RotatingStarsFull -0.2, 0.8, 0.05, -w
  53.     RotatingStarsFull -0.4, 0.8, 0.05, -w
  54.     RotatingStarsFull -0.4, 0.7, 0.05, -w
  55.     RotatingStarsFull -0.4, 0.6, 0.05, -w
  56.     RotatingStarsFull -0.4, 0.5, 0.05, -w
  57.     RotatingStarsFull -0.4, 0.4, 0.05, -w
  58.     RotatingStarsFull -0.2, 0.4, 0.05, -w
  59.     RotatingStarsFull -0.1, 0.7, 0.05, -w
  60.     RotatingStarsFull -0.2, 0.6, 0.05, -w
  61.     RotatingStarsFull -0.1, 0.5, 0.05, -w
  62.     '6
  63.     RotatingStarsFull 0.4, 0.8, 0.05, -w
  64.     RotatingStarsFull 0.3, 0.8, 0.05, -w
  65.     RotatingStarsFull 0.2, 0.7, 0.05, -w
  66.     RotatingStarsFull 0.1, 0.6, 0.05, -w
  67.     RotatingStarsFull 0.1, 0.5, 0.05, -w
  68.     RotatingStarsFull 0.2, 0.4, 0.05, -w
  69.     RotatingStarsFull 0.3, 0.3, 0.05, -w
  70.     RotatingStarsFull 0.3, 0.3, 0.05, -w
  71.     RotatingStarsFull 0.4, 0.4, 0.05, -w
  72.     RotatingStarsFull 0.3, 0.5, 0.05, -w
  73.     RotatingStarsFull 0.4, 0.5, 0.05, -w
  74.     RotatingStarsFull 0.2, 0.5, 0.05, -w
  75.  
  76.     '4
  77.     RotatingStarsFull 0.8, 0.8, 0.05, -w
  78.     RotatingStarsFull 0.7, 0.7, 0.05, -w
  79.     RotatingStarsFull 0.8, 0.7, 0.05, -w
  80.     RotatingStarsFull 0.6, 0.5, 0.05, -w
  81.     RotatingStarsFull 0.8, 0.6, 0.05, -w
  82.     RotatingStarsFull 0.65, 0.6, 0.05, -w
  83.     RotatingStarsFull 0.7, 0.5, 0.05, -w
  84.     RotatingStarsFull 0.9, 0.5, 0.05, -w
  85.     RotatingStarsFull 0.8, 0.5, 0.05, -w
  86.     RotatingStarsFull 0.8, 0.4, 0.05, -w
  87.     RotatingStarsFull 0.8, 0.3, 0.05, -w
  88.  
  89.     _glFlush
  90.  
  91. Sub IncrDrawPoint (x As Single, y As Single, r1 As Single, s1 As Integer, w As Single)
  92.     Static s2 As Integer
  93.     If s2 - s1 = 0 Then s2 = 2 Else s2 = s2 + 1
  94.     drawpoint x, y, r1, s2, 2 * s, w
  95.  
  96. Sub IncrRotStarsvoid (x As Single, y As Single, r1 As Single, w As Single)
  97.     Static r2 As Single
  98.     If r2 >= r1 Then r2 = 0 Else r2 = r2 + 0.001
  99.     RotatingStarsVoid x, y, r2, w
  100.  
  101. Sub drawpoint (x As Single, y As Single, r1 As Single, s1 As Integer, s2 As Single, w As Single)
  102.     Dim i As Single, cx As Single, cy As Single
  103.     _glColor4f 0.8, .8, 0.1, 1.0
  104.     _glPointSize s1 ' it works with 2 or more !
  105.     _glBegin _GL_POINTS
  106.     For i = 0 To _Pi(2) Step s2
  107.         cx = (Cos(i + w) * r1) + x
  108.         cy = (Sin(i + w) * r1) + y
  109.         _glVertex2f cx, cy
  110.     Next i
  111.     _glEnd
  112.  
  113.  
  114.  
  115.  
  116. Sub RotatingStarsFull (x As Single, y As Single, r1 As Single, w As Single)
  117.     Dim i, cx As Single, cy As Single, j As Integer, k As Integer, h As Integer
  118.     _glColor4f 0.8, .8, 0.1, 1.0
  119.  
  120.     _glBegin _GL_TRIANGLE_FAN
  121.  
  122.     h = 0
  123.     For i = 0 To _Pi(2) Step s
  124.         h = h + 1
  125.         If h Mod 2 = 0 Then
  126.             j = 2: k = 1
  127.         Else
  128.             j = 1: k = 2
  129.         End If
  130.  
  131.         cx = (Cos(i - s + w) * (r1 / k)) + x
  132.         cy = (Sin(i - s + w) * (r1 / k)) + y
  133.         _glVertex2f cx, cy
  134.  
  135.         cx = (Cos(i + w) * (r1 / j)) + x
  136.         cy = (Sin(i + w) * (r1 / j)) + y
  137.         _glVertex2f cx, cy
  138.         cx = (Cos(i + s + w) * (r1 / k)) + x
  139.         cy = (Sin(i + s + w) * (r1 / k)) + y
  140.         _glVertex2f cx, cy
  141.     Next i
  142.  
  143.     _glEnd
  144.  
  145. Sub RotatingStarsVoid (x As Single, y As Single, r1 As Single, w As Single)
  146.     Dim i, cx As Single, cy As Single, j As Integer, k As Integer, h As Integer
  147.     _glColor4f 0.8, 1, 0.1, 1.0
  148.  
  149.     _glBegin _GL_LINES
  150.  
  151.     h = 0
  152.     For i = 0 To _Pi(2) Step s
  153.         h = h + 1
  154.         If h Mod 2 = 0 Then
  155.             j = 2: k = 1
  156.         Else
  157.             j = 1: k = 2
  158.         End If
  159.  
  160.  
  161.         cx = (Cos(i + w) * (r1 / j)) + x
  162.         cy = (Sin(i + w) * (r1 / j)) + y
  163.         _glVertex2f cx, cy
  164.         cx = (Cos(i + s + w) * (r1 / k)) + x
  165.         cy = (Sin(i + s + w) * (r1 / k)) + y
  166.         _glVertex2f cx, cy
  167.     Next i
  168.  
  169.     _glEnd
  170.  

Happy Christmas.

11
Programs / A simple demo to show how to merge with transparency 2 images
« on: December 20, 2021, 10:16:06 am »
Hi Guys and Gals of QB64 Universe

on Discord there is this request.
I find it useful for sharing in a more stable place (the Forum).
Quote
There are alot of mentioning about transparency on putimage wiki, but cant find any examples Im looking for.
[11:43]
I mean if there is no thing for it internally, its no problem to use just multiple images with they own transparency in it. I was just thinking that there is since I remember seeing some things about transparency. But it could be for other things as wel

a bit of simple graphic functions of QB64 that mimic the AND/OR/XOR/PSET option of QB45 PUT graphic keyword.
In QB64 you needn't use the old graphic tecniques both for the more available graphic memory to use both for the simpler graphic keywords.

here I share a very simple demonstration about  how to merge 2 images with different grade of transparency

Code: QB64: [Select]
  1. Const w = 600, h = 600
  2. A1& = _NewImage(w, h, 32) ' first image THE SCREEN
  3. A2& = _NewImage(w, h, 32) ' second image to show on the screen
  4. A3& = _NewImage(w / 2, h / 2, 32) ' resizing the second image into a smaller image
  5. ' making background image of the screeen
  6. _Dest A1&
  7. Cls , _RGB32(100, 0, 0)
  8. Line (300, 300)-(400, 400), _RGB32(0, 0, 200, 255), BF
  9. ' making new image to paste with transparency to the SCREEN
  10. _Dest A2&
  11. Cls , _RGB32(0, 200, 0, 255)
  12. _PutImage , A2&, A3& ' save A2 in A3 changing its size
  13. _PutImage , A1&, A2& ' save a1 in a2 to restore background
  14.  
  15. Screen A1& ' it creates the screen
  16. For q = 1 To 255 Step 5
  17.     _PutImage , A2&, A1& ' it restores background to screen visible
  18.     Locate 1, 1: Print "Alpha channel source image: "; q ' onscreen output
  19.     _SetAlpha q, , A3& ' here it is changing transparency of A3&
  20.     _PutImage (200, 200)-(400, 400), A3&, A1& ' it puts A3& on the center of A1&
  21.     _Delay .2 'it waits to let you see changement
  22.     _Display ' it shows at the istant the changement
  23.     _Limit 10 ' it saves CPU work
  24.  

On the other side if you want only have the background transparent you must use an image with Black background that  it works as transparent color in QB64!
Moreover if you want  to make  transparent a specific color or range of colors you must use _SETALPHA keyword.

Good Coding

12
QB64 Discussion / Re: Forum outages
« on: December 13, 2021, 07:53:28 pm »
Moreover I have noticed that suggestion for shortcuts into reply page alt+s / alt+p.

Well those shortcuts doesn't work into my Chrome in Windows 8.1
Just a feedback that can be useful.

13
QB64 Discussion / Re: Project looking for Programmer (I can't do it myself)
« on: December 13, 2021, 07:50:52 pm »
Hi Daniel3D
about the strange bug it didn't come back running code into QB under DOSBOX.
So I must suppose that it is a bug of 03.00 AM o'clock! :-)
Nevertheless there are some difference in performances between running the code into QB64 and running the code in QB under Dosbox.
The first is that MKdir doesn't like a "\" at the end of the string of the name of folder to create.
Then I fall in Out of Stack!
Then in an issue to GET a string from Binary files.
Now all these are fixed. And I have tested the program about copying original folder using the list and it is ok.
Now I'm testing the full copy of a folder with mods to a destination path, and the possibility to make a selection of what to copy to destination.

@Richard:
I'll google for Dosbox X to see if there are some significative differences about the program in developing.

14
QB64 Discussion / Re: Forum outages
« on: December 13, 2021, 07:15:18 pm »
No idea. Do you still get that?
Yes I get

15
QB64 Discussion / Re: Forum outages
« on: December 12, 2021, 12:22:43 pm »
@FellippeHeitor
Good Job!


Is this issue related to the other that I have described you before?
(in time out, on replying to a post,  entering again into the forum with login  I get the page of New Thread)

Pages: [1] 2 3 ... 120