Skip to content

Commit 5b8451d

Browse files
jayrmjayrm
committed
fbdoc: examples/manual update 2018-09-03
1 parent 5d1ac76 commit 5b8451d

26 files changed

+769
-145
lines changed

‎examples/manual/array/redim.bas‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@
77
'' --------
88

99
'' Define a variable-length array with 5 elements
10-
''
1110
ReDim array(0 To 4) As Integer
1211

1312
For index As Integer = LBound(array) To UBound(array)

‎examples/manual/array/redim3.bas‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
'' examples/manual/array/redim3.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgRedim
7+
'' --------
8+
9+
'' Define a variable-length array as UDT field
10+
Type UDT
11+
Dim As Integer array(Any)
12+
End Type
13+
14+
Dim As UDT u(0 To 3)
15+
16+
'' For use of Redim with a complex array expression
17+
'' (especially if the array expression itself contains parentheses),
18+
'' the array expression must be enclosed in parentheses
19+
'' in order to solve the parsing ambiguity:
20+
'' Redim u(0).array(0 To 9)
21+
'' induces error 4: Duplicated definition, u in 'Redim u(0).array(0 To 9)'
22+
ReDim (u(0).array)(0 To 9)

‎examples/manual/datatype/funcptr.bas‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
'' examples/manual/datatype/funcptr.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgFunctionPtr
7+
'' --------
8+
9+
Function ConcatSelf( x As String ) As String
10+
Return x & x
11+
End Function
12+
13+
Dim x As Function( x As String ) As String = ProcPtr( ConcatSelf )
14+
15+
Print x( "Hello" )

‎examples/manual/datatype/funcptr2.bas‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
'' examples/manual/datatype/funcptr2.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgFunctionPtr
7+
'' --------
8+
9+
Function x2 (ByVal i As Integer) As Integer
10+
Return i * 2
11+
End Function
12+
13+
Function x3 (ByVal i As Integer) As Integer
14+
Return i * 3
15+
End Function
16+
17+
Function operation (ByVal i As Integer, ByVal op As Function (ByVal As Integer) As Integer) As Integer
18+
Return op(i)
19+
End Function
20+
21+
Print operation(4, @x2)
22+
Print operation(4, @x3)

‎examples/manual/datatype/funcptr3.bas‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
'' examples/manual/datatype/funcptr3.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgFunctionPtr
7+
'' --------
8+
9+
' Example of basic callback Function mechanism to implement a key pressed event:
10+
' (the user callback Function address cannot be modified while the event thread is running)
11+
' - An asynchronous thread tests the keyboard in a loop, and calls a user callback Function each time a key is pressed.
12+
' - The callback Function address is passed to the thread.
13+
' - The callback Function prints the character of the key pressed,
14+
' but if the key pressed is <escape> it orders the thread to finish by using the function return value.
15+
' - As the user callback address is passed to the thread as argument, it cannot be modified while the thread is running.
16+
17+
18+
'' thread Sub definition
19+
Sub threadInkey (ByVal p As Any Ptr)
20+
If p > 0 Then '' test condition callback Function defined
21+
Dim As Function (ByRef As String) As Integer callback = p '' convert the any ptr to a callback Function pointer
22+
Do
23+
Dim As String s = Inkey
24+
If s <> "" Then '' test condition key pressed
25+
If callback(s) Then '' test condition to finish thread
26+
Exit Do
27+
End If
28+
End If
29+
Sleep 50
30+
Loop
31+
End If
32+
End Sub
33+
34+
'' user callback Function definition
35+
Function printInkey (ByRef s As String) As Integer
36+
If Asc(s) = 27 Then '' test condition key pressed = <escape>
37+
Print
38+
Return -1 '' order thread to finish
39+
Else
40+
Print s;
41+
Return 0 '' order thread to continue
42+
End If
43+
End Function
44+
45+
'' user main code
46+
Dim As Any Ptr p = ThreadCreate(@threadInkey, @printInkey) '' launch the thread, passing the callback Function address
47+
ThreadWait(p) '' wait for the thread finish

‎examples/manual/datatype/subptr.bas‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
'' examples/manual/datatype/subptr.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgSubPtr
7+
'' --------
8+
9+
Sub Hello()
10+
Print "Hello"
11+
End Sub
12+
13+
Sub Goodbye()
14+
Print "Goodbye"
15+
End Sub
16+
17+
Dim x As Sub() = ProcPtr( Hello )
18+
19+
x()
20+
21+
x = @Goodbye '' or procptr(Goodbye)
22+
23+
x()

‎examples/manual/datatype/subptr2.bas‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
'' examples/manual/datatype/subptr2.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgSubPtr
7+
'' --------
8+
9+
Sub s0 ()
10+
Print "'s0 ()'"
11+
End Sub
12+
13+
Sub s1 (ByVal I As Integer)
14+
Print "'s1 (Byval As Integer)'", I
15+
End Sub
16+
17+
Sub s2 (ByRef S As String, ByVal D As Double)
18+
Print "'s2 (Byref As String, Byval As Double)'", S, D
19+
End Sub
20+
21+
Dim s0_ptr As Sub () = @s0
22+
Dim s1_ptr As Sub (ByVal I As Integer) = @s1
23+
Dim s2_ptr As Sub (ByRef S As String, ByVal D As Double) = @s2
24+
25+
s0_ptr()
26+
s1_ptr(3)
27+
s2_ptr("PI", 3.14)

‎examples/manual/datatype/subptr3.bas‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
'' examples/manual/datatype/subptr3.bas
2+
''
3+
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
4+
'' be included in other distributions without authorization.
5+
''
6+
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgSubPtr
7+
'' --------
8+
9+
' Example of advanced callback Sub mechanism to implement a key pressed event:
10+
' (the user callback Sub address can be modified while the event thread is running)
11+
' - An asynchronous thread tests the keyboard in a loop, and calls a user callback Sub each time a key is pressed.
12+
' - An UDT groups the common variables used (callback Sub pointer, character of key pressed, thread end flag),
13+
' and the static thread Sub plus the thread handle.
14+
' - An UDT instance pointer is passed to the thread, which then transmits it to the callback Sub each time.
15+
' - The callback Sub prints the character of the key pressed character,
16+
' but if the key pressed is <escape> it orders the thread to finish.
17+
' - As the user callback pointer is a member field of the UDT, it can be modified while the thread is running.
18+
19+
20+
'' UDT for thread environment
21+
Type threadUDT
22+
Dim As Sub (ByVal As ThreadUDT Ptr) callback '' callback Sub pointer
23+
Dim As Integer threadEnd '' thread end flag
24+
Dim As String s '' character of the key pressed
25+
Declare Static Sub threadInkey (ByVal p As Any Ptr) '' static thread Sub
26+
Dim As Any Ptr threadHandle '' handle to the thread
27+
End Type
28+
29+
'' thread Sub definition
30+
Sub threadUDT.threadInkey (ByVal p As Any Ptr)
31+
Dim As threadUDT Ptr pt = p '' convert the any ptr to a threadUDT pointer
32+
Do
33+
pt->s = Inkey
34+
If pt->s <> "" AndAlso pt->callback > 0 Then '' test condition key pressed & callback Sub defined
35+
pt->callback(p)
36+
End If
37+
Sleep 50
38+
Loop Until pt->threadEnd '' test condition to finish thread
39+
End Sub
40+
41+
'' user callback Sub definition
42+
Sub printInkey (ByVal pt As threadUDT Ptr)
43+
If Asc(pt->s) = 27 Then '' test condition key pressed = <escape>
44+
pt->threadEnd = -1 '' order thread to finish
45+
Print
46+
Else
47+
Print pt->s;
48+
End If
49+
End Sub
50+
51+
'' user main code
52+
Dim As ThreadUDT t '' create an instance of threadUDT
53+
t.threadHandle = ThreadCreate(@threadUDT.threadInkey, @t) '' launch the thread, passing the instance address
54+
t.callback = @printInkey '' initialize the callback Sub pointer
55+
ThreadWait(t.threadHandle) '' wait for the thread finish

‎examples/manual/fileio/basicvsc.bas‎

Lines changed: 67 additions & 73 deletions
Original file line numberDiff line numberDiff line change
@@ -6,87 +6,81 @@
66
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=ProPgFileIO
77
'' --------
88

9-
Data " File I/O example & test GET vs FREAD | (CL) 2008-10-12 Public Domain "
10-
Data " http://www.freebasic.net/wiki/wikka.php?wakka=ProPgFileIO "
11-
Rem
12-
Rem Compile With FB 0.20 Or newer
13-
Rem
14-
Rem In the commandline supply preferably 2 different files of same big size
15-
Rem Default Is "BLAH" For both (bad)
16-
Rem In both loops (Get And FREAD) the last Read can be "empty" ... no problem
9+
'==== File I/O example / 2018-05-18 ====
1710

18-
#include "crt\stdio.bi" '' Otherwise the "C"-stuff won't work
11+
Dim As String fileName = "test_123.tmp"
12+
Dim As ULong buffer(0 To 99) '100 x 4 bytes
13+
Dim As Integer numItems, result
1914

20-
Dim As FILE Ptr QQ '' This is the C-like file access pointer
21-
Dim As UByte Ptr BUF '' Buffer used for both FB-like and C-like read
22-
Dim As UInteger FILN '' FB-like "filenumber"
15+
Print !"\n==== Using the C Runtime (CRT) file I/O ====\n"
2316

24-
Dim As UInteger AA, BB, CC, DD, EE
25-
Dim As ULongInt II64 '' We do try to support files >= 4 GiB
17+
#include Once "crt/stdio.bi"
2618

27-
Dim As String VGSTEMP, VGSFILE1, VGSFILE2
19+
Dim As FILE Ptr filePtr
2820

29-
? : Read VGSTEMP : ? VGSTEMP : Read VGSTEMP : ? VGSTEMP : ?
21+
'open in binary writing mode
22+
filePtr = fopen(fileName, "wb")
23+
If filePtr <> 0 Then
24+
'write 75 x 4 = 300 bytes
25+
numItems = fwrite(@buffer(0), SizeOf(buffer(0)), 75, filePtr)
26+
Print "Number of bytes written: " & Str(numItems * SizeOf(buffer(0)))
27+
Print "Number of items written: " & Str(numItems)
28+
fclose(filePtr)
29+
Else
30+
Print "Failed to open " & fileName & " for writing"
31+
End If
3032

31-
VGSTEMP=Command$(1) : VGSFILE1="BLAH"
32-
If (VGSTEMP<>"") Then VGSFILE1=VGSTEMP
33-
VGSTEMP=Command$(2) : VGSFILE2=VGSFILE1
34-
If (VGSTEMP<>"") Then VGSFILE2=VGSTEMP
33+
'open in binary reading mode
34+
filePtr = fopen(fileName, "rb")
35+
If filePtr <> 0 Then
36+
'skip the first 25 items
37+
If fseek(filePtr, SizeOf(buffer(0)) * 25, SEEK_SET) <> 0 Then
38+
Print "Failed to seek (set file stream position)"
39+
End If
40+
'try to read the next 100 items
41+
numItems = fread(@buffer(0), SizeOf(buffer(0)), 100, filePtr)
42+
Print "Number of bytes read: " & Str(numItems * SizeOf(buffer(0)))
43+
Print "Number of items read: " & Str(numItems)
44+
fclose(filePtr)
45+
Else
46+
Print "Failed to open " & fileName & " for reading"
47+
End If
3548

36-
BUF = Allocate(32768) '' 32 KiB - hoping it won't fail, BUF could be 0 ...
49+
result = remove(fileName) 'delete file
50+
If result = 0 Then Print "Removed: " & fileName
3751

38-
? : ? "FB - OPEN - GET , """+VGSFILE1+"""": Sleep 1000
39-
FILN = FreeFile : AA=0 : II64=0 '' AA counts blocks per 32 KiB already read
40-
BB=Open (VGSFILE1 For Binary Access Read As #FILN)
41-
'' Result 0 is OK here, <>0 is evil
42-
'' "ACCESS READ" should prevent file creation if it doesn't exist
43-
? "OPEN result : " ; BB
44-
If (BB=0) Then '' BB will be "reused" for timer below
45-
BB=Cast(UInteger,(Timer*100)) '' No UINTEGER TIMER in FB, make units 10 ms
46-
CC=Get (#FILN,,*BUF,32768,DD)
47-
'' CC has the success status, 0 is OK, <>0 is bad
48-
'' DD is the amount of data read
49-
'' EOF is __NOT__ considered as error here
50-
? "0th GET : ";CC;" ";DD
51-
? "2 bytes read : ";BUF[0];" ";BUF[1]
52-
Do
53-
AA=AA+1 : II64=II64+Cast(ULongInt,DD)
54-
If (DD<32768) Or (CC<>0) Then Exit Do '' Give up
55-
CC=Get (#FILN,,*BUF,32768,DD)
56-
Loop
57-
EE=Cast(UInteger,(Timer*100))-BB
58-
? "Time : ";(EE+1)*10;" ms"
59-
If (AA>1) Then ? "Last GET : ";CC;" ";DD
60-
? "Got __EXACTLY__ ";II64;" bytes in ";AA;" calls"
61-
Close #FILN
62-
ENDIF
52+
Print !"\n==== Using the FreeBASIC file I/O ====\n"
6353

64-
? : ? "C - FOPEN - FREAD , """+VGSFILE2+"""" : Sleep 1000
65-
AA=0 : II64=0 '' AA counts blocks per 32 KiB already read
66-
QQ=FOPEN(VGSFILE2,"rb")
67-
'' Here 0 is evil and <>0 good, opposite from above !!!
68-
'' File will not be created if it doesn't exist (good)
69-
'' "rb" is case sensitive and must be lowercase, STRPTR seems not necessary
70-
? "FOPEN result : " ; QQ
71-
If (QQ<>0) Then
72-
BB=Cast(UInteger,(Timer*100)) '' No UINTEGER TIMER in FB, make units 10 ms
73-
DD=FREAD(BUF,1,32768,QQ) '' 1 is size of byte - can't live without :-D
74-
'' Returns size of data read, <32768 on EOF, 0 after EOF, or "-1" on error
75-
? "0th FREAD : ";DD
76-
? "2 bytes read : ";BUF[0];" ";BUF[1]
77-
Do
78-
AA=AA+1
79-
If (DD<=32768) Then II64=II64+Cast(ULongInt,DD)
80-
If (DD<>32768) Then Exit Do '' ERR or EOF
81-
DD=FREAD(BUF,1,32768,QQ)
82-
Loop
83-
EE=Cast(UInteger,(Timer*100))-BB
84-
? "Time : ";(EE+1)*10;" ms"
85-
If (AA>1) Then ? "Last FREAD : ";DD
86-
? "Got __EXACTLY__ ";II64;" bytes in ";AA;" calls"
87-
FCLOSE(QQ)
88-
ENDIF
54+
Dim As Long fileNum
55+
Dim As Integer numBytes
8956

90-
Deallocate(BUF): Sleep 1000 '' Crucial
57+
fileNum = FreeFile
58+
'open in binary writing mode
59+
If Open(fileName, For Binary, Access Write, As fileNum) = 0 Then
60+
'write 75 x 4 = 300 bytes
61+
result = Put(fileNum, , buffer(0), 75) 'No @buffer(0)
62+
numBytes = Seek(fileNum) - 1 'FreeBASIC file position is 1-based
63+
Print "Number of bytes written: " & Str(numBytes)
64+
Print "Number of items written: " & Str(numBytes \ SizeOf(buffer(0)))
65+
Close(fileNum)
66+
Else
67+
Print "Failed to open " & fileName & " for writing"
68+
End If
9169

92-
End
70+
'open in binary reading mode
71+
If Open(fileName, For Binary, Access Read, As fileNum) = 0 Then
72+
'skip the first 25 items
73+
Seek fileNum, 25 * SizeOf(buffer(0)) + 1 'Note: +1 & seek(...) not allowed
74+
'try to read the next 100 items
75+
result = Get(fileNum, , buffer(0), 100, numBytes)
76+
Print "Number of bytes read: " & Str(numBytes)
77+
Print "Number of items read: " & Str(numBytes \ SizeOf(buffer(0)))
78+
Close(fileNum)
79+
Else
80+
Print "Failed to open " & fileName & " for reading"
81+
End If
82+
83+
result = Kill(fileName) 'delete file
84+
If result = 0 Then Print "Killed: " & fileName
85+
86+
Print !"\n==== End ====\n"

0 commit comments

Comments
 (0)