* * *    
Главная » Статьи » Код PB

Просмотров: 1933 | Дата: 25.04.2024 | Коментарии (0)

2D конкурс рисунка



2D конкурс рисунка для версии PureBasic 4.30

Code
#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, <img src="http://s106.ucoz.net/sm/1/cool.gif" border="0" align="absmiddle" alt="cool">
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, <img src="http://s106.ucoz.net/sm/1/cool.gif" border="0" align="absmiddle" alt="cool">
  If R > 255
  R = 255
  EndIf
  If G > 255
  G = 255
  EndIf
  If B > 255
  B = 255
  EndIf
  ProcedureReturn RGB(R, G, <img src="http://s106.ucoz.net/sm/1/cool.gif" border="0" align="absmiddle" alt="cool">
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










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.