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