FreeBASIC 1.07 Release Discussion

[coderJeff]

I rebuilt the win64 packages, with only the DirectX bug fixed / changed from 1.07.2

• win64: FreeBASIC-1.07.3-win64.7z | FreeBASIC-1.07.3-win64.zip

The only difference is the gfxlib. So, if you already have 1.07.2, you can copy in just the libraries (about 165 KiB).

• win64 - gfxlib only: FreeBASIC-1.07.3-win64-gfxlib.zip

[UEZ]

Works properly now. Thx.

[Iczer]

I have some errors with 1.07.3 (but OK with 1.07.1):

Code: Select all

zstd.bi(39) error 14: Expected identifier, found '(' in 'declare function ZSTD_compressBound(byval srcSize as uinteger) as uinteger'

it' related to:

Code: Select all

#define ZSTD_COMPRESSBOUND(srcSize) (((srcSize) + ((srcSize) shr 8)) + iif((srcSize) < (128 shl 10), ((128 shl 10) - (srcSize)) shr 11, 0))
declare function ZSTD_compressBound(byval srcSize as uinteger) as uinteger

what i shoul do with this error?

[fxm]

I have some errors with 1.07.3 (but OK with 1.07.1)

That would surprise me a lot!

I think the "Define" is rather intended to be used as this (if there is a function returning it):

Code: Select all

#define ZSTD_COMPRESSBOUND(srcSize) (((srcSize) + ((srcSize) shr 8)) + iif((srcSize) < (128 shl 10), ((128 shl 10) - (srcSize)) shr 11, 0))

Function f (byval srcSize as uinteger) as uinteger
    Return ZSTD_COMPRESSBOUND(srcSize)
End Function

Otherwise, as a simple expression:
y = ZSTD_COMPRESSBOUND(x)

[Iczer]

i make this bi file with fbfrog:
from zstd.h:

Code: Select all

/*======  Helper functions  ======*/
#define ZSTD_COMPRESSBOUND(srcSize)   ((srcSize) + ((srcSize)>>8) + (((srcSize) < (128<<10)) ? (((128<<10) - (srcSize)) >> 11) /* margin, from 64 to 0 */ : 0))  /* this formula ensures that bound(A) + bound(B) <= bound(A+B) as long as A and B >= 128 KB */
ZSTDLIB_API size_t      ZSTD_compressBound(size_t srcSize); /*!< maximum compressed size in worst case single-pass scenario */

zstd.bi

Code: Select all

#pragma once

#include once "crt/limits.bi"
#include once "crt/stddef.bi"

#include once "zdict.bi"
#include once "zstd_errors.bi"

extern "C"

#define ZSTD_H_235446
#define ZSTDLIB_API ZSTDLIB_VISIBILITY
const ZSTD_VERSION_MAJOR = 1
const ZSTD_VERSION_MINOR = 4
const ZSTD_VERSION_RELEASE = 5
const ZSTD_VERSION_NUMBER = (((ZSTD_VERSION_MAJOR * 100) * 100) + (ZSTD_VERSION_MINOR * 100)) + ZSTD_VERSION_RELEASE
declare function ZSTD_versionNumber() as ulong
#define ZSTD_LIB_VERSION ZSTD_VERSION_MAJOR.ZSTD_VERSION_MINOR.ZSTD_VERSION_RELEASE
#define ZSTD_QUOTE(str) #str
#define ZSTD_EXPAND_AND_QUOTE(str) ZSTD_QUOTE(str)
#define ZSTD_VERSION_STRING ZSTD_EXPAND_AND_QUOTE(ZSTD_LIB_VERSION)
declare function ZSTD_versionString() as const zstring ptr
const ZSTD_CLEVEL_DEFAULT = 3
const ZSTD_MAGICNUMBER = &hFD2FB528
const ZSTD_MAGIC_DICTIONARY = &hEC30A437
const ZSTD_MAGIC_SKIPPABLE_START = &h184D2A50
const ZSTD_MAGIC_SKIPPABLE_MASK = &hFFFFFFF0
const ZSTD_BLOCKSIZELOG_MAX = 17
const ZSTD_BLOCKSIZE_MAX = 1 shl ZSTD_BLOCKSIZELOG_MAX
declare function ZSTD_compress(byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval compressionLevel as long) as uinteger
declare function ZSTD_decompress(byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval compressedSize as uinteger) as uinteger
const ZSTD_CONTENTSIZE_UNKNOWN = 0ull - 1
const ZSTD_CONTENTSIZE_ERROR = 0ull - 2

declare function ZSTD_getFrameContentSize(byval src as const any ptr, byval srcSize as uinteger) as ulongint
declare function ZSTD_getDecompressedSize(byval src as const any ptr, byval srcSize as uinteger) as ulongint
declare function ZSTD_findFrameCompressedSize(byval src as const any ptr, byval srcSize as uinteger) as uinteger
#define ZSTD_COMPRESSBOUND(srcSize) (((srcSize) + ((srcSize) shr 8)) + iif((srcSize) < (128 shl 10), ((128 shl 10) - (srcSize)) shr 11, 0))
declare function ZSTD_compressBound(byval srcSize as uinteger) as uinteger
declare function ZSTD_isError(byval code as uinteger) as ulong
declare function ZSTD_getErrorName(byval code as uinteger) as const zstring ptr
declare function ZSTD_minCLevel() as long
declare function ZSTD_maxCLevel() as long
type ZSTD_CCtx as ZSTD_CCtx_s
declare function ZSTD_createCCtx() as ZSTD_CCtx ptr
declare function ZSTD_freeCCtx(byval cctx as ZSTD_CCtx ptr) as uinteger
declare function ZSTD_compressCCtx(byval cctx as ZSTD_CCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval compressionLevel as long) as uinteger
type ZSTD_DCtx as ZSTD_DCtx_s
declare function ZSTD_createDCtx() as ZSTD_DCtx ptr
declare function ZSTD_freeDCtx(byval dctx as ZSTD_DCtx ptr) as uinteger
declare function ZSTD_decompressDCtx(byval dctx as ZSTD_DCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger) as uinteger

type ZSTD_strategy as long
enum
	ZSTD_fast = 1
	ZSTD_dfast = 2
	ZSTD_greedy = 3
	ZSTD_lazy = 4
	ZSTD_lazy2 = 5
	ZSTD_btlazy2 = 6
	ZSTD_btopt = 7
	ZSTD_btultra = 8
	ZSTD_btultra2 = 9
end enum

type ZSTD_cParameter as long
enum
	ZSTD_c_compressionLevel = 100
	ZSTD_c_windowLog = 101
	ZSTD_c_hashLog = 102
	ZSTD_c_chainLog = 103
	ZSTD_c_searchLog = 104
	ZSTD_c_minMatch = 105
	ZSTD_c_targetLength = 106
	ZSTD_c_strategy = 107
	ZSTD_c_enableLongDistanceMatching = 160
	ZSTD_c_ldmHashLog = 161
	ZSTD_c_ldmMinMatch = 162
	ZSTD_c_ldmBucketSizeLog = 163
	ZSTD_c_ldmHashRateLog = 164
	ZSTD_c_contentSizeFlag = 200
	ZSTD_c_checksumFlag = 201
	ZSTD_c_dictIDFlag = 202
	ZSTD_c_nbWorkers = 400
	ZSTD_c_jobSize = 401
	ZSTD_c_overlapLog = 402
	ZSTD_c_experimentalParam1 = 500
	ZSTD_c_experimentalParam2 = 10
	ZSTD_c_experimentalParam3 = 1000
	ZSTD_c_experimentalParam4 = 1001
	ZSTD_c_experimentalParam5 = 1002
	ZSTD_c_experimentalParam6 = 1003
	ZSTD_c_experimentalParam7 = 1004
end enum

type ZSTD_bounds
	error as uinteger
	lowerBound as long
	upperBound as long
end type

declare function ZSTD_cParam_getBounds(byval cParam as ZSTD_cParameter) as ZSTD_bounds
declare function ZSTD_CCtx_setParameter(byval cctx as ZSTD_CCtx ptr, byval param as ZSTD_cParameter, byval value as long) as uinteger
declare function ZSTD_CCtx_setPledgedSrcSize(byval cctx as ZSTD_CCtx ptr, byval pledgedSrcSize as ulongint) as uinteger

type ZSTD_ResetDirective as long
enum
	ZSTD_reset_session_only = 1
	ZSTD_reset_parameters = 2
	ZSTD_reset_session_and_parameters = 3
end enum

declare function ZSTD_CCtx_reset(byval cctx as ZSTD_CCtx ptr, byval reset as ZSTD_ResetDirective) as uinteger
declare function ZSTD_compress2(byval cctx as ZSTD_CCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger) as uinteger

type ZSTD_dParameter as long
enum
	ZSTD_d_windowLogMax = 100
	ZSTD_d_experimentalParam1 = 1000
	ZSTD_d_experimentalParam2 = 1001
end enum

declare function ZSTD_dParam_getBounds(byval dParam as ZSTD_dParameter) as ZSTD_bounds
declare function ZSTD_DCtx_setParameter(byval dctx as ZSTD_DCtx ptr, byval param as ZSTD_dParameter, byval value as long) as uinteger
declare function ZSTD_DCtx_reset(byval dctx as ZSTD_DCtx ptr, byval reset as ZSTD_ResetDirective) as uinteger

type ZSTD_inBuffer_s
	src as const any ptr
	size as uinteger
	pos as uinteger
end type

type ZSTD_inBuffer as ZSTD_inBuffer_s

type ZSTD_outBuffer_s
	dst as any ptr
	size as uinteger
	pos as uinteger
end type

type ZSTD_outBuffer as ZSTD_outBuffer_s
type ZSTD_CStream as ZSTD_CCtx
declare function ZSTD_createCStream() as ZSTD_CStream ptr
declare function ZSTD_freeCStream(byval zcs as ZSTD_CStream ptr) as uinteger

type ZSTD_EndDirective as long
enum
	ZSTD_e_continue = 0
	ZSTD_e_flush = 1
	ZSTD_e_end = 2
end enum

declare function ZSTD_compressStream2(byval cctx as ZSTD_CCtx ptr, byval output as ZSTD_outBuffer ptr, byval input as ZSTD_inBuffer ptr, byval endOp as ZSTD_EndDirective) as uinteger
declare function ZSTD_CStreamInSize() as uinteger
declare function ZSTD_CStreamOutSize() as uinteger
declare function ZSTD_initCStream(byval zcs as ZSTD_CStream ptr, byval compressionLevel as long) as uinteger
declare function ZSTD_compressStream(byval zcs as ZSTD_CStream ptr, byval output as ZSTD_outBuffer ptr, byval input as ZSTD_inBuffer ptr) as uinteger
declare function ZSTD_flushStream(byval zcs as ZSTD_CStream ptr, byval output as ZSTD_outBuffer ptr) as uinteger
declare function ZSTD_endStream(byval zcs as ZSTD_CStream ptr, byval output as ZSTD_outBuffer ptr) as uinteger
type ZSTD_DStream as ZSTD_DCtx
declare function ZSTD_createDStream() as ZSTD_DStream ptr
declare function ZSTD_freeDStream(byval zds as ZSTD_DStream ptr) as uinteger
declare function ZSTD_initDStream(byval zds as ZSTD_DStream ptr) as uinteger
declare function ZSTD_decompressStream(byval zds as ZSTD_DStream ptr, byval output as ZSTD_outBuffer ptr, byval input as ZSTD_inBuffer ptr) as uinteger
declare function ZSTD_DStreamInSize() as uinteger
declare function ZSTD_DStreamOutSize() as uinteger
declare function ZSTD_compress_usingDict(byval ctx as ZSTD_CCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval dict as const any ptr, byval dictSize as uinteger, byval compressionLevel as long) as uinteger
declare function ZSTD_decompress_usingDict(byval dctx as ZSTD_DCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval dict as const any ptr, byval dictSize as uinteger) as uinteger
type ZSTD_CDict as ZSTD_CDict_s
declare function ZSTD_createCDict(byval dictBuffer as const any ptr, byval dictSize as uinteger, byval compressionLevel as long) as ZSTD_CDict ptr
declare function ZSTD_freeCDict(byval CDict as ZSTD_CDict ptr) as uinteger
declare function ZSTD_compress_usingCDict(byval cctx as ZSTD_CCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval cdict as const ZSTD_CDict ptr) as uinteger
type ZSTD_DDict as ZSTD_DDict_s
declare function ZSTD_createDDict(byval dictBuffer as const any ptr, byval dictSize as uinteger) as ZSTD_DDict ptr
declare function ZSTD_freeDDict(byval ddict as ZSTD_DDict ptr) as uinteger
declare function ZSTD_decompress_usingDDict(byval dctx as ZSTD_DCtx ptr, byval dst as any ptr, byval dstCapacity as uinteger, byval src as const any ptr, byval srcSize as uinteger, byval ddict as const ZSTD_DDict ptr) as uinteger
declare function ZSTD_getDictID_fromDict(byval dict as const any ptr, byval dictSize as uinteger) as ulong
declare function ZSTD_getDictID_fromDDict(byval ddict as const ZSTD_DDict ptr) as ulong
declare function ZSTD_getDictID_fromFrame(byval src as const any ptr, byval srcSize as uinteger) as ulong
declare function ZSTD_CCtx_loadDictionary(byval cctx as ZSTD_CCtx ptr, byval dict as const any ptr, byval dictSize as uinteger) as uinteger
declare function ZSTD_CCtx_refCDict(byval cctx as ZSTD_CCtx ptr, byval cdict as const ZSTD_CDict ptr) as uinteger
declare function ZSTD_CCtx_refPrefix(byval cctx as ZSTD_CCtx ptr, byval prefix as const any ptr, byval prefixSize as uinteger) as uinteger
declare function ZSTD_DCtx_loadDictionary(byval dctx as ZSTD_DCtx ptr, byval dict as const any ptr, byval dictSize as uinteger) as uinteger
declare function ZSTD_DCtx_refDDict(byval dctx as ZSTD_DCtx ptr, byval ddict as const ZSTD_DDict ptr) as uinteger
declare function ZSTD_DCtx_refPrefix(byval dctx as ZSTD_DCtx ptr, byval prefix as const any ptr, byval prefixSize as uinteger) as uinteger
declare function ZSTD_sizeof_CCtx(byval cctx as const ZSTD_CCtx ptr) as uinteger
declare function ZSTD_sizeof_DCtx(byval dctx as const ZSTD_DCtx ptr) as uinteger
declare function ZSTD_sizeof_CStream(byval zcs as const ZSTD_CStream ptr) as uinteger
declare function ZSTD_sizeof_DStream(byval zds as const ZSTD_DStream ptr) as uinteger
declare function ZSTD_sizeof_CDict(byval cdict as const ZSTD_CDict ptr) as uinteger
declare function ZSTD_sizeof_DDict(byval ddict as const ZSTD_DDict ptr) as uinteger

end extern

zdict.bi

Code: Select all

#pragma once

#include once "crt/stddef.bi"

extern "C"

#define DICTBUILDER_H_001
#define ZDICTLIB_API ZDICTLIB_VISIBILITY
declare function ZDICT_trainFromBuffer(byval dictBuffer as any ptr, byval dictBufferCapacity as uinteger, byval samplesBuffer as const any ptr, byval samplesSizes as const uinteger ptr, byval nbSamples as ulong) as uinteger

type ZDICT_params_t
	compressionLevel as long
	notificationLevel as ulong
	dictID as ulong
end type

declare function ZDICT_finalizeDictionary(byval dstDictBuffer as any ptr, byval maxDictSize as uinteger, byval dictContent as const any ptr, byval dictContentSize as uinteger, byval samplesBuffer as const any ptr, byval samplesSizes as const uinteger ptr, byval nbSamples as ulong, byval parameters as ZDICT_params_t) as uinteger
declare function ZDICT_getDictID(byval dictBuffer as const any ptr, byval dictSize as uinteger) as ulong
declare function ZDICT_getDictHeaderSize(byval dictBuffer as const any ptr, byval dictSize as uinteger) as uinteger
declare function ZDICT_isError(byval errorCode as uinteger) as ulong
declare function ZDICT_getErrorName(byval errorCode as uinteger) as const zstring ptr

end extern

zstd_errors.bi

Code: Select all

#pragma once

#include once "crt/stddef.bi"

extern "C"

#define ZSTD_ERRORS_H_398273423
#define ZSTDERRORLIB_API ZSTDERRORLIB_VISIBILITY

type ZSTD_ErrorCode as long
enum
	ZSTD_error_no_error = 0
	ZSTD_error_GENERIC = 1
	ZSTD_error_prefix_unknown = 10
	ZSTD_error_version_unsupported = 12
	ZSTD_error_frameParameter_unsupported = 14
	ZSTD_error_frameParameter_windowTooLarge = 16
	ZSTD_error_corruption_detected = 20
	ZSTD_error_checksum_wrong = 22
	ZSTD_error_dictionary_corrupted = 30
	ZSTD_error_dictionary_wrong = 32
	ZSTD_error_dictionaryCreation_failed = 34
	ZSTD_error_parameter_unsupported = 40
	ZSTD_error_parameter_outOfBound = 42
	ZSTD_error_tableLog_tooLarge = 44
	ZSTD_error_maxSymbolValue_tooLarge = 46
	ZSTD_error_maxSymbolValue_tooSmall = 48
	ZSTD_error_stage_wrong = 60
	ZSTD_error_init_missing = 62
	ZSTD_error_memory_allocation = 64
	ZSTD_error_workSpace_tooSmall = 66
	ZSTD_error_dstSize_tooSmall = 70
	ZSTD_error_srcSize_wrong = 72
	ZSTD_error_dstBuffer_null = 74
	ZSTD_error_frameIndex_tooLarge = 100
	ZSTD_error_seekableIO = 102
	ZSTD_error_dstBuffer_wrong = 104
	ZSTD_error_maxCode = 120
end enum

declare function ZSTD_getErrorCode(byval functionResult as uinteger) as ZSTD_ErrorCode
declare function ZSTD_getErrorString(byval code as ZSTD_ErrorCode) as const zstring ptr

end extern

function ZSTD_compressBound is actually exist in zstd library.
so - simpliest way to resolve this error would be just comment #define ZSTD_COMPRESSBOUND , but why fbc 1.07.1 not complain about zstd.bi?

[jevans4949]

I have a problem with GAS64 when trying to compile a program including the fltk-c macros. Compilimg with GCC works OK but with GAS64 i get the following.

fltktest.a64: Assembler messages:
fltktest.a64:14804: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:14985: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15078: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15259: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15528: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15709: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15802: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'
fltktest.a64:15983: Error: no such instruction: `found AN ERROR:BOP datatype not handled 01=528'

These messages also occur in the A64 file.

To isolate the problem, I set up a test BAS file with one line:

#Include Once "fltk/fltk-c.bi"

The "problem code" is in the subsidiary include fltk-glut.bi;if I comment this out the problem disappears. There is no datatype BOP in the source code, so I assume it's something generated by GAS64, or else some sort of overflow problem; There are some quite complex assignments in the code.

I could try analysing the A64 file myself, but somebody who knows GAS64 could probably identify what is going wrong quicker.

This is happening with version 1.07.3; I also tried it with the GAS64 "fork" before 1.07.1, and got the same result.

[SARG]

I could try analysing the A64 file myself, but somebody who knows GAS64 could probably identify what is going wrong quicker.

Sure I could as I'm the author ;-)
You seems to get a a64 file so could you just post the lines before the error (10 should be enough). Otherwise tomorrow I'll try on my side I just need to retrieve the fltk files.

These messages also occur in the A64 file.

Exact. These are errors met by the emitter (which generates asm code) but for an easy retrieving they are also translated in faulty asm code.
In the case you reported a datatype (integer, long, byte, etc) is not recognized when an operator with 2 arguments (bop) is used. Anyway that's strange.

Code: Select all

	tempodtype=typeGetDtAndPtrOnly( v1->dtype )
	if typeisptr(tempodtype) then tempodtype=FB_DATATYPE_INTEGER
	select case tempodtype
		case FB_DATATYPE_INTEGER,FB_DATATYPE_UINT,FB_DATATYPE_LONGINT,FB_DATATYPE_ULONGINT,FB_DATATYPE_ENUM,FB_DATATYPE_DOUBLE
			prefix1="QWORD PTR "
		case FB_DATATYPE_LONG,FB_DATATYPE_ULONG,FB_DATATYPE_SINGLE
			prefix1="DWORD PTR "
		case FB_DATATYPE_SHORT,FB_DATATYPE_USHORT
			prefix1="WORD PTR "
		case FB_DATATYPE_BYTE,FB_DATATYPE_UBYTE,FB_DATATYPE_BOOLEAN,FB_DATATYPE_CHAR
			prefix1="BYTE PTR "
		case else
			asm_error("BOP datatype not handled 01 ="+typedumpToStr(v1->dtype,0))
	end select

I hope to be able to fix this issue quickly.

[SARG]

Fixed.
one minor issue : the message was for unary operator (UOP) not BOP, copy and paste with no change.......
major issue : 'as const for simple datatype' was not handled when an UOP is used.

I guess there will not be a 1.07.4 so you can use this (based on 1.07.2) : https://users.freebasic-portal.de/sarg/fbc64_SARG.zip

@jevans4949 Thank you for having isolating the problem ;-)

[jevans4949]

It works!

Thank you for your quick response.

[jmgbsas]

Discussion of FreeBASIC 1.07.x releases, issues, comments, remarks, etc. Full release announcement is posted at Version 1.07.0 released.

Original opening post follows. Sorry SARG, this is a good topic to commandeer for the discussion :) -- Jeff

----

Hi coderJeff,

Thanks for this new version.

The link to the change log on the released version 1.07 page --> "page not found"

By the way always working on gas64. For now lot of bugs fixed using the test suite :-) however the road is long :-(

Thanks,I am using FB 1.07.2 in a Grapchis Cairo application. I am studying cairo, my first graphics application. I found in the forum that GDI gives the focus when starting the application, for that reason I don't use Directx- I downloaded the new libfbgfx libraries, in development mode I know,and tried Directx . Now I have fine focus.
But I want to mention that I have 2 surfaces in a window one on top of the other and I have events clicking in some places depending on Getmouse x, y, with Directx now I lost the relationship between the place click xy and the graphic place where the click should be. This happens to me with the surface Cairo, Screenres and moveWindow MoveWindow (hWnd, 0, (0 + h-HIGH) \ 2, WIDTH, HIGHT, TRUE), it is a very specific observation. I hope it is useful and that they can understand it. I am using Screen without Frame. Thanks.

[jj2007]

GDI gives the focus when starting the application

SetFocus

[jmgbsas]

GDI gives the focus when starting the application

SetFocus

Thanks But I have not problem with focus with directx in the new version added in zip mode ,,I do not need SetFocus.focus run ok in directx..My new problem is the lost of pixel position graphics and my draw. I have done buttons graphics and theresize is more big now and change the position of x,y respect of the draw, if you need I can send 2 binary compiled with GDI and Directx in github to see the efect..I am new in all this...I have poor knowledge...Thanks ...
here I add two binary version of directx, if you want to see, old and new in thename you can watch the effect with F7/F8 , many many F7 show the issue and the lines and letters overwrite too....
or clicking in the up cornes - / + buttons, you will see how the bottons lost the place , in GDI and old Directx that not occur..(my code is very poor I am not a good programmer yet, many globals is a draft, not modualrizated yet and poor algorithms...) in the main directory is the version with GDI..
https://github.com/jmgbsas/ROLLMUSIC/tr ... rectxIssue

[dodicat]

Discussion of FreeBASIC 1.07.x releases, issues, comments, remarks, etc. Full release announcement is posted at Version 1.07.0 released.

Original opening post follows. Sorry SARG, this is a good topic to commandeer for the discussion :) -- Jeff

----

Hi coderJeff,

Thanks for this new version.

The link to the change log on the released version 1.07 page --> "page not found"

By the way always working on gas64. For now lot of bugs fixed using the test suite :-) however the road is long :-(

Thanks,I am using FB 1.07.2 in a Grapchis Cairo application. I am studying cairo, my first graphics application. I found in the forum that GDI gives the focus when starting the application, for that reason I don't use Directx- I downloaded the new libfbgfx libraries, in development mode I know,and tried Directx . Now I have fine focus.
But I want to mention that I have 2 surfaces in a window one on top of the other and I have events clicking in some places depending on Getmouse x, y, with Directx now I lost the relationship between the place click xy and the graphic place where the click should be. This happens to me with the surface Cairo, Screenres and moveWindow MoveWindow (hWnd, 0, (0 + h-HIGH) \ 2, WIDTH, HIGHT, TRUE), it is a very specific observation. I hope it is useful and that they can understand it. I am using Screen without Frame. Thanks.

Here are some cairo subs.
Getmouse gets the actual screen co-ordinates as you expand or contract with MoveWindow.(using fb screen)
Always dissapointing framerates using cairo graphics.
Use the wheel to alter the window.

Code: Select all

'SetEnviron("fbgfx=GDI")
Declare Function MoveWindow Alias "MoveWindow"(As Any Ptr,As Integer,As Integer,As Integer,As Integer,As Integer) As Integer

dim as integer w,h
screeninfo w,h
#include once "cairo/cairo.bi" 
#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

Dim Shared As cairo_font_extents_t _fonts  
Dim Shared As cairo_text_extents_t _text
Const pi=4*Atn(1)

Sub InitFonts(surf As cairo_t Ptr,fonttype As String="times new roman")
    If Len(fonttype) Then
        cairo_select_font_face (surf,fonttype, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
    End If
    cairo_font_extents (surf, @_fonts)
End Sub

Sub Cprint(surf As cairo_t Ptr,x As Long,y As Long,text As String,size As Single,colour As Ulong)
    cairo_set_font_size (surf,(size))
    cairo_move_to (surf, _ '                 lower left corner of text
    (x) - (_text.width / 2 + _text.x_bearing), _
    (y) + (_text.height / 2) - _fonts.descent)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_show_text(surf, text)
    cairo_stroke(surf)
End Sub

'rectangle unused
Sub Crectangle(surf As cairo_t Ptr,x As Long,y As Long,wide As Long,high As Long,thickness As Single,colour As Ulong)
    cairo_set_line_width(surf, (thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_move_to(surf, (x), (y))
    cairo_rectangle(surf,(x),(y),(wide),(high))
    cairo_stroke(surf)
End Sub

Sub Crectanglefill(surf As cairo_t Ptr,x As Long,y As Long,wide As Long,high As Long,colour As Ulong)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    'cairo_move_to(surf, (x), (y))
    cairo_rectangle(surf,(x),(y),(wide),(high))
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub

Sub Ccircle(Byref surf As cairo_t Ptr,cx As Long,cy As Long,radius As Long,start As Single,finish As Single,thickness As Single,colour As Ulong,Capoption As boolean)
    cairo_set_line_width(surf,(thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius),(start),(finish))
    If Capoption Then 
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
    Else
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
    End If
    cairo_stroke(surf)
End Sub

Sub Ccirclefill(Byref surf As cairo_t Ptr,cx As Long,cy As Long,radius As Long,colour As Ulong)
    cairo_set_line_width(surf,(1))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius),(0),(2*pi))
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub


Sub Cline(surf As cairo_t Ptr,x1 As Long,y1 As Long,x2 As Long,y2 As Long,thickness As Single,colour As Ulong,CapOption As boolean)
    cairo_set_line_width(surf, (thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_move_to(surf, (x1), (y1))
    cairo_line_to(surf,(x2),(y2))
    If Capoption Then 
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
    Else
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
    End If
    cairo_stroke(surf)
End Sub

Sub cpaint(surf As cairo_t Ptr,x As Long,y As Long,colour As Ulong)
    cairo_move_to(surf,x,y)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub

Sub SetBackgroundColour(c As cairo_t Ptr,colour As Ulong)
    cairo_set_source_rgba c,_rd_,_gr_,_bl_,_al_
    cairo_paint(c)
End Sub

Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32,,&h08 Or &h40
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Static As cairo_t Ptr res
    res= cairo_create(surface)
    Return res
End Function

Sub cflip(surf As cairo_t Ptr)
    cairo_stroke(surf)
End Sub

Type ball
    x As Single    'position x component
    y As Single    'position y component
    dx As Single   'velocity x component
    dy As Single   'velocity y component
    a As Single     'angular distance
    da As Single   'angular speed
    col As Ulong   'colour
    col2 As Ulong  'contrast to col (for ball texture)
    As Long r,m    'radius, mass
End Type


Sub texture3(c As cairo_t Ptr,xpos As Long,ypos As Long,size As Long,col1 As Ulong,col2 As Ulong,an As Single,num As Long=0)
    ccirclefill(c,xpos,ypos,size,col1)
    Var l=2+size/2
    cairo_save(c)
    Var tx=xpos-l,ty=ypos+l/1.5
    cairo_translate(c,xpos,ypos)
    cairo_rotate(c, an)
    cairo_translate(c,-xpos,-ypos)
    cprint(c,tx,ty,Right("00"+Str(num),2),size,col2)
    cairo_restore(c)  
End Sub


Sub MoveAndDraw(c As cairo_t Ptr, b() As ball,Byref e As Long,Byref ae As Long,i As Any Ptr=0)'get energy also
    For n As Long=Lbound(b) To Ubound(b)
        b(n).x+=b(n).dx:b(n).y+=b(n).dy
        b(n).a+=b(n).da*(1/b(n).r)
        texture3(c,b(n).x,b(n).y,b(n).r,b(n).col2,b(n).col,b(n).a,n)
        e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)
        ae+=b(n).da*b(n).da
    Next n
End Sub

Sub edges(b() As ball,xres As Long,yres As Long,Byref status As Long ) 'get status also
    For n As Long=Lbound(b) To Ubound(b) 
        If(b(n).x<b(n).r) Then b(n).x=b(n).r: b(n).dx=-b(n).dx:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        If(b(n).x>xres-b(n).r )Then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        
        If(b(n).y<b(n).r)Then b(n).y=b(n).r:b(n).dy=-b(n).dy:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If(b(n).y>yres-b(n).r)Then  b(n).y=yres-b(n).r:b(n).dy=-b(n).dy:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If b(n).x<0 Or b(n).x>xres Then status=0
        If b(n).y<0 Or b(n).y>yres Then status=0
    Next n
End Sub

Function DetectBallCollisions( B1 As ball,B2 As ball) As Single 'avoid using sqr if they are well seperated
    Dim As Single xdiff = B2.x-B1.x
    Dim As Single ydiff = B2.y-B1.y
    If Abs(xdiff) > (B2.r+B1.r) Then Return 0
    If Abs(ydiff) > (B2.r+B1.r) Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(B2.r+B1.r) Then Function=L Else Function=0
End Function

Sub BallCollisions(b() As ball)
    For n1 As Long=Lbound(b) To Ubound(b)-1
        For n2 As Long=n1+1 To Ubound(b)
            Dim As Single  L= DetectBallCollisions(b(n1),b(n2))
            If L Then
                Dim As Single  impulsex=(b(n1).x-b(n2).x)/L
                Dim As Single  impulsey=(b(n1).y-b(n2).y)/L
                'set one ball to nearest non overlap position
                b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex
                b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey
                
                Dim As Single  impactx=b(n1).dx-b(n2).dx
                Dim As Single  impacty=b(n1).dy-b(n2).dy
                
                Dim As Single  dot=impactx*impulsex+impacty*impulsey
                Dim As Single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)
                
                b(n1).dx-=dot*impulsex*2*mn1 
                b(n1).dy-=dot*impulsey*2*mn1 
                b(n2).dx+=dot*impulsex*2*mn2 
                b(n2).dy+=dot*impulsey*2*mn2 
                
                Dim As Single at1=(Atan2(b(n1).dy,b(n1).dx)),AT2=(Atan2(b(n2).dy,b(n2).dx))
                at1=Sgn(at1)*Iif(at1<0,pi+at1,pi-at1)
                at2=Sgn(at2)*Iif(at2<0,pi+at2,pi-at2)
                b(n1).da=at1'-
                b(n2).da=at2'-
            End If
        Next n2
    Next n1
End Sub

Sub circles(numballs As Long,OutsideRadius As Long,cx As Long,cy As Long,a() As ball)
    Redim a(1 To numballs+1)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius
    #define rad *pi/180  
    Dim As Long counter
    num= (45*(2*numballs-4)/numballs) rad
    num=Cos(num)
    r=num/(1+num)
    bigr=((1-r))*k  'radius to ring ball centres
    r=(r)*k -1        'radius of ring balls
    For z As Double=0 To 2*pi Step 2*pi/numballs
        counter+=1
        x=cx+bigr*Cos(z)
        y=cy+bigr*Sin(z)
        If counter>numballs Then Exit For
        a(counter).x=x
        a(counter).y=y
        a(counter).r=r
    Next z
    
    a(Ubound(a)).x=cx
    a(Ubound(a)).y=cy
    a(Ubound(a)).r=OutsideRadius-r*2-2
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Function contrast(c As Ulong) As Ulong
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
    'get the rgb values
    Dim As Ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
    Do
        r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
        'get at least 120 ubyte difference
    Loop Until Abs(r-r2)>120 Andalso Abs(g-g2)>120 Andalso Abs(b-b2)>120
    Return Rgb(r2,g2,b2) 
End Function


Dim As cairo_t Ptr c=setscreen(1024,768)
initfonts(c,"georgia")
Dim As Integer xres,yres
Screeninfo xres,yres

Dim As Long energy,angenergy,status=1,fps
Redim As ball b()
circles(15,250,xres/3,yres/2,b())
Randomize 3
For n As Long=Lbound(b) To Ubound(b)
    With b(n)
        .dx=0
        .dy=0
        .col=Rgb(Rnd*255,Rnd*255,Rnd*255)
        .col2=contrast(.col)
        '.r (determined in circles sub)
        .m=.r^2
    End With
Next
cprint(c,10,30,"Press a key",30,Rgba(255,255,255,255))
Screenlock
MoveAndDraw(c,b(),0,0)'first view (static)
Screenunlock
Sleep
b(1).dx=12 'set system alive

Dim As Integer I
Screencontrol(2,I)'getwindowhandle
Dim As Any Ptr Win = Cast(Any Ptr,I)
dim as long mx,my,mw
#define map(a,b,x,c,d)  ((d)-(c))*((x)-(a))\((b)-(a))+(c)
var f=768/1024 'screen ratio correction
While 1
   
    getmouse mx,my,mw
    MoveWindow(win,0,0,1024+mw*5,768+mw*5*f,1)
    
    energy=0
    AngEnergy=0
    edges(b(),xres,yres,status)
    BallCollisions(b())
   var dx=map(0,(1024+5*mw),mx,0,1024)
   var dy=map(0,(768+5*mw*f),my,0,768)
    Screenlock
    cls
    MoveAndDraw(c,b(),energy,AngEnergy)
    cprint(c,50,25," Press escape key to end",25,Rgba(255,255,255,255))
    cprint(c,50,55," framerate " &fps ,25,Rgba(0,200,0,255))
    Draw String (50,100),"Kinetic energy " &energy
    Draw String (50,140),"Angular energy " & AngEnergy
    Draw String (50,190),"System stauus " & Iif(status,"OK","Leaks")
    cprint(c,600,50,"mouse " +str(mx) + " , " + str(my),25,rgba(0,200,0,255))
    cprint(c,600-8*7,100,"mapmouse " +str(dx) + " , " + str(dy),25,rgba(0,200,0,255))
    
    cprint(c,600,150,"wheel " +str(mw),25,rgba(0,200,0,255))
    cprint(c,600,200,"desktop " +str(w)+ " , " + str(h),25,rgba(0,200,0,255))
    Screenunlock
    Sleep regulate(100,fps)
    If Inkey=Chr(27) Then Exit While
Wend
 

Note:
This runs on 32 bit compiler.
I don't know about the 64 bit compiler, there were issues with Movewindow().

[jmgbsas]

Discussion of FreeBASIC 1.07.x releases, issues, comments, remarks, etc. Full release announcement is posted at Version 1.07.0 released.

Original opening post follows. Sorry SARG, this is a good topic to commandeer for the discussion :) -- Jeff

----

Hi coderJeff,

Thanks for this new version.

The link to the change log on the released version 1.07 page --> "page not found"

By the way always working on gas64. For now lot of bugs fixed using the test suite :-) however the road is long :-(

Thanks,I am using FB 1.07.2 in a Grapchis Cairo application. I am studying cairo, my first graphics application. I found in the forum that GDI gives the focus when starting the application, for that reason I don't use Directx- I downloaded the new libfbgfx libraries, in development mode I know,and tried Directx . Now I have fine focus.
But I want to mention that I have 2 surfaces in a window one on top of the other and I have events clicking in some places depending on Getmouse x, y, with Directx now I lost the relationship between the place click xy and the graphic place where the click should be. This happens to me with the surface Cairo, Screenres and moveWindow MoveWindow (hWnd, 0, (0 + h-HIGH) \ 2, WIDTH, HIGHT, TRUE), it is a very specific observation. I hope it is useful and that they can understand it. I am using Screen without Frame. Thanks.

Here are some cairo subs.
Getmouse gets the actual screen co-ordinates as you expand or contract with MoveWindow.(using fb screen)
Always dissapointing framerates using cairo graphics.
Use the wheel to alter the window.

Code: Select all

'SetEnviron("fbgfx=GDI")
Declare Function MoveWindow Alias "MoveWindow"(As Any Ptr,As Integer,As Integer,As Integer,As Integer,As Integer) As Integer

dim as integer w,h
screeninfo w,h
#include once "cairo/cairo.bi" 
#define _rd_ Cast(Ubyte Ptr,@colour)[2]/255
#define _gr_ Cast(Ubyte Ptr,@colour)[1]/255
#define _bl_ Cast(Ubyte Ptr,@colour)[0]/255
#define _al_ Cast(Ubyte Ptr,@colour)[3]/255

Dim Shared As cairo_font_extents_t _fonts  
Dim Shared As cairo_text_extents_t _text
Const pi=4*Atn(1)

Sub InitFonts(surf As cairo_t Ptr,fonttype As String="times new roman")
    If Len(fonttype) Then
        cairo_select_font_face (surf,fonttype, CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_BOLD)
    End If
    cairo_font_extents (surf, @_fonts)
End Sub

Sub Cprint(surf As cairo_t Ptr,x As Long,y As Long,text As String,size As Single,colour As Ulong)
    cairo_set_font_size (surf,(size))
    cairo_move_to (surf, _ '                 lower left corner of text
    (x) - (_text.width / 2 + _text.x_bearing), _
    (y) + (_text.height / 2) - _fonts.descent)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_show_text(surf, text)
    cairo_stroke(surf)
End Sub

'rectangle unused
Sub Crectangle(surf As cairo_t Ptr,x As Long,y As Long,wide As Long,high As Long,thickness As Single,colour As Ulong)
    cairo_set_line_width(surf, (thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_move_to(surf, (x), (y))
    cairo_rectangle(surf,(x),(y),(wide),(high))
    cairo_stroke(surf)
End Sub

Sub Crectanglefill(surf As cairo_t Ptr,x As Long,y As Long,wide As Long,high As Long,colour As Ulong)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    'cairo_move_to(surf, (x), (y))
    cairo_rectangle(surf,(x),(y),(wide),(high))
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub

Sub Ccircle(Byref surf As cairo_t Ptr,cx As Long,cy As Long,radius As Long,start As Single,finish As Single,thickness As Single,colour As Ulong,Capoption As boolean)
    cairo_set_line_width(surf,(thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius),(start),(finish))
    If Capoption Then 
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
    Else
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
    End If
    cairo_stroke(surf)
End Sub

Sub Ccirclefill(Byref surf As cairo_t Ptr,cx As Long,cy As Long,radius As Long,colour As Ulong)
    cairo_set_line_width(surf,(1))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_arc(surf,(cx),(cy),(radius),(0),(2*pi))
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub


Sub Cline(surf As cairo_t Ptr,x1 As Long,y1 As Long,x2 As Long,y2 As Long,thickness As Single,colour As Ulong,CapOption As boolean)
    cairo_set_line_width(surf, (thickness))
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_move_to(surf, (x1), (y1))
    cairo_line_to(surf,(x2),(y2))
    If Capoption Then 
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_ROUND)
    Else
        cairo_set_line_cap(surf,CAIRO_LINE_CAP_SQUARE)
    End If
    cairo_stroke(surf)
End Sub

Sub cpaint(surf As cairo_t Ptr,x As Long,y As Long,colour As Ulong)
    cairo_move_to(surf,x,y)
    cairo_set_source_rgba surf,_rd_,_gr_,_bl_,_al_
    cairo_fill(surf)
    cairo_stroke(surf)
End Sub

Sub SetBackgroundColour(c As cairo_t Ptr,colour As Ulong)
    cairo_set_source_rgba c,_rd_,_gr_,_bl_,_al_
    cairo_paint(c)
End Sub

Function setscreen(xres As Integer,yres As Integer)  As cairo_t Ptr
    Screenres xres,yres,32,,&h08 Or &h40
    Width 8\xres,16\yres
    Var surface = cairo_image_surface_create_for_data(Screenptr(), CAIRO_FORMAT_ARGB32,xres,yres,xres*4)
    Static As cairo_t Ptr res
    res= cairo_create(surface)
    Return res
End Function

Sub cflip(surf As cairo_t Ptr)
    cairo_stroke(surf)
End Sub

Type ball
    x As Single    'position x component
    y As Single    'position y component
    dx As Single   'velocity x component
    dy As Single   'velocity y component
    a As Single     'angular distance
    da As Single   'angular speed
    col As Ulong   'colour
    col2 As Ulong  'contrast to col (for ball texture)
    As Long r,m    'radius, mass
End Type


Sub texture3(c As cairo_t Ptr,xpos As Long,ypos As Long,size As Long,col1 As Ulong,col2 As Ulong,an As Single,num As Long=0)
    ccirclefill(c,xpos,ypos,size,col1)
    Var l=2+size/2
    cairo_save(c)
    Var tx=xpos-l,ty=ypos+l/1.5
    cairo_translate(c,xpos,ypos)
    cairo_rotate(c, an)
    cairo_translate(c,-xpos,-ypos)
    cprint(c,tx,ty,Right("00"+Str(num),2),size,col2)
    cairo_restore(c)  
End Sub


Sub MoveAndDraw(c As cairo_t Ptr, b() As ball,Byref e As Long,Byref ae As Long,i As Any Ptr=0)'get energy also
    For n As Long=Lbound(b) To Ubound(b)
        b(n).x+=b(n).dx:b(n).y+=b(n).dy
        b(n).a+=b(n).da*(1/b(n).r)
        texture3(c,b(n).x,b(n).y,b(n).r,b(n).col2,b(n).col,b(n).a,n)
        e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)
        ae+=b(n).da*b(n).da
    Next n
End Sub

Sub edges(b() As ball,xres As Long,yres As Long,Byref status As Long ) 'get status also
    For n As Long=Lbound(b) To Ubound(b) 
        If(b(n).x<b(n).r) Then b(n).x=b(n).r: b(n).dx=-b(n).dx:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        If(b(n).x>xres-b(n).r )Then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dy)
        
        If(b(n).y<b(n).r)Then b(n).y=b(n).r:b(n).dy=-b(n).dy:b(n).da=-Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If(b(n).y>yres-b(n).r)Then  b(n).y=yres-b(n).r:b(n).dy=-b(n).dy:b(n).da=Abs(Atan2(b(n).dy,b(n).dx))*Sgn(b(n).dx)
        If b(n).x<0 Or b(n).x>xres Then status=0
        If b(n).y<0 Or b(n).y>yres Then status=0
    Next n
End Sub

Function DetectBallCollisions( B1 As ball,B2 As ball) As Single 'avoid using sqr if they are well seperated
    Dim As Single xdiff = B2.x-B1.x
    Dim As Single ydiff = B2.y-B1.y
    If Abs(xdiff) > (B2.r+B1.r) Then Return 0
    If Abs(ydiff) > (B2.r+B1.r) Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(B2.r+B1.r) Then Function=L Else Function=0
End Function

Sub BallCollisions(b() As ball)
    For n1 As Long=Lbound(b) To Ubound(b)-1
        For n2 As Long=n1+1 To Ubound(b)
            Dim As Single  L= DetectBallCollisions(b(n1),b(n2))
            If L Then
                Dim As Single  impulsex=(b(n1).x-b(n2).x)/L
                Dim As Single  impulsey=(b(n1).y-b(n2).y)/L
                'set one ball to nearest non overlap position
                b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex
                b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey
                
                Dim As Single  impactx=b(n1).dx-b(n2).dx
                Dim As Single  impacty=b(n1).dy-b(n2).dy
                
                Dim As Single  dot=impactx*impulsex+impacty*impulsey
                Dim As Single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)
                
                b(n1).dx-=dot*impulsex*2*mn1 
                b(n1).dy-=dot*impulsey*2*mn1 
                b(n2).dx+=dot*impulsex*2*mn2 
                b(n2).dy+=dot*impulsey*2*mn2 
                
                Dim As Single at1=(Atan2(b(n1).dy,b(n1).dx)),AT2=(Atan2(b(n2).dy,b(n2).dx))
                at1=Sgn(at1)*Iif(at1<0,pi+at1,pi-at1)
                at2=Sgn(at2)*Iif(at2<0,pi+at2,pi-at2)
                b(n1).da=at1'-
                b(n2).da=at2'-
            End If
        Next n2
    Next n1
End Sub

Sub circles(numballs As Long,OutsideRadius As Long,cx As Long,cy As Long,a() As ball)
    Redim a(1 To numballs+1)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius
    #define rad *pi/180  
    Dim As Long counter
    num= (45*(2*numballs-4)/numballs) rad
    num=Cos(num)
    r=num/(1+num)
    bigr=((1-r))*k  'radius to ring ball centres
    r=(r)*k -1        'radius of ring balls
    For z As Double=0 To 2*pi Step 2*pi/numballs
        counter+=1
        x=cx+bigr*Cos(z)
        y=cy+bigr*Sin(z)
        If counter>numballs Then Exit For
        a(counter).x=x
        a(counter).y=y
        a(counter).r=r
    Next z
    
    a(Ubound(a)).x=cx
    a(Ubound(a)).y=cy
    a(Ubound(a)).r=OutsideRadius-r*2-2
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Function contrast(c As Ulong) As Ulong
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
    'get the rgb values
    Dim As Ubyte r=Cptr(Ubyte Ptr,@c)[2],g=Cptr(Ubyte Ptr,@c)[1],b=Cptr(Ubyte Ptr,@c)[0],r2,g2,b2
    Do
        r2=Intrange(0,255):g2=IntRange(0,255):b2=IntRange(0,255)
        'get at least 120 ubyte difference
    Loop Until Abs(r-r2)>120 Andalso Abs(g-g2)>120 Andalso Abs(b-b2)>120
    Return Rgb(r2,g2,b2) 
End Function


Dim As cairo_t Ptr c=setscreen(1024,768)
initfonts(c,"georgia")
Dim As Integer xres,yres
Screeninfo xres,yres

Dim As Long energy,angenergy,status=1,fps
Redim As ball b()
circles(15,250,xres/3,yres/2,b())
Randomize 3
For n As Long=Lbound(b) To Ubound(b)
    With b(n)
        .dx=0
        .dy=0
        .col=Rgb(Rnd*255,Rnd*255,Rnd*255)
        .col2=contrast(.col)
        '.r (determined in circles sub)
        .m=.r^2
    End With
Next
cprint(c,10,30,"Press a key",30,Rgba(255,255,255,255))
Screenlock
MoveAndDraw(c,b(),0,0)'first view (static)
Screenunlock
Sleep
b(1).dx=12 'set system alive

Dim As Integer I
Screencontrol(2,I)'getwindowhandle
Dim As Any Ptr Win = Cast(Any Ptr,I)
dim as long mx,my,mw


While 1
    getmouse mx,my,mw
    MoveWindow(win,0,0,1024+mw*5,768+mw*5,1)
    
    energy=0
    AngEnergy=0
    edges(b(),xres,yres,status)
    BallCollisions(b())
   
    Screenlock
    Cls
    MoveAndDraw(c,b(),energy,AngEnergy)
    cprint(c,50,25," Press escape key to end",25,Rgba(255,255,255,255))
    cprint(c,50,55," framerate " &fps ,25,Rgba(0,200,0,255))
    Draw String (50,100),"Kinetic energy " &energy
    Draw String (50,140),"Angular energy " & AngEnergy
    Draw String (50,190),"System stauus " & Iif(status,"OK","Leaks")
    cprint(c,600,50,"mouse " +str(mx) + " , " + str(my),25,rgba(0,200,0,255))
    
    cprint(c,600,150,"wheel " +str(mw),25,rgba(0,200,0,255))
    cprint(c,600,200,"desktop " +str(w)+ " , " + str(h),25,rgba(0,200,0,255))
    Screenunlock
    Sleep regulate(100,fps)
    If Inkey=Chr(27) Then Exit While
Wend


 

Note:
This runs on 32 bit compiler.
I don't know about the 64 bit compiler, there were issues with Movewindow().

Ok Thanks a lot I will see and try..
I was able to run it, it's fabulous. I had just an error with the glyphs size Width 8 \ xres, 16 \ yres
line 121 for me -> Width 8\xres,16\yres

Aborting due to runtime error 0 () at line 121 of test-cairo.bas::SETSCREEN()
I commented and run it ok
And I watch the resize with wheel Thanks!

[dodicat]

I have tweaked the cairo code slightly.
I show the mouse and a mapping to the original screen 1024,768.
Also I tested on 64 bits, OK.