† † Der Codefriedhof † †
Übersicht
Sonstiges Projekte
|
BladeRunnerModeratorBetreff: † † Der Codefriedhof † † |
 Sa, Dez 13, 2008 15:19Antworten mit Zitat 
|
|---|---|---|
|
Der Modergeruch alter Befehle schlägt Euch entgegen als ihr die knarrende Tür zu dieser Gruft öffnet. Was mag sich hier verbergen? Wer war vor Euch hier und hinterließ seine Spuren? Als Ihr langsam die glitschigen Stufen in die Dunkelheit hinab nehmt, ahnt Ihr, dass hier so manch ein Juwel zu finden sein wird ...
† † Willkommen auf dem Codefriedhof † † Hier könnt ihr zum einen eure abgelegten Projekte für die Nachwelt veröffentlichen, zum anderen ist dies ein Marktplatz für Ideen. Allerdings gibt es da ein paar Regeln die ihr beachten solltet: † Wenn ihr eine Projektidee hier postet muss sie mehr als nur der typische Zweizeiler sein. "Man könnte ja mal ein MMORPG mit Actionelementen machen...!" ist keine Projektidee sondern ein (schlechter) Witz. † Wenn ihr Codeleichen postet müssen sie:  lauffähig sein
gekennzeichnet sein für welche Sprache der Code ist
alle Medias die nötig sind beinhalten. Dafür könnt ihr fremden Space oder das Archiv nutzen.
idealerweise gut kommentiert sein damit sich andere in eurem Code zurechtfinden
hundertprozentig von euch sein. Was ihr hier veröffentlicht gilt als OPEN SOURCE
Es ist unter keinen Umständen statthaft für die Codes hier die Galerie zu benutzen. Wenn ihr Bilder etc. zeigen wollt erfolgt das auschliesslich über eigenen Webspace oder eben das Archiv. Wir werden hier in regelmäßigen Abständen Kehraus halten. Wenn Links nicht funktionieren oder ein Code zweifelhaft in seiner Qualität ist wird er kommentarlos gelöscht. Bitte nutzt diesen Thread auch nicht als Diskussionsplattform für Ideen die darin stehen - wenn ihr Fragen oder Anmerkungen zu einer Idee habt, meldet das per PM an die entsprechenden User. Viel Freude mit dem Codefriedhof wünscht euch die Portalsadministration |
||
|
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3 Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64 B3D BMax MaxGUI Stolzer Gewinner des BAC#48, #52 & #92 |
||
- Zuletzt bearbeitet von BladeRunner am Sa, Dez 27, 2008 21:26, insgesamt einmal bearbeitet
|
|
BladeRunnerModerator |
Sa, Dez 13, 2008 15:29 Antworten mit Zitat
|
|---|---|---|
|
Konstantin hat Folgendes geschrieben: um mich ein wenig mit blitzmax anzufreunden, habe ich ein sehr einfach gestricktes snake-spiel geschrieben. der code ist weitestgehend selbsterklaerend.
BMAX: Code: [AUSKLAPPEN] ' a tiny snake clone ' konstantin schuerheck 2008 ' introscreen() stop the game, wait for player ' newgame() reset the game state ' controls() check for player input ' update() update game physics ' feed(x) enlarge the snake by x tiles ' createvictim() create a new victim by random ' draw() draw the screen ' initialize graphics apptitle = "a tiny snake clone" graphics(320, 240) setclscolor(0, 0, 32) ' create the snake global snake:TList = createlist() type tSnakeTile field x, y field oldx, oldy method bef:tSnakeTile() local link:TLink = ListFindLink(snake,Self).PrevLink() if link return tSnakeTile(link.Value()) else return Null endif endmethod end type global snake_direction ' 0: up, 1: right, 2: down, 3: left ' some food for the snake :) global victims:TList = createlist() type tVictim field x, y field lifespan field t ' type; 0: green (+2), 1: yellow (+4), 2: red (+6) 3: purple (+10) end type ' set up the score global score = 0 ' intro introscreen() ' main loop repeat controls() update() draw() 'fucked up delay 100 until appterminate() ' a small intro screen function introscreen() draw() setcolor 196, 98, 0 drawtext "press any key to start the game", 36, 215 flip waitkey newgame() end function ' set up a new game function newgame() ' set up a new snake for tile:tSnakeTile = eachin snake listremove(snake, tile) next for i = 1 to 5 tile:tSnakeTile = new tSnakeTile tile.x = 19 tile.y = 14 snake.addlast(tile) next snake_direction = 1 ' reset the victims for victim:tVictim = eachin victims listremove(victims, victim) next createvictim() score = 0 end function ' player controls function controls() if keyhit(KEY_UP) and snake_direction <> 2 then snake_direction = 0 if keyhit(KEY_DOWN) and snake_direction <> 0 then snake_direction = 2 if keyhit(KEY_LEFT) and snake_direction <> 1 then snake_direction = 3 if keyhit(KEY_RIGHT) and snake_direction <> 3 then snake_direction = 1 end function ' update the snake position function update() ' update the snake's head head:tSnakeTile = tSnakeTile(snake.first()) head.oldx = head.x head.oldy = head.y select snake_direction case 0 head.y = head.y - 1 case 1 head.x = head.x + 1 case 2 head.y = head.y + 1 case 3 head.x = head.x - 1 end select if head.x > 39 then head.x = 0 if head.x < 0 then head.x = 39 if head.y > 29 then head.y = 0 if head.y < 0 then head.y = 29 ' check for gameover for tile:tSnakeTile = eachin snake if tile <> snake.first() then if head.x = tile.x and head.y = tile.y then introscreen() endif next ' update the tail for tile:tSnakeTile = eachin snake prevtile:tSnakeTile = tile.bef() if prevtile then tile.oldx = tile.x tile.oldy = tile.y tile.x = prevtile.oldx tile.y = prevtile.oldy endif next ' update the victims for victim:tVictim = eachin victims ' check if eaten if victim.x = head.x and victim.y = head.y then select victim.t case 0 feed(2) score = score + 200 case 1 feed(4) score = score + 400 case 2 feed(6) score = score + 600 case 3 feed(10) score = score + 1000 end select listremove(victims, victim) createvictim() endif ' check if lifespan's exceeded if millisecs() > victim.lifespan then listremove(victims, victim) createvictim() endif next end function ' feed the snake function feed(length) lasttile:tSnakeTile = tSnakeTile(snake.last()) for i = 1 to length newtile:tSnakeTile = new tSnakeTile newtile.x = lasttile.x newtile.y = lasttile.y snake.addlast(newtile) next end function ' create a new victim function createvictim() victim:tVictim = new tVictim local overlap repeat victim.x = rnd(40) victim.y = rnd(30) overlap = 0 for tile:tSnakeTile = eachin snake if victim.x = tile.x and victim.y = tile.y then overlap = 1 next if overlap = 0 then exit forever victim.t = rnd(4) victim.lifespan = millisecs() + 3000 + rnd(5000) victims.addlast(victim) end function ' draw the screen function draw() cls ' draw the backround-grid setcolor 0, 0, 64 for i = 1 to 40 drawline(i * 8, 0, i * 8, 240) next for i = 1 to 30 drawline(0, i * 8, 320, i * 8) next ' draw the snake setcolor 0, 0, 128 for tile:tSnakeTile = eachin snake drawrect tile.x * 8 + 1, tile.y * 8 + 1, 7, 7 next ' draw the victims for victim:tVictim = eachin victims select victim.t case 0 setcolor 0, 255, 0 case 1 setcolor 255, 255, 0 case 2 setcolor 255, 0, 0 case 3 setcolor 255, 0, 255 end select drawrect victim.x * 8 + 1, victim.y * 8 + 1, 7, 7 next ' draw the score setcolor 0, 196, 0 drawtext "Score: " + score, 10, 10 flip end function |
||
|
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3 Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64 B3D BMax MaxGUI Stolzer Gewinner des BAC#48, #52 & #92 |
||
|
tedy |
Sa, Dez 13, 2008 17:48 Antworten mit Zitat
|
|---|---|---|
|
Ich hatte auch mal ein Pong clone gemacht um mich mit Bmax anzufreunden :O
Vieleicht kanns ja wer gebrauchen : Sprache : BMAX Code: [AUSKLAPPEN] Graphics 800,600 SetClsColor 64,64,64 SeedRnd MilliSecs() Local points:String Type Tplayer Field x:Int Field y:Int Field speed=2:Int Field points:Int Method up() y=y-speed If y<0+20 Then y=0+20 End Method Method down() y=y+speed If y>(600-50-20) Then y=(600-50-20) End Method End Type Type Tball Field x=400:Int,y=300:Int Field xspeed=2:Int,yspeed=2:Int End Type Local playerlist:Tlist = New Tlist Local player1:Tplayer = New Tplayer player1.x=10 player1.y=270 playerlist.Addlast(player1) Local player2:Tplayer = New Tplayer player2.x=780 player2.y=270 playerlist.Addlast(player2) Local ball:Tball = New Tball If Rand(0,1)=0 Then ball.xspeed=-ball.xspeed Local maintimer=CreateTimer(60) While Not KeyHit(KEY_ESCAPE) SetColor 170,170,170 For Local player_:Tplayer = EachIn playerlist DrawRect player_.x,player_.y,10,50 If ball.x+5>=player_.x And ball.x-5<=player_.x+10 And ball.y>=player_.y And ball.y<=player_.y+50 ball.xspeed=ball.xspeed*-1 EndIf Next SetColor 150,150,150 DrawOval ball.x-5,ball.y-5,10,10 SetColor 100,100,100 DrawRect 0,0,800,20 DrawRect 0,580,800,20 ball.x=ball.x+ball.xspeed ball.y=ball.y+ball.yspeed If ball.y<=20+5 Or ball.y>=(600-20-5) ball.yspeed=ball.yspeed*-1 EndIf If ball.x<0 Then player2.points=player2.points+1 If KeyDown(KEY_UP) player1.up() EndIf If KeyDown(KEY_down) player1.down() EndIf points=player1.points+" | "+player2.points SetColor 0,0,0 DrawText points,GraphicsWidth()/2-TextWidth(points),5 WaitTimer(maintimer) Flip Cls Wend |
||
Rocys |
Sa, Dez 13, 2008 18:36 Antworten mit Zitat
|
|
|---|---|---|
|
Ich habe mit Blitz2d mal angefangen, einen Oil-Imperium Clon zu schreiben. Leider hatte ich unterwegs keine Lust mehr.
Ist aber schon ein bisschen spielbar. https://www.blitzforum.de/upload/file.php?id=4027 |
||
|
BlitzcoderNewsposter |
So, Dez 14, 2008 2:15 Antworten mit Zitat
|
|---|---|---|
|
Ein kleiner Pong-Clone. War mal dafür gedacht um eine intelligente Pong KI reinzuhängen, einen PaddleController. Schaut euch die Main.bmx an, das erklärt eigentlich alles.
http://blitz-coder.de/data/Pong.zip |
||
|
P4 3 Ghz@3,55Ghz|GF 6600GT 256MB|Samsung 80GB | 2x Samsung 160GB|2048MB DDR-400 RAM|6 Mbit Flatrate | Logitech G15 | Samsung 225BW-TFT | Ubuntu Gutsy Linux | Windows Vista | Desktop | Blog | CollIDE | Worklog
________________ |°°°°°°°°°°°°°°||'""|""\__,_ |______________ ||__ |__|__ |) |(@) |(@)"""**|(@)(@)****|(@) |
||
|
Lobby |
So, Dez 14, 2008 11:58 Antworten mit Zitat
|
|---|---|---|
SGS2 
??.11.2006 - †??.02.2007 So, ich habe da jetzt aucheinmal ein Projekt vorzustellen, es hieß SGS2 (SkiGebietsSpiel), die Idee war ein 3D Aufbaustrategiespiel zu programmieren, in dem man ein Skigebiet auf die Beine stellen muss  .
Die Idee selbst ist nicht tod, aber das was ich damals geproggt habe auf jeden Fall, hier einmal ein 4er Screen: 
Steuern könnt ihr das 'Spiel' folgendermaßen: Mausrad drehen um zu Moven Mausrad klicken um die Kamera zu drehen (ich weiß, das ist sehr unhandlich) Cursortasten um ebenfalls zu Moven Mausrad klicken+drehen um langsamer zu Moven Mit der Taste 'W' könnt ihr Wireframe de-/aktivieren Escape fürs beenden Mit der Space-Taste wird die Map gespeichert, und so wieder beim nächsten Start geladen Oben habt ihr ein Menü, der erste Button, der mit dem Kran drauf, ist fürs Bauen zuständig, wählt einfach mal irgendeinen aus und baut es (rechte Maustaste zum Abrechen)  .
Der mittlere Button, das Auge, bietet euch die Möglichkeit mit einem Pistenfahrzeug umherzufahren (auch das könnt ihr mithilfe der rechten Maustaste beenden). Der ganz rechte Button, der mit dem 'I', hat noch keine besondere Beudeutung oder Funktion. Abreisen könnt ihr über das Baumenü, das unterste Icon (der Bulldozer). Nach dem Start könnt ihr einen Move durch die bisherige Landschaft mithilfe einer beliebigen Taste abbrechen, oben links, die unterste Angabe gibt euch die FPS an, ich hoffe sie sind bei euch über 24 .
>>>Download<<< (9,26MB) Ich habe euch eine Auswahl an verschiedenen Auflösungen/Modes in Form kompilierter Exen zur Verfügung gestellt, wenn ihr Blitz3D habt so könnt ihr die Auflösung in der Datei start.bb umändern, um das Spiel zu Compielen müsst ihr die game.bb öffnen und Ausführen. Ein wichtiges Element das nahezu noch vollständig fehlt sind Pisten sowie deren Skifahrer. Das Spiel ist jetzt schon ~2 Jahre alt, aufgegeben mangels Erfahrung vorallem im Bereich 3D (z.B. kein single Surface), der nächste Versuch soll in BlitzMax, MiniB3D umgesetzt werden aber bisher gibts keine anständige Terrainunterstützung (klepto2, mach schon ).
Achja, es sind übrigends sicherlich unnötige Dinge in dem Paket, außerdem bitte ich daran zu denken,dass die game.bb ist die Hauptdatei, der Code ist mehr oder weniger mit Kommentaren gekennzeichnet .
Wichtig, die Musik ist von Kernle32DLL, vielen Dank  .
So, das wars, ich hoffe mein Projekt soweit gut begraben zu haben um es bei anderen oder gar mir selbst wieder auferstehen zu lassen. |
||
- Zuletzt bearbeitet von Lobby am So, Jan 29, 2012 12:01, insgesamt einmal bearbeitet
|
coolo |
Mo, Dez 15, 2008 10:48 Antworten mit Zitat
|
|---|---|---|
|
Hallo,
nun da ich auch ein totes Projekt habe, möchte ich es nun anständig begraben. Es ist mein allererster Versuch eine Scriptsprache zu schreiben. Der Code ist grausig und EXTREM verbuggt. Nundenn. Syntax ist so zielmlich der grauslichste den es je gab... Variablen haben kein Vorzeichen. um Variablen zu ändern, muss man var davor schreiben. Das Script selber läuft in einer Endlosschleife. https://www.blitzforum.de/upload/file.php?id=4043 Bitte nicht hauen wegen grauslichen Code... Achja bevor ichs vergesse: B2D, B3D,B+ |
||
|
http://programming-with-design.at/ <-- Der Preis ist heiß!
That's no bug, that's my project! "Eigenzitate sind nur was für Deppen" -Eigenzitat |
||
|
|
BladeRunnerModerator |
Sa, Dez 27, 2008 21:26 Antworten mit Zitat
|
|---|---|---|
| ... aufgrund mangelnder Resonanz depinned. Es liegt in Zukunft an Euch diesen Thread am Leben zu erhalten. | ||
|
Zu Diensten, Bürger.
Intel T2300, 2.5GB DDR 533, Mobility Radeon X1600 Win XP Home SP3 Intel T8400, 4GB DDR3, Nvidia GF9700M GTS Win 7/64 B3D BMax MaxGUI Stolzer Gewinner des BAC#48, #52 & #92 |
||
Florian |
So, Dez 28, 2008 19:15 Antworten mit Zitat
|
|
|---|---|---|
|
Hallo,
hier mit stelle ich eine Virtuelle Maschine (VM) und einen Assembler zu Verfügung. Download [BlitzBasic] Code: [AUSKLAPPEN] Const Direkt = 1 Const Immediate = 2 Const VarInt = 3 Const CMarke = 4 Const RegisterEAX = 5 Const RegisterEBX = 6 Const RegisterIndirektEAX= 7 Const RegisterIndirektEBX= 8 Const KeinParameter = 9 Type ConstIntTyp Field Name$ Field Wert End Type Type MarkeTyp Field Name$ Field Adresse End Type Type VariableTyp Field Name$ Field Adresse Field Wert End Type Type AsmBefehlTypTyp Field BefehlNr Field Befehl$ Field Parameter1Typ Field Parameter2Typ Field Lang End Type Type AssemblerTyp Field Position Field InputDatei$ Field OutputDatei$ Field Speicher Field InputDateiNr Field OutputDateiNr Field AusgabeArt End Type Type AsmBefehlTyp Field Parameter1$ Field Parameter2$ Field Parameter1Typ Field Parameter2Typ Field Position Field BefehlNr End Type Global ConstInt.ConstIntTyp Global Marke.MarkeTyp Global Variable.VariableTyp Global AsmBefehlTyp.AsmBefehlTypTyp Global Assembler.AssemblerTyp Global AsmBefehl.AsmBefehlTyp Global BefehlLang[32] Global BefehlName$[32] Global BefehlTyp$[32] ;MOV Const MOV_EAX_EBX = 1 Const MOV_EBX_EAX = 2 Const MOV_EAX_Const = 3 Const MOV_EBX_Const = 4 Const RESTORE_EAX_CONST = 5 Const RESTORE_EBX_CONST = 6 Const RESTORE_EAX_EBX = 7 Const RESTORE_EBX_EAX = 8 Const LOAD_EAX_CONST = 9 Const LOAD_EBX_CONST = 10 Const LOAD_EAX_EBX = 11 Const LOAD_EBX_EAX = 12 ;Mathe Const ADD_EAX_EBX = 13 Const NEG_EAX = 14 Const SUB_EAX_EBX = 15 Const DIV_EAX_EBX = 16 Const MUL_EAX_EBX = 17 ;Setzt Zero=True ;EAX und EBX Const LT_EAX_EBX = 18 ;* < Const GT_EAX_EBX = 19 ;* > Const LE_EAX_EBX = 20 ;* <= Const GE_EAX_EBX = 21 ;* >= Const EQ_EAX_EBX = 22 ;* <> Const NE_EAX_EBX = 23 ;* = ;Push Const Push_EAX = 24 Const Push_EBX = 25 ;Pop Const POP_EAX = 26 Const POP_EBX = 27 ;Function Const Call_Int = 28 Const JMP_CONST = 29 Const JZ_CONST = 30 Const Ret = 31 Const Call = 32 Type TaskTyp Field Speicher Field SpeicherByte Field EIP Field ZERO ;Register Field EAX Field EBX Field StackZeiger End Type Global Task.TaskTyp Task=New TaskTyp Inst_Assembler Assembler=New AssemblerTyp Assembler\Position=0 Task\Speicher=CreateBank(200) asmZeile "Jmp :C" asmzeile "var t = 5" AsmZeile "MOV EAX 1000" asmzeile ":Z" asmzeile "DB 'Das ist ein Test.'" asmzeile ":C" AsmZeile "MOV EAX :Z" AsmZeile "CALLINT 3" AsmZeile "LOAD EAX T" Asmzeile "Mov EBX 1" Asmzeile "EQ EAX EBX" AsmZeile "SUB EAX EBX" AsmZeile "RESTORE EAX t" Asmzeile "JZ :C" Asmzeile "CALLINT 2" DateiNr=WriteFile("Comp.txt") Kompiliere_ASM ;WaitKey Task=First TaskTyp WriteBytes Task\Speicher,DateiNr,0,199 Run_VM WaitKey Function Upper$(S$) Slen=Len(S) If Slen>0 Then For P=1 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>96 And Ascii<123 Then Ascii=Ascii-32 ElseIf Ascii=252 Then ;ü Ascii=220 ElseIf Ascii=228 Then ;ä Ascii=196 ElseIf Ascii=246 Then ;ö Ascii=214 End If R$=R$+Chr$(ASCII) Next Return R$ End If End Function Function Lower$(S$) Slen=Len(S) If Slen>0 Then For P=1 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>64 And Ascii<92 Then Ascii=Ascii+32 ElseIf Ascii=220 Then ;ü Ascii=252 ElseIf Ascii=196 Then ;ä Ascii=228 ElseIf Ascii=214 Then ;ö Ascii=246 End If R$=R$+Chr$(ASCII) Next Return R$ End If End Function Function Run_VM() Repeat Select PeekByte(Task\Speicher,Task\EIP) Case MOV_EAX_EBX Task\EAX=Task\EBX Task\EIP=Task\EIP+1 Case MOV_EBX_EAX Task\EBX=Task\EAX Task\EIP=Task\EIP+1 Case MOV_EAX_CONST Task\EAX=PeekInt(Task\Speicher,Task\EIP+1) Task\EIP=Task\EIP+5 Case MOV_EBX_CONST Task\EBX=PeekInt(Task\Speicher,Task\EIP+1) Task\EIP=Task\EIP+5 Case RESTORE_EAX_CONST PokeInt Task\Speicher,PeekInt(Task\Speicher,Task\EIP+1),Task\EAX Task\EIP=Task\EIP+5 Case RESTORE_EBX_CONST PokeInt Task\Speicher,PeekInt(Task\Speicher,Task\EIP+1),Task\EBX Task\EIP=Task\EIP+5 Case RESTORE_EAX_EBX PokeInt Task\Speicher,Task\EAX,Task\EBX Task\EIP=Task\EIP+1 Case RESTORE_EBX_EAX PokeInt Task\Speicher,Task\EBX,Task\EAX Task\EIP=Task\EIP+1 Case LOAD_EAX_CONST Task\EAX=PeekInt(Task\Speicher,PeekInt(Task\Speicher,Task\EIP+1)) Task\EIP=Task\EIP+5 Case LOAD_EBX_CONST Task\EBX=PeekInt(Task\Speicher,PeekInt(Task\Speicher,Task\EIP+1)) Task\EIP=Task\EIP+5 Case LOAD_EAX_EBX Task\EAX=PeekInt(Task\Speicher,Task\EBX) Task\EIP=Task\EIP+1 Case LOAD_EBX_EAX Task\EBX=PeekInt(Task\Speicher,Task\EAX) Task\EIP=Task\EIP+1 Case ADD_EAX_EBX Task\EAX=Task\EAX+Task\EBX Task\EIP=Task\EIP+1 Case NEG_EAX Task\EAX=-Task\EAX Task\EIP=Task\EIP+1 Case SUB_EAX_EBX Task\EAX=Task\EAX-Task\EBX Task\EIP=Task\EIP+1 Case DIV_EAX_EBX Task\EAX=Task\EAX/Task\EBX Task\EIP=Task\EIP+1 Case MUL_EAX_EBX Task\EAX=Task\EAX*Task\EBX Task\EIP=Task\EIP+1 Case LT_EAX_EBX ; < If Task\EAX<Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case GT_EAX_EBX ; > If Task\EAX>Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case LE_EAX_EBX ; <= If Task\EAX<=Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case GE_EAX_EBX ; >= If Task\EAX>=Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case EQ_EAX_EBX ; <> If Task\EAX<>Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case NE_EAX_EBX ; = If Task\EAX=Task\EBX Then Task\ZERO=True Else Task\ZERO=False End If Task\EIP=Task\EIP+1 Case Push_EAX PushInt Task\EAX Task\EIP=Task\EIP+1 Case Push_EBX PushInt Task\EBX Task\EIP=Task\EIP+1 Case POP_EAX Task\EAX=PopInt() Task\EIP=Task\EIP+1 Case POP_EBX Task\EAX=PopInt() Task\EIP=Task\EIP+1 Case Call_Int Select PeekInt(Task\Speicher,Task\EIP+1) Case 1 Print Task\EAX Case 3 Print GetString$(Task\EAX) Case 2 Print "ENDE" Return End Select Task\EIP=Task\EIP+5 Case JMP_CONST Task\EIP=PeekInt(Task\Speicher,Task\EIP+1) Case JZ_CONST If Task\ZERO=True Then Task\EIP=PeekInt(Task\Speicher,Task\EIP+1) Else Task\EIP=Task\EIP+5 End If Case RET Task\EIP=PopInt() Case Call PushInt(Task\EIP+5) Task\EIP=PeekInt(Task\Speicher,Task\EIP+1) End Select Forever End Function Function SetString(P,S$) LenS=Len(S$)-1 For X=0 To LenS PokeByte Task\Speicher,P+X,Asc(Mid$(S$,X,1)) Next End Function Function GetString$(P) Zeichen=PeekByte(Task\Speicher,P) While Zeichen<>0 S$=S$+Chr$(Zeichen) P=P+1 Zeichen=PeekByte(Task\Speicher,P) Wend Return S$ End Function Function GetInt(IntNr) PeekInt(Task\Speicher,IntNr*4+5) End Function Function PushInt(IntWert) PokeInt Task\Speicher,Task\StackZeiger,IntWert Task\StackZeiger=Task\StackZeiger+4 End Function Function PopInt() Task\StackZeiger=Task\StackZeiger-4 Return PeekInt(Task\Speicher,Task\StackZeiger) End Function Function Inst_Assembler() BefehlLang[ 1]=1 BefehlName[ 1]="MOV_EAX_EBX" BefehlTyp [ 1]="MOV" BefehlLang[ 2]=1 BefehlName[ 2]="MOV_EBX_EAX" BefehlTyp [ 2]="MOV" BefehlLang[ 3]=5 BefehlName[ 3]="MOV_EAX_Const" BefehlTyp [ 3]="MOV" BefehlLang[ 4]=5 BefehlName[ 4]="MOV_EBX_Const" BefehlTyp [ 4]="MOV" BefehlLang[ 5]=5 BefehlName[ 5]="RESTORE_EAX_CONST" BefehlTyp [ 5]="RESTORE" BefehlLang[ 6]=5 BefehlName[ 6]="RESTORE_EBX_CONST" BefehlTyp [ 6]="RESTORE" BefehlLang[ 7]=1 BefehlName[ 7]="RESTORE_EAX_EBX" BefehlTyp [ 7]="RESTORE" BefehlLang[ 8]=1 BefehlName[ 8]="RESTORE_EBX_EAX" BefehlTyp [ 8]="RESTORE" BefehlLang[ 9]=5 BefehlName[ 9]="LOAD_EAX_CONST" BefehlTyp [ 1]="LOAD" BefehlLang[10]=5 BefehlName[10]="LOAD_EBX_CONST" BefehlTyp [10]="LOAD" BefehlLang[11]=1 BefehlName[11]="LOAD_EAX_EBX" BefehlTyp [11]="LOAD" BefehlLang[12]=1 BefehlName[12]="LOAD_EBX_EAX" BefehlTyp [12]="LOAD" BefehlLang[13]=1 BefehlName[13]="ADD_EAX_EBX" BefehlTyp [13]="LOAD" BefehlLang[14]=1 BefehlName[14]="NEG_EAX" BefehlTyp [14]="NEG" BefehlLang[15]=1 BefehlName[15]="SUB_EAX_EBX" BefehlTyp [15]="SUB" BefehlLang[16]=1 BefehlName[16]="DIV_EAX_EBX" BefehlTyp [16]="DIV" BefehlLang[17]=1 BefehlName[17]="MUL_EAX_EBX" BefehlTyp [17]="MUL" BefehlLang[18]=1 BefehlName[18]="LT_EAX_EBX" BefehlTyp [18]="LT" BefehlLang[19]=1 BefehlName[19]="GT_EAX_EBX" BefehlTyp [19]="GT" BefehlLang[20]=1 BefehlName[20]="LE_EAX_EBX" BefehlTyp [20]="LE" BefehlLang[21]=1 BefehlName[21]="GE_EAX_EBX" BefehlTyp [ 1]="GE" BefehlLang[22]=1 BefehlName[22]="EQ_EAX_EBX" BefehlTyp [22]="EQ" BefehlLang[23]=1 BefehlName[23]="NE_EAX_EBX" BefehlTyp [23]="NE" BefehlLang[24]=1 BefehlName[24]="PUSH_EAX" BefehlTyp [24]="PUSH" BefehlLang[25]=1 BefehlName[25]="PUSH_EBX" BefehlTyp [25]="PUSH" BefehlLang[26]=1 BefehlName[26]="POP_EAX" BefehlTyp [26]="POP" BefehlLang[27]=1 BefehlName[27]="POP_EBX" BefehlTyp [27]="POP" BefehlLang[28]=5 BefehlName[28]="CALL_INT" BefehlTyp [28]="CALL_INT" BefehlLang[29]=5 BefehlName[29]="JMP_CONST" BefehlTyp [29]="JMP" BefehlLang[30]=5 BefehlName[30]="JZ_CONST" BefehlTyp [30]="JZ" BefehlLang[31]=1 BefehlName[31]="RET" BefehlTyp [31]="RET" BefehlLang[32]=5 BefehlName[32]="CAll" BefehlTyp [32]="CALL" Inst_AsmBefehl "MOV" ,MOV_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "MOV" ,MOV_EBX_EAX ,RegisterEBX ,RegisterEAX ,1 Inst_AsmBefehl "MOV" ,MOV_EAX_Const ,RegisterEAX ,Direkt ,5 Inst_AsmBefehl "MOV" ,MOV_EBX_Const ,RegisterEBX ,Direkt ,5 Inst_AsmBefehl "MOV" ,MOV_EAX_Const ,RegisterEAX ,CMarke ,5 Inst_AsmBefehl "MOV" ,MOV_EBX_Const ,RegisterEBX ,CMarke ,5 Inst_AsmBefehl "RESTORE",RESTORE_EAX_CONST,RegisterEAX ,Immediate ,5 Inst_AsmBefehl "RESTORE",RESTORE_EBX_CONST,RegisterEBX ,Immediate ,5 Inst_AsmBefehl "RESTORE",RESTORE_EAX_CONST,RegisterEAX ,CMarke ,5 Inst_AsmBefehl "RESTORE",RESTORE_EBX_CONST,RegisterEBX ,CMarke ,5 Inst_AsmBefehl "RESTORE",RESTORE_EAX_CONST,RegisterEAX ,VarInt ,5 Inst_AsmBefehl "RESTORE",RESTORE_EBX_CONST,RegisterEBX ,VarInt ,5 Inst_AsmBefehl "RESTORE",RESTORE_EAX_EBX ,RegisterEAX ,RegisterIndirektEBX,1 Inst_AsmBefehl "RESTORE",RESTORE_EBX_EAX ,RegisterEBX ,RegisterIndirektEAX,1 Inst_AsmBefehl "LOAD" ,LOAD_EAX_EBX ,RegisterEAX ,RegisterIndirektEBX,1 Inst_AsmBefehl "LOAD" ,LOAD_EBX_EAX ,RegisterEBX ,RegisterIndirektEAX,1 Inst_AsmBefehl "LOAD" ,LOAD_EAX_CONST ,RegisterEAX ,CMarke ,5 Inst_AsmBefehl "LOAD" ,LOAD_EBX_CONST ,RegisterEBX ,CMarke ,5 Inst_AsmBefehl "LOAD" ,LOAD_EAX_CONST ,RegisterEAX ,VarInt ,5 Inst_AsmBefehl "LOAD" ,LOAD_EBX_CONST ,RegisterEBX ,VarInt ,5 Inst_AsmBefehl "LOAD" ,LOAD_EAX_CONST ,RegisterEAX ,Immediate ,5 Inst_AsmBefehl "LOAD" ,LOAD_EBX_CONST ,RegisterEBX ,Immediate ,5 Inst_AsmBefehl "ADD" ,ADD_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "NEG" ,NEG_EAX ,RegisterEAX ,KeinParameter ,1 Inst_AsmBefehl "SUB" ,SUB_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "DIV" ,DIV_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "MUL" ,MUL_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "LT" ,LT_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "GT" ,GT_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "LE" ,LE_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "GE" ,GE_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "EQ" ,EQ_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "NE" ,NE_EAX_EBX ,RegisterEAX ,RegisterEBX ,1 Inst_AsmBefehl "PUSH" ,Push_EAX ,RegisterEAX ,KeinParameter ,1 Inst_AsmBefehl "PUSH" ,Push_EBX ,RegisterEBX ,KeinParameter ,1 Inst_AsmBefehl "POP" ,POP_EAX ,RegisterEAX ,KeinParameter ,1 Inst_AsmBefehl "POP" ,POP_EBX ,RegisterEBX ,KeinParameter ,1 Inst_AsmBefehl "CALLINT",Call_Int ,Direkt ,KeinParameter ,5 Inst_AsmBefehl "JMP" ,JMP_CONST ,Immediate ,KeinParameter ,5 Inst_AsmBefehl "JZ" ,JZ_CONST ,Immediate ,KeinParameter ,5 Inst_AsmBefehl "JMP" ,JMP_CONST ,CMarke ,KeinParameter ,5 Inst_AsmBefehl "JZ" ,JZ_CONST ,CMarke ,KeinParameter ,5 Inst_AsmBefehl "RET" ,Ret ,KeinParameter,KeinParameter ,5 Inst_AsmBefehl "CALL" ,Call ,Immediate ,KeinParameter ,5 Inst_AsmBefehl "CALL" ,Call ,CMarke ,KeinParameter ,5 End Function Function Inst_AsmBefehl(BefehlName$,BefehlNr,Parameter1Typ,Parameter2Typ,Befehllang) AsmBefehlTyp.AsmBefehlTypTyp = New AsmBefehlTypTyp AsmBefehlTyp\Befehl$=BefehlName$ AsmBefehlTyp\BefehlNr=BefehlNr AsmBefehlTyp\Parameter1Typ=Parameter1Typ AsmBefehlTyp\Parameter2Typ=Parameter2Typ AsmBefehlTyp\lang=Befehllang End Function ;#ImmediateInt ;#ImmediateByte ;DirektInt ;RegisterEAX ;RegisterEBX ;@registerindirektEAX ;@registerindirektEBX Function Kompiliere_ASM() For AsmBefehl.AsmBefehlTyp=Each AsmBefehlTyp ;Print BefehlName[AsmBefehl\BefehlNr] ;Print AsmBefehl\Parameter2Typ If AsmBefehl\Parameter1Typ=Direkt Then PokeByte Task\Speicher,AsmBefehl\Position+1,Int(AsmBefehl\Parameter1$) ElseIf AsmBefehl\Parameter1Typ=Immediate Then PokeByte Task\Speicher,AsmBefehl\Position+1,Int(AsmBefehl\Parameter1$) ElseIf AsmBefehl\Parameter1Typ=CMarke Then For Marke=Each MarkeTyp If Upper$(Marke\Name$)=Upper$(Mid$(AsmBefehl\Parameter1$,2)) Then PokeByte Task\Speicher,AsmBefehl\Position+1,Marke\Adresse End If Next ElseIf AsmBefehl\Parameter1Typ=VarInt Then For Variable = Each VariableTyp If Upper$(AsmBefehl\Parameter1$)=Upper$(Variable\Name$) Then PokeByte Task\Speicher,AsmBefehl\Position+1,Variable\Adresse End If Next ElseIf AsmBefehl\Parameter2Typ=Direkt Then PokeByte Task\Speicher,AsmBefehl\Position+1,Int(AsmBefehl\Parameter2$) ElseIf AsmBefehl\Parameter2Typ=Immediate Then PokeByte Task\Speicher,AsmBefehl\Position+1,Int(AsmBefehl\Parameter2$) ElseIf AsmBefehl\Parameter2Typ=CMarke Then For Marke=Each MarkeTyp If Upper$(Marke\Name$)=Upper$(Mid$(AsmBefehl\Parameter2$,2)) Then PokeByte Task\Speicher,AsmBefehl\Position+1,Marke\Adresse End If Next ElseIf AsmBefehl\Parameter2Typ=VarInt Then For Variable = Each VariableTyp If Upper$(AsmBefehl\Parameter2$)=Upper$(Variable\Name$) Then PokeByte Task\Speicher,AsmBefehl\Position+1,Variable\Adresse End If Next End If Next End Function Function AsmZeile(Zeile$) Befehl$=Trim$(Upper$(Mid$(Zeile$,1,Instr(Zeile$+" "," ")-1))) Local ParameterS$[8] Parameter$=Mid$(Zeile$,Instr(Zeile$+" "," ")+1) ParameterLang=Len(Parameter$) For Pos=1 To ParameterLang Select Mid$(Parameter$,Pos,1) Case " " If Len(ParameterS[ParameterNr])>0 Then ParameterNr=ParameterNr+1 End If Case ";" Exit Default If ParameterNr=8 Then Return ;Error End If ParameterS[ParameterNr]=ParameterS[ParameterNr]+Mid$(Parameter$,Pos,1) End Select Next Parameter1$=ParameterS[0] Parameter2$=ParameterS[1] Parameter3$=ParameterS[2] If Len(ParameterS[ParameterNr])=0 Then ParameterNr=ParameterNr-1 End If If Befehl$="DB" Then Zeilelang=Len(Zeile$) Start=Instr(Zeile$+" "," ") If Start=0 Then Return End If For POS=Start To Zeilelang Select Mid$(Zeile$,Pos,1) Case " " If ZeichenAn=True Then PokeByte Task\Speicher,Assembler\Position,Asc(Mid$(Zeile$,Pos)) Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" Else If Len(ZahlenStrByte$)>0 Then ByteZahl=Int(ZahlenStrByte$) If ByteZahl>255 Then Return ;ERROR End If PokeByte Task\Speicher,Assembler\Position,ByteZahl Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" End If End If Case "," If ZeichenAn=True Then PokeByte Task\Speicher,Assembler\Position,Asc(Mid$(Zeile$,Pos)) Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" Else If Len(ZahlenStrByte$)>0 Then ByteZahl=Int(ZahlenStrByte$) If ByteZahl>255 Then Return ;ERROR End If PokeByte Task\Speicher,Assembler\Position,ByteZahl Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" End If End If Case "'" If ZeichenAn=True Then PokeByte Task\Speicher,Assembler\Position,ZahlenStrByte$ Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" End If ZeichenAn=True-ZeichenAn Case "0","1","2","3","4","5","6","7","8","9" If ZeichenAn=True Then PokeByte Task\Speicher,Assembler\Position,Asc(Mid$(Zeile$,Pos)) Assembler\Position=Assembler\Position+1 Else zahlenstrByte$=zahlenstrByte$+Mid$(Zeile$,Pos,1) End If Case ";" If ZeichenAn=False Then ;ERROR Return End If PokeByte Task\Speicher,Assembler\Position,Asc(Mid$(Zeile$,Pos)) Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" Default If ZeichenAn=True Then PokeByte Task\Speicher,Assembler\Position,Asc(Mid$(Zeile$,Pos)) Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" Else Return ;ERROR End If End Select Next If ZahlenStrByte$<>"" Then PokeByte Task\Speicher,Assembler\Position,Int(ZahlenStrByte$) Assembler\Position=Assembler\Position+1 ZahlenStrByte$="" End If ElseIf Befehl$="DW" Then Zeilelang=Len(Zeile$) Pos=Instr(Zeile$+" "," ")-1 If Start=0 Then Return End If For POS=Start To Zeilelang Select Mid$(Zeile$,Pos) Case ";" If (ZahlenStrDB$)>0 Then Zahlshort=Int(ZahlenStrDB$) PokeShort Task\Speicher,Assembler\Position,Zahlshort ZahlenStrDB$="" Else End If Return Case " " If (ZahlenStrDB$)>0 Then Zahlshort=Int(ZahlenStrDB$) PokeShort Task\Speicher,Assembler\Position,Zahlshort ZahlenStrDB$="" Else End If Case "," If (ZahlenStrDB$)>0 Then Zahlshort=Int(ZahlenStrDB$) PokeShort Task\Speicher,Assembler\Position,Zahlshort ZahlenStrDB$="" Else End If Case "0","1","2","3","4","5","6","7","8","9" ZahlenStrDB$=ZahlenstrDB$+Mid$(Zeile$,Pos) Default End Select Next If (ZahlenStrDB$)>0 Then Zahlshort=Int(ZahlenStrDB$) PokeShort Task\Speicher,Assembler\Position,Zahlshort ZahlenStrDB$="" End If ElseIf ISMarke(Befehl$)=True Then Marke=New MarkeTyp Marke\Name$= MarkeName$(Befehl$) Marke\Adresse=Assembler\Position ElseIf Befehl$="VAR" Then If ISVariable(Upper$(Parameter1$))=False Then Return ;ERROR End If For Variable=Each VariableTyp If Upper$(Variable\Name$)=Upper$(Parameter1$) Then Return ;ERROR End If Next If Len(Parameter2$)=0 Or Parameter2$="?" Then Variable=New VariableTyp Variable\Name$=Upper$(Parameter1$) Variable\Adresse=Assembler\Position Variable\Wert=0 Return End If If Parameter2$<>"=" Then Return ;ERROR End If Variable=New VariableTyp Variable\Name$=Upper$(Parameter1$) Variable\Adresse=Assembler\Position Variable\Wert=Int(Parameter3$) PokeInt Task\Speicher,Assembler\Position,Variable\Wert Assembler\Position=Assembler\Position+4 Return ElseIf Befehl$=";" Then Return ElseIf Befehl$="INCLUDE$" Then ElseIf ISMarke(Befehl$)=True Then Marke=New MarkeTyp Marke\Name$= MarkeName$(Befehl$) Marke\Adresse=Assembler\Position Return Else ASM Befehl$,Upper$(Parameter1$),Upper$(Parameter2$) End If End Function Function ASM(Befehl$,Parameter1$="",Parameter2$="") Befehl$=Upper(Befehl$) If Parameter1$="@EAX" Then Parameter1Typ=RegisterIndirektEAX ElseIf Parameter1$="@EBX" Then Parameter1Typ=RegisterIndirektEBX ElseIf Parameter1$="EAX" Then Parameter1Typ=RegisterEAX ElseIf Parameter1$="EBX" Then Parameter1Typ=RegisterEBX ElseIf Parameter1$="" Then Parameter1Typ=KeinParameter ElseIf ISInt(Parameter1$) Then Parameter1Typ=Direkt ElseIf ISMarke(Parameter1$)Then Parameter1Typ=CMarke ElseIf ISVariable(Upper$(Parameter1$))=True Then Parameter1Typ=VarInt ElseIf Parameter1$=";" Then Parameter1$="" End If If Parameter2$="@EAX" Then Parameter2Typ=RegisterIndirektEAX ElseIf Parameter2$="@EBX" Then Parameter2Typ=RegisterIndirektEBX ElseIf Parameter2$="EAX" Then Parameter2Typ=RegisterEAX ElseIf Parameter2$="EBX" Then Parameter2Typ=RegisterEBX ElseIf Parameter2$="" Then Parameter2Typ=KeinParameter ElseIf ISInt(Parameter2$) Then Parameter2Typ=Direkt ElseIf ISMarke(Parameter2$)Then Parameter2Typ=CMarke ElseIf ISVariable(Upper$(Parameter2$))=True Then Parameter2Typ=VarInt ElseIf Parameter2$=";" Then Parameter2$="" End If For AsmBefehlTyp=Each AsmBefehlTypTyp If Upper$(Befehl$)=Upper$(AsmBefehlTyp\Befehl$) Then If Parameter1Typ=AsmBefehlTyp\Parameter1Typ Then If Parameter2Typ=AsmBefehlTyp\Parameter2Typ Then AsmBefehl=New AsmBefehlTyp AsmBefehl\Parameter1$=Parameter1$ AsmBefehl\Parameter2$=Parameter2$ AsmBefehl\Parameter1Typ=Parameter1Typ AsmBefehl\Parameter2Typ=Parameter2Typ AsmBefehl\Position=Assembler\Position AsmBefehl\BefehlNr=AsmBefehlTyp\BefehlNr PokeByte Task\Speicher,Assembler\Position,AsmBefehl\BefehlNr Assembler\Position=Assembler\Position+AsmBefehlTyp\lang Return End If End If End If Next End Function Function ISVariable(S$) Slen=Len(S) If Slen>0 Then For P=1 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>64 And Ascii<92 Then ElseIf Ascii=220 Then ;ü ElseIf Ascii=196 Then ;ä ElseIf Ascii=214 Then ;ö Else Return False End If Next Return True End If End Function Function MarkeName$(Marke$) Return Mid$(Marke$,2) End Function Function ISMarke(S$) Slen=Len(S) If Mid$(S$,1,1)<>":" Then Return False If Slen>0 Then For P=2 To Slen ASCII=Asc(Mid$(S$,P,1)) If Ascii>64 And Ascii<92 Then ElseIf Ascii=220 Then ;ü ElseIf Ascii=196 Then ;ä ElseIf Ascii=214 Then ;ö Else Return False End If Next Return True End If End Function Function ISInt(S$) Slen=Len(S$) For P=1 To Slen If Instr("0123456789",Mid$(S$,P,1))=0 Then Return False Next If Slen=0 Then Return False End If Return True End Function Function Exist_Datei(Datei$) If FileType(datei)=1 Then Return True Else Return False End If End Function |
||
- Zuletzt bearbeitet von Florian am Mi, Dez 31, 2008 19:36, insgesamt einmal bearbeitet
|
SYSThern |
So, Dez 28, 2008 19:26 Antworten mit Zitat
|
|---|---|---|
|
hallo
vielleicht kennt der eine oder andere mein altes projekt Jump_Racer (0.5) es ist schon seit mitte des jahres auf eis und als opensource zu downloaden... https://www.blitzforum.de/foru...hp?t=28545 hoffe es passt hier her...
mfG SYSThern |
||
|
Tools and Programms
-------------------- www.systhern.de |
||
BIG BUG |
Mo, Dez 29, 2008 23:39 Antworten mit Zitat
|
|
|---|---|---|
|
Auch wenn ich in diesem Thread nicht wirklich einen Sinn sehe, poste ich trotzdem mal was.
Hier mal ein kleiner Versuch meinerseits mit B3D-Mitteln Stencil-Schatten zu simulieren: Code: [AUSKLAPPEN] ;stencil shadow test Graphics3D 1024,768,32,2 SetBuffer BackBuffer() light=CreateLight() RotateEntity light,75,60,0 ;create world container world = CreatePivot() ;create bottom plane plane = CreatePlane(5,world) EntityColor plane, 10, 100, 0 ;create "city" For i = 1 To 40 cube = CreateCube(world) PositionEntity cube, Rnd(-2,8), 0, Rnd(-8,8) ScaleEntity cube, 1,Rnd(1,2.5), 1 Next ;create & position camera cam=CreateCamera() PositionEntity cam, -2,10,-10 PointEntity cam, plane ;create alpha cube around camera to darken shadow image darken_cube = CreateCube(cam) EntityAlpha darken_cube, 0.7 ;shadow density EntityColor darken_cube, 0,0,0 ;shadow color FlipMesh darken_cube EntityFX darken_cube, 1 EntityOrder darken_cube, -1 ;create "shadow volume" - front side spr = CreateCube() ScaleMesh spr, 6, 6, 10 RotateMesh spr, 45,45,0 PositionMesh spr, -2, -3, 4 EntityColor spr, 255,0,255 ;render pink for later use with image mask EntityFX spr, 33 ; vertex-alpha to disable z-buffer writing on this one ;create back side of shadow volume spr_flip = CopyMesh(spr) FlipMesh spr_flip EntityColor spr_flip, 0, 0, 0 ;render black for later use with image mask EntityFX spr_flip, 1 ;create buffer images (used as lousy replacement for stencil buffer) imgWorld = CreateImage(GraphicsWidth(), GraphicsHeight()) ;contains rendered world without shadows imgShadowFrontSide = CreateImage(GraphicsWidth(), GraphicsHeight()) ;contains rendered front faces of shadow volume imgShadowBackSide = CreateImage(GraphicsWidth(), GraphicsHeight()) ;contains rendered back faces of shadow volume MaskImage imgWorld , 255, 0, 255 MaskImage imgShadowFrontSide, 255, 0, 255 MaskImage imgShadowBackSide , 0, 0, 0 SetBuffer BackBuffer() told = MilliSecs() Repeat td# = (MilliSecs() - told) / 20.0 told = MilliSecs() TurnEntity world, 0, td#, 0 ;--- first render world without shadowing HideEntity spr HideEntity spr_flip ShowEntity world CameraClsMode cam, 1,1 RenderWorld CopyRect 0,0,GraphicsWidth()-1, GraphicsHeight()-1,0,0,BackBuffer(), ImageBuffer(imgWorld) ;--- render pink front faces of shadow volume above world ShowEntity spr HideEntity spr_flip HideEntity world CameraClsMode cam, 0,0 ;keep rendered world and z-buffer RenderWorld CopyRect 0,0,GraphicsWidth()-1, GraphicsHeight()-1,0,0,BackBuffer(), ImageBuffer(imgShadowFrontSide) ;--- render black back faces of shadow volume on pink background HideEntity spr ShowEntity spr_flip HideEntity world CameraClsMode cam, 1,0 ;keep z-buffer CameraClsColor cam, 255, 0, 255 RenderWorld CopyRect 0,0,GraphicsWidth()-1, GraphicsHeight()-1,0,0,BackBuffer(), ImageBuffer(imgShadowBackSide) CameraClsColor cam, 0, 0, 0 ;--- post processing ;draw darkened world DrawBlock imgWorld, 0, 0 ShowEntity darken_cube HideEntity spr HideEntity spr_flip HideEntity world CameraClsMode cam, 0,1 RenderWorld HideEntity darken_cube ;mask world image with back faces of shadow volume SetBuffer ImageBuffer(imgWorld) DrawImage imgShadowBackSide, 0, 0 SetBuffer BackBuffer() ;draw front faces of shadow volume DrawImage imgShadowFrontSide, 0, 0 ;draw full bright world DrawImage imgWorld, 0, 0 ;fps calculation fps_fpscnt% = fps_fpscnt% + 1 fps_new_sec% = MilliSecs() If (fps_new_sec% => fps_old_sec% + 1000) fps_fps% = fps_fpscnt% fps_fpscnt% = 0 fps_old_sec% = fps_new_sec% EndIf Text 0,0, fps_fps% Flip 0 Until KeyHit(1) End Da man mit Imagemask-Befehlen den Stencil-Buffer nur sehr mäßig ersetzen kann ist das Ganze nur begrenzt einsatzfähig. Die Berechnung von Shadow Volumes habe ich mir gespart, so dass es nur einen Dummy-Schatten gibt. Vielleicht hilfts ja jemanden das Prinzip hinter Stencil-Schatten zu verstehen... |
||
|
B3D-Exporter für Cinema4D!(V1.4)
MD2-Exporter für Cinema4D!(final) |
||
|
Hubsi |
Di, Feb 17, 2009 20:27 Antworten mit Zitat
|
|---|---|---|
Wann ich das Projekt begonnen habe weiß ich nicht mehr, ist aber auch egal denke ich 
http://rc-chaoten.de/temp/Helifight.zip Gesteuert wird das ganze mit den Cursortasten, die KI hat die ein oder andere Macke und das schiessen ist vorbereitet, aber nicht implementiert. Im großen und ganzen geht nicht viel, aber vielleicht kanns ja einer gebrauchen
Laufen tut das ganze mit BlitzBasic 2D/3D und BlitzPlus. |
||
- Zuletzt bearbeitet von Hubsi am Sa, Nov 27, 2010 19:12, insgesamt einmal bearbeitet
|
Kernle 32DLL |
Mi, Feb 18, 2009 1:05 Antworten mit Zitat
|
|---|---|---|
|
Zeit das auch ich ein bisschen ausmiste. Hier 2 interessante Sachen aus meinem alten Vokabeltrainer Projekt... Bzw. genauer der Version 2.0, die nie erschienen ist.
Der Code zeugt nicht nur von meinem grauenhaften Programmierstil damals, sondern auch ein bisschen meine Denkweise in der ich auch noch heute programmiere: Alles dynamisch halten ^^ [1] TypeAction.bb Mein Include zum erstellen der Type-Einträge für meinen Vokabeltrainer, d.h. Klassen, Vokabelliste, etc. Eigentlich gehören da noch Funktionen zum auswerten der Daten zu, aber die sind tief in das Hauptprogramm integriert und da müsste ich schon den halben Code veröffentlichen damit das funktioniert... (Evt. mach ich das bei Zeiten sogar ). Leider habe ich auch nicht mehr die aktuellste Version, die enthielt nämlich auch die Delete Funktionen ^^
[2] Debug.bb Ein kleines nutzloses Include zum erweitern der [url=]DebugLog[/url] Funktion. Falls der File-Stream erstellt werden kann, werden dank dem neuen Befehl call_DebugLog Debugsachen nicht nur in die normale Debuglog, sondern auch in eine Datei geschrieben  Ebenfalls für den Vokabeltrainer 2.0 entstanden.
|
||
|
Mein PC: "Bluelight" - Xtreme Gamer PC [Video]
Meine Projekte: Cube-Wars 2010 [Worklog] Anerkennungen: 1. Platz BCC #7 , 1. Platz BCC #22 , 3. Platz BAC #89 Ich war dabei: NRW Treff III, IV ; Frankfurter BB Treffen 2009 |
||
|
Blackside |
Mi, Feb 18, 2009 19:31 Antworten mit Zitat
|
|---|---|---|
|
Habe mal John Conways Game of Life programmiert:
Infos: http://de.wikipedia.org/wiki/C...des_Lebens Steuerung: Enter -> Start/Stop Maus links -> Feld setzen Maus rechts -> Feld löschen L -> Laden S -> Speichern achja anzumerken wäre noch vorher einen ordner namens "maps" zu erstellen Game of Life:(BB2D/3D/BlitzPlus) Code: [AUSKLAPPEN] AppTitle "Game of Life"
Graphics 1024,768,32,2 SeedRnd MilliSecs() ;Kästchengröße Global SB = 16 Global SW = GraphicsWidth()/SB Global SH = GraphicsHeight()/SB Dim map(SW,SH) Dim temp_map(SW,SH) Dim Born(9) Dim Dead(9) ;Rules Born(3) = 1 Dead(3) = 1:Dead(2) = 1 ;Vars Local milli# = MilliSecs() Global play = False Local timer = CreateTimer(100) Local feldx,feldy Local speed = 100 Local font = LoadFont("",25) SetFont font While Not KeyDown(1) WaitTimer timer DrawMap() feldx = (MouseX()-(MouseX() Mod SB))/SB feldy = (MouseY()-(MouseY() Mod SB))/SB ;steuerung If MouseDown(1) Then play = 0:map(feldx,feldy) = 1 If MouseDown(2) Then play = 0:map(feldx,feldy) = 0 If KeyDown(46) Then Clearmap():play = 0 If KeyDown(19) Then FillMap(5) If KeyHit(57) Or KeyHit(28) Then play = 1-play Color 255,0,0 If KeyHit(31) Then FlushKeys():Locate 400,10:SaveMap(Input("Name: ")):FlushKeys() If KeyHit(38) Then FlushKeys():Locate 400,10:LoadMap(Input("Name: ")):FlushKeys() Color 255,0,0 speed = speed+(KeyDown(200)-KeyDown(208)) ;Neue Generation/Play If play = 1 And milli < MilliSecs() Then GenGen() milli = MilliSecs()+speed End If Color 255,0,0 Text 400,10,"Speed: "+speed Text 550,10,"Play: "+play Color 255,255,255 Flip 0 Cls Wend Function DrawMap() For y = 0 To SH-1 For x = 0 To SW-1 If play = 0 Then Rect x*SB,y*SB,SB,SB,0 Color 0,255,0 If map(x,y) > 0 Then Rect x*SB,y*SB,SB,SB Color 255,255,255 Next Next End Function Function FillMap(max) For y = 0 To SH-1 For x = 0 To SW-1 r = Rand(0,max) map(x,y) = (r = 1) Next Next End Function Function GenGen() For y = 0 To SH-1 For x = 0 To SW-1 Local nl = map(x-1,y) Local nr = map(x+1,y) Local nu = map(x,y-1) Local nd = map(x,y+1) Local nlu = map(x-1,y-1) Local nld = map(x-1,y+1) Local nru = map(x+1,y-1) Local nrd = map(x+1,y+1) If x = 0 Then nl = map(31,y) If x = SW-1 Then nr = map(0,y) If y = 0 Then nu = map(x,23) If y = SH-1 Then nd = map(x,0) Local alln = nl+nr+nu+nd+nlu+nld+nru+nrd If map(x,y) = 0 Then For i = 1 To 8 If Born(i) = 1 Then If alln = i Then temp_map(x,y) = 1 Exit EndIf Next End If If map(x,y) = 1 Then For l = 1 To 8 If Dead(l) = 1 Then If alln = l Then temp_map(x,y) = 1:Exit Else temp_map(x,y) = 0 End If Next End If Next Next For x = 0 To SW-1 For y = 0 To SH-1 map(x,y) = temp_map(x,y) temp_map(x,y) = 0 Next Next End Function Function Clearmap() For y = 0 To SH-1 For x = 0 To SW-1 map(x,y) = 0 Next Next End Function Function SaveMap(name$) Local stream = WriteFile("maps\"+name+".gol") WriteInt stream,SB For y = 0 To SH-1 For x = 0 To SW-1 WriteInt stream,map(x,y) Next Next CloseFile stream End Function Function LoadMap(name$) play = 0 Clearmap() Local stream = ReadFile("maps\"+name+".gol") SB = ReadInt(stream) SW = GraphicsWidth()/SB SH = GraphicsHeight()/SB Dim map(SW,SH) Dim temp_map(SW,SH) For y = 0 To SH-1 For x = 0 To SW-1 map(x,y) = ReadInt(stream) Next Next End Function |
||
| Hier sollte eigentlich eine Signatur stehen! | ||
|
|
Blackside |
Do, März 05, 2009 20:31 Antworten mit Zitat
|
|---|---|---|
Ich habe beim aufräumen meines Pcs noch 2 nützliche Gui-Elemente ausgegraben:
Vielleicht kann es ja jemand gebrauchen
editbox.bb: Code: [AUSKLAPPEN] Type EditBox
Field x#,y#,w#,h# Field txt$,active,curl = 1 Field milli,cursoron,backmilli,curmilli Field lines$[100],curchar = 1 End Type Function CreateEditBox.EditBox(x#,y#,w#,h#) Local eb.EditBox = New EditBox eb\x = x eb\y = y eb\w = w eb\h = h Return eb End Function Function UpdateEditBoxes() Local eb.EditBox,i,gk For eb.EditBox = Each EditBox ;zeichnen Rect eb\x,eb\y,eb\w,eb\h Color 0,0,0 For i = 0 To 100 Text eb\x+3,eb\y+(i*StringHeight("H")+3),eb\lines[i] Next ;active If MouseDown(1) Then If RectsOverlap(MouseX(),MouseY(),10,10,eb\x,eb\y,eb\w,eb\h) Then eb\active = 1 eb\curchar = Len(eb\lines[eb\curl]) eb\backmilli = 0 eb\curmilli = 0 FlushKeys() Else eb\active = 0 End If EndIf ;texteingabe If eb\active = 1 Then gk = GetKey() If gk > 31 Then eb\lines[eb\curl] = Mid(eb\lines[eb\curl],1,eb\curchar)+Chr(gk)+Mid(eb\lines[eb\curl],eb\curchar+1,Len(eb\lines[eb\curl])-eb\curchar+1) eb\curchar=eb\curchar+1 EndIf If KeyHit(14) Then If eb\curchar = 0 And eb\curl > 0 Then eb\curl=eb\curl-1:eb\curchar = Len(eb\lines[eb\curl]) If eb\curchar > 0 Then eb\lines[eb\curl] = (Mid(eb\lines[eb\curl],1,eb\curchar-1)+Mid(eb\lines[eb\curl],eb\curchar+1,Len(eb\lines[eb\curl])-eb\curchar+1)):eb\curchar=eb\curchar-1:eb\backmilli = MilliSecs()+500 EndIf If KeyDown(14) Then If eb\backmilli < MilliSecs() Then If eb\curchar > 0 Then eb\lines[eb\curl] = (Mid(eb\lines[eb\curl],1,eb\curchar-1)+Mid(eb\lines[eb\curl],eb\curchar+1,Len(eb\lines[eb\curl])-eb\curchar+1)) eb\curchar=eb\curchar-1 If eb\curchar = 0 And eb\curl > 0 Then eb\curl=eb\curl-1:eb\curchar = Len(eb\lines[eb\curl]) eb\backmilli = MilliSecs()+100 EndIf EndIf End If ;curchar If (KeyHit(203) Or KeyHit(205)) Then eb\curchar = eb\curchar+(KeyDown(205)-KeyDown(203)):eb\curmilli = MilliSecs()+500 If eb\curmilli < MilliSecs() Then eb\curchar = eb\curchar+(KeyDown(205)-KeyDown(203)) eb\curmilli = MilliSecs()+100 End If If eb\curchar > Len(eb\lines[eb\curl]) Then eb\curchar = Len(eb\lines[eb\curl]) If eb\curchar < 0 Then eb\curchar = 0 ;cursor If eb\milli < MilliSecs() Then eb\cursoron = 1-eb\cursoron eb\milli = MilliSecs()+300 End If If eb\cursoron And eb\active Then Rect eb\x+(StringWidth(Mid(eb\lines[eb\curl],1,eb\curchar))+4),eb\y+(eb\curl*StringHeight("H")+3),2,12 ;line If (StringWidth(eb\lines[eb\curl]) > eb\w Or KeyHit(28)) And eb\y+eb\curl*StringHeight("H")+3 < eb\h Then eb\curl = eb\curl+1:eb\curchar = 1 Color 255,255,255 Next End Function Button.bb: Code: [AUSKLAPPEN] Type Button
Field x#,y#,w#,h# Field pushed End Type Function CreateButton.Button(x#,y#,w#,h#) Local b.Button = New Button b\x = x b\y = y b\w = w b\h = h Return b End Function Function UpdateButtons() Local b.Button Local mh = MouseHit(1) For b.Button = Each Button ;zeichnen Rect b\x,b\y,b\w,b\h ;update If RectsOverlap(MouseX(),MouseY(),10,10,b\x,b\y,b\w,b\h) And mh Then b\pushed = 1 Else b\pushed = 0 End If Next End Function Die Anwendung sollte eigentlich selbsterklärend sein. P.S.: Ich hoffe Doppelpost ist hier nicht so schlimm :S |
||
| Hier sollte eigentlich eine Signatur stehen! | ||
Rufus Serano |
Do, Sep 03, 2009 21:24 Antworten mit Zitat
|
|
|---|---|---|
|
Na dann, werd ich hier mal ein altes Projekt von mir begraben:
RiP Fraktal Extreme BB/B3D (BP ungetestet) BlitzBasic: [AUSKLAPPEN] Const Complex_Real=0 Das ganze ist leider unkommentiert 
Dafür wird das Fraktal sehr schnell dargestellt und wird, je höher die Iteration wird, schneller!! Mit Linksklick kann man auch reinzoomen. Rauszoomen geht leider nicht. Wenn man sich mal mit Linksklick verklickt hat, kann man auch einfach mit Rechtsklick abbrechen. Na dann, ruhe sanft, FE, auf dass jemand in dir Begeisterung findet... |
||
|
orpheus_2003 |
Sa, Sep 05, 2009 12:23 Antworten mit Zitat
|
|---|---|---|
|
Rufus Serano hat Folgendes geschrieben: Na dann, werd ich hier mal ein altes Projekt von mir begraben:
Das ganze ist leider unkommentiert
Dafür wird das Fraktal sehr schnell dargestellt und wird, je höher die Iteration wird, schneller!! Mit Linksklick kann man auch reinzoomen. Rauszoomen geht leider nicht. Wenn man sich mal mit Linksklick verklickt hat, kann man auch einfach mit Rechtsklick abbrechen. Na dann, ruhe sanft, FE, auf dass jemand in dir Begeisterung findet... Sehr geil. Danke |
||
|
GazerStar - the beginning
http://gazerstar.lexigame.de/ Wizard (Worktitel) http://wizard.lexigame.de |
||
|
Eingeproggt |
Di, Apr 13, 2010 19:05 Antworten mit Zitat
|
|---|---|---|
|
Hier ist es ja extrem still geworden... Dabei glaub ich dass in den letzten 7 Monaten ja doch das eine oder andere Projekt gestorben ist...
Ich hatte den Thread selbst schon wieder vergessen gehabt aber durch eine andere Diskussion hier fiel er mir wieder ein - und ich hab gleich was zu beerdigen. Kann gut sein dass der eine oder andere weiß dass ich vor allem in 2D arbeite. Wollte mal n 3D-Projekt anfangen und damits schön klein und überschaubar wird hab ich etwas für den noch laufenden BCC36 geplant gehabt. Eine stark vereinfachte 3D-Umsetzung von SimCity, genannt "BlitzCity". Steuerung: Bewegen: WASD ausgewähltes Tile (Gebäude) setzen: linke Maustaste Auswahl ändern (blättern): Mausrad Features: -) Extrem wenig Möglichkeiten -) Extrem geringer Spelspass -) Totlangweiliges Terrain -) Bug beim Straßenbau -) Man braucht "Kraftwerk", "Wasserturm" und "Straße" deren Einflussbereiche sich überlappen - Polizei und Feuerwehr haben keine Funktion -) eigenes, an das *.x Format angelehnte 3D Format welches daraus entstand dass ich schlicht und ergreifend mit keinem Modeller bisher mehr als ein Standard-Objekt zustande gebracht habe - daher code ich lieber meine Modelle mit AddVertex und AddTriangle ^^ Credits -) Code komplett von mir -) Baum-Modell + Texturen von irgendeinem Baum Generator den ich selber schon wieder vergessen hab (das Modell hatte ich vor mehreren Jahren mal generiert und verwendete ich bis jetzt in jedem meiner 3D-Gehversuche -.- ) -) Wasser und Gras Textur: Irgendwo ausn Internet... Eigentlich waren diese Texturen nicht als final gedacht aber um ein Projekt auf dem Codefriedhof zu "veröffentlichen" tu ich mir da jetzt auch nix mehr an... Download Viel Spass damit falls es wen interessieren sollte. Screen wollte ich mit posten aber da mein Speicherplatz im Archiv schön langsam knapp wird spar ich ihn ein 
mfG, Christoph. |
||
| Gewinner des BCC 18, 33 und 65 sowie MiniBCC 9 | ||
|
count-doku |
Fr, Jun 04, 2010 16:16 Antworten mit Zitat
|
|---|---|---|
|
Hallo Geister alter Projekte...
Thunder und ich legen jetzt hier unser Projekt 3D-ParticleEngine ab, weil die SingleSurface Sache nicht so ganz hinhaut. Vllt. nehm ich es später nochmal wieder auf aber erstmal wollten wir es ruhen lassen. Momentan ist die Lib schon voll lauffähig, kommt es aber durch falsche SingleSurface verwendung zu Geschwindigkeitseinbußen. Die Library: BlitzBasic: [AUSKLAPPEN] ;========================================================= Der Header für das Testprogramm: BlitzBasic: [AUSKLAPPEN] ;DEBUGGING : IST THUNDER DER TESTER? Das Testprogramm: BlitzBasic: [AUSKLAPPEN] ;==================================================================== lg und ruhe in frieden, count-doku |
||
|
|
Kernle 32DLL |
Mo, Jun 28, 2010 23:06 Antworten mit Zitat
|
|---|---|---|
|
Ich gebe hiermit den Großteil meiner ehemaligen Projekte von mir frei. Ich werde die Projekte vermutlich nie fertig stellen, und vielleicht ist für den ein oder anderen noch irgendwo ein guter Code Happs zu holen. Und wenn nicht - zumindest einen guten Lacher.
Folgendes ist zu beachten: Es sind Codes für BlitzBasic, Blitz3D, BlitzPlus und BlitzMax enthalten. Erstere 3 sind zusammen geworfen, BlitzMax Projekte sind getrennt vom Rest.
Teilweise sind Sachen kompiliert, teilweise nicht. Teilweise gibt es auch exe Dateien ohne dazugehörigen Sourcecode (sehr selten). Das trifft nur auf die BB Projekte zu. BMax Projekte sind alle Vollständig
Ich habe sämtlichen Copyright Kram entfernt, das heißt Konkret das einige BB Sourcecodes nicht funktionieren, da ich die SpriteCandy Engine entfernen musste. Wenn ihr sie habt, fügt sich an entsprechender Stelle ein, und der Code läuft wieder.
Ich habe bewusst darauf verzichtet mein Langzeit Projekt Cube-Wars hinzuzufügen, da die alten Codes zu müllig sind um etwas sinnvolle daraus zu holen, und die neueren Codes Sachen enthalten die ich in dem unfertigen Zustand nicht rausgeben will, oder bereits herausgegeben habe.
Den Download des gesamten Paketes findet ihr HIER Ich leiste keinerlei Support für die Sourcecodes. Sollte das Paket trotz meiner intensiven Suche Copyright Geschützes Material enthalten, so bitte ich darum mich umgehen darüber zu informieren, damit ich diesen Inhalt entfernen kann. So long, Kernle |
||
|
Mein PC: "Bluelight" - Xtreme Gamer PC [Video]
Meine Projekte: Cube-Wars 2010 [Worklog] Anerkennungen: 1. Platz BCC #7 , 1. Platz BCC #22 , 3. Platz BAC #89 Ich war dabei: NRW Treff III, IV ; Frankfurter BB Treffen 2009 |
||
Übersicht
Sonstiges Projekte
Powered by phpBB © 2001 - 2006, phpBB Group