Mint_21.3 drawing-area和goocanvas的FB笔记(七)

FreeBASIC gfx 基本 graphics 绘图

8、ScreenControl与屏幕窗口位置设置

FreeBASIC通过自建屏幕窗口摆脱了原来的屏幕模式限制，既然是窗口，在屏幕坐标中就有它的位置。ScreenControl GET_WINDOW_POS x, y 获取窗口左上角的x, y位置；ScreenControl SET_WINDOW_POS x, y则将窗口放在屏幕坐标的 x, y处，配合 ScreenEvent(@e)，下面的程序在获取快速鼠标点击窗口绘图区时快速变动窗口位置并回到原处，看上去是在抖动。当判断鼠标点击的关闭窗口时，退出程序。

在Do与Loop的尾部，有一个sleep 5 毫秒的语句，让CPU更好地处理其它事件。

'' examples/manual/gfx/screencontrol.bas
''
'' Example extracted from the FreeBASIC Manual
'' from topic 'SCREENCONTROL'
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgScreencontrol
'' --------

'' include fbgfx.bi for some useful definitions
#include "fbgfx.bi"

'' use FB namespace for easy access to types/constants
Using FB

Dim e As Event
Dim As Long x0, y0, x, y
Dim As Integer shakes = 0
Dim As Any Ptr img

ScreenRes 320, 200, 32
Print "Click to shake window"

'' find window coordinates
ScreenControl GET_WINDOW_POS, x0, y0

Do

	If (shakes > 0) Then
		
		'' do a shake of the window

		If (shakes > 1) Then

			'' move window to a random position near its original coordinates
			x = x0 + Int(32 * (Rnd() - 0.5))
			y = y0 + Int(32 * (Rnd() - 0.5))
			ScreenControl SET_WINDOW_POS, x, y

		Else

			'' move window back to its original coordinates
			ScreenControl SET_WINDOW_POS, x0, y0

		End If

		shakes -= 1

	End If

	If (ScreenEvent(@e)) Then
		Select Case e.type
		
		'' user pressed the mouse button
		Case EVENT_MOUSE_BUTTON_PRESS

			If (shakes = 0) Then
				'' set to do 20 shakes
				shakes = 20

				'' find current window coordinates to shake around
				ScreenControl GET_WINDOW_POS, x0, y0
			End If

		'' user closed the window or pressed a key
		Case EVENT_WINDOW_CLOSE, EVENT_KEY_PRESS
			'' exit to end of program
			Exit Do

		End Select
	End If

	'' free up CPU for other programs
	Sleep 5

Loop

9、图像的透明度处理

程序通过imagecreate创建一块像素存储内存，然后即可用circle和line在image绘RGBA格式的圆和线，它们的 A = alpha 值不同。左侧用put带参数Pset, 右侧用put 带参数alpha, 左右图的透明度发生了变化。

'' examples/manual/gfx/rgba.bas
''
'' Example extracted from the FreeBASIC Manual
'' from topic 'RGBA'
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgRgba
'' --------

'open a graphics screen (320 * 240, 32-bit)
ScreenRes 320, 240, 32

Dim As Any Ptr img
Dim As Integer x, y

'make an image that varies in transparency and color
img = ImageCreate(64, 64)
For x = 0 To 63
  For y = 0 To 63
	PSet img, (x, y), RGBA(x * 4, 0, y * 4, (x + y) * 2)
  Next y
Next x
Circle img, (31, 31), 25,      RGBA(0, 127, 192, 192), ,,, F 'semi-transparent blue circle
Line   img, (26, 20)-(38, 44), RGBA(255, 255, 255, 0),    BF 'transparent white rectangle

'draw a background (diagonal white lines)
For x = -240 To 319 Step 10
  Line (x, 0)-Step(240, 240), RGB(255, 255, 255)
Next

Line (10,  10)-(310,  37), RGB(127, 0, 0), BF 'red box for text
Line (10, 146)-(310, 229), RGB(0, 127, 0), BF 'green box for Putting onto

'draw the image and some text with PSET
Draw String(64, 20), "PSet"
Put(48,  48), img, PSet
Put(48, 156), img, PSet

'draw the image and some text with ALPHA
Draw String (220, 20), "Alpha"
Put(208,  48), img, Alpha
Put(208, 156), img, Alpha



'Free the image memory
ImageDestroy img

'Keep the window open until the user presses a key
Sleep

put 最后的参数如果是 xor 则两个白色图叠加时共有部份就变成黑色。

put 后带 Pset 与 put 后带 trans 参数的区别

put 后带参数 or 的叠加图

imagecrete 三个图，用and叠加的效果

几种效果放在一起的效果图，做图方式是一样的，还是创建像素内存块，画广场然后 put 上去。

'' examples/manual/gfx/put-all.bas
''
'' Example extracted from the FreeBASIC Manual
'' from topic 'PUT (GRAPHICS)'
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgPutgraphics
'' --------

Declare Function checkered_blend( ByVal src As ULong, ByVal dest As ULong, ByVal param As Any Ptr ) As ULong

   Screen 14, 32                                   '' set 320*240*32 gfx mode
   
   Dim As Any Ptr sprite
   Dim As Integer counter = 0
   
   sprite = ImageCreate( 32, 32 )                  '' allocate memory for 32x32 sprite
   
   Line sprite, ( 0, 0 )-( 31, 31 ), RGBA(255, 0, 0, 64), bf  '' draw a sprite ...
   Line sprite, ( 4, 4 )-( 27, 27 ), RGBA(255, 0, 0, 192), bf
   Line sprite, ( 0, 0 )-( 31, 31 ), RGB(0, 255, 0), b
   Line sprite, ( 8, 8 )-( 23, 23 ), RGBA(255, 0, 255, 64), bf
   Line sprite, ( 1, 1 )-( 30, 30 ), RGBA(0, 0, 255, 192)
   Line sprite, ( 30, 1 )-( 1, 30 ), RGBA(0, 0, 255, 192)
   
   Cls
   Dim As Integer i : For i = 0 To 63              '' draw the background
	  Line( i,0 )-( i,240 ), RGB( i * 4, i * 4, i * 4 )
   Next i
   
   '' demonstrate all drawing methods ...
   Put( 8,14 ), sprite, PSet
   Put Step( 16,20 ), sprite, PReset
   Put Step( -16,20 ), sprite, And
   Put Step( 16,20 ), sprite, Or
   Put Step( -16,20 ), sprite, Xor
   Put Step( 16,20 ), sprite, Trans
   Put Step( -16,20 ), sprite, Alpha, 96
   Put Step( 16,20 ), sprite, Alpha
   Put Step( -16,20 ), sprite, Add, 192
   Put Step( 16,20 ), sprite, Custom, @checkered_blend, @counter
   
   '' print a description near each demo
   Draw String (100, 26), "<- pset"
   Draw String Step (0, 20), "<- preset"
   Draw String Step (0, 20), "<- and"
   Draw String Step (0, 20), "<- or"
   Draw String Step (0, 20), "<- xor"
   Draw String Step (0, 20), "<- trans"
   Draw String Step (0, 20), "<- alpha (uniform)"
   Draw String Step (0, 20), "<- alpha (per pixel)"
   Draw String Step (0, 20), "<- add"
   Draw String Step (0, 20), "<- custom"
   
   ImageDestroy( sprite )                          '' free allocated memory for sprite
   Sleep : End 0

'' custom blender function: chequered put
Function checkered_blend( ByVal src As ULong, ByVal dest As ULong, ByVal param As Any Ptr ) As ULong
   Dim As Integer Ptr counter
   Dim As ULong pixel
   
   counter = Cast(Integer Ptr, param)
   pixel = IIf(((*counter And 4) Shr 2) Xor ((*counter And 128) Shr 7), src, dest)
   *counter += 1
   Return pixel
End Function

用bload 将当前工作区(screenset n, 0 中的 n 区)的像素存成文件，用bsave 将像素文件装入工作区，用screencopy 将工作区的像素考贝到当前的显示区。

如果将一个位图文件装到一个工作区，在另一个工作工绘图并与位置异或，然后进行显示，往复进行异或显示，就是一幅动态的火焰列马图。

''
'' This fbgfx example deals with:
'' - palette
'' - multiple pages and double buffering
'' - direct access to the screen memory
'' - drawing to GET/PUT buffers
''

#define MAX_EXPLOSIONS     32
#define MAX_EXPLOSION_SIZE 100

#include "fbgfx.bi"

'const FALSE = 0
'const TRUE = (-1)

type EXPLOSION_TYPE
	sprite as ubyte ptr
	x as integer
	y as integer
	used as integer
	count as integer
end type

sub animate_fire(byval buffer as ubyte ptr, byval new_ as integer = 0)
	dim w as integer, h as integer, pitch as integer
	dim c0 as integer, c1 as integer, c2 as integer, c3 as integer
	dim header as FB.PUT_HEADER ptr

	header = cast(FB.PUT_HEADER ptr, buffer)
	w = header->width
	h = header->height
	pitch = header->pitch

	if new_ then
		line buffer, (0, 0)-(w-1, h-1), 0, bf
		for i as integer = 0 to 5
			circle buffer, ((w\4)+(rnd*(w\2)), (h\4)+(rnd*(h\2))), (w\6), 191,,,,F
		next
	else
		for y as integer = 1 to h-2
			for x as integer = 1 to w-2
				c0 = buffer[32 + (y * pitch) + x - 1]
				c1 = buffer[32 + (y * pitch) + x + 1]
				c2 = buffer[32 + ((y - 1) * pitch) + x]
				c3 = buffer[32 + ((y + 1) * pitch) + x]
				c0 = ((c0 + c1 + c2 + c3) \ 4) - rnd*2
				if (cint(c0) < 0) then c0 = 0
				buffer[32 + (y * pitch) + x] = c0
			next
		next
	end if
end sub


	dim pal(256) as integer, r as integer, g as integer, b as integer
	dim explosion(MAX_EXPLOSIONS) as EXPLOSION_TYPE
	dim work_page as integer

	screen 14, 8, 3

	randomize timer

	'' load image and get palette
	screenset 2
	bload exepath() & "/../fblogo.bmp"
	palette get using pal

	'' image uses first 64 colors; since we need colors 0-191, we need to move
	'' these 64 colors into colors 192-255.
	screenlock
	dim as byte ptr pixel = screenptr()
	for i as integer = 0 to (320*240)-1
			pixel[i] = 192 + pixel[i]
	next
	screenunlock
	for i as integer = 0 to 63
		pal(192+i) = pal(i)
	next

	'' create fire palette
	for i as integer = 0 to 63
		pal(i) = i
		pal(64+i) = &h3F or (i shl 8)
		pal(128+i) = &h3F3F or (i shl 16)
	next
	palette using pal

	'' start demo
	screenset 1, 0
	work_page = 1

	do
		screencopy 2, work_page

		for i as integer = 0 to MAX_EXPLOSIONS-1
			if (explosion(i).used = FALSE) and ((rnd*50) < 1) then
				dim as integer size = (MAX_EXPLOSION_SIZE\4) + (rnd*((MAX_EXPLOSION_SIZE*3)/4))

				with explosion(i)
					.sprite = imagecreate( size, size )
					.x = rnd*320
					.y = rnd*240
					.used = TRUE
					.count = 192
				end with

				animate_fire( explosion(i).sprite, TRUE )
			end if

			if explosion(i).used then
				animate_fire( explosion(i).sprite )

				put (explosion(i).x, explosion(i).y), explosion(i).sprite, trans

				explosion(i).count -= 1
				if explosion(i).count <= 0 then
					explosion(i).used = FALSE
				end if
			end if
		next

		screensync
		work_page xor= 1
		screenset work_page, work_page xor 1
	loop while inkey = ""

10、 gfx 与 cairo 并用

gfx 绘图方便，它本身不能显示汉字，对少量的汉字可以做成图直接 put 上去。下面的方法是在 gfx 绘图尾部，调用 cairo 的绘图能力，将文本 “显示中文” show 到需要的位置。

'' examples/manual/gfx/put-or.bas
''
'' Example extracted from the FreeBASIC Manual
'' from topic 'OR'
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgOrGfx
'' --------
'' Modified: Mongnewer 9, March 2024

#INCLUDE ONCE "cairo/cairo.bi"

''open a graphics window
ScreenRes 320, 200, 32

''create 3 sprites containing red, green and blue circles
Const As Long r = 32
Dim As Any Ptr cr, cg, cb
cr = ImageCreate(r * 2 + 1, r * 2 + 1, RGBA(0, 0, 0, 0))
cg = ImageCreate(r * 2 + 1, r * 2 + 1, RGBA(0, 0, 0, 0))
cb = ImageCreate(r * 2 + 1, r * 2 + 1, RGBA(0, 0, 0, 0))
Circle cr, (r, r), r, RGB(255, 0, 0), , , 1, f
Circle cg, (r, r), r, RGB(0, 255, 0), , , 1, f
Circle cb, (r, r), r, RGB(0, 0, 255), , , 1, f

''put the sprite at three different multipier
''levels, overlapping each other in the middle
Put (146 - r, 108 - r), cr, Or
Put (174 - r, 108 - r), cg, Or
Put (160 - r,  84 - r), cb, Or

''free the memory used by the sprites
ImageDestroy cr
ImageDestroy cg
ImageDestroy cb

''pause the program before closing

  VAR c_s_t = cairo_image_surface_create_for_data( _
                SCREENPTR, CAIRO_FORMAT_ARGB32, _
                320, 200, 320 * 4)
  VAR crx = cairo_create(c_s_t)

  cairo_set_source_rgb(crx, 1.0, 1.0, 1.0) '         white background
  cairo_move_to(crx, 10, 20)  
  cairo_show_text(crx, "显示中文")

Sleep
  
  cairo_destroy(crx)  
  cairo_surface_destroy(c_s_t)
    
End 0