So just clic somewhere in the rotating chromosome to select a genus!
Code: Select all
'_______------------------------->"gentics.bas"
'_______.......................................
'_______ FREEBASIC GENETICS LAB
'_______ NEW GAME OF LIFE
'_______ V1.0
'_______.......................................
'_______program purpose:
'_______manipulate some ADN
'_______
'_______credits:
'_______the program is indebted to BasicCoder2
'_______for the 3Dsphere viewer.
'_______The quick-'sort routine is a dodicat's
'_______piece of art.
'_______note for further development:
'_______this is all big enough now to deserve a
'_______refactoring before adding anything new.
'------------------DEFINITION------------------
#include once "fbgfx.bi"
#include once "utility.bas"
#include once "dodi_interpolator.bas"
'------------------DEFINITION------------------
dim shared as ulong _maxDots => 178
const as double _pi => 4*atn(1)
const as double _2pi => 2*_pi
const as double _rToD => 180/_pi
const as double _dToR => _pi/180
#define _up <,>
#define _down >,<
#macro _SETQSORT(datatype, fname, b1, b2, dot)
sub fname(array() As datatype, Begin as long, Finish as long)
dim as long i => Begin, _
j => Finish
dim as datatype x => array(((i + j)\2))
while (i<=j)
while array(i)dot b1 x dot : i += 1 : wend
while array(j)dot b2 x dot : j -= 1 : wend
if i<=j then swap array(i), array(j): i += 1 : j -= 1
wend
if j>Begin then fname(array(), Begin, j)
if i<Finish then fname(array(), i, Finish)
end sub
#endmacro
type SORTABLEP3D
as double _x
as double _y
as double _z
as ulong _c
as integer _id
end type : _SETQSORT(SORTABLEP3D, Qsort_z, _down, ._z)
type GENETICUNIT extends DBUTTON
declare constructor()
as SORTABLEP3D ptr _sp3DPtr
as integer _id
end type
constructor GENETICUNIT()
BASE()
end constructor
declare function DrawAppFrameWindow(byval as double) as integer
'-------------------EXECUTION------------------
'..........................................INIT
randomize TIMER
dim as integer scrW, scrH
declare sub ShowActiveAdnNodeBox(byval as integer, _
() as GENETICUNIT, _
byval as integer, _
byval as integer)
scope
screen 0
dim as integer desktopW, desktopH
screenInfo desktopW, desktopH
scrW => desktopW*0.8
scrH => desktopH*0.8
screenRes scrW, scrH, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW
color , rgb(255,0,255)
cls
end scope
'interface______________
dim as DBUTTON playAdnButton
dim as DBUTTON stopAdnButton
scope
dim as integer topLeftCornerPositionX => 100
dim as integer topLeftCornerPositionY => 210
dim as integer btnWidth => 42
dim as integer btnHeight => 08
dim as string buttonText => "PLAY"
dim as DBUTTON._BTNBEHAVIOUR btnBehav => DBUTTON._BTNBEHAVIOUR._useDelay
dim as double btnDelay => 0.8
playAdnButton = _
DBUTTON(topLeftCornerPositionX, _
topLeftCornerPositionY, _
btnWidth, _
btnHeight, _
buttonText, _
btnBehav, _
btnDelay)
end scope
scope
dim as integer topLeftCornerPositionX => 160
dim as integer topLeftCornerPositionY => 210
dim as integer btnWidth => 42
dim as integer btnHeight => 08
dim as string buttonText => " STOP"
dim as DBUTTON._BTNBEHAVIOUR btnBehav => DBUTTON._BTNBEHAVIOUR._useDelay
dim as double btnDelay => 0.8
stopAdnButton = _
DBUTTON(topLeftCornerPositionX, _
topLeftCornerPositionY, _
btnWidth, _
btnHeight, _
buttonText, _
btnBehav, _
btnDelay)
end scope
'_______________________
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<ADN1>>>>>>>>>>(+)
dim as SORTABLEP3D sp3D
sp3D._x => -0.14*scrW
sp3D._y => -.12*scrH
sp3D._z => 900
dim as SORTABLEP3D absolute3DPosition(_maxDots)
dim as SORTABLEP3D relative3DPosition(_maxDots)
dim as GENETICUNIT geneticUnitInstance(_maxDots)
dim as double radius => 100, _
angle1, _
angle2
dim as double angle, _
x, y, z, _
rx, ry, rz, _
px, py, _
cosAngle, sinAngle, aRot
scope
dim as integer index
for angle1 = 160 to 259 step 4
for angle2 = 0 to 159 step 80
absolute3DPosition(index)._x = radius*sin(angle1*_dToR)*cos(angle2*_dToR)
absolute3DPosition(index)._y = radius*sin(angle1*_dToR)*sin(angle2*_dToR)
absolute3DPosition(index)._z = radius*cos(angle1*_dToR)
absolute3DPosition(index)._c = rgb(angle2\2, int(rnd(1)*256), angle1\2)
absolute3DPosition(index)._id = index
'
geneticUnitInstance(index)._sp3DPtr = @absolute3DPosition(index)
geneticUnitInstance(index)._id = index
geneticUnitInstance(index)._text = ""
geneticUnitInstance(index)._isQuiet = TRUE
if index<_maxDots then
index += 1
end if
next angle2
next angle1
end scope
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<ADN1>>>>>>>>>>___
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<ADN2>>>>>>>>>>(+)
type ANGULAR
const as double _degreeToRadianCoefficient => _dToR
enum _ANGLEUNIT
_rad => 0
_deg => 1
end enum
declare constructor()
declare constructor(byval as double)
declare constructor(byval AngleInAngleUnit as double=0, _
byval MinValueInAngleUnit as double, _
byval MaxValueInAngleUnit as double, _
byval AngleUnit as _ANGLEUNIT=1)
declare operator Let(byval as double)
declare operator Cast() as double
declare property MinDegreeValue() as double
declare property MinDegreeValue(byval as double)
declare property MaxDegreeValue() as double
declare property MaxDegreeValue(byval as double)
declare property CurrentDegreeValue() as double
declare function IncrementValueByDegreeUnit(byval as double=+1) as double
as double _angRad
private:
as double _minDegValue
as double _maxDegValue
end type
constructor ANGULAR()
THIS._angRad => 0
THIS._minDegValue => 0
THIS._minDegValue => 359
end constructor
constructor ANGULAR(byval AngleInRad as double)
THIS._angRad => AngleInRad
end constructor
constructor ANGULAR(byval AngleInAngleUnit as double=0, _
byval MinValueInAngleUnit as double, _
byval MaxValueInAngleUnit as double, _
byval AngleUnit as _ANGLEUNIT=1)
select case AngleUnit
case ANGULAR._ANGLEUNIT._rad
THIS._angRad => AngleInAngleUnit
THIS._minDegValue => MinValueInAngleUnit*1/ANGULAR._degreeToRadianCoefficient
THIS._maxDegValue => MinValueInAngleUnit*1/ANGULAR._degreeToRadianCoefficient
case else
THIS._angRad => AngleInAngleUnit*ANGULAR._degreeToRadianCoefficient
THIS._minDegValue => MinValueInAngleUnit
THIS._maxDegValue => MaxValueInAngleUnit
end select
end constructor
operator ANGULAR.Let(byval LetValue as double)
THIS._angRad => LetValue
end operator
operator ANGULAR.Cast() as double
'---->
return THIS._angRad
end operator
property ANGULAR.MinDegreeValue() as double
if THIS._minDegValue>THIS._maxDegValue then
swap THIS._minDegValue, THIS._maxDegValue
end if
'---->
return THIS._minDegValue
end property
property ANGULAR.MinDegreeValue(byval SetValue as double)
THIS._minDegValue = SetValue
end property
property ANGULAR.MaxDegreeValue() as double
if THIS._minDegValue>THIS._maxDegValue then
swap THIS._minDegValue, THIS._maxDegValue
end if
'---->
return THIS._maxDegValue
end property
property ANGULAR.MaxDegreeValue(byval SetValue as double)
THIS._maxDegValue = SetValue
end property
property ANGULAR.CurrentDegreeValue() as double
'---->
return THIS._angRad*ANGULAR._degreeToRadianCoefficient
end property
function ANGULAR.IncrementValueByDegreeUnit(byval IncValue as double=+1) as double
THIS._angRad += IncValue*1/ANGULAR._degreeToRadianCoefficient
'
'---->
return THIS._angRad
end function
type ROTATABLESPHERESET
declare constructor()
declare constructor(byval MaxDot as integer, _
byval Radius as integer, _
byval Angle1 as integer, _
byval Angle2 as integer)
declare property X2D() as integer
declare property Y2D() as integer
declare sub SimpleRotationByAngleInDegree(byval as ANGULAR=90)
'declare sub RotateByAngleInDegree(byval as double=90, byval as double=90)
as uByte _maxDot
as SORTABLEP3D _sp3dSphereCenter
as double _mainSphereRadius
as double _individualItemRadius
as SORTABLEP3D _absolute3DItemPosition(any)
as SORTABLEP3D _relative3DItemPosition(any)
as GENETICUNIT _gItemUnit(any)
as ANGULAR _angle
as ANGULAR _angle1
as ANGULAR _angle2
as double _projection2DX
as double _projection2DY
'
as double _x
as double _y
as double _z
as double _rx
as double _ry
as double _rz
as double _cosAngle
as double _sinAngle
as double _aRot
end type
type RSS as ROTATABLESPHERESET
dim as SORTABLEP3D sp3D_2
sp3D_2._x => scrW - 0.14*scrW
sp3D_2._y => -.12*scrH
sp3D_2._z => 900
dim as SORTABLEP3D absolute3DPosition_2(_maxDots)
dim as SORTABLEP3D relative3DPosition_2(_maxDots)
dim as GENETICUNIT geneticUnitInstance_2(_maxDots)
dim as double radius_2 => 100, _
angle1_2, _
angle2_2
dim as double angle_2, _
x_2, y_2, z_2, _
rx_2, ry_2, rz_2, _
px_2, py_2, _
cosAngle_2, sinAngle_2, aRot_2
scope
dim as integer index
for angle1 = 160 to 259 step 4
for angle2 = 0 to 159 step 80
absolute3DPosition(index)._x = radius*sin(angle1*_dToR)*cos(angle2*_dToR)
absolute3DPosition(index)._y = radius*sin(angle1*_dToR)*sin(angle2*_dToR)
absolute3DPosition(index)._z = radius*cos(angle1*_dToR)
absolute3DPosition(index)._c = rgb(angle2\2, int(rnd(1)*256), angle1\2)
absolute3DPosition(index)._id = index
'
geneticUnitInstance(index)._sp3DPtr = @absolute3DPosition(index)
geneticUnitInstance(index)._id = index
geneticUnitInstance(index)._text = ""
geneticUnitInstance(index)._isQuiet = TRUE
if index<_maxDots then
index += 1
end if
next angle2
next angle1
end scope
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<ADN2>>>>>>>>>>___
'.....................................MAIN_LOOP
dim as integer activeAdnNodeIndex => -1
dim as boolean isAdnNodeClicked => FALSE
dim as boolean isPlayAdnButtonClicked => TRUE
dim as boolean isStopAdnButtonClicked => FALSE
'
dim as double w
do
'interaction flags__________________________________________________________________
if playAdnButton._mouseClick then
if not isPlayAdnButtonClicked then isPlayAdnButtonClicked = TRUE
if isStopAdnButtonClicked then isStopAdnButtonClicked = FALSE
end if
if stopAdnButton._mouseClick then
if not isStopAdnButtonClicked then isStopAdnButtonClicked = TRUE
if isStopAdnButtonClicked then isPlayAdnButtonClicked = FALSE
end if
'___________________________________________________________________________________
'
'rotation rate
if isPlayAdnButtonClicked then aRot = aRot + 1
if aRot >= 360 then aRot = 0
angle = aRot*_dToR
cosAngle = cos(angle)
sinAngle = sin(angle)
'
'3Dpoint rotation
for i as integer = 0 to (_maxDots - 1)
x = absolute3DPosition(i)._x
y = absolute3DPosition(i)._y
z = absolute3DPosition(i)._z
'rotation
relative3DPosition(i)._x = (cosAngle*x) - (sinAngle*z)
relative3DPosition(i)._y = y
relative3DPosition(i)._z = (sinAngle*x) + (cosAngle*z)
relative3DPosition(i)._x = relative3DPosition(i)._x - sp3D._x
relative3DPosition(i)._y = relative3DPosition(i)._y - sp3D._y
relative3DPosition(i)._z = relative3DPosition(i)._z - sp3D._z
relative3DPosition(i)._c = absolute3DPosition(i)._c
relative3DPosition(i)._id = absolute3DPosition(i)._id
'refresh the associated 3D coordinates
geneticUnitInstance(absolute3DPosition(i)._id)._sp3DPtr = @relative3DPosition(i)
geneticUnitInstance(absolute3DPosition(i)._id)._id = relative3DPosition(i)._id
if activeAdnNodeIndex=absolute3DPosition(i)._id then
geneticUnitInstance(absolute3DPosition(i)._id)._text = _
str(activeAdnNodeIndex)
else
geneticUnitInstance(absolute3DPosition(i)._id)._text = ""
end if
geneticUnitInstance(absolute3DPosition(i)._id)._isQuiet = TRUE
next i
'
'sort by distance along z axis
'*********dodisort************
Qsort_z( relative3DPosition(), _
lBound(relative3DPosition), _
uBound(relative3DPosition) )
'
'drawing
screenlock
cls
'draw application window frame______________________________________________________
DrawAppFrameWindow(aRot)
'ADN viewer button
playAdnButton.DrawButton()
stopAdnButton.DrawButton()
'draw application window frame______________________________________________________
'
'3D to 2D ADN viewing
for i as integer = 0 to _maxDots - 1
'this bit is purely to add perspective
w = 1 + (relative3DPosition(i)._z/sp3D._z)
relative3DPosition(i)._x = (relative3DPosition(i)._x - sp3D._x)/w + sp3D._x
relative3DPosition(i)._y = (relative3DPosition(i)._y - sp3D._y)/w + sp3D._y
relative3DPosition(i)._z = (relative3DPosition(i)._z - sp3D._z)/w + sp3D._z
'convert 3d to 2d coordinates
px = (relative3DPosition(i)._x/relative3DPosition(i)._z) * 2000
py = (relative3DPosition(i)._y/relative3DPosition(i)._z) * 2000
circle (px + scrW/2, py + scrH/2), 5, relative3DPosition(i)._c, , , , f
'
'refresh dbutton position
geneticUnitInstance(relative3DPosition(i)._id)._topLeftCornerX = px + scrW/2 - 2
geneticUnitInstance(relative3DPosition(i)._id)._topLeftCornerY = py + scrH/2 - 2
geneticUnitInstance(relative3DPosition(i)._id)._bottomRightCornerX = px + scrW/2 + 4
geneticUnitInstance(relative3DPosition(i)._id)._bottomRightCornerY = py + scrH/2 + 4
'draw button
geneticUnitInstance(relative3DPosition(i)._id).DrawButton()
'
'tracking when adn node clicked
if geneticUnitInstance(relative3DPosition(i)._id)._mouseClick then
if not isAdnNodeClicked then isAdnNodeClicked = TRUE
activeAdnNodeIndex = relative3DPosition(i)._id
end if
next i
ShowActiveAdnNodeBox(activeAdnNodeIndex, geneticUnitInstance(), scrW, scrH)
screenunlock()
'
sleep 20
loop until multikey(&H01)
'.....................................TERMINATE
getKey()
'----------------PROCEDURE_BODY----------------
function DrawAppFrameWindow(byval RotAngle as double) as integer
dim as integer scrW, scrH
screenInfo scrW, scrH
'
line (60, 20)-(scrW - 10, scrH - 10), rgb(0,56,56), bf
line (60, 100)-(scrW - 10, scrH - 10), rgb(0,56,56), bf
line (60, 180)-(scrW - 10, scrH - 10), rgb(0,56,56), bf
line (60, 260)-(scrW - 10, scrH - 10), rgb(0,62,62), bf
line (60, 340)-(scrW - 10, scrH - 10), rgb(0,70,70), bf
line (60, 420)-(scrW - 10, scrH - 10), rgb(0,78,78), bf
for i as integer = 0 to 6
line (60 + i, 20 + i)-(scrW - 10 - i, scrH - 10 - i), rgb(80,00,100), b
line (60 + i, 20 + i)-(scrW - 10 - i, scrH - 10 - i), rgb(80,00,100), b
next i
line (60, 20)-(scrW - 10, scrH - 10), rgb(5,60,180), b
line (60 + scrW\3, 0)-step(scrW\3 - 60, 40), rgb(80,200,100), bf
line (60 + scrW\3, 0)-step(scrW\3 - 60, 43), rgb(5,60,180), b
line (61 + scrW\3, 2)-step(scrW\3 - 62, 40), rgb(80,200,100), bf
'ADN frame background
circle (155, 120), 60, rgb(05,090,080), , , , f
circle (155, 120), 40, rgb(05,120,080), , , , f
line (80, 210)-step(145, 14), rgb(0,180,180), bf
'rotation rate text
draw string (140, 190), "ADN", rgb(100,180,120)
draw string (100, 200), "rotation::"& str(RotAngle), rgb(100,180,120)
'
'---->
return 0
end function
sub ShowActiveAdnNodeBox(byval ActiveIndex as integer, _
GI() as GENETICUNIT, _
byval SW as integer, _
byval SH as integer)
static as integer _activeIndex => -1
static as integer _processGraphicsStep => -1
'
if _activeIndex<>ActiveIndex then
/'new value'/
_activeIndex = ActiveIndex
_processGraphicsStep = 0
end if
if _processGraphicsStep=-1 then exit sub
'- - - - - - - - - - - - - - - - - - - - - - - - -
dim as integer x = GI(_activeIndex)._topLeftCornerX
dim as integer y = GI(_activeIndex)._topLeftCornerY
select case _processGraphicsStep
case is<100
line(x + 2,y + 2)-step(16,16), rgb(055,105,055 + _processGraphicsStep), b
line(x,y)-step(20 - 80\(_processGraphicsStep + 2),20 - 80\(_processGraphicsStep + 2)), _
rgb(055,205,155 + _processGraphicsStep), _
b
circle (x + 10, y + 10), 20, _
rgb(55,100 + _processGraphicsStep,180), _
_processGraphicsStep, _
_processGraphicsStep + 1
draw string (x + 2, y + 8), _
str(ActiveIndex), _
rgb(55,100, 120 + _processGraphicsStep)
case is>=100 , is<150
circle (x + 10, y + 10), _
1980\_processGraphicsStep, _
rgb(55, 200 ,80 + _processGraphicsStep), _
_processGraphicsStep, _
_processGraphicsStep + 2
draw string (x + 3, y + 8), _
str(ActiveIndex), _
rgb(55, _processGraphicsStep,180)
end select
'
if _processGraphicsStep>-1 then _processGraphicsStep += 1
if _processGraphicsStep>150 then _processGraphicsStep = -1
end sub
'(eof)(edit) I'm looking for the dependancies! sorry it's coming!
Code: Select all
'------------------------->"utility.bas"
'.......................................
'content:
'1- DBUTTON :: button with delay
#include once "fbgfx.bi"
'---------------------------------------------1
type DBUTTON
public:
enum _BTNBEHAVIOUR
_useDelay = -1
_standard = 0
end enum '_BTNBEHAVIOUR
declare constructor()
declare constructor(byval as integer, _
byval as integer, _
byval as string)
declare constructor(byval as integer, _
byval as integer, _
byval as integer, _
byval as integer, _
byval as string, _
byval as _BTNBEHAVIOUR=_BTNBEHAVIOUR._useDelay, _
byval as double=0.5)
declare property Behaviour() as _BTNBEHAVIOUR
declare property Behaviour(byval as _BTNBEHAVIOUR)
declare property ClickTimeInterval() as double
declare property ClickTimeInterval(byval as double)
declare property LastClickTime() as double
declare sub TestButton()
declare sub DrawButton()
as integer _topLeftCornerX
as integer _topLeftCornerY
as integer _bottomRightCornerX
as integer _bottomRightCornerY
as string _text
as boolean _mouseOver
as boolean _mouseClick
as boolean _mouseLegalIntervalClick
as boolean _isQuiet
private:
as _BTNBEHAVIOUR _behaviour
as double _lastClickedTime
as double _minClickTimeInterval
end type 'DBUTTON
constructor DBUTTON()
dim as integer scrW, scrH
if screenPtr()=0 then
scrW = 200
scrH = 200
else
screenInfo scrW, scrH
end if
'
with THIS
._text => "DBUTTON"
._topLeftCornerX => (scrW - 8*len(._text))\2
._topLeftCornerY => (scrH - 20)\2
._bottomRightCornerX=> (scrW - 8*len(._text))\2 + 56
._bottomRightCornerY=> (scrH + 10)\2
._mouseOver => FALSE
._mouseClick => FALSE
._lastClickedTime => 0
._behaviour => DBUTTON._BTNBEHAVIOUR._standard
._minClickTimeInterval => 0.5
._mouseLegalIntervalClick => FALSE
end with 'THIS
end constructor 'DBUTTON explicit default constructor
constructor DBUTTON(byval TLCX as integer, _
byval TLCY as integer, _
byval Text as string)
with THIS
._text => Text
._topLeftCornerX => TLCX
._topLeftCornerY => TLCY
._bottomRightCornerX=> ._topLeftCornerX + 8*len(._text)
._bottomRightCornerY=> ._topLeftCornerY + 15
._mouseOver => FALSE
._mouseClick => FALSE
._lastClickedTime => 0
._behaviour => DBUTTON._BTNBEHAVIOUR._standard
._minClickTimeInterval => 0.5
._mouseLegalIntervalClick => FALSE
end with 'THIS
end constructor 'DBUTTON(valINT,valINT,valSTR)
constructor DBUTTON(byval TLCX as integer, _
byval TLCY as integer, _
byval BtnWidth as integer, _
byval BtnHeight as integer, _
byval Text as string, _,
byval BtnBehaviour as DBUTTON._BTNBEHAVIOUR=-1, _
byval CTI as double=0.5)
if BtnHeight<15 then BtnHeight = 15
with THIS
._topLeftCornerX => TLCX
._topLeftCornerY => TLCY
._bottomRightCornerX=> ._topLeftCornerX + BtnWidth
._bottomRightCornerY=> ._topLeftCornerY + BtnHeight
._text => left(Text, BtnWidth\8)
._mouseOver => FALSE
._mouseClick => FALSE
._lastClickedTime => 0
._behaviour => DBUTTON._BTNBEHAVIOUR._standard
._minClickTimeInterval => CTI
._mouseLegalIntervalClick => FALSE
end with 'THIS
end constructor 'DBUTTON(valINT,valINT,valINT,valINT,valSTR)
property DBUTTON.Behaviour() as DBUTTON._BTNBEHAVIOUR
'---->
return THIS._behaviour
end property 'get BUTTON_BTNBEHAVIOUR:=DBUTTON.Behaviour
property DBUTTON.Behaviour(byval SetValue as DBUTTON._BTNBEHAVIOUR)
THIS._behaviour = SetValue
end property 'set DBUTTON.Behaviour(valBUTTON_BTNBEHAVIOUR)
property DBUTTON.ClickTimeInterval() as double
'---->
return THIS._minClickTimeInterval
end property 'get DBL:=DBUTTON.ClickTimeInterval
property DBUTTON.ClickTimeInterval(byval SetValue as double)
THIS._minClickTimeInterval = SetValue
end property 'set DBUTTON.ClickTimeInterval(valDBL)
property DBUTTON.LastClickTime() as double
'---->
return THIS._lastClickedTime
end property 'get DBL:=DBUTTONLastClickTime
sub DBUTTON.TestButton()
dim as integer gmX, gmY, gmBtn1
getMouse gmX, gmY, , gmBtn1
'
with THIS
if gmX>._topLeftCornerX and _
gmY>._topLeftCornerY and _
gmX<._bottomRightCornerX and _
gmY<._bottomRightCornerY then
if ._mouseOver=FALSE then ._mouseOver = TRUE
if gmBtn1=+1 then
if ._mouseClick=FALSE then ._mouseClick = TRUE
if (TIMER - ._lastClickedTime)>._minClickTimeInterval then
THIS._lastClickedTime = TIMER
if ._mouseLegalIntervalClick=FALSE then _
._mouseLegalIntervalClick = TRUE
else
if ._mouseLegalIntervalClick=TRUE then _
._mouseLegalIntervalClick = FALSE
end if
else
if ._mouseClick=TRUE then ._mouseClick = FALSE
if ._mouseLegalIntervalClick=TRUE then _
._mouseLegalIntervalClick = FALSE
end if
else
if ._mouseOver=TRUE then ._mouseOver = FALSE
if ._mouseClick=TRUE then ._mouseClick = FALSE
if ._mouseLegalIntervalClick=TRUE then _
._mouseLegalIntervalClick = FALSE
end if
end with 'THIS
end sub 'DBUTTON.TestButton()
sub DBUTTON.DrawButton()
dim as ulong btnColor
with THIS
.TestButton()
if ._mouseClick=TRUE then
if ._behaviour=-1 then
btnColor = rgb(255,180,140)
else
btnColor = rgb(255,190,140)
end if
elseif ._mouseOver=TRUE then
if (TIMER - ._lastClickedTime)<._minClickTimeInterval and _
._behaviour=-1 then
btnColor = rgb(180,140,120)
else
btnColor = rgb(200,150,120)
end if
else
if (TIMER - ._lastClickedTime)<._minClickTimeInterval and _
._behaviour=-1 then
if not ._isQuiet then
btnColor = rgb(100,180,240)
end if
else
if not ._isQuiet then
btnColor = rgb(180,180,220)
end if
end if
end if
'
if not ._isQuiet then
line (._topLeftCornerX, ._topLeftCornerY)-_
(._bottomRightCornerX, ._bottomRightCornerY), _
btnColor, _
bf
else
if btnColor=0 then
line (._topLeftCornerX + 3, ._topLeftCornerY + 3)-_
(._bottomRightCornerX - 1, ._bottomRightCornerY - 1), _
0, _
bf
else
line (._topLeftCornerX, ._topLeftCornerY)-_
(._bottomRightCornerX, ._bottomRightCornerY), _
btnColor, _
bf
end if
end if
draw string (._topLeftCornerX + 1, ._topLeftCornerY - 1 + _
(._bottomRightCornerY - _topLeftCornerY)\2), _
left(._text, (._bottomRightCornerX - ._topLeftCornerX)), _
0
end with 'THIS
end sub 'DBUTTON.DrawButton()
'---------------------------------------------.
'(eof)Code: Select all
'--------------->"dodi_interpolator.bas"
'.......................................
nameSpace dodi
declare sub GaussJordan(() as double, () as double, () as double)
declare sub Interpolate(() as double, () as double, () as double)
declare function PolyEval(() as double, byval as double) as double
'-----------------------------------------------------------------
'-----------------------------------------------------------------
sub GaussJordan(Matrix() as double, Rhs() as double, Ans() as double)
'solve linear equations
dim as long n => uBound(Matrix, 1)
redim Ans(1 to n)
dim as double b(1 to n, 1 to n), r(1 to n)
'
for c as long = 1 to n ''take copies
r(c) = Rhs(c)
for d as long = 1 to n
b(c,d) = Matrix(c,d)
next d
next c
#macro _PIVOT(num)
for p1 as long = num to n - 1
for p2 as long = p1 + 1 to n
if abs(b(p1,num))<abs(b(p2,num)) then
swap r(p1), r(p2)
for g as long = 1 to n
swap b(p1,g), b(p2,g)
next g
end if
next p2
next p1
#endmacro
for k as long = 1 to n-1
_PIVOT(k) ''full pivoting
for row as long = k to n-1
if b(row+1,k) = 0 then exit for
var f = b(k, k)/b(row + 1, k)
r(row + 1) = r(row + 1)*f - r(k)
for g as long = 1 to n
b((row + 1), g) = b((row + 1), g)*f - b(k, g)
next g
next row
next k
'back substitute
for z as long = n to 1 step - 1
Ans(z) = r(z)/b(z, z)
for j as long = n to z + 1 step - 1
Ans(z) = Ans(z) - (b(z, j)*Ans(j)/b(z, z))
next j
next z
end sub
sub Interpolate(Xvalues() as double, Yvalues() as double, P() as double)
'interpolate through points
var n = uBound(Xvalues)
redim P(1 to n)
dim as double matrix(1 to n, 1 to n), rhs(1 to n)
for a as long = 1 to n
rhs(a) = Yvalues(a)
for b as long = 1 to n
matrix(a,b) = Xvalues(a)^(b - 1)
next b
next a
'solve the linear equations
GaussJordan(matrix(), rhs(), P())
end sub
function PolyEval(Coefficients() as double, byval X as double) as double
'evaluate a polynomial at X
dim as double acc
for i as long = uBound(Coefficients) to lBound(Coefficients) step -1
acc = acc*X + Coefficients(i)
next i
'
return acc
end function
end nameSpace
'(eof)