PureMondrian

[Mr.L]

...I made a few modifications to make the game DPI aware

Code: Select all

;PureMondrian 1.0 by Jac de Lad
EnableExplicit

Enumeration Window
	#MainWindow
EndEnumeration
Enumeration Gadget
	#Canvas
	#List
	#SolveButton
	#InfoButton
	#Difficulty
	#Language
EndEnumeration

Structure Occupied
	X.a
	Y.a
	EX.a
	EY.a
EndStructure

Structure MPos
	X.a
	Y.a
	Rot.a
	EX.a
	EY.a
EndStructure

Structure Tile
	X.a
	Y.a
	InitX.a
	InitY.a
	NowX.b
	NowY.a
	NowRot.a
	Color.l
	Fixed.a
	DragX.w
	DragY.w
	DragW.w
	DragH.w
	DragRot.a
	RPosition.a
	List Position.MPos()
EndStructure

Structure XY
	X.a
	Y.a
EndStructure

Structure Task
	Difficulty.a
	Tile1X.a
	Tile1Y.a
	Tile2X.a
	Tile2Y.a
	Tile2R.a
	Tile3X.a
	Tile3Y.a
	Tile3R.a
	Image.i
EndStructure

Global Dim Field.a(7,7),NewList Tiles.Tile(),NewList PositionMatrix.MPos(),Thread.i,NewList Tasks.Task(),Background.l,Language.a,DragTile.b=-1,MX.w,MY.w,X.w,Y.w,Solved.a=#True,NoDrop.a

Procedure Draw(Mode)
	Protected PL.a,MX.w,MY.w
	Protected X.w,Y.w,W.w,H.w,PX.w,PY.w,PEX.w,PEY.w
	StartDrawing(CanvasOutput(#Canvas))
	Box(0,0,OutputWidth(),OutputHeight(),Background)
	If Not mode
		For X=1 To 9
			Line(DesktopScaledX(40*X), DesktopScaledY(40), DesktopScaledX(1), DesktopScaledY(320),#Green)
			Line(DesktopScaledX(40), DesktopScaledY(40*X-1), DesktopScaledX(320), DesktopScaledY(1), #Green)
		Next
	EndIf
	ForEach Tiles()
		If Not Mode
			FirstElement(Tiles()\Position())
		EndIf
		If Mode Or Tiles()\Fixed
			Box(DesktopScaledX(41+40*Tiles()\Position()\X),
			    DesktopScaledY(41+40*Tiles()\Position()\Y),
			    DesktopScaledX(40*(Tiles()\Position()\EX-Tiles()\Position()\X+1)-2),
			    DesktopScaledY(40*(Tiles()\Position()\EY-Tiles()\Position()\Y+1)-2),
			    Tiles()\Color)
		EndIf
		If Not Mode And Not Tiles()\Fixed
			If Tiles()\NowX=-1
				If DragTile=ListIndex(Tiles())
					PushListPosition(Tiles())
					PL=#True
				Else
					Box(DesktopScaledX(Tiles()\DragX),DesktopScaledY(Tiles()\DragY),DesktopScaledX(Tiles()\DragW),DesktopScaledY(Tiles()\DragH),Tiles()\Color)
				EndIf
			Else
				If Tiles()\NowRot
					Box(DesktopScaledX(41+40*Tiles()\NowX),DesktopScaledY(41+40*Tiles()\NowY),DesktopScaledX(40*Tiles()\Y-2),DesktopScaledY(40*Tiles()\X-2),Tiles()\Color)
				Else
					Box(DesktopScaledX(41+40*Tiles()\NowX),DesktopScaledY(41+40*Tiles()\NowY),DesktopScaledX(40*Tiles()\X-2),DesktopScaledY(40*Tiles()\Y-2),Tiles()\Color)
				EndIf
			EndIf
		EndIf
	Next
	If PL
		PopListPosition(Tiles())
		MX=DesktopUnscaledX(WindowMouseX(#MainWindow))
		MY=DesktopUnscaledY(WindowMouseY(#MainWindow))
		If Tiles()\DragRot
			X=MX-0.8*Tiles()\DragH
			Y=MY-0.8*Tiles()\DragW
			W=Tiles()\DragH*1.6
			H=Tiles()\DragW*1.6
		Else
			X=MX-0.8*Tiles()\DragW
			Y=MY-0.8*Tiles()\DragH
			W=Tiles()\DragW*1.6
			H=Tiles()\DragH*1.6
		EndIf
		
		PX=Round((X-41)/40,#PB_Round_Nearest)
		PY=Round((Y-41)/40,#PB_Round_Nearest)
		PEX=PX+Round((W-41)/40,#PB_Round_Nearest)
		PEY=PY+Round((H-41)/40,#PB_Round_Nearest)
		NoDrop=#False
		
		If PX<0 Or PY<0 Or PEX>7 Or PEY>7
			NoDrop=#True
		Else
			For MX=PX To PEX
				For MY=PY To PEY
					If Field(MX,MY)>0
						NoDrop=#True
						Break
					EndIf
				Next
			Next
			
		EndIf
		
		If NoDrop
			Box(DesktopScaledX(X),DesktopScaledY(Y),DesktopScaledX(W),DesktopScaledY(H),#Gray)
		Else
			Box(DesktopScaledX(X),DesktopScaledY(Y),DesktopScaledX(W),DesktopScaledY(H),#Green)
		EndIf
	EndIf
	StopDrawing()
EndProcedure

Macro CreateTile(MyX,MyY,MyInitX,MyInitY,MyColor,MyFixed=#False)
	AddElement(Tiles())
	Tiles()\X=MyX
	Tiles()\Y=MyY
	Tiles()\InitX=MyInitX
	Tiles()\InitY=MyInitY
	Tiles()\Color=MyColor
	Tiles()\Fixed=MyFixed
EndMacro
CreateTile(1,1,0,0,#Black,#True)
CreateTile(2,1,0,0,#Black,#True)
CreateTile(3,1,0,0,#Black,#True)
CreateTile(4,3,6,3,#Blue)
CreateTile(3,3,3,3,#White)
CreateTile(5,2,6,1,#Red)
CreateTile(4,2,2,1,#White)
CreateTile(3,2,0,3,#Red)
CreateTile(2,2,0,1,#White)
CreateTile(5,1,0,0,#Yellow)
CreateTile(4,1,5,0,#Yellow)

Procedure Solve()
	Protected X.a,Y.a,*Pos.Tile,*MPos.MPos,NewList Locked.XY(),Position.w,Del.a,NewList Occupied.Tile(),Dim Field.a(7,7),Done.a,error.a
	
	;Teilematrix erstellen
	ForEach Tiles()
		If Not Tiles()\Fixed
			ClearList(Tiles()\Position())
			Tiles()\RPosition=0
			For X=0 To 7
				For Y=0 To 7
					If X+Tiles()\X<=8 And Y+Tiles()\Y<=8
						AddElement(Tiles()\Position())
						Tiles()\Position()\X=X
						Tiles()\Position()\Y=Y
						Tiles()\Position()\Rot=0
					EndIf
					If Tiles()\X<>Tiles()\Y And X+Tiles()\Y<=8 And Y+Tiles()\X<=8
						AddElement(Tiles()\Position())
						Tiles()\Position()\X=X
						Tiles()\Position()\Y=Y
						Tiles()\Position()\Rot=1
					EndIf
				Next
			Next
		EndIf
	Next
	
	;Gesperrte Positionen ermitteln
	ForEach Tiles()
		If Tiles()\Fixed
			ForEach Tiles()\Position()
				If Tiles()\Position()\Rot
					For X=0 To Tiles()\Y-1
						For Y=0 To Tiles()\X-1
							AddElement(Locked())
							Locked()\X=Tiles()\Position()\X+X
							Locked()\Y=Tiles()\Position()\Y+Y
						Next  
					Next
					;           Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
					;           Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
				Else
					For X=0 To Tiles()\X-1
						For Y=0 To Tiles()\Y-1
							AddElement(Locked())
							Locked()\X=Tiles()\Position()\X+X
							Locked()\Y=Tiles()\Position()\Y+Y
						Next  
					Next  
					;           Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
					;           Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
				EndIf
			Next
		EndIf
	Next
	
	;Teilematrix ausdünnen
	ForEach Tiles()
		If Not Tiles()\Fixed
			Position=ListSize(Tiles()\Position())-1
			Repeat
				SelectElement(Tiles()\Position(),Position)
				Del=#False
				ForEach Locked()
					If Tiles()\Position()\Rot
						If Locked()\X>=Tiles()\Position()\X And Locked()\X<Tiles()\Position()\X+Tiles()\Y And Locked()\Y>=Tiles()\Position()\Y And Locked()\Y<Tiles()\Position()\Y+Tiles()\X
							DeleteElement(Tiles()\Position(),1)
							Del=#True
							Break
						EndIf
					Else
						If Locked()\X>=Tiles()\Position()\X And Locked()\X<Tiles()\Position()\X+Tiles()\X And Locked()\Y>=Tiles()\Position()\Y And Locked()\Y<Tiles()\Position()\Y+Tiles()\Y
							DeleteElement(Tiles()\Position(),1)
							Del=#True
							Break
						EndIf
					EndIf
				Next
				If Not Del
					If Tiles()\Position()\Rot
						Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
						Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
					Else
						Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
						Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
					EndIf
				EndIf
				Position-1
			Until Position<0
		EndIf
	Next
	
	;Brute-Force-Placement-Attacke
	Protected Count.q
	
	Repeat
		
		;Teile prüfen
		FreeArray(Field())
		Dim Field(7,7)
		Done=#True
		ForEach Tiles()
			If Not Tiles()\Fixed
				SelectElement(Tiles()\Position(),Tiles()\RPosition)
				For X=Tiles()\Position()\X To Tiles()\Position()\EX
					For Y=Tiles()\Position()\Y To Tiles()\Position()\EY
						If Field(X,Y)
							Done=#False
							Break 3
						Else
							Field(X,Y)=1
						EndIf
					Next
				Next
			EndIf
		Next  
		
		If Done
			Break
		EndIf
		
		Tiles()\RPosition+1
		Repeat
			If Tiles()\RPosition>=ListSize(Tiles()\Position())
				Tiles()\RPosition=0
				If PreviousElement(Tiles())
					Tiles()\RPosition+1
				Else
					If Language
						MessageRequester("Error","There was no solution found!",#PB_MessageRequester_Error)
					Else
						MessageRequester("Fehler","Es konnte keine Lösung gefunden werden!",#PB_MessageRequester_Error)
					EndIf
					error=#True
					Break 2
				EndIf
			Else
				Break
			EndIf
		ForEver
		Count+1
		
	ForEver
	
	If Not error
		Solved=#True
		Draw(#True)
		DisableGadget(#SolveButton,#True)
	EndIf
	
EndProcedure

Procedure LoadList(Difficulty)
	ClearGadgetItems(#List)
	ForEach Tasks()
		If Tasks()\Difficulty=Difficulty
			If Language
				AddGadgetItem(#List,-1,"Riddle "+Str(ListIndex(Tasks())+1),ImageID(Tasks()\Image))
			Else
				AddGadgetItem(#List,-1,"Rätsel "+Str(ListIndex(Tasks())+1),ImageID(Tasks()\Image))
			EndIf
		EndIf
		SetGadgetItemData(#List,CountGadgetItems(#List)-1,@Tasks())
	Next
	StartDrawing(CanvasOutput(#Canvas))
	Box(0,0,400,400,Background)
	StopDrawing()
	DisableGadget(#SolveButton,#True)
EndProcedure

Procedure LoadTasks()
	Protected *Mem=?Tasks,Size.a=4
	Repeat
		AddElement(Tasks())
		Tasks()\Difficulty=PeekA(*Mem)
		Tasks()\Tile1X=PeekA(*Mem+1)
		Tasks()\Tile1Y=PeekA(*Mem+2)
		Tasks()\Tile2X=PeekA(*Mem+3)
		Tasks()\Tile2Y=PeekA(*Mem+4)
		Tasks()\Tile2R=PeekA(*Mem+5)
		Tasks()\Tile3X=PeekA(*Mem+6)
		Tasks()\Tile3Y=PeekA(*Mem+7)
		Tasks()\Tile3R=PeekA(*Mem+8)
		Tasks()\Image=CreateImage(#PB_Any,8*Size+4,8*Size+4,24,#Green)
		StartDrawing(ImageOutput(Tasks()\Image))
		Box(2,2,8*Size,8*Size,Background)
		Box(2+Tasks()\Tile1X*Size,2+Tasks()\Tile1Y*Size,Size,Size,#Black)
		If Tasks()\Tile2R
			Box(2+Tasks()\Tile2X*Size,2+Tasks()\Tile2Y*Size,Size,Size*2,#Black)
		Else
			Box(2+Tasks()\Tile2X*Size,2+Tasks()\Tile2Y*Size,Size*2,Size,#Black)
		EndIf
		If Tasks()\Tile3R
			Box(2+Tasks()\Tile3X*Size,2+Tasks()\Tile3Y*Size,Size,Size*3,#Black)
		Else
			Box(2+Tasks()\Tile3X*Size,2+Tasks()\Tile3Y*Size,Size*3,Size,#Black)
		EndIf
		StopDrawing()
		*Mem+9
	Until *Mem>=?TasksEnd
EndProcedure

Procedure LoadTask(Task)
	Protected X.a
	ForEach Tiles()
		ClearList(Tiles()\Position())
	Next
	ChangeCurrentElement(Tasks(),Task)
	FirstElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile1X
	Tiles()\Position()\Y=Tasks()\Tile1Y
	NextElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile2X
	Tiles()\Position()\Y=Tasks()\Tile2Y
	Tiles()\Position()\Rot=Tasks()\Tile2R
	NextElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile3X
	Tiles()\Position()\Y=Tasks()\Tile3Y
	Tiles()\Position()\Rot=Tasks()\Tile3R
	FreeArray(Field())
	Dim Field(7,7)
	ForEach Tiles()
		If Tiles()\Fixed
			ForEach Tiles()\Position()
				If Tiles()\Position()\Rot
					Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
					Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
					For X=1 To Tiles()\X
						Field(Tiles()\Position()\X,Tiles()\Position()\Y+X-1)=1
					Next
				Else
					Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
					Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
					For X=1 To Tiles()\X
						Field(Tiles()\Position()\X+X-1,Tiles()\Position()\Y)=1
					Next
				EndIf
			Next
		Else
			Tiles()\NowX=-1
			Tiles()\NowRot=0
			Tiles()\DragRot=0
			Tiles()\DragX=41+30*Tiles()\InitX
			Tiles()\DragY=401+30*Tiles()\InitY
			Tiles()\DragW=25*Tiles()\X-2
			Tiles()\DragH=25*Tiles()\Y-2
		EndIf
	Next
	Solved=#False
EndProcedure

OpenWindow(#MainWindow,0,0,700,630,"PureMondrian",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
	Background.l=GetSysColor_(#COLOR_BTNFACE)
CompilerElse
	StartDrawing(WindowOutput(#MainWindow))
	Background=Point(0,0)
	StopDrawing()
CompilerEndIf
SetGadgetFont(#PB_Default,FontID(LoadFont(#PB_Any,"Verdana",10,#PB_Font_HighQuality)))
CanvasGadget(#Canvas,0,0,400,600,#PB_Canvas_ClipMouse)
StartDrawing(CanvasOutput(#Canvas))
Box(0,0,OutputWidth(),OutputHeight(),Background)
StopDrawing()
ListIconGadget(#List,400,0,300,600,"Riddle",180,#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
SetGadgetAttribute(#List, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
ComboBoxGadget(#Difficulty,400,600,200,30)
AddGadgetItem(#Difficulty,-1,"Einfach")
AddGadgetItem(#Difficulty,-1,"Mittel")
AddGadgetItem(#Difficulty,-1,"Schwer")
AddGadgetItem(#Difficulty,-1,"Meister")
SetGadgetState(#Difficulty,0)
ButtonGadget(#Language,600,600,100,30,"Sprache")
ButtonGadget(#InfoButton,0,600,100,30,"Info")
ButtonGadget(#SolveButton,150,600,100,30,"Lösen")
DisableGadget(#SolveButton,#True)
LoadTasks()
LoadList(0)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			Define MouseX = DesktopUnscaledX(GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX))
			Define MouseY = DesktopUnscaledY(GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY))
			
			Select EventType()
				Case #PB_EventType_LeftClick
					Select EventGadget()
						Case #InfoButton
							If Language
								MessageRequester("Information",~"PureMondrian\r\nby Jac de Lad\r\n\r\nHow to play:\r\nSelect a riddle. Drag and drop the tiles to build a 8x8-square; the black pieces are locked. While moving a part, rotate it with the right mouse button. Remove a placed tile with a right click on it.\r\n\r\nIn case of despair, use the solve button.",#PB_MessageRequester_Info)
							Else
								MessageRequester("Information",~"PureMondrian\r\nby Jac de Lad\r\n\r\nSpielanleitung:\r\nWähle ein Rätsel. Ziehe die Teile auf das 8x8-Quadrat; die schwarzen Teile sind vorgegeben. Während des Ziehens kann ein Teil mit der rechten Maustaste gedreht werden. Klicken sie mit rechts auf ein bereits platziertes Teil, um es zu entfernen.\r\n\r\nSollten sie verzweifeln, nutzen sie den Lösungsbutton.",#PB_MessageRequester_Info)
							EndIf
						Case #SolveButton
							Solve()
						Case #Language
							Language=1-Language
							If Language
								SetGadgetText(#Language,"Language")
								SetGadgetText(#SolveButton,"Solve")
								SetGadgetItemText(#Difficulty,0,"Easy")
								SetGadgetItemText(#Difficulty,1,"Medium")
								SetGadgetItemText(#Difficulty,2,"Hard")
								SetGadgetItemText(#Difficulty,3,"Master")
							Else  
								SetGadgetText(#Language,"Sprache")
								SetGadgetText(#SolveButton,"Lösen")
								SetGadgetItemText(#Difficulty,0,"Einfach")
								SetGadgetItemText(#Difficulty,1,"Mittel")
								SetGadgetItemText(#Difficulty,2,"Schwer")
								SetGadgetItemText(#Difficulty,3,"Meister")
							EndIf
							X=GetGadgetState(#List)
							LoadList(GetGadgetState(#Difficulty))
							SetGadgetState(#List,X)
							PostEvent(#PB_Event_Gadget,#MainWindow,#List,#PB_EventType_Change)
					EndSelect
				Case #PB_EventType_LeftButtonDown  
					Select EventGadget()
						Case #Canvas
							
							If Not Solved
								
								Y=#True
								MX=Round((MouseX-61)/40,#PB_Round_Nearest)
								MY=Round((MouseY-61)/40,#PB_Round_Nearest)
								If MX>=0 And MY>=0 And MX<=7 And MY<=7
									X=Field(MX,MY)
									If X>2
										DragTile=X
										SelectElement(Tiles(),X)
										Tiles()\NowX=-1
										For MX=0 To 7
											For MY=0 To 7
												If Field(MX,MY)=X
													Field(MX,MY)=0
												EndIf
											Next  
										Next
										Y=#False
									EndIf
								EndIf
								
								If Y  
									MX=MouseX
									MY=MouseY
									ForEach Tiles()
										If MX>=Tiles()\DragX And MX<=Tiles()\DragX+Tiles()\DragW And MY>=Tiles()\DragY And MY<=Tiles()\DragY+Tiles()\DragH And Tiles()\NowX=-1
											DragTile=ListIndex(Tiles())
											Break
										EndIf
									Next
								EndIf
								
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_LeftButtonUp  
					Select EventGadget()
						Case #Canvas
							If Not Solved
								If DragTile>-1 And Not NoDrop
									MX=MouseX
									MY=MouseY
									SelectElement(Tiles(),DragTile)
									
									If Tiles()\DragRot
										X=MX-0.8*Tiles()\DragH
										Y=MY-0.8*Tiles()\DragW
									Else
										X=MX-0.8*Tiles()\DragW
										Y=MY-0.8*Tiles()\DragH
									EndIf
									
									Tiles()\NowX=Round((X-41)/40,#PB_Round_Nearest)
									Tiles()\NowY=Round((Y-41)/40,#PB_Round_Nearest)
									Tiles()\NowRot=Tiles()\DragRot
									
									If Tiles()\NowRot
										For X=Tiles()\NowX To Tiles()\NowX+Tiles()\Y-1
											For Y=Tiles()\NowY To Tiles()\NowY+Tiles()\X-1
												Field(X,Y)=ListIndex(Tiles())
											Next
										Next
									Else
										For X=Tiles()\NowX To Tiles()\NowX+Tiles()\X-1
											For Y=Tiles()\NowY To Tiles()\NowY+Tiles()\Y-1
												Field(X,Y)=ListIndex(Tiles())
											Next
										Next
									EndIf
									
								EndIf
								DragTile=-1
								Draw(#False)
								
								X=0
								ForEach Tiles()
									If Tiles()\Fixed Or Tiles()\NowX<>-1
										X+1
									EndIf
								Next
								If X=11
									Solved=#True
									DisableGadget(#SolveButton,#True)
									If Language
										MessageRequester("Solved!","Hooray, you solved the riddle!",#PB_MessageRequester_Info)
									Else
										MessageRequester("Gelöst!","Hurra, sie haben das Rätsel gelöst!",#PB_MessageRequester_Info)
									EndIf
								EndIf
								
							EndIf
					EndSelect
				Case #PB_EventType_MouseMove
					Select EventGadget()
						Case #Canvas
							If DragTile<>-1
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_RightClick
					Select EventGadget()
						Case #Canvas
							If DragTile=-1
								If Not Solved
									MX=Round((MouseX-61)/40.0,#PB_Round_Nearest)
									MY=Round((MouseY-61)/40.0,#PB_Round_Nearest)
									If MX>=0 And MY>=0 And MX<=7 And MY<=7
										X=Field(MX,MY)
										If X>2
											SelectElement(Tiles(),X)
											Tiles()\NowX=-1
											For MX=0 To 7
												For MY=0 To 7
													If Field(MX,MY)=X
														Field(MX,MY)=0
													EndIf
												Next  
											Next
											Draw(#False)
										EndIf
									EndIf								
								EndIf
							Else
								SelectElement(Tiles(),DragTile)
								Tiles()\DragRot=1-Tiles()\DragRot
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_Change
					Select EventGadget()
						Case #List
							If GetGadgetState(#List)=-1
								StartDrawing(CanvasOutput(#Canvas))
								Box(0,0,OutputWidth(),OutputHeight(),Background)
								StopDrawing()
								DisableGadget(#SolveButton,#True)
								Solved=#True
							Else
								LoadTask(GetGadgetItemData(#List,GetGadgetState(#List)))
								Draw(#False)
								DisableGadget(#SolveButton,#False)
							EndIf
						Case #Difficulty
							LoadList(GetGadgetState(#Difficulty))
					EndSelect
			EndSelect
	EndSelect
	
ForEver

DataSection
	Tasks:
	Data.a 0,0,1,0,4,0,5,3,1
	Data.a 0,2,1,3,6,0,0,2,0
	Data.a 0,3,5,2,4,1,0,2,0
	Data.a 0,1,0,6,7,0,5,2,0
	Data.a 0,1,3,4,2,0,6,2,1
	Data.a 0,1,7,1,6,0,0,2,0
	Data.a 0,0,0,1,3,0,1,5,0
	Data.a 0,7,7,1,5,0,1,2,1
	Data.a 0,2,3,3,2,0,4,4,0
	Data.a 0,6,0,4,4,0,5,5,1
	Data.a 0,0,0,2,0,1,5,3,1
	Data.a 0,0,7,0,5,0,3,0,1
	Data.a 0,2,1,7,5,1,7,0,1
	Data.a 0,6,3,1,2,1,0,5,1
	Data.a 0,2,4,6,2,0,5,0,0
	Data.a 0,3,6,4,1,1,7,0,1
	Data.a 0,7,4,4,4,0,5,7,0
	Data.a 0,3,2,1,3,1,4,7,0
	Data.a 0,3,5,4,5,1,0,1,0
	Data.a 0,7,7,2,4,0,3,7,0
	Data.a 0,7,3,4,3,0,2,0,0
	Data.a 0,1,2,5,4,0,2,0,0
	
	Data.a 1,4,2,5,3,1,1,2,0
	Data.a 1,2,1,3,1,1,0,5,1
	Data.a 1,3,2,7,5,1,7,0,1
	Data.a 1,6,4,2,3,0,0,0,0
	Data.a 1,2,7,4,3,0,7,4,1
	Data.a 1,7,2,7,6,1,4,5,1
	Data.a 1,3,3,0,7,0,2,1,1
	Data.a 1,5,5,7,3,1,4,1,1
	Data.a 1,4,4,1,7,0,3,2,1
	Data.a 1,3,5,7,4,1,0,4,0
	Data.a 1,7,3,2,4,0,3,5,0
	Data.a 1,2,5,7,5,1,3,3,0
	Data.a 1,4,2,5,6,1,2,0,1
	Data.a 1,2,3,7,2,1,4,2,1
	Data.a 1,5,0,0,2,0,0,3,0
	Data.a 1,3,6,0,3,1,5,5,0
	Data.a 1,5,0,0,4,1,3,3,1
	Data.a 1,3,4,4,2,1,2,4,1
	Data.a 1,1,3,3,0,1,5,3,0
	Data.a 1,3,0,0,2,0,5,3,0
	Data.a 1,4,4,3,1,0,0,1,0
	Data.a 1,5,5,3,1,0,0,1,0
	
	Data.a 2,3,1,5,4,1,0,5,1
	Data.a 2,5,5,6,3,0,3,4,0
	Data.a 2,4,3,7,4,1,0,2,0
	Data.a 2,6,3,2,3,0,7,3,1
	Data.a 2,4,3,0,4,0,0,0,0
	Data.a 2,6,3,2,2,0,7,3,1
	Data.a 2,0,0,7,4,1,3,5,1
	Data.a 2,5,3,5,2,1,2,0,0
	Data.a 2,4,5,7,2,1,0,2,1
	Data.a 2,3,3,4,6,1,3,0,0
	Data.a 2,2,4,3,2,1,0,3,0
	Data.a 2,4,2,2,0,0,3,5,1
	Data.a 2,1,4,2,7,0,0,2,1
	Data.a 2,5,4,2,0,0,0,3,1
	Data.a 2,6,4,3,6,1,7,2,1
	Data.a 2,2,2,4,4,1,7,5,1
	Data.a 2,5,3,0,2,0,2,5,0
	Data.a 2,2,2,0,4,0,5,3,0
	Data.a 2,5,4,4,4,1,3,0,1
	Data.a 2,5,3,3,2,0,0,4,0
	Data.a 2,6,3,3,4,1,4,4,0
	Data.a 2,3,4,0,2,1,7,3,1
	
	Data.a 3,5,5,3,0,1,0,7,0
	Data.a 3,4,2,6,5,0,2,7,0
	Data.a 3,3,4,5,0,1,7,3,1
	Data.a 3,4,5,2,0,1,0,5,1
	Data.a 3,2,3,4,5,0,0,0,0
	Data.a 3,4,3,0,2,1,5,0,0
	Data.a 3,3,2,4,2,0,0,0,1
	Data.a 3,2,6,3,3,1,0,7,0
	Data.a 3,1,2,3,7,0,0,0,1
	Data.a 3,5,5,2,6,1,2,0,0
	Data.a 3,3,4,4,6,1,5,7,0
	Data.a 3,3,3,4,2,1,2,7,0
	Data.a 3,5,4,4,3,1,2,0,0
	Data.a 3,4,2,2,4,0,0,0,1
	Data.a 3,2,5,0,2,0,7,5,1
	Data.a 3,5,3,3,4,1,2,0,0
	Data.a 3,4,4,2,6,1,3,0,0
	Data.a 3,2,2,4,0,0,5,1,1
	Data.a 3,2,5,4,3,1,3,0,1
	Data.a 3,2,4,7,3,1,5,5,0
	Data.a 3,2,2,0,6,1,5,4,0
	Data.a 3,2,6,0,3,1,0,7,0
	
	TasksEnd:
EndDataSection

[jacdelad]

@idle: Hehehe!
@moulder61: That's why I included the source. Maybe a rectangle around the shapes will make it more visible.
@Mr.L: I'll try this. May I use your modifications?

[Mr.L]

@Mr.L: I'll try this. May I use your modifications?

Of course, you may! Here is another modification, using the Vector lib...

Code: Select all

;PureMondrian 1.0 by Jac de Lad
EnableExplicit

Enumeration Window
	#MainWindow
EndEnumeration
Enumeration Gadget
	#Canvas
	#List
	#SolveButton
	#InfoButton
	#Difficulty
	#Language
EndEnumeration

Structure Occupied
	X.a
	Y.a
	EX.a
	EY.a
EndStructure

Structure MPos
	X.a
	Y.a
	Rot.a
	EX.a
	EY.a
EndStructure

Structure Tile
	X.a
	Y.a
	InitX.a
	InitY.a
	NowX.b
	NowY.a
	NowRot.a
	Color.l
	Fixed.a
	DragX.w
	DragY.w
	DragW.w
	DragH.w
	DragRot.a
	RPosition.a
	List Position.MPos()
EndStructure

Structure XY
	X.a
	Y.a
EndStructure

Structure Task
	Difficulty.a
	Tile1X.a
	Tile1Y.a
	Tile2X.a
	Tile2Y.a
	Tile2R.a
	Tile3X.a
	Tile3Y.a
	Tile3R.a
	Image.i
EndStructure

Global Dim Field.a(7,7),NewList Tiles.Tile(),NewList PositionMatrix.MPos(),Thread.i,NewList Tasks.Task(), Background.l,Language.a,DragTile.b=-1,MX.w,MY.w,X.w,Y.w,Solved.a=#True,NoDrop.a


Procedure AddPathRoundBox(x.d,y.d,w.d,h.d,radius.d,flags=#PB_Path_Default)
	MovePathCursor(x+radius,y,flags)
	AddPathArc(w-radius,0,w-radius,radius,radius,#PB_Path_Relative)
	AddPathArc(0,h-radius,-radius,h-radius,radius,#PB_Path_Relative)
	AddPathArc(-w+radius,0,-w+radius,-radius,radius,#PB_Path_Relative)
	AddPathArc(0,-h+radius,radius,-h+radius,radius,#PB_Path_Relative)
	ClosePath()
EndProcedure


Procedure Draw(Mode)
	Protected PL.a,MX.w,MY.w
	Protected X.w,Y.w,W.w,H.w,PX.w,PY.w,PEX.w,PEY.w
	
	StartVectorDrawing(CanvasVectorOutput(#Canvas))
	
	VectorSourceColor(Background)
	FillVectorOutput()
	
	ScaleCoordinates(DesktopResolutionX(), DesktopResolutionY())
	
	If Not mode
		For X=1 To 9
			MovePathCursor(40*X, 40)
			AddPathLine(0, 320, #PB_Path_Relative)
			MovePathCursor(40, 40*X-1)
			AddPathLine(320, 0, #PB_Path_Relative)
		Next
		VectorSourceColor(RGBA(32,32,32,255))
		DotPath(1, 3)
	EndIf
	ForEach Tiles()
		If Not Mode
			FirstElement(Tiles()\Position())
		EndIf
		If Mode Or Tiles()\Fixed
			AddPathBox(41+40*Tiles()\Position()\X,
			                41+40*Tiles()\Position()\Y,
			                40*(Tiles()\Position()\EX-Tiles()\Position()\X+1)-3,
			                40*(Tiles()\Position()\EY-Tiles()\Position()\Y+1)-3)
		EndIf
		If Not Mode And Not Tiles()\Fixed
			If Tiles()\NowX=-1
				If DragTile=ListIndex(Tiles())
					PushListPosition(Tiles())
					PL=#True
				Else
					AddPathRoundBox(Tiles()\DragX,Tiles()\DragY,Tiles()\DragW,Tiles()\DragH, 8)
				EndIf
			Else
				If Tiles()\NowRot
					AddPathRoundBox(41+40*Tiles()\NowX,41+40*Tiles()\NowY,40*Tiles()\Y-3,40*Tiles()\X-3, 8)
				Else
					AddPathRoundBox(41+40*Tiles()\NowX,41+40*Tiles()\NowY,40*Tiles()\X-3,40*Tiles()\Y-3, 8)
				EndIf
			EndIf
		EndIf
		If Tiles()\Fixed
			VectorSourceColor(Tiles()\Color)
		Else
			VectorSourceLinearGradient(PathBoundsX(), PathBoundsY(),PathBoundsX(), PathBoundsY() + PathBoundsHeight())
			VectorSourceGradientColor(RGBA(255,255,255,255), 0)
			VectorSourceGradientColor(Tiles()\Color, 1)
		EndIf
		
		FillPath(#PB_Path_Preserve)
		VectorSourceColor(RGBA(64,64,64,255))
		StrokePath(3)
	Next
	If PL
		PopListPosition(Tiles())
		MX=DesktopUnscaledX(WindowMouseX(#MainWindow))
		MY=DesktopUnscaledY(WindowMouseY(#MainWindow))
		If Tiles()\DragRot
			X=MX-0.8*Tiles()\DragH
			Y=MY-0.8*Tiles()\DragW
			W=Tiles()\DragH*1.6
			H=Tiles()\DragW*1.6
		Else
			X=MX-0.8*Tiles()\DragW
			Y=MY-0.8*Tiles()\DragH
			W=Tiles()\DragW*1.6
			H=Tiles()\DragH*1.6
		EndIf
		VectorSourceColor(RGBA(Red(Tiles()\Color), Green(Tiles()\Color), Blue(Tiles()\Color), 128))
		
		PX=Round((X-41)/40,#PB_Round_Nearest)
		PY=Round((Y-41)/40,#PB_Round_Nearest)
		PEX=PX+Round((W-41)/40,#PB_Round_Nearest)
		PEY=PY+Round((H-41)/40,#PB_Round_Nearest)
		NoDrop=#False
		
		If PX<0 Or PY<0 Or PEX>7 Or PEY>7
			NoDrop=#True
		Else
			For MX=PX To PEX
				For MY=PY To PEY
					If Field(MX,MY)>0
						NoDrop=#True
						Break
					EndIf
				Next
			Next
			
		EndIf
		
		AddPathRoundBox(X,Y,W,H, 8)
		If NoDrop
			VectorSourceColor(RGBA(128,128,128,128))
		EndIf
		FillPath(#PB_Path_Preserve)
		VectorSourceColor(RGBA(0,0,0,255))
		StrokePath(2)
	EndIf
	StopVectorDrawing()
EndProcedure

Macro CreateTile(MyX,MyY,MyInitX,MyInitY,MyColor,MyFixed=#False)
	AddElement(Tiles())
	Tiles()\X=MyX
	Tiles()\Y=MyY
	Tiles()\InitX=MyInitX
	Tiles()\InitY=MyInitY
	Tiles()\Color=RGBA(Red(MyColor),Green(MyColor),Blue(MyColor),255)
	Tiles()\Fixed=MyFixed
EndMacro
CreateTile(1,1,0,0,RGB(64,64,64),#True)
CreateTile(2,1,0,0,RGB(64,64,64),#True)
CreateTile(3,1,0,0,RGB(64,64,64),#True)
CreateTile(4,3,6,3,#Blue)
CreateTile(3,3,3,3,#Cyan)
CreateTile(5,2,6,1,#Red)
CreateTile(4,2,2,1,#Cyan)
CreateTile(3,2,0,3,#Red)
CreateTile(2,2,0,1,#Cyan)
CreateTile(5,1,0,0,#Yellow)
CreateTile(4,1,5,0,#Yellow)

Procedure Solve()
	Protected X.a,Y.a,*Pos.Tile,*MPos.MPos,NewList Locked.XY(),Position.w,Del.a,NewList Occupied.Tile(),Dim Field.a(7,7),Done.a,error.a
	
	;Teilematrix erstellen
	ForEach Tiles()
		If Not Tiles()\Fixed
			ClearList(Tiles()\Position())
			Tiles()\RPosition=0
			For X=0 To 7
				For Y=0 To 7
					If X+Tiles()\X<=8 And Y+Tiles()\Y<=8
						AddElement(Tiles()\Position())
						Tiles()\Position()\X=X
						Tiles()\Position()\Y=Y
						Tiles()\Position()\Rot=0
					EndIf
					If Tiles()\X<>Tiles()\Y And X+Tiles()\Y<=8 And Y+Tiles()\X<=8
						AddElement(Tiles()\Position())
						Tiles()\Position()\X=X
						Tiles()\Position()\Y=Y
						Tiles()\Position()\Rot=1
					EndIf
				Next
			Next
		EndIf
	Next
	
	;Gesperrte Positionen ermitteln
	ForEach Tiles()
		If Tiles()\Fixed
			ForEach Tiles()\Position()
				If Tiles()\Position()\Rot
					For X=0 To Tiles()\Y-1
						For Y=0 To Tiles()\X-1
							AddElement(Locked())
							Locked()\X=Tiles()\Position()\X+X
							Locked()\Y=Tiles()\Position()\Y+Y
						Next  
					Next
					;           Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
					;           Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
				Else
					For X=0 To Tiles()\X-1
						For Y=0 To Tiles()\Y-1
							AddElement(Locked())
							Locked()\X=Tiles()\Position()\X+X
							Locked()\Y=Tiles()\Position()\Y+Y
						Next  
					Next  
					;           Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
					;           Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
				EndIf
			Next
		EndIf
	Next
	
	;Teilematrix ausdünnen
	ForEach Tiles()
		If Not Tiles()\Fixed
			Position=ListSize(Tiles()\Position())-1
			Repeat
				SelectElement(Tiles()\Position(),Position)
				Del=#False
				ForEach Locked()
					If Tiles()\Position()\Rot
						If Locked()\X>=Tiles()\Position()\X And Locked()\X<Tiles()\Position()\X+Tiles()\Y And Locked()\Y>=Tiles()\Position()\Y And Locked()\Y<Tiles()\Position()\Y+Tiles()\X
							DeleteElement(Tiles()\Position(),1)
							Del=#True
							Break
						EndIf
					Else
						If Locked()\X>=Tiles()\Position()\X And Locked()\X<Tiles()\Position()\X+Tiles()\X And Locked()\Y>=Tiles()\Position()\Y And Locked()\Y<Tiles()\Position()\Y+Tiles()\Y
							DeleteElement(Tiles()\Position(),1)
							Del=#True
							Break
						EndIf
					EndIf
				Next
				If Not Del
					If Tiles()\Position()\Rot
						Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
						Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
					Else
						Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
						Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
					EndIf
				EndIf
				Position-1
			Until Position<0
		EndIf
	Next
	
	;Brute-Force-Placement-Attacke
	Protected Count.q
	
	Repeat
		
		;Teile prüfen
		FreeArray(Field())
		Dim Field(7,7)
		Done=#True
		ForEach Tiles()
			If Not Tiles()\Fixed
				SelectElement(Tiles()\Position(),Tiles()\RPosition)
				For X=Tiles()\Position()\X To Tiles()\Position()\EX
					For Y=Tiles()\Position()\Y To Tiles()\Position()\EY
						If Field(X,Y)
							Done=#False
							Break 3
						Else
							Field(X,Y)=1
						EndIf
					Next
				Next
			EndIf
		Next  
		
		If Done
			Break
		EndIf
		
		Tiles()\RPosition+1
		Repeat
			If Tiles()\RPosition>=ListSize(Tiles()\Position())
				Tiles()\RPosition=0
				If PreviousElement(Tiles())
					Tiles()\RPosition+1
				Else
					If Language
						MessageRequester("Error","There was no solution found!",#PB_MessageRequester_Error)
					Else
						MessageRequester("Fehler","Es konnte keine Lösung gefunden werden!",#PB_MessageRequester_Error)
					EndIf
					error=#True
					Break 2
				EndIf
			Else
				Break
			EndIf
		ForEver
		Count+1
		
	ForEver
	
	If Not error
		Solved=#True
		Draw(#True)
		DisableGadget(#SolveButton,#True)
	EndIf
	
EndProcedure

Procedure LoadList(Difficulty)
	ClearGadgetItems(#List)
	ForEach Tasks()
		If Tasks()\Difficulty=Difficulty
			If Language
				AddGadgetItem(#List,-1,"Riddle "+Str(ListIndex(Tasks())+1),ImageID(Tasks()\Image))
			Else
				AddGadgetItem(#List,-1,"Rätsel "+Str(ListIndex(Tasks())+1),ImageID(Tasks()\Image))
			EndIf
		EndIf
		SetGadgetItemData(#List,CountGadgetItems(#List)-1,@Tasks())
	Next
	StartDrawing(CanvasOutput(#Canvas))
	Box(0,0,400,400,Background)
	StopDrawing()
	DisableGadget(#SolveButton,#True)
EndProcedure

Procedure LoadTasks()
	Protected *Mem=?Tasks,Size.a=4
	Repeat
		AddElement(Tasks())
		Tasks()\Difficulty=PeekA(*Mem)
		Tasks()\Tile1X=PeekA(*Mem+1)
		Tasks()\Tile1Y=PeekA(*Mem+2)
		Tasks()\Tile2X=PeekA(*Mem+3)
		Tasks()\Tile2Y=PeekA(*Mem+4)
		Tasks()\Tile2R=PeekA(*Mem+5)
		Tasks()\Tile3X=PeekA(*Mem+6)
		Tasks()\Tile3Y=PeekA(*Mem+7)
		Tasks()\Tile3R=PeekA(*Mem+8)
		Tasks()\Image=CreateImage(#PB_Any,8*Size+4,8*Size+4,24,#Green)
		StartDrawing(ImageOutput(Tasks()\Image))
		Box(2,2,8*Size,8*Size,Background)
		Box(2+Tasks()\Tile1X*Size,2+Tasks()\Tile1Y*Size,Size,Size,#Black)
		If Tasks()\Tile2R
			Box(2+Tasks()\Tile2X*Size,2+Tasks()\Tile2Y*Size,Size,Size*2,#Black)
		Else
			Box(2+Tasks()\Tile2X*Size,2+Tasks()\Tile2Y*Size,Size*2,Size,#Black)
		EndIf
		If Tasks()\Tile3R
			Box(2+Tasks()\Tile3X*Size,2+Tasks()\Tile3Y*Size,Size,Size*3,#Black)
		Else
			Box(2+Tasks()\Tile3X*Size,2+Tasks()\Tile3Y*Size,Size*3,Size,#Black)
		EndIf
		StopDrawing()
		*Mem+9
	Until *Mem>=?TasksEnd
EndProcedure

Procedure LoadTask(Task)
	Protected X.a
	ForEach Tiles()
		ClearList(Tiles()\Position())
	Next
	ChangeCurrentElement(Tasks(),Task)
	FirstElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile1X
	Tiles()\Position()\Y=Tasks()\Tile1Y
	NextElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile2X
	Tiles()\Position()\Y=Tasks()\Tile2Y
	Tiles()\Position()\Rot=Tasks()\Tile2R
	NextElement(Tiles())
	AddElement(Tiles()\Position())
	Tiles()\Position()\X=Tasks()\Tile3X
	Tiles()\Position()\Y=Tasks()\Tile3Y
	Tiles()\Position()\Rot=Tasks()\Tile3R
	FreeArray(Field())
	Dim Field(7,7)
	ForEach Tiles()
		If Tiles()\Fixed
			ForEach Tiles()\Position()
				If Tiles()\Position()\Rot
					Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\Y-1
					Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\X-1
					For X=1 To Tiles()\X
						Field(Tiles()\Position()\X,Tiles()\Position()\Y+X-1)=1
					Next
				Else
					Tiles()\Position()\EX=Tiles()\Position()\X+Tiles()\X-1
					Tiles()\Position()\EY=Tiles()\Position()\Y+Tiles()\Y-1
					For X=1 To Tiles()\X
						Field(Tiles()\Position()\X+X-1,Tiles()\Position()\Y)=1
					Next
				EndIf
			Next
		Else
			Tiles()\NowX=-1
			Tiles()\NowRot=0
			Tiles()\DragRot=0
			Tiles()\DragX=41+30*Tiles()\InitX
			Tiles()\DragY=401+30*Tiles()\InitY
			Tiles()\DragW=25*Tiles()\X-2
			Tiles()\DragH=25*Tiles()\Y-2
		EndIf
	Next
	Solved=#False
EndProcedure

OpenWindow(#MainWindow,0,0,700,630,"PureMondrian",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
	Background.l = GetSysColor_(#COLOR_BTNFACE)
CompilerElse
	StartDrawing(WindowOutput(#MainWindow))
	Background = Point(0,0)
	StopDrawing()
CompilerEndIf
Background = RGBA(Red(Background),Green(Background),Blue(Background),255)

SetGadgetFont(#PB_Default,FontID(LoadFont(#PB_Any,"Verdana",10,#PB_Font_HighQuality)))
CanvasGadget(#Canvas,0,0,400,600,#PB_Canvas_ClipMouse)
StartDrawing(CanvasOutput(#Canvas))
Box(0,0,OutputWidth(),OutputHeight(),Background)
StopDrawing()
ListIconGadget(#List,400,0,300,600,"Riddle",180,#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
SetGadgetAttribute(#List, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
ComboBoxGadget(#Difficulty,400,600,200,30)
AddGadgetItem(#Difficulty,-1,"Einfach")
AddGadgetItem(#Difficulty,-1,"Mittel")
AddGadgetItem(#Difficulty,-1,"Schwer")
AddGadgetItem(#Difficulty,-1,"Meister")
SetGadgetState(#Difficulty,0)
ButtonGadget(#Language,600,600,100,30,"Sprache")
ButtonGadget(#InfoButton,0,600,100,30,"Info")
ButtonGadget(#SolveButton,150,600,100,30,"Lösen")
DisableGadget(#SolveButton,#True)
LoadTasks()
LoadList(0)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			Define MouseX = DesktopUnscaledX(GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX))
			Define MouseY = DesktopUnscaledY(GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY))
			
			Select EventType()
				Case #PB_EventType_LeftClick
					Select EventGadget()
						Case #InfoButton
							If Language
								MessageRequester("Information",~"PureMondrian\r\nby Jac de Lad\r\n\r\nHow to play:\r\nSelect a riddle. Drag and drop the tiles to build a 8x8-square; the black pieces are locked. While moving a part, rotate it with the right mouse button. Remove a placed tile with a right click on it.\r\n\r\nIn case of despair, use the solve button.",#PB_MessageRequester_Info)
							Else
								MessageRequester("Information",~"PureMondrian\r\nby Jac de Lad\r\n\r\nSpielanleitung:\r\nWähle ein Rätsel. Ziehe die Teile auf das 8x8-Quadrat; die schwarzen Teile sind vorgegeben. Während des Ziehens kann ein Teil mit der rechten Maustaste gedreht werden. Klicken sie mit rechts auf ein bereits platziertes Teil, um es zu entfernen.\r\n\r\nSollten sie verzweifeln, nutzen sie den Lösungsbutton.",#PB_MessageRequester_Info)
							EndIf
						Case #SolveButton
							Solve()
						Case #Language
							Language=1-Language
							If Language
								SetGadgetText(#Language,"Language")
								SetGadgetText(#SolveButton,"Solve")
								SetGadgetItemText(#Difficulty,0,"Easy")
								SetGadgetItemText(#Difficulty,1,"Medium")
								SetGadgetItemText(#Difficulty,2,"Hard")
								SetGadgetItemText(#Difficulty,3,"Master")
							Else  
								SetGadgetText(#Language,"Sprache")
								SetGadgetText(#SolveButton,"Lösen")
								SetGadgetItemText(#Difficulty,0,"Einfach")
								SetGadgetItemText(#Difficulty,1,"Mittel")
								SetGadgetItemText(#Difficulty,2,"Schwer")
								SetGadgetItemText(#Difficulty,3,"Meister")
							EndIf
							X=GetGadgetState(#List)
							LoadList(GetGadgetState(#Difficulty))
							SetGadgetState(#List,X)
							PostEvent(#PB_Event_Gadget,#MainWindow,#List,#PB_EventType_Change)
					EndSelect
				Case #PB_EventType_LeftButtonDown  
					Select EventGadget()
						Case #Canvas
							
							If Not Solved
								
								Y=#True
								MX=Round((MouseX-61)/40,#PB_Round_Nearest)
								MY=Round((MouseY-61)/40,#PB_Round_Nearest)
								If MX>=0 And MY>=0 And MX<=7 And MY<=7
									X=Field(MX,MY)
									If X>2
										DragTile=X
										SelectElement(Tiles(),X)
										Tiles()\NowX=-1
										For MX=0 To 7
											For MY=0 To 7
												If Field(MX,MY)=X
													Field(MX,MY)=0
												EndIf
											Next  
										Next
										Y=#False
									EndIf
								EndIf
								
								If Y  
									MX=MouseX
									MY=MouseY
									ForEach Tiles()
										If MX>=Tiles()\DragX And MX<=Tiles()\DragX+Tiles()\DragW And MY>=Tiles()\DragY And MY<=Tiles()\DragY+Tiles()\DragH And Tiles()\NowX=-1
											DragTile=ListIndex(Tiles())
											Break
										EndIf
									Next
								EndIf
								
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_LeftButtonUp  
					Select EventGadget()
						Case #Canvas
							If Not Solved
								If DragTile>-1 And Not NoDrop
									MX=MouseX
									MY=MouseY
									SelectElement(Tiles(),DragTile)
									
									If Tiles()\DragRot
										X=MX-0.8*Tiles()\DragH
										Y=MY-0.8*Tiles()\DragW
									Else
										X=MX-0.8*Tiles()\DragW
										Y=MY-0.8*Tiles()\DragH
									EndIf
									
									Tiles()\NowX=Round((X-41)/40,#PB_Round_Nearest)
									Tiles()\NowY=Round((Y-41)/40,#PB_Round_Nearest)
									Tiles()\NowRot=Tiles()\DragRot
									
									If Tiles()\NowRot
										For X=Tiles()\NowX To Tiles()\NowX+Tiles()\Y-1
											For Y=Tiles()\NowY To Tiles()\NowY+Tiles()\X-1
												Field(X,Y)=ListIndex(Tiles())
											Next
										Next
									Else
										For X=Tiles()\NowX To Tiles()\NowX+Tiles()\X-1
											For Y=Tiles()\NowY To Tiles()\NowY+Tiles()\Y-1
												Field(X,Y)=ListIndex(Tiles())
											Next
										Next
									EndIf
									
								EndIf
								DragTile=-1
								Draw(#False)
								
								X=0
								ForEach Tiles()
									If Tiles()\Fixed Or Tiles()\NowX<>-1
										X+1
									EndIf
								Next
								If X=11
									Solved=#True
									DisableGadget(#SolveButton,#True)
									If Language
										MessageRequester("Solved!","Hooray, you solved the riddle!",#PB_MessageRequester_Info)
									Else
										MessageRequester("Gelöst!","Hurra, sie haben das Rätsel gelöst!",#PB_MessageRequester_Info)
									EndIf
								EndIf
								
							EndIf
					EndSelect
				Case #PB_EventType_MouseMove
					Select EventGadget()
						Case #Canvas
							If DragTile<>-1
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_RightClick
					Select EventGadget()
						Case #Canvas
							If DragTile=-1
								If Not Solved
									MX=Round((MouseX-61)/40.0,#PB_Round_Nearest)
									MY=Round((MouseY-61)/40.0,#PB_Round_Nearest)
									If MX>=0 And MY>=0 And MX<=7 And MY<=7
										X=Field(MX,MY)
										If X>2
											SelectElement(Tiles(),X)
											Tiles()\NowX=-1
											For MX=0 To 7
												For MY=0 To 7
													If Field(MX,MY)=X
														Field(MX,MY)=0
													EndIf
												Next  
											Next
											Draw(#False)
										EndIf
									EndIf								
								EndIf
							Else
								SelectElement(Tiles(),DragTile)
								Tiles()\DragRot=1-Tiles()\DragRot
								Draw(#False)
							EndIf
					EndSelect
				Case #PB_EventType_Change
					Select EventGadget()
						Case #List
							If GetGadgetState(#List)=-1
								StartDrawing(CanvasOutput(#Canvas))
								Box(0,0,OutputWidth(),OutputHeight(),Background)
								StopDrawing()
								DisableGadget(#SolveButton,#True)
								Solved=#True
							Else
								LoadTask(GetGadgetItemData(#List,GetGadgetState(#List)))
								Draw(#False)
								DisableGadget(#SolveButton,#False)
							EndIf
						Case #Difficulty
							LoadList(GetGadgetState(#Difficulty))
					EndSelect
			EndSelect
	EndSelect
	
ForEver

DataSection
	Tasks:
	Data.a 0,0,1,0,4,0,5,3,1
	Data.a 0,2,1,3,6,0,0,2,0
	Data.a 0,3,5,2,4,1,0,2,0
	Data.a 0,1,0,6,7,0,5,2,0
	Data.a 0,1,3,4,2,0,6,2,1
	Data.a 0,1,7,1,6,0,0,2,0
	Data.a 0,0,0,1,3,0,1,5,0
	Data.a 0,7,7,1,5,0,1,2,1
	Data.a 0,2,3,3,2,0,4,4,0
	Data.a 0,6,0,4,4,0,5,5,1
	Data.a 0,0,0,2,0,1,5,3,1
	Data.a 0,0,7,0,5,0,3,0,1
	Data.a 0,2,1,7,5,1,7,0,1
	Data.a 0,6,3,1,2,1,0,5,1
	Data.a 0,2,4,6,2,0,5,0,0
	Data.a 0,3,6,4,1,1,7,0,1
	Data.a 0,7,4,4,4,0,5,7,0
	Data.a 0,3,2,1,3,1,4,7,0
	Data.a 0,3,5,4,5,1,0,1,0
	Data.a 0,7,7,2,4,0,3,7,0
	Data.a 0,7,3,4,3,0,2,0,0
	Data.a 0,1,2,5,4,0,2,0,0
	
	Data.a 1,4,2,5,3,1,1,2,0
	Data.a 1,2,1,3,1,1,0,5,1
	Data.a 1,3,2,7,5,1,7,0,1
	Data.a 1,6,4,2,3,0,0,0,0
	Data.a 1,2,7,4,3,0,7,4,1
	Data.a 1,7,2,7,6,1,4,5,1
	Data.a 1,3,3,0,7,0,2,1,1
	Data.a 1,5,5,7,3,1,4,1,1
	Data.a 1,4,4,1,7,0,3,2,1
	Data.a 1,3,5,7,4,1,0,4,0
	Data.a 1,7,3,2,4,0,3,5,0
	Data.a 1,2,5,7,5,1,3,3,0
	Data.a 1,4,2,5,6,1,2,0,1
	Data.a 1,2,3,7,2,1,4,2,1
	Data.a 1,5,0,0,2,0,0,3,0
	Data.a 1,3,6,0,3,1,5,5,0
	Data.a 1,5,0,0,4,1,3,3,1
	Data.a 1,3,4,4,2,1,2,4,1
	Data.a 1,1,3,3,0,1,5,3,0
	Data.a 1,3,0,0,2,0,5,3,0
	Data.a 1,4,4,3,1,0,0,1,0
	Data.a 1,5,5,3,1,0,0,1,0
	
	Data.a 2,3,1,5,4,1,0,5,1
	Data.a 2,5,5,6,3,0,3,4,0
	Data.a 2,4,3,7,4,1,0,2,0
	Data.a 2,6,3,2,3,0,7,3,1
	Data.a 2,4,3,0,4,0,0,0,0
	Data.a 2,6,3,2,2,0,7,3,1
	Data.a 2,0,0,7,4,1,3,5,1
	Data.a 2,5,3,5,2,1,2,0,0
	Data.a 2,4,5,7,2,1,0,2,1
	Data.a 2,3,3,4,6,1,3,0,0
	Data.a 2,2,4,3,2,1,0,3,0
	Data.a 2,4,2,2,0,0,3,5,1
	Data.a 2,1,4,2,7,0,0,2,1
	Data.a 2,5,4,2,0,0,0,3,1
	Data.a 2,6,4,3,6,1,7,2,1
	Data.a 2,2,2,4,4,1,7,5,1
	Data.a 2,5,3,0,2,0,2,5,0
	Data.a 2,2,2,0,4,0,5,3,0
	Data.a 2,5,4,4,4,1,3,0,1
	Data.a 2,5,3,3,2,0,0,4,0
	Data.a 2,6,3,3,4,1,4,4,0
	Data.a 2,3,4,0,2,1,7,3,1
	
	Data.a 3,5,5,3,0,1,0,7,0
	Data.a 3,4,2,6,5,0,2,7,0
	Data.a 3,3,4,5,0,1,7,3,1
	Data.a 3,4,5,2,0,1,0,5,1
	Data.a 3,2,3,4,5,0,0,0,0
	Data.a 3,4,3,0,2,1,5,0,0
	Data.a 3,3,2,4,2,0,0,0,1
	Data.a 3,2,6,3,3,1,0,7,0
	Data.a 3,1,2,3,7,0,0,0,1
	Data.a 3,5,5,2,6,1,2,0,0
	Data.a 3,3,4,4,6,1,5,7,0
	Data.a 3,3,3,4,2,1,2,7,0
	Data.a 3,5,4,4,3,1,2,0,0
	Data.a 3,4,2,2,4,0,0,0,1
	Data.a 3,2,5,0,2,0,7,5,1
	Data.a 3,5,3,3,4,1,2,0,0
	Data.a 3,4,4,2,6,1,3,0,0
	Data.a 3,2,2,4,0,0,5,1,1
	Data.a 3,2,5,4,3,1,3,0,1
	Data.a 3,2,4,7,3,1,5,5,0
	Data.a 3,2,2,0,6,1,5,4,0
	Data.a 3,2,6,0,3,1,0,7,0
	
	TasksEnd:
EndDataSection

[jacdelad]

Oh my god, this is awesome! I'll not modify my code but put a link to your post! This is really great!

[Justin]

Hi Mr.L,

none of yout modifications work here, this is how it looks at 4k 200% scaling:

[moulder61]

@jacdelad
I would say the shapes with outlines might be a good idea but the black squares would need outlines too, or maybe some kind of hatching pattern to make them stand out?
When I first tried the game I couldn't always place the shapes where I wanted because I didn't notice the odd single black square and wondered why it wasn't letting me put it there? The bigger black squares overwrite the the green grid somewhat so they are easily noticeable.

@Mr.L
Your first modification seems to work nicely for me although I don't have a need for scaling, personally. Not sure who does? It just looks like zooming into the desktop a bit which I can kind of do in XFCE on Linux anyway. (Not an ideal situation as the screen moves about while zoomed in).
The second mod looks very nice but doesn't work for me. I can click on the buttons OK but can't move the shapes, unfortunately.

Moulder.

[jacdelad]

I leave the graphical updates to Mr.L, who did a fantastic overhaul to the graphics.
Anyway, everybody can adapt it to their needs, if wanted. Don't forget to post it here, we want to see it too!

[Justin]

the dpi scaling works except for the right panel, i forgot to select a puzzle, maybe the first one should be selected by default

[Mr.L]

I leave the graphical updates to Mr.L, who did a fantastic overhaul to the graphics.

I do it like Trapattoni: 'ich habe fertig.' (I am done with it)

[jacdelad]

I do it like Trapattoni: 'ich habe fertig.' (I am done with it)

Then I'll Trapattoni you too: "Was erlauben der Mr.L?"

OK, I'll do an overhaul. Including Mr.L's fantastic new graphics. But it'll take some time, because I have a week off now and it feels better if I get paid while doing it (see first post).

[infratec]

I prefer square boxes without round corners like the original pictures of Mondrian.

https://lawnim19artisticfreedom.blogspo ... uares.html

So I replaced all AddPathRoundBox() with the normal AddPathBox()

[jacdelad]

I will add an option for that.

[Mr.L]

I prefer square boxes without round corners like the original pictures of Mondrian.

Uhhh... shame on me! That happened entirely because of my lack of general knowledge. I didn't know that Mondrian was an artist and that the original game design resembles his art

[jacdelad]

You should have read my first post!

Btw: One of his art pieces was placed upside down in a museum until someone found an old photography of Piet and it which clearly showed it had to be turned around.
https://www.google.de/amp/s/amp.theguar ... ars?espv=1

[Axolotl]

Another idea of improvement you could consider.
Maybe you could display the parts so that you can see their size before you touch them with the mouse.
Or as we say in germany "A picture says more than 1000 words" I let PB paint this to explain my wish/idea/...

Code: Select all

Procedure Box2(X, Y, Width, Height, Color)
  Protected w, h 
  Box(X, Y, Width, Height, #Black) 
  w = (Width / 2) - 4
  h = (Height / 2) - 4 
  Box(X+2, Y+2, w, h, Color) 
  Box(X+2+w+2, Y+2, w, h, Color) 
  Box(X+2, Y+2+h+2, w, h, Color) 
  Box(X+2+w+2, Y+2+h+2, w, h, Color) 
EndProcedure 

  If OpenWindow(0, 0, 0, 400, 200, "2DDrawing Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If CreateImage(0, 400, 200, 24, #Gray) And StartDrawing(ImageOutput(0))
      ; instead of 
      Box(10, 10, 100, 100, #Red)   ; <- this is currently seen 
      ; something like this 
      Box2(120, 10, 100, 100, #Green)   ; <- wish for the future 
      StopDrawing() 
      ImageGadget(0, 0, 0, 400, 200, ImageID(0)) 
    EndIf
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

A "restart" button would be helpful. Maybe if you click the selected riddle again.