Dos-Display

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

 

Kekskiller

Betreff: Dos-Display

BeitragSa, Feb 26, 2005 20:24
Antworten mit Zitat
Benutzer-Profile anzeigen
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...

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group