The job of this is to make it so one can use screen 0 and move text around similiar to the way pictures are displayed and moved around.
Commands are:
AsciiLoad - Working and demonstrated
AsciiSave - Working and demonstrated
AsciiGet - Working and demonstrated
AsciiPut - Working and demonstrated
AsciiColor - Coded but untested
There are two Demo routines that shows off the commands:
Demo 1) Displays a ship, saves it (AsciiGet and AsciiSave), loads it (AsciiLoad), and finally displays it (AsciiGet)
Demo 2: Displays a Ship flyin across the screen. Loads it (AsciiLoad), and displays it (AsciiPut). This one shows the Clipping available in AsciiPut.
Code: Select all
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Types
Type ArtData
ArtC as Integer
ArtX as Integer
ArtY as Integer
ArtW as Integer
ArtH as Integer
End Type
Dim Shared Ship as ArtData
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Declare Functions
Declare Function AsciiGet(x1 as Integer, y1 as Integer, _
x2 as Integer, y2 as Integer) as String
Declare Function AsciiLoad(tData as ArtData, InFile as String) as String
Declare Function Replace(iMatch as String, iNew as String, _
iMain as String) as String
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Declare Subroutines
Declare Sub AsciiDemo1()
Declare Sub AsciiDemo2()
Declare Sub AsciiColor(x1 as Integer, y1 as Integer, _
x2 as Integer, y2 as Integer, _
iColor as Integer)
Declare Sub AsciiPut(x1 as Integer, y1 as Integer, tData as ArtData, _
ArtStr as String, iFlag as Integer)
Declare Sub AsciiSave(tData as ArtData, ArtStr as String, SaveFile as String)
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Functions
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Get an ASCII Art String -=- x1, y1 - Starting Position -=-
' From the Screen -=- x2, y2 - Ending Position -=-
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Function AsciiGet(x1 as Integer, y1 as Integer, _
x2 as Integer, y2 as Integer) as String
Dim x as Integer
Dim y as Integer
Dim tArt as String
Dim tColr as String
' Load the Colors and Art from the Screen and return it as a String
For y=y1 to y2
For x=x1 to x2
tArt=tArt+Chr$(Screen(y, x, 0))
tColr=tColr+Chr$(Screen(y, x, 1))
Next
Next
AsciiGet=tColr+tArt
End Function
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Load AScii Art From a File -=- InFile - File to Load -=-
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Function AsciiLoad(tData as ArtData, InFile as String) as String
Dim tFile as Integer
Dim tLoad as String
tFile=FreeFile
Open InFile for Binary as #tFile
If LOF(tFile)=0 then
' File Error
tLoad="Err"
Else
' Header Information
tLoad=Space$(8)
Get #tFile, 0, tLoad
If Left$(tLoad, 4)<>"NDAF" then
' Bad Header
tLoad="Err"
Else
' Width and Height
tData.ArtW=Asc(Mid$(tLoad, 6, 1))
tData.ArtH=Asc(Mid$(tLoad, 7, 1))
' Art Image
tLoad=Space$(2*tData.ArtW*tData.ArtH)
Get #tFile, 9, tLoad
End If
End If
Close #tFile
AsciiLoad=tLoad
End Function
' REPLACE Match String WITH New String IN Main String
' This is a PowerBasic command converted to FreeBasic.
Function Replace (iMatch as String, iNew as String, iMain as String) as String
Dim t as Integer
Dim tmp as String
tmp=iMain
For t=1 to Len(iMain)
If Mid$(tmp, t, 1)=iMatch then Mid$(tmp, t, 1)=iNew
Next
Replace=tmp
End Function
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Subroutines
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Save Ascii Art -=- ArtStr - AsciiArt Image -=-
' -=- to a File -=- SaveFile - File to Save to -=-
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Sub AsciiSave(tData as ArtData, ArtStr as String, SaveFile as String)
Dim tFile as Integer
Dim tHeader as String
tHeader="NDAF"+Chr$(0)+Chr$(tData.ArtW)+Chr$(tData.ArtH)+Chr$(0)
tFile=FreeFile
Open SaveFile for Binary as #tFile
Put #tFile, 0, tHeader
Put #tFile, , ArtStr
Close #tFile
End Sub
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Sub AsciiColor(x1 as Integer, y1 as Integer, _
x2 as Integer, y2 as Integer, iColor as Integer)
Dim x as Integer
Dim y as Integer
' Check Location
If (x1<1 or y1<1) or (x2>80 or y2>25) then Exit Sub
' Change Color at Location
For y=y1 to y2
For x=x1 to x2
Color iColor: Locate y, x: Print Screen(y, x);
Next
Next
End Sub
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Sub AsciiPut(x1 as Integer, y1 as Integer, tData as ArtData, _
AsciiStr as String, iFlag as Integer)
' iFlag=0: Transparent (Skip Spaces)
' iFlag=1: Non-Transparent
Dim x as Integer
Dim y as Integer
Dim ArtW as Integer
Dim ArtH as Integer
Dim ArtP as Integer
Dim tmp as String
Dim tArt as String
Dim tColr as String
' Art Width and Height
ArtW=tData.ArtW : ArtH=tData.ArtH
' Check Location
If (x1<-ArtW or x1=0 or y1<1) then Exit Sub
' Extract Colors and Art Image
tColr=Left$(AsciiStr, ArtW*ArtH)
tArt=Right$(AsciiStr, ArtW*ArtH)
If iFlag=0 then
' Place Holder
Else
tArt=Replace(Chr$(127), Chr$(32), tArt)
For y=0 to ArtH-1
ArtP=ArtW*y+1
tmp=Mid$(tArt, ArtP, ArtW)
Color Asc(Mid$(tColr, ArtP, 1))
' Display partial image on the left
If x1<1 then
ArtP=Abs(x1)
Locate y1+y, 1, 0 : Print Right$(tmp, ArtW-ArtP);
End If
' Display full image
If x1>0 and x1+ArtW<81 then
Locate y1+y, x1, 0 : Print tmp;
End If
' Display partial image on the right
If x1+ArtW>80 then
ArtP=(x1+ArtW)-81
Locate y1+y, x1, 0 : Print Left$(tmp, ArtW-ArtP);
End If
Next
End If
End Sub
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' -=- Demo Routines
Sub AsciiDemo1
Dim t as Integer
Dim x as Integer
Dim y as Integer
Dim ArtStr as String
' Define Ship Color, Width, and Height
Ship.ArtC=6 : Ship.ArtW=27 : Ship.ArtH=6
' Clear Screen - Set Ship Color
CLS : Color Ship.ArtC
' Read Ship Data and Draw it.
For t=1 to Ship.ArtH : Read ArtStr : Locate t, 1, 0 : Print ArtStr; : Next
' Load the Ship Into ArtStr
ArtStr=AsciiGet(1, 1, Ship.ArtW, Ship.ArtH)
' Save Ship Art Into a File Called Ship.art
AsciiSave Ship, ArtStr, "Ship.art"
' Load the Ship
ArtStr=AsciiLoad(Ship, "Ship.art")
' Display the Ship
AsciiPut 40, 1, Ship, ArtStr, 1
End Sub
Sub AsciiDemo2
Dim x as Integer
Dim y as Integer
Dim ArtStr as String
' Load the Ship
ArtStr=AsciiLoad(Ship, "Ship.art")
' Clear the Screen
CLS
' Animate a Ship Travelin From Left to Right
For x=-27 to 80
AsciiPut x, 1, Ship, ArtStr, 1
Sleep 20 : If Inkey$=Chr$(27) then End
' Clear Screen Area
For y=0 to Ship.ArtH-1
Locate y+1, 1 : Print Space$(80);
Next
Next
End Sub
' -=-=-=-=-=-=-=-=-=-=-cal clipping availablevertiave =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' Ship Data
Data "_______________ "
Data ",-' ,-' |_-_| | `--."
Data "/ | [___] `-------`."
Data "| ___\___________________\"
Data "\__\_|_________________/"
Data "(______________<||_)"
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' Commands Used: AsciiSave, AsciiLoad, AsciiGet, AsciiPut
AsciiDemo1
' Commands Used: AsciiPut {Animated}
AsciiDemo2
' -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
I will be adding vertical clipping and some other items and as I get them done, uploading the new code.