PureBoard

Verfasst: **01.04.2006 22:21**

Hat jemand von euch ein kleines Programm (open source) an dem ich mitarbeiten könnte, will PB in learning by doing lernen.

Code: Alles auswählen

MessageRequester("Hallo","Hallo Welt!")

Verfasst: **03.04.2006 21:23**

Hab jede menge kleine programme, die noch nicht ganz fertig sind.
Wie klein soll das programm denn sein, das du suchst?
Oder anders gefragt: was kannst du schon in PB?

Verfasst: **04.04.2006 22:05**

Hi, danke dass du mir das Reactionspiel geschickt hast, es sollte ja ein Menü entstehen ganz am Anfang des Spieles, ich hab mal eins erstellt jedoch hab ich das Prob. das ich nicht per Mausklick auf die Items ins Spiel kommen kann, sprich: das game hat en paar bugs. Also an alle bitte helft mir den Fehler zu beseitigen. Der Code steht gleich unten.

Code: Alles auswählen


InitSprite()
InitMouse()
InitKeyboard()

#Window_Start = 0
#Window_Scree = 1


#Radius_max = 60
#Text_dauer = 50


RandomSeed(ElapsedMilliseconds()) 


Global a_ma.l, a_err.l, a_ent.l

Global speed.f, OBJ_Delay.l, OBJ_Start_Delay.l, points.l, time.l, proz.f
speed.f = 0.5

OBJ_Start_Delay.l = 60
OBJ_Delay.l = 100

      
Structure Txt
  x.f
  y.f
  txt.s
  dauer.l
EndStructure
NewList Txt.Txt()      

Structure Obj
  x.l
  y.l
  radius.f
  max_radius.f
  speed.f
  wert.f
EndStructure
NewList Obj.Obj()


Procedure AddObj()
  AddElement(Obj())
  Obj()\x = Random(800-#Radius_max)+#Radius_max/2
  Obj()\y = Random(600-#Radius_max)+#Radius_max/2
  Obj()\radius = 0.1
  Obj()\speed = speed
  Obj()\max_radius = #Radius_max 
EndProcedure


Procedure AddTxt(x.f, y.f, Text.s)
  AddElement(Txt())
  Txt()\x = x
  Txt()\y = y
  Txt()\txt = Text.s
  Txt()\dauer = #Text_dauer
EndProcedure




Procedure UpdateObj()
   
  ForEach Obj()
    del = 0
    Circle(Obj()\x, Obj()\y, Obj()\radius ,RGB(0,128,0))
    Obj()\wert = Pow((Obj()\max_radius-Obj()\radius),2)
    If MouseButton(1)  <> 0 
      If My_GetDistanceFloat(Obj()\x, Obj()\y, MouseX(), MouseY()) <= Obj()\radius
        AddTxt(Obj()\x, Obj()\y, Str(Obj()\wert))
        points.l + Obj()\wert
        del = 1
        a_err.l + 1
        ;While GetAsyncKeyState_(#VK_LBUTTON) :Wend
      EndIf
    EndIf 
    If Obj()\radius <= Obj()\max_radius
      Obj()\radius + Obj()\speed
    Else
      a_max+1
      AddTxt(Obj()\x, Obj()\y, "-10000")
      points.l - 10000
      del = 1
    EndIf
    If del = 1
      DeleteElement(Obj())
    EndIf
  Next
  
  
  ForEach Txt()
    FrontColor(0,255,0)
    Locate(Txt()\x, Txt()\y)
    DrawText(Txt()\txt)
    If Txt()\dauer <= 0
      DeleteElement(Txt())
    Else
      Txt()\dauer - 1
      Txt()\y - 1
    EndIf
  Next
  
EndProcedure



winID.l = OpenWindow(#Window_Start, 300, 300, 800, 600, #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget, "Reaction 1.0")
scrID.l = OpenWindowedScreen(WindowID(), 0, 0, 800, 600, 1, 0, 0)


CreateSprite(0, 9, 9, 0)
StartDrawing(SpriteOutput(0))
LineXY(0, 4, 9, 4, RGB(255,255,0))
LineXY(4, 0, 4, 9, RGB(255,255,0)) 
StopDrawing()






mouse_unlocked.l = -1


zeit = 60

a_max.l = 0
a_err.l = 0
a_ent.l = 0

counter.f = 0


Gosub StartMenu


My_StartTimer()

Repeat 
  FlipBuffers()
  ClearScreen(0,0,64)
  ExamineMouse()
  ExamineKeyboard()
  

  
  
  time.l  = My_StopTimer()
  StartDrawing(ScreenOutput())
  DrawingMode(1)
  FrontColor(0,255,0)  
  UpdateObj()
  Locate(10,10)
  FrontColor(0,255,0)
  DrawText(Str(points.l))
  Locate(10,30)
  counter.f = zeit-time.l/1000
  DrawText(StrF(counter.f, 2))
  proz.f = (a_err.l/a_max.l)*100
  Locate(10,50)
  DrawText(StrF(proz.f, 2)+"   fps: "+Str(My_FPS(1000)))
  StopDrawing()
  
  If OBJ_Delay <= 0
    AddObj()
    a_max.l + 1
    If counter <= 45
      del.l = 45
    Else
      del.l = counter 
    EndIf
    OBJ_Delay = Random(del-20)+10
  EndIf
  OBJ_Delay - 1
  
  If KeyboardReleased(#PB_Key_F1)
    mouse_unlocked.l * -1
    ReleaseMouse(mouse_unlocked.l) 
  EndIf
  
  If KeyboardReleased(#PB_Key_1)
    Gosub StartMenu
  EndIf
  
  
  
  If counter <= 0
    ReleaseMouse(1)
    MessageRequester("Info", "Punkte     : "+Str(points.l)+Chr(10)+Chr(13)+"Genauigkeit: "+StrF(proz.f, 2)+"%")
    End
  EndIf
  
  DisplayTransparentSprite(0, MouseX(), MouseY())
Until KeyboardPushed(#PB_Key_Escape) Or WindowEvent() = #PB_Event_CloseWindow 



CloseScreen()

End



StartMenu:
Repeat
If OpenWindow(0, 300, 300, 300, 100, #PB_Window_SystemMenu, "Das Seifenblasenspiel") 
    If CreateMenu(0, WindowID())  ;
      MenuTitle("Reaction") 
        MenuItem(1, "Spiel starten") 
        MenuBar()                 
        MenuItem(4, "Spiel beenden") 
    EndIf 
    Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow 

  EndIf 
  
  If KeyboardReleased(#PB_Key_F1)
    mouse_unlocked.l * -1
    ReleaseMouse(mouse_unlocked.l) 
  EndIf
  
  
  StopDrawing()
  
  
  Delay(1)

Until KeyboardReleased(#PB_Key_return) 
 Return

Verfasst: **04.04.2006 22:35**

Eins hätt ich fast vergessen.
Die Funktion 'My_FPS()' habe ich in einer meiner Userlibs.

Ihr benötigt diese Prozedur um den Code korrekt auszuführen:

Code: Alles auswählen

Procedure.l My_FPS(RefreshTime.l)
  Static sek.l, fps.f, fps2.f, stoptm.l, starttm.l, timemm.l, ElapTime.l
  stoptm.l = ElapsedMilliseconds()
  timemm.l = stoptm.l-starttm.l
  ElapTime.l = ElapsedMilliseconds()-sek.l
  If ElapTime.l >= RefreshTime.l
    fps2.f = fps.f*(1000/RefreshTime)
    fps.f = 1
    sek.l=ElapsedMilliseconds()
  Else
    fps.f + 1
  EndIf
  starttm.l = ElapsedMilliseconds()
  ProcedureReturn Round(fps2.f, 1)
EndProcedure

[EDIT]
Hab gerade den geposteten Code compiliert (ohne ihr vorher nochmal anzuschauen) und hab das Fenster kaum wieder zubekommen.

Meine Absicht war eigentlich ein Menü direkt im Windowedscreen zu machen. (Mit Bitmaps als Buttons usw.)

Hier ist mein original Code und die EXE:
http://www.10000kb.de/user_web/frogger/ ... action.rar

PureBoard

Newbie sucht Projekte zum mitcoden

Newbie sucht Projekte zum mitcoden

Das Seifenblasenspiel