TEXTUR-CONTEST: ZeichneTextur()

[Xaby]

Hallo Leute, ich hab mir was ausgedacht
Der Befehl ZeichneTextur() kann von jedem zwischen StartDrawing() und StopDrawing() individuell gestaltet werden.
Mathematische Funktionen, kreatives an einander Setzen von Linien, sogar die Erzeugung von Images und das Aufmalen dieser Images ist erlaubt.
Also alles, was die 2D-Drawing-Befehle und Image-Befehle hergeben.

REGELN:

- keine Bilder laden, LoadImage ist verboten
- nur PB-Befehle, damit plattform unabhängig
- Größe der Textur darf jeder selbst wählen: 32, 64, 128, 256, 512 Pixel.
- Ergebnis muss eindeutig rekonstruierbar sein (Zufall muss überall gleich sein!)
- Code sollte so klein wie möglich sein
(Sonst bindet noch jemand ein Image mit DataSection ein und nutzt Plot)

Code: Alles auswählen

;/ Folker Linstedt
;/ 2008-02-16
;/ PureBaic Textur-Contest

EnableExplicit


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512


CreateImage(0,#TextureWidth,#TextureWidth)  
CreateImage(1,1024,1024)  


Procedure ZeichneTextur()

;/ Optional 
Protected i, i2


  StartDrawing(ImageOutput(0))

     ;/ QUELLCODE: Beispiel
       For i=0 To ImageWidth(0)/5
        Box(0+5*i,0,5,20,RGB(255,128,10*i))
       Next 
       
       Circle(ImageWidth(0)/2,ImageHeight(0)/2,18,RGB(255,0,0))

     ;/

  StopDrawing()
EndProcedure

Procedure ZeichneTexturen()
Protected i, i2
  StartDrawing(ImageOutput(1))
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1
      For i=0 To ImageWidth(1)/ImageWidth(0)-1
        DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2)
      Next
    Next
  StopDrawing()
EndProcedure




Procedure createGadgets()
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border)
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10)
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border)
  
  CloseGadgetList()
EndProcedure


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0))
  
  createGadgets() 
  ZeichneTextur()
  ZeichneTexturen()
  
  SetGadgetState(0,ImageID(0))
  SetGadgetState(2,ImageID(1))
  
  
  Define Event.l, Quit, GadgetNr
  
  
  Repeat
    
    Event=WaitWindowEvent()
    
    If Event=16
      Quit=1
      
    ElseIf Event=#PB_Event_Gadget
      GadgetNr=EventGadget()    
      
      
    EndIf   
    
    
  Until Quit  
  
  
EndIf

Gepostet wird nur die Prozedure ZeichneTextur(),
aber ich denke, es sollte erlaubt sein, dass auch weitere Prozeduren dazu genommen werden, wenn diese von ZeichneTextur() aus aufgerufen werden. Allerdings zählt hier auch die Gesamt-Länge des Codes.

Externe LIBs sind verboten!



Ein Beispiel wie eine ZeichneTextur() aussehen könnte, ist im Code enthalten. Die Ergebnisse sollen natürlich um einiges "schicker" sein.

[dllfreak2001]

Hast du so eine coole Prozedur programmiert?

[Kaeru Gaman]

wetten nicht?

...das bild is garantiert woanders her.

[TomS]

Probier den Code halt aus, dann weißte's

So sieht das Ergebnis des Codes bei mir aus. http://i31.tinypic.com/2nteds4.jpg

[ZeHa]

Naja sieht ja so ähnlich aus

[STARGÅTE]

sowas in der Art?

Code: Alles auswählen

;/ Folker Linstedt 
;/ 2008-02-16 
;/ PureBaic Textur-Contest 

EnableExplicit 


#TextureWidth=128 ; Möglich 32, 64, 128, 256, 512 


CreateImage(0,#TextureWidth,#TextureWidth)  
CreateImage(1,1024,1024)  

Macro Wisch()
 F(0) = Point(x,y)
 If x > 0 : F(1) = Point(x-1,y) : Else : F(1)=F(0) : EndIf
 If y > 0 : F(2) = Point(x,y-1) : Else : F(2)=F(0) : EndIf
 If x < xx-1 : F(3) = Point(x+1,y) : Else : F(3)=F(0) : EndIf
 If y < yy-1 : F(4) = Point(x,y+1) : Else : F(4)=F(0) : EndIf
 FarbeR=0:FarbeG=0:FarbeB=0
 For i2 = 0 To 4
  FarbeR + Red(F(i2))
  FarbeG + Green(F(i2))
  FarbeB + Blue(F(i2))
 Next
 Plot(x,y, RGB(FarbeR/5, FarbeG/5, FarbeB/5))
EndMacro

Procedure ZeichneTextur() 
 Protected i, i2, xx, yy, grau, x, y,FarbeR,FarbeG,FarbeB
 Dim F(4)
  xx = ImageWidth(0)
  yy = ImageHeight(0)

  StartDrawing(ImageOutput(0)) 
  
   DrawingMode(4)
   For i = 1 To 10000
    FarbeR = 80+Sin(i/10)*80
    FarbeG = 120+Sin(i/10)*120
    FarbeB = Random(32) + 192
    Box(Random(xx)-2, Random(yy)-2, Random(9)+1, Random(9)+1, RGB(FarbeR, FarbeG,FarbeB))
   Next i
   For i = 1 To 100000
    x = Random(xx-1)
    y = Random(yy-1)
    Wisch()
   Next i

  StopDrawing() 
EndProcedure 

Procedure ZeichneTexturen() 
Protected i, i2 
  StartDrawing(ImageOutput(1)) 
    For i2=0 To ImageHeight(1)/ImageHeight(0)-1 
      For i=0 To ImageWidth(1)/ImageWidth(0)-1 
        DrawImage(ImageID(0),ImageWidth(0)*i,ImageHeight(0)*i2) 
      Next 
    Next 
  StopDrawing() 
EndProcedure 




Procedure createGadgets() 
  ImageGadget(0,5,5,ImageWidth(0),ImageHeight(0),ImageID(0),#PB_Image_Border) 
  ScrollAreaGadget(1,GadgetX(0)+GadgetWidth(0)+5,5,WindowWidth(0)-GadgetWidth(0)-15,650,1124,1124,10) 
    ImageGadget(2,5,5,ImageWidth(1),ImageHeight(1),ImageID(1),#PB_Image_Border) 
  
  CloseGadgetList() 
EndProcedure 


If OpenWindow(0,0,0,1000,700,"FL Bild",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0)) 
  
  createGadgets() 
  ZeichneTextur() 
  ZeichneTexturen() 
  
  SetGadgetState(0,ImageID(0)) 
  SetGadgetState(2,ImageID(1)) 
  
  
  Define Event.l, Quit, GadgetNr 
  
  
  Repeat 
    
    Event=WaitWindowEvent() 
    
    If Event=16 
      Quit=1 
      
    ElseIf Event=#PB_Event_Gadget 
      GadgetNr=EventGadget()    
      
      
    EndIf    
    
    
  Until Quit  
  
  
EndIf

PS: nicht wundern, das erstellen dauert etwas ^^

[Xaby]

Puh?

Ihr macht es einem auch nicht einfach.
Die Textur, die ihr hier sehen könnt, soll nur ein Beispiel sein, wie eine generierte Textur aussehen könnte.

Die habe ich nicht gemacht. Wollte aber auch nicht gleich meinen besten Texturgenerator-Code posten, damit ihr auch ein bisschen am Contest mit macht. Sonst kann ich ja auch für mich allein das machen. Soll aber nicht Sinn und Zweck der Sache sein.

@Stargate
Die Textur ist schon schick, aber Regeln nicht beachtet

- Ergebnis muss eindeutig rekonstruierbar sein (Zufall muss überall gleich sein!)

>>> Stimmt zwar, dass die Zeit, die das Generieren der Textur benötigt nicht zu den Regeln gehört, aber sollte bei der Erstellung berücksichtig werden.

Ziel: Eindrucksvolle Bilder mit wenig Code in kurzer Zeit

Du hast Random benutzt und bei jedem Start des Porgramms sieht die Textur anders aus. Das Resultat ist also vorher nicht abschätzbar.

Ich werde mal eine Prozedur zum Besten geben und ihr könnt ja dann entscheiden, ob euch die Herausforderung geällt oder nicht.

[TomS]

Oha, STARGÅTE

Geht zwar nicht ganz ineinander über, sieht aber geil aus.

[Xaby]

Achso, die Texturen müssen nicht zwangsweise in einander übergehen, ...

- es können auch Bilder, Fotos, Sprites erstellt werden
(Wobei Sprites hier als später bewegte Elemente gemeint ist)

Wenn jemand also eine Winterlandschaft oder ein Haus mit 2D-Drawing-Befehlen machen möchte, ist das auch legitim. Dazu muss die Größe auch nicht quadratisch sein.

Die Kachelung ist nur dazu gedacht, dass man halt gleich sieht, ob die "Textur" zum Kacheln geeignet wäre ... ist aber nicht Zwang.

[Kaeru Gaman]

yo, STARGÅTEs texture is kewl

das mit dem zufall läßt sich beheben.
wenn man feste startwerte nimmt, sind die texturen beliebig oft reproduzierbar.

und die zeit is doch minimal die da benötigt wird.

lediglich die unstimmigen stoßkanten stören mich,
aber das ist ja immer ein leidiges thema.

also ich finde: Stargate geht klar in Führung.