Simpler Converter (Example)

al90 · Beitrag von **al90** » 14.02.2006 03:54

So ich habe jetzt mal aus langeweile einen kleinen Converter geschrieben.
(Ich konnte es einfach nicht abwarten

)
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.

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")

Lebostein · Beitrag von **Lebostein** » 14.02.2006 08:57

Scheint auf den ersten Blick (oder ersten Test) gut zu funktionieren!

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))

Beitrag von **Falko** » 14.02.2006 10:54

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

al90 · Beitrag von **al90** » 14.02.2006 20:37

@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.

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.

al90 · Beitrag von **al90** » 15.02.2006 19:31

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)

hardfalcon · Beitrag von **hardfalcon** » 15.02.2006 19:51

@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...

DarkDragon · Beitrag von **DarkDragon** » 15.02.2006 19:54

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...

Nein, nicht wenn es 3 durch komma getrennte sind.

hardfalcon · Beitrag von **hardfalcon** » 15.02.2006 19:59

Aso, hmm, das hört sich ziemlich interessant an...

al90 · Beitrag von **al90** » 15.02.2006 20:13

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.

DarkDragon · Beitrag von **DarkDragon** » 15.02.2006 20:22

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.

Ä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