SeedRnd MilliSecs()
Graphics3D 640,480,0,2
SetBuffer BackBuffer()

Global Kennung%,index%,D%,mx,my,mhit,Beschreibung$
Global ORad%=6;nur für Objektdarstellung
Global Gewicht#;Inventar-gesamt-gewicht

Global Automatischt_Zusammenfuehren=False

AddObjekt("Schuh",2.95)
AddObjekt("Stiefel",3.1)
AddObjekt("Schwert",7.6)
AddObjekt("Keule",12.0)
AddObjekt("Fleisch",1.25)
AddObjekt("Schild",28.5)

For index=1 To 50
	LiegtRum(Rand(160+ORad,620-ORad),Rand(48+ORad,448-ORad),Rand(1,6),Rand(1,10))
Next

Local A.Auffindbar,I.Inventar
Local X,Y

Local Timer=CreateTimer(60)
While Not KeyHit(1)
	Cls
	
	mx=MouseX()
	my=MouseY()
	mhit=MouseHit(1)
	Beschreibung$=""
	Gewicht#=0
	
	;Inventar-darstellen
	X=0
	Y=0
	For I.Inventar=Each Inventar
		Gewicht=Gewicht+I\O\Gewicht*I\Anzahl
		If RectsOverlap(mx,my,1,1,16+X*16,48+Y*16,16,16) Then
			Beschreibung$=I\O\Name+" - Gewicht: "+I\O\Gewicht+" Kg x"+I\Anzahl
			Color 255,0,0
			If mhit Then ObjektAbwerfen(I)
		Else
			Color I\O\R,I\O\G,I\O\B
		EndIf
		
		Rect 16+X*16,48+Y*16,16,16,0
		Oval 18+X*16,50+Y*16,12,12,1
		
		X=X+1
		If X=7 Then X=0:Y=Y+1
	Next
	
	Color 255,255,255
	Text 16,32,"Inventar:"
	Rect 16,48,112,240,0
	Text 16,300,"Gewicht: "+Gewicht+" Kg"
	
	;herumliegende Objekte darstellen
	For A.Auffindbar=Each Auffindbar
		D=Distance(mx,my,A\X,A\Y)
		If D<=ORad Then
			Beschreibung$=A\O\Name+" - Gewicht: "+A\O\Gewicht+" Kg - x"+A\Anzahl
			Color 0,255,0
		Else
			Color A\O\R,A\O\G,A\O\B
		EndIf
		Oval A\X-ORad,A\Y-ORad,ORad*2,ORad*2,1
		If D<=ORad And mhit Then ObjektAufnehmen(A.Auffindbar)
	Next
	
	Color 255,255,255
	Text 160,32,"herumliegende Objekte:"
	Rect 160,48,460,400,0
	
	Text 16,460,"Ausgewähltes Objekt: "+Beschreibung$
	
	WaitTimer Timer
	Flip 0
Wend
End

Type Inventar
	Field O.Objekt,Anzahl
End Type
Type Auffindbar
	Field X,Y
	Field O.Objekt,Anzahl
End Type
Type Objekt
	Field Name$,Kennung%
	Field Gewicht#
	
	Field R,G,B
End Type
Function Distance#(X1#,Y1#,X2#,Y2#)
	Return Sqr((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2))
End Function
Function AddObjekt(Name$,Gewicht#)
	Local O.Objekt,ExistiertBereits
	For O.Objekt=Each Objekt
		If O\Name=Name And O\Gewicht=Gewicht Then
			ExistiertBereits=True
			Exit
		EndIf
	Next
	If ExistiertBereits=False Then
		O.Objekt=New Objekt
		Kennung=Kennung+1
		O\Kennung=Kennung
	EndIf
	O\Name=Name
	O\Gewicht=Gewicht
	
	O\R=Rand(255)
	O\G=Rand(255)
	O\B=Rand(255)
End Function
Function LiegtRum(X,Y,Kennung%,Anzahl%)
	Local O.Objekt
	For O.Objekt=Each Objekt
		If O\Kennung=Kennung Then
			Local A.Auffindbar=New Auffindbar
			A\X=X
			A\Y=Y
			A\Anzahl=Anzahl
			A\O.Objekt=O.Objekt
			Return 1
		EndIf
	Next
End Function
Function ObjektAufnehmen(A.Auffindbar)
	Local I.Inventar
	If Automatischt_Zusammenfuehren=True Then
		For I.Inventar=Each Inventar
			If I\O.Objekt=A\O.Objekt Then
				I\Anzahl=I\Anzahl+A\Anzahl
				Delete A.Auffindbar
				Return 1
			EndIf
		Next
	EndIf
	I.Inventar=New Inventar
	I\O.Objekt=A\O.Objekt
	I\Anzahl=A\Anzahl
	Delete A.Auffindbar
	Return 1
End Function
Function ObjektAbwerfen(I.Inventar)
	
	LiegtRum(Rand(160+ORad,620-ORad),Rand(48+ORad,448-ORad),I\O\Kennung,I\Anzahl)
	Delete I.Inventar
	
End Function

Type

Type TItem
  Field image
  Field amount
  ...
End Type

Dim Inventory.TItem(7, 7)

For y = 0 To 7
  For x = 0 To 7
    If Inventory(x, y) <> Null
      DrawImage Inventory(x, y)\image, x * 32, y * 32
    EndIf
  Next
Next