irgendwie hat es mich gerissen, und ich hab mich hingesetzt und ne komplette Demo geproggt...
damit ihr auch was davon habt, poste ichs auch noch mal hier.
...wär vielleicht auch was für's CodeArchiv....
EDIT:
Code ergänzt um eine Auslesefunktion, den Screen resizable gemacht.
Code: Alles auswählen
;***************************************
;***
;*** Textmode Emulation Demo
;***
;*** by Kaeru Gaman, 2007-09-02
;***
;*** PB Ver 4.02
;***
;*** Code-Archive ready
;***
;***************************************
EnableExplicit ; the obligative
;******************************************************************************
;*** Constants
#TxtScrn_ChrWi = 8
#TxtScrn_ChrHi = 16
#TxtScrn_MatWi = 80
#TxtScrn_MatHi = 30
; Screensize is Matrixsize * Charsize, here 640x480
#TxtScrn_ScrWi = #TxtScrn_MatWi * #TxtScrn_ChrWi
#TxtScrn_ScrHi = #TxtScrn_MatHi * #TxtScrn_ChrHi
#TxtScrn_CrsrSpd = 250 ; duration of Cursor-Phase
#PB_Event_TimeOut = 0 ; WaitWindowEvent Timeout
;******************************************************************************
;*** Variables
Define.l CrsrX, CrsrY
Define.l EvID, EXIT = 0
Define.l GlobalTimer, DemoCommand, DemoMode = 1
Define.l ComX, ComY, ComT, ComL
Define.s CommandString, ComS
Global Dim TextScreen.c(#TxtScrn_MatWi-1,#TxtScrn_MatHi-1)
;******************************************************************************
;*** Inits
If Not InitSprite()
MessageRequester("Error","No DX")
EndIf
If Not OpenWindow(0,#PB_Ignore,#PB_Ignore,#TxtScrn_ScrWi,#TxtScrn_ScrHi,"Textmode Demo", #PB_Window_SystemMenu | #PB_Window_SizeGadget)
MessageRequester("Error","No Window")
EndIf
If Not OpenWindowedScreen(WindowID(0),0,0,#TxtScrn_ScrWi,#TxtScrn_ScrHi,1,0,0)
MessageRequester("Error","No Screen")
EndIf
;******************************************************************************
;*** Procedures
;******************************************************************************
;***************************************
;***
;*** Create_Charset()
;***
;***************************************
;*** Arguments : None
;*** Return Value : None
;***************************************
;***
;*** For the demo, I create a Charset on-the-fly out of Courier New.
;*** for serious use, you should create a Sprite-Charset manually
;*** sure you can keep this Proc for testing purposes
;***
;***************************************
Procedure Create_Charset()
;*** Creating the Charset
Protected n.l
LoadFont(0,"Courier New",10) ; chars are 8x16pix
; change the Font if you change the sizes
For n=32 To 255 ; ASCII-codes 32 - 255 used
CreateSprite(n,#TxtScrn_ChrWi,#TxtScrn_ChrHi)
StartDrawing(SpriteOutput(n))
DrawingFont(FontID(0))
DrawText(0,0,Chr(n),$00FF00,$000000) ; green on black
StopDrawing()
Next
;*** Creating the Cursor
CreateSprite(256,#TxtScrn_ChrWi,#TxtScrn_ChrHi)
StartDrawing(SpriteOutput(256))
Line(0,#TxtScrn_ChrHi-3,#TxtScrn_ChrWi,0,$00FF00) ; two filled lines
Line(0,#TxtScrn_ChrHi-2,#TxtScrn_ChrWi,0,$00FF00) ; one line above the last line
StopDrawing()
EndProcedure
;***************************************
;***
;*** TxtScrn_Clear( [RePos] )
;***
;***************************************
;*** Arguments : (optional) #False to keep Cursor position
;*** Return Value : None
;***************************************
;***
;*** Textmatrix Function
;***
;*** Clears the internal Textmatrix
;***
;***************************************
Procedure TxtScrn_Clear(RePos = 1)
Shared CrsrX.l, CrsrY.l
Protected n.l, t.l
For t=0 To #TxtScrn_MatHi-1
For n=0 To #TxtScrn_MatWi-1
TextScreen(n,t) = 32
Next
Next
If RePos
CrsrX = 0
CrsrY = 0
EndIf
EndProcedure
;***************************************
;***
;*** TxtScrn_Display()
;***
;***************************************
;*** Arguments : None
;*** Return Value : None
;***************************************
;***
;*** Textmatrix-to-Display Function
;***
;*** displays the internal Textmatrix
;*** to the current Output channel
;***
;***************************************
Procedure TxtScrn_Display()
Protected n.l, t.l
For t=0 To #TxtScrn_MatHi-1
For n=0 To #TxtScrn_MatWi-1
DisplaySprite(TextScreen(n,t),#TxtScrn_ChrWi*n,#TxtScrn_ChrHi*t)
Next
Next
EndProcedure
;***************************************
;***
;*** TxtScrn_Scroll()
;***
;***************************************
;*** Arguments : None
;*** Return Value : None
;***************************************
;***
;*** Textmatrix Function
;***
;*** scrolls the internal Textmatrix one line up.
;***
;***************************************
Procedure TxtScrn_Scroll() ; scroll the textscreen up
Protected n.l, t.l
For t=0 To #TxtScrn_MatHi-2 ; one line less
For n=0 To #TxtScrn_MatWi-1
TextScreen(n,t) = TextScreen(n,t+1) ; replace chars by the line below
Next
Next
For n=0 To #TxtScrn_MatWi-1
TextScreen(n,#TxtScrn_MatHi-1) = 32 ; clear the last line
Next
EndProcedure
;***************************************
;***
;*** TxtScrn_ShowCursor()
;***
;***************************************
;*** Arguments : None
;*** Return Value : None
;***************************************
;***
;*** Textmatrix-to-Display Function
;***
;*** shows the cursor of the internal
;*** Textmatrix on the screen,
;*** blinking in the defined rate.
;***
;***************************************
Procedure TxtScrn_ShowCursor()
Static CrsrTimer.l
Static CrsrMode.l
Shared CrsrX.l, CrsrY.l
If CrsrTimer = 0 ; first call
CrsrTimer = ElapsedMilliseconds()
EndIf
If ElapsedMilliseconds() > CrsrTimer
CrsrTimer + #TxtScrn_CrsrSpd
CrsrMode = 1 - CrsrMode
EndIf
If CrsrMode
DisplaySprite(256, #TxtScrn_ChrWi*CrsrX, #TxtScrn_ChrHi*CrsrY)
EndIf
EndProcedure
;***************************************
;***
;*** TxtScrn_Locate(X.l, Y.l)
;***
;***************************************
;*** Arguments : new Cursor Coordinates
;*** Return Value : #False if outside the Matrix
;***************************************
;***
;*** Textmatrix Function
;***
;*** moves the cursor of the internal
;*** Textmatrix to the specified position.
;*** if the position is outside the matrix,
;*** the cursor will not move.
;*** this can be used to create floating text,
;*** when a function always does positioning,
;*** like in this demo.
;***
;***************************************
Procedure.l TxtScrn_Locate(X.l, Y.l)
Shared CrsrX.l, CrsrY.l
If X >= 0 And X < #TxtScrn_MatWi And Y >= 0 And Y < #TxtScrn_MatHi
CrsrX = X
CrsrY = Y
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
;***************************************
;***
;*** TxtScrn_Print(OutString.s)
;***
;***************************************
;*** Arguments : String to write
;*** Return Value : #False if the Textmatrix had to be scrolled up
;***************************************
;***
;*** Textmatrix Function
;***
;*** writes the given String into
;*** the internal Textmatrix.
;***
;***************************************
Procedure.l TxtScrn_Print(OutString.s)
Shared CrsrX.l, CrsrY.l
Protected OutString_Pos.l = 1, OutString_Char.c, UnScrolled = #True
Repeat
OutString_Char = Asc(Mid(OutString, OutString_Pos, 1))
Select OutString_Char
;***************************************
Case 32 To 255 ; printable char?
TextScreen(CrsrX, CrsrY) = OutString_Char
CrsrX +1 ; next row
If CrsrX > #TxtScrn_MatWi-1 ; right out
CrsrX = 0 ; reset to leftmost row
CrsrY +1 ; next line
If CrsrY > #TxtScrn_MatHi-1 ; bottom out
CrsrY -1 ; reset to bottom row
TxtScrn_Scroll() ; scroll the textscreen
UnScrolled = #False
EndIf
EndIf
;***************************************
Case 10, 13 ; newline
; note that both are used as newline,
; so a windows-style #CRLF$ will add TWO newlines
CrsrX = 0 ; reset to leftmost row
CrsrY +1 ; next line
If CrsrY > #TxtScrn_MatHi-1 ; bottom out
CrsrY -1 ; reset to bottom row
TxtScrn_Scroll() ; scroll the textscreen
UnScrolled = #False
EndIf
;***************************************
; add more Cases if you want
; e.g. BEEP or any ESCAPE-sequence
EndSelect
OutString_Pos +1
Until OutString_Char = #NUL
EndProcedure
;***************************************
;***
;*** TxtScrn_Read(X.l, Y.l, Lng.l)
;***
;***************************************
;*** Arguments : Starting Coordinates and length of string to read
;*** Return Value : String read from the Textmatrix
;***************************************
;***
;*** Textmatrix Function
;***
;*** reads a String of the requested length
;*** from the internal Textmatrix.
;***
;***************************************
Procedure.s TxtScrn_Read(X.l, Y.l, Lng.l)
Protected ReturnString.s, GetString_Char.c
If X >= 0 And X < #TxtScrn_MatWi And Y >= 0 And Y < #TxtScrn_MatHi And Lng > 0
Repeat
GetString_Char = TextScreen(X, Y) ; get the char from the matrix
ReturnString + Chr(GetString_Char) ; add it to the String
X +1 ; next row
If X > #TxtScrn_MatWi-1 ; right out
X = 0 ; reset to leftmost row
Y +1 ; next line
If Y > #TxtScrn_MatHi-1 ; bottom out
Lng = 0 ; stop reading and leave proc
EndIf
EndIf
Lng -1
Until Lng = 0
Else
ReturnString = Chr(4) ; Return EOT if trying to read outside the matrix.
EndIf
ProcedureReturn ReturnString
EndProcedure
;******************************************************************************
;*** last preparations
Create_Charset()
TxtScrn_Clear()
;******************************************************************************
;*** Main Loop start
Repeat
EvID = WaitWindowEvent(20) ; FPS ~50
Select EvID
Case #PB_Event_TimeOut ; no Event? ...carry on with the action
;***************************************
; the following is only for the demo
; to show the Procs work as they should
;***************************************
;*** Demo Action start
If DemoMode ; active until end of demo reached
If GlobalTimer = 0 ; no timer, read next Command
Read CommandString ; get DemoCommand
DemoCommand = Asc(Left(CommandString,1)) ; leftmost token is the command
Select DemoCommand
Case 'T' ; Timer Command
ComT = Val(Mid(CommandString,3,4)) ; 4 letters timevalue
GlobalTimer = ElapsedMilliseconds() + ComT
Case 'P' ; Print Command
ComX = Val(Mid(CommandString,3,2)) ; 2 letters X-Pos
ComY = Val(Mid(CommandString,6,2)) ; 2 letters Y-Pos
ComS = Mid(CommandString,9,Len(CommandString)) ; rest is out$
TxtScrn_Locate(ComX,ComY) ; Locate Cursor
TxtScrn_Print(ComS) ; write text into array
Case 'R' ; Carriage Return Command
ComS = #CR$
TxtScrn_Print(ComS) ; write text into array
Case 'C' ; Clear TextScreen Command
TxtScrn_Clear()
Case 'D' ; Debug Command
ComX = Val(Mid(CommandString,3,2)) ; 2 letters X-Pos
ComY = Val(Mid(CommandString,6,2)) ; 2 letters Y-Pos
ComL = Val(Mid(CommandString,9,2)) ; 2 letters length
ComS = TxtScrn_Read(ComX, ComY, ComL)
Debug ComS
Case 'X' ; 'Special' Command
ComS = "and now" + #LF$
ComS + "we test" + #CR$
ComS + "the newline" + #CRLF$
ComS + "note that #CRLF$ adds two lines..."
TxtScrn_Print(ComS) ; write text into array
Case 'E' ; End Demo Command
DemoMode = 0
EndSelect
ElseIf ElapsedMilliseconds() > GlobalTimer ; timer reached
GlobalTimer = 0 ; reset
EndIf
EndIf
;*** Demo Action end
;***************************************
Case #PB_Event_CloseWindow
EXIT = 1
EndSelect
;***************************************
;*** Screen Action start
ClearScreen($000000) ; not really necessary, because we cover the screen with sprites...
TxtScrn_Display() ; display the textmatrix array on the screen
TxtScrn_ShowCursor() ; show our cursor
FlipBuffers()
;*** Screen Action end
;***************************************
Until EXIT
;*** Main Loop end
;******************************************************************************
End
;********************************************
; the whole Datasection is only for the Demo
;********************************************
DataSection
ComTable:
Data.s "P 13,15,this is a test"
Data.s "T 1500"
Data.s "P 17,09,this is another test"
Data.s "T 1500"
Data.s "P 00,16,the quick brown fox jumps over the lazy dog"
Data.s "T 1000"
Data.s "P 36,07,the quick brown fox jumps over the lazy dog"
Data.s "T 1000"
Data.s "P 18,12,the quick brown fox jumps over the lazy dog"
Data.s "T 1000"
Data.s "P 58,17,the quick brown fox jumps over the lazy dog"
Data.s "T 2000"
Data.s "P 15,10,worx nice... ain't it? ;)"
Data.s "T 5000"
Data.s "C"
Data.s "P 27,13,special test for CR..."
Data.s "T 2000"
Data.s "X"
Data.s "T 5000"
Data.s "C"
Data.s "P 23,13,special test for floating text..."
Data.s "T 2000"
Data.s "P 10,27,start here ->"
Data.s "T 1000", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "P -1,-1,this " , "T 0200", "P -1,-1,is " , "T 0200", "P -1,-1,the " , "T 0200", "P -1,-1,poem "
Data.s "T 0200", "P -1,-1,to " , "T 0200", "P -1,-1,kill " , "T 0200", "P -1,-1,your " , "T 0200", "P -1,-1,nerves "
Data.s "T 0200", "P -1,-1,because " , "T 0200", "P -1,-1,it " , "T 0200", "P -1,-1,never " , "T 0200", "P -1,-1,ends! "
Data.s "T 0200", "R"
Data.s "T 0200", "R"
Data.s "T 0200", "R"
Data.s "T 0200", "P -1,-1,mission accomplished."
Data.s "T 1500", "P 10,04,and now we test the reading."
Data.s "D 05,23,17"
Data.s "T 1500", "P 10,05,and we overwrite the part we read to see if it worked correctly."
Data.s "P 05,23,#################"
Data.s "E"
EndDataSection