PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

PureGolf mit Scrollender Matrix

https://www.purebasic.fr/german/viewtopic.php?t=6883

Seite 1 von 10

PureGolf mit Scrollender Matrix

Verfasst: 09.02.2006 16:27
von AndyX
:)

Wieder einmal werden eure Fähigkeiten im Kürzen von Codes gefordert.
Ja, hiermit eröffne ich meinen PureGolf! :mrgreen:

Code: Alles auswählen

Structure Matrix_Letter
  Green.c
  Letter.c
EndStructure
#SCR_WIDTH = 800
#SCR_HEIGHT = 600
Global Dim Array_Screen_Letters.Matrix_Letter(#SCR_WIDTH/10,#SCR_HEIGHT/10)

Procedure ScrollMatrix()
  For i = #SCR_HEIGHT/10 To 0 Step -1
    For j = #SCR_WIDTH/10 To 0 Step -1
      If i And Random(1)=0
        scrollletter.c = Array_Screen_Letters(j,i-1)\Letter
        Green.c = Array_Screen_Letters(j,i-1)\Green
        With Array_Screen_Letters(j,i)
          If Random(3)<>1
            Letter = scrollletter
          Else
            Letter = Random(222)+33
          EndIf
          \Green = Green - Random(1)
          If \Green <= 0
            \Green = Random(250)
            \Letter = Random(222)+33
          EndIf
        EndWith
      ElseIf (Not i) And Random(1)=0
        With Array_Screen_Letters(j,i)
          \Letter = Random(222)+33
          \Green = Random(250)
        EndWith
      EndIf
    Next j
  Next i
EndProcedure

For i = 0 To #SCR_HEIGHT/10
  For j = 0 To #SCR_WIDTH/10
      With Array_Screen_Letters(j,i)
        \Green = Random(250)
        \Letter = Random(222)+33
      EndWith
  Next j
Next i

If Not InitSprite()
  MessageRequester("Fehler","Konnte DirectX nicht laden!")
EndIf
If Not InitKeyboard()
  MessageRequester("Fehler","Konnte die Tastatur nicht laden!")
EndIf
If Not OpenScreen(#SCR_WIDTH,#SCR_HEIGHT,32,"Matrix")
  MessageRequester("Fehler","Konnte keinen Screen nicht laden!")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i = 0 To #SCR_HEIGHT/10
    For j = 0 To #SCR_WIDTH/10
      With Array_Screen_Letters(j,i)
        DrawText(j*10,i*10,Chr(\Letter),RGB(0,\Green,0),0)
      EndWith
    Next j
  Next i
      
  StopDrawing()
  
  FlipBuffers()
  ScrollMatrix()
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)
Ziel ist es, den oberen Code möglichst kurz umzuschreiben. Am Ende soll er aber immer noch so (oder so ähnlich) aussehen wie mein Beispielcode. Programmiert wird mit PB v4.0 und gezählt wird mithilfe dieses Counters:

Code: Alles auswählen

win = OpenWindow(0,0,0,200,45,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Codezähler")
CreateGadgetList(win)
StringGadget(0,0,0,140,20,"")
ButtonGadget(1,141,0,58,20,"Browse")
ButtonGadget(2,0,22,60,20,"Count")
TextGadget(3,65,25,200,20,"Zeichen: ")
Repeat
  eventid=WaitWindowEvent()
  If eventid=#PB_Event_Gadget
    If EventGadget() = 1
      file.s = OpenFileRequester("Open","","PB-Code *.pb | *.pb| Alles *.* | *.*",0)
      SetGadgetText(0,file)
    ElseIf EventGadget() = 2
      count=0
      If file
        OpenFile(0,file)
        While Eof(0) = 0
          line.s = Trim(ReadString(0)) 
          If Mid(line,1,1) <> ";" : count+Len(line) : EndIf
        Wend
        SetGadgetText(3,"Zeichen: "+Str(count))        
      EndIf 
    EndIf
  EndIf
Until eventid = #PB_Event_CloseWindow
Viel Spaß! :)

PS: 1432! :mrgreen:

Verfasst: 09.02.2006 16:37
von Batze
Mit Macros wird PureGolf bestimmt lustig :mrgreen:

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure
W=800
H=600
Global Dim A.M(W/10,H/10)

Macro Z
  MessageRequester("Fehler","
EndMacro

For i=0 To H/10
  For j=0 To W/10
      With A(j,i)
        \G=Random(250)
        \L=Random(222)+33
      EndWith
  Next
Next

If InitSprite()=0
  Z Konnte OpenGL nicht laden!")
EndIf
If InitKeyboard()=0
  Z Konnte die Tastatur nicht laden!")
EndIf
If OpenScreen(W,H,32,"Matrix")=0
  Z Konnte keinen Screen nicht laden!")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To H/10
    For j=0 To W/10
      With A(j,i)
        DrawText(j*10,i*10,Chr(\L),\G<<8, 0)
      EndWith
    Next
  Next
     
  StopDrawing()
 
  FlipBuffers()
    For i=H/10 To 0 Step -1
    For j=W/10 To 0 Step -1
      If i And Random(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If Random(3)<>1
            L=s
          Else
            L=Random(222)+33
          EndIf
          \G = G-Random(1)
          If \G<1
            \G=Random(250)
            \L=Random(222)+33
          EndIf
        EndWith
      ElseIf i=0 And Random(1)=0
        With A(j,i)
          \L=Random(222)+33
          \G=Random(250)
        EndWith
      EndIf
    Next
  Next
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(1)
899

Verfasst: 09.02.2006 17:03
von freedimension
Sind Strings auch dann Taboo wenn sie selbst im Original keinen Sinn ergeben? :D

Verfasst: 09.02.2006 17:08
von Batze
Hab ich auch gedacht als ich das gelesen hab. :freak:
Wollte erst durch einen gleichlangen String ersetzen, habs aber dann gelassen.

Verfasst: 09.02.2006 17:20
von Eric

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure
W=800
H=600
Global Dim A.M(80,60)

Macro Z
  MessageRequester("Fehler","
EndMacro

For i=0 To 60
  For j=0 To 80
      With A(j,i)
        \G=Random(250)
        \L=Random(222)+33
      EndWith
  Next
Next

If InitSprite()=0
  Z Konnte OpenGL nicht laden!")
EndIf
If InitKeyboard()=0
  Z Konnte die Tastatur nicht laden!")
EndIf
If OpenScreen(W,H,32,"Matrix")=0
  Z Konnte keinen Screen nicht laden!")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To 60
    For j=0 To 80
      With A(j,i)
        DrawText(j*10,i*10,Chr(\L),\G<<8, 0)
      EndWith
    Next
  Next
     
  StopDrawing()
 
  FlipBuffers()
    For i=60 To 0 Step -1
    For j=80 To 0 Step -1
      If i And Random(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If Random(3)<>1
            L=s
          Else
            L=Random(222)+33
          EndIf
          \G = G-Random(1)
          If \G<1
            \G=Random(250)
            \L=Random(222)+33
          EndIf
        EndWith
      ElseIf i=0 And Random(1)=0
        With A(j,i)
          \L=Random(222)+33
          \G=Random(250)
        EndWith
      EndIf
    Next
  Next
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(1)
883

Verfasst: 09.02.2006 17:23
von Batze

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure
W=800
H=600
F=10
Global Dim A.M(80,60)

Macro Z(R)
  MessageRequester("Fehler","Konnte "+R+" nicht laden!")
EndMacro

For i=0 To 60
  For j=0 To 80
      With A(j,i)
        \G=Random(250)
        \L=Random(222)+33
      EndWith
  Next
Next

If InitSprite()=0
  Z("OpenGL")
EndIf
If InitKeyboard()=0
  Z("die Tastatur")
EndIf
If OpenScreen(W,H,32,"Matrix")=0
  Z("keinen Screen")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To 60
    For j=0 To 80
      With A(j,i)
        DrawText(j*F,i*F,Chr(\L),\G<<8, 0)
      EndWith
    Next
  Next
     
  StopDrawing()
 
  FlipBuffers()
    For i=60 To 0 Step -1
    For j=80 To 0 Step -1
      If i And Random(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If Random(3)<>1
            L=s
          Else
            L=Random(222)+33
          EndIf
          \G = G-Random(1)
          If \G<1
            \G=Random(250)
            \L=Random(222)+33
          EndIf
        EndWith
      ElseIf i=0 And Random(1)=0
        With A(j,i)
          \L=Random(222)+33
          \G=Random(250)
        EndWith
      EndIf
    Next
  Next
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(1)
858

Verfasst: 09.02.2006 17:29
von Eric

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure
W=800
H=600
Global Dim A.M(80,60)

Macro Z(R)
  MessageRequester("Fehler","Konnte "+R+" nicht laden!")
EndMacro

Macro R(B,A)
\B=Random(A)
EndMacro

For i=0 To 60
  For j=0 To 80
      With A(j,i)
        R(G,250)
        R(L,222)+33
      EndWith
  Next
Next

If InitSprite()=0
  Z("OpenGL")
EndIf
If InitKeyboard()=0
  Z("die Tastatur")
EndIf
If OpenScreen(W,H,32,"Matrix")=0
  Z("keinen Screen")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To 60
    For j=0 To 80
      With A(j,i)
        DrawText(j*10,i*10,Chr(\L),\G<<8, 0)
      EndWith
    Next
  Next
     
  StopDrawing()
 
  FlipBuffers()
    For i=60 To 0 Step -1
    For j=80 To 0 Step -1
      If i And Random(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If Random(3)<>1
            L=s
          Else
            L=Random(222)+33
          EndIf
          \G = G-Random(1)
          If \G<1
            R(G,250)
            R(L,222)+33
          EndIf
        EndWith
      ElseIf i=0 And Random(1)=0
        With A(j,i)
          R(L,222)+33
          R(G,250)
        EndWith
      EndIf
    Next
  Next
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(1)
852

Verfasst: 09.02.2006 17:40
von Batze

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure
W=800
H=600
F=10
Global Dim A.M(80,60)

Macro Z(R)
  MessageRequester("Fehler","Konnte "+R+" nicht laden!")
EndMacro
Macro R(n)
  Random(n)
EndMacro

For i=0 To 60
  For j=0 To 80
      With A(j,i)
        \G=R(250)
        \L=R(222)+33
      EndWith
  Next
Next

If InitSprite()=0
  Z("OpenGL")
EndIf
If InitKeyboard()=0
  Z("die Tastatur")
EndIf
If OpenScreen(W,H,32,"Matrix")=0
  Z("keinen Screen")
EndIf

Repeat
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To 60
    For j=0 To 80
      With A(j,i)
        DrawText(j*F,i*F,Chr(\L),\G<<8, 0)
      EndWith
    Next
  Next
     
  StopDrawing()
 
  FlipBuffers()
  For i=60 To 0 Step -1
    For j=80 To 0 Step -1
      If i And R(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If R(3)<>1
            L=s
          Else
            L=R(222)+33
          EndIf
          \G=G-R(1)
          If \G<1
            \G=R(250)
            \L=R(222)+33
          EndIf
        EndWith
      ElseIf i+R(1)=0
        With A(j,i)
          \L=R(222)+33
          \G=R(250)
        EndWith
      EndIf
    Next
  Next
  ExamineKeyboard()
  Delay(1)
Until KeyboardPushed(1)
822

Verfasst: 09.02.2006 17:55
von NicTheQuick

Code: Alles auswählen

Structure M 
G.c 
L.c 
EndStructure 
W=800 
H=600 
F=10 
Global Dim A.M(80,60) 

Macro Z(R) 
  MessageRequester("Fehler","Konnte #R# nicht laden!") 
EndMacro 
Macro R(n) 
  Random(n) 
EndMacro 

For i=0 To 60 
  For j=0 To 80 
      With A(j,i) 
        \G=R(250) 
        \L=R(222)+33 
      EndWith 
  Next 
Next 

If InitSprite()=0
  Z(OpenGL) 
EndIf 
If InitKeyboard()=0 
  Z(die Tastatur) 
EndIf 
If OpenScreen(W,H,32,"Matrix")=0 
  Z(keinen Screen) 
EndIf 

Repeat 
  ClearScreen(0) 
  StartDrawing(ScreenOutput()) 
  For i=0 To 60 
    For j=0 To 80 
      With A(j,i) 
        DrawText(j*F,i*F,Chr(\L),\G<<8, 0) 
      EndWith 
    Next 
  Next 
      
  StopDrawing() 
  
  FlipBuffers() 
  For i=60 To 0 Step -1 
    For j=80 To 0 Step -1 
      If i And R(1)=0 
        s.c = A(j,i-1)\L 
        G.c = A(j,i-1)\G 
        With A(j,i) 
          If R(3)<>1 
            L=s 
          Else 
            L=R(222)+33 
          EndIf 
          \G = G-R(1) 
          If \G<1 
            \G=R(250) 
            \L=R(222)+33 
          EndIf 
        EndWith 
      ElseIf i+R(1)=0 
        With A(j,i) 
          \L=R(222)+33 
          \G=R(250) 
        EndWith 
      EndIf 
    Next 
  Next 
  ExamineKeyboard() 
  Delay(1) 
Until KeyboardPushed(1)
Zeichen weiß ich nicht. Hab grad nicht zählen können. Aber jetzt seht ihr
erstmal, wie man Makros auch benutzen kann.

Verfasst: 09.02.2006 18:11
von nco2k
659

Code: Alles auswählen

Structure M
G.c
L.c
EndStructure

W=800
H=600
F=10
Global Dim A.M(80,60)

Macro R(n)
  Random(n)
EndMacro

For i=0 To 60
  For j=0 To 80
      With A(j,i)
        \G=R(250)
        \L=R(222)+33
      EndWith
  Next
Next

InitSprite()
InitKeyboard()
OpenScreen(W,H,32,"")

Repeat
  
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  For i=0 To 60
    For j=0 To 80
      With A(j,i)
        DrawText(j*F,i*F,Chr(\L),\G<<8,0)
      EndWith
    Next
  Next
  StopDrawing()
  FlipBuffers()
  
  For i=60 To 0 Step-1
    For j=80 To 0 Step-1
      If i And R(1)=0
        s.c = A(j,i-1)\L
        G.c = A(j,i-1)\G
        With A(j,i)
          If R(3)<>1
            L=s
          Else
            L=R(222)+33
          EndIf
          \G = G-R(1)
          If \G<1
            \G=R(250)
            \L=R(222)+33
          EndIf
        EndWith
      ElseIf i+R(1)=0
        With A(j,i)
          \L=R(222)+33
          \G=R(250)
        EndWith
      EndIf
    Next
  Next
  
  ExamineKeyboard()
Until KeyboardPushed(1)
der MessageRequester ist total überflüssig, die fehlermeldung wird zwar ausgegeben, aber das programm nicht beendet. genauso wie der Title$ = "Matrix" was man in einer vollbild anwendung, sowieso nicht sieht.

c ya,
nco2k
Alle Zeiten sind UTC+02:00
Seite 1 von 10

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de