{ ************************************************************************** }
{ This is the complete source code of SpellView, version 1.3                 }
{ This program was coded by Spellcaster of Spell, and you can find general   }
{ info about the program in the info docs suplied with this package.         }
{ The reason why I released the source code of this program is that I want   }
{ people to learn... That how I did it... I learned with other people's      }
{ sources...                                                                 }
{ Of course, this source code is just for tutorial purposes and should not,  }
{ in any circunstance be used for comercial purposes.                        }
{ You can use this source code as you want, alter it to suit your needs, or  }
{ use it as a base to a great text viewer (better than this, anyway).        }
{ But, please, don't change just a line in the code and claim it as yours... }
{ That's f#$@$ lame !!! Don't be lame !!!                                    }
{ The code should be self-explainable, because, altough I'm a caothic        }
{ programmer, I took some care with the formatting of this one...            }
{ The program just uses the standart CRT unit, and other unit called Mode13h,}
{ that is used to do graphics (reading the PCX image). The unit and the rest }
{ of the programm should be easy to understand to someone that reads the     }
{ fabulous ezine, 'The Mag'. :))))                                           }
{ So, take care... And may the bytes be with you... (Shit, what a lame end   }
{ phrase !!!) :))                                                            }
{                                           Spellcaster of Spell             }
{                                                                            }
{ ************************************************************************** }

Program SpellView(input,output);

Uses Mode13h,Crt;

Const MaxParam=50;
      NPartials=1024;
      VidSeg=$B800;

Type TextPoint=^LineRec;
     LineRec=Record
                   Line:String[80];
                   Fg,Bg:Byte;
                   Next:TextPoint;
             End;

     ParsedType=Array[1..MaxParam] Of String[50];

     PartialType=Record
                       Color:Byte;
                       Line:Word;
                       X1,X2:Byte;
                 End;

Var FileName:String;
    TheText:TextPoint;
    CurrentLine:Word;
    A:Byte;
    C:Char;
    NLines:Word;

    TitleFg:Byte;
    TitleBg:Byte;
    TitleString:String[80];
    Bg:Byte;
    Fg:Byte;
    PNum:Word;

    Partials:Array[1..NPartials] Of PartialType;

Function Find(S:String;C:Char):byte;
Var B:Byte;
Begin
     B:=0;
     Find:=0;
     While (S[B]<>C) And (B<=Length(S)) Do
     Begin
          Inc(B);
          If S[B]=C Then Find:=B;
     End;
End;

Function Left(S:String;N:Byte):String;
Var P:string;
    H:byte;
Begin
     P:='';
     If Length(S)<N Then N:=Length(S);
     For H:=1 to N do
         P:=P+S[H];
     Left:=P
End;

Function Exist(Name:String):Boolean;
Var F:File;
Begin
     {$I-}
     Assign(F,Name);
     Reset(F);
     Close(F);
     {$I+}
     Exist:=(IOResult=0) And (Name<>'');
End;

Function FindSpace(S:String;Start:Byte):Byte;
Begin
     While (S[Start+1]<>' ') And (S[Start+1]<>',') And (Start<Length(S)) Do
       Inc(Start);
     FindSpace:=Start;
End;

Function GetString(S:String;Start,Finish:Byte):String;
Var A:Byte;
    Tmp:String;
Begin
     Tmp:='';
     For A:=Start+1 To Finish Do Tmp:=Tmp+S[A];
     GetString:=Tmp;
End;

Procedure Parse(S:String;Var Parsed:ParsedType);
Var ArrayIndex:Byte;
    StringIndex:Byte;
    NextSpace:Byte;
Begin
     ArrayIndex:=1;
     StringIndex:=0;
     NextSpace:=FindSpace(S,StringIndex);
     While (StringIndex<=Length(S)) And (ArrayIndex<=MaxParam) Do
     Begin
          NextSpace:=FindSpace(S,StringIndex);
          Parsed[ArrayIndex]:=GetString(S,StringIndex,NextSpace);
          StringIndex:=NextSpace+1;
          Inc(ArrayIndex);
     End;
End;

Function Upper(S:String):String;
Var Tmp:String;
    A:Byte;
Begin
     Tmp:='';
     For A:=1 To Length(S) Do Tmp:=Tmp+UpCase(S[A]);
     Upper:=Tmp;
End;

Procedure MyWrite(N:Word;BgC,FgC:Byte;S:String);
Var A:Word;
    P:Word;
    Cl:Byte;
Begin
     P:=0;
     For A:=1 To PNum Do If Partials[A].Line=N Then P:=A;
     For A:=1 To Length(S) Do
     Begin
          Cl:=BgC*16+FgC;
          If P<>0 Then
            If (A>=Partials[P].X1) And (A<=Partials[P].X2) Then
              Cl:=Partials[P].Color;
          TextColor(Cl And 143);
          TextBackground((Cl And 112) Shr 4);
          Write(S[A]);
     End;
End;

Procedure ReadText(Name:String);
Var F:Text;
    Tmp:TextPoint;
Begin
     Assign(F,Name);
     Reset(F);
     If MaxAvail<SizeOf(LineRec) Then
     Begin
          Writeln;
          Writeln('SPELLVIEW V1.3');
          Writeln('A Text Viewer by Spellcaster');
          Writeln;
          Writeln('Not enough memory to read text... :(');
          Writeln;
          Halt(0);
     End;
     New(TheText);
     Tmp:=TheText;
     NLines:=0;
     While Not Eof(F) Do
     Begin
          Readln(F,Tmp^.Line);
          Tmp^.Fg:=Fg;
          Tmp^.Bg:=Bg;
          Tmp^.Next:=NIL;
          If Not Eof(F) Then
          Begin
               If MaxAvail<SizeOf(LineRec) Then
               Begin
                    Writeln('Sorry, not enough memory to load text... :(');
                    Writeln;
                    Halt(0);
               End;
               New(Tmp^.Next);
               Tmp:=Tmp^.Next;
          End;
          Inc(NLines);
     End;
     Close(F);
End;

Function Col(S:String):Byte;
Var A,C:Word;
Begin
     Col:=0;
     If S='0' Then
     Begin
          Col:=0;
          Exit;
     End;
     Val(S,C,A);
     If C<>0 Then
     Begin
          Col:=C;
          Exit;
     End;
     If S='BLACK' Then Col:=0;
     If S='BLUE' Then Col:=1;
     If S='GREEN' Then Col:=2;
     If S='CYAN' Then Col:=3;
     If S='RED' Then Col:=4;
     If S='MAGENTA' Then Col:=5;
     If S='BROWN' Then Col:=6;
     If S='LIGHTGRAY' Then Col:=7;
     If S='DARKGRAY' Then Col:=8;
     If S='LIGHTBLUE' Then Col:=9;
     If S='LIGHTGREEN' Then Col:=10;
     If S='LIGHTCYAN' Then Col:=11;
     If S='LIGHTRED' Then Col:=12;
     If S='LIGHTMAGENTA' Then Col:=13;
     If S='YELLOW' Then Col:=14;
     If S='WHITE' Then Col:=15;
End;

Procedure SetBgCol(Line,Color:Word);
Var Tmp:TextPoint;
    A:Word;
Begin
     Tmp:=TheText;
     If (Line=0) Or (Line>Nlines) Then Exit;
     For A:=1 To Line-1 Do Tmp:=Tmp^.Next;
     Tmp^.Bg:=Color;
End;

Procedure SetFgCol(Line,Color:Word);
Var Tmp:TextPoint;
    A:Word;
Begin
     Tmp:=TheText;
     If (Line=0) Or (Line>Nlines) Then Exit;
     For A:=1 To Line-1 Do Tmp:=Tmp^.Next;
     Tmp^.Fg:=Color;
End;

Procedure ReadPref(Name:String);
Var A,Cl:Word;
    R,G,B,C:Word;
    Ch:Char;
    F:Text;
    Cmd:String;
    Parsed:ParsedType;
    Relative:Integer;
Begin
     Relative:=0;
     A:=Find(Name,'.');
     Name:=Left(Name,A);
     Name:=Name+'swd';
     If Exist(Name)=False Then Exit;
     Assign(F,Name);
     Reset(F);
     While Not Eof(F) Do
     Begin
          Readln(F,Cmd);
          For A:=1 To MaxParam Do Parsed[A]:='';
          Parse(Cmd,Parsed);
          For A:=1 To MaxParam Do Parsed[A]:=Upper(Parsed[A]);
          If Parsed[1]='BG' Then
          Begin
               Cl:=Col(Parsed[2]);
               A:=3;
               While Parsed[A]<>'' Do
               Begin
                    Val(Parsed[A],B,C);
                    B:=Relative+B;
                    If B<>0 Then SetBgCol(B,Cl);
                    Inc(A);
               End;
          End;
          If Parsed[1]='RELATIVE' Then Val(Parsed[2],Relative,C);
          If Parsed[1]='RANGEBG' Then
          Begin
               Cl:=Col(Parsed[2]);
               Val(Parsed[3],R,C);
               R:=Relative+R;
               Val(Parsed[4],G,C);
               G:=Relative+G;
               For A:=R To G Do SetBgCol(A,Cl);
          End;
          If Parsed[1]='FG' Then
          Begin
               Cl:=Col(Parsed[2]);
               A:=3;
               If Parsed[3]='BLINK' Then
               Begin
                    Cl:=Cl+Blink;
                    A:=4;
               End;
               While Parsed[A]<>'' Do
               Begin
                    Val(Parsed[A],B,C);
                    B:=Relative+B;
                    If B<>0 Then SetFgCol(B,Cl);
                    Inc(A);
               End;
          End;
          If Parsed[1]='RANGEFG' Then
          Begin
               Cl:=Col(Parsed[2]);
               Val(Parsed[3],R,C);
               Val(Parsed[4],G,C);
               R:=Relative+R;
               G:=Relative+G;
               For A:=R To G Do SetFgCol(A,Cl);
          End;
          If Parsed[1]='TITLE' Then
          Begin
               TitleFg:=Col(Parsed[2]);
               TitleBg:=Col(Parsed[3]);
               A:=4;
               TitleString:='';
               While Parsed[A]<>'' Do
               Begin
                    TitleString:=TitleString+Parsed[A]+' ';
                    Inc(A);
               End;
          End;
          If Parsed[1]='NOTITLE' Then
          Begin
               TitleFg:=0;
               TitleBg:=0;
               TitleString:='';
          End;
          If Parsed[1]='RGB' Then
          Begin
               Cl:=Col(Parsed[2]);
               Val(Parsed[3],R,C);
               Val(Parsed[4],G,C);
               Val(Parsed[5],B,C);
               SetColor(Cl,R,G,B);
          End;
          If Parsed[1]='PARTIAL' Then
          Begin
               If PNum<=NPartials Then
               Begin
                    R:=Col(Parsed[2]);
                    G:=Col(Parsed[3]);
                    Cl:=R*16+G;
                    Partials[PNum].Color:=Cl;
                    Val(Parsed[4],A,C);
                    B:=Relative+B;
                    Partials[PNum].Line:=A;
                    Val(Parsed[5],A,C);
                    Partials[PNum].X1:=A;
                    Val(Parsed[6],A,C);
                    Partials[PNum].X2:=A;
                    Inc(PNum);
               End;
          End;
          If Parsed[1]='TITLEPCX' Then
          Begin
               If Exist(Parsed[2]) Then
               Begin
                    InitGraph;
                    For A:=0 To 255 Do
                    Begin
                         PCXPal[A].R:=0;
                         PCXPal[A].G:=0;
                         PCXPal[A].B:=0;
                    End;
                    SetPalette(PCXPal);
                    LoadPCX(Parsed[2],VGA);
                    Fade(PCXPal);
                    Ch:=Readkey;
                    For A:=0 To 255 Do
                    Begin
                         PCXPal[A].R:=0;
                         PCXPal[A].G:=0;
                         PCXPal[A].B:=0;
                    End;
                    Fade(PCXPal);
                    CloseGraph;
               End;
          End;
     End;
     Close(F);
End;

Procedure ReadPrePref(Name:String);
Var A,Cl:Byte;
    R,G,B,C:Word;
    Ch:Char;
    F:Text;
    Cmd:String;
    Parsed:ParsedType;
Begin
     A:=Find(Name,'.');
     Name:=Left(Name,A);
     Name:=Name+'swd';
     If Exist(Name)=False Then Exit;
     Assign(F,Name);
     Reset(F);
     While Not Eof(F) Do
     Begin
          Readln(F,Cmd);
          For A:=1 To MaxParam Do Parsed[A]:='';
          Parse(Cmd,Parsed);
          For A:=1 To MaxParam Do Parsed[A]:=Upper(Parsed[A]);
          If Parsed[1]='BACKGROUND' Then Bg:=Col(Parsed[2]);
          If Parsed[1]='FOREGROUND' Then Fg:=Col(Parsed[2]);
     End;
     Close(F);
End;

Procedure DestroyText;
Var Tmp1,Tmp2:TextPoint;
Begin
     Tmp1:=TheText;
     While Tmp1^.Next<>NIL Do
     Begin
          Tmp2:=Tmp1;
          Tmp1:=Tmp1^.Next;
          Dispose(Tmp2);
     End;
End;

Function Spaces(N:Byte):String;
Var S:String;
    A:Byte;
Begin
     S:='';
     For A:=1 To N Do S:=S+' ';
     Spaces:=S;
End;

Procedure TypeTitle;
Begin
     GotoXY(1,1);
     TextColor(TitleFg);
     TextBackground(TitleBg);
     Writeln(Spaces(80));
     GotoXY(1,1);
     Writeln(TitleString);
End;

Procedure DisplayText;
Var Tmp:TextPoint;
    A:Word;
Begin
     Tmp:=TheText;
     For A:=1 To CurrentLine-1 Do Tmp:=Tmp^.Next;
     For A:=1 to 22 Do
     Begin
          GotoXY(1,A+1);
          MyWrite(CurrentLine+A-1,Tmp^.Bg,Tmp^.Fg,Tmp^.Line);
          Tmp:=Tmp^.Next;
     End;
End;

Procedure ClearTextArea;
Var A:Byte;
Begin
     TextBackground(Bg);
     ClrScr;
     TypeTitle;
End;

Procedure SetUpDefaults;
Var A:Word;
Begin
     Bg:=Black;
     Fg:=White;
     TitleFg:=Yellow;
     TitleBg:=Red;
     TitleString:=Filename;
     For A:=1 To NPartials Do
     Begin
          Partials[A].Color:=0;
          Partials[A].Line:=0;
          Partials[A].X1:=0;
          Partials[A].X2:=0;
     End;
     PNum:=1;
End;

Procedure ScrollDown;
Begin
     Move(Mem[47104:160],Mem[47104:320],3360);
     GotoXY(1,2);
     TextColor(Fg);
     TextBackground(Bg);
     Writeln(Spaces(80));
End;

Procedure ScrollUp;
Begin
     Move(Mem[47104:320],Mem[47104:160],3360);
     GotoXY(1,23);
     TextColor(Fg);
     TextBackground(Bg);
     Writeln(Spaces(80));
End;

Procedure DisplayCurrentLineTop;
Var Tmp:TextPoint;
    A:Word;
Begin
     Tmp:=TheText;
     For A:=1 To CurrentLine-1 Do Tmp:=Tmp^.Next;
     GotoXY(1,2);
     MyWrite(CurrentLine,Tmp^.Bg,Tmp^.Fg,Tmp^.Line);
End;

Procedure DisplayCurrentLineBottom;
Var Tmp:TextPoint;
    A:Word;
Begin
     Tmp:=TheText;
     For A:=1 To CurrentLine+20 Do Tmp:=Tmp^.Next;
     GotoXY(1,23);
     TextColor(Tmp^.Fg);
     TextBackground(Tmp^.Bg);
     MyWrite(CurrentLine+21,Tmp^.Bg,Tmp^.Fg,Tmp^.Line);
End;

Begin
     If ParamCount<>1 Then
     Begin
          Writeln;
          Writeln('SPELLVIEW V1.3');
          Writeln('A Text Viewer by Spellcaster');
          Writeln;
          Writeln('Usage:');
          Writeln('       SPLVIEW <filename>');
          Writeln;
          Halt(0);
     End;
     FileName:=ParamStr(1);
     If Not Exist(Filename) Then
     Begin
          Writeln;
          Writeln('SPELLVIEW V1.3');
          Writeln('A Text Viewer by Spellcaster');
          Writeln;
          Writeln('File not found... :(');
          Writeln;
          Halt(0);
     End;
     SetUpDefaults;
     ReadPrePref(Filename);
     ReadText(FileName);
     ReadPref(FileName);
     TextBackground(Bg);
     ClrScr;
     TypeTitle;
     CurrentLine:=1;
     DisplayText;
     Repeat
           C:=UpCase(ReadKey);
           If (C=Chr(0)) then
           Begin
                Repeat Until Keypressed;
                C:=Readkey;
                If (C=chr(72)) And (CurrentLine>1) Then
                Begin
                     Dec(CurrentLine);
                     ScrollDown;
                     DisplayCurrentLineTop;
                     C:=Chr(255);
                End;
                If (C=Chr(80)) And (CurrentLine<Nlines-21) Then
                Begin
                     Inc(CurrentLine);
                     ScrollUp;
                     DisplayCurrentLineBottom;
                     C:=Chr(255);
                End;
                If C=Chr(73) Then
                Begin
                     If CurrentLine>22 Then Dec(CurrentLine,22) Else
                       CurrentLine:=1;
                     ClearTextArea;
                     DisplayText;
                     C:=Chr(255);
                End;
                If C=Chr(81) Then
                Begin
                     If CurrentLine>=Integer(Nlines)-45 Then CurrentLine:=NLines-21 Else
                       Inc(CurrentLine,22);
                     ClearTextArea;
                     DisplayText;
                     C:=Chr(255);
                End;
                C:=Chr(255);
           End;
           If (C='L') Then
           Begin
                ClearTextArea;
                DisplayText;
                C:=Chr(255);
           End;
           If ((C='P') Or (C='-')) Then
           Begin
                If CurrentLine>22 Then Dec(CurrentLine,22) Else
                  CurrentLine:=1;
                ClearTextArea;
                DisplayText;
                C:=Chr(255);
           End;
           If ((C='N') Or (C=' ') Or (C='+')) Then
           Begin
                If CurrentLine>=Nlines-45 Then CurrentLine:=NLines-21 Else
                  Inc(CurrentLine,22);
                ClearTextArea;
                DisplayText;
                C:=Chr(255);
           End;
     Until (C='X') Or (C=Chr(27)) Or (C='Q');
     DestroyText;
     Closegraph;
End.