PureBoard

Code: Alles auswählen

EnableExplicit

Structure tRGBinfo
	X.f
	Y.f
	Z.f
	L.f
	a.f
	b.f
EndStructure

Define tStart = ElapsedMilliseconds()

Global Dim aRGBinfo.tRGBinfo(255,255,255)
Define R, G, B
Define.f Xn = 96.422
Define.f Yn = 100
Define.f Zn = 82.521

For R = 0 To 255
	For G = 0 To 255
		For B = 0 To 255
			With aRGBinfo(R,G,B)
				\X = 0.4124564 * R + 0.3575761 * G + 0.1804375 * B
				\Y = 0.2126729 * R + 0.7151522 * G + 0.0721750 * B
				\Z = 0.0193339 * R + 0.1191920 * G + 0.9503041 * B
				\L = 116 *   Pow(\Y / Yn, 3) - 16
				\a = 500 * ( Pow(\X / Xn, 3) - Pow(\Y / Yn, 3) )
				\b = 200 * ( Pow(\Y / Yn, 3) - Pow(\Z / Zn, 3) )
			EndWith
		Next B
	Next G
Next R

Define tEnd = ElapsedMilliseconds()
MessageRequester("","Time [ms]: " + Str(tEnd - tStart) )

Code: Alles auswählen

UseZipPacker()
Structure gruen
  wert.f[6]
EndStructure
Structure blau
  gruen.gruen[256]
EndStructure  
Structure rot
  blau.blau[256]
EndStructure
Structure Tabelle
  rot.rot[256]
EndStructure

*buf.Tabelle=AllocateMemory(SizeOf(Tabelle))
#tabelleFile="werte.dat"
#FileID=$12345678;Irgendein Wert als ID/Versionsnummer!

#usepack=#True

Debug *buf
Debug StrF(SizeOf(Tabelle) /1024/1024,2)+" MB"
Debug SizeOf(*buf)

; Exestiert die Tabelle schon? nein-> Erstellen
If FileSize(#tabelleFile)<=0
  
  ; hier tabelle füllen
  Debug "Tabelle mit unsinn füllen"
  For i=0 To 255
    *buf\rot[i]\blau[255-i]\gruen[255]\wert[1]=i/(256.0-i)
  Next
  
  
  ; wir speichern das mal lieber als zip!
  
  Debug "speichern"
  CompilerIf #usepack
    out=CreatePack(#PB_Any,#tabelleFile,#PB_PackerPlugin_Zip)
    If out
      AddPackMemory(out,*buf,SizeOf(Tabelle),"data")
      ClosePack(out)
    EndIf
  CompilerElse
    out=CreateFile(#PB_Any,#tabelleFile)
    If out
      WriteLong(out,#FileID)
      WriteData(out,*buf,SizeOf(Tabelle))
      CloseFile(out)
    EndIf
  CompilerEndIf
  Debug "saved"
Else
  
  ;In Programm einfach laden.
  CompilerIf #usepack
    in=OpenPack(#PB_Any,#tabelleFile,#PB_PackerPlugin_Zip)
    If in
      If ExaminePack(in)
        While NextPackEntry(in)
          If PackEntryName(in)="data"
            len= UncompressPackMemory(in,*buf,SizeOf(tabelle))
            If len<>SizeOf(tabelle)
              Debug "UNCOMPRESS ERROR "+len+" "+SizeOf(tabelle)
              End
            EndIf
          EndIf
        Wend
      EndIf
      ClosePack(in)
    EndIf
  CompilerElse
    in=ReadFile(#PB_Any,#tabelleFile)
    If in
      If ReadLong(in)<>#FileID
        Debug "Veraltete Datei - man müsste hier zur erstellung springen!"
      Else
        ReadData(in,*buf,SizeOf(Tabelle))
      EndIf
      CloseFile(in)
    EndIf
  CompilerEndIf
  
  Debug "loaded"
EndIf



Debug "Check"
For i=0 To 255
  value.f=i/(256.0-i)
  If *buf\rot[i]\blau[255-i]\gruen[255]\wert[1]<>value
    Debug "DATEN FEHLERHAFT "+StrF(*buf\rot[i]\blau[255-i]\gruen[255]\wert[1]) +" "+StrF(value)
  EndIf
Next



FreeMemory(*buf)
End

Code: Alles auswählen

Data.f 230443,12.443432,-112.344432,0.3444324,-67.004556,-3.785545,-54.225467

Code: Alles auswählen

Structure fWerte
  wert1.f
  wert2.f
  wert3.f
  wert4.f
  wert5.f
  wert6.f
EndStructure

MessageRequester("","CHECK memory usage of process")
Dim Farbwerte.fWerte($FFFFFF)
MessageRequester("","CHECK memory usage of process")