Wireworld-Simulator
Übersicht
BlitzBasic Codearchiv
|
DAKBetreff: Wireworld-Simulator |
 Mi, Jun 18, 2008 10:32Antworten mit Zitat 
|
|---|---|---|
|
Sowas gibts hier in dem Forum zwar schon, allerdings ist das existierende leider absolut unbedienbar... (nix für ungut, aber es ist so)
Desswegen hab ich das hier gemacht: Code: [AUSKLAPPEN] Graphics 800, 600, 16, 2
SetBuffer BackBuffer() Dim timer(10) For i = 1 To 10 timer(i) = CreateTimer(3*i) Next usetim = 1 .fullinit Global xges = 80 Global yges = 60 Global globrgb Dim pos(xges+1, yges+1) .init run = 0 scal = 10 fast = 0 scx = 0 scy = 0 lines = 1 rm = 1 While Not KeyHit(1) Cls Dim done(xges+1, yges+1) Color 128, 128, 128 smaxx = xges*scal If smaxx > 800 Then smaxx = 800 smaxy = yges*scal If smaxy > 600 Then smaxy = 600 If lines Then Select scal Case 2 For x = 2 To smaxx Step 2 Line x, 0, x, smaxy Next For y = 2 To smaxy Step 2 Line 0, y, smaxx, y Next Case 3 For x = 3 To smaxx Step 3 Line x, 0, x, smaxy Next For y = 3 To smaxy Step 3 Line 0, y, smaxx, y Next Case 4 For x = 4 To smaxx Step 4 Line x, 0, x, smaxy Next For y = 4 To smaxy Step 4 Line 0, y, smaxx, y Next Case 5 For x = 5 To smaxx Step 5 Line x, 0, x, smaxy Next For y = 5 To smaxy Step 5 Line 0, y, smaxx, y Next Case 6 For x = 6 To smaxx Step 6 Line x, 0, x, smaxy Next For y = 6 To smaxy Step 6 Line 0, y, smaxx, y Next Case 7 For x = 7 To smaxx Step 7 Line x, 0, x, smaxy Next For y = 7 To smaxy Step 7 Line 0, y, smaxx, y Next Case 8 For x = 8 To smaxx Step 8 Line x, 0, x, smaxy Next For y = 8 To smaxy Step 8 Line 0, y, smaxx, y Next Case 9 For x = 9 To smaxx Step 9 Line x, 0, x, smaxy Next For y = 9 To smaxy Step 9 Line 0, y, smaxx, y Next Case 10 For x = 10 To smaxx Step 10 Line x, 0, x, smaxy Next For y = 10 To smaxy Step 10 Line 0, y, smaxx, y Next End Select EndIf If run Then For x = 1 To xges For y = 1 To yges If pos(x, y) = 1 Then fnd = 0 For xi = -1 To 1 For yi = -1 To 1 If pos(x+xi, y+yi) = 2 And done(x+xi,y+yi)=0 Then fnd = fnd+1 Next Next If fnd=1 Or fnd=2 Then pos(x,y) = 2 done(x, y)=1 EndIf Next Next For x = 1 To xges For y = 1 To yges If pos(x, y)=2 Then If done(x, y)=0 Then pos(x, y)=3:done(x, y)=1 EndIf Next Next For x = 1 To xges For y = 1 To yges If pos(x, y)=3 Then If done(x, y)=0 Then pos(x, y)=1 EndIf Next Next EndIf If rm = 0 Then LockBuffer BackBuffer() Color2(255, 128, 0) xmax = scx+800/scal+1 ymax = scy+600/scal+1 If xmax > xges Then xmax = xges If ymax > yges Then ymax = yges For x = scx To xmax For y = scy To ymax If pos(x, y)=1 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color2(255, 0, 0) For x = scx To xmax For y = scy To ymax If pos(x, y)=2 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color2(0, 0, 255) For x = scx To xmax For y = scy To ymax If pos(x, y)=3 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next UnlockBuffer BackBuffer() Else Color 255, 128, 0 xmax = scx+800/scal+1 ymax = scy+600/scal+1 If xmax > xges Then xmax = xges If ymax > yges Then ymax = yges For x = scx To xmax For y = scy To ymax If pos(x, y)=1 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color 255, 0, 0 For x = scx To xmax For y = scy To ymax If pos(x, y)=2 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color 0, 0, 255 For x = scx To xmax For y = scy To ymax If pos(x, y)=3 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next EndIf For i = 0 To 3 If KeyHit(i+2) Then mode = i Next If run Then If Not fast Then WaitTimer timer(usetim) If KeyHit(39) Then lines = 1-lines If KeyHit(33) Then fast = 1-fast If KeyHit(59) Then usetim = usetim+1 If KeyHit(60) Then usetim = usetim-1 If usetim <1 Then usetim = 1 If usetim >10 Then usetim = 10 If KeyHit(28) Then run = 1-run If MouseDown(1) Then px =Floor(MouseX()/scal)+1+scx If px>xges Then px = xges py =Floor(MouseY()/scal)+1+scy If py>yges Then py = yges pos(px, py) = mode EndIf If KeyHit(31) Then save() If KeyHit(38) Then load():Goto init If KeyHit(24) Then load2():Goto init If KeyHit(46) Then Goto fullinit If KeyDown(200) Then scy = scy-10/scal If KeyDown(203) Then scx = scx-10/scal If KeyDown(205) Then scx = scx+10/scal If KeyDown(208) Then scy = scy+10/scal If KeyHit(61) Then rm = 1-rm If scx<0 Then scx=0 If scy<0 Then scy=0 If scx>xges-80 Then scx=xges-80 If scy>yges-60 Then scy=yges-60 If KeyHit(74) Then scal = scal -1 If KeyHit(78) Then scal = scal +1 If scal < 2 Then scal = 2 If scal > 10 Then scal = 10 Flip Wend End Function Color2(r, g, b) globrgb = r*$10000 + g*$100 + b End Function Function Rect2(sx, sy, ex, ey) For x = sx To sx+ex-1 If x>0 And x<800 Then For y = sy To sy+ey-1 If y>0 And y<600 Then WritePixelFast(x, y, globrgb) Next EndIf Next End Function Function save() img = CreateImage(xges, yges) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges For y = 1 To yges If pos(x, y)=1 Then WritePixelFast(x, y, 16744448) If pos(x, y)=2 Then WritePixelFast(x, y, 16711680) If pos(x, y)=3 Then WritePixelFast(x, y, 255) Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() SaveImage(img, "wireworld-save.bmp") FreeImage img End Function Function load() Cls Flip Delay 100 img = LoadImage("wireworld-save.bmp") xges = ImageWidth(img) yges = ImageHeight(img) Dim pos(xges+1, yges+1) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges-1 For y = 1 To yges-1 rgb = ReadPixelFast(x, y) r = (rgb And $FF0000)/$10000 g = (rgb And $FF00)/$100 b = rgb And $FF If r > 230 And g > 103 And g < 152 Then pos(x, y) = 1 If r > 230 And g > 230 Then pos(x, y) = 2 If b > 230 And g > 103 And g < 152 Then pos(x, y) = 3 Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() End Function Function load2() Cls Flip Delay 100 img = LoadImage("wireworld-save.bmp") xges = ImageWidth(img) yges = ImageHeight(img) Dim pos(xges+1, yges+1) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges-1 For y = 1 To yges-1 rgb = ReadPixelFast(x, y) r = (rgb And $FF0000)/$10000 g = (rgb And $FF00)/$100 b = rgb And $FF If r > 230 And g > 103 And g < 152 Then pos(x, y) = 1 If r > 230 And g < 25 Then pos(x, y) = 2 If b > 230 And g < 25 Then pos(x, y) = 3 Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() End Function Steuerung: Plazierter Typ: 1 = leer 2 = Leiter 3 = Elektronenkopf 4 = Elektronenende Allgemein linke Maus = plazieren Enter = Starten/Pausieren (plazieren am Besten in den Pausen...) F1/F2 = schneller/langsamer F = keine Geschwindigkeitsbegrenzung (nur durch die CPU) Ö = Raster ein-/ausschallten Links/Rechts/Rauf/runter = scrollen (geht nur, wenn xges > 80 / yges > 60) Laden/Speichern (Gespeichert wird in das Bild wireworld-save.bmp, lässt sich dann mit paint/usw. verändern) S = speichern (in den Farben, die in der Simulation verwendet werden) O = laden (-,,-) L = laden (in den Farben weiß (255, 255, 255) für Elektronenkopf und blau (0, 128, 255) für Elektronenende) Die beiden Ladefunktionen haben den Sinn, dass man den Wireworldcomputer laden kann. Viel Spaß damit... |
||
| Gewinner der 6. und der 68. BlitzCodeCompo | ||
|
hecticSieger des IS Talentwettbewerb 2006 |
Mi, Jun 18, 2008 14:34 Antworten mit Zitat
|
|---|---|---|
|
Wenn ich ein ''L'' mache und jeweils zur Ecke hin einmal rot und einmal blau einzeichne, bekomme ich eine Dauerstromquelle.
Zitat: 0020000
0020000 0020000 0030000 0024222 0000000 0000000 Das Problem dabei - da es sich ja um einen Eingabefehler handelt - kann dieser Endloszustand auch durch Kollisions von allein zustande kommen. Edit1: Gehört das so? |
||
| Download der Draw3D2 V.1.1 für schnelle Echtzeiteffekte über Blitz3D | ||
|
|
DAK |
Mi, Jun 18, 2008 14:57 Antworten mit Zitat
|
|---|---|---|
|
jup, den wireworld regeln nach wird hier alles völlig korrekt behandelt.
Die regeln sind folgende: Leer bleibt leer Leiter wird zu Elektronenkopf, wenn ein oder 2 Elektronenköpfe rund um den Leiter sind Elektronenkopf wird zu Elektronenende Jedes Feld kann sich nur ein mal pro Generation verändern. Code: [AUSKLAPPEN] 030 024 000 wird zu Code: [AUSKLAPPEN] 040 032 000 wird zu Code: [AUSKLAPPEN] 020 043 000 wird zum 1. Was du hier gemacht hast, ist ein 3-Tick-Pulsegenarator. 3-Tick wird aber kaum verwendet, da man damit nicht sonderlich viel machen kann... Damit nicht unabsichtlich sowas passiert, macht man Ecken normalerweise so: Code: [AUSKLAPPEN] 0200 0200 0022 0000 Öfters verwendet wird 4-Tick oder 6-Tick. 4-Tick-Pulsegenarator: Code: [AUSKLAPPEN] 02000 20322 04000 6-Tick-Pulsegenarator: Code: [AUSKLAPPEN] 022000 200222 043000 Probier die beiden mal aus... Die wichtigsten 6-Tick-Logic-Sachen findest du hier: http://www.quinapalus.com/wi-index.html Außerdem kannst du dir den auf dieser Website gezeigten Wireworld-Computer hier runterladen. (Bild als wireworld-save.bmp in den Ordner, in der die wireworld.exe ist, speichern und in der Simulation "L" drücken.) |
||
| Gewinner der 6. und der 68. BlitzCodeCompo | ||
|
Silver_Knee |
Mi, Jun 18, 2008 16:11 Antworten mit Zitat
|
|---|---|---|
| wenn du eine diode unglücklich kollidieren lässt auch -.- | ||
|
|
hecticSieger des IS Talentwettbewerb 2006 |
Mi, Jun 18, 2008 18:48 Antworten mit Zitat
|
|---|---|---|
| ok, dann sollte ja alles klar sein. Nettes Spielzeug. | ||
| Download der Draw3D2 V.1.1 für schnelle Echtzeiteffekte über Blitz3D | ||
#ReaperNewsposter |
Do, Jun 19, 2008 15:32 Antworten mit Zitat
|
|
|---|---|---|
|
Also... naja
Der Code ist noch sehr, sehr stark Verbesserungswürdig.. Du benutzt 3mal 800*600er Schleifen, um etwas zu zeichnen, das man auch mit nur einer Schleife hinbekommen würde. Auch hast du 3 Schleifen für die Wireworld-Simulation, wo ich zu mindestens die letzten beiden zu einer Schleife zusammensetzten konnte, ohne das es Probleme in der Wireworld. (Wäre noch genauer zu prüfen.) Ansonsten finde ich persönlich den Code nun nicht so "ordentlich" geschrieben. Naja, ok, aber hier bin ich von BMax bedingt eh ein anderes Aussehen des Codes gewöhnt, wegen SuperStrict.) Vielleicht kann man ja noch an ein paar Ecken den Code etwas verschnellern, weil bei mir läuft zu mindestens der Wireworld-Computer (dein Link) nicht gerade flüssig. Vielleicht werde ich mich auch mal dran setzten, ich mag es Code auf Speed zu optimieren. 
|
||
|
AMD Athlon 64 3500+, ATI AX800 Pro/TD, 2048 MB DRR 400 von Infineon, ♥RIP♥ (2005 - Juli 2015 -> sic!)
Blitz3D, BlitzMax, MaxGUI, Monkey X; Win7 |
||
FWeinbehemals "ich" |
Do, Jun 19, 2008 19:31 Antworten mit Zitat
|
|
|---|---|---|
|
Also ich finde das Wireworld Prinzip ziemlich geil nur leider habe ich noch keine Simulation gefunden die Ansatzweise Schnell ist (ich versuche den Wireworld Computer laufen zu sehen)
Ich hoffe das du den Code noch verbesserst. mfg ich |
||
|
"Wenn die Menschen nur über das sprächen, was sie begreifen, dann würde es sehr still auf der Welt sein." Albert Einstein (1879-1955)
"If you live each day as if it was your last, someday you'll most certainly be right." Steve Jobs |
||
|
|
DAK |
Sa, Jun 21, 2008 13:40 Antworten mit Zitat
|
|---|---|---|
|
Ok, hab den Code mal überarbeitet...
Die beiden Schleifen von der Simulation hab ich zusammen gelegt, die drei zeichenschleifen nicht. Ich hab da einen Speedtest gemacht (wie viele ms die Funktion bei einem vollen schirm braucht), der mir gesagt hat, dass die drei getrennten Schleifen schneller sind (~25ms statt ~28ms). Ich schätze, das liegt an den selteneren Aufrufen von Color... Außerdem hab ich noch steuerungszeug, das man während dem laufen nicht braucht (plazieren, laden, plazierter typ) während dem laufen ausgeschalltet.... @Geschwindigkeit vom Wireworld-Computer: Das Ding ist so ziemlich das komplexeste (=> langsamste) das mit Wireworld gemacht worden ist. Den kann man vergessen, wirklich schnell laufen zu lassen. (auf der Website steht, dass es ruhig schon mal eine halbe stunde dauern kann, bis sich die 1. zahl ändert...) Code: [AUSKLAPPEN] Graphics 800, 600, 16, 2
SetBuffer BackBuffer() Dim timer(10) For i = 1 To 10 timer(i) = CreateTimer(3*i) Next usetim = 1 .fullinit Global xges = 80 Global yges = 60 Global globrgb Dim pos(xges+1, yges+1) .init run = 0 scal = 10 fast = 0 scx = 0 scy = 0 lines = 1 rm = 1 While Not KeyHit(1) Cls Dim done(xges+1, yges+1) Color 128, 128, 128 smaxx = xges*scal If smaxx > 800 Then smaxx = 800 smaxy = yges*scal If smaxy > 600 Then smaxy = 600 If lines Then Select scal Case 2 For x = 2 To smaxx Step 2 Line x, 0, x, smaxy Next For y = 2 To smaxy Step 2 Line 0, y, smaxx, y Next Case 3 For x = 3 To smaxx Step 3 Line x, 0, x, smaxy Next For y = 3 To smaxy Step 3 Line 0, y, smaxx, y Next Case 4 For x = 4 To smaxx Step 4 Line x, 0, x, smaxy Next For y = 4 To smaxy Step 4 Line 0, y, smaxx, y Next Case 5 For x = 5 To smaxx Step 5 Line x, 0, x, smaxy Next For y = 5 To smaxy Step 5 Line 0, y, smaxx, y Next Case 6 For x = 6 To smaxx Step 6 Line x, 0, x, smaxy Next For y = 6 To smaxy Step 6 Line 0, y, smaxx, y Next Case 7 For x = 7 To smaxx Step 7 Line x, 0, x, smaxy Next For y = 7 To smaxy Step 7 Line 0, y, smaxx, y Next Case 8 For x = 8 To smaxx Step 8 Line x, 0, x, smaxy Next For y = 8 To smaxy Step 8 Line 0, y, smaxx, y Next Case 9 For x = 9 To smaxx Step 9 Line x, 0, x, smaxy Next For y = 9 To smaxy Step 9 Line 0, y, smaxx, y Next Case 10 For x = 10 To smaxx Step 10 Line x, 0, x, smaxy Next For y = 10 To smaxy Step 10 Line 0, y, smaxx, y Next End Select EndIf If run Then For x = 1 To xges For y = 1 To yges If pos(x, y) = 1 Then fnd = 0 For xi = -1 To 1 For yi = -1 To 1 If pos(x+xi, y+yi) = 2 And done(x+xi,y+yi)=0 Then fnd = fnd+1 Next Next If fnd=1 Or fnd=2 Then pos(x,y) = 2 done(x, y)=1 EndIf Next Next For x = 1 To xges For y = 1 To yges If pos(x, y)=2 Then If done(x, y)=0 Then pos(x, y)=3:done(x, y)=1 ElseIf pos(x, y)=3 Then If done(x, y)=0 Then pos(x, y)=1 EndIf Next Next EndIf If rm = 0 Then LockBuffer BackBuffer() Color2(255, 128, 0) xmax = scx+800/scal+1 ymax = scy+600/scal+1 If xmax > xges Then xmax = xges If ymax > yges Then ymax = yges For x = scx To xmax For y = scy To ymax If pos(x, y)=1 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color2(255, 0, 0) For x = scx To xmax For y = scy To ymax If pos(x, y)=2 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color2(0, 0, 255) For x = scx To xmax For y = scy To ymax If pos(x, y)=3 Then Rect2 x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next UnlockBuffer BackBuffer() Else xmax = scx+800/scal+1 ymax = scy+600/scal+1 If xmax > xges Then xmax = xges If ymax > yges Then ymax = yges Color 255, 128, 0 For x = scx To xmax For y = scy To ymax If pos(x, y)=1 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color 255, 0, 0 For x = scx To xmax For y = scy To ymax If pos(x, y)=2 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next Color 0, 0, 255 For x = scx To xmax For y = scy To ymax If pos(x, y)=3 Then Rect x*scal-scal+1-scx*scal, y*scal-scal+1-scy*scal, scal-1, scal-1 EndIf Next Next EndIf If run = 0 For i = 0 To 3 If KeyHit(i+2) Then mode = i Next If MouseDown(1) Then px =Floor(MouseX()/scal)+1+scx If px>xges Then px = xges py =Floor(MouseY()/scal)+1+scy If py>yges Then py = yges pos(px, py) = mode EndIf If KeyHit(38) Then load():Goto init If KeyHit(24) Then load2():Goto init EndIf If run Then If Not fast Then WaitTimer timer(usetim) If KeyHit(39) Then lines = 1-lines If KeyHit(33) Then fast = 1-fast If KeyHit(59) Then usetim = usetim+1 If KeyHit(60) Then usetim = usetim-1 If usetim <1 Then usetim = 1 If usetim >10 Then usetim = 10 If KeyHit(28) Then run = 1-run If KeyHit(31) Then save() If KeyHit(46) Then Goto fullinit If KeyDown(200) Then scy = scy-10/scal If KeyDown(203) Then scx = scx-10/scal If KeyDown(205) Then scx = scx+10/scal If KeyDown(208) Then scy = scy+10/scal If KeyHit(61) Then rm = 1-rm If scx<0 Then scx=0 If scy<0 Then scy=0 If scx>xges-80 Then scx=xges-80 If scy>yges-60 Then scy=yges-60 If KeyHit(74) Then scal = scal -1 If KeyHit(78) Then scal = scal +1 If scal < 2 Then scal = 2 If scal > 10 Then scal = 10 Flip Wend End Function Color2(r, g, b) globrgb = r*$10000 + g*$100 + b End Function Function Rect2(sx, sy, ex, ey) For x = sx To sx+ex-1 If x>0 And x<800 Then For y = sy To sy+ey-1 If y>0 And y<600 Then WritePixelFast(x, y, globrgb) Next EndIf Next End Function Function save() img = CreateImage(xges, yges) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges For y = 1 To yges If pos(x, y)=1 Then WritePixelFast(x, y, 16744448) If pos(x, y)=2 Then WritePixelFast(x, y, 16711680) If pos(x, y)=3 Then WritePixelFast(x, y, 255) Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() SaveImage(img, "wireworld-save.bmp") FreeImage img End Function Function load() Cls Flip Delay 100 img = LoadImage("wireworld-save.bmp") xges = ImageWidth(img) yges = ImageHeight(img) Dim pos(xges+1, yges+1) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges-1 For y = 1 To yges-1 rgb = ReadPixelFast(x, y) r = (rgb And $FF0000)/$10000 g = (rgb And $FF00)/$100 b = rgb And $FF If r > 230 And g > 103 And g < 152 Then pos(x, y) = 1 If r > 230 And g > 230 Then pos(x, y) = 2 If b > 230 And g > 103 And g < 152 Then pos(x, y) = 3 Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() End Function Function load2() Cls Flip Delay 100 img = LoadImage("wireworld-save.bmp") xges = ImageWidth(img) yges = ImageHeight(img) Dim pos(xges+1, yges+1) SetBuffer ImageBuffer(img) LockBuffer ImageBuffer(img) For x = 1 To xges-1 For y = 1 To yges-1 rgb = ReadPixelFast(x, y) r = (rgb And $FF0000)/$10000 g = (rgb And $FF00)/$100 b = rgb And $FF If r > 230 And g > 103 And g < 152 Then pos(x, y) = 1 If r > 230 And g < 25 Then pos(x, y) = 2 If b > 230 And g < 25 Then pos(x, y) = 3 Next Next UnlockBuffer ImageBuffer(img) SetBuffer BackBuffer() End Function |
||
| Gewinner der 6. und der 68. BlitzCodeCompo | ||
Übersicht
BlitzBasic Codearchiv
Powered by phpBB © 2001 - 2006, phpBB Group