Chromosome viewer - a brick for a genetic lab game

Game development specific discussions.
Tourist Trap
Posts: 2357
Joined: Jun 02, 2015 16:24

Chromosome viewer - a brick for a genetic lab game

Postby Tourist Trap » Jan 08, 2018 21:27

I'm posting this demo stuff, that I projected to use in a bigger game that I had in mind. But truly if someone gets more inspired and involved than myself here it is. I really can think of tons of funny games from this starting bloc.
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)


Thanks ;)

(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)

Ok I need dodi's doodle now... Digging up for it!

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)


Outch! It should work now... That's not so easy when you have a modular program and that you forgot where are the spare parts :)
Tourist Trap
Posts: 2357
Joined: Jun 02, 2015 16:24

Re: Chromosome viewer - a brick for a genetic lab game

Postby Tourist Trap » Jan 11, 2018 20:55

Some update. I finally figured out how it was supposed to work. That's old stuff. The history of this started with the conversion of a code from BasicCoder2 that rotates a sphere. I wanted to make it a UDT. Then playing with it it became a chromosome. And finally I found that I should make a game of it where one would tweak the chromosomes to make a beetle that he would send to fight on the battle ground (of Mars!). The concept sounded funny. Of course it went not very far, just this piece of quite complicated code...

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


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

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   => scrW\2 - 30
   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   => scrW\2 + 30
   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
'_______________________

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<1>>>>>>>>>>(+)
dim as SORTABLEP3D    sp3D
   sp3D._x => -0.14*scrW
   sp3D._y => -.12*scrH
   sp3D._z => 1200
dim as SORTABLEP3D   absolute3DPosition(_maxDots)
dim as SORTABLEP3D   relative3DPosition(_maxDots)
dim as GENETICUNIT   geneticUnitInstance(_maxDots)
dim as double      radius   => 150, _
               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
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<1>>>>>>>>>>___
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<2>>>>>>>>>>(+)
dim as SORTABLEP3D    sp3D_2
   sp3D_2._x => .14*scrW
   sp3D_2._y => -.12*scrH
   sp3D_2._z => 1200

dim as SORTABLEP3D   absolute3DPosition_2(_maxDots)
dim as SORTABLEP3D   relative3DPosition_2(_maxDots)
dim as GENETICUNIT   geneticUnitInstance_2(_maxDots)
dim as double      radius_2   => 150, _
               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_2 = 160 to 259 step 4
       for angle2_2 = 0 to 159 step 80
           absolute3DPosition_2(index)._x = radius_2*sin(angle1_2*_dToR)*cos(angle2_2*_dToR)
           absolute3DPosition_2(index)._y = radius_2*sin(angle1_2*_dToR)*sin(angle2_2*_dToR)
           absolute3DPosition_2(index)._z = radius_2*cos(angle1_2*_dToR)
           absolute3DPosition_2(index)._c = rgb(angle2_2\2, int(rnd(1)*256), angle1_2\2)
           absolute3DPosition_2(index)._id = index
           '
          geneticUnitInstance_2(index)._sp3DPtr      = @absolute3DPosition_2(index)
          geneticUnitInstance_2(index)._id         = index
           geneticUnitInstance_2(index)._text         = ""
           geneticUnitInstance_2(index)._isQuiet      = TRUE
           if index<_maxDots then
               index += 1
           end if
       next angle2_2
   next angle1_2
end scope
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<2>>>>>>>>>>___


'.....................................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            ''for perspective
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
       aRot_2 = aRot_2 - 1
    end if
    if aRot >= 360 then aRot = 0
    if aRot_2 <= 0 then aRot_2 = 360
    angle      = aRot*_dToR
    angle_2      = aRot_2*_dToR
    cosAngle   = cos(angle)   :   sinAngle   = sin(angle)
    cosAngle_2   = cos(angle_2)   :   sinAngle_2   = sin(angle_2)
   '
   '3Dpoint rotation
   '3Dpoint rotation <1>
    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
    ''3Dpoint rotation <2>
    for i as integer = 0 to (_maxDots - 1)
        x_2 = absolute3DPosition_2(i)._x
        y_2 = absolute3DPosition_2(i)._y
        z_2 = absolute3DPosition_2(i)._z
        'rotation
        relative3DPosition_2(i)._x = y_2
        relative3DPosition_2(i)._y = (cosAngle_2*x_2) - (sinAngle_2*z_2)
        relative3DPosition_2(i)._z = (sinAngle_2*x_2) + (cosAngle_2*z_2)
        relative3DPosition_2(i)._x = relative3DPosition_2(i)._x - sp3D_2._x
        relative3DPosition_2(i)._y = relative3DPosition_2(i)._y - sp3D_2._y
        relative3DPosition_2(i)._z = relative3DPosition_2(i)._z - sp3D_2._z
        relative3DPosition_2(i)._c = absolute3DPosition_2(i)._c
        relative3DPosition_2(i)._id = absolute3DPosition_2(i)._id
      'refresh the associated 3D coordinates
        geneticUnitInstance_2(absolute3DPosition_2(i)._id)._sp3DPtr      = @relative3DPosition_2(i)
        geneticUnitInstance_2(absolute3DPosition_2(i)._id)._id         = relative3DPosition_2(i)._id
        if activeAdnNodeIndex=absolute3DPosition_2(i)._id then
           geneticUnitInstance_2(absolute3DPosition_2(i)._id)._text   = _
                                      str(activeAdnNodeIndex)
        else
           geneticUnitInstance_2(absolute3DPosition_2(i)._id)._text   = ""
        end if
        geneticUnitInstance_2(absolute3DPosition_2(i)._id)._isQuiet      = TRUE
    next i   
   '
    'sort by distance along z axis
    '*********dodisort************
    Qsort_z( relative3DPosition(), _
           lBound(relative3DPosition), _
           uBound(relative3DPosition) )
    Qsort_z( relative3DPosition_2(), _
           lBound(relative3DPosition_2), _
           uBound(relative3DPosition_2) )
   '
    '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
        '<1>
        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)
        '<2>
        for i as integer = 0 to _maxDots - 1
            'this bit is purely to add perspective
            w = 1 + (relative3DPosition_2(i)._z/sp3D_2._z)
            relative3DPosition_2(i)._x = (relative3DPosition_2(i)._x - sp3D_2._x)/w + sp3D_2._x
            relative3DPosition_2(i)._y = (relative3DPosition_2(i)._y - sp3D_2._y)/w + sp3D_2._y
            relative3DPosition_2(i)._z = (relative3DPosition_2(i)._z - sp3D_2._z)/w + sp3D_2._z
            'convert 3d to 2d coordinates
            px_2 = (relative3DPosition_2(i)._x/relative3DPosition_2(i)._z) * 2000
            py_2 = (relative3DPosition_2(i)._y/relative3DPosition_2(i)._z) * 2000
            circle (px_2 + scrW/2, py_2 + scrH/2), 5, relative3DPosition_2(i)._c, , , , f
            '
            'refresh dbutton position
            geneticUnitInstance_2(relative3DPosition_2(i)._id)._topLeftCornerX   = px_2 + scrW/2 - 2
            geneticUnitInstance_2(relative3DPosition_2(i)._id)._topLeftCornerY   = py_2 + scrH/2 - 2
           geneticUnitInstance_2(relative3DPosition_2(i)._id)._bottomRightCornerX   = px_2 + scrW/2 + 4
           geneticUnitInstance_2(relative3DPosition_2(i)._id)._bottomRightCornerY   = py_2 + scrH/2 + 4
            'draw button
            geneticUnitInstance_2(relative3DPosition_2(i)._id).DrawButton()
            '
            'tracking when adn node clicked
            if geneticUnitInstance_2(relative3DPosition_2(i)._id)._mouseClick then
               if not isAdnNodeClicked then isAdnNodeClicked = TRUE
               activeAdnNodeIndex   = relative3DPosition_2(i)._id
            end if
        next i
        ShowActiveAdnNodeBox(activeAdnNodeIndex, geneticUnitInstance_2(), 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,156,156), bf
    line (60, 100)-(scrW - 10, scrH - 10), rgb(0,156,156), bf
    line (60, 180)-(scrW - 10, scrH - 10), rgb(0,156,156), bf
    line (60, 260)-(scrW - 10, scrH - 10), rgb(0,162,162), bf
    line (60, 340)-(scrW - 10, scrH - 10), rgb(0,170,170), bf
    line (60, 420)-(scrW - 10, scrH - 10), rgb(0,178,178), 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(180,200,100), bf
    'ADN frame background
    circle (scrW\2 + 20, scrH\2 - 60), 60, rgb(05,090,080), , , , f
    circle (scrW\2 + 20, scrH\2 - 60), 40, rgb(05,120,080), , , , f
    line (scrW\2 - 50, 210)-step(145, 14), rgb(0,180,180), bf
    'rotation rate text
    draw string (scrW\2 - 20, 190), "ADN", rgb(100,180,120)
    draw string (scrW\2 - 40, 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)

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 1 guest