Hi
This is a simple Jigsaw-puzzle-generator
(used in my 'Halloween'-Production 'Ghostwriters'
It is for loaded images or created animations
(It's both in this program; that's just for demostration)
You can change number of tiles,image- and tilesize
Click on a tile - click on an other tile to exchange
use function-keys F1-F4
made with PB 1.54
[pbcode]
; PROJECT : Jigsaw-Puzzler
; AUTHOR : stef
; CREATED : 26.10.2006
; EDITED : 28.10.2006
; ---------------------------------------------------------------------
; click one tile , click another tile to exchange with first one
; F1 toggles info
; F2 toggles red grid
; F3 shows tiles in correct position
; F4 change images (just to demostrate you can use a loaded image or an animation)
;---------------------------------------------------------------------
;to change manually
Global screenw=800
Global screenh=600
; imagesize/blocksize should be without remainder!
Global imagesizex=500;width of displayed image
Global imagesizey=400;height of displayed image
Global tilesizex=100;width of tile
Global tilesizey=100;height of tile
Global tilesx=imagesizex/tilesizex; number of tiles x-direction
Global tilesy=imagesizey/tilesizey; number of tiles y-direction
Global tiles=tilesx*tilesy;total number of tiles
Global offsetx=(screenw-imagesizex)/2;display image/tiles centered on screen
Global offsety=(screenh-imagesizey)/2; if offsetx=0 : left screenborder
;--------------------------------------------------------------------
OpenScreen screenw,screenh,16,2
Global fpsset=60
SetFPS fpsset
; change ---------------------------------------------------
animal_im=GetFreeImage()
If FileExist("animal.jpg")=1
LoadImage "animal.jpg",animal_im
Else
LoadImage "..\..\projects\gfx\animal.jpg",animal_im ; maybe more or less "..\"
EndIf
ScaleImage animal_im,imagesizex,imagesizey,1
;------------------------------------------------------------
fs=50;framebreadth
col=RGB(100,100,100)
colorframe_im=NewImage(screenw,screenh)
RenderToImage colorframe_im
;boxc 0,0,screenw,screenh,1,rgb(0,0,100)
BoxC offsetx-fs,offsety-fs,offsetx+imagesizex+fs,offsety+imagesizey+fs,1,col
BoxC offsetx,offsety,offsetx+imagesizex,offsety+imagesizey,1,RGB(0,0,0)
Global display=1
Global bluebox=0
Global grid=-1
Global choice=1
Global info=1
Global tim
Global xmouse
Global ymouse
Global display_im,initimage
Type tparts
image
xnumber
ynumber
xactualpos
yactualpos
xcorrectpos
ycorrectpos
xfalsepos
yfalsepos
correctposexist
falseposexist
EndType
;creating and defining of tiles
Dim parts(tiles) As tparts
For a = 1 To tiles
parts(a).image=NewImage(tilesizex,tilesizey)
parts(a).xnumber=xval
parts(a).ynumber=yval
parts(a).xcorrectpos=parts(a).xnumber*tilesizex
parts(a).ycorrectpos=parts(a).ynumber*tilesizey
xval=xval+1
If xval=tilesx
xval=0
yval=yval+1
EndIf
If yval=tilesy Then yval=0
Next
;setting tiles on randompositions
For a = 1 To tiles
Repeat
anew = RndRange(1,tiles)
If parts(a).correctposexist=0 And parts(anew).falseposexist=0
parts(anew).falseposexist=1
parts(a).correctposexist=1
parts(a).xfalsepos=parts(anew).xcorrectpos
parts(a).yfalsepos=parts(anew).ycorrectpos
Inc newexistcounter
If newexistcounter=tiles Then ExitRepeat
EndIf
Until parts(anew).falseposexist=0
Next
Global display_im=NewImage(imagesizex,imagesizey)
Do
;switches images-------------------------------------------------
If choice=1
generateimage();image to display as puzzle
Else
RenderToImage animal_im;loaded image
EndIf
;----------------------------------------------------------
;grabbing of tiles-----------------------------------------
For a= 1 To tiles
GetImage parts(a).image,parts(a).xcorrectpos,parts(a).ycorrectpos,parts(a).xcorrectpos+tilesizex,parts(a).ycorrectpos+tilesizey
Next
;---------------------------------------------------------
RenderToScreen
Cls 0
DrawImage colorframe_im,0,0,1
For a= 1 To tiles
If bluebox=1
If parts(a).xactualpos=bluex And parts(a).yactualpos=bluey
old=a
EndIf
EndIf
If display=1;falsepos
parts(a).xactualpos=parts(a).xfalsepos
parts(a).yactualpos=parts(a).yfalsepos
Else
parts(a).xactualpos=parts(a).xcorrectpos
parts(a).yactualpos=parts(a).ycorrectpos
EndIf
If yellowbox=1;switch tiles
If parts(a).xactualpos=yellowx And parts(a).yactualpos=yellowy
yellowbox=0
parts(a).xfalsepos=parts(old).xfalsepos
parts(a).yfalsepos=parts(old).yfalsepos
parts(old).xfalsepos=yellowx
parts(old).yfalsepos=yellowy
EndIf
EndIf
DrawImage parts(a).image,parts(a).xactualpos+offsetx,parts(a).yactualpos+offsety,1
Next
xmouse=MouseX()
ymouse=MouseY()
If grid=-1
For x = 0 To imagesizex Step tilesizex
LineC x+offsetx,0+offsety,x+offsetx,imagesizey+offsety,RGB(255,0,0)
Next
For x = 0 To imagesizey Step tilesizey
LineC 0+offsetx,x+offsety,imagesizex+offsetx,x+offsety,RGB(255,0,0)
Next
EndIf
CircleC xmouse,ymouse,3,1,RGB(255,0,0)
If display=1;color boxes (green,blue,yellow)
For y=0 To imagesizey-tilesizey Step tilesizey
For x = 0 To imagesizex- tilesizex Step tilesizex
If PointInBox(xmouse,ymouse,x+offsetx,y+offsety,x+tilesizex+offsetx,y+tilesizey+offsety)
BoxC x+offsetx,y+offsety,x+tilesizex+1+offsetx,y+tilesizey+offsety,0,RGB(0,255,0)
If LeftMouseButton()=1
FlushMouse
If bluebox=0
bluebox=1
yellowbox=0
bluex=x
bluey=y
ElseIf bluebox=1
bluebox=0
yellowbox=1
yellowx=x
yellowy=y
EndIf
EndIf
EndIf
Next
Next
EndIf
If bluebox=1
BoxC bluex+offsetx,bluey+offsety,bluex+tilesizex+1+offsetx,bluey+tilesizey+offsety,0,RGB(0,0,255)
EndIf
If yellowbox=1
BoxC yellowx+offsetx,yellowy+offsety,yellowx+tilesizex+1+offsetx,yellowy+tilesizey+offsety,0,RGB(255,255,0)
EndIf
checkkeys()
;check for solution
For a = 1 To tiles
If parts(a).xfalsepos<>parts(a).xcorrectpos Or parts(a).yfalsepos<>parts(a).ycorrectpos
text$=""
ExitFor
Else
text$="CONGRATULATION YOU MADE IT"
EndIf
Next
If tim< 20
CenterText screenw/2,offsety+imagesizey, text$
EndIf
Inc tim
If tim>30 Then tim=0
Sync
Loop
Function generateimage()
If initimage=0
initimage=1
Type tim
exist
x#,y#
dx#,dy#
dir
radius
col
EndType
Dim im(20) As tim
EndIf
For x= 0 To 20
If im(x).exist=0
im(x).exist=1
pos1=Rnd(1)
pos2=Rnd(1)
If pos2=1
im(x).dir=-1
Else
im(x).dir=1
EndIf
If pos1=0
im(x).x#=Rnd(imagesizex):im(x).y#=pos2*imagesizey:im(x).dx#=RndRange(1,10)*0.1:im(x).dy#=0
Else
im(x).y#=Rnd(imagesizey):im(x).x#=pos2*imagesizex:im(x).dy#=RndRange(1,10)*0.1:im(x).dx#=0
EndIf
im(x).radius=RndRange(10,30)
im(x).col=RndRGB()
EndIf
Next
RenderToImage display_im
For x=0 To 20
If im(x).exist=1
CircleC im(x).x,im(x).y,im(x).radius,1,im(x).col
im(x).x#=im(x).x#+(im(x).dy#*im(x).dir)
im(x).y#=im(x).y#+(im(x).dx#*im(x).dir)
EndIf
If im(x).x#<0 Or im(x).x# >imagesizex Then im(x).exist=0
If im(x).y#<0 Or im(x).y# >imagesizey Then im(x).exist=0
Next
EndFunction
Function checkkeys()
If FunctionKeys(1)=1
FlushKeys
info=info*-1
EndIf
If info=1
Print "F1:toggles info, F2:red grid, F3:tiles in correct position, F4:switch images"
Print "FPS set to: "+Str$(fpsset)
Print "tiles: "+Str$(tiles)
Print "Imagesize: "+ Str$(imagesizex)+"*"+Str$(imagesizey)
Print "Tilesize: "+ Str$(tilesizex)+"*"+Str$(tilesizey)
Print "mouse-x: "+Str$(xmouse)
Print "mouse-y: "+Str$(ymouse)
EndIf
If FunctionKeys(2)=1
FlushKeys
grid=grid*-1
EndIf
If FunctionKeys(3)=1
FlushKeys
display=display*-1
EndIf
If FunctionKeys(4)=1
FlushKeys
choice=choice*-1
EndIf
EndFunction
[/pbcode]