PureGolf mit Scrollender Matrix

Hier kann alles mögliche diskutiert werden. Themen zu Purebasic sind hier erwünscht.
Flames und Spam kommen ungefragt in den Mülleimer.
Antworten
Benutzeravatar
AndyX
Beiträge: 1272
Registriert: 17.12.2004 20:10
Wohnort: Niederösterreich
Kontaktdaten:
Kontaktdaten von AndyX

PureGolf mit Scrollender Matrix

Beitrag 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:
Nach oben
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:
Kontaktdaten von Batze

Beitrag 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
Zuletzt geändert von Batze am 09.02.2006 17:17, insgesamt 2-mal geändert.
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Nach oben
Benutzeravatar
freedimension
Admin
Beiträge: 1987
Registriert: 08.09.2004 13:19
Wohnort: Ludwigsburg
Kontaktdaten:
Kontaktdaten von freedimension

Beitrag von freedimension »

Sind Strings auch dann Taboo wenn sie selbst im Original keinen Sinn ergeben? :D
Beginne jeden Tag als ob es Absicht wäre!
Bild
BILDblog
Nach oben
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:
Kontaktdaten von Batze

Beitrag von Batze »

Hab ich auch gedacht als ich das gelesen hab. :freak:
Wollte erst durch einen gleichlangen String ersetzen, habs aber dann gelassen.
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Nach oben
Benutzeravatar
Eric
Beiträge: 303
Registriert: 05.09.2004 09:50
Wohnort: Göttingen

Beitrag 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
El_Choni_work: cant't you just spit the binary data to sqlite, as you would spit a hamster into a microwave oven?
* Fangles falls off the chair laughing
Bild
Nach oben
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:
Kontaktdaten von Batze

Beitrag 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
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Nach oben
Benutzeravatar
Eric
Beiträge: 303
Registriert: 05.09.2004 09:50
Wohnort: Göttingen

Beitrag 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
El_Choni_work: cant't you just spit the binary data to sqlite, as you would spit a hamster into a microwave oven?
* Fangles falls off the chair laughing
Bild
Nach oben
Benutzeravatar
Batze
Beiträge: 1492
Registriert: 03.06.2005 21:58
Wohnort: Berlin
Kontaktdaten:
Kontaktdaten von Batze

Beitrag 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
Hier sind meine Codes (aber die Seite geht gerade nicht):
http://www.basicpure.de.vu
Nach oben
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8807
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 64 GB DDR4-3200
Ubuntu 24.04.2 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken

Beitrag 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.
Nach oben
Benutzeravatar
nco2k
Beiträge: 892
Registriert: 08.09.2004 23:13

Beitrag 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
~|__/
..o.o.. <--- This is Einkaufswagen. Copy Einkaufswagen into your signature to help him on his way to world domination.
Nach oben
Antworten

Zurück zu „Offtopic“