Skip to content

Commit c9be553

Browse files
dkldkl
committed
examples: Update manual example snippets from the wiki
1 parent fb2dfc6 commit c9be553

File tree

8 files changed

+444
-30
lines changed

8 files changed

+444
-30
lines changed

‎examples/manual/gfx/get.bas‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -13,39 +13,39 @@ ScreenRes 400, 300, 32
1313

1414
'' First draw funny stuff...
1515
Line (10,10)-(140,30), RGB(255,255,0), bf
16-
Draw String (20, 20), "Hello there!", RGB(255,0,0)
16+
Draw String (30, 20), "Hello there!", RGB(255,0,0)
1717

1818
'' Now capture a 150x50 block from the top-left of the screen into an image
1919
'' buffer with GET...
2020
Dim As fb.Image Ptr image = ImageCreate(150, 50)
21-
Get (1,1)-(150,50), image
21+
Get (0,0)-(150-1,50-1), image
2222

2323
'' And duplicate it all over the place!
24-
Put (1,50), image
25-
Put (1,100), image
26-
Put (1,150), image
27-
Put (1,200), image
28-
Put (1,250), image
29-
Put (150,1), image
24+
Put (0,50), image
25+
Put (0,100), image
26+
Put (0,150), image
27+
Put (0,200), image
28+
Put (0,250), image
29+
Put (150,0), image
3030
Put (150,50), image
3131
Put (150,100), image
3232
Put (150,150), image
3333
Put (150,200), image
3434
Put (150,250), image
3535

3636
'' And a frame around a whole screen..
37-
Line (1,1)-(400-1,300-1), RGB(255,255,0), b
37+
Line (0,0)-(400-1,300-1), RGB(255,255,0), b
3838

3939
'' Now get the whole screen...
4040
Dim As fb.Image Ptr big = ImageCreate(400, 300)
41-
Get (1,1)-(400-1,300-1), big
41+
Get (0,0)-(400-1,300-1), big
4242

4343
'' And display that "screenshot" as if it was scrolling by...
4444
Dim As Integer x = -350
4545
While ((Inkey() = "") And (x < 350))
4646
ScreenLock
4747
Cls
48-
Put (x,1), big
48+
Put (x,0), big
4949
ScreenUnlock
5050

5151
Sleep 100, 1

‎examples/manual/gfx/put-trans-custom.bas‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
'' examples/manual/gfx/put-trans-custom.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: http://www.freebasic.net/wiki/wikka.php?wakka=KeyPgTransGfx
7+
'' --------
8+
9+
Function trans32 ( ByVal source_pixel As UInteger, ByVal destination_pixel As UInteger, ByVal parameter As Any Ptr ) As UInteger
10+
'' returns the source pixel
11+
'' unless it is &hff00ff (magenta), then return the destination pixel
12+
If (source_pixel And &hffffff) <> &hff00ff Then
13+
Return source_pixel
14+
Else
15+
Return destination_pixel
16+
End If
17+
End Function
18+
19+
'' set up a screen: 320 * 200, 16 bits per pixel
20+
ScreenRes 320, 200, 32
21+
22+
'' set up an image with the mask color as the background.
23+
Dim img As Any Ptr = ImageCreate( 32, 32, RGB(255, 0, 255) )
24+
Circle img, (16, 16), 15, RGB(255, 255, 0), , , 1, f
25+
Circle img, (10, 10), 3, RGB( 0, 0, 0), , , 2, f
26+
Circle img, (23, 10), 3, RGB( 0, 0, 0), , , 2, f
27+
Circle img, (16, 18), 10, RGB( 0, 0, 0), 3.14, 6.28
28+
29+
'' Put the image with PSET (gives the exact contents of the image buffer)
30+
Draw String (110, 50 - 4), "Image put with PSET"
31+
Put (60 - 16, 50 - 16), img, PSet
32+
33+
'' Put the image with TRANS
34+
Draw String (110, 100 - 4), "Image put with TRANS"
35+
Put (60 - 16, 100 - 16), img, Trans
36+
37+
'' Put the image with TRANS
38+
Draw String (110, 150 - 4), "Image put with trans32"
39+
Put (60 - 16, 150 - 16), img, Custom, @trans32
40+
41+
'' free the image memory
42+
ImageDestroy img
43+
44+
'' wait for a keypress
45+
Sleep

‎examples/manual/threads/condcreate.bas‎

Lines changed: 11 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -20,28 +20,27 @@ Dim Shared hcondready As Any Ptr
2020

2121
Sub mythread(ByVal id_ptr As Any Ptr)
2222
Dim id As Integer = Cast(Integer, id_ptr)
23-
24-
Print "Thread #" & id & " is waiting..."
25-
23+
2624
'' signal that this thread is ready
2725
MutexLock hmutexready
2826
threadcount += 1
27+
Print "Thread #" & id & " is waiting..."
2928
CondSignal hcondready
3029
MutexUnlock hmutexready
31-
30+
3231
'' wait for the start signal
3332
MutexLock hmutexstart
34-
Do While start = 0
35-
CondWait hcondstart, hmutexstart
33+
Do While start = 0
34+
CondWait hcondstart, hmutexstart
3635
Loop
3736

3837
'' now this thread holds the lock on hmutexstart
39-
38+
4039
MutexUnlock hmutexstart
4140

4241
'' print out the number of this thread
4342
For i As Integer = 1 To 40
44-
Print id;
43+
Print id;
4544
Next i
4645
End Sub
4746

@@ -55,22 +54,22 @@ hmutexready = MutexCreate()
5554

5655
threadcount = 0
5756

58-
57+
MutexLock(hmutexready)
5958
For i As Integer = 1 To 9
6059
threads(i) = ThreadCreate(@mythread, Cast(Any Ptr, i))
6160
If threads(i) = 0 Then
62-
Print "unable to create thread"
61+
Print "unable to create thread"
6362
End If
6463
Next i
6564

6665
Print "Waiting until all threads are ready..."
6766

68-
MutexLock(hmutexready)
6967
Do Until threadcount = 9
7068
CondWait(hcondready, hmutexready)
7169
Loop
7270
MutexUnlock(hmutexready)
7371

72+
Print
7473
Print "Go!"
7574

7675
MutexLock hmutexstart
@@ -81,7 +80,7 @@ MutexUnlock hmutexstart
8180
'' wait for all threads to complete
8281
For i As Integer = 1 To 9
8382
If threads(i) <> 0 Then
84-
ThreadWait threads(i)
83+
ThreadWait threads(i)
8584
End If
8685
Next i
8786

‎examples/manual/threads/condcreate2.bas‎

Lines changed: 133 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,133 @@
1+
'' examples/manual/threads/condcreate2.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: http://www.freebasic.net/wiki/wikka.php?wakka=KeyPgCondCreate
7+
'' --------
8+
9+
'Visual example of mutual exclusion + mutual synchronization between 2 threads
10+
'by using Mutex and CondVar:
11+
'the "user-defined thread" computes the points coordinates on a circle,
12+
'and the "main thread" plots the points.
13+
'
14+
'Principle of mutual exclusion + mutual synchronisation
15+
' Thread#A XOR + <==> Thread#B
16+
'..... .....
17+
'MutexLock(mut) MutexLock(mut)
18+
' While Thread#A_signal <> false While Thread#A_signal <> true
19+
' CondWait(cond, mut) CondWait(cond, mut)
20+
' Wend Wend
21+
' Do_something#A_with_exclusion Do_something#B_with_exclusion
22+
' Thread#A_signal = true Thread#A_signal = false
23+
' CondSignal(cond) CondSignal(cond)
24+
'MutexUnlock(mut) MutexUnlock(mut)
25+
'..... .....
26+
'
27+
'Behavior:
28+
'- Unnecessary to pre-calculate the first point.
29+
'- Each calculated point is plotted one time only.
30+
'
31+
'If you comment out the lines containing "MutexLock" and "MutexUnlock",
32+
'"CondWait" and "CondSignal", ".ready"
33+
'(inside "user-defined thread" or/and "main thread"),
34+
'there will be no longer mutual exclusion nor mutual synchronization
35+
'between computation of coordinates and plotting of points,
36+
'and many points will not be plotted on circle (due to non coherent coordinates).
37+
38+
'-----------------------------------------------------------------------------------------------------
39+
40+
Type ThreadUDT 'Generic user thread UDT
41+
Dim handle As Any Ptr 'Any Ptr handle to user thread
42+
Dim sync As Any Ptr 'Any Ptr handle to mutex
43+
Dim cond As Any Ptr 'Any Ptr handle to conditional
44+
Dim ready As Byte 'Boolean to coordinates ready
45+
Dim quit As Byte 'Boolean to end user thread
46+
Declare Static Sub Thread (ByVal As Any Ptr) 'Generic user thread procedure
47+
Dim procedure As Sub (ByVal As Any Ptr) 'Procedure(Any Ptr) to be executed by user thread
48+
Dim p As Any Ptr 'Any Ptr to pass to procedure executed by user thread
49+
Const false As Byte = 0 'Constante "false"
50+
Const true As Byte = Not false 'Constante "true"
51+
End Type
52+
53+
Static Sub ThreadUDT.Thread (ByVal param As Any Ptr) 'Generic user thread procedure
54+
Dim tp As ThreadUDT Ptr = param 'Casting to generic user thread UDT
55+
Do
56+
Static As Integer I
57+
MutexLock(tp->sync) 'Mutex (Lock) for user thread
58+
While tp->Ready <> false 'Process loop against spurious wakeups
59+
CondWait(tp->cond, tp->sync) 'CondWait to receive signal from main-thread
60+
Wend
61+
tp->procedure(tp->p) 'Procedure(Any Ptr) to be executed by user thread
62+
I += 1
63+
Locate 30, 38
64+
Print I;
65+
tp->Ready = true 'Set Ready
66+
CondSignal(tp->cond) 'CondSignal to send signal to main thread
67+
MutexUnlock(tp->sync) 'Mutex (Unlock) for user thread
68+
Sleep 5
69+
Loop Until tp->quit = tp->true 'Test for ending user thread
70+
End Sub
71+
72+
'-----------------------------------------------------------------------------------------------------
73+
74+
Type Point2D
75+
Dim x As Integer
76+
Dim y As Integer
77+
End Type
78+
79+
Const x0 As Integer = 640 / 2
80+
Const y0 As Integer = 480 / 2
81+
Const r0 As Integer = 200
82+
Const pi As Single = 4 * Atn(1)
83+
84+
Sub PointOnCircle (ByVal p As Any Ptr)
85+
Dim pp As Point2D Ptr = p
86+
Dim teta As Single = 2 * pi * Rnd
87+
pp->x = x0 + r0 * Cos(teta)
88+
Sleep 5 'To increase possibility of uncorrelated data occurrence
89+
pp->y = y0 + r0 * Sin(teta)
90+
End Sub
91+
92+
93+
Screen 12
94+
Locate 30, 2
95+
Print "<any_key> : exit";
96+
Locate 30, 27
97+
Print "calculated:";
98+
Locate 30, 54
99+
Print "plotted:";
100+
101+
Dim Pptr As Point2D Ptr = New Point2D
102+
103+
Dim Tptr As ThreadUDT Ptr = New ThreadUDT
104+
Tptr->sync = MutexCreate
105+
Tptr->cond = CondCreate
106+
Tptr->procedure = @PointOnCircle
107+
Tptr->p = Pptr
108+
Tptr->handle = ThreadCreate(@ThreadUDT.Thread, Tptr)
109+
110+
Do
111+
Static As Integer I
112+
Sleep 5
113+
MutexLock(Tptr->sync) 'Mutex (Lock) for main thread
114+
While Tptr->ready <> Tptr->true 'Process loop against spurious wakeups
115+
CondWait(Tptr->cond, Tptr->sync) 'CondWait to receive signal from user-thread
116+
Wend
117+
PSet (Pptr->x, Pptr->y) 'Plotting one point
118+
I += 1
119+
Locate 30, 62
120+
Print I;
121+
Tptr->Ready = Tptr->false 'Reset Ready
122+
CondSignal(Tptr->cond) 'CondSignal to send signal to user thread
123+
MutexUnlock(Tptr->sync) 'Mutex (Unlock) for main thread
124+
Loop Until Inkey <> ""
125+
126+
Tptr->quit = Tptr->true
127+
ThreadWait(Tptr->handle)
128+
MutexDestroy(Tptr->sync)
129+
CondDestroy(Tptr->cond)
130+
Delete Tptr
131+
Delete Pptr
132+
133+
Sleep

‎examples/manual/threads/condsignal.bas‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
'' examples/manual/threads/condsignal.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: http://www.freebasic.net/wiki/wikka.php?wakka=KeyPgCondSignal
7+
'' --------
8+
9+
' This very simple example code demonstrates the use of several condition variable routines.
10+
' The main routine initializes a string and creates one thread.
11+
' The thread complementes the string, then sends a condition signal.
12+
' The main routine waits until receive the condition signal, then print the complemented string.
13+
'
14+
'Principle of mutual exclusion + simple synchronisation
15+
' Thread#A XOR + ==> Thread#B
16+
'..... .....
17+
'MutexLock(mut) MutexLock(mut)
18+
' Do_something#A_with_exclusion While Thread#A_signal <> true
19+
' Thread#A_signal = true CondWait(cond, mut)
20+
' CondSignal(cond) Wend
21+
'MutexUnlock(mut) Do_something#B_with_exclusion
22+
'..... Thread#A_signal = false
23+
' MutexUnlock(mut)
24+
' .....
25+
26+
Dim Shared As Any Ptr mutex
27+
Dim Shared As Any Ptr cond
28+
Dim Shared As String txt
29+
Dim As Any Ptr pt
30+
Dim Shared As Integer ok = 0
31+
32+
Sub thread (ByVal p As Any Ptr)
33+
Print "thread is complementing the string"
34+
MutexLock(mutex)
35+
Sleep 400
36+
txt &= " complemented by thread"
37+
ok = 1
38+
CondSignal(cond)
39+
MutexUnlock(mutex)
40+
Print "thread signals the processing completed"
41+
End Sub
42+
43+
mutex = MutexCreate
44+
cond = CondCreate
45+
46+
txt = "example of text"
47+
Print "main() initializes a string = " & txt
48+
Print "main creates one thread"
49+
Print
50+
pt = ThreadCreate(@thread)
51+
MutexLock(mutex)
52+
While ok <> 1
53+
CondWait(cond, mutex)
54+
Wend
55+
Print
56+
Print "back in main(), the string = " & txt
57+
ok = 0
58+
MutexUnlock(mutex)
59+
60+
ThreadWait(pt)
61+
MutexDestroy(mutex)
62+
CondDestroy(cond)

0 commit comments

Comments
 (0)