Avant de compiler, modifiez la constante #PBdir selon votre installation.
Faites des cercles avec la souris pour changer l'orientation de la "lumière".
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