Code archives/Miscellaneous/Apple IIe Text Console
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| This is a coordinate-addressable text console for roguelikes and whatever other console display needs you might have. This is fast enough for just about any purpose but could be vastly sped up by getting rid of the cls statement, only plotting characters that changed in a given tick, and clearing each one by writing a black rectangle over it first. Further huge speedup could be had by using a pixmap draw like Derron's drawimagetoimage or something similar, which will cut down the number of screen draws to one (but not necessary if you are plotting only changes.) | |||||
' Quick and Dirty Text Display Console. For roguelikes or whatever else you might
' want.
Graphics 1280,960
Global text:String[10000] ' This is the text string. It's not a 2D array to make it
' easier to display actual readable strings but is addressable
' by x and y with function plotchar.
Global textimage:TImage = New TImage
' The Apple IIe font as an image.
' Grab it here:
' https://www.dropbox.com/s/s4flyf1345qjbb8/applefont-wide.png?dl=0
textimage = LoadImage("applefont-wide.png")
Cls
' This is the order of characters as they appear in the font. When drawing
' we use a text search to find where in the string the character is,
' then translate that into x and y coordinates so that we can clip
' the correct subimagerect out of the font bitmap for pasting.
Global fontstring$ = " !~q#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz(|}~~"
'stringtotext("Test",1)
Global curkey$
Global cursorx=0
Global cursory=0
Function drawapplefontchar(a$,x:Int,y:Int)
Local fontimagex:Int
Local fontimagey:Int
Local infontstring=fontstring.find(a$)
If infontstring > -1
fontimagex = infontstring Mod 16
fontimagey = infontstring / 16
EndIf
drawimagesubrect(textimage,x,y,fontimagex*16,64+fontimagey*32,16,32)
End Function
While Not KeyDown(KEY_ESCAPE)
curkey = GetChar()
If curkey>0
cursorx = cursorx + 1
text[cursorx]=Chr(Int(curkey))
EndIf
Cls
curchar=0
For j = 0 To 30
For i = 0 To 80
curchar=curchar+1
dist=distance(i*16,j*32,MouseX(),MouseY())
SetColor(255-dist,255-dist/2,255)
drawapplefontchar text[curchar],i*16,j*32
Next
Next
For i = 0 To 10
plotchar(Chr(33+Rand(48)) ,Rand(80)-1,Rand(40)-1)
Next
Flip
Wend
Function stringtotext(a$,num:Int)
For Local i:Int = 0 To Len(a$)-1
text[num+i]=Chr(a$[i])
Next
End Function
Function plotchar(a$,x:Int,y:Int)
text[y*80+x] = a
End Function
Function Distance#(x0#,y0#,x1#,y1#)
Local dx# = x0-x1
Local dy# = y0-y1
Return Sqr(dx*dx + dy*dy)
End Function
Function DrawImageSubRect(Image:TImage, DrawX#, DrawY#, PartX#, PartY#, PartWidth#, PartHeight#, Frame# = 0)
' Not my code, someone else here did this a long time ago. Draws a sub-rectangle of a given
' image to the screen.
Local OldX:Int
Local OldY:Int
Local OldWidth:Int
Local OldHeight:Int
Local ViewportX:Int = DrawX
Local ViewportY:Int = DrawY
' Save current viewport settings
GetViewport(OldX, OldY, OldWidth, OldHeight)
' Calculate viewport coordinates based on image's handle
If Image.Handle_X Then
Local PercentX:Float
PercentX = Float(Image.Handle_X) / Float(Image.Width)
ViewportX = DrawX - (PercentX * PartWidth)
EndIf
If Image.Handle_Y Then
Local PercentY:Float
PercentY = Float(Image.Handle_Y) / Float(Image.Height)
ViewportY = DrawY - (PercentY * PartHeight)
EndIf
SetViewport(ViewportX, ViewportY, PartWidth, PartHeight)
DrawImage(Image, DrawX-PartX, DrawY-PartY, Frame)
' Restore old viewport settings
SetViewport(OldX, OldY, OldWidth, OldHeight)
End Function |
Comments
| ||
| Brilliant post :) Here's a slight different version that gives dynamic displays of different resolutions. It also allows for foreground and background colours!
' Quick and Dirty Text Display Console. For roguelikes or whatever else you might want.
superstrict
'size of the window
Global ScreenWidth:Int = 1280
Global ScreenHeight:Int = 960
Global TextX:Int = 40
Global TextY:Int = 25
Graphics ScreenWidth, ScreenHeight
Global vdu:TVdu = New TVdu
vdu.init(ScreenWidth, ScreenHeight, TextX, TextY)
vdu.fontInit("applefont.png")
While Not KeyDown(KEY_ESCAPE)
vdu.DrawScreen()
Local k:Int
vdu.SetFcol(Rand(0,255), Rand(0,255), Rand(0,255))
vdu.SetBcol(Rand(0,255), Rand(0,255), Rand(0,255))
For k = 0 To 10
vdu.plotchar(Chr(Rand(33,127)) ,Rand(0, TextX-1), Rand(0, TextY-1))
Next
Flip
Wend
End
Type TVdu
'size of the display (usually 800x40)
Field TextXRes:Int
Field TextYRes:Int
Field TextXRes1:Int
Field TextYRes1:Int
Field TextMaxRes:Int
Field TextWidth:Float
Field TextHeight:Float
'where we put the chars
Field text:Int[]
'where we put the colours
Field fcol:Int[]
Field bcol:Int[]
field gFcol:Int
field gBcol:Int
'Load the font
field textimage:TImage = New TImage
Method Init(width:Int, height:Int, textx:Int, texty:int)
TextXRes = textx
TextYRes = texty
TextXRes1 = TextXRes-1
TextYRes1 = TextYRes-1
TextMaxRes = TextXRes * TextYRes
TextWidth = Float(Width) / Float(TextXRes)
TextHeight = Float(Height) / Float(TextYRes)
'redim the array to the new size
text = text[..TextMaxRes+1]
fCol = fCol[..TextMaxRes+1]
bCol = bCol[..TextMaxRes+1]
End Method
Method FontInit(FontName:String)
textimage = LoadImage(FontName)
End Method
method drawapplefontchar(char:Int, x:Int, y:Int)
Local fontimagex:Int
Local fontimagey:Int
If char > -1
fontimagex = char Mod 16
fontimagey = char Shr 4
EndIf
DrawSubImageRect textimage, x*TextWidth,y*TextHeight,TextWidth,TextHeight, fontimagex*16,64+fontimagey*32,16,32
End method
method DrawScreen()
Local curchar:Int = 0
Local x:Int
Local y:Int
Local fontimagex:Int
Local fontimagey:Int
Local xx:Float
Local yy:Float
For y = 0 To TextYRes1
For x = 0 To TextXRes1
If text[curchar] > -1
fontimagex = text[curchar] Mod 16
fontimagey = text[curchar] Shr 4
xx = x * TextWidth
yy = y * TextHeight
SetColor (Bcol[curchar] Shr 16) & 255, (Bcol[curchar] Shr 8) & 255, Bcol[curchar] & 255
DrawRect xx,yy,TextWidth,TextHeight
SetColor (Fcol[curchar] Shr 16) & 255, (Fcol[curchar] Shr 8) & 255, Fcol[curchar] & 255
DrawSubImageRect textimage, xx,yy,TextWidth,TextHeight, fontimagex*16,64+fontimagey*32,16,32
EndIf
curchar = curchar + 1
Next
Next
End method
method plotchar(a$, x:Int, y:Int)
Local pos:Int = (y * TextXRes) + x
If pos < 0 Then
pos = 0
Else If pos > TextMaxRes Then
pos = TextMaxRes
End If
text[pos] = Asc(a)
fcol[pos] = gFcol
bcol[pos] = gBcol
End method
method SetFCol(red:Int, green:Int, blue:Int)
gFCol = ((red & 255) Shl 16) | ((green & 255) Shl 8) | (blue & 255)
End method
method SetBCol(red:Int, green:Int, blue:Int)
gBCol = ((red & 255) Shl 16) | ((green & 255) Shl 8) | (blue & 255)
End method
End Type
|
Code Archives Forum
   |