Blöder Ball

Spiele, Demos, Grafikzeug und anderes unterhaltendes.
Antworten
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Blöder Ball

Beitrag von dllfreak2001 »

Hier ist ein blöder Ball den Mann per Druck auf die Linke Maustaste
an eine Art Gummiband hängt. Dann kann man den Ball werfen und er dreht sich auch.
Blöder Ball ist für alle die programmierten Schwachsinn mögen:

Code: Alles auswählen

InitSprite()
InitMouse()
InitKeyboard()
ExamineDesktops()
Global sw.l, sh.l
sw = DesktopWidth(0)
sh = DesktopHeight(0)

OpenScreen(sw,sh,32,"BloederBall_v1.0")

Global ballx.f, bally.f, ballxm.f, ballym.f, pw.l, tempx.f, tempy.f, rot.f,rotm.f , pi.f
pi = 3.141592
ballx = 640
bally = 512
ballxm = 11
pw = 2000

CreateSprite(0,sw,sh,0)
StartDrawing(SpriteOutput(0))
    For x = 0 To 9000
        Box(Random(sw),Random(sh),16,16,RGB(0,Random(50),0))
    Next
    
StopDrawing()

Repeat
    DisplaySprite(0,0,0)
    ExamineKeyboard()
    ExamineMouse()

    ;Kraftdivision einstellen

    If MouseWheel() > 0
        pw + 100
        
        If pw = 0
            pw = 1
        EndIf
        
    EndIf
    
    If MouseWheel() < 0
        pw - 100
        If pw = 0
            pw = -1
        EndIf
        
    EndIf
    
    If bally < -16000
        bally = -16000
        ballym = 0
    EndIf
    
    
    If MouseButton(1)
        tempx = (ballx-MouseX())/pw
        tempy = (bally-MouseY())/pw
        
        ballym -  tempy
        ballxm -  tempx
    
        ping = 1
    Else
        ping = 0
    EndIf

    If bally <  sh-16
        ballym = ballym + 0.1
    EndIf
    
    bally + ballym
    
    If bally > sh-16
        bally = sh-16
        ballym = -(ballym/2)    

        rotm =  ballxm
        
    EndIf
    
    If ballxm > 0
        ballxm - 0.01
    EndIf
    If ballxm < 0
        ballxm + 0.01 
    EndIf

    ballx+ballxm
    
    If ballx > sw-16
        ballx = sw-16
        ballxm = -(ballxm/2)
        rotm = -ballym
    EndIf
    If ballx < 16
        ballx = 16
        ballxm = -(ballxm/2)
        rotm = ballym
    EndIf

    If rotm > 0
        rotm - 0.01
    EndIf
    
    If rotm < 0
        rotm + 0.01
    EndIf
   
    StartDrawing(ScreenOutput())
        olposx = MouseX()
        olposy = MouseY()
        If ping = 1
            For x = 0 To 50

                If ballx > olposx
                    newposx = Random(16)-4
                Else
                    newposx = Random(64)-32
                    If ballx < olposx
                        newposx = 4-Random(16)                   
                    EndIf
                EndIf
            
                If bally > olposy
                    newposy = Random(16)-4
                Else
                    newposy = Random(64)-32
                    If bally < olposy
                        newposy = 4-Random(16)                   
                    EndIf
                EndIf

                If x = 100
                    newposx = olposx-ballx
                    newposy = olposy-bally
                EndIf
                Line(olposx,olposy,newposx,newposy,RGB(100-x,50-x/2,255-x*2))
                olposx = olposx + newposx
                olposy = olposy + newposy
            Next
            
        EndIf
        Circle(ballx,bally,16,RGB(100,0,0))

        rot - rotm
        For x = 1 To 8
            rox.f = Sin(2*pi*((rot+(x*45))/360))*15
            roy.f = Cos(2*pi*((rot+(x*45))/360))*15
            Line(ballx,bally,rox,roy,RGB(255,0,0))
        Next
        
        Line(MouseX(),MouseY()-16,0,32,RGB(255,255,0))
        Line(MouseX()-16,MouseY(),32,0,RGB(255,255,0))
    
        Locate(0,0)
        DrawingMode(1)
        FrontColor(255,255,255)
        DrawText("Power-Division: "+Str(pw))
        Locate(0,16)
        DrawText("Ball-X: "+Str(ballx))
        Locate(0,32)
        DrawText("Ball-Y: "+Str(bally))
        Locate(0,48)
        DrawText("Ball-Move-X: "+StrF(ballxm,3))
        Locate(0,64)
        DrawText("Ball-Move-Y: "+StrF(ballym,3))       
    StopDrawing()
    
    FlipBuffers()
    ClearScreen(10,10,0)
    
Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
End
I´a dllfreak2001
Nach oben
Benutzeravatar
benny
Beiträge: 383
Registriert: 29.08.2004 09:18
Wohnort: Am Ende des www's
Kontaktdaten:
Kontaktdaten von benny

Beitrag von benny »

:allright:
So long,
benny!
.
nur t0te f1sche schw1mmen m1t dem str0m - 00100 !
Nach oben
Benutzeravatar
benpicco
Beiträge: 391
Registriert: 01.10.2004 15:32
Wohnort: im Code
Kontaktdaten:
Kontaktdaten von benpicco

Beitrag von benpicco »

wow, cool :allright:
Johann Wolfgang von Geothe hat geschrieben:Wie dieses oder jenes Wort geschrieben wird, darauf kommt es doch eigentlich nicht an, sondern darauf, daß die Leser verstehen, was man damit sagen wollte.
Nach oben
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

Cool scheint ja echten positiv anzukommen,
mein nutzloses Programm. Krass!
I´a dllfreak2001
Nach oben
Benutzeravatar
AndyX
Beiträge: 1272
Registriert: 17.12.2004 20:10
Wohnort: Niederösterreich
Kontaktdaten:
Kontaktdaten von AndyX

Beitrag von AndyX »

NAja es is nutzlos aber cool :D
Nach oben
Benutzeravatar
ralle
Beiträge: 88
Registriert: 29.11.2004 17:50
Wohnort: Berlin

Beitrag von ralle »

Jo, geiles Prog! Showcase, Showcase, Showcase! ;)
Nach oben
Benutzeravatar
Green Snake
Beiträge: 1394
Registriert: 22.02.2005 19:08

Beitrag von Green Snake »

is ja voll geil :o
vorallem der bzw die blitze :o

isch stimme zu

showcase :lol:
-.-"
Nach oben
Benutzeravatar
bluejoke
Beiträge: 1244
Registriert: 08.09.2004 16:33
Kontaktdaten:
Kontaktdaten von bluejoke

Beitrag von bluejoke »

Ist voll geil!

Vielleicht erbarmt sich da jemand und nimmt das Teil als Grundlage für ein echtes Spiel. So alá Kugellabyrinth - Die Kugel darf also bspw. nirgendwo anecken, oder nicht in bestimmte Löcher fallen.


tschau,
Simon
Ich bin Ausländer - fast überall
Windows XP Pro SP2 - PB 4.00
Nach oben
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

ist zwar kein Labirinth aber jetzt kann man den Ball gegen ander herunterfallende Bälle Werfen und bekommt Punkte dafür!

Code: Alles auswählen

InitSprite()
InitMouse()
InitKeyboard()
ExamineDesktops()
Global sw.l, sh.l
sw = DesktopWidth(0)
sh = DesktopHeight(0)

OpenScreen(sw,sh,32,"BloederBall_v1.1")

Global ballx.f, bally.f, ballxm.f, ballym.f, pw.l, tempx.f, tempy.f, rot.f,rotm.f , pi.f
pi = 3.141592
ballx = sw/2
bally = sh/2
ballxm = Random(34)-17
pw = 2000

Dim ex.l(20)
Dim ey.l(20)
Dim eexist.b(20)

Global count.l, hardness.l, ce.l, fehler.l

CreateSprite(0,sw,sh,0)
StartDrawing(SpriteOutput(0))
    For x = 0 To 9000
        Box(Random(sw),Random(sh),16,16,RGB(0,Random(50),0))
    Next

StopDrawing()

Repeat
    DisplaySprite(0,0,0)
    ExamineKeyboard()
    ExamineMouse()

    ;Kraftdivision einstellen

    If MouseWheel() > 0
        pw + 100
        
        If pw = 0
            pw = 1
        EndIf
        
    EndIf
    
    If MouseWheel() < 0
        pw - 100
        If pw = 0
            pw = -1
        EndIf
        
    EndIf
    
    If bally < -16000
        bally = -16000
        ballym = 0
    EndIf
    
    
    If MouseButton(1)
        tempx = (ballx-MouseX())/pw
        tempy = (bally-MouseY())/pw
        
        ballym -  tempy
        ballxm -  tempx
    
        ping = 1
    Else
        ping = 0
    EndIf

    If bally <  sh-16
        ballym = ballym + 0.1
    EndIf
    
    bally + ballym
    
    If bally > sh-16
        bally = sh-16
        ballym = -(ballym/2)    

        rotm =  ballxm
        
    EndIf
    
    If ballxm > 0
        ballxm - 0.01
    EndIf
    If ballxm < 0
        ballxm + 0.01 
    EndIf

    ballx+ballxm
    
    If ballx > sw-16
        ballx = sw-16
        ballxm = -(ballxm/2)
        rotm = -ballym
    EndIf
    If ballx < 16
        ballx = 16
        ballxm = -(ballxm/2)
        rotm = ballym
    EndIf

    If rotm > 0
        rotm - 0.01
    EndIf
    
    If rotm < 0
        rotm + 0.01
    EndIf
   
    StartDrawing(ScreenOutput())
        olposx = MouseX()
        olposy = MouseY()
        If ping = 1
            For x = 0 To 50

                If ballx > olposx
                    newposx = Random(16)-4
                Else
                    newposx = Random(64)-32
                    If ballx < olposx
                        newposx = 4-Random(16)                   
                    EndIf
                EndIf
            
                If bally > olposy
                    newposy = Random(16)-4
                Else
                    newposy = Random(64)-32
                    If bally < olposy
                        newposy = 4-Random(16)                   
                    EndIf
                EndIf

                If x = 100
                    newposx = olposx-ballx
                    newposy = olposy-bally
                EndIf
                Line(olposx,olposy,newposx,newposy,RGB(100-x,50-x/2,255-x*2))
                olposx = olposx + newposx
                olposy = olposy + newposy
            Next
            
        EndIf
        ce = 0
        For x = 0 To 20
            If eexist(x) = 0 And ce < hardness+1
                ex(x) = 16+Random(sw-32)
                ey(x) = -100
                eexist(x) = 1
                ce + 1

            Else
                ce + 1  
            EndIf
            
        Next
        col + 5
        If col > 255
            col = 0
        EndIf
            
        For x = 0 To 20
            If eexist(x) = 1
                
                ey(x) + 1
                For y = 1 To 15
                    Circle(ex(x),ey(x),16-y,RGB(200,255-col/2 + (200/15)*y*4,0))
                Next

                If Sqr(Pow(ballx-ex(x),2)+Pow(bally-ey(x),2)) <= 32
                    eexist(x) = 0
                    count + 1
                EndIf
                
                If ey(x) > sh+16
                    fehler + 1
                    count - 1
                    eexist(x) = 0
                EndIf
                
                               
            EndIf 
            
        Next
        
        hardness = Round(count/10, 0)
        
        Circle(ballx,bally,16,RGB(100,0,0))

        rot - rotm
        For x = 1 To 8
            rox.f = Sin(2*pi*((rot+(x*45))/360))*15
            roy.f = Cos(2*pi*((rot+(x*45))/360))*15
            Line(ballx,bally,rox,roy,RGB(255,0,0))
        Next
        
        Line(MouseX(),MouseY()-16,0,32,RGB(255,255,0))
        Line(MouseX()-16,MouseY(),32,0,RGB(255,255,0))
        
        Locate(0,0)
        DrawingMode(1)
        FrontColor(255,255,255)
        DrawText("Power-Division: "+Str(pw))
        Locate(0,16)
        DrawText("Ball-X: "+Str(ballx))
        Locate(0,32)
        DrawText("Ball-Y: "+Str(bally))
        Locate(0,48)
        DrawText("Ball-Move-X: "+StrF(ballxm,3))
        Locate(0,64)
        DrawText("Ball-Move-Y: "+StrF(ballym,3))       
        Locate(0,80)
        DrawText("Punkte: "+Str(count))       
        Locate(0,96)
        DrawText("Fehler: "+Str(fehler)+"/10")       
    StopDrawing()

    If fehler > 9
        hardness = 0
        ballx = sw/2
        bally = sh/2
        ballxm = Random(34)-17
        count = 0
        For x = 0 To 20
            eexist(x) = 0
        Next
        fehler = 0

    EndIf
    
    FlipBuffers()
    ClearScreen(10,10,0)
    
Until KeyboardPushed(#PB_Key_Escape) 
CloseScreen()
End
I´a dllfreak2001
Nach oben
Benutzeravatar
vonTurnundTaxis
Beiträge: 2130
Registriert: 06.10.2004 20:38
Wohnort: Bayreuth
Kontaktdaten:
Kontaktdaten von vonTurnundTaxis

Beitrag von vonTurnundTaxis »

:allright:
Nicht durch Zorn, sondern durch Lachen tötet man
ClipGrab | Pastor - jetzt mit kurzen URLs!
Nach oben
Antworten

Zurück zu „Feedback - Spiele“