Pythagoras- Baum

    • Ich hab mal versucht, diesen E-Code zu übersetzen, aber ich bin wohl aus der Übung. AmigaE ist auch schon was her :thumbsup: :
      osnews.com/story/169

      Der XProfan-Code macht aber nicht, was er soll... :-(

      Quellcode

      1. Declare LongInt width, height
      2. Declare Float cx, cy, dx, dy, ex, ey, c
      3. Proc PythTree
      4. Parameters Float ax, ay, bx, by, Int depth
      5. cx = ax - ay + by
      6. cy = ax + ay - bx
      7. dx = bx + by - ay
      8. dy = ax - bx + by
      9. ex = 0.5 * (cx - cy + dx + dy)
      10. ey = 0.5 * (cx + cy - dx + dy)
      11. c = (-1) - depth * $100020
      12. UsePen 0, 1, Rgb(c, c, c)
      13. Line cx, cy - ax, ay
      14. Line ax, ay - bx, by
      15. Line bx, by - dx, dy
      16. Line dx, dy - cx, cy
      17. Line cx, cy - ex, ey
      18. Line ex, ey - dx, dy
      19. If depth < 12
      20. PythTree (cx, cy, ex, ey, depth + 1)
      21. PythTree (ex, ey, dx, dy, depth + 1)
      22. EndIf
      23. EndProc
      24. width = 640
      25. height = 480
      26. WindowTitle "Pythagora's-Baum"
      27. Window width, height
      28. PythTree ((width/2 - width/12), (height-20), (width/2 + width/12), (height-20), 0)
      29. WaitInput
      Alles anzeigen
      Gruß, Frank
    • Vermutlich soll hier Rekursion demonstriert werden. Hab da was haldentaugliches gefunden, das auf relativen Koordinaten (Turtle-Graphics) beruht. Dazu waren nur 3 kleine Hilfs-Procs nötig. XProfan ist eben unschlagbar ;-)

      Quellcode

      1. Windowtitle "Pythagoras-Baum (wohl eher Brokkoli ;-)":Window 0,0-%maxx,%maxy
      2. 'Q: http://www.pohlig.de/Unterricht/Inf2003/Tag18/14.5_Pythagorasbaum.htm
      3. '...übertragen nach XProfan11.2a 2014-01 by P.Specht. Keine Gewähr - Für garnix!
      4. declare xr!,yr!,wr!
      5. xr!=width(%hwnd)*0.5 : yr!=height(%hwnd)*0.8 : wr!=-pi()/2
      6. moveto xr!,yr!
      7. ZeichnePythagorasBaum(120)
      8. Print "." : waitinput : end
      9. proc ZeichnePythagorasBaum :parameters c!
      10. Whileloop 0,3:forward(c!):right(90):endwhile
      11. if c!>1
      12. forward(c!):left(30)
      13. zeichnePythagorasBaum(c!*0.5*sqrt(3))
      14. right(90):forward(c!*0.5*sqrt(3))
      15. zeichnePythagorasBaum(c!/2)
      16. ' und Rückwicklung zum Ursprung:
      17. forward(-c!*0.5*sqrt(3)) : left(60) : forward(-c!)
      18. endif
      19. endproc
      20. proc forward : parameters c!:xr!=xr!+c!*cos(wr!):yr!=yr!+c!*sin(wr!):lineto xr!,yr!
      21. endproc
      22. proc left : parameters w! :wr!=wr!+w!*pi()/180
      23. endproc
      24. proc right :parameters w!:wr!=wr!-w!*pi()/180
      25. endproc
      Alles anzeigen
      Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von p. specht ()

    • Übrigens tut's Franks Code ohnehin sehr gut, zumindest nach kleiner Umstellung auf Profan11.2a ;-)

      Quellcode

      1. Windowtitle "Tree of Pythagoras -- based on old E example by Raymond Hoving"
      2. var width& = 640:var height&=480:Window width&,height&
      3. pythtree( width&/2-width&/12,height&-20 , width&/2+width&/12,height&-20, 0)
      4. waitinput:end
      5. proc pythtree :parameters ax!,ay!,bx!,by!,depth&
      6. var cx!=ax!-ay!+by!:var cy!=ax!+ay!-bx!
      7. var dx!=bx!+by!-ay!:var dy!=ax!-bx!+by!
      8. var ex!=0.5*(cx!-cy!+dx!+dy!):var ey!=0.5*(cx!+cy!-dx!+dy!)
      9. usepen 0,1,depth&*$100020
      10. line cx!,cy! - ax!,ay! : line ax!,ay! - bx!,by!
      11. line bx!,by! - dx!,dy! : line dx!,dy! - cx!,cy!
      12. line cx!,cy! - ex!,ey! : line ex!,ey! - dx!,dy!
      13. if depth& < 12
      14. pythtree(cx!,cy!,ex!,ey!,depth&+1)
      15. pythtree(ex!,ey!,dx!,dy!,depth&+1)
      16. endif
      17. endproc
      Alles anzeigen
      Win7-64HomPremSP1,XProfan11.2a,XPIA,JWasm,xpse,IntelCoreQuad2.5GHz/4GB/je1TB HD intern:esataBay:USB3
    • Interessante Probleme. Vielleicht ist das so nicht zulässig?

      Quellcode

      1. Parameters Float ax, ay, bx, by, Int depth

      Und bei #4 wird keine doppelte Deklaration angemeckert.
      Ansonsten finde ich weniger Linien besser. Nur den "Endzweig" geschlossen.

      Quellcode

      1. Windowtitle "Tree of Pythagoras -- based on old E example by Raymond Hoving"
      2. var width& = 640
      3. var height&=480
      4. Window width&,height&
      5. pythtree( width&/2-width&/12,height&-20 , width&/2+width&/12,height&-20, 0)
      6. waitinput
      7. end
      8. proc pythtree
      9. parameters ax!,ay!,bx!,by!,depth&
      10. var cx!=ax!-ay!+by!
      11. var cy!=ax!+ay!-bx!
      12. var dx!=bx!+by!-ay!
      13. var dy!=ax!-bx!+by!
      14. var ex!=0.5*(cx!-cy!+dx!+dy!)
      15. var ey!=0.5*(cx!+cy!-dx!+dy!)
      16. usepen 0,1,depth&*$100020
      17. line cx!,cy! - ax!,ay!
      18. line bx!,by! - dx!,dy!
      19. if depth& < 8
      20. pythtree(cx!,cy!,ex!,ey!,depth&+1)
      21. pythtree(ex!,ey!,dx!,dy!,depth&+1)
      22. else
      23. line cx!,cy! - ex!,ey!
      24. line ex!,ey! - dx!,dy!
      25. endif
      26. endproc
      Alles anzeigen


      Gruß Thomas

      Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von THFR ()

    • Frabbing schrieb:

      Danke,das geht! :-)
      Was ist anders bei mir?

      Bei dir sind einige Variablen (cx, etc.) global deklariert und hier sind sie lokal deklariert!

      Gruß
      Roland
      Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD / ATI Radeon HD4770 512 MB / Windows 7(32) - XProfan X3
      AMD Athlon II X2 2,9 GHz / 3 GB RAM / 500 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X3


      http://www.xprofan.de
    • Hallo Frank,

      ich weiß, Dein Beitrag ist schon ein wenig älter, aber trotzdem noch eine Anmerkung:

      Da XProfan erlaubt, eine Prozedur wahlweise als Funktion (mit geklammerten Parametern) oder Prozedur (Parameter ohne Klammer) aufzurufen, macht der Parser das an der Klammer direkt nach dem Prozedurnamen fest. Da Du keinen Rückgabewert erwartest, kannst Du die Parameter auch einfach ohne Klammern angeben, wie bei Befehlen.

      Gruß
      Roland
      Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD / ATI Radeon HD4770 512 MB / Windows 7(32) - XProfan X3
      AMD Athlon II X2 2,9 GHz / 3 GB RAM / 500 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X3


      http://www.xprofan.de
    • Das mache ich ja schon. Nur in diesem Fall kann man nicht erkennen, dass es überflüssig ist, da die Prozedur ja auch als Befehl aufgerufen werden kann und dann das Leerzeichen notwendig ist. Die folgende Klammer könnte ja auch eine Klammer eines Parameters sein und nicht die Klammer, die den oder die Funktionsparameter einklammert. Zumal es eher unwahrscheinlich ist, dass man eine Prozedur als Funktion aufruft, wenn man das Ergebnis nicht zuweist.

      Gruß
      Roland
      Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD / ATI Radeon HD4770 512 MB / Windows 7(32) - XProfan X3
      AMD Athlon II X2 2,9 GHz / 3 GB RAM / 500 GB HDD / ATI Radeon 3000 (onboard) / Windows 10(64) - XProfan X3


      http://www.xprofan.de