I can see why FreeBasic defaults to non-resizable windows: the whole graphics lib would have to be different and the differences would make FreeBasic too distinct from QuickBasic... I mean really too distinct. It would be too complex to always maintain an image buffer for the screen and the resolution would no longer be fixed, so one would need to be able to check it permanently. Some way of configuring how the contents of the window would react would have to be added and it would be better to make contents a separate thing from the window itself. I'm aware of all this.
Now... I still would like to make programs with variable-size windows :P
So I was thinking. Say I want to make a very simple version of a variable-size window, in which there is a fixed screen size representing the maximum the window can be stretched and if you make it smaller, the image remains still relative to the top-left corner with the bottom-right becoming invisible up to a minimum size one could define. Is there a simple way I can accomplish this (and make it portable between Linux and Windows) so that I don't have to throw away the whole FBGFX library and work only with system specific stuff? That is, I would like to do mostly everything with FBGFX and only just tiny bits with X and whatever Windows uses in place of X.
Note: I don't want to use any library that doesn't come preisntalled in the OS.
Resizing the program window
Re: Resizing the program window
I'd think that, with all the currently written restrictions (by you), the only possible answer is: can't be done.
(implying: within reasonable amounts, of time and effort)
The only possible available way (IMHO), to *sort of* achieve, what you intend is (AFAIK) with OpenGL (I'm
not 100% sure about LINUX on that one, but WINDOWS supports it *natively*).
This however implies, no FB-GFX (except: the gfx 0 driver call to start OpenGL, AFAIK).
(Btw: I've never used it myself so far.)
Aka: you'll need a combination of: GFX-API coupled with a (on both OS's) pre-installed driver, to stay inde-
pendent, of the OS specific, sets of GFX-overlays (X-Windows/MS-Windows).
There are certainly other options, but not with all your stated restrictions, in place. Meaning: you'd first
have to *loosen* the restrictions somewhat, for those to become viable ...
(implying: within reasonable amounts, of time and effort)
The only possible available way (IMHO), to *sort of* achieve, what you intend is (AFAIK) with OpenGL (I'm
not 100% sure about LINUX on that one, but WINDOWS supports it *natively*).
This however implies, no FB-GFX (except: the gfx 0 driver call to start OpenGL, AFAIK).
(Btw: I've never used it myself so far.)
Aka: you'll need a combination of: GFX-API coupled with a (on both OS's) pre-installed driver, to stay inde-
pendent, of the OS specific, sets of GFX-overlays (X-Windows/MS-Windows).
There are certainly other options, but not with all your stated restrictions, in place. Meaning: you'd first
have to *loosen* the restrictions somewhat, for those to become viable ...
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Resizing the program window
Hi xlucas, as far as I've observed, if you don't try to make a window that gets well refreshed while resizing, it's easy to achieve your goal with the transparent window.xlucas wrote:So I was thinking. Say I want to make a very simple version of a variable-size window, in which there is a fixed screen size representing the maximum the window can be stretched and if you make it smaller, the image remains still relative to the top-left corner with the bottom-right becoming invisible up to a minimum size one could define. Is there a simple way I can accomplish this (and make it portable between Linux and Windows) so that I don't have to throw away the whole FBGFX library and work only with system specific stuff? That is, I would like to do mostly everything with FBGFX and only just tiny bits with X and whatever Windows uses in place of X.
The only reason why I haven't provided the simplest example yet is that I was too much occupied by the whole gui affair, I mean moving, resizing, multiple document application, parent child relations between windows. If you take this as a whole, it's relatively harder, specially for a simple hobbyist. But it's still reachable. As usual when we come to this kind of topic about some crossplatform hand made gui, here is the link of my effort of the last year:
http://www.freebasic.net/forum/viewtopi ... 76#p214876
I still think it's possible to complete this task not too badly if we don't expect something perfectly smooth when dragging or resizing.
(I dont know if I'm answering to your question anyway)
Re: Resizing the program window
Thank you, guys!
Mr Swiss: It's a good point. I'm sure I can use X to make a resizable window easily and, although I'm not that familiar with Windows, I'm also sure it does have the tools to easily do the same. But FBGFX is built on another paradigm, which makes a lot of sense too. I think in Linux, OpenGL is usually available, but the development libraries (the prototypes and such) have to be installed... meaning that my programs would likely run out of the box, but not compile out of the box. But well, as you say, I'd be losing FBGFX anyway. Just making sure there's no "perfect" solution before having to choose among the imperfect ones :P
Tourist Trap: That's a very smart approach to it, that would keep it FB-native! Of course, it does have its drawbacks, but it's pure FB. Very clever! Yeah, I remember you've been working hard on window managing. We've talked about window dragging and all that. So you mean I could just make a window the size of the whole desktop, for example, transparent and draw windows inside it? If I do that, can I grab other windows "through" my window transparency?
Mr Swiss: It's a good point. I'm sure I can use X to make a resizable window easily and, although I'm not that familiar with Windows, I'm also sure it does have the tools to easily do the same. But FBGFX is built on another paradigm, which makes a lot of sense too. I think in Linux, OpenGL is usually available, but the development libraries (the prototypes and such) have to be installed... meaning that my programs would likely run out of the box, but not compile out of the box. But well, as you say, I'd be losing FBGFX anyway. Just making sure there's no "perfect" solution before having to choose among the imperfect ones :P
Tourist Trap: That's a very smart approach to it, that would keep it FB-native! Of course, it does have its drawbacks, but it's pure FB. Very clever! Yeah, I remember you've been working hard on window managing. We've talked about window dragging and all that. So you mean I could just make a window the size of the whole desktop, for example, transparent and draw windows inside it? If I do that, can I grab other windows "through" my window transparency?
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Resizing the program window
Yes. You can click throught the transparency and access to the other applications behind. Any example could show it but I like this one:xlucas wrote: can I grab other windows "through" my window transparency?
Code: Select all
'. a basic pixel-ruler
' -------------------
'- uses the windows API to handle window displacement
'- otherwise, transparency is as featured by freebasic
'- restriction is horizontal/vertical versus any angle
'personal note:
'- todo n°1: make mouse keep in ruler while displacing
'- todo n°2: make ruler have flip h/v cntr of rotation
#include "fbgfx.bi"
#include "windows.bi"
declare sub DimensionRulerScreen(byval as integer=0)
declare sub DrawRulerBackground(byval as integer=0, _
byval as integer=8)
declare sub DrawRulerUserGuide(byval as integer=0, _
byval as integer)
declare function DrawHVtoggleBtn(byval as integer=0, _
byval as integer=0) _
as integer
declare sub DrawScaleInfoBtn(byval as integer=0, _
byval as integer, _
byval as integer=0)
declare function DrawScaleSizeUpBtn(byval as integer=0, _
byval as integer=0) _
as integer
declare function DrawScaleSizeDownBtn(byval as integer=0, _
byval as integer=0) _
as integer
'---------------------------------------------------------------------------------------M
'----------------------------------------------------------------------------------------
dim as HWND _console
dim as HWND _main
dim as WINDOWINFO ptr _windowInfoPtr
_windowInfoPtr = cAllocate(1, sizeOf(WINDOWINFO))
_console = GetConsoleWindow()
ShowWindow(_console, 0)
'ruler is horizontal by default
dim as integer v1h0Flag = 0
DimensionRulerScreen(v1h0Flag)
_main = GetForegroundWindow()
GetWindowInfo(_main, _windowInfoPtr)
dim as integer userRulerPixelScale => 8
dim as integer gmX, gmY, gmBtn1
dim as integer xMousePosAtClick, yMousePosAtClick
dim as integer xRelativeMousePosAtClick, yRelativeMousePosAtClick
dim as integer btn1ClickedFlag => 0
dim as integer rulerBtnClickedFlag => 0
dim as integer hvToggleBtnClickedFlag => 0
dim as integer scaleSizeUpBtnClickedFlag => 0
dim as integer scaleSizeDownBtnClickedFlag => 0
dim as integer xNewPos, yNewPos
do
getMouse gmX, gmY, , gmBtn1
screenLock
cls
DrawRulerBackground(v1h0Flag)
DrawRulerUserGuide(v1h0Flag, userRulerPixelScale)
DrawHVtoggleBtn(v1h0Flag)
DrawScaleInfoBtn(v1h0Flag, userRulerPixelScale)
DrawScaleSizeUpBtn(v1h0Flag)
DrawScaleSizeDownBtn(v1h0Flag)
if gmBtn1=+1 then
if btn1ClickedFlag=0 then
btn1ClickedFlag = -1
'-check for ruler button clicked------
select case v1h0Flag 'h/v_toogle Btn
case 0
if gmX>380 and _
gmX<390 and _
gmY>10 and _
gmY<20 then
if hvToggleBtnClickedFlag=0 then hvToggleBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
v1h0Flag = 1
DimensionRulerScreen(v1h0Flag)
_main = GetForegroundWindow()
GetWindowInfo(_main, _windowInfoPtr)
hvToggleBtnClickedFlag = DrawHVtoggleBtn(v1h0Flag, 1)
end if
case else '->1
if gmX>15 and _
gmX<25 and _
gmY>10 and _
gmY<20 then
if hvToggleBtnClickedFlag=0 then hvToggleBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
v1h0Flag = 0
DimensionRulerScreen(v1h0Flag)
_main = GetForegroundWindow()
GetWindowInfo(_main, _windowInfoPtr)
hvToggleBtnClickedFlag = DrawHVtoggleBtn(v1h0Flag, 1)
end if
end select 'v1h0Flag
'
select case v1h0Flag 'scale_SizeUp Btn
case 0
if gmX>345 and _
gmX<355 and _
gmY>10 and _
gmY<20 then
if scaleSizeUpBtnClickedFlag=0 then _
scaleSizeUpBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
userRulerPixelScale += DrawScaleSizeUpBtn(v1h0Flag, 1)
if userRulerPixelScale>255 then _
userRulerPixelScale = 255
end if
case else '->1
if gmX>15 and _
gmX<25 and _
gmY>35 and _
gmY<45 then
if scaleSizeUpBtnClickedFlag=0 then _
scaleSizeUpBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
userRulerPixelScale += DrawScaleSizeUpBtn(v1h0Flag, 1)
if userRulerPixelScale>255 then _
userRulerPixelScale = 255
end if
end select 'v1h0Flag
'
select case v1h0Flag ''scale_SizeDown Btn
case 0
if gmX>360 and _
gmX<370 and _
gmY>10 and _
gmY<20 then
if scaleSizeDownBtnClickedFlag=0 then _
scaleSizeDownBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
userRulerPixelScale += DrawScaleSizeDownBtn(v1h0Flag, 1)
if userRulerPixelScale<2 then _
userRulerPixelScale = 2
end if
case else '->1
if gmX>30 and _
gmX<40 and _
gmY>35 and _
gmY<45 then
if scaleSizeDownBtnClickedFlag=0 then _
scaleSizeDownBtnClickedFlag = -1
if rulerBtnClickedFlag=0 then rulerBtnClickedFlag = -1
userRulerPixelScale += DrawScaleSizeDownBtn(v1h0Flag, 1)
if userRulerPixelScale<2 then _
userRulerPixelScale = 2
end if
end select 'v1h0Flag
'
'-cfrbc-------------------------------
'if no button clicked, it's about displacement
if rulerBtnClickedFlag=0 then
'retain mousePosAtClick
xMousePosAtClick = gmX
yMousePosAtClick = gmY
'currentWindowPos is the new reference pos
GetWindowInfo(_main, _windowInfoPtr)
xNewPos = _windowInfoPtr->rcClient.left
yNewPos = _windowInfoPtr->rcClient.top
'retain relativeMousePosAtClick
xRelativeMousePosAtClick = gmX - xNewPos
yRelativeMousePosAtClick = gmY - yNewPos
end if
end if 'btn1ClickedFlag=0
else
rulerBtnClickedFlag = 0
if btn1ClickedFlag=-1 then
btn1ClickedFlag = 0
end if
end if 'gmBtn1=+1
screenUnlock
if btn1ClickedFlag=-1 and rulerBtnClickedFlag=0 then
'add mousePointer_delta to currentPos
xNewPos += gmX - xMousePosAtClick
yNewPos += gmY - yMousePosAtClick
SetWindowPos(_main, _
HWND_TOPMOST, _
xNewPos, _
yNewPos, _
0, _
0, _
SWP_NOSIZE)
end if
sleep 50
loop until chr(27)=inkey
'DestroyWindow(_console) '(*) when compiling to final executable (*.exe)
ShowWindow(_console, 1) 'uncomment DestroyWindow and comment ShowWindow
'---------------------------------------------------------------------------------------E
'----------------------------------------------------------------------------------------
sub DimensionRulerScreen(byval V1H0 as integer=0)
select case V1H0
case 0
screenRes 400, _
50, _
32, _
1, _
fb.GFX_SHAPED_WINDOW + _
fb.GFX_ALWAYS_ON_TOP
case else '->1
screenRes 50, _
400, _
32, _
1, _
fb.GFX_SHAPED_WINDOW + _
fb.GFX_ALWAYS_ON_TOP
end select 'V1H0
cls
DrawRulerBackground(V1H0)
end sub 'DimensionRulerScreen(valINT[0])
'
sub DrawRulerBackground(byval V1H0 as integer=0, _
byval Scale as integer=8)
select case V1H0
case 0
paint (1, 1), rgb(120, 120, 120)
circle (10, 10), 5, rgba(255,0,255,0), , , , f
circle (10, 10), 7, rgb(195,195,0)
line (0, 50 - 8)-(399, 50 - 8), rgb(105,105,0)
'horizontaly scaled ruler marks
for markPos as integer = 0 to 399 step Scale
line (markPos, 50 - 10)-(markPos, 50 - 8), rgb(195,195,0)
next markPos
case else '->1
paint (1, 1), rgb(120, 120, 120)
circle (50 - 10, 10), 5, rgba(255,0,255,0), , , , f
circle (50 - 10, 10), 7, rgb(195,195,0)
line (8, 0)-(8, 399), rgb(105,105,0)
'verticaly scaled ruler marks
for markPos as integer = 24 to 399 step Scale
line (8, markPos)-(10, markPos), rgb(195,195,0)
next markPos
end select 'V1H0
end sub 'DrawRulerBackground(valINT[0],valINT[8])
'
sub DrawRulerUserGuide(byval V1H0 as integer=0, _
byval UserScale as integer)
select case V1H0
case 0
line (0,43)-(399,49), rgb(100,100,100), bf
for markPos as integer = 0 to 399 step UserScale
line (markPos, 42)-(markPos, 49), rgb(180,185,220)
next markPos
line (50, 0)-(50 + UserScale, 20), _
rgba(255,0,255,0), _
bf
line (52 + UserScale, 7)-(52 + UserScale, 15), _
rgb(195,195,0)
line step-(56 + UserScale, 11), rgb(195,195,0)
line step-(52 + UserScale, 7), rgb(195,195,0)
case else '->1
line (0,0)-(7,399), rgb(100,100,100), bf
for markPos as integer = 0 to 399 step UserScale
line (0, markPos)-(7, markPos), rgb(180,185,220)
next markPos
line (29, 70)-(49, 70 + UserScale), _
rgba(255,0,255,0), _
bf
line (35, 72 + UserScale)-(43, 72 + UserScale), _
rgb(195,195,0)
line step-(39, 76 + UserScale), rgb(195,195,0)
line step-(35, 72 + UserScale), rgb(195,195,0)
end select 'V1H0
end sub 'DrawRulerUserGuide(valINT[0],valINT)
'
function DrawHVtoggleBtn(byval V1H0 as integer=0, _
byval BtnActivateFlag as integer=0) _
as integer
select case V1H0
case 0
line (380, 10)-(390, 20), rgb(040,010,140), bf
draw string (382, 10), "V", rgb(190,180,255)
case else '->1
line (15, 10)-(25, 20), rgb(040,010,140), bf
draw string (15, 10), "H", rgb(190,180,255)
end select 'V1H0
'
return 0
end function 'INT:=DrawHVtoggleBtn(valINT[0],valINT[0])
'
sub DrawScaleInfoBtn(byval V1H0 as integer=0, _
byval ScaleInfo as integer, _
byval BtnActivateFlag as integer=0)
select case V1H0
case 0
line (380 - 8*len(str(ScaleInfo)), 25)-(390, 35), _
rgb(000,010,100), _
bf
draw string (392 - 8*len(str(ScaleInfo)), 27), _
str(ScaleInfo), _
rgb(0,255,255)
case else '->1
line (30 - 8*len(str(ScaleInfo)), 20)-(40, 30), _
rgb(000,010,100), _
bf
draw string (42 - 8*len(str(ScaleInfo)), 22), _
str(ScaleInfo), _
rgb(0,255,255)
end select 'V1H0
end sub 'DrawScaleInfoBtn(valINT[0],valINT,valINT[0])
'
function DrawScaleSizeUpBtn(byval V1H0 as integer=0, _
byval BtnActivateFlag as integer=0) _
as integer
select case V1H0
case 0
line (345, 10)-(355, 20), _
rgb(040,010,140), _
bf
draw string (345, 12), _
"+", _
iif(BtnActivateFlag=0, rgb(190,180,255), rgb(0,0,255))
case else '->1
line (15, 35)-(25, 45), _
rgb(040,010,140), _
bf
draw string (17, 37), _
"+", _
iif(BtnActivateFlag=0, rgb(190,180,255), rgb(0,0,255))
end select 'V1H0
'
return +1
end function 'INT:=DrawScaleSizeUpBtn(valINT[0],valINT[0])
'
function DrawScaleSizeDownBtn(byval V1H0 as integer=0, _
byval BtnActivateFlag as integer=0) _
as integer
select case V1H0
case 0
line (360, 10)-(370, 20), _
rgb(040,010,140), _
bf
draw string (360, 12), _
"-", _
iif(BtnActivateFlag=0, rgb(190,180,255), rgb(0,0,255))
case else '->1
line (30, 35)-(40, 45), _
rgb(040,010,140), _
bf
draw string (32, 37), _
"-", _
iif(BtnActivateFlag=0, rgb(190,180,255), rgb(0,0,255))
end select 'V1H0
'
return -1
end function 'INT:=DrawScaleSizeDownBtn(valINT[0],valINT[0])
'---eof---
Re: Resizing the program window
Oh... I don't have Windows. I would have to compile it with the Windows version of FB in Wine and see how it works. But yes, I've been testing this myself and works perfectly well in Linux. It really is a great simple solution! Besides, I like making my own window frame :)
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Resizing the program window
Yes I had been trying the windows API to move the application screen, I remember now.xlucas wrote:Oh... I don't have Windows.
This simple example below should work, it's pure FB.
Code: Select all
#include "fbgfx.bi"
dim as integer scrW => any
dim as integer scrH => any
scope
var dskW => -1
var dskH => -1
screenControl fb.GET_DESKTOP_SIZE, _
dskW, _
dskH
'
scrW = dskW - 2*dskW\32
scrH = dskH - 2*dskH\8
screenRes scrW, scrH, _ 'sets application screen dimension
32, _ 'sets application screen color depth
2, _ 'sets application screen page number
fb.GFX_SHAPED_WINDOW + _ 'enables application standard transparency
fb.GFX_ALPHA_PRIMITIVES + _ 'enables application standard alpha
fb.GFX_NO_FRAME 'sets application borders to none
end scope
screenSet 1, 0
color , rgb(100,0,200)
cls
? "move the console window from behind if you see only a black circle"
circle (scrW\2, scrH\2), 100, rgb(255,0,255), , , , f
screenCopy 1, 0
sleepRe: Resizing the program window
Yep! I can click back on Geany's window through the hole XD I'm definitely going to use this!
-
thesanman112
- Posts: 538
- Joined: Jul 15, 2005 4:13
Re: Resizing the program window
You should also be able to have your window resizeable and scaleable with the view and window function..not sure if you could capture mouse location on move of window edges and using a call to screenres to reaize window.....????
-
thesanman112
- Posts: 538
- Joined: Jul 15, 2005 4:13
Re: Resizing the program window
There is more than one way of doing it....smoothest would be like example above and using 4 clear rectangles to clip screen edges and control the graphics inside clipping areas with the window command, or graphics controlled by your own software(scaling, size,placement)
Re: Resizing the program window
I haven't used View and Window for a long time because I had had bad experiences with them in QuickBasic, ha, ha... but maybe their implementation in FreeBasic is better. I don't think you can define a viewport larger than the program window, which would be an elegant way of adding support for things like window resizing and dragging and desktop capture while keeping FreeBasic compatible with QuickBasic, and code looking native, by the way. So it's very interesing that you mention it.
View is useful for clipping. I have used it... very seldom, but I have. But Window... I normally do the scaling myself. One example of a reason why I normally do that is that if I scale larger, I lose direct access to the physical pixels between logical pixels. I imagine that, if I resize a window, normally I will just want to extend the space available for one of the functions instead of stretching all the contents. For example, say I'm writing a text editor. I don't want the text to zoom and stretch. I just want more space to type more lines and columns. Also, I still want the menu to be the same height. I think Window is most useful when combined with View (which is also when it gets more messy, ha, ha), to plot graphics in a region of your screen in a way that the graphic can be stretched. I'm talking about graphics such as histograms and the sort.
What is your view of View?..... And your window of Window? :P
View is useful for clipping. I have used it... very seldom, but I have. But Window... I normally do the scaling myself. One example of a reason why I normally do that is that if I scale larger, I lose direct access to the physical pixels between logical pixels. I imagine that, if I resize a window, normally I will just want to extend the space available for one of the functions instead of stretching all the contents. For example, say I'm writing a text editor. I don't want the text to zoom and stretch. I just want more space to type more lines and columns. Also, I still want the menu to be the same height. I think Window is most useful when combined with View (which is also when it gets more messy, ha, ha), to plot graphics in a region of your screen in a way that the graphic can be stretched. I'm talking about graphics such as histograms and the sort.
What is your view of View?..... And your window of Window? :P
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Resizing the program window
I have no window of window, not even a clue of it, but my view on view is best summarized here below. Note that you can use the scrolling on the debug window if I remember well:xlucas wrote:What is your view of View?..... And your window of Window? :P
Code: Select all
'simulation of a mobile
#include "fbgfx.bi"
nameSpace dbg
dim as integer consoleXi
dim as integer consoleYi
dim as integer verticalCursorPos
end nameSpace
#macro _STARTDBGCONSOLE(xi, yi)
dbg.consoleXi = (xi)
dbg.consoleYi = (yi)
dbg.verticalCursorPos = 10
#endMacro
#macro _APPENDDRAWTODBGCONSOLE(text)
draw string (dbg.consoleXi, dbg.verticalCursorPos + gmWheel*8), _
(text), _
iif((dbg.verticalCursorPos mod 20)=0, 0, rgb(220,20,90))
dbg.verticalCursorPos += 10
#endMacro
nameSpace cst
const as double _pi => 4*atn(1)
end nameSpace
#macro _P2DDISTANCE(p1, p2)
( sqr( (p2._x - p1._x)^2 + (p2._y - p1._y)^2 ) )
#endMacro
#define _MIN(a, b) iif( (a)<(b), (a), (b) )
#define _MAX(a, b) iif( (a)>(b), (a), (b) )
#macro _VP(angle)
iif(angle>2*cst._pi, angle - 2*cst._pi, iif(angle<0, 2*cst._pi + angle, angle))
#endMacro
type P2D
declare function DistanceToP2D(byval P as P2D) as single
declare sub DrawP2D()
as integer _x
as integer _y
as ulong _c
end type
function P2D.DistanceToP2D(byval P as P2D) as single
'---->
return _P2DDISTANCE(THIS, P)
end function
sub P2D.DrawP2D()
circle (THIS._x, THIS._y), 4
end sub
type BIPOINT
declare sub RefreshSegmentLength()
as P2D _firstPoint
as P2D _secondPoint
as single _segmentLength
declare static sub QsortDistanceFirstPointToP(byref P as P2D, Array() As BIPOINT, LB as long, UB as ulong)
declare static sub QsortDistanceSecondPointToP(byref P as P2D, Array() As BIPOINT, LB as long, UB as ulong)
declare static sub QsortDistance(Array() As BIPOINT, LB as long, UB as ulong)
end type
sub BIPOINT.RefreshSegmentLength()
THIS._segmentLength = _P2DDISTANCE(THIS._firstPoint, THIS._secondPoint)
end sub
sub BIPOINT.QsortDistanceFirstPointToP(byref P as P2D, Array() As BIPOINT, LB as long, UB as ulong)
'adapted from Qsort/.author: dodicat@fb.net
dim as long i => LB
dim as long j => UB
dim as BIPOINT item => Array( ( (i + j)\2 ) )
'
while i<=j
while Array(i)._firstPoint.DistanceToP2D(P)>item._firstPoint.DistanceToP2D(P) : i += 1 : wend
while Array(j)._firstPoint.DistanceToP2D(P)<item._firstPoint.DistanceToP2D(P) : j -= 1 : wend
if i<j then
swap Array(i), Array(j)
i += 1
j -= 1
elseIf i=j then
i += 1
j -= 1
end if
wend
'
if j>LB then BIPOINT.QsortDistanceFirstPointToP( P, Array() , LB, j )
if i<UB then BIPOINT.QsortDistanceFirstPointToP( P, Array(), i, UB)
end sub
sub BIPOINT.QsortDistanceSecondPointToP(byref P as P2D, Array() As BIPOINT, LB as long, UB as ulong)
'adapted from Qsort/.author: dodicat@fb.net
dim as long i => LB
dim as long j => UB
dim as BIPOINT item => Array( ( (i + j)\2 ) )
'
while i<=j
while Array(i)._secondPoint.DistanceToP2D(P)>item._secondPoint.DistanceToP2D(P) : i += 1 : wend
while Array(j)._secondPoint.DistanceToP2D(P)<item._secondPoint.DistanceToP2D(P) : j -= 1 : wend
if i<j then
swap Array(i), Array(j)
i += 1
j -= 1
elseIf i=j then
i += 1
j -= 1
end if
wend
'
if j>LB then BIPOINT.QsortDistanceSecondPointToP( P, Array() , LB, j )
if i<UB then BIPOINT.QsortDistanceSecondPointToP( P, Array(), i, UB)
end sub
sub BIPOINT.QsortDistance(Array() As BIPOINT, LB as long, UB as ulong)
'adapted from Qsort/.author: dodicat@fb.net
dim as long i => LB
dim as long j => UB
dim as BIPOINT item => Array( ( (i + j)\2 ) )
'
while i<=j
while Array(i)._segmentLength>item._segmentLength : i += 1 : wend
while Array(j)._segmentLength<item._segmentLength : j -= 1 : wend
if i<j then
swap Array(i), Array(j)
i += 1
j -= 1
elseIf i=j then
i += 1
j -= 1
end if
wend
'
if j>LB then BIPOINT.QsortDistance( Array() , LB, j )
if i<UB then BIPOINT.QsortDistance( Array(), i, UB)
end sub
function BresenhamPsetAndDetect( byval X1 as integer, _
byval Y1 as integer, _
byval X2 as integer, _
byval Y2 As integer, _
byval PlotColour as ulong, _
NeutralColour() as ulong, _
ObstacleP2D as P2D) _
as boolean
#macro _DETECT(detectionStartingDist)
scope
if sqr((xp - xi)^2 + (yp - yi)^2)>detectionStartingDist then
dim as integer index
for index = lBound(NeutralColour) to uBound(NeutralColour)
if point(xp, yp)=NeutralColour(index) then
hasDetectedNeutral = TRUE
index = index - 1
exit for
end if
next index
if index>(uBound(NeutralColour) - lBound(NeutralColour)) then
'
ObstacleP2D._x => xp
ObstacleP2D._y => yp
ObstacleP2D._c => point(xp, yp)
'
'---->
return hasDetectedNeutral
end if
end if
end scope
#endmacro
'
ObstacleP2D._x => -1
ObstacleP2D._y => -1
ObstacleP2D._c => -1
dim as boolean hasDetectedNeutral
dim as integer xi => X1
dim as integer yi => Y1
dim as integer xp => X1
dim as integer yp => Y1
'
dim as integer scrW, scrH
screenInfo scrW, scrH
var deltaX => abs(X2 - X1)
var deltaY => abs(Y2 - Y1)
var iX => sgn(X1 - X2)*( (deltaX>0) and (1 or -1) )
var iY => sgn(Y1 - Y2)*( (deltaY>0) and (1 or -1) )
deltaX = 2*abs(deltaX)
deltaY = 2*abs(deltaY)
'
'if X1>=0 andAlso _
' X1<=scrW andAlso _
' Y1>=0 andAlso _
' Y1<=scrH then
if cBool(X1=X2) andAlso cBool(Y1=Y2) then
_DETECT(8)
end if
pSet (xp, yp), PlotColour
'end if
'
dim as integer errorValue
if deltaX>=deltaY then
errorValue = deltaY - deltaX/ 2
'
while (X1<>X2)
if (errorValue>=0) and _
( (errorValue<>0) or (iX>0) ) then
errorValue -= deltaX
Y1 += iY
end if
'
errorValue += deltaY
X1 += iX
'
if Y1>Y2 then
if X1>X2 then
xp = X1
yp = Y1
else
xp = X1
yp = Y1
end if
else
xp = X1
yp = Y1
end if
'if X1>=0 andAlso _
' X1<=scrW andAlso _
' Y1>=0 andAlso _
' Y1<=scrH then
_DETECT(8)
pSet (xp, yp), PlotColour*xp*yp
'end if
'
wend
else
errorValue = deltaX - deltaY/2
'
while (Y1<>Y2)
if (errorValue >= 0) and _
( (errorValue<>0) or (iY>0) ) then
errorValue -= deltaY
X1 += iX
end if
'
errorValue += deltaX
Y1 += iY
'
if Y1>Y2 then
if X1>X2 then
xp = X1
yp = Y1
else
xp = X1
yp = Y1
end if
else
xp = X1
yp = Y1
end if
'if X1>=0 andAlso _
' X1<=scrW andAlso _
' Y1>=0 andAlso _
' Y1<=scrH then
_DETECT(8)
pSet (xp, yp), PlotColour*xp*yp
'end if
'
wend
end if
'
return not hasDetectedNeutral
#undef _DETECT
end function
type BOX extends OBJECT
declare property Xi() as single
declare property Yi() as single
declare property Xf() as single
declare property Yf() as single
as single _boxTopLeftCornerX
as single _boxTopLeftCornerY
as single _boxWidth
as single _boxHeight
as ulong _boxColour
end type
property BOX.Xi() as single
'---->
return THIS._boxTopLeftCornerX
end property
property BOX.Yi() as single
'---->
return THIS._boxTopLeftCornerY
end property
property BOX.Xf() as single
'---->
return ( THIS._boxTopLeftCornerX + THIS._boxWidth )
end property
property BOX.Yf() as single
'---->
return ( THIS._boxTopLeftCornerY + THIS._boxHeight )
end property
type DETECTOR extends BOX
declare constructor()
declare property DetectionRange() as single
declare property DetectionRange(byval as single)
declare property SweepingAngleStep() as double
declare property NearestObstacle() as P2D
declare sub RefreshNeutralColor( NC() as ulong )
declare sub RemoveFromObstacleFreeBiPointArrayAt(byval Index as integer)
declare sub RemovePassedObstacleFromObstacleFreeBiPointArray()
declare sub AddToObstacleFreeBiPointArray()
declare sub RemoveFromObstacleFreeBiPointArray()
declare sub PerformAnalysis()
declare sub ScanForObstacle()
declare sub DrawHelper()
declare sub DrawCameraHelper()
'______________OWNER PARAMETER
as ulong _neutralColor(any)
as double _headingAngle
as single _rotationRate
'_____________DETECTOR SETTING
as single _detectionRange
as double _sweepingAngleStep
as double _sweeperRayAngle
as integer _sweepingSign
as double _sweepingZero
as double _sweeperRelativeAnglePlus
as double _sweeperRelativeAngleMinus
'____________OBSTACLE DETECTION
as boolean _hasObstacleFreeStartingPoint
as boolean _hasObstacleFreeEndingPoint
as P2D _lastObstacleFreeSegmentStartingPoint
as P2D _lastObstacleFreeSegmentEndingPoint
as integer _numberOfObstacleFreeSegment
as BIPOINT _obstacleFreeSegmentArray(any)
'________________________HELPER
dim as integer _camViewPortX
dim as integer _camViewPortY
dim as fb.IMAGE ptr _camHelperImage
end type
constructor DETECTOR()
redim as ulong nC(0)
nC(0) = 0
THIS.RefreshNeutralColor( nC() )
'
with THIS
._rotationRate => 0
._detectionRange => 100
._sweepingAngleStep => 0.1
._sweeperRayAngle => THIS._headingAngle
._sweepingSign => +1
._sweepingZero => 0
._sweeperRelativeAnglePlus => +.6
._sweeperRelativeAngleMinus => -.6
end with
'
with THIS
._camViewPortX => 40
._camViewPortY => 40
._camHelperImage => imageCreate(160, 160, rgb(255,0,255), 32)
end with
end constructor
property DETECTOR.DetectionRange() as single
'---->
return _MAX(2, THIS._detectionRange)
end property
property DETECTOR.DetectionRange(byval SetValue as single)
THIS._detectionRange = _MAX(2, SetValue)
end property
property DETECTOR.SweepingAngleStep() as double
':broken - about the smallest useful step (to save computation):
'if abs(THIS._sweepingAngleStep)<(3/_detectionRange) then
' THIS._sweepingAngleStep = sgn(THIS._sweepingAngleStep)*(3/_detectionRange)
'end if
'---->
return THIS._sweepingAngleStep
end property
property DETECTOR.NearestObstacle() as P2D
dim as P2D P = type<P2D>(THIS.Xi, THIS.Yi , 0)
'
BIPOINT.QsortDistanceFirstPointToP( P, _
THIS._obstacleFreeSegmentArray(), _
lBound(THIS._obstacleFreeSegmentArray), _
uBound(THIS._obstacleFreeSegmentArray) )
dim as P2D minFirstPoint => _
THIS._obstacleFreeSegmentArray(uBound(THIS._obstacleFreeSegmentArray))._firstPoint
'
BIPOINT.QsortDistanceSecondPointToP( P, _
THIS._obstacleFreeSegmentArray(), _
lBound(THIS._obstacleFreeSegmentArray), _
uBound(THIS._obstacleFreeSegmentArray) )
dim as P2D minSecondPoint => _
THIS._obstacleFreeSegmentArray(uBound(THIS._obstacleFreeSegmentArray))._secondPoint
'
if _P2DDISTANCE( P, minFirstPoint)<_P2DDISTANCE( P, minSecondPoint) then
'---->
return minFirstPoint
else
'---->
return minSecondPoint
end if
end property
sub DETECTOR.RefreshNeutralColor( NC() as ulong )
redim THIS._neutralColor(uBound(NC))
for index as integer = 0 to uBound(NC)
THIS._neutralColor(index) = NC(index)
next index
end sub
sub DETECTOR.RemoveFromObstacleFreeBiPointArrayAt(byval Index as integer)
if Index>=lBound(THIS._obstacleFreeSegmentArray) andAlso _
Index<uBound(THIS._obstacleFreeSegmentArray) then
swap THIS._obstacleFreeSegmentArray(Index), _
THIS._obstacleFreeSegmentArray(uBound(THIS._obstacleFreeSegmentArray))
'
if (uBound(THIS._obstacleFreeSegmentArray) - lBound(THIS._obstacleFreeSegmentArray) - 1)<0 then
erase THIS._obstacleFreeSegmentArray
else
redim preserve _
THIS._obstacleFreeSegmentArray( uBound(THIS._obstacleFreeSegmentArray) - _
lBound(THIS._obstacleFreeSegmentArray) - _
1)
end if
end if
end sub
sub DETECTOR.RemovePassedObstacleFromObstacleFreeBiPointArray()
#macro _EVALUATELINE(theta, xo, yo, x, y)
( sin((theta))*((x) - (xo)) - cos((theta))*((y) - (yo)) )
#endMacro
'
dim as double theta = -THIS._headingAngle - cst._pi
'
dim as single signAtSensorBoxAnchor => _EVALUATELINE( theta, _
THIS.Xi, _
THIS.Yi, _
THIS.Xi + THIS._boxWidth*cos(theta), _
THIS.Yi + THIS._boxWidth*sin(theta) )
assert(signAtSensorBoxAnchor=0)
'
dim as single signAtFrontOfSensorBox => _EVALUATELINE( theta, _
THIS.Xi, _
THIS.Yi, _
THIS.Xi + 14*cos(-THIS._headingAngle - cst._pi/2), _
THIS.Yi + 14*sin(-THIS._headingAngle - cst._pi/2) )
'
for index as integer = 0 to uBound(THIS._obstacleFreeSegmentArray)
dim as single evaluateAtP1
evaluateAtP1 => _EVALUATELINE( theta, _
THIS.Xi, _
THIS.Yi, _
THIS._obstacleFreeSegmentArray(index)._firstPoint._x, _
THIS._obstacleFreeSegmentArray(index)._firstPoint._y )
dim as single evaluateAtP2
evaluateAtP2 => _EVALUATELINE( theta, _
THIS.Xi, _
THIS.Yi, _
THIS._obstacleFreeSegmentArray(index)._secondPoint._x, _
THIS._obstacleFreeSegmentArray(index)._secondPoint._y )
if (sgn(evaluateAtP1)=-sgn(signAtFrontOfSensorBox)) andAlso _
(sgn(evaluateAtP2)=-sgn(signAtFrontOfSensorBox)) then
THIS.RemoveFromObstacleFreeBiPointArrayAt(index)
exit for
end if
next index
'
#undef _EVALUATELINE
end sub
sub DETECTOR.AddToObstacleFreeBiPointArray()
dim as BIPOINT bp
bp._firstPoint => THIS._lastObstacleFreeSegmentStartingPoint
bp._secondPoint => THIS._lastObstacleFreeSegmentEndingPoint
bp.RefreshSegmentLength()
assert(bp._segmentLength=0)
'
redim preserve _
THIS._obstacleFreeSegmentArray( uBound(THIS._obstacleFreeSegmentArray) - _
lBound(THIS._obstacleFreeSegmentArray) + _
1)
THIS._obstacleFreeSegmentArray( uBound(THIS._obstacleFreeSegmentArray) ) => bp
end sub
sub DETECTOR.PerformAnalysis()
THIS.RemovePassedObstacleFromObstacleFreeBiPointArray()
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
end sub
sub DETECTOR.ScanForObstacle()
select case THIS._sweepingSign
case +1
if (THIS._sweeperRayAngle - THIS._sweepingZero)>_sweeperRelativeAnglePlus then
THIS._sweepingSign = -1
THIS._sweeperRayAngle = 0
THIS._sweepingZero = 0
end if
case -1
if (THIS._sweeperRayAngle - THIS._sweepingZero)<_sweeperRelativeAngleMinus then
THIS._sweepingSign = +1
THIS._sweeperRayAngle = 0
THIS._sweepingZero = 0
end if
end select
'
THIS._sweeperRayAngle = _
THIS._sweeperRayAngle + THIS._sweepingSign*THIS.SweepingAngleStep + THIS._rotationRate
'
dim as P2D obstacleReturner
dim as P2D target
target._x => THIS.Xi + THIS._detectionRange*cos(THIS._sweeperRayAngle - THIS._headingAngle - cst._pi/2)
target._y => THIS.Yi + THIS._detectionRange*sin(THIS._sweeperRayAngle - THIS._headingAngle - cst._pi/2)
dim as boolean hasDetectedObstacle
hasDetectedObstacle = BresenhamPsetAndDetect( THIS.Xi, _
THIS.Yi, _
target._x, _
target._y, _
THIS._neutralColor(3) , _
THIS._neutralColor(), _
obstacleReturner )
if not hasDetectedObstacle then
circle (THIS.Xi, THIS.Yi), 4, THIS._neutralColor(3), , , , f
else
if not THIS._hasObstacleFreeStartingPoint then
THIS._lastObstacleFreeSegmentStartingPoint = obstacleReturner
THIS._hasObstacleFreeStartingPoint = TRUE
elseIf not THIS._hasObstacleFreeEndingPoint then
THIS._lastObstacleFreeSegmentEndingPoint = obstacleReturner
THIS._hasObstacleFreeEndingPoint = TRUE
else
THIS.AddToObstacleFreeBiPointArray()
THIS._hasObstacleFreeStartingPoint = FALSE
THIS._hasObstacleFreeEndingPoint = FALSE
end if
end if
end sub
sub DETECTOR.DrawHelper()
for index as integer = 0 to uBound(THIS._obstacleFreeSegmentArray)
circle (THIS._obstacleFreeSegmentArray(index)._firstPoint._x, _
THIS._obstacleFreeSegmentArray(index)._firstPoint._y), _
4, _
THIS._obstacleFreeSegmentArray(index)._firstPoint._c, , , , f
circle (THIS._obstacleFreeSegmentArray(index)._secondPoint._x, _
THIS._obstacleFreeSegmentArray(index)._secondPoint._y), _
4, _
THIS._obstacleFreeSegmentArray(index)._secondPoint._c, , , , f
next index
end sub
sub DETECTOR.DrawCameraHelper()
'to use out of the main viewport
line THIS._camHelperImage, (0,0)-(160,160), rgb(255,0,255), bf
'
view (40 + THIS._camViewPortX,40 + THIS._camViewPortY)- _
(200 + THIS._camViewPortX,200 + THIS._camViewPortY), _
rgb(200,200,200), _
rgb(100,100,80)
window (-600,-10)-(+600,+10)
dim as single d
dim as single e
dim as single theta
dim as single h
dim as integer xO
dim as integer yO
dim as integer xM
dim as integer yM
dim as integer xX
dim as integer yY
dim as integer dist
h = THIS._headingAngle
theta = -h - cst._pi/2
xM = THIS.Xi + 100*cos(theta)
yM = THIS.Yi + 100*sin(theta)
for index as integer = 0 to uBound(THIS._obstacleFreeSegmentArray)
xO = THIS._obstacleFreeSegmentArray(index)._secondPoint._x
yO = THIS._obstacleFreeSegmentArray(index)._secondPoint._y
d = ( sin(theta)*(xO - xM) - cos(theta)*(yO - yM) )/( sin(-h)*cos(theta) - sin(theta)*cos(-h) )
e = ( sin(-h)*(xO - xM) - cos(-h)*(yO - yM) )/( sin(-h)*cos(theta) - sin(theta)*cos(-h) )
xX = THIS.Xi + d*cos(-h)
yY = THIS.Yi + d*sin(-h)
dist = sgn(d)*sqr( (xX - xM)^2 + (yY - yM)^2 )
circle THIS._camHelperImage, _
(dist, 0), _
_P2DDISTANCE(type<P2D>(THIS.Xi, THIS.Yi, 0), _
THIS._obstacleFreeSegmentArray(index)._secondPoint), _
THIS._obstacleFreeSegmentArray(index)._secondPoint._c
'*
xO = THIS._obstacleFreeSegmentArray(index)._firstPoint._x
yO = THIS._obstacleFreeSegmentArray(index)._firstPoint._y
d = ( sin(theta)*(xO - xM) - cos(theta)*(yO - yM) )/( sin(-h)*cos(theta) - sin(theta)*cos(-h) )
e = ( sin(-h)*(xO - xM) - cos(-h)*(yO - yM) )/( sin(-h)*cos(theta) - sin(theta)*cos(-h) )
xX = THIS.Xi + d*cos(-h)
yY = THIS.Yi + d*sin(-h)
dist = sgn(d)*sqr( (xX - xM)^2 + (yY - yM)^2 )
circle THIS._camHelperImage, _
(dist, 0), _
_P2DDISTANCE(type<P2D>(THIS.Xi, THIS.Yi, 0), _
THIS._obstacleFreeSegmentArray(index)._firstPoint), _
THIS._obstacleFreeSegmentArray(index)._firstPoint._c
next index
put (-600, 10), THIS._camHelperImage, TRANS
window screen
view screen
end sub
type MOBILE extends BOX
declare constructor()
declare operator cast() as integer
declare property RightNose() as P2D
declare property LeftNose() as P2D
declare property MobSpeed() as single
declare property MobSpeed(byval as single)
declare sub RefreshNosePosition()
declare sub RefreshDetectionDevicePosition()
declare sub RotateMob()
declare sub MoveMob()
declare sub SetCourse()
declare sub DrawMob()
declare sub DrawMobVisualGuide()
'________________________MOBILE
as single _mobSpeed
as single _mobRotationRate
as double _headingAngle
'
as double _instantCourseToTargetAngle
as P2D _targetPoint(any)
'______________________DETECTOR
as DETECTOR _mobL0DetectionDevice
as DETECTOR _mobR0DetectionDevice
'_____________NOSE VISUAL GUIDE
as P2D _rightNose
as P2D _rightNoseforward
as single _rightNoseDistanceToCenter
as ubyte _rightNoseBlinker
as P2D _leftNose
as P2D _leftNoseforward
as single _leftNoseDistanceToCenter
as ubyte _leftNoseBlinker
static as ulong neutralColor(any)
end type
redim as ulong MOBILE.neutralColor(3)
with MOBILE
.neutralColor(0) = rgb(120,60,150)
.neutralColor(1) = rgb(45,58,72)
.neutralColor(2) = rgb(85,88,122)
.neutralColor(3) = rgb(255,0,255)
end with
constructor MOBILE()
dim as integer scrW, scrH
screenInfo scrW, scrH
'BOX
'note:: box corner is center of rotation
with THIS
._boxTopLeftCornerX => 25
._boxTopLeftCornerY => scrH\2
._boxWidth => 40
._boxHeight => 25
._boxColour => rgb(240,140,180)
end with
'MOB
with THIS
._mobSpeed => 1.9
._mobRotationRate => +.005
._headingAngle => 3*cst._pi/2
end with
'DETECTOR
THIS.RefreshDetectionDevicePosition()
THIS._mobL0DetectionDevice._camViewPortX => 0
THIS._mobL0DetectionDevice._camViewPortY => 0
THIS._mobR0DetectionDevice._camViewPortX => 560
THIS._mobR0DetectionDevice._camViewPortY => 0
'NOSE
with THIS
._rightNose._x => .Xf - 100*sin(._headingAngle)
._rightNose._y => ._boxTopLeftCornerY + ._boxHeight\2 - 100*cos(._headingAngle)
._rightNoseDistanceToCenter = sqr( (._rightNose._x - ._boxTopLeftCornerX)^2 + _
(._rightNose._x - ._boxTopLeftCornerY)^2 )
'
._leftNose._x => .Xf - 100*sin(._headingAngle)
._leftNose._y => ._boxTopLeftCornerY + ._boxHeight\2 - 100*cos(._headingAngle)
._leftNoseDistanceToCenter = sqr( (._leftNose._x - ._boxTopLeftCornerX)^2 + _
(._leftNose._x - ._boxTopLeftCornerY)^2 )
end with
'
THIS.SetCourse()
end constructor
operator MOBILE.cast() as integer
static as ubyte alternator
if alternator=1 then
alternator = 0
'---->
return THIS.Xi
else
alternator = 1
'---->
return THIS.Yi
end if
end operator
property MOBILE.RightNose() as P2D
THIS.RefreshNosePosition()
'---->
return THIS._rightNose
end property
property MOBILE.LeftNose() as P2D
THIS.RefreshNosePosition()
'---->
return THIS._leftNose
end property
property MOBILE.MobSpeed() as single
'---->
return THIS._mobSpeed
end property
property MOBILE.MobSpeed(byval SetValue as single)
THIS._mobSpeed = SetValue
end property
sub MOBILE.RefreshNosePosition()
'right nose
THIS._rightNose._x = _
THIS._boxTopLeftCornerX - THIS._rightNoseDistanceToCenter*sin(THIS._headingAngle - cst._pi/50)
THIS._rightNose._y = _
THIS._boxTopLeftCornerY - THIS._rightNoseDistanceToCenter*cos(THIS._headingAngle - cst._pi/50)
'left nose
THIS._leftNose._x = _
THIS._boxTopLeftCornerX - THIS._leftNoseDistanceToCenter*sin(THIS._headingAngle + cst._pi/50)
THIS._leftNose._y = _
THIS._boxTopLeftCornerY - THIS._leftNoseDistanceToCenter*cos(THIS._headingAngle + cst._pi/50)
end sub
sub MOBILE.RefreshDetectionDevicePosition()
with THIS._mobL0DetectionDevice
.RefreshNeutralColor(MOBILE.neutralColor())
._headingAngle => THIS._headingAngle
._boxTopLeftCornerX => THIS._leftNoseforward._x
._boxTopLeftCornerY => THIS._leftNoseforward._y
._rotationRate => THIS._mobRotationRate
end with
with THIS._mobR0DetectionDevice
.RefreshNeutralColor(MOBILE.neutralColor())
._headingAngle => THIS._headingAngle
._boxTopLeftCornerX => THIS._rightNoseforward._x
._boxTopLeftCornerY => THIS._rightNoseforward._y
._rotationRate => THIS._mobRotationRate
end with
end sub
sub MOBILE.RotateMob()
'heading angle cycle
if (THIS._headingAngle - 4.71)>2*cst._pi then THIS._headingAngle = 4.71
if (THIS._headingAngle - 4.71)<0 then THIS._headingAngle = 2*cst._pi + 4.71
'right nose
THIS._rightNoseforward._x = THIS._boxTopLeftCornerX - _
sqr(THIS._boxWidth^2 + THIS._boxHeight^2/4)*sin(THIS._headingAngle - cst._pi/10)
THIS._rightNoseforward._y = THIS._boxTopLeftCornerY - _
sqr(THIS._boxWidth^2 + THIS._boxHeight^2/4)*cos(THIS._headingAngle - cst._pi/10)
'left nose
THIS._leftNoseforward._x = THIS._boxTopLeftCornerX - _
sqr(THIS._boxWidth^2 + THIS._boxHeight^2/4)*sin(THIS._headingAngle + cst._pi/10)
THIS._leftNoseforward._y = THIS._boxTopLeftCornerY - _
sqr(THIS._boxWidth^2 + THIS._boxHeight^2/4)*cos(THIS._headingAngle + cst._pi/10)
end sub
sub MOBILE.MoveMob()
with THIS
._headingAngle = ._headingAngle + ._mobRotationRate
._boxTopLeftCornerX += -._mobSpeed*sin(._headingAngle)
._boxTopLeftCornerY += -._mobSpeed*cos(._headingAngle)
end with
'
THIS.RotateMob()
end sub
sub MOBILE.SetCourse()
THIS.MoveMob()
THIS.RefreshDetectionDevicePosition()
'
with THIS._mobL0DetectionDevice
.ScanForObstacle()
.PerformAnalysis()
end with
with THIS._mobR0DetectionDevice
.ScanForObstacle()
.PerformAnalysis()
end with
end sub
sub MOBILE.DrawMob()
for y as integer = 0 to THIS._boxWidth
for x as integer = 0 to THIS._boxHeight\2
pset( THIS._boxTopLeftCornerX - cos(THIS._headingAngle)*x - sin(THIS._headingAngle)*y, _
THIS._boxTopLeftCornerY - cos(THIS._headingAngle)*y + sin(THIS._headingAngle)*x ), _
rgb(240,240,120)
next x
next y
for y as integer = 0 to THIS._boxWidth
for x as integer = -THIS._boxHeight\2 to 0
pset( THIS._boxTopLeftCornerX - cos(THIS._headingAngle)*x - sin(THIS._headingAngle)*y, _
THIS._boxTopLeftCornerY - cos(THIS._headingAngle)*y + sin(THIS._headingAngle)*x ), _
rgb(240,240,120)
next x
next y
'
circle (THIS._boxTopLeftCornerX, THIS._boxTopLeftCornerY), 2, , , , , f
end sub
sub MOBILE.DrawMobVisualGuide()
dim as P2D obstacleReturner
dim as boolean r
r = BresenhamPsetAndDetect( THIS._rightNoseforward._x, _
THIS._rightNoseforward._y, _
(THIS.RightNose)._x, _
(THIS.RightNose)._y, _
rgb(200,100,100) , _
MOBILE.neutralColor(), _
obstacleReturner )
if not r then
circle ((THIS.RightNose)._x, (THIS.RightNose)._y), 2, rgb(200,200,100), , , , f
if (THIS._rightNoseBlinker mod 2)=0 then
circle ((THIS.RightNose)._x, (THIS.RightNose)._y), 4, rgb(200,200,100), , , , f
end if
end if
r = BresenhamPsetAndDetect( THIS._leftNoseforward._x, _
THIS._leftNoseforward._y, _
(THIS.LeftNose)._x, _
(THIS.LeftNose)._y, _
rgb(200,100,100) , _
MOBILE.neutralColor(), _
obstacleReturner )
if not r then
circle ((THIS.LeftNose)._x, (THIS.LeftNose)._y), 2, rgb(200,200,100), , , , f
if (THIS._leftNoseBlinker mod 2)=0 then
circle ((THIS.LeftNose)._x, (THIS.LeftNose)._y), 4, rgb(200,200,100), , , , f
end if
end if
'
THIS._rightNoseBlinker += 1
THIS._leftNoseBlinker += 1
'
circle (THIS._rightNoseforward._x, THIS._rightNoseforward._y), _
2, _
rgb(250,190,190), _
, _
, _
, f
circle (THIS._leftNoseforward._x, THIS._leftNoseforward._y), _
2, _
rgb(250,190,190), _
, _
, _
, f
'
draw string ((THIS._rightNoseforward)._x, (THIS._rightNoseforward)._y + 4), _
left(str(THIS._headingAngle - 4.71), 4), rgb(200,240,180)
draw string ((THIS._rightNoseforward)._x, (THIS._rightNoseforward)._y + 14), _
str(THIS._mobSpeed), rgb(200,240,180)
draw string ((THIS._rightNoseforward)._x, (THIS._rightNoseforward)._y + 24), _
str(THIS._mobRotationRate), rgb(200,240,180)
'
THIS._mobL0DetectionDevice.DrawHelper()
THIS._mobR0DetectionDevice.DrawHelper()
end sub
type OBSTACLE extends BOX
declare constructor()
declare sub InitRandomObstacle()
declare sub DrawObstacle()
declare static sub DrawAllObstacle()
static as OBSTACLE ptr arrayOfObstaclePtr()
end type
dim as OBSTACLE ptr OBSTACLE.arrayOfObstaclePtr(any)
constructor OBSTACLE()
THIS.InitRandomObstacle()
end constructor
sub OBSTACLE.InitRandomObstacle()
redim preserve _
OBSTACLE.arrayOfObstaclePtr(uBound(OBSTACLE.arrayOfObstaclePtr) + 1)
OBSTACLE.arrayOfObstaclePtr(uBound(OBSTACLE.arrayOfObstaclePtr)) = @THIS
'
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer tlcX, tlcY, wid, hei
'
dim as integer loopCounter
do
if loopCounter = 8 then
tlcX = scrW\4 + rnd()*scrW\2
exit do
end if
loopCounter += 1
tlcX = -scrW + 3*rnd()*(scrW)
loop until ( tlcX>=(-scrW + 20) andAlso tlcX<=(2*scrW - 20) )
'
loopCounter = 0
do
if loopCounter = 8 then
tlcY = scrH\4 + rnd()*scrH\2
exit do
end if
loopCounter += 1
tlcY = -scrH + 3*rnd()*(scrH)
loop until ( tlcY>=(-scrH + 20) andAlso tlcY<=(2*scrH - 20) )
'
loopCounter = 0
do
if loopCounter = 8 then
wid = 4
exit do
end if
loopCounter += 1
wid = rnd()*scrW
loop until ( wid>=2 andAlso wid<=(scrW\40) )
'
loopCounter = 0
do
if loopCounter = 8 then
hei = 4
exit do
end if
loopCounter += 1
hei = rnd()*scrH
loop until ( hei>=2 andAlso hei<=(scrH\40) )
'
with THIS
._boxTopLeftCornerX => tlcX
._boxTopLeftCornerY => tlcY
._boxWidth => wid
._boxHeight => hei
._boxColour => rgb(240,140,180 - 120*rnd())
end with
end sub
sub OBSTACLE.DrawObstacle()
line ( THIS._boxTopLeftCornerX, THIS._boxTopLeftCornerY )- _
step( THIS._boxWidth, THIS._boxHeight ), _
THIS._boxColour, _
bf
end sub
sub OBSTACLE.DrawAllObstacle()
for index as integer = 0 to uBound(OBSTACLE.arrayOfObstaclePtr)
OBSTACLE.arrayOfObstaclePtr(index)->DrawObstacle()
next index
end sub
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
randomize TIMER, 2
screenRes 800, 540, 32, 2, fb.GFX_NO_FRAME
screenSet 1, 0
color , rgb(145,145,145)
cls
? "freebasic mobile simulation"
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as MOBILE mob
mob._boxTopLeftCornerX = 150
redim as OBSTACLE obst(1800)
'view window
dim as integer leftBorderOffset => 20
dim as integer rightBorderOffset => 20
dim as integer topBorderOffset => 20
dim as integer bottomBorderOffset => 100
dim as string keypressed
do
'<.......>
mob._mobRotationRate += iif(mob._mobRotationRate>0.1, -mob._mobRotationRate, +0.001)
'mob._mobRotationRate = 0.0
mob._mobSpeed += iif(mob._mobSpeed>14, -mob._mobSpeed, +0.1)
'mob._mobSpeed = 1
'<display>
view (leftBorderOffset, topBorderOffset)-(scrW - rightBorderOffset, scrH - bottomBorderOffset), _
MOBILE.neutralColor(1), _
rgb(250,120,120)
window screen (mob - scrW\2 + leftBorderOffset, mob - scrH\2 + topBorderOffset)- _
(mob + scrW\2 - rightBorderOffset - 1, mob + scrH\2 - bottomBorderOffset - 1)
'some neutral background....................
line ( 0, 150 )-step( scrW, scrH - 300 ), _
MOBILE.neutralColor(0), _
bf
'obstacle...................................
OBSTACLE.DrawAllObstacle()
'mob........................................
mob.SetCourse()
mob.DrawMob()
'helper*************************************
'mob.DrawMobVisualGuide()
mob._mobL0DetectionDevice.DrawHelper()
mob._mobR0DetectionDevice.DrawHelper()
'
window screen
view screen
'camera viewport
mob._mobL0DetectionDevice.DrawCameraHelper()
mob._mobR0DetectionDevice.DrawCameraHelper()
'
'debug viewport
'
dim as integer gmX, gmY, gmWheel, gmBtn
getMouse gmX, gmY, gmWheel, gmBtn
view (80, scrH - 90)-(scrW - 20, scrH - 10), rgb(200,200,200), rgb(100,100,160)
draw string (1,1), str(gmWheel)
_STARTDBGCONSOLE(10, 10)
_APPENDDRAWTODBGCONSOLE( "dv._obstacleArray:: "& str(uBound(mob._mobL0DetectionDevice._obstacleFreeSegmentArray)) )
_APPENDDRAWTODBGCONSOLE( "mb.position:: "& str( mob.Xi ) &"..."& str( mob.Yi ) )
_APPENDDRAWTODBGCONSOLE( "mb.speed:: "& str(mob.MobSpeed ) )
_APPENDDRAWTODBGCONSOLE( "dv.SweepingAngleStep:: "& str(mob._mobL0DetectionDevice.SweepingAngleStep ) )
_APPENDDRAWTODBGCONSOLE( "dv.DetectionRange:: "& str(mob._mobL0DetectionDevice.DetectionRange ) )
_APPENDDRAWTODBGCONSOLE( "dv._neutralColor count:: "& str(uBound(mob._mobL0DetectionDevice._neutralColor)) )
_APPENDDRAWTODBGCONSOLE( "dv.__sweeperRayAngle:: "& str(mob._mobL0DetectionDevice._sweeperRayAngle) )
_APPENDDRAWTODBGCONSOLE( "dv._heading:: "& str(mob._mobL0DetectionDevice._headingAngle) )
_APPENDDRAWTODBGCONSOLE( "mb._heading:: "& str(mob._headingAngle) )
_APPENDDRAWTODBGCONSOLE( "mb._heading:: "& str(mob._headingAngle) )
view screen
'draw to screen.................................
flip 1,0
'
sleep 100
keypressed = inkey()
loop until chr(27)=keypressed
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
getKey()
'(eof)Code: Select all
'level0----------------------------------------
'program purpose: .............................
'example implementing dual-view & wrap around
'level1----------------------------------------
'------------------------PREPROCESSOR DIRECTIVE
#include "fbgfx.bi"
#macro _FreeKeyboardBuffer
while inkey<>""
'free keyboard buffer
wend
#endmacro '_FreeKeyboardBuffer
'level2----------------------------------------
'--------------------------------------CONSTANT
'level3----------------------------------------
'--------------------------------UDT / OPERATOR
'level4----------------------------------------
'-------------------------FUNCT/SUB DECLARATION
declare sub DrawTree(byref as fb.IMAGE ptr, _
byval as integer, _
byval as integer, _
byval as ulong)
declare sub DrawPlayer(byval as integer, _
byval as integer, _
byval as ulong)
declare sub DrawText(byval as integer, _
byval as integer, _
byval as string)
'level5----------------------------------------
'--------------------------------INITIALIZATION
'size screen
dim as integer myScreenWidth => 400
dim as integer myScreenHeight => 200
dim as integer myScreenColorDepth => 32
screenRes myScreenWidth, myScreenHeight, myScreenColorDepth
windowTitle "scrollable playground 2"
'size playground
dim as integer myPlaygroundWidth => myScreenWidth*2
dim as integer myPlaygroundHeight => myScreenHeight\2
dim as ulong myPlaygroundBackgroundColor => rgb(100,120,100)
dim as integer myPlaygroundColorDepth => 32
'
dim as fb.IMAGE ptr scrollableBackgroundImage
scrollableBackgroundImage => imageCreate(myPlaygroundWidth, _
myPlaygroundHeight, _
myPlaygroundBackgroundColor, _
myPlaygroundColorDepth)
'populate playground
dim as ulong frontierColor => rgb(180, 20, 90)
dim as ulong jointColor => rgb(200, 200, 200)
dim as ulong innerColor => rgb(150, 200, 150)
line scrollableBackgroundImage, _
(0,0)-(4, myPlaygroundHeight - 1), _
jointColor, _
bf
line scrollableBackgroundImage, _
(0,0)-(myPlaygroundWidth - 1, 4), _
frontierColor, _
bf
line scrollableBackgroundImage, _
(0,myPlaygroundHeight - 1)-(myPlaygroundWidth - 1, myPlaygroundHeight - 1 - 4), _
frontierColor, _
bf
'tree
dim as ulong treeColor1 => rgb(100,235,100)
dim as ulong treeColor2 => rgb(200,225,150)
dim as ulong treeColor3 => rgb(150,225,100)
randomize timer
for i as integer = 0 to (25 * myPlaygroundWidth\800)
dim as ulong effectiveColor
dim as integer x => myPlaygroundWidth*rnd()
dim as integer y => myPlaygroundHeight*rnd()
if x>30 and _
x<(myPlaygroundWidth - 1 - 30) and _
y>30 and _
y<(myPlaygroundHeight - 1 - 30) then
select case cInt(12*rnd())
case 0 to 3
effectiveColor = treeColor1
case 4 to 7
effectiveColor = treeColor2
case 8 to 12
effectiveColor = treeColor3
end select '12*rnd()
DrawTree(scrollableBackgroundImage, x, y, effectiveColor)
end if
next i
'player
dim as ulong player1Color => rgb(100,100,230)
dim as ulong player2Color => rgb(230,100,100)
'
'*VIEW1*
view (1, 1)-(myScreenWidth - 2, myScreenHeight\2 - 2), , rgb(80,80,200)
window (1, - myScreenHeight\2 + 2)-(myScreenWidth - 2, 1)
'put the playground at screen
put (0, 0), scrollableBackgroundImage, PSET
'draw player1
DrawPlayer(myScreenWidth\2, _
-myPlaygroundHeight\2, _
player1Color)
'draw player2
DrawPlayer(myScreenWidth\2 + 40, _
-myPlaygroundHeight\2, _
player2Color)
draw string (0, -04), "Press [ESC] to leave"
draw string (0, -14), "Arrow key to explore"
draw string (0, -22), "Any key to start...."
'
'*VIEW2*
view (1, myScreenHeight\2 + 1)-(myScreenWidth - 2, myScreenHeight - 2), , rgb(80,200,80)
window (1, - myScreenHeight\2 + 2)-(myScreenWidth - 2, -1)
'put the playground at screen
put (-40, 0), scrollableBackgroundImage, PSET
'draw player1
DrawPlayer(myScreenWidth\2 - 40, _
-myPlaygroundHeight\2, _
player1Color)
'draw player2
DrawPlayer(myScreenWidth\2, _
-myPlaygroundHeight\2, _
player2Color)
draw string (0, -04), "Press [ESC] to leave"
draw string (0, -14), "Arrow key to explore"
draw string (0, -22), "Any key to start...."
'
sleep
'level6----------------------------------------
'------------------------------------------MAIN
'level7----------------------------------------
'-------------------------------------MAIN LOOP
dim as single topPlaygroundOriginX => 0
dim as single topPlaygroundOriginY => 0
dim as single bottomPlaygroundOriginX => 0
dim as single bottomPlaygroundOriginY => 0
dim as boolean westernFrontierSighted => FALSE
dim as boolean westernFrontierPassed => FALSE
dim as boolean easternFrontierSighted => FALSE
dim as boolean easternFrontierPassed => FALSE
do
'---------------------------refresh graphics
screenLock
'necessary: for global cls reset global view
view screen
window
cls
'
' *VIEW1*
view (1, 1)-(myScreenWidth - 2, myScreenHeight\2 - 2), _
, _
rgb(80,80,200)
window (1, - myScreenHeight\2 + 2)-(myScreenWidth - 2, 1)
'put the playground at screen
'
put (topPlaygroundOriginX, topPlaygroundOriginY), _
scrollableBackgroundImage, _
PSET
'view1
'draw player1
DrawPlayer(myScreenWidth\2, _
-myPlaygroundHeight\2, _
player1Color)
'wrap around process
'*******************************************
if westernFrontierSighted then
put (topPlaygroundOriginX - myPlaygroundWidth + 2, _
topPlaygroundOriginY), _
scrollableBackgroundImage, _
XOR 'PSET
end if
'
if easternFrontierSighted then
put (topPlaygroundOriginX + myPlaygroundWidth - 1, _
topPlaygroundOriginY), _
scrollableBackgroundImage, _
XOR 'PSET
end if
'
if westernFrontierPassed then
westernFrontierSighted = FALSE
easternFrontierSighted = TRUE
topPlaygroundOriginX = myScreenWidth\2 - myPlaygroundWidth
topPlaygroundOriginY = topPlaygroundOriginY
end if
'
if easternFrontierPassed then
westernFrontierSighted = TRUE
easternFrontierSighted = FALSE
topPlaygroundOriginX = myScreenWidth\2
topPlaygroundOriginY = topPlaygroundOriginY
end if
'draw player2
DrawPlayer(myScreenWidth\2 + _
40 + _
bottomPlaygroundOriginX + _
topPlaygroundOriginX, _
topPlaygroundOriginY + _
bottomPlaygroundOriginY - _
myPlaygroundHeight\2, _
player2Color)
'
'*******************************************
'
'*******************************************
'important informations for debug purpose
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2 - 10, _
"Wsighted:"& westernFrontierSighted)
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2, _
"Esighted:"& easternFrontierSighted)
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2 + 10 , _
"Wpassed:"& westernFrontierPassed)
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2 + 20, _
"Epassed:"& easternFrontierPassed)
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2 + 30, _
"X"& str(topPlaygroundOriginX))
DrawText(myScreenWidth\2 - 60, _
-myPlaygroundHeight\2 + 40, _
"Y"& str(topPlaygroundOriginY))
'*******************************************
'
' *VIEW2*
view (1, myScreenHeight\2 + 1)-(myScreenWidth - 2, myScreenHeight - 2), _
, _
rgb(80,200,80)
window (1, - myScreenHeight\2 + 2)-(myScreenWidth - 2, -1)
'put the playground at screen
put (-40 - bottomPlaygroundOriginX, 0 - bottomPlaygroundOriginY), _
scrollableBackgroundImage , _
PSET
'view2
'draw player1
DrawPlayer(myScreenWidth\2 - 40 - bottomPlaygroundOriginX - topPlaygroundOriginX, _
-myPlaygroundHeight\2 - bottomPlaygroundOriginY - topPlaygroundOriginY, _
player1Color)
'draw player2
DrawPlayer(myScreenWidth\2, _
-myPlaygroundHeight\2, _
player2Color)
screenUnlock
'
'-------------------------catch interaction
'player1 / top screen -> user interaction
if multiKey(fb.SC_UP) then
'move towards north screen
if topPlaygroundOriginY>(-myPlaygroundHeight\2 + 12) then
topPlaygroundOriginX += +0
topPlaygroundOriginY += -1
end if
_FreeKeyboardBuffer
end if
if multiKey(fb.SC_DOWN) then
'move towards south screen
if topPlaygroundOriginY<(myScreenHeight\2 - myPlaygroundHeight\2 - 12) then
topPlaygroundOriginX += +0
topPlaygroundOriginY += +1
end if
_FreeKeyboardBuffer
end if
'
if multiKey(fb.SC_LEFT) then
'move towards west screen
'
topPlaygroundOriginX += +1
topPlaygroundOriginY += +0
_FreeKeyboardBuffer
end if
if multiKey(fb.SC_RIGHT) then
'move towards east screen
'
topPlaygroundOriginX += -1
topPlaygroundOriginY += +0
_FreeKeyboardBuffer
end if
'*******************************************
if topPlaygroundOriginX>0 and _
topPlaygroundOriginX<=(myScreenWidth\2) then
if westernFrontierSighted=FALSE then westernFrontierSighted = TRUE
else
if westernFrontierSighted=TRUE then westernFrontierSighted = FALSE
end if
'
if topPlaygroundOriginX>(myScreenWidth/2) then
if westernFrontierPassed=FALSE then westernFrontierPassed = TRUE
else
if westernFrontierPassed=TRUE then westernFrontierPassed = FALSE
end if
'
if topPlaygroundOriginX<(myScreenWidth - myPlaygroundWidth) and _
topPlaygroundOriginX>=(myScreenWidth\2 - myPlaygroundWidth) then
if easternFrontierSighted=FALSE then easternFrontierSighted = TRUE
else
if easternFrontierSighted=TRUE then easternFrontierSighted = FALSE
end if
'
if topPlaygroundOriginX<(myScreenWidth\2 - myPlaygroundWidth) then
if easternFrontierPassed=FALSE then easternFrontierPassed = TRUE
else
if easternFrontierPassed=TRUE then easternFrontierPassed = FALSE
end if
'
'*******************************************
'
'player2 / bottom screen -> set automatically
bottomPlaygroundOriginX += +1
if bottomPlaygroundOriginY>(-myPlaygroundHeight\2 + 12) and _
bottomPlaygroundOriginY<(myScreenHeight\2 - myPlaygroundHeight\2 - 12) then
bottomPlaygroundOriginY += +2*rnd()-1
end if
'
sleep 15
loop until inkey=chr(27)
? "Thanks and good bye!"
sleep
'level8----------------------------------------
'----------------------------------FINALIZATION
'clean-up and exit
imageDestroy(scrollableBackgroundImage)
sleep
end
'level9----------------------------------------
'----------------------FUNCT/SUB IMPLEMENTATION
sub DrawTree(byref Img as fb.IMAGE ptr, _
byval X as integer, _
byval Y as integer, _
byval C as ulong)
circle Img, (X, Y), 10, C, , , , f
circle Img, (X - 10, Y - 10), 10, C, , , , f
circle Img, (X - 10, Y + 10), 10, C, , , , f
circle Img, (X + 10, Y - 10), 10, C, , , , f
circle Img, (X + 10, Y + 10), 10, C, , , , f
end sub 'DrawTree(refIMAGE_PTR,valINT,valINT,valULNG)
sub DrawPlayer(byval X as integer, _
byval Y as integer, _
byval C as ulong)
circle (X, Y), 8, C, , , , f
circle (X, Y), 5, rgb(0,200,255), , , , f
end sub 'DrawPlayer(valINT,valINT,valULNG)
sub DrawText(byval X as integer, _
byval Y as integer, _
byval T as string)
draw string (X, Y), T, rgb(25,255,200)
end sub 'DrawText(valInt,valInt,valSTR)
'level10
'------------------------------------------DATA
'[end of the freebasic code file]Re: Resizing the program window
Very cool simulation! And yes, View is useful. I think, much more useful than Window. Of course, you can clip without View, but FBGFX functions are designed to only clip to either View or the border of the Screen/Image, so it becomes a lot more convenient (and fast) to use View than to have to clip the borders manually. Lastly, I haven't been using it, because what I've been doing, I normally solved inside an image smaller than the program window, then past it somewhere.
I remember that one thing I didn't like about Window in QuickBasic was that it defined coordinates by default in the first quadrant, but when you would Put an image, it would still be oriented as in the fourth. So if I had to make a calculation relative to something that was contained in the image, I was forced to use fourth-quadrant coordinates. But this complaint is really picky. View is good.
I remember that one thing I didn't like about Window in QuickBasic was that it defined coordinates by default in the first quadrant, but when you would Put an image, it would still be oriented as in the fourth. So if I had to make a calculation relative to something that was contained in the image, I was forced to use fourth-quadrant coordinates. But this complaint is really picky. View is good.
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Resizing the program window
And DJ.Peters has gracefully crafted a nice utility that is able to detect when a mouse is over a view area. It's somewhere in the forum or if you need it I can find in some disk of mines.xlucas wrote:View is good.
[edit] Here it is, a pretty tool to use view the most clever way:
Code: Select all
'DJ. Peters utility
#ifndef __MOUSETOOL_BI__
#define __MOUSETOOL_BI__
#define CTX_WINDOW_ACTIVE &H04
#define CTX_WINDOW_SCREEN &H08
#define CTX_VIEWPORT_SET &H10
#define CTX_VIEW_SCREEN &H20
#define MAX_PUTTER 10
type _GFXContext ' offsets 32 / 64 bit
as long id ' 0
as long work_page ' 4
as any ptr p0 ' 8
as long max_h ' 12 16
as long target_bpp ' 16 20
as long target_pitch ' 20 24
as any ptr p1 ' 24 28
as single last_x ' 28 36
as single last_y ' 32 40
union
type
as long view_x ' 36 44
as long view_y ' 40 48
as long view_w ' 44 52
as long view_h ' 48 56
end type
as long view(4-1)
end union
union
type
as long old_view_x ' 52 60
as long old_view_y ' 56 64
as long old_view_w ' 60 68
as long old_view_h ' 64 72
end type
as long old_view(4-1)
end union
as single win_x ' 68 76
as single win_y ' 72 80
as single win_w ' 76 84
as single win_h ' 80 88
as ulong fg_color ' 84 92
as ulong bg_color ' 88 96
as any ptr p2 ' 92 100
as any ptr p3 ' 96 108
as any ptr p4 ' 100 116
as any ptr ptr p5(9) ' 104 124
as long flags ' 144 204
end type
declare function GetContext cdecl alias "fb_hGetContext" as _GFXContext ptr
function getFlag() as ulong
dim as ulong flag
var p=GetContext()
if p then flag=p->flags
return flag
end function
' WINDOW ()-()
function IsWindowActive as boolean
return iif(getFlag() and CTX_WINDOW_ACTIVE,true,false)
end function
' WINDOW SCREEN ()-()
function IsWindowScreenActive as boolean
' is WINDOW active?
if IsWindowActive()=false then return false
' is WINDOW SCREEN active?
return iif(getFlag() and CTX_WINDOW_SCREEN,true,false)
end function
' VIEW
function IsViewActive as boolean
return iif(getFlag() and CTX_VIEWPORT_SET,true,false)
end function
' VIEW SCREEN
function IsViewScreenActive as boolean
' is VIEW active?
if IsViewActive()=false then return false
' is it VIEW SCREEN relative
return iif(getFlag() and CTX_VIEW_SCREEN,true,false)
end function
function getWindowCoords(byref x1 as single, byref y1 as single, byref x2 as single, byref y2 as single) as boolean
if IsWindowActive() then
var p=GetContext()
' get view coords
x1=p->win_x : y1=p->win_y : x2=x1+p->win_w : y2=y1+p->win_h
return true
else
x1=0 : y1=0
dim as integer w,h
screeninfo w,h
x2=w : y2=h
return false
end if
end function
function getViewCoords(byref x1 as integer, byref y1 as integer, byref x2 as integer, byref y2 as integer) as boolean
if IsViewActive() then
var p=GetContext()
' get view coords
x1=p->view_x : y1=p->view_y : x2=x1+p->view_w : y2=y1+p->view_h
return true
else
x1=0:y1=0 : screeninfo x2,y2
return false
end if
end function
Function getWindowMouse(ByRef x As Single, ByRef y As Single, ByRef wheel As Integer = 0, ByRef buttons As Integer = 0, ByRef clip As Integer = 0) As Long
dim as integer mx,my
var result = getMouse(mx,my,wheel,buttons,clip)
' is mouse in window and the WINDOW command active ?
if result=0 andalso IsWindowActive()=true then
dim as integer w,h
dim as single x1,y1,x2,y2
getWindowCoords(x1,y1,x2,y2)
screeninfo(w,h)
x=x1+mx*(x2-x1)/(w-1)
y=y1+my*(y2-y1)/(h-1)
else
x=mx : y=my
end if
return result
end function
Function getViewMouse(ByRef x As Integer, ByRef y As Integer, ByRef wheel As Integer = 0, ByRef buttons As Integer = 0, ByRef clip As Integer = 0) As Long
var result = getMouse(x,y,wheel,buttons,clip)
' is mouse in window and command VIEW active ?
if result=0 andalso IsViewActive()=true then
dim as integer x1,y1,x2,y2
getViewCoords(x1,y1,x2,y2)
if x>=x1 andalso y>=y1 andalso x<=x2 andalso y<=y2 then
x-=x1 : y-=y1
else
' not inside the view
x=-1 : y=-1 : result = 1
end if
end if
return result
end function
#endif-
thesanman112
- Posts: 538
- Joined: Jul 15, 2005 4:13
Re: Resizing the program window
I think anyone who tried to use window and view in qbasic was left with a puzzled face....hahahaha i tried it in fb with the breakout demo....it worked liked you would imagine....very cool indeed!!!