Here's a script for scrolling text

[martin]

Although the code is not perfect yet, here's a little script that scrolls text in an invisible canvas. I created it for my music player, but maybe it's useful for others as well.


USES "UI"

Begin Const
%btnScroll = 1
%ID_Canvas1 = 2
$ScrollText = "hello everybody, this is script is an example of a scrolling text "
End Const

dim hDlg AS DWORD

FUNCTION TBMAIN()
DIALOG New 0, "Scrolling example by using Canvas - by Martin Verlaan",-1,-1, 350, 120, %WS_POPUP Or %WS_VISIBLE Or %WS_CAPTION OR %WS_SYSMENU Or %WS_MINIMIZEBOX To hDlg
CONTROL ADD BUTTON, hDlg, %btnScroll, "Scroll", 170, 100, 60, 14, CALL btnScrollProc
DIALOG SHOW MODAL hDlg, CALL dlgProc
END FUNCTION

CALLBACK FUNCTION dlgProc()
SELECT CASE CBMSG
CASE %WM_INITDIALOG
local xpos,ypos as long
dialog get client hDlg to xpos,ypos

CONTROL ADD CANVAS, hDlg, %ID_Canvas1, "", 20,27,xpos-50,50
cANVAS_Attach hDlg, %ID_Canvas1, %true
CANVAS_Box 0,0,xpos-50,50, 0,RGB(236,233,216)
CANVAS_Font("Lucida Console" , 22, "bold")
CANVAS_SetPos 0,10
CANVAS_Printl $ScrollText
CASE %WM_COMMAND
CASE %WM_CLOSE
END SELECT
END FUNCTION

CALLBACK FUNCTION btnScrollProc()
IF CBMSG = %WM_COMMAND and CBCTLMSG = %BN_CLICKED THEN
dim MoveLeft as boolean = %true
dim cx,cy, xpos, Characterwidth as long

Characterwidth=12 ' change this value if you choose another font. Always use a fixed font, otherwise it won't work.

control disable hDLG,%btnScroll

CONTROL GET CLIENT hDlg, %ID_Canvas1 TO cx,cy
dim maxpos as long = (len($ScrollText)*Characterwidth)-cx

do
CANVAS_SetPos xpos,10
CANVAS_Printl $ScrollText
canvas_redraw
sleep 10
doevents
if MoveLeft then
xpos=xpos-1
else
xpos=xpos+1
end if
if abs(xpos)=maxpos or xpos=0 then
if MoveLeft then
MoveLeft=%false
else
MoveLeft=%true
end if
sleep 1000
end if
loop
end if
END FUNCTION

[Lionheart008]

hi martin :)

good idea with your scrolling text example !... I like it!
- perhaps you can build a new button for 'pause' or 'stop' the scrolling text and fill it with colours ? ;) good work!

one idea dropped into my head: a kind of "newsticker" with important news could be also nice to have ! 8)

nice day, Lionheart

[martin]

Hi Lionheart!

Thanks for your feedback!
In my player-script I already improved the scrolling with a different font, color and also I made resizing possible. However I don't feel the need to pimp this example-script with bling bling things as it was just a small example to show how I created scrolling text with small, easy code. I am pretty curious if there are other better ways to create scrolling text, is there any example in TBGL?

All the best,

Martin

[Petr Schreiber]

Hi Martin,

one example on text scrolling is in:
SampleScripts\TBGL\TBGL_Demo8_Font.tBasic

It uses font from bitmap to render, fonts can be easily generated using this tool:
TBGL Font Creator (http://community.thinbasic.com/index.php?topic=1024.msg6811#msg6811)

It is possible to use TTF fonts as well, but they are being clipped once their lower left corner is out of drawing space.
This can be solved by rendering the text at 0, 0 to texture, and then perform texture scrolling... but I am not sure this is ideal for your purpose.

I think your approach is very good, just that loop seems a possible trouble maker to me.

This can be solved using timer and static variables:


USES "UI"

Begin Const
%btnScroll = %WM_USER + 1
%ID_Canvas1
%tTimer
$ScrollText = "hello everybody, this is script is an example of a scrolling text "
End Const

dim hDlg AS DWORD
dim wantScroll as long = %TRUE
FUNCTION TBMAIN()
DIALOG New 0, "Scrolling example by using Canvas - by Martin Verlaan",-1,-1, 350, 120, %WS_POPUP Or %WS_VISIBLE Or %WS_CAPTION OR %WS_SYSMENU Or %WS_MINIMIZEBOX To hDlg
CONTROL ADD BUTTON, hDlg, %btnScroll, "Scroll", 170, 100, 60, 14, CALL btnScrollProc
DIALOG SHOW MODAL hDlg, CALL dlgProc
END FUNCTION

CALLBACK FUNCTION dlgProc()
SELECT CASE CBMSG
CASE %WM_INITDIALOG
local xpos,ypos as long
dialog get client hDlg to xpos,ypos

CONTROL ADD CANVAS, hDlg, %ID_Canvas1, "", 20,27,xpos-50,50
cANVAS_Attach hDlg, %ID_Canvas1, %true
CANVAS_Box 0,0,xpos-50,50, 0,RGB(236,233,216)
CANVAS_Font("Lucida Console" , 22, "bold")
CANVAS_SetPos 0,10
CANVAS_Printl $ScrollText
CASE %WM_TIMER
ScrollText()

CASE %WM_CLOSE
dialog kill timer cbhndl, %tTimer

END SELECT
END FUNCTION

CALLBACK FUNCTION btnScrollProc()
IF CBMSG = %WM_COMMAND and CBCTLMSG = %BN_CLICKED THEN
dialog set timer cbhndl, %tTimer, 10, 0
control disable hDLG,%btnScroll
END IF
END FUNCTION

FUNCTION ScrollText()

STATIC MoveLeft as boolean = %true
STATIC cx,cy, xpos as long
static Characterwidth as long = 12 ' change this value if you choose another font. Always use a fixed font, otherwise it won't work.
static maxpos as long = (len($ScrollText)*Characterwidth)-cx
static MoveLeft as boolean = %true
Characterwidth=12 ' change this value if you choose another font. Always use a fixed font, otherwise it won't work.

CONTROL GET CLIENT hDlg, %ID_Canvas1 TO cx,cy

CANVAS_SetPos xpos,10
CANVAS_Printl $ScrollText
canvas_redraw
if MoveLeft then
xpos=xpos-1
else
xpos=xpos+1
end if
if abs(xpos)=maxpos or xpos=0 then
if MoveLeft then
MoveLeft=%false
else
MoveLeft=%true
end if
end if

END FUNCTION


This way the impact of scrolling on other dialog interaction will keep at zero level.


Petr

[Michael Clease]

you could use the sprite functions so each character is a sprite then you can do whatever you want to them.

[martin]

To Petr:
No worries, in my original script I will make a timer as well, the loop was only for testing. Code in TBGL looks impressive: very small! :)

To Michael:
Yes I also thought a moment about sprites but I guess my code is smallest and easiest for what I want to do. I have no knowledge (yet) of TBGL so I decided to do it this way (with canvas).

[Michael Clease]

Heres one I did a while back

use the left and right arrow keys to adjust frequency.


Mike

Update : added a check to see if window create if error msg and stop.

[martin]

Thanks Michael but if I run the script I see only a window with a black background. And then it seems to crash (nothing happens,and I can't quit with middle mouse button.

[Michael Clease]

I updated my previous post with a minor change and quitting by right mouse button

[Michael Hartlef]

Hi Michael,

I got this output, is that how it should look like?

[Michael Hartlef]

And to martin and Petr, both works fine here. Thanks for sharing the source :)

[Petr Schreiber]

Hi Michael,

on my PC it looks like on attached picture.
Could be emulation problem on your side?


Petr

P.S. Martin, could you run script from here (http://community.thinbasic.com/index.php?topic=668.msg3885#msg3885) and post results please?

[Michael Hartlef]

I'm sure it is an emulation problem.

[matthew]

Recently my Vista laptop overheated & stopped working so I had to go back to my XP laptop with the SIS graphics card.

I've tried one of the scripts & got the same result that Michael did. :?

I've ran the OpenGL Info program you wrote Petr & I've attached the results.

[Petr Schreiber]

Thank you guys,

those are some interesting problems, and I think I know where is the reason.
Micheal.Clease renders to texture 640x72. This is possible with TBGL, but only if it is supported by hardware (usually OpenGL 2.0+).

If you write scripts which might use not-power-of-two textures, please query npot support first:


' You need to create variable to which we will pass data later
DIM texInfo AS TBGL_tTexturingInfo

' To fill variable fields, just use following
TBGL_TexturingQuery( texInfo )

' Use the passed variable for tests in your code
IF texInfo.NPOTSupport = %FALSE THEN
' -- You have to specify POT textures
ELSE
' -- You can use your oddly shaped textures
END IF


Michael could not take advantage of this, as at the time he developed the script the functionality was not present.


Petr

[martin]

P.S. Martin, could you run script from here (http://community.thinbasic.com/index.php?topic=668.msg3885#msg3885) and post results please?

opengl_getinfo says that Open GL is installed correctly

[Petr Schreiber]

Thanks Martin,

do you know which OpenGL version does the tool report?


Petr

P.S. Nice to see your face! Pleased to meet you!

[martin]

2.1.7751 RELEASE


Nice to see your face! Pleased to meet you!

Thanks, it feels more and more like home here :)

[Michael Hartlef]

2.1.7751 RELEASE


Nice to see your face! Pleased to meet you!

Thanks, it feels more and more like home here :)


That's nice to hear. And I always like to see the face behind a nickname. :)

[Michael Clease]

Here is a version with a font and texture size of 64 and some minor tweaks so it does have magic numbers anymore.

I dont know why I used 72 ??

thanks Petr and everyone for testing.

update add new version below using power of 2 dimensions

[matthew]

For some reason the new version of the SinScroller still isn't working correctly on my computer.

As it seems to be working for everyone else though I'd probably put it down to a graphics card problem.

[Michael Clease]

Try this its by Kent http://community.thinbasic.com/index.php?topic=984.0

[Petr Schreiber]

Matthew,

I think I found the problem here:
http://community.thinbasic.com/index.php?topic=2843.msg21461#msg21461

You have not OpenGL 1.5EXT/2.0+ card, so NPOT textures are not supported.
Michael uses 640x64 in latest example, where 640 dimension sadly isn't power of two.

The Kents example causes some problem now, because older versions of TB were more tolerant to such a stunts as declaring STATICs outside of procedure. It also uses 500x500 texture, which is again not POT.

So I add one render to texture example here for you, which should run (512x512):


'
' Render to texture
' Petr Schreiber, started on 08-12-2009
'

Uses "TBGL"

BEGIN CONST
' -- TextureID
%tTexture= 1

' -- Scene IDs
%sScene = 1

' -- Entity IDs
%eCamera = 1
%eLight
%eBox
END CONST

FUNCTION TBMAIN()
LOCAL hWnd As DWORD
LOCAL FrameRate AS DOUBLE

' -- Create and show window
hWnd = TBGL_CreateWindowEx("TBGL render to texture - press ESC to quit", 512, 512, 32, %TBGL_WS_WINDOWED or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow

' -- Create scene
TBGL_SceneCreate(%sScene)

' -- Create basic entities
' -- Create camera to look from 15, 15, 15 to 0, 0, 0
TBGL_EntityCreateCamera(%sScene, %eCamera)
TBGL_EntitySetPos(%sScene, %eCamera, 5, 5, 5)
TBGL_EntitySetTargetPos(%sScene, %eCamera, 0, 0, 0)

' -- Create point light
TBGL_EntityCreateLight(%sScene, %eLight)
TBGL_EntitySetPos(%sScene, %eLight, 15, 10, 5)

' -- Create something to look at
tbgl_MakeTexture STRING$ ( 512*512*4, 255 ), %TBGL_DATA_RGBA, 512, 512, %tTexture, %TBGL_TEX_LINEAR

TBGL_EntityCreateBox(%sScene, %eBox, 0, 2, 2, 2, %tTexture, 255, 255, 255)

' -- Resets status of all keys
TBGL_ResetKeyState()

' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate

TBGL_ClearFrame
TBGL_EntitySetTexture(%sScene, %eBox, 0)
TBGL_SceneRender(%sScene)

TBGL_RenderToTexture(%tTexture, 0, 0, 512, 512)

TBGL_ClearFrame
TBGL_EntitySetTexture(%sScene, %eBox, %tTexture)
TBGL_SceneRender(%sScene)
TBGL_DrawFrame

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While


TBGL_EntityTurn(%sScene, %eBox, 0,-90/FrameRate, 0)

Wend

TBGL_DestroyWindow
END FUNCTION


Please let me know if it works, I want TBGL to work on all cards.


Petr

[Michael Clease]

Heres another verison with power of 2

[martin]

Heres another verison with power of 2


This one works fine here

[matthew]

Yeah, it works now. I thought the previous version had correctly sized textures, I hadn't noticed that 640 was still being used for one of the texture dimensions.