Dos-Display
Übersicht

KekskillerBetreff: Dos-Display |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Mir war langweilig und habe ein mich ein wenig mit der Idee einer Art
Blitzkonsole beschäftig und das ist rausgekommen: Code: [AUSKLAPPEN] Const SCREENWIDTH = 640
Const SCREENHEIGHT = 480 Const COLFG_R = 255 Const COLFG_G = 255 Const COLFG_B = 255 Const COLBG_R = 0 Const COLBG_G = 0 Const COLBG_B = 0 Graphics(SCREENWIDTH, SCREENHEIGHT, 16) ClsColor 0, 0, 0 Global display = CreateBank(0) ;Displaydaten Global cwidth = FontWidth() ;Zeichenbreite Global cheight = FontHeight() ;Zeichenhöhe Global dwidth = SCREENWIDTH / cwidth ;Displaybreite Global dheight = SCREENHEIGHT / cheight ;Displayhöhe ResizeBank(display, dwidth * dheight * 4) ;Auf richtige Größe bringen Global mcbxpos = 0 ;x-Position des Mauscursors Global mcbypos = 0 ;y-Position des Mauscursors Global mcbrate = 85 ;Blinkrate des Mauscursors Global mcbtimer = 0 ;Blinktimer des Mauscursors Global mcbpos = 0 ;Blinkstatus des Mauscursors Global tcbxpos = 10 ;x-Position des Textcursors Global tcbypos = 20 ;y-Position des Textcursors Global tcbrate = 85 ;Blinkrate des Textcursors Global tcbtimer = 0 ;Blinktimer des Textcursors Global tcbpos = 0 ;Blinkstatus des Textcursors Function PlaceChar(x, y, char, r, g, b) pos = MathUnitPos(x,y) SetUnit(pos, char, r, g, b) End Function Function DrawDisplay(x, y) For zy = 0 To dheight - 1 For zx = 0 To dwidth - 1 char = GetUnitChar(zx, zy) ;Zeichen rausholen dx = x + zx * cwidth ;X errechnen dy = y + zy * cheight ;Y errechnen If dx => 0 If dx <= SCREENWIDTH If dy => 0 If dy <= SCREENHEIGHT ;falls in richtiger Position ;Mauscursor If zx = mcbxpos And zy = mcbypos And mcbpos = 1 red = GetUnitRed(zx, zy) green = GetUnitGreen(zx, zy) blue = GetUnitBlue(zx, zy) Color red, green, blue Rect dx, dy, cwidth, cheight ;falls keine Nullen oder Leerzeichen drinne If char <> 0 And char <> 32 ;hervorgehobener Text Color COLBG_R, COLBG_G, COLBG_B Text(dx, dy, Chr(char)) EndIf Else ;normaler Text If char <> 0 And char <> 32 red = GetUnitRed(zx, zy) green = GetUnitGreen(zx, zy) blue = GetUnitBlue(zx, zy) Color red, green, blue Text(dx, dy, Chr(char)) EndIf EndIf ;Textcursor zeichnen If zx = tcbxpos And zy = tcbypos And tcbpos = 1 red = GetUnitRed(zx, zy) green = GetUnitGreen(zx, zy) blue = GetUnitBlue(zx, zy) Color red, green, blue Text(dx, dy, "_") EndIf EndIf EndIf EndIf EndIf Next Next End Function Function PlaceString(x, y, pstring$, r, g, b) pslen = Len(pstring$) ;Länge der Zeichenkette If pslen > 0 For z = 1 To pslen char = Asc(Mid(pstring$, z, 1)) ;Zeichen rausholen PlaceChar(x, y, char, r, g, b) ;Zeichen schreiben x = x + 1 Next EndIf End Function Function ClearDisplay() For zy = 0 To dheight - 1 For zx = 0 To dwidth - 1 PlaceChar(zx, zy, 32, COLFG_R, COLFG_B, COLFG_B) ;Speicher an dieser Stelle mit Leerzeichen füllen Next Next End Function Function UpdateTextCursor() ;Blinken tcbtimer = tcbtimer + 1 If tcbtimer >= 100 - tcbrate tcbpos = 1 - tcbpos tcbtimer = 0 EndIf End Function Function UpdateMouseCursor() ;Blinken mcbtimer = mcbtimer + 1 If mcbtimer >= 100 - mcbrate mcbpos = 1 - mcbpos mcbtimer = 0 EndIf ;Cursorabfrage mx = ( MouseX() / cwidth ) my = ( MouseY() / cheight ) If mx <> mcbxpos Or my <> mcbypos mcbxpos = mx mcbypos = my mcbpos = 1 mcbtimer = 0 EndIf If mcbxpos > dwidth - 1 mcbxpos = dwidth - 1 EndIf If mcbypos > dheight - 1 mcbypos = dheight - 1 EndIf If MouseHit(1) LocateTextCursor(mcbxpos, mcbypos) EndIf End Function Function LocateMouseCursor(x, y) If x >= 0 And x < dwidth If y >= 0 And y < dheight mcbxpos = x mcbypos = y MoveMouse(mcbxpos * cwidth, mcbypos * cheight) EndIf EndIf End Function Function LocateTextCursor(x, y) If x >= 0 And x < dwidth If y >= 0 And y < dheight tcbxpos = x tcbypos = y EndIf EndIf End Function Function MathUnitPos(x, y) bankpos = ( y * dwidth + x ) * 4 Return bankpos End Function Function GetUnitChar(x, y) pos = MathUnitPos(x, y) char = PeekByte(display, pos) Return char End Function Function GetUnitRed(x, y) pos = MathUnitPos(x, y) red = PeekByte(display, pos + 1) Return red End Function Function GetUnitGreen(x, y) pos = MathUnitPos(x, y) green = PeekByte(display, pos + 2) Return green End Function Function GetUnitBlue(x, y) pos = MathUnitPos(x, y) blue = PeekByte(display, pos + 3) Return blue End Function Function SetUnit(pos, char, red, green, blue) If char <> - 1 PokeByte(display, pos , char ) If red <> - 1 PokeByte(display, pos + 1, red ) If green <> - 1 PokeByte(display, pos + 2, green) If blue <> - 1 PokeByte(display, pos + 3, blue ) End Function Function FillDisplayRect(x, y, width, height, char, r, g, b) For zy = y To height For zx = x To width PlaceChar(zx, zy, char, r, g, b) Next Next End Function ClearDisplay() PlaceString(3, 2, "Ich Bin so deprimiert.", 200, 200, 200) PlaceString(3, 3, "FPS: " , 200, 255, 200) ;FillDisplayRect(2, 12, 3, 3, Asc("x"), 255, 255, 100) LocateMouseCursor(5,5) LocateTextCursor(10,3) Global oldZeit, bwx, BW ;FPS-Berechnungen sind von Rallimen, alles nur geklaut Repeat UpdateMouseCursor() UpdateTextCursor() PlaceString(3 + Len("FPS: "), 3, BW + " ", 200, 255, 255) Cls DrawDisplay(0, 0) Flip bwx=bwx+1:If MilliSecs()>oldZeit+999 Then BW=bwx:bwx=0:oldZeit=MilliSecs() Delay(1) Until KeyHit(1) Da kann man dann ganz leicht irgendwas plazieren und Spielerchen mit machen. Das ist doch mal was sinnvolles... |
||
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group