To dodicat:
Very true!
... then you have to update the problem ...
... also there are wheels with nucleus of exagonal (honeycomb of bees), that do not prick.
An arithmetic problem
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: An arithmetic problem
It comforts me in the approach I choosed, of tracking each wheel one by one with surveying their state along the road. Work in progress, but here is for a possible wheel system:lrcvs wrote:.. then you have to update the problem ...
Code: Select all
'.................................
'arithmetic of car wheels exchange
'.................................
'(new wheel system implemented)
#include once "fbgfx.bi"
#define _MIN(a, b) iif((a)<(b), (a), (b))
#define _MAX(a, b) iif((a)>(b), (a), (b))
type FBIMAGEPTR as fb.IMAGE ptr
type CAR_FWD as CAR ptr
type WHEEL
declare constructor()
declare constructor(byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
declare operator cast() as string
declare property StateString(byref as const string)
declare property StateString() as const string
declare property TotalTimeInUse() as single
declare property OwnerCar() as CAR_FWD
declare property TimeLinePicture() as FBIMAGEPTR
declare property WheelPicture() as FBIMAGEPTR
declare sub SetWaitingStateTo(byval State as boolean)
declare sub SetInUseStateTo(byval State as boolean)
declare sub SetRetiredStateTo(byval State as boolean)
declare function BreakLinkWithCurrentOwnerCar() as boolean
declare sub MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
declare sub MakePictureOfWheel()
as string _name
as string _positionName
as CAR_FWD _ownerCar
as single _startingTimeOfUsageArray(any)
as single _timeInUseArray(any)
as single _totalTimeInUse
as single _initialTime
as single _initialUseTime
as string _stateString
as boolean _isWaitingForBeingUsed
as boolean _isCurrentlyInUse
as boolean _isCurrentlyRetired
as FBIMAGEPTR _timeLinePicture
as FBIMAGEPTR _wheelPicture
end type
constructor WHEEL()
with THIS
._name => "undefined"
._positionName => "undefined"
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => 0.
._initialUseTime => 0.
._stateString => "100"
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
constructor WHEEL( byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
with THIS
._name => WheelName
._positionName => WheelPositionName
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => InitialTime
._initialUseTime => InitialUseTime
._stateString => InitialStateString
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
operator WHEEL.cast() as string
dim as string carResolution => "not_mounted"
#if typeOf(THIS._ownerCar)=typeOf(CAR_FWD)
carResolution = str(THIS._ownerCar)
#endIf
return "<"& _
":"& THIS._name & _
":"& THIS._positionName & _
":"& THIS._totalTimeInUse & _
":"& THIS.StateString & _
":"& carResolution &">"
end operator
property WHEEL.StateString(byref SetValue as const string)
dim as string workString => SetValue
'invalid state fix
if not ( val("&b"& workString)=1 orElse _
val("&b"& workString)=2 orElse _
val("&b"& workString)=4 _
) then
if val(mid(workString, 2, 1))=1 then
workString = "010"
elseIf val(mid(workString, 3, 1))=1 then
workString = "001"
elseIf val(mid(workString, 1, 1))=0 then
workString = "100"
end if
end if
'incomplete state fix
while len(workString)<3
if len(workString)=0 then
workString += "1"
elseIf len(workString)=2 andAlso val(workString)=0 then
workString += "1"
else
workString += "0"
end if
wend
'
if val("&b"& workString)=4 then
THIS._isWaitingForBeingUsed = TRUE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = FALSE
elseIf val("&b"& workString)=2 then
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = TRUE
THIS._isCurrentlyRetired = FALSE
else
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = TRUE
end if
'
THIS._stateString => workString
end property
property WHEEL.StateString() as const string
return str(iif(THIS._isWaitingForBeingUsed, "1", "0")) & _
str(iif(THIS._isCurrentlyInUse, "1", "0")) & _
str(iif(THIS._isCurrentlyRetired, "1", "0"))
end property
property WHEEL.TotalTimeInUse() as single
dim as single totalTime => 0
for arrayIndex as integer = lBound(THIS._timeInUseArray) to _
uBound(THIS._timeInUseArray)
totalTime += THIS._timeInUseArray(arrayIndex)
next arrayIndex
'
return totalTime
end property
property WHEEL.OwnerCar() as CAR_FWD
#if typeOf(THIS._ownerCar)<>typeOf(CAR_FWD)
return -1
#else
return THIS._ownerCar
#endIf
end property
property WHEEL.TimeLinePicture() as FBIMAGEPTR
THIS.MakePictureOfTimeLineReportedToInterval()
'
return THIS._timeLinePicture
end property
property WHEEL.WheelPicture() as FBIMAGEPTR
THIS.MakePictureOfWheel()
'
return THIS._wheelPicture
end property
sub WHEEL.SetWaitingStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetInUseStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetRetiredStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = State
end sub
sub WHEEL.MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
imageDestroy(THIS._timeLinePicture)
THIS._timeLinePicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picW => scrW/4
dim as integer picH => scrH/10
THIS._timeLinePicture = imageCreate(picW, picH, rgb(105,105,125), 32)
'
line THIS._timeLinePicture, _
(2, picH\2 - 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 - 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2 + 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 + 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2), _
rgb(_MIN(255, 255*(THIS.TotalTimeInUse)/1000),200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
end sub
sub WHEEL.MakePictureOfWheel()
imageDestroy(THIS._wheelPicture)
THIS._wheelPicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picL => _MIN(scrW, scrH)\10
THIS._wheelPicture = imageCreate(picL, picL, rgb(255,0,255), 32)
'
for radius as integer = picL\4 to picL\2
circle THIS._wheelPicture, _
(picL\2, picL\2), _
radius, _
rgb(_MIN(255, 255*(THIS.TotalTimeInUse)/1000),200/(1 + THIS.TotalTimeInUse),_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
next radius
circle THIS._wheelPicture, (picL\2, picL\2), picL\2, rgb(100,100,200)
circle THIS._wheelPicture, (picL\2, picL\2), picL\4, rgb(100,100,200)
end sub
'-------------------------------------------------MAIN
randomize TIMER
'we set some well defined application screen
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
dim as WHEEL w => WHEEL("test_wheel", "test_garage", "100", , 0.)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dim as single driveTime
do
'
screenSet 1, 0
cls
line (10, 10)-(scrW - 10 - 1, scrH - 10 - 1), rgb(100,100,205), b
paint(1,1), rgb(100,100,255), rgb(100,100,205)
'
draw string (12,12), w
draw string (8*len(str(w)) + 22, 12), str(w.TotalTimeInUse) & _
space(12) & _
str(w._timeInUseArray(uBound(w._timeInUseArray)))
put (12,20), w.WheelPicture, TRANS
dim as integer wheelPictureWidth
imageInfo w._wheelPicture, wheelPictureWidth
put (12 + wheelPictureWidth + 12,20), w.TimeLinePicture, TRANS
screenCopy 1, 0
'
driveTime += .005
w._timeInUseArray(uBound(w._timeInUseArray)) += driveTime
'
sleep 15
loop until chr(27)=inkey()
'-------------------------------------------------END.
getKey()
'(eof)
Re: An arithmetic problem
Is Ircvs son a genius or a monk?
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: An arithmetic problem
A monk would walk rather than drive a car, so it must be a genius.bplus wrote:Is Ircvs son a genius or a monk?
Re: An arithmetic problem
lol -good point
A: Tourist Trap
Q: What do you call a guy who makes unnecessary complications necessary?
A: Tourist Trap
Q: What do you call a guy who makes unnecessary complications necessary?
Re: An arithmetic problem
The opposite of a genius? (just to stay politically correct)bplus wrote:Q: What do you call a guy who makes unnecessary complications <snip>
Re: An arithmetic problem
Yes, we want to stay politically correct ;-))
But I had another idea besides the opposite of genius, there are those that can make the unnecessary complications, necessary.
I will now boldly, flat out risk all political in-correctness and call them artists!
But I had another idea besides the opposite of genius, there are those that can make the unnecessary complications, necessary.
I will now boldly, flat out risk all political in-correctness and call them artists!
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: An arithmetic problem
Ouch, now it starts looking as a car.... Ok, there is some more effort required. Then also it would be great to change the wheels by clicking with the mouse. I'll see all that later!
To give a word of explanation, the wheels show their lifetime while the car is driving. The light blue wheel is the spare wheel because it's not in use. The other wheels are getting red with the time being used by the car and will need to be changed after a while, at least I think it should be so.
Of course any wheel not in use would not become red anymore, but the car will drive if it has its wheels mounted.
Code: Select all
'.................................
'arithmetic of car wheels exchange
'.................................
'(new wheel system implemented)
'(new car system implemented)
#include once "fbgfx.bi"
#define _MIN(a, b) iif((a)<(b), (a), (b))
#define _MAX(a, b) iif((a)>(b), (a), (b))
type FBIMAGEPTR as fb.IMAGE ptr
type CAR_FWD as CAR ptr
type WHEEL
declare constructor()
declare constructor(byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
declare operator cast() as string
declare property StateString(byref as const string)
declare property StateString() as const string
declare property TotalTimeInUse() as single
declare property OwnerCar() as CAR_FWD
declare property TimeLinePicture() as FBIMAGEPTR
declare property WheelPicture() as FBIMAGEPTR
declare sub SetWaitingStateTo(byval State as boolean)
declare sub SetInUseStateTo(byval State as boolean)
declare sub SetRetiredStateTo(byval State as boolean)
declare sub RegisterWheelLifeTime(byval LifeTime as single=0.)
declare function BreakLinkWithCurrentOwnerCar() as boolean
declare sub MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
declare sub MakePictureOfWheel()
as string _name
as string _positionName
as CAR_FWD _ownerCar
as single _startingTimeOfUsageArray(any)
as single _timeInUseArray(any)
as single _totalTimeInUse
as single _initialTime
as single _initialUseTime
as string _stateString
as boolean _isWaitingForBeingUsed
as boolean _isCurrentlyInUse
as boolean _isCurrentlyRetired
as FBIMAGEPTR _timeLinePicture
as FBIMAGEPTR _wheelPicture
end type
constructor WHEEL()
with THIS
._name => "undefined"
._positionName => "undefined"
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => 0.
._initialUseTime => 0.
._stateString => "100"
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
constructor WHEEL( byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
with THIS
._name => WheelName
._positionName => WheelPositionName
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => InitialTime
._initialUseTime => InitialUseTime
._stateString => InitialStateString
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
operator WHEEL.cast() as string
dim as string carResolution => "not_mounted"
#if typeOf(THIS._ownerCar)=typeOf(CAR_FWD)
carResolution = str(THIS._ownerCar)
#endIf
return "<"& _
":"& THIS._name & _
":"& THIS._positionName & _
":"& THIS._totalTimeInUse & _
":"& THIS.StateString & _
":"& carResolution &">"
end operator
property WHEEL.StateString(byref SetValue as const string)
dim as string workString => SetValue
'invalid state fix
if not ( val("&b"& workString)=1 orElse _
val("&b"& workString)=2 orElse _
val("&b"& workString)=4 _
) then
if val(mid(workString, 2, 1))=1 then
workString = "010"
elseIf val(mid(workString, 3, 1))=1 then
workString = "001"
elseIf val(mid(workString, 1, 1))=0 then
workString = "100"
end if
end if
'incomplete state fix
while len(workString)<3
if len(workString)=0 then
workString += "1"
elseIf len(workString)=2 andAlso val(workString)=0 then
workString += "1"
else
workString += "0"
end if
wend
'
if val("&b"& workString)=4 then
THIS._isWaitingForBeingUsed = TRUE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = FALSE
elseIf val("&b"& workString)=2 then
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = TRUE
THIS._isCurrentlyRetired = FALSE
else
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = TRUE
end if
'
THIS._stateString => workString
end property
property WHEEL.StateString() as const string
return str(iif(THIS._isWaitingForBeingUsed, "1", "0")) & _
str(iif(THIS._isCurrentlyInUse, "1", "0")) & _
str(iif(THIS._isCurrentlyRetired, "1", "0"))
end property
property WHEEL.TotalTimeInUse() as single
dim as single totalTime => 0
for arrayIndex as integer = lBound(THIS._timeInUseArray) to _
uBound(THIS._timeInUseArray)
totalTime += THIS._timeInUseArray(arrayIndex)
next arrayIndex
'
return totalTime
end property
property WHEEL.OwnerCar() as CAR_FWD
':note:
'I leave this around here because it doesn't hurt but:
'this approach below is not good, the type of THIS._ownerCar is well know and won't change
'the problem was to let the program say if, or not,
'typeOf(INT(THIS._ownerCar)) is still in touch with a pointer to a CAR, or typeOf(i) with i an integer
#if typeOf(THIS._ownerCar)<>typeOf(CAR_FWD)
return -1
#else
return THIS._ownerCar
#endIf
end property
property WHEEL.TimeLinePicture() as FBIMAGEPTR
THIS.MakePictureOfTimeLineReportedToInterval()
'
return THIS._timeLinePicture
end property
property WHEEL.WheelPicture() as FBIMAGEPTR
THIS.MakePictureOfWheel()
'
return THIS._wheelPicture
end property
sub WHEEL.SetWaitingStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetInUseStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetRetiredStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = State
end sub
sub WHEEL.RegisterWheelLifeTime(byval LifeTime as single=0.)
if THIS._ownerCar=0 then
exit sub
end if
'
'the wheel has some owner, if it's a wheel in use then add some <lifetime> to it
if THIS.StateString="010" then
THIS._timeInUseArray(uBound(THIS._timeInUseArray)) += LifeTime
end if
end sub
sub WHEEL.MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
imageDestroy(THIS._timeLinePicture)
THIS._timeLinePicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picW => scrW/4
dim as integer picH => scrH/10
THIS._timeLinePicture = imageCreate(picW, picH, rgb(105,105,125), 32)
'
line THIS._timeLinePicture, _
(2, picH\2 - 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 - 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2 + 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 + 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2), _
rgb(_MIN(255, 255*(THIS.TotalTimeInUse)/1000),200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
end sub
sub WHEEL.MakePictureOfWheel()
imageDestroy(THIS._wheelPicture)
THIS._wheelPicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picL => _MIN(scrW, scrH)\10
THIS._wheelPicture = imageCreate(picL, picL, rgb(255,0,255), 32)
'
for radius as integer = picL\4 to picL\2
circle THIS._wheelPicture, _
(picL\2, picL\2), _
radius, _
rgb( _MIN(255, _
255*(THIS.TotalTimeInUse)/1000),200/(1 + THIS.TotalTimeInUse), _
_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000) )
next radius
circle THIS._wheelPicture, (picL\2, picL\2), picL\2, rgb(100,100,200)
circle THIS._wheelPicture, (picL\2, picL\2), picL\4, rgb(100,100,200)
end sub
type CAR
declare constructor()
declare property CarPicture() as FBIMAGEPTR
declare sub AddWheelToCarHistoryByPointer(byval WheelPtr as WHEEL ptr, byval WheelPosition as integer)
declare sub ChangeWheelRandomlyWithOnlyOneChangeAllowed(byval WheelPtr as WHEEL ptr)
declare sub RegisterCarLifeTime(byval LifeTime as single=0.)
declare sub StartCar()
declare sub StopCar()
declare sub MakeCarPicture()
as string _carName
as single _fullDrivingTime
as boolean _isCarStopped
as WHEEL ptr _wheelsArrayOfPtr(any)
as boolean _hasPosition1WheelBeenExhanged(any)
as boolean _hasPosition2WheelBeenExhanged(any)
as boolean _hasPosition3WheelBeenExhanged(any)
as boolean _hasPosition4WheelBeenExhanged(any)
as boolean _hasSpareWheelBeenExhanged(any)
as FBIMAGEPTR _carPicture
end type
function WHEEL.BreakLinkWithCurrentOwnerCar() as boolean
if THIS._ownerCar=0 then
return FALSE
end if
#if typeOf(THIS._ownerCar)<>typeOf(CAR_FWD)
return FALSE
#endIf
THIS._ownerCar = 0
THIS._ownerCar->StopCar()
'
return TRUE
end function
constructor CAR()
with THIS
._carName => "undefined"
._fullDrivingTime => 0.
._isCarStopped => TRUE
._carPicture => 0
end with
redim THIS._wheelsArrayOfPtr(4)
end constructor
property CAR.CarPicture() as FBIMAGEPTR
THIS.MakeCarPicture()
'
return THIS._carPicture
end property
sub CAR.AddWheelToCarHistoryByPointer(byval WheelPtr as WHEEL ptr, byval WheelPosition as integer)
if WheelPtr>0 andAlso ( WheelPosition=0 orElse _
WheelPosition=1 orElse _
WheelPosition=2 orElse _
WheelPosition=3 orElse _
WheelPosition=4 ) then
THIS._wheelsArrayOfPtr(WheelPosition) = WheelPtr
WheelPtr->_positionName = "c"& str(WheelPosition)
if WheelPosition<>0 then
if WheelPtr->StateString="100" then
WheelPtr->_ownerCar = @THIS
WheelPtr->SetInUseStateTo(TRUE)
end if
else
WheelPtr->_ownerCar = @THIS
WheelPtr->SetWaitingStateTo(TRUE)
end if
end if
end sub
sub CAR.ChangeWheelRandomlyWithOnlyOneChangeAllowed(byval WheelPtr as WHEEL ptr)
if not WheelPtr->_isWaitingForBeingUsed then
exit sub
end if
'
dim as integer exchangePosition
exchangePosition = 1 + int(rnd()*4)
'
dim as integer arrayIndex => -1
for arrayIndex = lBound(THIS._wheelsArrayOfPtr) to uBound(THIS._wheelsArrayOfPtr)
if (THIS._wheelsArrayOfPtr(arrayIndex)->_positionName="c"& exchangePosition) then
exit for
end if
next arrayIndex
'
if arrayIndex>uBound(THIS._wheelsArrayOfPtr) then
exit sub
end if
'
THIS._wheelsArrayOfPtr(arrayIndex)->_positionName = "undefined"
THIS._wheelsArrayOfPtr(arrayIndex)->StateString = "001"
'
WheelPtr->_positionName = "c"& exchangePosition
WheelPtr->StateString = "010"
'
redim WheelPtr->_startingTimeOfUsageArray(uBound(WheelPtr->_startingTimeOfUsageArray) + 1)
redim WheelPtr->_timeInUseArray(uBound(WheelPtr->_timeInUseArray) + 1)
WheelPtr->_startingTimeOfUsageArray(uBound(WheelPtr->_startingTimeOfUsageArray)) = THIS._fullDrivingTime
WheelPtr->_timeInUseArray(uBound(WheelPtr->_timeInUseArray)) = 0.
'
THIS.AddWheelToCarHistoryByPointer(WheelPtr, exchangePosition)
end sub
sub CAR.RegisterCarLifeTime(byval LifeTime as single=0.)
if not THIS._isCarStopped then
THIS._fullDrivingTime += LifeTime
end if
'
for arrayIndex as integer = lBound(THIS._wheelsArrayOfPtr) to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)<>0 then
THIS._wheelsArrayOfPtr(arrayIndex)->RegisterWheelLifeTime(LifeTime)
end if
next arrayIndex
end sub
sub CAR.StartCar()
for arrayIndex as integer = 1 to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)=0 then
'we won't drive with a missing wheel
exit sub
end if
next arrayIndex
'
THIS._isCarStopped = FALSE
end sub
sub CAR.StopCar()
THIS._isCarStopped = TRUE
end sub
sub CAR.MakeCarPicture()
imageDestroy(THIS._carPicture)
THIS._carPicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picL => _MIN(scrW, scrH)\2
THIS._carPicture = imageCreate(picL, picL, rgb(100,100,155), 32)
'
'draw main carriage
'draw wheels
for arrayIndex as integer = lBound(THIS._wheelsArrayOfPtr) to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)=0 then
continue for
end if
draw string (22,22 + 10*arrayIndex), *THIS._wheelsArrayOfPtr(arrayIndex)
select case arrayIndex
case 1
put THIS._carPicture, _
(10,20), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 2
put THIS._carPicture, (62,20), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 3
put THIS._carPicture, (10,62), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 4
put THIS._carPicture, (62,62), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case else
put THIS._carPicture, (32,132), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
end select
next arrayIndex
end sub
'-------------------------------------------------MAIN
randomize TIMER
'we set some well defined application screen
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
dim as WHEEL w => WHEEL("test_wheel", "test_garage", "100", , 0.)
dim as WHEEL w0 => WHEEL("wheel0", "undefined", "100", , 0.)
dim as WHEEL w1 => WHEEL("wheel1", "undefined", "100", , 0.)
dim as WHEEL w2 => WHEEL("wheel2", "undefined", "100", , 0.)
dim as WHEEL w3 => WHEEL("wheel3", "undefined", "100", , 0.)
dim as WHEEL w4 => WHEEL("wheel4", "undefined", "100", , 0.)
dim as CAR lrcvsCar
with lrcvsCar
.AddWheelToCarHistoryByPointer(@w0, 0)
.AddWheelToCarHistoryByPointer(@w1, 1)
.AddWheelToCarHistoryByPointer(@w2, 2)
.AddWheelToCarHistoryByPointer(@w3, 3)
.AddWheelToCarHistoryByPointer(@w4, 4)
end with
lrcvsCar.StartCar()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dim as single fullDriveTime
dim as single driveTimeStep => .5
do
'
screenSet 1, 0
cls
line (10, 10)-(scrW - 10 - 1, scrH - 10 - 1), rgb(100,100,205), b
paint(1,1), rgb(100,100,255), rgb(100,100,205)
'
draw string (12, 12), str(lrcvsCar._carName) & _
space(12) & _
str(lrcvsCar._fullDrivingTime) & _
space(8) & _
str(fullDriveTime)
put (scrW\4, scrH\4), lrcvsCar.CarPicture, TRANS
screenCopy 1, 0
'
fullDriveTime += driveTimeStep
lrcvsCar.RegisterCarLifeTime(driveTimeStep)
'
sleep 15
loop until chr(27)=inkey()
'-------------------------------------------------END.
getKey()
'(eof)Of course any wheel not in use would not become red anymore, but the car will drive if it has its wheels mounted.
Re: An arithmetic problem
Hi, all:
Tourist Trap: Thank you!
Regards
Tourist Trap: Thank you!
Regards
Last edited by lrcvs on May 23, 2017 18:38, edited 1 time in total.
-
thesanman112
- Posts: 538
- Joined: Jul 15, 2005 4:13
Re: An arithmetic problem
or....
(total_distance*4)/total_number_of_tires
couldn't resist....
(total_distance*4)/total_number_of_tires
couldn't resist....
-
Tourist Trap
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: An arithmetic problem
Just better showcase.
Code: Select all
'.................................
'arithmetic of car wheels exchange
'.................................
#include once "fbgfx.bi"
#define _MIN(a, b) iif((a)<(b), (a), (b))
#define _MAX(a, b) iif((a)>(b), (a), (b))
type FBIMAGEPTR as fb.IMAGE ptr
type CAR_FWD as CAR ptr
type WHEEL
declare constructor()
declare constructor(byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
declare operator cast() as string
declare property StateString(byref as const string)
declare property StateString() as const string
declare property TotalTimeInUse() as single
declare property OwnerCar() as CAR_FWD
declare property TimeLinePicture() as FBIMAGEPTR
declare property WheelPicture() as FBIMAGEPTR
declare sub SetWaitingStateTo(byval State as boolean)
declare sub SetInUseStateTo(byval State as boolean)
declare sub SetRetiredStateTo(byval State as boolean)
declare sub RegisterWheelLifeTime(byval LifeTime as single=0.)
declare function BreakLinkWithCurrentOwnerCar() as boolean
declare sub MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
declare sub MakePictureOfWheel()
as string _name
as string _positionName
as CAR_FWD _ownerCar
as single _startingTimeOfUsageArray(any)
as single _timeInUseArray(any)
as single _totalTimeInUse
as single _initialTime
as single _initialUseTime
as string _stateString
as boolean _isWaitingForBeingUsed
as boolean _isCurrentlyInUse
as boolean _isCurrentlyRetired
as FBIMAGEPTR _timeLinePicture
as FBIMAGEPTR _wheelPicture
end type
constructor WHEEL()
with THIS
._name => "undefined"
._positionName => "undefined"
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => 0.
._initialUseTime => 0.
._stateString => "100"
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
constructor WHEEL( byref WheelName as const string, _
byref WheelPositionName as const string, _
byref InitialStateString as const string, _
byval InitialTime as single=0., _
byval InitialUseTime as single=0. )
with THIS
._name => WheelName
._positionName => WheelPositionName
._ownerCar => 0
._totalTimeInUse => 0.
._initialTime => InitialTime
._initialUseTime => InitialUseTime
._stateString => InitialStateString
._timeLinePicture => 0
._wheelPicture => 0
end with
redim THIS._startingTimeOfUsageArray(0)
redim THIS._timeInUseArray(0)
THIS._startingTimeOfUsageArray(0) => THIS._initialTime
THIS._timeInUseArray(0) => THIS._initialUseTime
'
THIS.StateString => THIS._stateString
end constructor
property WHEEL.StateString(byref SetValue as const string)
dim as string workString => SetValue
'invalid state fix
if not ( val("&b"& workString)=1 orElse _
val("&b"& workString)=2 orElse _
val("&b"& workString)=4 _
) then
if val(mid(workString, 2, 1))=1 then
workString = "010"
elseIf val(mid(workString, 3, 1))=1 then
workString = "001"
elseIf val(mid(workString, 1, 1))=0 then
workString = "100"
end if
end if
'incomplete state fix
while len(workString)<3
if len(workString)=0 then
workString += "1"
elseIf len(workString)=2 andAlso val(workString)=0 then
workString += "1"
else
workString += "0"
end if
wend
'
if val("&b"& workString)=4 then
THIS._isWaitingForBeingUsed = TRUE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = FALSE
elseIf val("&b"& workString)=2 then
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = TRUE
THIS._isCurrentlyRetired = FALSE
else
THIS._isWaitingForBeingUsed = FALSE
THIS._isCurrentlyInUse = FALSE
THIS._isCurrentlyRetired = TRUE
end if
'
THIS._stateString => workString
end property
property WHEEL.StateString() as const string
return str(iif(THIS._isWaitingForBeingUsed, "1", "0")) & _
str(iif(THIS._isCurrentlyInUse, "1", "0")) & _
str(iif(THIS._isCurrentlyRetired, "1", "0"))
end property
property WHEEL.TotalTimeInUse() as single
dim as single totalTime => 0
for arrayIndex as integer = lBound(THIS._timeInUseArray) to _
uBound(THIS._timeInUseArray)
totalTime += THIS._timeInUseArray(arrayIndex)
next arrayIndex
'
return totalTime
end property
property WHEEL.OwnerCar() as CAR_FWD
':note:
'I leave this around here because it doesn't hurt but:
'this approach below is not good, the type of THIS._ownerCar is well know and won't change
'the problem was to let the program say if, or not,
'typeOf(INT(THIS._ownerCar)) is still in touch with a pointer to a CAR, or typeOf(i) with i an integer
#if typeOf(THIS._ownerCar)<>typeOf(CAR_FWD)
return -1
#else
return THIS._ownerCar
#endIf
end property
property WHEEL.TimeLinePicture() as FBIMAGEPTR
THIS.MakePictureOfTimeLineReportedToInterval()
'
return THIS._timeLinePicture
end property
property WHEEL.WheelPicture() as FBIMAGEPTR
THIS.MakePictureOfWheel()
'
return THIS._wheelPicture
end property
sub WHEEL.SetWaitingStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetInUseStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = State
THIS._isCurrentlyRetired = not State
end sub
sub WHEEL.SetRetiredStateTo(byval State as boolean)
THIS._isWaitingForBeingUsed = not State
THIS._isCurrentlyInUse = not State
THIS._isCurrentlyRetired = State
end sub
sub WHEEL.RegisterWheelLifeTime(byval LifeTime as single=0.)
if THIS._ownerCar=0 then
exit sub
end if
'
'the wheel has some owner, if it's a wheel in use then add some <lifetime> to it
if THIS.StateString="010" then
THIS._timeInUseArray(uBound(THIS._timeInUseArray)) += LifeTime
end if
end sub
sub WHEEL.MakePictureOfTimeLineReportedToInterval( byval IntervalStartingTime as single=0, _
byval IntervalEndingTime as single=1000 )
imageDestroy(THIS._timeLinePicture)
THIS._timeLinePicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picW => scrW/4
dim as integer picH => scrH/10
THIS._timeLinePicture = imageCreate(picW, picH, rgb(105,105,125), 32)
'
line THIS._timeLinePicture, _
(2, picH\2 - 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 - 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2 + 1)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2 + 1), _
rgb(0,200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
line THIS._timeLinePicture, _
(2, picH\2)-_
(THIS._timeInUseArray(uBound(THIS._timeInUseArray))/( IntervalEndingTime - _
IntervalStartingTime )*picW - _
2 - _
1, picH\2), _
rgb(_MIN(255, 255*(THIS.TotalTimeInUse)/1000),200,_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000))
end sub
sub WHEEL.MakePictureOfWheel()
imageDestroy(THIS._wheelPicture)
THIS._wheelPicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picL => _MIN(scrW, scrH)\10
THIS._wheelPicture = imageCreate(picL, picL, rgb(255,0,255), 32)
'
for radius as integer = picL\4 to picL\2
circle THIS._wheelPicture, _
(picL\2, picL\2), _
radius, _
rgb( _MIN(255, _
255*(THIS.TotalTimeInUse)/1000),200/(1 + THIS.TotalTimeInUse), _
_MAX(0, 255*(1000 - THIS.TotalTimeInUse)/1000) )
next radius
circle THIS._wheelPicture, (picL\2, picL\2), picL\2, rgb(100,100,200)
circle THIS._wheelPicture, (picL\2, picL\2), picL\4, rgb(100,100,200)
end sub
type CAR
declare constructor()
declare property CarPicture() as FBIMAGEPTR
declare sub AddWheelToCarHistoryByPointer(byval WheelPtr as WHEEL ptr, byval WheelPosition as integer)
declare sub ChangeWheelRandomlyWithOnlyOneChangeAllowed(byval WheelPtr as WHEEL ptr)
declare sub RegisterCarLifeTime(byval LifeTime as single=0.)
declare sub StartCar()
declare sub StopCar()
declare sub MakeCarPicture()
as string _carName
as single _fullDrivingTime
as boolean _isCarStopped
as WHEEL ptr _wheelsArrayOfPtr(any)
as boolean _hasPosition1WheelBeenExhanged(any)
as boolean _hasPosition2WheelBeenExhanged(any)
as boolean _hasPosition3WheelBeenExhanged(any)
as boolean _hasPosition4WheelBeenExhanged(any)
as boolean _hasSpareWheelBeenExhanged(any)
as FBIMAGEPTR _carPicture
end type
operator WHEEL.cast() as string
dim as string carResolution => "not_mounted"
#if typeOf(THIS._ownerCar)=typeOf(CAR_FWD)
carResolution = str(THIS._ownerCar->_carName)
#endIf
return "<"& _
":"& THIS._name & _
":"& THIS._positionName & _
":"& THIS._totalTimeInUse & _
":"& THIS.StateString & _
":"& carResolution &">"
end operator
function WHEEL.BreakLinkWithCurrentOwnerCar() as boolean
if THIS._ownerCar=0 then
return FALSE
end if
#if typeOf(THIS._ownerCar)<>typeOf(CAR_FWD)
return FALSE
#endIf
THIS._ownerCar = 0
THIS._ownerCar->StopCar()
'
return TRUE
end function
constructor CAR()
with THIS
._carName => "undefined"
._fullDrivingTime => 0.
._isCarStopped => TRUE
._carPicture => 0
end with
redim THIS._wheelsArrayOfPtr(4)
end constructor
property CAR.CarPicture() as FBIMAGEPTR
THIS.MakeCarPicture()
'
return THIS._carPicture
end property
sub CAR.AddWheelToCarHistoryByPointer(byval WheelPtr as WHEEL ptr, byval WheelPosition as integer)
if WheelPtr>0 andAlso ( WheelPosition=0 orElse _
WheelPosition=1 orElse _
WheelPosition=2 orElse _
WheelPosition=3 orElse _
WheelPosition=4 ) then
THIS._wheelsArrayOfPtr(WheelPosition) = WheelPtr
WheelPtr->_positionName = "c"& str(WheelPosition)
if WheelPosition<>0 then
if WheelPtr->StateString="100" then
WheelPtr->_ownerCar = @THIS
WheelPtr->SetInUseStateTo(TRUE)
end if
else
WheelPtr->_ownerCar = @THIS
WheelPtr->SetWaitingStateTo(TRUE)
end if
end if
end sub
sub CAR.ChangeWheelRandomlyWithOnlyOneChangeAllowed(byval WheelPtr as WHEEL ptr)
if not WheelPtr->_isWaitingForBeingUsed then
exit sub
end if
'
dim as integer exchangePosition
exchangePosition = 1 + int(rnd()*4)
'
dim as integer arrayIndex => -1
for arrayIndex = lBound(THIS._wheelsArrayOfPtr) to uBound(THIS._wheelsArrayOfPtr)
if (THIS._wheelsArrayOfPtr(arrayIndex)->_positionName="c"& exchangePosition) then
exit for
end if
next arrayIndex
'
if arrayIndex>uBound(THIS._wheelsArrayOfPtr) then
exit sub
end if
'
THIS._wheelsArrayOfPtr(arrayIndex)->_positionName = "undefined"
THIS._wheelsArrayOfPtr(arrayIndex)->StateString = "001"
'
WheelPtr->_positionName = "c"& exchangePosition
WheelPtr->StateString = "010"
'
redim WheelPtr->_startingTimeOfUsageArray(uBound(WheelPtr->_startingTimeOfUsageArray) + 1)
redim WheelPtr->_timeInUseArray(uBound(WheelPtr->_timeInUseArray) + 1)
WheelPtr->_startingTimeOfUsageArray(uBound(WheelPtr->_startingTimeOfUsageArray)) = THIS._fullDrivingTime
WheelPtr->_timeInUseArray(uBound(WheelPtr->_timeInUseArray)) = 0.
'
THIS.AddWheelToCarHistoryByPointer(WheelPtr, exchangePosition)
end sub
sub CAR.RegisterCarLifeTime(byval LifeTime as single=0.)
if not THIS._isCarStopped then
THIS._fullDrivingTime += LifeTime
end if
'
for arrayIndex as integer = lBound(THIS._wheelsArrayOfPtr) to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)<>0 then
THIS._wheelsArrayOfPtr(arrayIndex)->RegisterWheelLifeTime(LifeTime)
end if
next arrayIndex
end sub
sub CAR.StartCar()
for arrayIndex as integer = 1 to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)=0 then
'we won't drive with a missing wheel
exit sub
end if
next arrayIndex
'
THIS._isCarStopped = FALSE
end sub
sub CAR.StopCar()
THIS._isCarStopped = TRUE
end sub
sub CAR.MakeCarPicture()
imageDestroy(THIS._carPicture)
THIS._carPicture = 0
'
'compute some convenient picture box dimension
dim as integer scrW, scrH
screenInfo scrW, scrH
dim as integer picL => _MIN(scrW, scrH)\2
THIS._carPicture = imageCreate(picL, picL, rgb(100,100,155), 32)
'
'draw main carriage
circle THIS._carPicture, (0,0), picL\4, rgb(255,0,255), , , , f
circle THIS._carPicture, (0,picL), picL\4, rgb(255,0,255), , , , f
circle THIS._carPicture, (picL,0), picL\4, rgb(255,0,255), , , , f
circle THIS._carPicture, (picL,picL), picL\4, rgb(255,0,255), , , , f
'draw wheels
for arrayIndex as integer = lBound(THIS._wheelsArrayOfPtr) to _
uBound(THIS._wheelsArrayOfPtr)
if THIS._wheelsArrayOfPtr(arrayIndex)=0 then
continue for
end if
dim as integer imgW
imageInfo THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, imgW
draw string THIS._carPicture, (8,62 + 10*arrayIndex), *THIS._wheelsArrayOfPtr(arrayIndex)
select case arrayIndex
case 1
put THIS._carPicture, (10,20), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 2
put THIS._carPicture, (picL - imgW - 10,20), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 3
put THIS._carPicture, (10,picL - imgW - 10), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case 4
put THIS._carPicture, (picL - imgW - 10,picL - imgW - 10), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
case else
put THIS._carPicture, (picL\2 - imgW\2, 42 + picL\2 - imgW\2), _
THIS._wheelsArrayOfPtr(arrayIndex)->WheelPicture, _
TRANS
end select
next arrayIndex
end sub
'-------------------------------------------------MAIN
randomize TIMER
'we set some well defined application screen
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
dim as WHEEL w => WHEEL("test_wheel", "test_garage", "100", , 0.)
dim as WHEEL w0 => WHEEL("wheel0", "undefined", "100", , 0.)
dim as WHEEL w1 => WHEEL("wheel1", "undefined", "100", , 0.)
dim as WHEEL w2 => WHEEL("wheel2", "undefined", "100", , 0.)
dim as WHEEL w3 => WHEEL("wheel3", "undefined", "100", , 0.)
dim as WHEEL w4 => WHEEL("wheel4", "undefined", "100", , 0.)
dim as CAR lrcvsCar
with lrcvsCar
.AddWheelToCarHistoryByPointer(@w0, 0)
.AddWheelToCarHistoryByPointer(@w1, 1)
.AddWheelToCarHistoryByPointer(@w2, 2)
.AddWheelToCarHistoryByPointer(@w3, 3)
.AddWheelToCarHistoryByPointer(@w4, 4)
end with
lrcvsCar.StartCar()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dim as single fullDriveTime
dim as single driveTimeStep => .5
do
'
screenSet 1, 0
cls
line (10, 10)-(scrW - 10 - 1, scrH - 10 - 1), rgb(100,100,205), b
paint(1,1), rgb(100,100,255), rgb(100,100,205)
'
draw string (12, 12), str(lrcvsCar._carName) & _
space(12) & _
str(lrcvsCar._fullDrivingTime) & _
"units"
'draw car with embedded wheels
put (scrW\4, scrH\4), lrcvsCar.CarPicture, TRANS
'draw wheels characteristics
dim as integer carImgW
imageInfo lrcvsCar.CarPicture, carImgW
for arrayIndex as integer = lBound(lrcvsCar._wheelsArrayOfPtr) to _
uBound(lrcvsCar._wheelsArrayOfPtr)
dim as integer wheelImgH
imageInfo lrcvsCar._wheelsArrayOfPtr(arrayIndex)->TimeLinePicture, , wheelImgH
put (scrW\4 + carImgW + 4,scrH\4 + arrayIndex*wheelImgH + 4), _
lrcvsCar._wheelsArrayOfPtr(arrayIndex)->TimeLinePicture, _
TRANS
next arrayIndex
screenCopy 1, 0
'
fullDriveTime += driveTimeStep
lrcvsCar.RegisterCarLifeTime(driveTimeStep)
'
sleep 15
loop until chr(27)=inkey()
'-------------------------------------------------END.
getKey()
'(eof)