XProfan

' Programm: lesson13
' per XProfan 9
declare font&, \' Base Display List For The Font Set
cnt1!, \' 1st Counter Used To Move Text & For Coloring
cnt2!, \' 2nd Counter Used To Move Text & For Coloring
cnt3!' Neu eingefügt
cnt3! = -7
declare time&, frames%

proc DrawGLScene

    oGL("Clear")
    oGL("Origin", 0, 0, -2)' Move Into The Screen
    oGL("Color", cos(cnt1!), sin(cnt2!), 1 - 0.5 * cos(cnt1! + cnt2!), 1)
    cnt1! = cnt1! + 0.051' Increase The First Counter
    cnt2! = cnt2! + 0.005
    cnt3! = cnt3! + 0.007' Neu eingefügt
    ' Increase The 2nd Counter
    oGL("Locate", -5.95 - cnt3!, 0.32 * sin(cnt2!))' Position The Text On The Screen ************ Neu eingefügt
    oGL("Print", font&, "Text in OpenGL mit XProfan 9")' Print GL Text To The Screen
    oGL("Show")

endproc

' Hauptprogramm
' -------------
declare ende%, hfont&
CLS 0
oGL("Init", %hWnd, 0, 0, 0, 1)
hfont& = create("Font", "Arial", 32, 0, 0, 0, 0)
font& = oGL("BitmapFont", hfont&)
deleteobject hfont&
Ende% = 0
time&   = &GetTickCount
setTimer 10' max. 100 Frames /sek.

WhileNot ende%

    WaitInput

    If IsKey(27)

        Ende% = 1

    EndIf

    DrawGLScene()
    inc frames%

    if &GetTickCount - time& >= 1000' 1 Sekunde ist 'rum

        setText %hWnd, str$(frames%) + " Frames / sek"
        time&   = &GetTickCount
        frames% = 0

    endif

EndWhile

killTimer
end

' Programm: lesson14
' per XProfan 10
declare font&, rot!, pos!
pos!=8
declare time&, frames%

proc DrawGLScene

    pos! = pos! - 0.05
    oGL("Clear")
    oGL("Origin", 0, 0, -12)
    '  oGL("Rotate", rot!, rot! * 0.1, rot! * 0.09)
    oGL("Color", cos(rot!/20), sin(rot!/25), 1 - 0.5*cos(rot!/17), 1)
    oGL("Move", pos!, 0, 0)
    oGL("Print", font&, "OpenGL mit XProfan 9")
    rot! = rot! + 0.5
    oGL("Show")
    locate 0,0
    print str$(pos!)

endproc

' Hauptprogramm
' -------------
declare ende%, hfont&
CLS 0
oGL("Init", %hWnd, 0, 0, 0, 1)
hfont& = create("Font", "Courier New", 48, 0, 1, 0, 1)
font& = oGL("OutlineFont", hfont&, 0.3)
deleteobject hfont&
Ende% = 0
time&   = &GetTickCount
setTimer 25' max. 100 Frames /sek.

WhileNot ende%

    WaitInput

    If IsKey(27)

        Ende% = 1

    EndIf

    Case pos! < -18 : pos! = 7'Text wieder nach rechts
    DrawGLScene()
    inc frames%

    if &GetTickCount - time& >= 1000' 1 Sekunde ist 'rum

        setText %hWnd, str$(frames%) + " Frames / sek"
        time&   = &GetTickCount
        frames% = 0

    endif

EndWhile

killTimer
end

'-Begin-----------------------------------------------------------------
Declare A$,B$
Cls
WindowTitle "Testprogramm MP3 / MPG"

If %ParCount

    A$ = Par$(1)
    print "Abspielen: \n" + A$

Else

    print "Keine mp3-File trasferimento >>> File auswählen"
    A$=LoadFile$("MP3/MPG-DATEI","*.MP*")

EndIf

While A$ <> ""

    A$ = "\q" + A$ + "\q"
    A$="OPEN " + A$ + " TYPE MPEGVIDEO ALIAS MP"
    B$=MCISend$(A$)
    Case %MCIError : Print "Fehler: ";B$
    B$=MCISend$("PLAY MP")
    WaitMouse
    B$=MCISend$("CLOSE MP")
    A$=LoadFile$("MP3/MPG-DATEI","*.MP*")

EndWhile

'-End-------------------------------------------------------------------

/*
Diashow
*/
WindowStyle 64 + 16'Fenster ohne Rahmen und
Window %MaxX, %MaxY'Fenster an Desktopauflösung anpassen
CLS 0'Bildschirm Schwarz färben
Declare Ende%'Variable per Abbruchbedingung
Declare hfont&, font&'Variablen per Font1
Declare pos!, rot!'Positions- und RotationsVariablen
Ende% = 0'Startbedingung 0 - Also kein Abbruch
pos!=12'Position des Textes außerhalb des rechten Bildschirmrandes
rot!=0'Rotation = 0
oGL("Init", %hWnd, 0, 0, 0, 0)'OpenGL Init
oGL("LoadXPGL", "Linie.xpgl")'Lädt Linienpunkte aus File Linie.xpgl
oGL("UseXPGL", 1)'Verwendet diese Linienpunkte
hfont& = create("Font", "Courier New", 64, 0, 0, 10, 0)'Lädt Font in Variable hfont&
font& = oGL("OutlineFont", hfont&, 0.3)'Weist hfont& oGL zu
deleteobject hfont&'Zerstört Objekt hfont& wieder, weil es nach Zuweisung nicht mehr necessario wird
MIDI("Play", $ProgDir + "irgendeinSound.mp3", 1)'Spielt mp3 aus dem Programmverzeichnis ab aus dem dieses Programm gestartet wurde
SetTimer 5'max. 100 Frames /sek.

WhileNot ende%'Wenn keine Abbruchbedingung erkannt wurde, durchlauf des Timers

    WaitInput'wartet auf Abbruchbedingung

    If IsKey(27)'ist Abbruchbedingung "Escape-Taste" erfüllt, dann

        Ende% = 1'setzte Variable Ende% auf 1

    EndIf'und beende diese Abfrage

    Case pos! < -22 : pos! = 12'Wenn Text hinter linkem Bildschirmrand verschwunden dann starte ihn wieder von Vorne
    Case rot! <= 90 : rot!=0'Wenn Rotationswinkel 90Grad erreicht, dann auf 0 setzen
    DrawLauftext()'Zeichne derweil OpenGL

EndWhile'Springe zu WhileNot

KillTimer'Beende nach 5ms den Timer oder besser gesagt: Springe nach 5ms wieder zum SetTimer
End
'----------------------------------------------------------------------------

proc DrawLauftext

    pos! = pos! - 0.05
    rot! = rot! + 0.05
    oGL("Clear")
    oGL("Origin", 0, 0, -12)
    'oGL("Rotate", rot!, rot! * 0.1, rot! * 0.09)
    oGL("Color", cos(rot!), sin(rot!), 1 - 0.5*cos(rot!), 1)
    oGL("Move", pos!, 4.3, 0)
    oGL("Print", font&, "OpenGL mit XProfan 9")
    oGL("Origin", 0, 0, -12)
    oGL("Color", cos(rot!), sin(rot!), 1 - 0.5*cos(rot!), 1)
    oGL("Move", pos!/0.7, -4.7, 0)
    oGL("Print", font&, "OpenGL mit XProfan 9")
    oGL("Origin", 0.0, 0.0, -9.0)'Setzt Position der XPGL-Linien
    oGL("DrawXPGL", 0, 4)'Zeichnet ebend diese Linien
    oGL("Show")'Zeigt Lauftext und Linien

EndProc