Ich habe diesen Nachmittag ein kleines Puzzlespiel gebastelt, welches ich hier präsentieren möchte. Der Code ist knapp genug, daß ich ihn per copy/paste bereitstellen kann.
- Ihr müsst zuvor ein beliebiges .jpg-Image mit dem Namen "puzzle.jpg" in denselben Ordner wie die Code-Datei legen (Maße/Höhe/Breite sind egal, das Bild wird entsprechend seiner Ausdehnung automatisch an die Fenstergröße angepasst). Auch das Motiv (ob Jeremy Renner, Megan Fox, Dinosaurier, Katze oder Einhorn) ist euch frei überlassen.
- Die Schwierigkeit legt ihr mit der Variable difficulty (an zweiter Stelle, nach EnableExplicit) fest - der Wert muß mindestens 2 betragen, das ist die Anzahl Teile an der kürzeren Seite des Bildes, nach oben hin gibt es keine Grenze (außer eure CPU und masochistische Disposition).
- Alle Teile sind quadratisch, der dabei eventuell entstehende Rand wird als fester Rahmen angezeigt und kann nicht bewegt werden; der Puzzle-Part wird dabei möglichst mittig in diesem Rahmen ausgerichtet.
- Mit der rechten Maustaste könnt ihr die Teile im Uhrzeigersinn drehen
- Mit der linken Maustaste könnt ihr Teile "taggen" und "detaggen"; sobald 2 Teile getaggt sind, tauschen diese ihre Position
- Nach jedem "swap" und jeder "rotation" checkt das Programm, ob das Puzzle korrekt gelöst wurde.
- Mit ESC beendet ihr das Spiel.
Viel Spaß!
Code: Alles auswählen
EnableExplicit
UseJPEGImageDecoder()
Declare selectDifficulty()
Declare ini()
Declare aspectResize(picID,newX,newY)
Declare loop()
Declare processInput()
Declare processTimer()
Declare checkPuzzle()
Declare clearTags()
Declare yay()
Declare inRange(value,min,max)
Structure TILE
index.i
trueX.i
trueY.i
x.i
y.i
xMicro.i
yMicro.i
xMicroDir.i
yMicroDir.i
rotation.i
tagged.i
EndStructure
Global NewList tile.TILE()
#xRes = 1024
#yRes = 768
Global screen
Global pic
Global difficulty
Global selectSPR
Global selectX,selectY
Global marginSPR
Global Dim tileSPR(0)
Global tagSPR
Global xMax, yMax
Global xMargin, yMargin
Global tileSize
Global swapping
Global targetAngle
Global gameOver
Global Dim *tag.TILE(1)
Global frameDuration, frameFinished
Global perSecond.f
ini()
loop()
End
Procedure selectDifficulty()
Define event
Define diffSelection
diffSelection = OpenWindow(#PB_Any, 0, 0, 160, 180, "Select Difficulty", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(2, 30, 20, 100, 20, "Why even play")
ButtonGadget(3, 30, 45, 100, 20, "I hate Puzzles")
ButtonGadget(4, 30, 70, 100, 20, "Easy")
ButtonGadget(5, 30, 95, 100, 20, "Medium")
ButtonGadget(6, 30, 120, 100, 20, "Harder")
ButtonGadget(7, 30, 145, 100, 20, "Challenge me")
ButtonGadget(8, 30, 170, 100, 20, "Master")
ButtonGadget(9, 30, 195, 100, 20, "This is work")
ButtonGadget(10, 30, 220, 100, 20, "Masochistic")
ButtonGadget(11, 30, 245, 100, 20, "Impossible")
Repeat
event = WaitWindowEvent(16)
difficulty = EventGadget()
Until difficulty Or event = #PB_Event_CloseWindow
CloseWindow(diffSelection)
If event = #PB_Event_CloseWindow
End
EndIf
EndProcedure
Procedure ini()
Define x, y
Define xSize
Define ySize
Define newX, newY
Define defSide
Define count
Dim puzzle(0,0)
Define event
If FileSize("puzzle.jpg") < 1
If OpenWindow(#PB_Any, 0, 0, 225, 120, "No Puzzle Image found!",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TextGadget(0,10,10,200,20,"Put any image (.jpg format required)")
TextGadget(1,10,30,200,20,"into the same directory as PurePuzzle.exe")
TextGadget(2,10,50,200,20,"and rename the image file to 'puzzle.jpg'")
ButtonGadget(3,50,80,100,20,"Understood")
Repeat
event = WaitWindowEvent(1)
Until EventGadget() = 3 Or event = #PB_Event_CloseWindow
EndIf
End
EndIf
selectDifficulty()
If InitSprite()
screen = OpenWindow(#PB_Any,0,0,#xRes,#yRes,"PurePuzzle (©diceman, 2018) --- Press ESC to Quit",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
If OpenWindowedScreen(WindowID(screen),0,0,#xRes,#yRes)
InitKeyboard()
InitMouse()
EndIf
EndIf
;Bild laden und Größe anpassen
pic = LoadImage(#PB_Any,"puzzle.jpg")
xSize = ImageWidth(pic)
ySize = ImageHeight(pic)
If xSize > ySize
newX = #xRes
Else
newY = #yRes
EndIf
aspectResize(pic,newX,newY)
;Anzahl der Teile bestimmen
xSize = ImageWidth(pic)
ySize = ImageHeight(pic)
If xSize > ySize
defSide = ySize
Else
defSide = xSize
EndIf
tileSize = defSide/difficulty
xMax = (xSize/tileSize)-1
yMax = (ySize/tileSize)-1
;Bild im Hintergrund zeichnen für weitere Operationen
If StartDrawing(ScreenOutput())
DrawImage(ImageID(pic),0,0)
StopDrawing()
EndIf
;Rahmen erkennen
xMargin = (xSize - ((xMax+1)*tileSize))/2
yMargin = (ySize - ((yMax+1)*tileSize))/2
;Teile als Sprites speichern
count = -1
For x = 0 To xMax
For y = 0 To yMax
count +1
ReDim tileSPR(count)
tileSPR(count) = GrabSprite(#PB_Any,(x*tileSize)+xMargin,(y*tileSize)+yMargin,tileSize,tileSize)
AddElement(tile())
tile()\index = count
tile()\trueX = x
tile()\trueY = y
Next
Next
;Rahmen speichern
If StartDrawing(ScreenOutput())
DrawingMode(#PB_2DDrawing_Default)
Box(xMargin,yMargin,(xMax+1)*tileSize,(yMax+1)*tileSize,RGB(0,0,0))
StopDrawing()
EndIf
GrabSprite(marginSPR,0,0,xSize,ySize) ;Der Einfachheit halber wird das komplette Bild als Rahmen gespeichert und als unterste Ebene gezeichnet. Die Puzzleteile liegen darüber.
;Puzzle mischen
Dim puzzle(xMax,yMax)
ForEach tile()
Repeat
tile()\x = Random(xMax)
tile()\y = Random(yMax)
tile()\rotation = Random(3)*90
Until puzzle(tile()\x,tile()\y) = 0
puzzle(tile()\x,tile()\y) = #True
Next
;übrige Sprites initialisieren
tagSPR = CreateSprite(#PB_Any,tileSize,tileSize)
If StartDrawing(SpriteOutput(tagSPR))
DrawingMode(#PB_2DDrawing_Outlined)
Box(0,0,tileSize,tileSize,RGB(255,0,0))
Box(1,1,tileSize-2,tileSize-2,RGB(255,0,0))
Box(3,3,tileSize-6,tileSize-6,RGB(255,0,0))
StopDrawing()
EndIf
selectSPR = CreateSprite(#PB_Any,tileSize,tileSize)
TransparentSpriteColor(selectSPR,RGB(255,0,0))
EndProcedure
Procedure processInput()
Define *pointer.TILE
Define x, y
Define count
Define event
Define absCount
selectX = -1
selectY = -1
ForEach tile()
If inRange(WindowMouseX(screen), xMargin+(tile()\x*tileSize)+tile()\xMicro, xMargin+((tile()\x+1)*tileSize)+tile()\xMicro) And inRange(WindowMouseY(screen), yMargin+(tile()\y*tileSize)+tile()\yMicro,yMargin+((tile()\y+1)*tileSize)+tile()\yMicro)
*pointer = @tile()
selectX = *pointer\x
selectY = *pointer\y
Break
EndIf
Next
event = WaitWindowEvent(16)
If swapping Or targetAngle
ProcedureReturn #False
EndIf
If event = #PB_Event_CloseWindow
gameOver = 2
EndIf
If *pointer
If event = #PB_Event_LeftClick
Select *pointer\tagged
Case #True
*pointer\tagged = #False
*tag(0) = #Null
Case #False
*pointer\tagged = #True
If *tag(0)
count = 1
EndIf
*tag(count) = *pointer
EndSelect
If *tag(0) And *tag(1)
swapping = #True
For count = 0 To 1
ChangeCurrentElement(tile(),*tag(count))
MoveElement(tile(),#PB_List_Last)
absCount = Abs(count-1)
If *tag(count)\x > *tag(absCount)\x
*tag(count)\xMicroDir = -1
EndIf
If *tag(count)\x < *tag(absCount)\x
*tag(count)\xMicroDir = 1
EndIf
If *tag(count)\y > *tag(absCount)\y
*tag(count)\yMicroDir = -1
EndIf
If *tag(count)\y < *tag(absCount)\y
*tag(count)\yMicroDir = 1
EndIf
Next
EndIf
EndIf
If event = #PB_Event_RightClick
clearTags()
*tag(0) = *pointer
ChangeCurrentElement(tile(),*tag(0))
MoveElement(tile(),#PB_List_Last)
targetAngle = *tag(0)\rotation+90
EndIf
EndIf
EndProcedure
Procedure processTimer()
Define count
Define absCount
If swapping
For count = 0 To 1
absCount = Abs(count-1)
*tag(count)\xMicro + (*tag(count)\xMicroDir*Abs((*tag(count)\x*tileSize)-(*tag(absCount)\x*tileSize))*perSecond*4)
*tag(count)\yMicro + (*tag(count)\yMicroDir*Abs((*tag(count)\y*tileSize)-(*tag(absCount)\y*tileSize))*perSecond*4)
If *tag(count)\xMicroDir = -1 And (*tag(count)\x*tileSize)+*tag(count)\xMicro <= *tag(absCount)\x*tileSize
*tag(count)\xMicroDir = 0
EndIf
If *tag(count)\xMicroDir = 1 And (*tag(count)\x*tileSize)+*tag(count)\xMicro >= *tag(absCount)\x*tileSize
*tag(count)\xMicroDir = 0
EndIf
If *tag(count)\yMicroDir = -1 And (*tag(count)\y*tileSize)+*tag(count)\yMicro <= *tag(absCount)\y*tileSize
*tag(count)\yMicroDir = 0
EndIf
If *tag(count)\yMicroDir = 1 And (*tag(count)\y*tileSize)+*tag(count)\yMicro >= *tag(absCount)\y*tileSize
*tag(count)\yMicroDir = 0
EndIf
Next
If *tag(0)\xMicroDir = 0 And *tag(0)\yMicroDir = 0 And *tag(1)\xMicroDir = 0 And *tag(1)\yMicroDir = 0
For count = 0 To 1
*tag(count)\xMicro = 0
*tag(count)\yMicro = 0
Next
swapping = #False
;markierte Teile tauschen
Swap *tag(0)\x, *tag(1)\x
Swap *tag(0)\y, *tag(1)\y
clearTags()
checkPuzzle()
EndIf
EndIf
If targetAngle
*tag(0)\rotation+(1000*perSecond)
If *tag(0)\rotation >= targetAngle
*tag(0)\rotation = targetAngle
If *tag(0)\rotation = 360
*tag(0)\rotation = 0
EndIf
targetAngle = 0
clearTags()
checkPuzzle()
EndIf
EndIf
EndProcedure
Procedure clearTags()
Define count
For count = 0 To 1
If *tag(count)
*tag(count)\tagged = #False
*tag(count) = #Null
EndIf
Next
EndProcedure
Procedure loop()
Define event
Define x, y
Repeat
ClearScreen(RGB(0,0,0))
DisplaySprite(marginSPR,0,0)
ForEach tile()
RotateSprite(tileSPR(tile()\index),tile()\rotation,#PB_Absolute)
DisplaySprite(tileSPR(tile()\index),xMargin+(tile()\x*tileSize)+tile()\xMicro,yMargin+(tile()\y*tileSize)+tile()\yMicro)
If selectX = tile()\x And selectY = tile()\y
RotateSprite(selectSPR,tile()\rotation,#PB_Absolute)
DisplayTransparentSprite(selectSPR,xMargin+(selectX*tileSize)+tile()\xMicro,yMargin+(selectY*tileSize)+tile()\yMicro,100)
EndIf
If tile()\tagged = #True
DisplayTransparentSprite(tagSPR,xMargin+(tile()\x*tileSize),yMargin+(tile()\y*tileSize))
EndIf
Next
FlipBuffers()
ExamineKeyboard()
If Not gameOver
processInput()
processTimer()
Else
yay()
EndIf
;Delta Time
perSecond = frameDuration/1000
frameDuration = ElapsedMilliseconds() - frameFinished
frameFinished = ElapsedMilliseconds()
Until KeyboardPushed(#PB_Key_Escape) Or gameOver = 2
EndProcedure
Procedure checkPuzzle()
ForEach tile()
If tile()\x <> tile()\trueX Or tile()\y <> tile()\trueY Or tile()\rotation <> 0
ProcedureReturn #False
EndIf
Next
selectX = -1
selectY = -1
gameOver = 1
EndProcedure
Procedure yay()
Define confirm
confirm = OpenWindow(#PB_Any, 0, 0, 180, 70, "* * * * * * * * * * * * * * * * * * * * *",#PB_Window_WindowCentered)
SetActiveWindow(confirm)
TextGadget(0,45,10,200,20,"Congratulations!")
ButtonGadget(1,30,35,100,20,"Yay")
Repeat
WaitWindowEvent(16)
Until EventGadget() = 1
gameOver = 2
EndProcedure
Procedure aspectResize(picID,newX,newY)
Define x = ImageWidth(picID)
Define y = ImageHeight(picID)
Define factor.f
If newX = 0 And newY = 0
ProcedureReturn #False
EndIf
If newX And newY = 0
factor = y/x
newY = newX*factor
EndIf
If newX = 0 And newY
factor = x/y
newX = newY*factor
EndIf
ResizeImage(picID,newX,newY)
EndProcedure
Procedure inRange(value,min,max)
If value >= min And value <= max
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure