PureBasic

Code : Tout sélectionner

Structure vector3
  x.f
  y.f
  z.f
EndStructure
; 
; struct v
; {
; f x,y,z;
; v operator+(v r){Return v(x+r.x,y+r.y,z+r.z);}
; v operator*(f r){Return v(x*r,y*r,z*r)      ;}
; f operator%(v r){Return x*r.x+y*r.y+z*r.z   ;}
; v(){}
; v operator^(v r){Return v(y*r.z-z*r.y,z*r.x-x*r.z,x*r.y-y*r.x);}
; v(f a,f b,f c){x=a;y=b;z=c;}
; v operator!(){Return*this*(1/sqrt(*this%*this))               ;}
; } 

;
Global Dim G(8)
G(0) = 247570
G(1) = 280596
G(2) = 280600
G(3) = 249748
G(4) = 18578
G(5) = 18577
G(6) = 231184
G(7) = 16
G(8) = 16
; 

Procedure.f length2(*v.vector3) 
  ProcedureReturn *v\x * *v\x + *v\y * *v\y + *v\z * *v\z
EndProcedure

Procedure.f Mul(*v.vector3, *t.vector3) 
  ProcedureReturn *v\x * *t\x + *v\y * *t\y + *v\z * *t\z
EndProcedure

Procedure normalize(*v.vector3) 
  nor2.f = length2(*v) 
  If (nor2 > 0)  
    invNor.f = 1.0 / Sqr(nor2) 
    *v\x * invNor
    *v\y * invNor
    *v\z * invNor 
  EndIf 
EndProcedure

Procedure.f R()
  ProcedureReturn Random(1000)/1000
EndProcedure  

Procedure cross(*w.vector3, *v.vector3, *r.vector3)
  *w\x = *v\y * *r\z - *v\z * *r\y
  *w\y = *v\z * *r\x - *v\x * *r\z
  *w\z = *v\x * *r\y - *v\y * *r\x
EndProcedure


;The intersection test For line [o,v].
; Return 2 If a hit was found (And also Return distance t And bouncing ray n).
; Return 0 If no hit was found but ray goes upward
; Return 1 If no hit was found but ray goes downward
Procedure T(*o.vector3,*d.vector3,*t.Float,*n.vector3) 
  *t\f=1e9
  m=0
  p1.f=-*o\z/*d\z
  If 0.01<p1
    *t\f=p1
    *n\x=0
    *n\y=0
    *n\z=1
    m=1
  EndIf
  
  ;The world is encoded in G, With 9 lines And 19 columns
  For k=18 To 0 Step -1 ;For each columns of objects
    For j=8 To 0 Step -1;For each line on that columns
      
      If(G(j)&(1<<k)) ;//For this line j, is there a sphere at column i ?
        
        ; There is a sphere but does the ray hits it ?
        
        p.vector3
        p\x=*o\x -k
        p\y=*o\y 
        p\z=*o\z-j-4
        
        
        b.f=Mul(@p,*d)
        c.f=Mul(@p,@p)-1
        q.f=b*b-c
        
        ;Does the ray hit the sphere ?
        If q>0
          ;It does, compute the distance camera-sphere
          s.f=-b-Sqr(q)
          
          If s<*t\f And s>0.01
            ; So far this is the minimum distance, save it. And also
            ; compute the bouncing ray vector into 'n'  
            *t\f=s
            *n\x=p\x+*d\x*s
            *n\y=p\y+*d\y*s
            *n\z=p\z+*d\z*s
            
            normalize(*n)
            m=2
          EndIf  
        EndIf
      EndIf
    Next
  Next
  ProcedureReturn m
EndProcedure

; (S)ample the world And Return the pixel color For
; a ray passing by point o (Origin) And d (Direction)
Procedure S(*w.vector3, *o.vector3, *d.vector3)
  t.f
  n.vector3
  
  ;Search For an intersection ray Vs World.
  m=T(*o,*d,@t,@n)
  
  If m=0
    ;No sphere found And the ray goes upward: Generate a sky color  
    *w\x = 0.7 * Pow(1-*d\z,4)
    *w\y = 0.6 * Pow(1-*d\z,4)
    *w\z =   1 * Pow(1-*d\z,4)
    
    ProcedureReturn  
  EndIf
  
  ; sphere was maybe hit.
  h.vector3  ; h = intersection coordinate
  l.vector3  ; 'l' = direction To light (random delta For shadows).
  r.vector3  ; r = The half-vector
  
  h\x=*o\x+*d\x*t                    
  h\y=*o\y+*d\y*t  
  h\z=*o\z+*d\z*t  
  
  l\x=9+R()+h\x*-1
  l\y=9+R()+h\y*-1
  l\z=16+h\z*-1  
  normalize(@l)
  r\x=*d\x+n\x*(mul(@n,*d)*-2)               
  r\y=*d\y+n\y*(mul(@n,*d)*-2) 
  r\z=*d\z+n\z*(mul(@n,*d)*-2) 
  
  ;Calculated the lambertian factor
  b.f=mul(@l,@n)
  
  ;Calculate illumination factor (lambertian coefficient > 0 Or in shadow)?
  If b<0 Or T(@h,@l,@t,@n)
    b=0
  EndIf
  
  ; Calculate the color 'p' With diffuse And specular component 
  p.f=Pow(mul(@l,@r)*Bool(b>0),99)
  
  If m=1   ;m == 1
    h\x=h\x*0.2; //No sphere was hit and the ray was going downward: Generate a floor color
    h\y=h\y*0.2
    h\z=h\z*0.2
    
    ii.i = Int(Round(h\y,#PB_Round_Nearest))&1
    
    If Round(h\x,#PB_Round_Nearest)+ ii
      *w\x = 3
      *w\y = 1
      *w\z = 1
    Else  
      *w\x = 3*(b*0.2+0.1)
      *w\y = 3*(b*0.2+0.1)
      *w\z = 3*(b*0.2+0.1)
    EndIf  
    ProcedureReturn
  EndIf
  
  ;m == 2 A sphere was hit. Cast an ray bouncing from the sphere surface.
  S(*w,@h,@r)
  ww.vector3
  ww\x = p
  ww\y = p
  ww\z = p
  *w\x = ww\x + *w\x*0.5 ; //Attenuate color by 50% since it is bouncing (* .5)
  *w\y = ww\x + *w\y*0.5
  *w\z = ww\z + *w\z*0.5
  ProcedureReturn 
EndProcedure


; The main function. It generates a PPM image To stdout.
; Usage of the program is hence: ./card > erk.ppm
Procedure main()
  
  ; The '!' are For normalizing each vectors With ! operator. 
  Protected.vector3 g,a,b,c,p,pc,t,q
  ;Camera direction
  g\x =-6
  g\y = -16
  g\z = 0 
  normalize(@g)
  ; Camera up vector...Seem Z is pointing up :/ WTF !
  q\x = 0
  q\y = 0
  q\z = 1
  
  cross(@a, @q, @g)
  normalize(@a)
  a\x *0.002 
  a\y *0.002 
  a\z *0.002   
  ; The right vector, obtained via traditional cross-product
  cross(@b,@g,@a)
  normalize(@b)
  b\x *0.002 
  b\y *0.002 
  b\z *0.002 
  ; WTF ? See https://news.ycombinator.com/item?id=6425965.
  c\x=(a\x+b\x)*-256+g\x      
  c\y=(a\y+b\y)*-256+g\y  
  c\z=(a\x+b\z)*-256+g\z  
  
  For y=511 To 0  Step -1 ;For each column
    For x=511 To 0 Step -1;For each pixel in a line
      
      ;Reuse the vector class To store Not XYZ but a RGB pixel color
      ; Default pixel color is almost pitch black
      pc\x = 255    
      pc\y = 255 
      pc\z = 255 
      ;Cast 64 rays per pixel (For blur (stochastic sampling) And soft-shadows. 
      For r=63 To 0 Step -1 
        
        ; The delta To apply To the origin of the view (For Depth of View blur).
        t\x=a\x*(R()-0.5)*99+b\x*(R()-0.5)*99;  A little bit of delta 
        t\y=a\y*(R()-0.5)*99+b\y*(R()-0.5)*99;  A little bit of delta 
        t\z=a\z*(R()-0.5)*99+b\z*(R()-0.5)*99;  A little bit of delta 
        
        ; Set the camera focal point v(17,16,8) And Cast the ray 
        ; Accumulate the color returned in the p variable
        q.vector3 ;Ray Origin
        q\x = 17 + t\x
        q\y = 16 + t\y
        q\z =  8 + t\z
        w.vector3 ; Ray Direction With random deltas, For stochastic sampling
        w\x = t\x*-1+(a\x*(R()+x)+b\x*(y+R())+c\x)*16
        w\y = t\y*-1+(a\y*(R()+x)+b\y*(y+R())+c\y)*16
        w\z = t\z*-1+(a\z*(R()+x)+b\z*(y+R())+c\z)*16
        normalize(@w)
        S(@p,@q,@w)
        p\x=p\x*3.5+pc\x; // +p for color accumulation
        p\y=p\y*3.5+pc\y
        p\z=p\z*3.5+pc\z
      Next
      
      Plot(511-x,511-y, RGB(p\x,p\y,p\z))
      
      
    Next
  Next  
EndProcedure


If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Error", "Can't open the sprite system", 0)
  End
EndIf

If OpenWindow(0, 0, 0, 512, 512, "Gadget and sprites!", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  
  If OpenWindowedScreen(WindowID(0), 0, 0, 512, 512, 0, 0, 0)
    
    CreateSprite(0,512, 512)
    StartDrawing(SpriteOutput(0))
    main()
    StopDrawing()
    
    ReleaseMouse(1)
    Repeat
      Repeat
        ; Always process all the events to flush the queue at every frame
        Event = WindowEvent()
        
        Select Event
          Case #PB_Event_CloseWindow
            Quit = 1
            
            
        EndSelect
        
      Until Event = 0 ; Quit the event loop only when no more events are available
      
      ExamineKeyboard()
      
      
      ExamineMouse()
      
      ; Clear the screen and draw our sprites
      ClearScreen(RGB(0,0,0))
      
      DisplaySprite(0,0, 0)
      
      FlipBuffers()       ; Inverse the buffers (the back become the front (visible)... and we can do the rendering on the back
      
    Until  Quit Or KeyboardPushed(#PB_Key_Escape)
  Else
    MessageRequester("Error", "Can't open windowed screen!", 0)
  EndIf
EndIf