DisplayTextSprite() (Schneller als 2ddrawing)

[benpicco]

Da das anzeigen von Text im Fullscreenmode über 2ddrawing doch nicht gerade die schnellste Möglichkeit ist, habe ich mal das hier gebastelt, vileicht kann man´s ja gebrauchen:

Code: Alles auswählen

InitSprite()
InitKeyboard()
Global AnfangX.w,AnfangY.w,MaxMessages.b
AnfangX=100
AnfangY=600
MaxMessages=5
Structure Messages
  ID.w
  Text.s
  Deathtime.w
  x.w
  y.w
  YSize.b
EndStructure
Structure Sprites
  ID.w
  sprite.l
  YSize.b
  ASCII.b
EndStructure
NewList FontSprites.Sprites()
NewList InfoText.Messages()

Procedure LoadSpriteFont(ID.w,Name$,YSize.w,Style.w,color.l)
  Protected FontID.l, red.w,green.w,blue.w,x.w,sprite.l
  FontID=LoadFont(#PB_Any,Name$,YSize,Style)
  red=Red(color)
  green=Green(color)
  blue=Blue(color)
  For x=1 To 255
    StartDrawing(ScreenOutput())
    DrawingFont(UseFont(FontID))
    sprite=CreateSprite(#PB_Any,TextLength(Chr(x)),YSize*2)
    StopDrawing()
    ;If sprite<>0
    StartDrawing(SpriteOutput(sprite))
    DrawingMode(1)
    FrontColor(red,green,blue)
    DrawingFont(UseFont(FontID))
    Locate(0,0)
    DrawText(Chr(x))
    StopDrawing()
    ;Debug Str(x)+ "("+Chr(x)+")"
    ;EndIf
    AddElement(FontSprites())
    FontSprites()\ID=ID
    FontSprites()\sprite=sprite
    FontSprites()\YSize=YSize
    FontSprites()\ASCII=x-128
  Next
EndProcedure
Procedure DisplaySpriteFont(ID,x,y,text$)
  Protected a.w,ASCII.w
  For a=1 To Len(text$)
    ASCII=Asc(Mid(text$,a,1))
    ForEach FontSprites()
      If FontSprites()\ID=ID And FontSprites()\ASCII=ASCII-128
        Break
      EndIf
    Next
    DisplayTransparentSprite(FontSprites()\sprite,x,y)
    x+SpriteWidth(FontSprites()\sprite)
  Next
EndProcedure
Procedure DisplayTranslucideSpriteFont(ID,x,y,text$,Intensity)
  Protected a.w
  For a=1 To Len(text$)
    ASCII=Asc(Mid(text$,a,1))
    ForEach FontSprites()
      If FontSprites()\ID=ID And FontSprites()\ASCII=ASCII-128
        Break
      EndIf
    Next
    DisplayTranslucideSprite(FontSprites()\sprite,x,y,Intensity)
    x+SpriteWidth(FontSprites()\sprite)
  Next
EndProcedure
Procedure AddInfoText(TextSpriteID.w,text$,Deathtime)
  Protected count.l,ListCount.w
  ListCount=CountList(InfoText())
  ForEach InfoText()
    If count<ListCount
      SelectElement(InfoText(),count+1)
      YSize=InfoText()\YSize
      SelectElement(InfoText(),count)
      InfoText()\y-YSize*2
    EndIf
    If ListCount=>MaxMessages
      InfoText()\Deathtime=InfoText()\Deathtime/(ListCount-count)
    EndIf
    count+1
  Next
  ForEach FontSprites()
    If FontSprites()\ID=TextSpriteID 
      Break
    EndIf
  Next
  AddElement(InfoText())
  InfoText()\Text=text$
  InfoText()\Deathtime=Deathtime
  InfoText()\x=AnfangX
  InfoText()\y=AnfangY
  InfoText()\ID=TextSpriteID
  InfoText()\YSize=FontSprites()\YSize
EndProcedure
OpenScreen(1024,768,32,"test")
LoadSpriteFont(0,"Comic Sans MS",9,0,RGB(0,255,0)) 
LoadSpriteFont(1,"Times New Roman",12,#PB_Font_Bold,RGB(255,0,0)) 

Repeat
  FlipBuffers(0)
  ExamineKeyboard()
  ;StartSpecialFX()  
  ClearScreen(0,0,0) 
  If Lasttime<>Date()
    Lasttime=Date()
    If Second(Lasttime)<>0
      AddInfoText(0,"Es ist "+Str(Hour(Lasttime))+" Uhr, "+Str(Minute(Lasttime))+" und "+Str(Second(Lasttime))+" Sekunden",1000)
    Else
      AddInfoText(1,"Es ist "+Str(Hour(Lasttime))+" Uhr, "+Str(Minute(Lasttime))+" und "+Str(Second(Lasttime))+" Sekunden",1000)
    EndIf
  EndIf
  
  ForEach InfoText()
    InfoText()\Deathtime-1
    If InfoText()\Deathtime>255
      DisplaySpriteFont(InfoText()\ID,InfoText()\x,InfoText()\y,InfoText()\Text)
    Else
      InfoText()\Deathtime-5
      DisplayTranslucideSpriteFont(InfoText()\ID,InfoText()\x,InfoText()\y,InfoText()\Text,InfoText()\Deathtime)
      If InfoText()\Deathtime <=0
        DeleteElement(InfoText())
      EndIf
    EndIf
  Next
  ;StopSpecialFX()
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End

Der Geschwindigkeitsvorteil wird leider vom TranslicideSprite wieder reduziert, aber das ist ja auch nicht immer nötig. (Seltsamerweise wird die Geschwindigkeit durch StartSpecialFX weiter reduziert, dabei stand doch in der Hilfe

Dieser Befehl arbeitet viel schneller, wenn StartSpecialFX() genutzt wird

)

[Kekskiller]

StartSpecialFX() bringt nur einen wirklichen Speedvorteil, wenn man massiv und intensiv viele Bilder mit Spezialfunktionen nutzt und anzeigt. Für meinen Editor habe ich den Befehl auch rausgelassen, da ich da nur ein Spezialbild anzeige.