Any list of softwares made in fb?

General discussion for topics related to the FreeBASIC project or its community.
Roland Chastain
Posts: 1007
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Any list of softwares made in fb?

Post by Roland Chastain »

BasicCoder2 wrote:It is a .rar file which window 10 could not open.
Downloaded the app RAR Extractor but when I tried to run FreeBasicMiner the images were just blocks of black.
Usually I don't bother downloading anything unless it is a .zip file which always seems to work.
.
Maybe you have tested the first file that I uploaded by mistake, which was incomplete. I tested successfully under Windows 10 the both other files (links in my previous messages).
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Any list of softwares made in fb?

Post by BasicCoder2 »

@Roland Chastain,
Downloaded your link again and it worked fine.
.
Roland Chastain
Posts: 1007
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Any list of softwares made in fb?

Post by Roland Chastain »

Tourist Trap wrote:@Roland Chastain, I started a 5000 code lines chess program in FB this last year. Since 3 monthes I had no more time to go further. The thing started to be a little lengthy. What makes my version lengthy is mostly the interface and some use of the OOP with a lot of what I would call structural bricks (types deriving from types and so on). Then what makes all of this long also is my extensive use of 64 bits Bitmaps for the coding of the analysis system. However, it's an original concept overall for a few reason and I'm quite proud of it. I can't make any decision about what to do now with this packet :) What's your opinion as an chess programmer expert?
Honestly, I can say that I have some experience, but I don't believe to be an expert. The core of my chess program is a translation of a Turbo Pascal source code made by someone else.

It's hard to say something about your code without seeing it. I will take a look at it with pleasure if you publish it somewhere. ;)
Roland Chastain
Posts: 1007
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: Any list of softwares made in fb?

Post by Roland Chastain »

BasicCoder2 wrote:@Roland Chastain,
Downloaded your link again and it worked fine.
.
Good news. :)
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Any list of softwares made in fb?

Post by Tourist Trap »

Roland Chastain wrote: Honestly, I can say that I have some experience, but I don't believe to be an expert. The core of my chess program is a translation of a Turbo Pascal source code made by someone else.

It's hard to say something about your code without seeing it. I will take a look at it with pleasure if you publish it somewhere. ;)
Ok, I'll try to make some upload of a RAR (or ZIP) version somewhere. I really need some advice because maybe you will say that a first version should be complete before any release. Or maybe you will say that honnestly it's too much work for someone that has only a few hours by week to dedicate to this. I'll give you some new this week-end. Thanks by advance!
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Any list of softwares made in fb?

Post by BasicCoder2 »

Tourist Trap wrote: @Roland Chastain, I started a 5000 code lines chess program in FB this last year. Since 3 monthes I had no more time to go further. The thing started to be a little lengthy. What makes my version lengthy is mostly the interface and some use of the OOP with a lot of what I would call structural bricks (types deriving from types and so on). Then what makes all of this long also is my extensive use of 64 bits Bitmaps for the coding of the analysis system. However, it's an original concept overall for a few reason and I'm quite proud of it. I can't make any decision about what to do now with this packet :) What's your opinion as an chess programmer expert?
Are you representing the chess board like this?
http://pages.cs.wisc.edu/~psilord/blog/ ... s/rep.html
When Roland was working on his version I worked on my own in parallel. I only wanted to see if I could make a chess program that worked and was more interested in readability than speed. Chess programs ran on computers with very little memory. The standard engine wasn't all that big. My obstacle was adding alpha/beta tree pruning to the move generator. It works without it but still I would have liked to have understood it better. The other bit I never got around to was adding all those predetermined first few moves you had to add to the start of the game when there was no "best move" just a set of good starts.
It is possible that adding a neural net to value a move might be useful. In AI there is the crisp logic of an algorithm and the intuitive logic of an ANN. The ANN has enabled software that can play Backgammon and Go as well if not better than a human player.
The top human player can remember the layout of a chess board from a glance but is no better than anyone else if the pieces are placed in some random order. Clearly they are remembering variations on common chess board patterns which they have seen many times. This is something an ANN can do.
.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Any list of softwares made in fb?

Post by Tourist Trap »

BasicCoder2 wrote: Are you representing the chess board like this?
http://pages.cs.wisc.edu/~psilord/blog/ ... s/rep.html
Yes. I've learned this stuff here:
https://chessprogramming.wikispaces.com ... dateByMove

It's not that hard, you really just code your chessboard as a string of 0 and 1, and convert it to an integer with VAL and BIN when you have to do setwise operations (NOT, AND ...).
BasicCoder2 wrote: It is possible that adding a neural net to value a move might be useful. In AI there is the crisp logic or an algorithm and the intuitive logic of an ANN. The ANN has enabled software that can play Backgammon and Go as well if not better than a human player.
For now I have just coded the rules of displacement (and not yet promotion and complicated stuff like "en passant", forbiden rock move when passing a threatened square, and so on...). I just need the chessboard playing randomly authorized moves for tuning the interface. However Ifeel that what you mention is probably the way to go with the AI, because what is able to handle GO should manage the chess game as well.

Here is an example of the code (I dont claim for simplicity, I have applied fresh learned stuff so no optimization done at all):

Code: Select all

sub CHESSTOKEN.BuildBitmapTokenAttackSquares()
	THIS.ReinitTokenSquareBitmap()
	THIS.BuildBitmapUnoccupiedSquares()	
	'
	dim as ulongint	bitmapTokenAttackValue	=> valUlng(THIS._bitmapTokenAttackSquares)	
	'
	'retrieve the set of all the opponents
	var opponentFoundCount		=> 0
	var notAliveOpponentCount	=> 0
	dim as CHESSTOKEN ptr		kingOpponent	=> -1
	dim as CHESSTOKEN ptr		arrayOfPawnOpponentPtr(any)
	dim as CHESSTOKEN ptr		arrayOfRookOpponentPtr(any)
	dim as CHESSTOKEN ptr		arrayOfKnightOpponentPtr(any)
	dim as CHESSTOKEN ptr		arrayOfBishopOpponentPtr(any)
	dim as CHESSTOKEN ptr		arrayOfQueenOpponentPtr(any)
	for squareIndex as integer =	iif(THIS.IsWhite, 0, 63) to _
									iif(THIS.IsWhite, 63, 0) step _
									iif(THIS.IsWhite, 1, -1)
		if 2^(63 - squareIndex)=(2^(63 - squareIndex) and valUlng(THIS._bitmapOpponentOccupationSquare))	then
			opponentFoundCount	+= 1
			var opponentSquare	=> THIS._activePlayBoard->_square(squareIndex)
			for dockedElementIndex as integer	=	lBound(opponentSquare->_dockedElementArrayOfPtr) to _
													uBound(opponentSquare->_dockedElementArrayOfPtr)
													
			var opponentCandidate	=> cast(	CHESSTOKEN ptr, _ 
												opponentSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)
				if opponentCandidate->IsAlive				andAlso _
				   not opponentCandidate->IsMirrorBlocker 	andAlso _ 
				   (THIS.IsWhite andAlso opponentCandidate->IsBlack)	orElse _
				   (THIS.IsBlack andAlso opponentCandidate->IsWhite)	then
						if opponentCandidate->IsKing then
							kingOpponent	= opponentCandidate
						elseIf opponentCandidate->IsPawn then
							redim preserve arrayOfPawnOpponentPtr(	_ 
																	uBound(arrayOfPawnOpponentPtr) - _ 
																	lBound(arrayOfPawnOpponentPtr) + _ 
																	1 _ 
																	)
							arrayOfPawnOpponentPtr(uBound(arrayOfPawnOpponentPtr)) = opponentCandidate
						elseIf opponentCandidate->IsRook then
							redim preserve arrayOfRookOpponentPtr(	_ 
																	uBound(arrayOfRookOpponentPtr) - _ 
																	lBound(arrayOfRookOpponentPtr) + _ 
																	1 _ 
																	)
							arrayOfRookOpponentPtr(uBound(arrayOfRookOpponentPtr)) = opponentCandidate
						elseIf opponentCandidate->IsKnight then
							redim preserve arrayOfKnightOpponentPtr(	_ 
																	uBound(arrayOfKnightOpponentPtr) - _ 
																	lBound(arrayOfKnightOpponentPtr) + _ 
																	1 _ 
																	)
							arrayOfKnightOpponentPtr(uBound(arrayOfKnightOpponentPtr)) = opponentCandidate
						elseIf opponentCandidate->IsBishop then
							redim preserve arrayOfBishopOpponentPtr(	_ 
																	uBound(arrayOfBishopOpponentPtr) - _ 
																	lBound(arrayOfBishopOpponentPtr) + _ 
																	1 _ 
																	)
							arrayOfBishopOpponentPtr(uBound(arrayOfBishopOpponentPtr)) = opponentCandidate
						elseIf opponentCandidate->IsQueen then
							redim preserve arrayOfQueenOpponentPtr(	_ 
																	uBound(arrayOfQueenOpponentPtr) - _ 
																	lBound(arrayOfQueenOpponentPtr) + _ 
																	1 _ 
																	)
							arrayOfQueenOpponentPtr(uBound(arrayOfQueenOpponentPtr)) = opponentCandidate
						end if
				elseIf not opponentCandidate->IsAlive 			andAlso _ 
					   not opponentCandidate->IsMirrorBlocker 	andAlso _ 
				   (THIS.IsWhite andAlso opponentCandidate->IsBlack)	orElse _
				   (THIS.IsBlack andAlso opponentCandidate->IsWhite)	then
						notAliveOpponentCount += 1
				end if
			next dockedElementIndex
			'
			if opponentFoundCount>=(16 - notAliveOpponentCount) then exit for
		end if
	next squareIndex
	'
	'build attackable squares set
	if THIS.IsKing then
		for x as integer	= -9 to -7	step +1
			for y as integer	= 0 to +16	step +8
				if (x + y)=0 then
					continue for
				end if
				var k	=> THIS._originSquareIndex + (x + y)
				var dx	=> (k mod 8) - ((k - (x + y)) mod 8)
				if not (	dx<-1	orElse _ 
							dx>+1	)	andAlso _ 
				   not (	k<0		orElse _ 
				   			k>63	)   then
					var testedSquare	=> THIS._activePlayBoard->_square(k)
					for dockedElementIndex as integer	=	lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
															uBound(testedSquare->_dockedElementArrayOfPtr)
						var testedToken	=> cast(	CHESSTOKEN ptr, _
													testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)
						if testedToken->IsAlive							andAlso _
						   not testedToken->IsMirrorBlocker				then
							if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   		(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
								bitmapTokenAttackValue	or= 2^(63 - k)
							end if
						end if
					next dockedElementIndex
				end if
			next y
		next x
	elseIf THIS.IsKnight then
		var n	=> THIS._originSquareIndex
		var dx	=> 0
		for x as integer = 1 to 2	step +1
			for s as integer = -1 to +1	step +2
				'
				select case (s*x)
					case -2
						dx	= ((n - 10) mod 8) - (n mod 8)
						if dx=-2 then
							if not (n - 10)<0 then
								var testedSquare	=> THIS._activePlayBoard->_square(n - 10)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n - 10))
										end if
									end if
								next dockedElementIndex
							end if
						end if
						dx	= ((n + 6) mod 8) - (n mod 8)
						if dx=-2 then
							if not (n + 6)>63 then
								var testedSquare	=> THIS._activePlayBoard->_square(n + 6)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n + 6))
										end if
									end if
								next dockedElementIndex
							end if
						end if
					case -1
						dx	= ((n - 17) mod 8) - (n mod 8)
						if dx=-1 then
							if not (n - 17)<0 then
								var testedSquare	=> THIS._activePlayBoard->_square(n - 17)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n - 17))
										end if
									end if
								next dockedElementIndex
							end if
						end if
						dx	= ((n + 15) mod 8) - (n mod 8)
						if dx=-1 then
							if not (n + 15)>63 then
								var testedSquare	=> THIS._activePlayBoard->_square(n + 15)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n + 15))
										end if
									end if
								next dockedElementIndex
							end if
						end if
					case +1
						dx	= ((n - 15) mod 8) - (n mod 8)
						if dx=+1 then
							if not (n - 15)<0 then
								var testedSquare	=> THIS._activePlayBoard->_square(n - 15)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n - 15))
										end if
									end if
								next dockedElementIndex
							end if
						end if
						dx	= ((n + 17) mod 8) - (n mod 8)
						if dx=+1 then
							if not (n + 17)>63 then
								var testedSquare	=> THIS._activePlayBoard->_square(n + 17)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n + 17))
										end if
									end if
								next dockedElementIndex
							end if
						end if
					case +2
						dx	= ((n - 6) mod 8) - (n mod 8)
						if dx=+2 then
							if not (n - 6)<0 then
								var testedSquare	=> THIS._activePlayBoard->_square(n - 6)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n - 6))
										end if
									end if
								next dockedElementIndex
							end if
						end if
						dx	= ((n + 10) mod 8) - (n mod 8)
						if dx=+2 then
							if not (n + 10)>63 then
								var testedSquare	=> THIS._activePlayBoard->_square(n + 10)
								for dockedElementIndex as integer	=	_ 
												lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
												uBound(testedSquare->_dockedElementArrayOfPtr)
									var testedToken	=> cast(	CHESSTOKEN ptr, _
																testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)									
									if testedToken->IsAlive				andAlso _ 
									   not testedToken->IsMirrorBlocker	then
										if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   					(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
											bitmapTokenAttackValue	or= 2^(63 - (n + 10))
										end if
									end if
								next dockedElementIndex
							end if
						end if
				end select
				'
			next s
		next x
	elseIf THIS.IsRook then
		var n		=> THIS._originSquareIndex
		var bearing	=> -1
		for s as integer	= +1 to -1 step -2
			for x as integer	= -7 to +9 step +16
				bearing += s*x
				select case bearing
					case -8, +8
						var testedSquareIndex		=> n + bearing
						while not (testedSquareIndex<0 orElse testedSquareIndex>63)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
					case -1, +1
						var testedSquareIndex		=> n + bearing
						while (	not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _
														(testedSquareIndex\8)=(n\8)	)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
				end select
			next x
		next s
	elseIf THIS.IsBishop then
		var n		=> THIS._originSquareIndex
		var bearing	=> 0
		for x as integer	= -9 to -7	step +1
			for y as integer	= 0 to +16	step +16
				bearing = x + y
				select case bearing
					case -9, +9
						if (	((n mod 8)=0 andAlso (bearing=-9 orElse bearing=+7))	orElse _ 
								((n mod 8)=7 andAlso (bearing=+9 orElse bearing=-7))	)	then
							continue for
						end if
						var testedSquareIndex		=> n + bearing
						var dx						=> (testedSquareIndex mod 8) - (n mod 8)
						while (	_ 
								not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _ 
								sgn((testedSquareIndex mod 8) - (n mod 8))=sgn(dx)	_ 
									)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
					case -7, +7
						if (	((n mod 8)=0 andAlso (bearing=-9 orElse bearing=+7))	orElse _ 
								((n mod 8)=7 andAlso (bearing=+9 orElse bearing=-7))	)	then
							continue for
						end if
						var testedSquareIndex		=> n + bearing
						var dx						=> (testedSquareIndex mod 8) - (n mod 8)
						while (	_ 
								not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _ 
								sgn((testedSquareIndex mod 8) - (n mod 8))=sgn(dx)	_ 
									)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
				end select
			next y
		next x
	elseIf THIS.IsQueen then
		var n		=> THIS._originSquareIndex
		var bearing	=> -1
		'rook attack behaviour
		for s as integer	= +1 to -1 step -2
			for x as integer	= -7 to +9 step +16
				bearing += s*x
				select case bearing
					case -8, +8
						var testedSquareIndex		=> n + bearing
						while not (testedSquareIndex<0 orElse testedSquareIndex>63)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
					case -1, +1
						var testedSquareIndex		=> n + bearing
						while (	not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _
														(testedSquareIndex\8)=(n\8)	)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
				end select
			next x
		next s
		'bishop attack behaviour
		for x as integer	= -9 to -7	step +1
			for y as integer	= 0 to +16	step +16
				bearing = x + y
				select case bearing
					case -9, +9
						if (	((n mod 8)=0 andAlso (bearing=-9 orElse bearing=+7))	orElse _ 
								((n mod 8)=7 andAlso (bearing=+9 orElse bearing=-7))	)	then
							continue for
						end if
						var testedSquareIndex		=> n + bearing
						var dx						=> (testedSquareIndex mod 8) - (n mod 8)
						while (	_ 
								not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _ 
								sgn((testedSquareIndex mod 8) - (n mod 8))=sgn(dx)	_ 
									)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
					case -7, +7
						if (	((n mod 8)=0 andAlso (bearing=-9 orElse bearing=+7))	orElse _ 
								((n mod 8)=7 andAlso (bearing=+9 orElse bearing=-7))	)	then
							continue for
						end if
						var testedSquareIndex		=> n + bearing
						var dx						=> (testedSquareIndex mod 8) - (n mod 8)
						while (	_ 
								not (testedSquareIndex<0 orElse testedSquareIndex>63)	andAlso _ 
								sgn((testedSquareIndex mod 8) - (n mod 8))=sgn(dx)	_ 
									)
							var testedSquare	=> THIS._activePlayBoard->_square(testedSquareIndex)
							for dockedElementIndex as integer	= _ 
														lBound(testedSquare->_dockedElementArrayOfPtr) to _
														uBound(testedSquare->_dockedElementArrayOfPtr)
								var squareToken	=> cast(	_ 
														CHESSTOKEN ptr, _ 
														testedSquare->_dockedElementArrayOfPtr(dockedElementIndex) _ 
															)
								if squareToken->IsAlive				andAlso _
								   not squareToken->IsMirrorBlocker	then
									if (	(THIS.IsWhite andAlso squareToken->IsBlack)	orElse _ 
									   		(THIS.IsBlack andAlso squareToken->IsWhite)	)	then
										bitmapTokenAttackValue	or= 2^(63 - testedSquareIndex)
										exit while
									else
										exit while
									end if
								end if
							next dockedElementIndex
							'
							testedSquareIndex += bearing
						wend
				end select
			next y
		next x
	elseIf THIS.IsPawn then
		select case THIS.IsWhite
		case TRUE
			for x as integer	= -9 to -7	step +2
				var p	=> THIS._originSquareIndex + x
				var dx	=> (p mod 8) - ((p - x) mod 8)
				if not (	dx<-1	orElse _ 
							dx>+1	)	andAlso _ 
				   not (	p<0		orElse _ 
			   				p>63	)   then
					var testedSquare	=> THIS._activePlayBoard->_square(p)
					for dockedElementIndex as integer	=	lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
															uBound(testedSquare->_dockedElementArrayOfPtr)
						var testedToken	=> cast(	CHESSTOKEN ptr, _
													testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)
						if testedToken->IsAlive							andAlso _
						   not testedToken->IsMirrorBlocker				then
							if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   		(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
								bitmapTokenAttackValue	or= 2^(63 - p)
							end if
						end if
					next dockedElementIndex
				end if
			next x
		case FALSE
			for x as integer	= +7 to +9	step +2
				var p	=>THIS._originSquareIndex + x
				var dx	=> (p mod 8) - ((p - x) mod 8)
				if not (	dx<-1	orElse _ 
							dx>+1	)	andAlso _ 
				   not (	p<0		orElse _ 
			   				p>63	)   then
					var testedSquare	=> THIS._activePlayBoard->_square(p)
					for dockedElementIndex as integer	=	lBound(testedSquare->_dockedElementArrayOfPtr) to _ 
															uBound(testedSquare->_dockedElementArrayOfPtr)
						var testedToken	=> cast(	CHESSTOKEN ptr, _
													testedSquare->_dockedElementArrayOfPtr(dockedElementIndex)	)
						if testedToken->IsAlive							andAlso _
						   not testedToken->IsMirrorBlocker				then
							if (	(THIS.IsWhite	andAlso testedToken->IsBlack)	orElse _ 
							   		(THIS.IsBlack	andAlso testedToken->IsWhite)	)	then
								bitmapTokenAttackValue	or= 2^(63 - p)
							end if
						end if
					next dockedElementIndex
				end if
			next x
		end select
	end if
	'
	THIS._bitmapTokenAttackSquares	= "&b"& bin(bitmapTokenAttackValue, 64)
end sub
If you open a topic on this at game section we could talk about it and probably attract amateurs that could share also opinions.
The bitboard representation is really cool stuff (fast!).

Image
Yes, I've taken the token from chessmaster C64 edition :)
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Any list of softwares made in fb?

Post by Tourist Trap »

Provoni wrote:AZdecrypt, my decryption software for classical ciphers: http://www.zodiackillersite.com/viewtop ... =81&t=3198
Thanks for signaling this. It's a huge file!
What is the licence?
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Any list of softwares made in fb?

Post by Tourist Trap »

St_W wrote: But I agree that publishing information about FreeBasic and FreeBasic projects would contribute to make FB known by more people and get additional users. But that is not restricted to projects on github and sourceforge, but applies to anything FB related like blogs, websites, ...
I hope that Basicoder2 won't sue me for the use of its name in this sample below, but in order to answer positively to this comment I found best to show some example on how easy would be to make something here and there talking about our favourite programming language in different ways.

Here below a pic describing a simple (kind of) webzine page (sorry by advance if the bandwitch of the host doesn't allow the pic to display):
Image
Provoni
Posts: 514
Joined: Jan 05, 2014 12:33
Location: Belgium

Re: Any list of softwares made in fb?

Post by Provoni »

Tourist Trap wrote:
Provoni wrote: AZdecrypt, my decryption software for classical ciphers: http://www.zodiackillersite.com/viewtop ... =81&t=3198
Thanks for signaling this. It's a huge file!
What is the licence?
No licence.
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Any list of softwares made in fb?

Post by BasicCoder2 »

Tourist Trap wrote:I hope that Basicoder2 won't sue me for the use of its name in this sample below, but in order to answer positively to this comment I found best to show some example on how easy would be to make something here and there talking about our favourite programming language in different ways.
Just because FreeBasic was a good fit for an old BASIC programmer weaned on the old machines doesn't make it a good fit for someone new to programming wanting to make use of a modern operating system and the easy use of other people's code. There are some things you can do easily with FreeBasic and other things that require knowledge beyond the standard FreeBasic set of keywords.
.
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Any list of softwares made in fb?

Post by BasicCoder2 »

Roland Chastain wrote:
BasicCoder2 wrote:@Roland Chastain,
Downloaded your link again and it worked fine.
.
Good news. :)
However apart from using the arrow keys to move the character left/right and climb the ladders with up/down I couldn't figure out how to make the character do anything else.
.
St_W
Posts: 1627
Joined: Feb 11, 2009 14:24
Location: Austria
Contact:

Re: Any list of softwares made in fb?

Post by St_W »

Provoni wrote:
Tourist Trap wrote:
Provoni wrote: AZdecrypt, my decryption software for classical ciphers: http://www.zodiackillersite.com/viewtop ... =81&t=3198
Thanks for signaling this. It's a huge file!
What is the licence?
No licence.
No license is usually a bad idea, except you want nobody to use your code/software without explicitly requesting a license. The reason is that you as the author owns all the rights per default and a user has no rights by default (this is sometimes also explicitly stated by the phrase "All rights reserved", although that is unnecessary as this is implicitly the case).
So if you want others to use your software or code in any way you have to grant them to do so. You merely can specify whatever you want, but usually one just picks an existing license for simplicity.

See also https://choosealicense.com/no-license/ and https://blog.codinghorror.com/pick-a-li ... y-license/
Provoni
Posts: 514
Joined: Jan 05, 2014 12:33
Location: Belgium

Re: Any list of softwares made in fb?

Post by Provoni »

Thanks for the info St_W. I was unaware of license stuff.

AZdecrypt: http://www.zodiackillersite.com/viewtop ... =81&t=3198 is a product of my continuing effort to decrypt the unsolved Zodiac 340 cipher. It happens to be one of the handful of programs that can decrypt homophonic substitution ciphers. The algorithm behind it is completely original and offers leading performance by a very large margin in all respects compared to other automatic solvers.

This paper: http://emnlp2014.org/papers/pdf/EMNLP2014184.pdf is about a modern algorithm that achieves a less than 10 second decryption on the Zodiac 408 cipher:
Improved Decipherment of Homophonic Ciphers wrote: Our new algorithm is able to decipher the Zodiac-408 cipher in less than 10s on a single CPU, as compared to 48h of CPU time using the previously published heuristic...
In that same time my program solved the Zodiac 408 cipher 50 times (using a single core/thread of a Intel i7-930 CPU), a less than 0.2 second decryption per Zodiac 408 cipher:

Code: Select all

AZdecrypt batch ciphers for: 408_50.txt
--------------------------------------------------------
Items processed: 50
Mean/average score: 23225.29465
Processing time: 9.54 seconds
- Per cipher: 0.19099 seconds
It can also decrypt homophonic substitution + transposition, + vigenère, + aperiodical polyalphabetism and more. There are currently no other programs that I know of which even attempt any of these.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Any list of softwares made in fb?

Post by Tourist Trap »

Provoni wrote:Thanks for the info St_W. I was unaware of license stuff.
Hello,

originally I questionned you, not because I was about to use effectively this nice program - because it's of no use for people like me (decyphering zodiac machine is somewhat a niche). I just wanted to know if it was open source so that you could post it on SourceForge or anywhere else. Whatever this is of no importance outside of this topic (where I was complaining about the lack of freebasic stuff posted in popular browsers).
AZdecrypt: http://www.zodiackillersite.com/viewtop ... =81&t=3198 is a product of my continuing effort to decrypt the unsolved Zodiac 340 cipher.
Freebasic not mentioned in the description of your software?
Post Reply