: H/Q Another Droid BBS - andr01d.zapto.org:9999 :
Write Pipes With Pascal In Pi
Actually, not only in Pi... but it rimes better :p
So... PIPES are codes that are used in BBSes to change color in text. You
probably have seen them. Usually are something like this 07. The symbol in
front the pipe defines that the next two numbers are a color. To change
the foreground color we use numbers from 00 to 15 and for the background
from 16 to 23... but why?
In Pascal the color of the text is defined by a variable, which is called
TextAttr. The size of this attribute is one byte, so it can take values
from 0 to 255. To represent foreground and background color, we use this
formula:
TextAttr : Foreground + Background * 16
Where Foreground is 0 to 15 and Background from 0 to 7. But in pipe codes
we use the values 16 to 23 for the background color, cause the first 16
values are taken and we cant use again 0 to 7. So we continue counting
from 16.
+---------------------- FG ---------------------+---------- BG ---------+
00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23
In a Pipe code to take the actual background value we calculate it like
this:
Background BG Pipe Code - 16
So, 23 is 23 - 16 7, which is actually white/grey in Pascal.
Sometimes, the pipe symbol is used for ASCII graphics, so if we translate
it every time we encounter it, as a pipe code, we may garble the text. We
must be sure that after the pipe symbol, two digits are following, else we
print the pipe as it is.
This is the theory... lets code...
Program writepipe
MODE objfpc // Use FreePascal format
H- // We dont want extended strings
Uses Crt
We will use our own String to Integer conversion, because we must know if
an error occurred while converting. If there is an error, then we know,
that we didnt process a valid color number and we have to print the text
instead of converting it in a color value.
Function S2IN:String:Smallint
Var
I,Code:Word
Begin
Result : -1 // Set default value for function
Val N,I,Code
If Code0 Then Exit // Is Everything OK? if not exit.
Result:I // If its OK then our result is a color number
End
Now... this is the sweet part.
+--+-- Really? i have to explain this?
+-- Default color to use
+-- TextAttr valid value
+ Our text with pipe codes
Procedure WriteXYPipe X, Y, Attr: Byte Text: String
Const
Seth // We could also use any other symbol we want ex.
Var
Count : Byte // Variable to know the position we are in the
// text
Code : String2 // Color values as text
CodeNum : Smallint // Our color value from the pipe code
OldAttr : Byte -
OldX : Byte Values to restore color and cursor position
OldY : Byte -/
Begin
OldAttr : TextAttr
OldX : WhereX
OldY : WhereY
GotoXY X, Y // Go to new position
TextAttr:Attr // Save old attribute
Count : 1 // Start in the beginning of the text
While Count LengthText Do Begin // While we are processing the
// text, check for colors
If TextCount Seth Then Begin // We found a pipe color?
Code : CopyText, Count + 1, 2 // Get two characters in front
CodeNum : S2ICode // Convert them to integer num.
if CodeNum0 Then Begin // If the conversion fails, then
// this wasnt actually a pipe
// code, so write the char
// instead of processing it.
WriteTextCount
Count+1
End
If CodeNum0 Or Code00 Then Begin
// We actually got a pipe code!
Count+3 // Increase the counter by three cause
// pipes are 23
If CodeNum in 00..15 Then // Is the color code from 0 to 15?
// then we have to change the
// foreground color.
// We only need to change the foreground color, so we need to
// know, what is the currect background color. To do that, we
// divide the current TextAttr by 16 and then multiple the
// result again with 16. This way, we get the value for the
// background only! After, we just add, the number for the
// foreground color.
+-- Foreground Color
+-- Get the old value and
// re-apply it
TextAttr : CodeNum + TextAttr Div 16 * 16
Else
// If our pipe color is between 16 and 23, then we change the
// background color, but we have to keep the same foreground
// color. To extract foreground color from the textattr variable
// we mod it... we want the modulus of the division TextAttr / 16
// As we said earlier, the background value is from 0 to 7, so to
// convert our background pipe color 16 to 23 we just sub 16 and
// then multiple by 16
+-- Current Foreground Color
+-- Background Value
TextAttr :TextAttr Mod 16 + CodeNum - 16 * 16
End
End Else Begin // No pipe code, so we print the character and move on
WriteTextCount
Count+1
End
End
TextAttr:OldAttr // At the end, restore old color and position
GotoXY OldX, OldY
End
Begin
ClrScr
WriteXYPipe10,5,7,Hello 1517World 1this is +
0803write11XY0623Pipe
For f:0 to 7 Do
For b:0 to 7 Do
WriteXYPipe10+f*8,8+b,7,+I2Sf++I2Sb+16+TEXT
End.
Complete Program
Program writepipe
MODE objfpc // Use FreePascal format
H- // We dont want extended strings
Uses Crt
Var
f,b:Byte
Function I2S N: LongInt: String
Var
T : String
Begin
StrN, T
If LengthT1 Then T:0+T
Result : T
End
Function S2IN:String:Smallint
Var
I,Code:Word
Begin
Result : -1
Val N,I,Code
If Code0 Then Exit
Result:I
End
Procedure WriteXYPipe X, Y, Attr: Byte Text: String
Const
Seth
Var
Count : Byte
Code : String2
CodeNum : Smallint
OldAttr : Byte
OldX : Byte
OldY : Byte
Begin
OldAttr : TextAttr
OldX : WhereX
OldY : WhereY
GotoXY X, Y
TextAttr:Attr
Count : 1
While Count LengthText Do Begin
If TextCount Seth Then Begin
Code : CopyText, Count + 1, 2
CodeNum : S2ICode
if CodeNum0 Then Begin
WriteTextCount
Count+1
End
If CodeNum0 Or Code00 Then Begin
Count+3
If CodeNum in 00..15 Then
TextAttr : CodeNum + TextAttr Div 16 * 16
Else
TextAttr :TextAttr Mod 16 + CodeNum - 16 * 16
End
End Else Begin
WriteTextCount
Count+1
End
End
TextAttr:OldAttr
GotoXY OldX, OldY
End
Begin
ClrScr
WriteXYPipe10,5,7,Hello 1517World 1this is +
0803write11XY0623Pipe
For f:0 to 7 Do
For b:0 to 7 Do
WriteXYPipe10+f*8,8+b,7,+I2Sf++I2Sb+16+TEXT
End.
8888
. - . . 8 888888 8
/ 8888888888
8888888888
DoNt Be aNoTHeR DrOiD fOR tHe SySteM 88 8888 88
8888888888
/: HaM RaDiO /: ANSi ARt! /: MySTiC MoDS /: DooRS 8888
/: NeWS /: WeATheR /: FiLEs /: SPooKNet 8888
/: GaMeS /: TeXtFiLeS /: PrEPardNeSS /: FsxNet 88
/: TuTors /: bOOkS/PdFs /: SuRVaViLiSM /: ArakNet 8 8 88888888888
888 8888888
TeLNeT : andr01d.zapto.org:9999 UTC 11:00 - 20:00 8 88888888888
SySoP : xqtr eMAiL: xqtr@gmx.com 8 8888..888
DoNaTe : https://paypal.me/xqtr 8 888888888