Code archives/Algorithms/THeartSystem
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| Type THeartSystem Method Subtract(phase:Int) Method Add(phase:Int) Method AddHeart() Method RemoveHeart() Method RestoreAll() Method Draw() EndType phase:Int is one of the constants at the top of the code Functions: CreateHeartSystem:THeartSystem(count:Int,x:Float,y:Float,url:Object) url:Object is the image path FreeHeartSystem(system:THeartSystem) Pretty simple to use. Only use a 48x48 heart (240x48 AnimImage). Hearts must have 4 parts.  Let me know of any bugs! | |||||
SuperStrict Const HEARTSYSTEM_ONEPIECE:Int=0 Const HEARTSYSTEM_TWOPIECE:Int=1 Const HEARTSYSTEM_THREEPIECE:Int=2 Const HEARTSYSTEM_FOURPIECE:Int=4 Const HEARTSYSTEM_HALFHEART:Int=HEARTSYSTEM_TWOPIECE Const HEARTSYSTEM_WHOLEHEART:Int=HEARTSYSTEM_FOURPIECE Type THeartSystem Global _list:TList=New TList Field x:Float,y:Float Field img:TImage Field totheartcount:Int Field totpiececount:Int Field curpiececount:Int Field fullhearts:Int Field fullpieces:Int Field allsc:Float=0.5 'inactive hearts' Field cursc:Float=0.5 'active heart' Field incr:Int=True Method New() _list.addlast Self EndMethod Method Create:THeartSystem(count:Int,x:Float,y:Float,url:Object) img=LoadAnimImage(url,48,48,0,5,FILTEREDIMAGE) If Not img Return Null MidHandleImage img Self.x=x Self.y=y totheartcount=count totpiececount=(count*4) curpiececount=totpiececount fullhearts=totheartcount fullpieces=0 Return Self EndMethod Method Subtract(phase:Int) Select phase Case HEARTSYSTEM_ONEPIECE curpiececount:-1 Case HEARTSYSTEM_TWOPIECE curpiececount:-2 Case HEARTSYSTEM_THREEPIECE curpiececount:-3 Case HEARTSYSTEM_FOURPIECE curpiececount:-4 Default curpiececount:-0 EndSelect If curpiececount<0 curpiececount=0 EndIf Local numoffullhearts:Int=0 Local k:Int=0 Local remaining:Int=0 Repeat If k>=curpiececount remaining=k-curpiececount numoffullhearts:-1 Exit Else numoffullhearts:+1 k:+4 EndIf Forever fullhearts=numoffullhearts fullpieces=4-remaining If fullpieces=4 fullhearts:+1 ; fullpieces=0 EndMethod Method Add(phase:Int) Select phase Case HEARTSYSTEM_ONEPIECE curpiececount:+1 Case HEARTSYSTEM_TWOPIECE curpiececount:+2 Case HEARTSYSTEM_THREEPIECE curpiececount:+3 Case HEARTSYSTEM_FOURPIECE curpiececount:+4 Default curpiececount:+0 EndSelect If curpiececount>totpiececount curpiececount=totpiececount EndIf Local numoffullhearts:Int=0 Local k:Int=0 Local remaining:Int=0 Repeat If k>=curpiececount remaining=k-curpiececount numoffullhearts:-1 Exit Else numoffullhearts:+1 k:+4 EndIf Forever fullhearts=numoffullhearts fullpieces=4-remaining If fullpieces=4 fullhearts:+1 ; fullpieces=0 EndMethod Method RestoreAll() curpiececount=totpiececount fullhearts=totheartcount fullpieces=0 EndMethod Method AddHeart() totheartcount:+1 totpiececount:+4 curpiececount:+4 Local numoffullhearts:Int=0 Local k:Int=0 Local remaining:Int=0 Repeat If k>=curpiececount remaining=k-curpiececount numoffullhearts:-1 Exit Else numoffullhearts:+1 k:+4 EndIf Forever fullhearts=numoffullhearts fullpieces=4-remaining If fullpieces=4 fullhearts:+1 ; fullpieces=0 EndMethod Method RemoveHeart() totheartcount:-1 If totheartcount<1 totheartcount=1 totpiececount:-4 If totpiececount<4 totpiececount=4 If curpiececount>=4 curpiececount:-4 If curpiececount<0 curpiececount=0 EndIf Local numoffullhearts:Int=0 Local k:Int=0 Local remaining:Int=0 Repeat If k>=curpiececount remaining=k-curpiececount numoffullhearts:-1 Exit Else numoffullhearts:+1 k:+4 EndIf Forever fullhearts=numoffullhearts fullpieces=4-remaining If fullpieces=4 fullhearts:+1 ; fullpieces=0 EndMethod Method Draw() If incr=True cursc:+0.01 If cursc>0.75 cursc=0.75 incr=False EndIf Else cursc:-0.01 If cursc<0.5 cursc=0.5 incr=True EndIf EndIf SetBlend ALPHABLEND SetScale allsc,allsc SetAlpha 1.0 SetRotation 0 SetColor 255,255,255 If fullhearts=totheartcount Local i:Int For i=0 To fullhearts-2 DrawImage img,(x+(i*(48*allsc))+(i*5))+((48*allsc)/2),(y+((48*allsc)/2)),0 Next SetScale cursc,cursc DrawImage img,(x+(i*(48*allsc))+(i*5))+((48*allsc)/2),(y+((48*allsc)/2)),0 SetScale allsc,allsc Else Local i:Int For i=0 To fullhearts-1 DrawImage img,(x+(i*(48*allsc))+(i*5))+((48*allsc)/2),(y+((48*allsc)/2)),0 Next If fullpieces SetScale cursc,cursc If fullpieces=1 DrawImage img,(x+(fullhearts*(48*allsc))+(fullhearts*5)+((48*allsc)/2)),(y+((48*allsc)/2)),3 ElseIf fullpieces=2 DrawImage img,(x+(fullhearts*(48*allsc))+(fullhearts*5)+((48*allsc)/2)),(y+((48*allsc)/2)),2 ElseIf fullpieces=3 DrawImage img,(x+(fullhearts*(48*allsc))+(fullhearts*5)+((48*allsc)/2)),(y+((48*allsc)/2)),1 EndIf SetScale allsc,allsc Local i:Int For i=fullhearts+1 To totheartcount-1 DrawImage img,(x+(i*(48*allsc))+(i*5))+((48*allsc)/2),(y+((48*allsc)/2)),4 Next Else Local i:Int=fullhearts-1 If i<>-1 SetScale cursc,cursc DrawImage img,(x+(i*(48*allsc))+(i*5)+((48*allsc)/2)),(y+((48*allsc)/2)),0 SetScale allsc,allsc EndIf For i=fullhearts To totheartcount-1 DrawImage img,(x+(i*(48*allsc))+(i*5))+((48*allsc)/2),(y+((48*allsc)/2)),4 Next EndIf EndIf EndMethod Method Free() img=Null _list.remove Self EndMethod EndType Function CreateHeartSystem:THeartSystem(count:Int,x:Float,y:Float,url:Object) Return New THeartSystem.Create(count,x,y,url) EndFunction Function FreeHeartSystem(system:THeartSystem) system.Free() EndFunction Graphics 800,600 Global hsystem:THeartSystem=CreateHeartSystem(3,5,3,"zeldaheart.png") SetClsColor 255,255,255 Repeat If AppTerminate() Exit If KeyHit(KEY_ESCAPE) Exit Cls hsystem.Draw() If KeyHit(KEY_RIGHT)=True hsystem.Add(HEARTSYSTEM_TWOPIECE) If KeyHit(KEY_LEFT)=True hsystem.Subtract(HEARTSYSTEM_TWOPIECE) If KeyHit(KEY_UP)=True hsystem.AddHeart() If KeyHit(KEY_DOWN)=True hsystem.RemoveHeart() Flip() Forever FreeHeartSystem(hsystem) End |
Comments
None.
Code Archives Forum
   |