PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Simpler Converter (Example)

https://www.purebasic.fr/german/viewtopic.php?t=6957

Seite 1 von 2

Simpler Converter (Example)

Verfasst: 14.02.2006 03:54
von al90
So ich habe jetzt mal aus langeweile einen kleinen Converter geschrieben.
(Ich konnte es einfach nicht abwarten :mrgreen: )
Dieser passt aber nur alle DiskAccess-Befehle zu ReadDir() & CreateFile() und EvenGadgetID() an.
Einfach am ende des Codes eine Quell & Zieldatei angeben und starten.

Wichtig:
Bitte lasst die Routine aber vorsichtshalber mal nur im Debuggmodus laufen,
da evtl. noch fehler drinn stecken und die Routine hängen bleiben könnte.
Ich habe es mit einem meiner Projekte getestet und es klappte ganz gut. :wink:
Eventuell können wir das ganze noch weiter ausbauen oder Didelphodon
nimmt sich halt etwas davon, sofern er etwas davon gebrauchen kann?!

Bin mal auf eure vorschläge gespannt.

Code: Alles auswählen

Global Dim zeilen$(10000)

Procedure.l GetInteger(wert$)
  pos=FindString(wert$,"$",1)
  If pos
    wert$=Mid(wert$,pos+1,2)
  Else
    ProcedureReturn Val(wert$)
  EndIf
  For i=1 To Len(wert$)
    b$=UCase(Mid(wert$,i,1)):c=Val(b$)
    If c=0 And b$<>"0":c=Asc(b$)-55:EndIf
    e=e*16:e=e+c
  Next
ProcedureReturn e
EndProcedure

Procedure.s GetDiskAccessHandle(line$)
  pos=FindString(line$,"ReadFile(",1)
  If pos>1 Or Left(line$,9)="ReadFile("
      pos2=pos+8:handle$=""
    Repeat
      pos2+1
      handle$+Mid(line$,pos2,1)
    Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
  EndIf
  If Not pos
    pos=FindString(line$,"CreateFile(",1)
    If pos>1 Or Left(line$,11)="CreateFile("
        pos2=pos+10:handle$=""
      Repeat
        pos2+1
        handle$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
    EndIf
  EndIf
  If Not pos
    pos=FindString(line$,"UseFile(",1)
    If pos>1 Or Left(line$,8)="UseFile("
        pos2=pos+7:handle$=""
      Repeat
        pos2+1
        handle$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)=")" Or pos2=Len(line$)
    EndIf
  EndIf
  If FindString(handle$,"#PB_Any",1)
    handle$="":pos2=pos
    Repeat:pos2-1:Until Mid(line$,pos2,1)="=" Or pos2=2
    Repeat
      pos2-1
      handle$+Mid(line$,pos2,1)
    Until Mid(line$,pos2-1,1)=" " Or Mid(line$,pos2-1,1)=":" Or pos2=1
    For i=Len(handle$) To 1 Step -1
      handle2$+Mid(handle$,i,1)
    Next
    handle$=handle2$
  EndIf
  ProcedureReturn handle$
EndProcedure

Procedure.s PatchLine(line$,handle$)
  start=1
  Repeat
    red$="":green$="":blue$=""
    pos=FindString(line$,"TransparentSpriteColor(",start)
    If pos
      start=pos+1:pos2=pos+23
      Repeat:pos2+1:Until Mid(line$,pos2,1)=","
      Repeat
        pos2+1
        red$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
      pos2+1
      Repeat
        pos2+1
        green$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
      pos2+1
      Repeat
        pos2+1
        blue$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)=")" Or pos2=Len(line$)
      col=GetInteger(red$)*256:col+GetInteger(green$):col*256:col+GetInteger(blue$)
      pos2=pos+23:a$=""
      For i=1 To pos+23:a$+Mid(line$,i,1):Next
      Repeat:pos2+1:a$+Mid(line$,pos2,1):Until Mid(line$,pos2,1)=","
      a$+Str(col)+")"
      Repeat:pos2+1:Until Mid(line$,pos2,1)=")" Or pos2=Len(line$)
      If pos2<Len(line$):Repeat:pos2+1:a$+Mid(line$,pos2,1):Until pos2=Len(line$):EndIf
      line$=a$
    EndIf
  Until pos=0
  start=1
  Repeat
    red$="":green$="":blue$=""
    pos=FindString(line$,"ClearScreen(",start)
    If pos
      start=pos+1:pos2=pos+11
      Repeat
        pos2+1
        red$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
      pos2+1
      Repeat
        pos2+1
        green$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)="," Or pos2=Len(line$)
      pos2+1
      Repeat
        pos2+1
        blue$+Mid(line$,pos2,1)
      Until Mid(line$,pos2+1,1)=")" Or pos2=Len(line$)
      col=GetInteger(red$)*256:col+GetInteger(green$):col*256:col+GetInteger(blue$)
      pos2=pos+11:a$=""
      For i=1 To pos+11:a$+Mid(line$,i,1):Next
      a$+Str(col)+")"
      Repeat:pos2+1:Until Mid(line$,pos2,1)=")" Or pos2=Len(line$)
      If pos2<Len(line$):Repeat:pos2+1:a$+Mid(line$,pos2,1):Until pos2=Len(line$):EndIf
      line$=a$
    EndIf
  Until pos=0
  Repeat
    a$=ReplaceString(line$,"DisplayTranslucideSprite()","DisplayTranslucentSprite()")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"EventGadgetID()","EventGadget()")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"ReadByte()","ReadByte("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"ReadWord()","ReadWord("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"ReadLong()","ReadLong("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  a$=""
  For i=1 To Len(line$)
    If i>9
      If Mid(line$,i-9,9)="ReadData(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  Repeat
    a$=ReplaceString(line$,"ReadFloat()","ReadFloat("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"ReadString()","ReadString("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  a$=""
  For i=1 To Len(line$)
    If i>9
      If Mid(line$,i-9,9)="FileSeek(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  Repeat
    a$=ReplaceString(line$,"Loc()","Loc("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  Repeat
    a$=ReplaceString(line$,"Lof()","Lof("+handle$+")")
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  a$=""
  For i=1 To Len(line$)
    If i>10
      If Mid(line$,i-10,10)="WriteByte(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>10
      If Mid(line$,i-10,10)="WriteWord(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>10
      If Mid(line$,i-10,10)="WriteLong(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>10
      If Mid(line$,i-10,10)="WriteData(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>11
      If Mid(line$,i-11,11)="WriteFloat(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>12
      If Mid(line$,i-12,12)="WriteString(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  a$=""
  For i=1 To Len(line$)
    If i>13
      If Mid(line$,i-13,13)="WriteStringN(":a$+handle$+",":EndIf
    EndIf
    a$+Mid(line$,i,1)
  Next
  line$=a$
  Repeat
    usefile$="UseFile("
    pos=FindString(line$,"UseFile(",1)
    If pos
      pos2=pos+7
      Repeat
        pos2+1:usefile$+Mid(line$,pos2,1)
      Until Mid(line$,pos2,1)=")" Or pos2=>Len(line$)
      a$=ReplaceString(line$,usefile$+":","")
      line$=a$
      a$=ReplaceString(line$,usefile$+" : ","")
      line$=a$
      a$=ReplaceString(line$,usefile$,"")
      If a$=Space(Len(a$)) Or CountString(a$,Chr(9))=Len(a$):line$=Chr(255):Break:EndIf
    EndIf
    If line$=a$:Break:EndIf
    line$=a$
  ForEver
  ProcedureReturn line$
EndProcedure

Procedure.l PatchPureBasicSourceCode(source$,dest$)

  ;
  ; SourceFile einlesen!
  ;

  r=ReadFile(1,source$)
  If r
    Repeat
      zeile+1
    zeilen$(zeile)=ReadString(1)
    Until Eof(1)
    CloseFile(1)
  EndIf

  ;
  ; Neues SourceFile generieren!
  ;

  w=CreateFile(2,dest$)
  If w
    For i=1 To zeile
      a$=GetDiskAccessHandle(zeilen$(i))
      If a$<>"":b$=a$:EndIf
      newline$=PatchLine(zeilen$(i),b$)
      If Not newline$=Chr(255):WriteStringN(2,newline$):EndIf
    Next
    CloseFile(2)
  EndIf

EndProcedure


;PatchPureBasicSourceCode("c:\BBCruncherV25_Neu.pb","c:\newtestfile.pb")

Verfasst: 14.02.2006 08:57
von Lebostein
Scheint auf den ersten Blick (oder ersten Test) gut zu funktionieren! :allright: Werde es mal über ein größerers Projekt laufen lassen.

Was du noch einfach einbauen könntest:

TransparentSpriteColor(Sprite, R, G, B) -> TransparentSpriteColor(Sprite, RGB(R, G, B))
ClearScreen(R, G, B) -> ClearScreen(RGB(R, G, B))

Verfasst: 14.02.2006 10:54
von Falko
Es wäre schön, wenn Freak sowas in der IDE einbauen könnte.
So zusagen als Import und evt. umgekehrt Export unter Datei.

Ist nur ein kleiner Vorschlag :allright:

Verfasst: 14.02.2006 20:37
von al90
@Lebostein

Ok ich werde es mal versuchen noch weiter auszubauen. Aber zuerst
muss ich noch einige verbesserungen/Fixes daran vornehmen.
Sage mir mal bescheid wenn es bei grösseren projekte probleme geben sollte.
TransparentSpriteColor(Sprite, R, G, B) -> TransparentSpriteColor(Sprite, RGB(R, G, B))
ClearScreen(R, G, B) -> ClearScreen(RGB(R, G, B))
Werde ich mal versuchen. Auch wäre es sinvoll hier mal eine Liste
mit allen änderungen zusammenzutragen.

@Falko

Wäre wünschenswert. Aber ich fürchte das PB-Team hat im moment andere sorgen. :freak:
Deshalb wäre es gut wenn wir uns im moment mit eigenen Codes behelfen.
Schade nur das sich so wenige dafür interessieren. Ich hatte eigentlich
mir mehr resonanz gerechnet.

Verfasst: 15.02.2006 19:31
von al90
TransparentSpriteColor(Sprite, R, G, B) -> TransparentSpriteColor(Sprite, RGB(R, G, B))
ClearScreen(R, G, B) -> ClearScreen(RGB(R, G, B))
Wird jetzt auch unterstützt. Die routine erkennt sogar hex z.b. $FF,$FF,$FF
und macht dann daraus (16777215)

Verfasst: 15.02.2006 19:51
von hardfalcon
@al90: wandelt der Compiler nicht automatisch Hexzahlen um? AFAIK speichert der doch alles direkt als Zahl, eine Umwandlung von String zu Zahl wärend der Laufzeit des Programms wäre doch reine REssourcenverschwendung... :wink:

Verfasst: 15.02.2006 19:54
von DarkDragon
hardfalcon hat geschrieben:@al90: wandelt der Compiler nicht automatisch Hexzahlen um? AFAIK speichert der doch alles direkt als Zahl, eine Umwandlung von String zu Zahl wärend der Laufzeit des Programms wäre doch reine REssourcenverschwendung... :wink:
Nein, nicht wenn es 3 durch komma getrennte sind.

Verfasst: 15.02.2006 19:59
von hardfalcon
Aso, hmm, das hört sich ziemlich interessant an... :D

Verfasst: 15.02.2006 20:13
von al90
Also das problem an der ganzen sache ist eben das sich die Hexwerte
in einem string befinden. z.b. "$FF". Dieser muss erstmal umgewandelt werden.
Deswegen habe ich auch die GetInteger() funktion mit eingebunden.
Ist der string bspw. "255" wird 255 als integer zurückgegeben und bei
"$FF" wird dann ebenfalls 255 zurückgegeben.

Code: Alles auswählen

Procedure.l GetInteger(wert$) 
  pos=FindString(wert$,"$",1) 
  If pos 
    wert$=Mid(wert$,pos+1,2) 
  Else 
    ProcedureReturn Val(wert$) 
  EndIf 
  For i=1 To Len(wert$) 
    b$=UCase(Mid(wert$,i,1)):c=Val(b$) 
    If c=0 And b$<>"0":c=Asc(b$)-55:EndIf 
    e=e*16:e=e+c 
  Next 
ProcedureReturn e 
EndProcedure
Manchmal muss man eben "Kopfstand" machen um das ziel zu erreichen. :freak: :lol:

Verfasst: 15.02.2006 20:22
von DarkDragon
al90 hat geschrieben:Also das problem an der ganzen sache ist eben das sich die Hexwerte
in einem string befinden. z.b. "$FF". Dieser muss erstmal umgewandelt werden.
Deswegen habe ich auch die GetInteger() funktion mit eingebunden.
Ist der string bspw. "255" wird 255 als integer zurückgegeben und bei
"$FF" wird dann ebenfalls 255 zurückgegeben.

Code: Alles auswählen

Procedure.l GetInteger(wert$) 
  pos=FindString(wert$,"$",1) 
  If pos 
    wert$=Mid(wert$,pos+1,2) 
  Else 
    ProcedureReturn Val(wert$) 
  EndIf 
  For i=1 To Len(wert$) 
    b$=UCase(Mid(wert$,i,1)):c=Val(b$) 
    If c=0 And b$<>"0":c=Asc(b$)-55:EndIf 
    e=e*16:e=e+c 
  Next 
ProcedureReturn e 
EndProcedure
Manchmal muss man eben "Kopfstand" machen um das ziel zu erreichen. :freak: :lol:
Ähm ne, in einer Hex-Ziffer werden 4 Bits gespeichert, also häng sie aneinander anstatt sie umzuwandeln :P .

Aus $FF, $AA, $BB wird $FFAABB
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de