Animated score effect?

[firace]

Are there any PB examples of a simple odometer-style number animated score effect, similar to this old C64 game?

https://youtu.be/O5u_RpH79qY?t=4m4s


As you can see, I'm still at square one

Code: Select all

Procedure UpdateScore(x)
  SetGadgetText(0,RSet(Str(x),4,"0"))
EndProcedure

OpenWindow(0, 930, 30, 405, 195, "Score",#PB_Window_SystemMenu)

LoadFont(1, "courier new", 34)
SetGadgetFont(-1, FontID(1))

TextGadget(0, 8,  6, 110, 36, "")

AddWindowTimer(0,1,1000)

Repeat 
  
  e = WaitWindowEvent() 
  If e = #PB_Event_Timer
    score + Random(100) 
    updateScore(score)
  EndIf
  
Until e = #PB_Event_CloseWindow  

[ar-s]

Hi,
First, you have to use 2D screen to that kind of effect

In that exemple, i create a 50x100 sprite
In there i draw
SCORE (x0 y0)
SCORE + 1 (x0 y50)

So i have a sprite with 0 and 1

The idea is that each time you press right arrow, i move the sprite to -1 Y
You can show the scroll effect 0 to 1
If Y = -50
I redraw the sprite withe the new score.

It may have easier solution but i have not really the time to help you more.

Code: Select all

Enumeration
  #WIN
  #FontC
EndEnumeration

Enumeration Sprites
  #UNI
EndEnumeration



UsePNGImageDecoder()
Global FontC = LoadFont(#FontC, "courier new", 34)


; INITIALISATION

Global LWIN = 800, HWIN = 600, Pos,Uni
Global SC_UNI

InitSprite() : InitKeyboard() 



Procedure CreateTextSprite()
  
  Uni = CreateSprite(#UNI, 50,100)
  SC_UNI = 0
EndProcedure

Procedure DrawScore()
  StartDrawing(SpriteOutput(#UNI))
  DrawingMode(#PB_2DDrawing_Transparent)
  Box(0,0,50,100,$0)
  DrawingFont(FontC)
  DrawText(0,0,Str(SC_UNI),$FFFFFF,$0)
   DrawText(0,50,Str(SC_UNI+1),$FFFFFF,$0)
  StopDrawing()
EndProcedure

Procedure ShowScore()
  ClipSprite (#UNI,0,pos,50,50)
  DisplayTransparentSprite(#UNI, 0, 0, 255)

EndProcedure

Procedure AnimSprite()
  ; Animation
  ClipSprite (#UNI,0,pos,50,50)
  
  Pos + 1
  If Pos = 50
    SC_UNI+1
If SC_UNI = 10 : Sc_Uni = 0 : Endif
    pos = 0
    DrawScore()
  EndIf
  DisplayTransparentSprite(#UNI, 0, Pos, 255)
  ;///////////////////////////////////////
EndProcedure




Procedure GOWINDOW()
  
  
  OpenWindow(#WIN,0,0,Lwin, Hwin,"Ar-S Agony Intro",#PB_Window_BorderLess|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(#WIN),0,0,Lwin,Hwin,1,0,0)
  
  SetFrameRate(18)
  VIT = 15
  
  CreateTextSprite()
  DrawScore()
     
    Start=ElapsedMilliseconds()
    
    Repeat
      
      Repeat
        WindowEvent()
        Until WindowEvent() = 0
      
      ; // 2D
      ExamineKeyboard() 
      
      
      
      ShowScore()
      
      If KeyboardReleased(#PB_Key_Right)
        AnimSprite()
      ClearScreen(0)
    EndIf

      If KeyboardPushed(#PB_Key_Escape)
        End
      EndIf
      
      
      FlipBuffers()
    ForEver
    End  

  
  
EndProcedure


GOWINDOW()

[Fig]

Something is wrong in that (my) code, there is a small glitch when changing decimals.

Code: Select all

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, 800, 600, "Score Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0,#PB_Screen_NoSynchronization)=0:EndIf

;Press space to add a point to score
; Pb 5.62
#nbDigit=4 ;number of digits to display
#Speed=5   ;speed in milliseconds
Global texthight.i,textlarge.i
LoadFont(0, "terminal", 36)
StartDrawing(ScreenOutput()):DrawingFont(FontID(0)):textlarge=TextWidth("0"):texthight=TextHeight("0"):StopDrawing()
For t=1 To #nbDigit
   CreateSprite(t,textlarge,texthight*11)
   StartDrawing(SpriteOutput(t))
   DrawingFont(FontID(0))
   DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_Transparent)      
   BackColor($FF0000)
   GradientColor(0.2, $00FFFF)
   GradientColor(0.4, $FFFF00)
   GradientColor(0.6, $00FFFF)
   GradientColor(0.8, $FFFF00)
   FrontColor($FF0000)
   LinearGradient(0,0,0,texthight*10)
   For i=0 To 10
      DrawText(0,i*texthight,Str(i%10))
   Next i
   StopDrawing()
   ClipSprite(t,0,0,textlarge,texthight)
Next t

Procedure IncrementScore(digit.i)
   Static Dim scrolly(#nbDigit)
   Static timer
   If digit=#nbDigit And ElapsedMilliseconds()-timer<=#Speed:ProcedureReturn 0:EndIf
   timer=ElapsedMilliseconds()
   If scrolly(digit)>texthight*9
      If scrolly(digit)=texthight*10:scrolly(digit)=0:EndIf
      IncrementScore(digit-1)
   EndIf
   scrolly(digit)+1
   ClipSprite(digit,0,scrolly(digit),textlarge,texthight)
   If scrolly(digit)%(texthight)=texthight-1:ProcedureReturn 1:EndIf
EndProcedure

Score.i=0
addscore.i=0
Repeat
   Repeat:Until WindowEvent()=0
   ExamineKeyboard()
   FlipBuffers()
   ClearScreen(#Black)
   If KeyboardPushed(#PB_Key_Space)
      addscore=score+1
   EndIf
   If score<>addscore Or ok=1
      ok=IncrementScore(#nbDigit)
      If ok:score+1:EndIf
   EndIf
   For i=1 To #nbDigit
      DisplaySprite(i,i*textlarge,10)
   Next i
   StartDrawing(ScreenOutput())
   DrawText(0,100,"[SPACE] To increment Score")
   DrawText(0,120,"[ESCAPE] To quit")
   StopDrawing()
Until KeyboardPushed(#PB_Key_Escape)

[JHPJHP]

Hi firace,

See the following: Windows Services & Other Stuff:
- \Other_Stuff\Odometer\Odometer.pb

[netmaestro]

Code: Select all

Declare RollUp(value)
Declare AddCount(value)

CreateImage(0, 20, 264, 24, RGB(255, 255, 223))
StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_Transparent)
  For i = 0 To 9
    DrawText(4, 2+24*i, Str(i), 0)
  Next
StopDrawing()

Global yy = 0
Global current = GrabImage(0, #PB_Any, 0, yy, 20, 24)

OpenWindow(0,0,0,160,160,"Counter",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ImageGadget(0,60,60,28,28,ImageID(current),#PB_Image_Border)

AddWindowTimer(0, 1, 500)

Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #PB_Event_Timer
      RollUp(1)
  EndSelect
Until ev=#PB_Event_CloseWindow

Procedure RollUp(value)
  CreateThread(@AddCount(), value)
EndProcedure

Procedure AddCount(value)
  For i=1 To 24
    yy+1 
    If yy > 216 
      For i=0 To 23
        If current : FreeImage(current) : EndIf
        current = CreateImage(#PB_Any, 20,24,24,RGB(255,255,233))
        If top:FreeImage(top):EndIf
        topheight = 24-i-1
        top = GrabImage(0, #PB_Any, 0, 216+i, 20, topheight)
        If bottom:FreeImage(bottom):EndIf
        bottom = GrabImage(0, #PB_Any, 0, 0, 20, 24-topheight)
        StartDrawing(ImageOutput(current))
          DrawImage(ImageID(top), 0, 0)
          DrawImage(ImageID(bottom), 0, ImageHeight(top))
        StopDrawing()
        SetGadgetState(0, ImageID(current))
        Delay(10)
      Next
      yy=0
    EndIf
    If current : FreeImage(current) : EndIf
    current = GrabImage(0, #PB_Any, 0, yy, 20, 24)
    SetGadgetState(0, ImageID(current))
    Delay(10)
  Next
EndProcedure

__________________________________________________
Code tags added
26.03.2018
RSBasic

[firace]

Thank you so much everyone - multiple great implementations!

[firace]

Something is wrong in that (my) code, there is a small glitch when changing decimals

@Fig I've tried hard to fix it, but with no success