PureBasic Forums - English

Posted: **Thu Apr 17, 2008 1:23 pm**

The 2D Contest

Goal, Target :

Draw a Image with pure 2D-Drawing Commands

Rules:
- Only Commands from the 2D-Commandset
(Box,Circle,DrawText,DrawingFont,DrawingMode,Ellipse,FillArea,FrontColor,Line,LineXY,Plot,Point) No dependecys

- Size of Picture is 800 x 600 pixels
- no use of external files
- Don't draw a picture completly with Plot's
- Don't publish your Code/picture in the public before the contest ends
(This is only to save you private creation and nobody copy it for his own needs)
- your filing is only valid with Sourcecode & generated picture.
- The Pictures will be presented later on the web, with your name.

The jury is:
RSBasic, almgaudi & PMTheQuick
(they do not participate this contest)

Send your creation until may, 11th. 2008
(Sourcecode and picture) to:

"pmthequick @ gmail.com"

For this time, there are 3 prices:

2 year free webspace with subdomains,email,msql, php
, no traffic-limit and no advertising.

First price:
1 gb space
5 Subdomans
20 emails
2 MySQL databases
3 FTP-Accounts

Second one:
0.5 gb space
2 Subdomans
10 emails
2 MySQL databases
2 FTP-Accounts

Third:
0.25 gb space
1 Subdomans
5 emails
1 MySQL databases
1 FTP-Accounts

If you have more questions, ask here:

(quickly translated by Rings)

Posted: **Thu Apr 17, 2008 1:29 pm**

just a template :

Code: Select all

Procedure Make2DGFX(ImageNR)
    StartDrawing(ImageOutput(ImageNR))
   
    ;- go on here:
   
   
    ;this is just an example
    For k=0 To 255
      FrontColor(RGB(100,50, k))
      Line(0, k, 800, 0)
    Next
    For k=0 To 255
      Line(0, 600 - k, 800, 0,RGB(100,k, 100))
    Next
   
    DrawingMode(1)
    FrontColor(RGB(255,255,255)) ; print the text to white !
    DrawText(280, 300, "2D Drawing Contest Image")
   
   
    ;-until here
    StopDrawing()
EndProcedure

#win=0
#ImageGadget=0
#Image=0
If OpenWindow(#win, 0, 0, 800, 600, "PureBasic - 2D Image Contest")
    If CreateGadgetList(WindowID(#win))
     id=CreateImage(#Image, 800, 600)
     Make2DGFX(#Image)
     ImageGadget(#ImageGadget, 0, 0, 800, 600, ImageID(#Image))
     Repeat
      EventID = WaitWindowEvent()
     Until EventID = #PB_Event_CloseWindow  ;
     Programname.s=GetFilePart(ProgramFilename())
     SaveImage(#Image,Left(Programname,Len(Programname)-3) + "bmp") ;we save our image as bitmap
    EndIf
EndIf
End

Posted: **Fri Apr 18, 2008 1:31 am**

just a few questions...

is there a particular object you'd like the image to be of, or are we free to produce an image of anything?

you say only 2DDrawing commands... what about DrawImage() and DrawingBuffer(), or are we limited to the basic commands?

what asthetic properties are the images to be judged on?

Posted: **Fri Apr 18, 2008 2:25 am**

DrawImage is allowed to reproduce on-the-fly created parts.
Data import is forbidden, neither as a file, nor as a DataSection.

DrawingBuffer...
to make your internal formulas faster? no problem.

@Rings
did PMtQ not provide an updated version of the rules for you to translate?

DOH...
he couldn't update it... the original thread is locked...
my fault... but RSB could also have reopened it...

Posted: **Fri Apr 18, 2008 11:39 am**

hehe! it is very interesting imo. Besides it is fully art, it reminds me to the MSX Basic times.
If i get a bit of time i would participate.

Posted: **Fri Apr 18, 2008 2:20 pm**

Can we submit multiple programs/pictures?

Edit: What is the judging criteria?

Posted: **Fri Apr 18, 2008 2:49 pm**

Yes you can submit multiple programs/pictures.

Greetings
PMTheQuick

EDIT: The judging criteria is the Picture and the Sourcecode. Also all.

Posted: **Sun May 11, 2008 12:50 pm**

CONTEST IS ALREADY BEEN TERMINATED 12 CLOCK
Sodala, the contest is over. Have 9 entries. The jury is soon finished with evaluate. Then I take the winning side online and contact the winner!

Greetings
PMTheQuick

Posted: **Sun May 11, 2008 7:08 pm**

Hi dear community,

the jury has voted in a draw. Again many thanks to the jury (RSBasic, almgaudi & I) In addition, thank you, to all who have joined, even if they are worse off, hauptsache you are!
Here are the winning side: http://q-soft.ch/?site=2dcontest
Congratulations to all winners!

You can now also discuss to what you want to say Contest etc ^ ^ still be beautiful day,

Greetings
PMTheQuick

Posted: **Sun May 11, 2008 7:20 pm**

Ha! I'm among the top ten!

Posted: **Sun May 11, 2008 7:53 pm**

Wow

Some incredible stuff there. Hats off to the competitors.

cheers

Posted: **Sun May 11, 2008 9:44 pm**

Here's mine. Unfortunately I couldn't send it in, because they stopped accepting submissions 12 hours before what I thought was the deadline. :roll:

Code: Select all

#TS = 48 ; Tile size

Procedure Mix(Col1, Col2, Alpha)
    R = Red(Col1)
    B = Blue(Col1)
    G = Green(Col1)
    
    R2 = Red(Col2)
    B2 = Blue(Col2)
    G2 = Green(Col2)
    
    R = ((R*Alpha)/255) + ((R2*(255-Alpha)) / 255)
    G = ((G*Alpha)/255) + ((G2*(255-Alpha)) / 255)
    B = ((B*Alpha)/255) + ((B2*(255-Alpha)) / 255)
    
  ProcedureReturn RGB(R, G, B)
EndProcedure

Procedure PlotA(X, Y, Col, Alpha)
  If X >= 0 And Y >= 0
    Plot(X, Y, Mix(Col, Point(X, Y), Alpha))
  EndIf
EndProcedure

Procedure LineXA(X, Y, Width, Col, Alpha)
  Width + X
  For X = X To Width-1
    PlotA(X, Y, Col, Alpha)
  Next
EndProcedure

Procedure LineYA(X, Y, Height, Col, Alpha)
  Height + Y
  For Y = Y To Height-1
    PlotA(X, Y, Col, Alpha)
  Next
EndProcedure

Procedure DrawSky()
  For I = 0 To 600
    C = 255-(i*0.2)
    C = RGB(C-20, C-40, C)
    Line(0, I, 800, 0, C)
  Next
EndProcedure

Procedure DrawCloud(BX, BY, Width, Height, ClumpSize, Seed, Color=#White)
  RandomSeed(Seed)
  For I = 0 To Width*0.6
    YO = Random(Height*2)
    If YO > Height
      YO - (YO-Height)
    EndIf
    Circle(BX+Random(Width), BY+YO, Random(ClumpSize), Color)
  Next
EndProcedure

Procedure DrawClouds()
  DrawCloud(-60, 80,  200,  60, 20, 2345678)
  DrawCloud(100, 280, 50,   10, 8, 17698, RGB(220, 200, 255))
  DrawCloud(300, 80,  50,   10, 8, 17611, RGB(245, 245, 255))
  DrawCloud(400, 100, 200,  60, 20, 176695)
  DrawCloud(750, 180, 200,  30, 10, 176695)
  DrawCloud(150, 180, 200,  30, 10, 176704, RGB(220, 200, 255))
EndProcedure

Procedure MRGB(R, G, B)
  If R > 255
    R = 255
  EndIf
  If G > 255
    G = 255
  EndIf
  If B > 255
    B = 255
  EndIf
  ProcedureReturn RGB(R, G, B)
EndProcedure

Procedure Algo1FillArea(X, Y, CX, CY, Col, Stretch)
  RandomSeed(12349)
  X*#TS
  Y*#TS
  CX*#TS
  CY*#TS
  R = Red(Col)
  B = Blue(Col)
  G = Green(Col)
  For I = 0 To CX-1
    Rnd = Random(Stretch)+1
    For J = 0 To CY-1
      Col = MRGB(R+(I+J)%Rnd, G+(I+J)%Rnd, B+(I+J)%Rnd)
      Plot(X+I, Y+J, Col)
    Next
  Next
EndProcedure

Procedure Algo2FillArea(X, Y, CX, CY, Col)
  RandomSeed(1235)
  X*#TS
  Y*#TS
  CX*#TS
  CY*#TS
  R = Red(Col)
  B = Blue(Col)
  G = Green(Col)
  Box(X, Y, CX, CY, Col)
  C1 = #White
  C2 = #Black
  For I = 1 To CX-1
    For J = 1 To CY-1
      If Random(1) = 0
        PlotA(X+I, Y+J, C1, 32)
        PlotA(X+I-1, Y+J-1, C2, 32)
        Swap C1, C2
      EndIf
    Next
  Next
EndProcedure

Procedure Border(X, Y, CX, CY)
  X*#TS
  Y*#TS
  CX*#TS
  CY*#TS
  LineXA(X, Y, CX, #White, 100)
  LineXA(X, Y+CY-1, CX, #Black, 100)
  
  LineYA(X, Y, CY, #White, 100)
  LineYA(X+CX-1, Y, CY, #Black, 100)
EndProcedure



Procedure Block(X, Y, CX, CY, Col)
  Algo2FillArea(X, Y, CX, CY, Col)
  Border(X, Y, CX, CY)
EndProcedure

Procedure Tube(X, Y, CY)
  X * #TS
  Y * #TS
  CY * #TS
  CX = #TS*2
  TopH = #TS/1.5
  IX = 6
  G1 = RGB(120, 220, 50)
  G2 = RGB(50, 125, 30)
  Box(X+IX, Y, CX-IX*2, CY, G2)
  LineYA(X+IX, Y, CY, 0, 192)
  LineYA(X+CX-IX, Y, CY, 0, 192)
  Box(X, Y, CX, TopH, Mix(0, G1, 192))
  Box(X+1, Y+1, CX-2, TopH-2, G2)
  Line(X+1, Y+1, CX-2, 0, G1)
  
  ; Gloss
  I = 6
  Box(X+I-3, Y+2, 1, TopH-2, G1)
  Box(X+I, Y+2, 2, TopH-2, G1)
  Box(X+I+5, Y+2, 5, TopH-2, G1)
  Box(X+I+15, Y+2, 2, TopH-2, G1)
  
  I + IX
  Box(X+I-3, Y+TopH, 1, CY-TopH, G1)
  Box(X+I, Y+TopH, 2, CY-TopH, G1)
  Box(X+I+5, Y+TopH, 5, CY-TopH, G1)
  Box(X+I+15, Y+TopH, 2, CY-TopH, G1)
  
  I = #TS+9
  Box(X+I, Y+2, 2, TopH-2, G1)
  I - 2
  Box(X+I, Y+TopH, 2, CY-TopH, G1)
  
  ; Inverse gloss
  S = Mix(0, G1, 192)
  I + 14
  Box(X+I, Y+2, 1, TopH-2, S)
  Box(X+I+6, Y+2, 2, TopH-2, S)
  Box(X+I+11, Y+2, 7, TopH-2, S)
  Box(X+CX-7, Y+2, 5, TopH-2, S)
  
  I - IX
  Box(X+I+1, Y+TopH, 1, CY-TopH, S)
  Box(X+I+6, Y+TopH, 2, CY-TopH, S)
  Box(X+I+11, Y+TopH, 7, CY-TopH, S)
  Box(X+I+20, Y+TopH, 6, CY-TopH, S)
  
  ; Top shadow
  Box(X, Y+TopH-5, CX, 5, 0)
EndProcedure

Procedure DrawTubes()
  Tube(14, 7, 2)
  Tube(8, 4, 1)
EndProcedure

Procedure DrawBlocks()
  Stone = RGB(130, 140, 150)
  Wood = RGB(170, 120, 60)
  Block(-1, 9, 5, 1, Stone)
  Block(8, 5, 3, 1, Wood)
  Block(7, 9, 2, 1, Stone)
  Block(14, 9, 3, 1, Wood)
EndProcedure

Procedure DrawWater()
  Water = RGB(50, 180, 255)
  Algo1FillArea(9, 9, 5, 4, Water, 70)
  For I = 0 To 25
    LineXA(9*#TS, 9*#TS+I, 5*#TS, #White, Pow((25-I)/1.7, 2))
  Next
EndProcedure

Procedure DoDraw()
  CreateImage(0, 800, 600, 32)
  StartDrawing(ImageOutput(0))
    DrawSky()
    DrawClouds()
    DrawWater()
    DrawBlocks()
    DrawTubes()
  StopDrawing()
EndProcedure

OpenWindow(0, 0, 0, 816, 616, "", #PB_Window_ScreenCentered | #PB_Window_BorderLess)
CreateGadgetList(WindowID(0))
SetWindowColor(0, #Black)
DoDraw()
ImageGadget(0, 8, 8, 0, 0, ImageID(0))


Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow, #WM_CHAR
      Break
  EndSelect
ForEver

Posted: **Sun May 11, 2008 9:52 pm**

Incredible Trond

But i guess it must be a boring hard work to do that...

Posted: **Sun May 25, 2008 4:19 pm**

@Trond
Mario 4ever!

Posted: **Mon Aug 17, 2009 11:19 pm**

@Trond

Very beautiful code!
Bravo!

Ollivier