Author Topic: XMas tree for purebasic 4.0  (Read 405 times)

0 Members and 1 Guest are viewing this topic.

Offline benny!

  • Senior Member
  • DBF Aficionado
  • ********
  • Posts: 4130
  • Karma: 223
  • in this place forever!
    • View Profile
    • bennyschuetz.com - mycroBlog
XMas tree for purebasic 4.0
« on: February 28, 2007 »


Hi.

Today I converted some old code ( december 2oo4 ) to the actual version
of purebasic. Furthermore, the old code needs some 3rd party opengl user
library. The new code doesnt. You can compile it with the current version
of PureBasic V4.0.

Code: [Select]

;##################################
;##  XMas Tree in some kilobytes
;##           for the
;##     Pure Winter Contest
;##          Dec.2004
;##             by
;##  benny^weltenkonstrukteur.de
;##
;## Note:
;## This was done in quite a hurry
;## (1 afternoon). In addition I am
;## suffering from a glue. So excuse
;## buggy code.
;##
;## Anyway,
;##
;##  Merry X-Mas And a Happy New Year!
;##


;## Converted to PB4.0 on 28.Feb.2007

XIncludeFile "OpenGL.pb"

;##################################
;## Constants, Globals ...

Import "glu32.lib"
 gluPerspective(fovy.d,aspect.d,zNear.d,zFar.d) ;sets up a perspective projection matrix
 gluLookAt(eyex.d,eyey.d,eyez.d,centerx.d,centery.d,centerz.d,upx.d,upy.d,upz.d) ;defines a viewing transformation
EndImport


Declare InitSnow(snowflake.l)

Structure SnowFlake
  state.l ; 0 = Snowing / alive
          ; 1 = Dying / on ground 
  transX.f
  transY.f
  transZ.f
  downZ.f
  color.f
EndStructure

#WindowWidth = 640
#WindowHeight = 480
#numFLAKES = 200

Global hWnd.l

Dim Flakes.SnowFlake(#numFLAKES)
For z=0 To #numFLAKES-1
  InitSnow(z)
Next z

Procedure WindowCallback(Window,Message,wParam,lParam)
  Static small
  Select Message
    Case #WM_SIZE
      If small = 1
        glViewport_(0, 0, GetSystemMetrics_(#SM_CXSCREEN) , GetSystemMetrics_(#SM_CYSCREEN) )
        small = 0
      Else
        glViewport_(0, 0, #WindowWidth , #WindowHeight )
        small = 1
      EndIf
      Result = DefWindowProc_(Window,Message,wParam,lParam)
    Case #WM_DESTROY
      DestroyWindow_(Window)
      PostQuitMessage_(0)
      End
      ProcedureReturn 0
    Default
      Result = DefWindowProc_(Window,Message,wParam,lParam)
  EndSelect
  ProcedureReturn Result
EndProcedure


Procedure InitSnow(snowflake.l)
  Shared Flakes()
  Flakes(snowflake)\state = 0
  Flakes(snowflake)\transX = 1.0 - (Random(20) / 10)
  Flakes(snowflake)\transY = 1.0 - (Random(20) / 10)
  Flakes(snowflake)\transZ = 2.4 + Random(2)
  Flakes(snowflake)\downZ  = Random(10) / 1000 + 0.004
  Flakes(snowflake)\color  = 0.8
EndProcedure
 
;##################################
;## Setting the whole thing up.

#Style   = #WS_VISIBLE | #WS_SYSMENU | #WS_MAXIMIZEBOX
#StyleEx = #WS_EX_OVERLAPPEDWINDOW

WindowClass.s = "MeinFenster"
wc.WNDCLASSEX
wc\cbSize        = SizeOf(WNDCLASSEX)
wc\lpfnWndProc   = @WindowCallback()
wc\lpszClassName = @WindowClass
RegisterClassEx_(@wc)

hWnd = CreateWindowEx_( #StyleEx,WindowClass,"xmas tree in 4kb ;-) | pure winter contest 2oo4 entry by benny",#Style,200,200,640,480,0,0,0,0)

pfd.PIXELFORMATDESCRIPTOR
hDC = GetDC_(hWnd)
pfd\nSize        = SizeOf(PIXELFORMATDESCRIPTOR)
pfd\nVersion     = 1
pfd\dwFlags      = #PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER | #PFD_DRAW_TO_WINDOW
pfd\iLayerType   = #PFD_MAIN_PLANE
pfd\iPixelType   = #PFD_TYPE_RGBA
pfd\cColorBits   = 24  ;Colorbuffer
pfd\cDepthBits   = 32  ;Depthbuffer
pfd\cAlphaBits  = 1
pixformat = ChoosePixelFormat_(hDC, pfd)
SetPixelFormat_(hDC, pixformat, pfd)
hrc = wglCreateContext_(hDC)
wglMakeCurrent_(hDC, hrc)

SwapBuffers_(hDC)
glShadeModel_(#GL_SMOOTH)
glClearColor_(0.1, 0.1, 0.2, 0.1) ;Background color

glMatrixMode_(#GL_PROJECTION)
glLoadIdentity_()
;gluPerspectivef_(50.0, 640/480, 0.1, 100.0)
gluPerspective(50.0, 640/480, 0.1, 100.0)
gluLookAt(0.0, -0.3, 0.2, 0.0, 0.0, -0.6, 0.0, 1.0, 0.0)
glMatrixMode_(#GL_MODELVIEW)

glEnable_(#GL_BLEND)
glDisable_(#GL_DEPTH_TEST)
glBlendFunc_(#GL_SRC_ALPHA, #GL_ONE)

;##################################
;## Main Loop

;Repeat
!l_mainloop:
 
  If (PeekMessage_(msg.MSG, #Null, 0, 0, #PM_REMOVE))
      TranslateMessage_(msg)
      DispatchMessage_(msg)
  Else

  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
     
  glLoadIdentity_() ; Reset Plotter
  glTranslatef_(0.0, 0.0, -4.0) ; Move Plotter
  glRotatef_(65.0, -1.0, 0.0, 0.0)
  glRotatef_(rot.f, 0.0, 0.0, 1.0)
 
  glBegin_(#GL_LINES)
  ;Grid
    glColor4f_(0.8, 0.8, 1.0, 0.8)
    For x = -10 To 10 Step 2
      tx.f = x / 10
      glVertex3f_ (1.0, tx.f, 0.0)
      glVertex3f_ (-1.0, tx.f, 0.0)
    Next x
    For x = -10 To 10 Step 2
      tx.f = x / 10
      glVertex3f_ (tx.f, 1.0, 0.0)
      glVertex3f_ (tx.f, -1.0, 0.0)
    Next x
  glEnd_()
   
  ;Tree
  glBegin_(#GL_TRIANGLES)
    glColor4f_(0.0, 0.8, 0.0, 0.25)
    glVertex3f_(0.0, 0.0, 1.4)
    glVertex3f_(-0.8, 0.0 , 0.0)
    glVertex3f_(0.8, 0.0, 0.0)
     
    glVertex3f_(0.0, 0.0, 1.4)
    glVertex3f_(-0.5, -0.5, 0.0)
    glVertex3f_(0.5, 0.5, 0.0)
     
    glVertex3f_(0.0, 0.0, 1.4)
    glVertex3f_(-0.5, 0.5, 0.0)
    glVertex3f_(0.5, -0.5, 0.0)
  glEnd_()
   
   ;SnowFlake
  For z = 0 To #numFLAKES-1
    Flakes(z)\transZ - Flakes(z)\downZ
    If Flakes(z)\transZ <=0.0
      Flakes(z)\transZ = 0.0
      Flakes(z)\state = 1   ; dying
    EndIf
    If Flakes(z)\state = 1
      Flakes(z)\color - 0.01
      If Flakes(z)\color < 0.00
        InitSnow(z)
      EndIf
    EndIf
    glTranslatef_(Flakes(z)\transX, Flakes(z)\transY, Flakes(z)\transZ)
       glBegin_(#GL_LINES)
        glColor4f_(1.0, 1.0, 1.0, Flakes(z)\color)
        glVertex3f_(0.01, 0.01, 0.0)
        glVertex3f_(-0.01, -0.01, 0.0)
        glVertex3f_(0.01, -0.01, 0.0)
        glVertex3f_(-0.01, 0.01, 0.0)
        glVertex3f_(-0.01, 0.01, 0.0)
        glVertex3f_(0.01, -0.01, 0.0)
        glVertex3f_(0.0, 0.01, 0.01)
        glVertex3f_(0.0, -0.01, -0.01)
        glVertex3f_(-0.01, 0.0, -0.01)
        glVertex3f_(0.01, 0.0, 0.01)       
        glEnd_()
        glTranslatef_(Flakes(z)\transX*(-1), Flakes(z)\transY*(-1), Flakes(z)\transZ*(-1))
    Next z
   
    SwapBuffers_(hDC)
     
  rot.f + 0.6
  Delay(1)
EndIf

;Until finished = 10
!JMP l_mainloop

End

[ mycroBLOG - POUET :: whatever keeps us longing - for another breath of air - is getting rare ]

Challenge Trophies Won: