Copy Link
Add to Bookmark
Report

NULL mag Issue 04 19 Pascal Programming - Write Pipe Codes

eZine's profile picture
Published in 
null magazine
 · 26 Dec 2020

  

__ _ __ _ _ __
______\ \_\\_______________________\///__________________________//_/ /______
\___\ /___/
| .__ __ |
| | ___ __________/ |________ |
| \ \/ / ____/\ __\_ __ \ |
; > < <_| | | | | | \/ ;
: /__/\_ \__ | |__| |__| :
. \/ |__| .
. .
: 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 can't 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 don't 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 didn't process a valid color number and we have to print the text
instead of converting it in a color value.

Function S2I(N:String):Smallint;
Var
I,Code:Word;
Begin
Result := -1; // Set default value for function
Val (N,I,Code);
If Code<>0 Then Exit; // Is Everything OK? if not exit.
Result:=I; // If it's 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 : String[2]; // 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 <= Length(Text) Do Begin // While we are processing the
// text, check for colors
If Text[Count] = Seth Then Begin // We found a pipe color?
Code := Copy(Text, Count + 1, 2); // Get two characters in front
CodeNum := S2I(Code); // Convert them to integer num.
if CodeNum<0 Then Begin // If the conversion fails, then
// this wasn't actually a pipe
// code, so write the char
// instead of processing it.
Write(Text[Count]);
Count+=1;
End;
If (CodeNum>0) Or (Code='00') 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
Write(Text[Count]);
Count+=1;
End;

End;
TextAttr:=OldAttr; // At the end, restore old color and position
GotoXY (OldX, OldY);
End;

Begin
ClrScr;
WriteXYPipe(10,5,7,'|Hello| |15|17World |1this is '+
'|08|03write|11XY|06|23Pipe');


For f:=0 to 7 Do
For b:=0 to 7 Do
WriteXYPipe(10+f*8,8+b,7,'|'+I2S(f)+'|'+I2S(b+16)+'TEXT ');

End.


+ --- -- - . - --- --- --- - . - -- --- '
Complete Program
+ --- -- - . - --- --- --- - . - -- --- '

Program writepipe;
{$MODE objfpc} // Use FreePascal format
{$H-} // We don't want extended strings
Uses Crt;

Var
f,b:Byte;

Function I2S (N: LongInt): String;
Var
T : String;
Begin
Str(N, T);
If Length(T)=1 Then T:='0'+T;
Result := T;
End;

Function S2I(N:String):Smallint;
Var
I,Code:Word;
Begin
Result := -1;
Val (N,I,Code);
If Code<>0 Then Exit;
Result:=I;
End;

Procedure WriteXYPipe (X, Y, Attr: Byte; Text: String);
Const
Seth = '|';
Var
Count : Byte;
Code : String[2];
CodeNum : Smallint;
OldAttr : Byte;
OldX : Byte;
OldY : Byte;
Begin
OldAttr := TextAttr;
OldX := WhereX;
OldY := WhereY;

GotoXY (X, Y);
TextAttr:=Attr;

Count := 1;

While Count <= Length(Text) Do Begin
If Text[Count] = Seth Then Begin
Code := Copy(Text, Count + 1, 2);
CodeNum := S2I(Code);
if CodeNum<0 Then Begin
Write(Text[Count]);
Count+=1;
End;
If (CodeNum>0) Or (Code='00') 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
Write(Text[Count]);
Count+=1;
End;

End;
TextAttr:=OldAttr;
GotoXY (OldX, OldY);
End;

Begin
ClrScr;
WriteXYPipe(10,5,7,'|Hello| |15|17World |1this is '+
'|08|03write|11XY|06|23Pipe');


For f:=0 to 7 Do
For b:=0 to 7 Do
WriteXYPipe(10+f*8,8+b,7,'|'+I2S(f)+'|'+I2S(b+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 '88||||88'
/: NeWS /: WeATheR /: FiLEs /: SPooKNet ''8888"'
/: GaMeS /: TeXtFiLeS /: PrEPardNeSS /: FsxNet 88
/: TuTors /: bOOkS/PdFs /: SuRVaViLiSM /: ArakNet 8 8 88888888888
888 8888][][][888
TeLNeT : andr01d.zapto.org:9999 [UTC 11:00 - 20:00] 8 888888##88888
SySoP : xqtr eMAiL: xqtr@gmx.com 8 8888.####.888
DoNaTe : https://paypal.me/xqtr 8 8888##88##888

← previous
next →
loading
sending ...
New to Neperos ? Sign Up for free
download Neperos App from Google Play
install Neperos as PWA

Let's discover also

Recent Articles

Recent Comments

Neperos cookies
This website uses cookies to store your preferences and improve the service. Cookies authorization will allow me and / or my partners to process personal data such as browsing behaviour.

By pressing OK you agree to the Terms of Service and acknowledge the Privacy Policy

By pressing REJECT you will be able to continue to use Neperos (like read articles or write comments) but some important cookies will not be set. This may affect certain features and functions of the platform.
OK
REJECT