PureBasic

Code : Tout sélectionner

#PBdir = "c:\program files\purebasic\"



Structure texture8
   larj.l
   htr.l
   pix.l
EndStructure

Procedure.l charjtexture8(*txt.texture8,nom$)
   img=LoadImage(#pb_any,nom$)
   If img
      larj=ImageWidth()
      htr=ImageHeight()
      If StartDrawing(ImageOutput())
         *pix.byte=AllocateMemory(larj*htr)
         If *pix
            *txt\larj=larj
            *txt\htr=htr
            *txt\pix=*pix
            valret=1
            For y=0 To htr-1 : For x=0 To larj-1
               *pix\b=Point(x,y)
               *pix+1
            Next : Next
         EndIf
      StopDrawing() : EndIf
      FreeImage(img)
   EndIf
   ProcedureReturn valret
EndProcedure

Procedure pastetex(*src.texture8,*dst.texture8,x,y)
   addrsrc=*src\pix
   larjsrc=*src\larj
   htrsrc=*src\htr
   pitchsrc=larjsrc
   If x+larjsrc>*dst\larj
      larjsrc=*dst\larj-x
      If larjsrc<=0 : ProcedureReturn : EndIf
   EndIf
   If x<0
      corrx=-x
      x=0
      If corrx>=larjsrc : ProcedureReturn : EndIf
      addrsrc+corrx
      larjsrc-corrx
   EndIf
   If y+htrsrc>*dst\htr
      htrsrc=*dst\htr-y
      If htrsrc<=0 : ProcedureReturn : EndIf
   EndIf
   If y<0
      corry=-y
      y=0
      If corry>=htrsrc : ProcedureReturn : EndIf
      addrsrc+(corry*pitchsrc)
      htrsrc-corry
   EndIf
   pitchdst=*dst\larj
   addrdst=*dst\pix+x+y*pitchdst
   Repeat
      CopyMemory(addrsrc,addrdst,larjsrc)
      addrsrc+pitchsrc
      addrdst+pitchdst
      htrsrc-1
   Until htrsrc=0
EndProcedure

Procedure subbar(*src.byte,*dst.byte,len)
   While len
      *dst\b+128-*src\b
      *dst+1
      *src+1
      len-1
   Wend
EndProcedure

Procedure subtex(*src.texture8,*dst.texture8,x,y)
   addrsrc=*src\pix
   larjsrc=*src\larj
   htrsrc=*src\htr
   pitchsrc=larjsrc
   If x+larjsrc>*dst\larj
      larjsrc=*dst\larj-x
      If larjsrc<=0 : ProcedureReturn : EndIf
   EndIf
   If x<0
      corrx=-x
      x=0
      If corrx>=larjsrc : ProcedureReturn : EndIf
      addrsrc+corrx
      larjsrc-corrx
   EndIf
   If y+htrsrc>*dst\htr
      htrsrc=*dst\htr-y
      If htrsrc<=0 : ProcedureReturn : EndIf
   EndIf
   If y<0
      corry=-y
      y=0
      If corry>=htrsrc : ProcedureReturn : EndIf
      addrsrc+(corry*pitchsrc)
      htrsrc-corry
   EndIf
   pitchdst=*dst\larj
   addrdst=*dst\pix+x+y*pitchdst
   Repeat
      subbar(addrsrc,addrdst,larjsrc)
      addrsrc+pitchsrc
      addrdst+pitchdst
      htrsrc-1
   Until htrsrc=0
EndProcedure




;>test

UsePNGImageDecoder()

DefType.texture8 bumpy,vscr

vscr\larj=640
vscr\htr=480
vscr\pix=AllocateMemory(640*480)
charjtexture8(@bumpy,#PBdir+"examples\sources\data\terrain.png")


InitSprite()
InitPalette()
InitKeyboard()
InitMouse()

OpenScreen(640,480,8,"")

CreatePalette(0)
For c=0 To 255
   SetPaletteColor(c,RGB(c,c,c))
Next
DisplayPalette(0)



Repeat
   ExamineKeyboard() : ExamineMouse()
   pastetex(@bumpy,@vscr,320-bumpy\larj/2,240-bumpy\htr/2)
   subtex(@bumpy,@vscr,320-bumpy\larj/2+(MouseX()-320)/64,240-bumpy\htr/2+(MouseY()-240)/48)
   Gosub transfscr
   FlipBuffers()
Until KeyboardPushed(#pb_key_escape)


transfscr:
   scrop=ScreenOutput()
   If scrop And StartDrawing(scrop)
      buf=DrawingBuffer()
      pic=DrawingBufferPitch()
      If buf And pic
         src=vscr\pix
         For y=0 To 479
            CopyMemory(src,buf,640)
            src+640
            buf+pic
         Next
      EndIf
   StopDrawing() : EndIf
   zeromemory_(vscr\pix,640*480)
Return