the Mona Lisa come to life
Posted: Sun Jul 19, 2015 4:07 pm
when we extrude the points by the amount of the the red or green color in the mona lisa picture, it looks evil in a close position, but with blue it looks friendly
change line 75: MeshVertexPosition(x, y, rd) to MeshVertexPosition(x, y, bl) to see it friendly, it is possible that da vinci painted his masterpiece with something in his mind yet to be discovered.
save this picture to the same folder as this code (change it first to "bmp")
https://upload.wikimedia.org/wikipedia/ ... ouched.jpg
this is the 687 × 1,024 pixels picture found here: https://en.wikipedia.org/wiki/File:Mona ... ouched.jpg to use other resolutons you need to change the camera position. and don't try the 7,479 × 11,146 pixels, file size: 89.94 MB
Code: Select all
#CameraSpeed = 0.2
#plane = 10
Quit.b = #False
Define.f KeyX, KeyY, MouseX, MouseY
Global r.f
ExamineDesktops()
If OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), " ", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
;Initialize environment
InitEngine3D()
InitSprite()
OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0)-10, 0, 0, 0)
WorldShadows(#PB_Shadow_Additive)
InitKeyboard()
InitMouse()
SetFrameRate(60)
Add3DArchive(".", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)
CreateMaterial(0, LoadTexture(0, "snow_1024.jpg"))
CreatePlane(#plane, 100, 100, 1, 1, 1, 1)
CreateEntity (#plane, MeshID(#plane), MaterialID(0),0,-10,0)
CreateLight(0,RGB(255,255,255),-100,40,30)
AmbientColor(RGB(100,100,100))
CreateCamera(0, 0, 0, 100, 100)
;MoveCamera(0, -1.1884304285, 0.2495694309, 6.1952486038)
MoveCamera(0, 0.731574297, -3.8886890411, 11.3255195618)
RotateCamera(0, 0, 0, 0)
EndIf
SkyDome("clouds.jpg", 100) ;for blue color background
CreateMaterial(0, LoadTexture(0, "White.jpg"))
MaterialBlendingMode(0, #PB_Material_AlphaBlend)
DisableMaterialLighting(0, #True)
CreateMaterial(1, LoadTexture(0, "White.jpg"))
MaterialBlendingMode(1, #PB_Material_AlphaBlend)
DisableMaterialLighting(0, #True)
DisableMaterialLighting(1, #True)
;SetMaterialColor(1, #PB_Material_SpecularColor, RGB(250,0,0))
CreateMesh(1, #PB_Mesh_PointList, #True)
SetMeshMaterial(1, MaterialID(0))
Procedure showPic()
Define image_id.i
; load image
image_id = LoadImage( #PB_Any, "monalisa.bmp" )
Dim image_pixel_data.b( ImageWidth(image_id), ImageHeight(image_id) )
StartDrawing( ImageOutput( image_id ) )
For y = 0 To ImageHeight(image_id) - 1
For x = 0 To ImageWidth(image_id) - 1
color=Point(x,y)
rd=Red(color)
gr=Green(color)
bl=Blue(color)
r.f+1
;MeshVertexPosition(x, y, Sin(Radian(rd*gr*bl))*137)
MeshVertexPosition(x, y, rd)
MeshVertexColor(RGBA(rd,gr,bl,200))
Next x
Next y
StopDrawing()
FreeImage(image_id)
FinishMesh(#True )
EndProcedure
showPic()
CreateEntity(1, MeshID(1), MaterialID(0))
ScaleEntity(1,0.02,0.02,0.02)
RotateEntity(1, -180, 0, 0 )
MoveEntity(1,-5,4.0,-2)
incr.f=0.7
Repeat
Event = WindowEvent()
RenderWorld()
FlipBuffers()
If ExamineMouse()
MouseX = -MouseDeltaX() * #CameraSpeed * 0.5
MouseY = -MouseDeltaY() * #CameraSpeed * 0.5
EndIf
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Left)
KeyX = -#CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Right)
KeyX = #CameraSpeed
Else
KeyX = 0
EndIf
If KeyboardPushed(#PB_Key_Up)
KeyY = -#CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Down)
KeyY = #CameraSpeed
Else
KeyY = 0
EndIf
If KeyboardReleased(#PB_Key_Z)
Debug StrF(CameraX(0))+" "+StrF(CameraY(0))+" "+StrF(CameraZ(0))
EndIf
If KeyboardPushed(#PB_Key_Escape)
Quit = #True
EndIf
MoveCamera (0, KeyX, 0, KeyY)
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
Until Quit = #True Or Event = #PB_Event_CloseWindow
