home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WEDITS22.ZIP / WEOUTPUT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-15  |  11.5 KB  |  485 lines
  1. UNIT WEOutput;
  2. { -- This is the Output Unit of WWIVEdit 2.2
  3.   -- Last Updated : 8/15/91
  4.   -- Written By:
  5.   --   Adam Caldwell
  6.   --
  7.   -- This Code is Limited Public Domain (see WWIVEdit.pas for details)
  8.   --
  9.   -- Purpose : Does the main output of WWIVEdit
  10.   --
  11.   -- Know Errors: None
  12.   --
  13.   -- Planned Enhancements:  Adding Virtual Output
  14.   --
  15.   -- }
  16. {$R-,V-,S-,B-,E-,N-}   { These Optomize things as much as possible }
  17.  
  18. INTERFACE
  19.  
  20. CONST
  21.     Black         =  0;   { The Same Constants as defined in the CRT unit }
  22.     Blue          =  1;
  23.     Green         =  2;
  24.     Cyan          =  3;
  25.     Red           =  4;
  26.     Magenta       =  5;
  27.     Brown         =  6;
  28.     LightGray     =  7;
  29.     DarkGray      =  8;
  30.     LightBlue     =  9;
  31.     LightGreen    =  10;
  32.     LightCyan     =  11;
  33.     LightRed      =  12;
  34.     LightMagenta  =  13;
  35.     Yellow        =  14;
  36.     White         =  15;
  37.     Blink         =  128; { Ex: Textcolor(Red+Blink); }
  38.  
  39.     c0 = ^C'0';  { Norm Color }   { Short cuts FOR changing WWIV colors       }
  40.     c1 = ^C'1';  { Yes/No Ans }   { These should be used in conj. with Print  }
  41.     c2 = ^C'2';  { Prompt     }   { and Prompt if you want them to be         }
  42.     c3 = ^C'3';  { Note       }   { translated during the design phase of your}
  43.     c4 = ^C'4';  { Input Line }   { program.                                  }
  44.     c5 = ^C'5';  { Y/N Quest. }
  45.     c6 = ^C'6';  { Notice     }
  46.     c7 = ^C'7';  { Border     }
  47.  
  48.  
  49. VAR
  50.   DisplayColor:char;
  51.   Translate : boolean;
  52.   PausePrompt : string;
  53.  
  54. PROCEDURE ClrScr;
  55. PROCEDURE ClrEOL;
  56. PROCEDURE ReverseVideoOn;
  57. PROCEDURE ReverseVideoOff;
  58. PROCEDURE Prompt(i:string);
  59. PROCEDURE Print(i:string);
  60. PROCEDURE Ansic(c:char);
  61. PROCEDURE TextColor(c:byte);
  62. PROCEDURE TextBackground(c:byte);
  63. PROCEDURE GotoXY(x,y:byte);
  64. FUNCTION  WhereY:byte;
  65. FUNCTION  WhereX:byte;
  66. PROCEDURE Center(s:string);
  67. PROCEDURE nl;
  68. PROCEDURE ReadScreen(VAR s:string; x,y:integer);
  69. PROCEDURE WriteScreen(s:string; x,y,at:integer);
  70. PROCEDURE WriteControl(ch:char);
  71. PROCEDURE PauseScr;
  72. PROCEDURE Redisplay;
  73. PROCEDURE ForcedRedisplay;
  74. PROCEDURE ShowHeader;
  75. PROCEDURE ShowMaxLines;
  76. PROCEDURE StatusLine1(s:string);
  77. PROCEDURE StatusLine2(s:string);
  78. PROCEDURE StatusLine3(s:string);
  79. PROCEDURE ClrStatLine3;
  80. PROCEDURE ClrStatLine2;
  81. PROCEDURE PrintControlLine(s:string);
  82.  
  83. IMPLEMENTATION
  84.  
  85. USES DOS, WEString, WEKbd, WEVars, WELine, WETime;
  86.  
  87. TYPE
  88.   ScreenLine = ARRAY[1..80] OF RECORD
  89.            c : char;
  90.            a : byte;
  91.          END;
  92.  
  93.   ScreenBuff = ARRAY[1..50] OF ScreenLine;
  94.  
  95. VAR
  96.   FG, BG : Integer;
  97.   WhereYFix:integer;
  98.   disp : ^ScreenBuff;
  99.   Blinking : boolean;
  100.  
  101. PROCEDURE ReverseVideoOn;
  102. BEGIN
  103.   Prompt(ESC+'[7m');
  104. END;
  105.  
  106. PROCEDURE ReverseVideoOff;
  107. BEGIN
  108.   Prompt(ESC+'[87m');
  109. END;
  110.  
  111. PROCEDURE DoColor(f,b : byte);
  112. BEGIN
  113.   TextColor(f);
  114.   TextBackground(b);
  115. END;
  116.  
  117.  
  118. PROCEDURE Ansic(c:char);
  119. { New version of ANSIC requires a CHAR instead of an Int... it simplifies
  120.   using all the Color Mods out there }
  121. BEGIN
  122.   IF NOT NoColor THEN
  123.   BEGIN
  124.     DisplayColor:=c;
  125.     IF Not Translate THEN prompt(^C+C);
  126.     CASE c OF
  127.       '0' : FG:=LightGray;
  128.       '1' : FG:=LightCyan;
  129.       '2' : FG:=Yellow;
  130.       '3' : FG:=Magenta;
  131.       '4' : BEGIN FG:=White; BG:=Blue END;
  132.       '5' : FG:=green;
  133.       '6' : FG:=LightRed+Blink;
  134.       '7' : FG:=LightBlue;
  135.      ELSE FG:=7;
  136.     END;
  137.     IF c<>'4' THEN BG:=Black;
  138.     IF Translate
  139.       THEN DoColor(FG,BG);
  140.   END;
  141. END;
  142.  
  143. PROCEDURE WriteControl(ch:char);
  144. { Writes Ch in inverted colors... should be in the range [#0..#31] }
  145. BEGIN
  146.   ReverseVideoOn;
  147.   Write(chr(ord(ch)+ord('@'))); { prints out H for ^H, etc }
  148.   ReverseVideoOff;
  149. END;
  150.  
  151. PROCEDURE ClrEol;
  152. BEGIN
  153.   write(#27,'[K')
  154. END;
  155.  
  156.  
  157. PROCEDURE TextColor(c : byte);
  158. VAR
  159.   i : string;
  160.   intense : boolean;
  161. BEGIN
  162.   i  :=  #27+'[';
  163.   IF Blinking THEN
  164.     i:=i+'85;';
  165.   blinking:=c>=blink;
  166.   IF blinking THEN dec(c,blink);
  167.   intense:=c>7;
  168.   IF intense THEN
  169.     dec(c,8);
  170.   IF intense
  171.     THEN i := i+'1;'
  172.     ELSE i := i+'0;';
  173.   case c of
  174.     0 : i:=i+'30'; {Black/DarkGray}
  175.     1 : i:=i+'34'; {Blue/LightBlue}
  176.     2 : i:=i+'32'; {Green/LightGreen}
  177.     3 : i:=i+'36'; {Cyan/LightCyan}
  178.     4 : i:=i+'31'; {Red/LightRed}
  179.     5 : i:=i+'35'; {Magenta/LightMagenta}
  180.     6 : i:=i+'33'; {Brown/Yellow}
  181.    ELSE i:=i+'37'; {LightGrey/White}
  182.   END;
  183.   IF blinking THEN
  184.     i  :=  i+';5';
  185.   i  :=  i+'m';
  186.   write(i);
  187. END;
  188.  
  189.  
  190. PROCEDURE TextBackground(c : byte);
  191. VAR i : string;
  192. BEGIN
  193.   i  :=  #27+'[';
  194.   IF c > 7 THEN dec(c,8);
  195.   case c of
  196.     0 : i  :=  i+'40'; {Black/DarkGray}
  197.     1 : i  :=  i+'44'; {Blue/LightBlue}
  198.     2 : i  :=  i+'42'; {Green/LightGreen}
  199.     3 : i  :=  i+'46'; {Cyan/LightCyan}
  200.     4 : i  :=  i+'41'; {Red/LightRed}
  201.     5 : i  :=  i+'45'; {Magenta/LightMagenta}
  202.     6 : i  :=  i+'43'; {Brown/Yellow}
  203.     7 : i  :=  i+'47'; {LightGrey/White}
  204.   END;
  205.   i  :=  i+'m';
  206.   write(i);
  207. END;
  208.  
  209.  
  210. PROCEDURE Center(s:string);
  211. BEGIN
  212.   writeln(' ':40-(lengthw(s) div 2),s);
  213. END;
  214.  
  215. PROCEDURE prompt(i:string);
  216. VAR c : integer; pp : byte; cc : char;
  217. BEGIN
  218.   IF (i[1]=^B) AND Translate THEN BEGIN
  219.     delete(i,1,1);
  220.     write(#27+'['+cstr(40-(lengthw(i) div 2))+'C')
  221.   END;
  222.   IF NOT Translate THEN
  223.     write(i)
  224.   ELSE
  225.   FOR c  :=  1 TO length(i) DO
  226.   BEGIN
  227.     IF Translate AND (i[c] = #3) THEN
  228.     BEGIN
  229.       ansic(i[c+1]);
  230.       inc(c)
  231.     END
  232.     ELSE write(i[c]);
  233.   END;
  234. END;
  235.  
  236.  
  237. PROCEDURE nl;
  238. BEGIN
  239.   prompt(#13#10);
  240. END;
  241.  
  242. PROCEDURE print(i : string);
  243. BEGIN
  244.   prompt(i);
  245.   nl;
  246. END;
  247.  
  248.  
  249.  
  250.  
  251. PROCEDURE clrscr;
  252. BEGIN
  253.   Whereyfix:=0;
  254.   gotoxy(1,1);
  255.   ansic('0');
  256.   prompt(#27+'[2J');
  257.   WhereyFix:=WhereY-1;
  258. END;
  259.  
  260.  
  261. PROCEDURE gotoxy(x,y : byte);
  262. BEGIN
  263.   write(#27,'[',y,';',x,'H');
  264. END;
  265.  
  266. FUNCTION wherex : byte;
  267. VAR
  268.   r:registers;
  269. BEGIN
  270.   r.ah  :=  3;
  271.   r.bh  :=  0;
  272.   intr($10,r);
  273.   wherex  :=  r.dl+1;
  274. END;
  275.  
  276.  
  277. FUNCTION WhereY : byte;
  278. VAR
  279.   r:registers;
  280. BEGIN
  281.   r.ah  :=  3;
  282.   r.bh  :=  0;
  283.   intr($10,r);
  284.   wherey  :=  r.dh-WhereYFix+1;
  285. END;
  286.  
  287.  
  288. PROCEDURE WriteScreen(s:string; x,y,at:integer);
  289. VAR
  290.   i:integer;
  291. BEGIN
  292.   i:=x;
  293.   WHILE (i<80) AND (i-x+1<=length(s)) DO
  294.   WITH disp^[y+whereyfix][i] DO
  295.   BEGIN
  296.     c:=s[i-x+1];
  297.     a:=at;
  298.     inc(i);
  299.   END;
  300. END;
  301.  
  302.  
  303. PROCEDURE ReadScreen(VAR s:string; x,y:integer);
  304. VAR
  305.   i:integer;
  306. BEGIN
  307.   s:='';
  308.   FOR i:=x TO 80 DO
  309.     s:=s+disp^[y][i].c;
  310. END;
  311.  
  312. PROCEDURE pausescr;
  313. VAR
  314.   ch:char;
  315. BEGIN
  316.   ansic('3'); prompt(PausePrompt);
  317.   Prompt(#27'['+cstr(lengthw(PausePrompt))+'D');
  318.   REPEAT UNTIL keypressed;
  319.   ch:=readkey;
  320.   clreol;
  321. END;
  322.  
  323. PROCEDURE Redisplay;
  324. { This updates the physical display, does a pretty good job of not doing
  325.   more than it has to, but occasionally does...                          }
  326. VAR
  327.   y, i   : integer;
  328.   p      : integer;
  329.   Shorter: boolean;
  330.   cc     : char;
  331.   vp, py : integer;
  332.  
  333. BEGIN
  334.   cc := DisplayColor;
  335.   FOR y := ViewTop TO ViewBottom DO
  336.   IF y <= MaxLines THEN                             { If its a legal line and }
  337.   IF (Line[y]^.l <> screen[y - ViewTop + 1].l) OR   { either the color or text}
  338.      (Line[y]^.c <> screen[y - viewtop + 1].c) THEN { has changed, then       }
  339.   BEGIN                                             { display the changes     }
  340.     vp := y - ViewTop + 1;          { The line corresponding to y in Screen[] }
  341.     py := y + WindowTop - ViewTop;                  { The physical screen line}
  342.     shorter:=length(Screen[vp].l) > length(Line[y]^.l);       { used later on }
  343.     p := firstdiff(screen[vp], Line[y]^);           { Find position of first  }
  344.     FOR i := p TO len(y) DO                         { difference and then     }
  345.     BEGIN                                           { continue checking until }
  346.       IF (i > length(Screen[vp].l)) OR              { EOL is reached          }
  347.          (character(y,i) <> Screen[vp].l[i]) OR
  348.          (Color(Line[y]^,i) <> Color(Screen[vp],i)) THEN
  349.       BEGIN                                         { If character is different}
  350.         IF NOT ((wherex = i) and (wherey = py)) THEN{ reposition as needed    }
  351.            gotoxy(i,py);
  352.         IF cc <> Color(Line[y]^,i) THEN             { change color if needed  }
  353.         BEGIN
  354.           ansic(Line[y]^.c[i]);
  355.           cc := Color(Line[y]^,i);
  356.         END;
  357.         IF character(y,i) IN [#32..#255]            { write character }
  358.           THEN write(character(y,i))
  359.           ELSE WriteControl(character(y,i));
  360.       END;
  361.     END; { for loop }
  362.     IF shorter THEN                         { If the line is shorter }
  363.     BEGIN
  364.       IF (wherex <> len(y) + 1) OR (wherey <> py) THEN
  365.         gotoxy(len(y) + 1, py);             { move to the end of it }
  366.       cc:='0';                              { Set Color to 0 }
  367.       Ansic('0');                           { Clear to end of line }
  368.       clreol;
  369.     END;
  370.     screen[vp] := Line[y]^;                 { update screen array }
  371.   END;
  372.   IF DisplayColor <> CurrentColor THEN      { Change color if needed }
  373.     Ansic(currentColor);
  374.   IF NOT ((wherex=cx) AND                   { reposition if needed }
  375.           (Wherey=cy+WindowTop-ViewTop)) THEN
  376.     gotoxy(cx,cy+WindowTop-ViewTop);
  377. END;
  378.  
  379.  
  380. PROCEDURE ForcedRedisplay;
  381. { This will make sure that the screen is redisplayed }
  382. VAR x:integer;
  383. BEGIN
  384.   ansic('0');
  385.   FOR x:=1 TO MaxPhyLines DO
  386.     initline(screen[x]);
  387.   clrscr;
  388.   ShowHeader;
  389.   Redisplay;
  390. END;
  391.  
  392. PROCEDURE ShowHeader;
  393. { Prints the message header and also the Max Lines }
  394. VAR i:integer;
  395. BEGIN
  396.   ShowMaxLines;
  397.   IF ScreenState IN [0,2] THEN
  398.   BEGIN
  399.     gotoxy(1,1);
  400.     clreol;  print(C2+'Title '+C1+': '+copy(Title,1,70)+C0);
  401.     IF ScreenState=0 THEN BEGIN
  402.       clreol;  print(C2+'Dest  '+C1+': '+copy(destination,1,70)+C0);
  403.       clreol; prompt(C2+'Time  '+C1+': '+time);
  404.       gotoxy(40,wherey);
  405.       print(C2+'ESC'+C5+' to Save, '+C2+'CTRL-O'+C5+' for Help'+C0);
  406.     END;
  407.     clreol;
  408.     prompt('[');
  409.     FOR i:=2 TO LineLen-1 DO
  410.       IF i mod 10=0 THEN prompt(chr(i div 10+ord('0')))
  411.         ELSE IF i mod 5 =0 THEN prompt('|')
  412.           ELSE prompt('.');
  413.     print(']');
  414.   END;
  415. END;
  416.  
  417. PROCEDURE ShowMaxLines;
  418. VAR s:string;
  419. BEGIN
  420.   s:=C7+'Max Lines '+C1+': '+cstr(MaxLines)+'  '+C4;
  421.   IF InsertMode THEN s:=s+'Insert Mode' ELSE s:=s+'Overwrite Mode';
  422.   StatusLine2(s+C0);
  423.   IF Info.username <> '' THEN
  424.     WriteScreen(Info.UserName+'  '+thisuser.name+' #'+
  425.       cstr(usernum),WhereX+2,Wherey,7);
  426. END;
  427.  
  428. PROCEDURE StatusLine1(s:string);
  429. VAR wx,wy:integer;
  430. BEGIN
  431.   wx:=WhereX; wy:=Wherey;
  432.   gotoxy(1,WindowBottom+2);
  433.   clreol; prompt(s);
  434.   Gotoxy(wx,wy);
  435. END;
  436.  
  437. PROCEDURE StatusLine2(s:string);
  438. BEGIN
  439.   Gotoxy(1,WindowBottom+2);
  440.   clreol; prompt(s);
  441. END;
  442.  
  443. PROCEDURE StatusLine3(s:string);
  444. BEGIN
  445.   Gotoxy(1,WindowBottom+1);
  446.   clreol; prompt(s);
  447. END;
  448. VAR
  449.  savep_sx,savep_sy : byte;
  450. PROCEDURE SaveP;
  451. BEGIN
  452.   savep_sx:=wherex;
  453.   Savep_sy:=wherey;
  454. END;
  455. PROCEDURE RestoreP;
  456. BEGIN
  457.   Gotoxy(savep_sx,savep_sy);
  458. END;
  459.  
  460. PROCEDURE PrintControlLine(s:string);
  461. VAR i:integer;
  462. BEGIN
  463.   ansic('0');
  464.   FOR i:=1 TO length(s) DO
  465.     IF s[i] IN [#32..#255]
  466.       THEN write(s[i])
  467.       ELSE WriteControl(s[i]);
  468. END;
  469.  
  470.  
  471. {$F+} PROCEDURE ClrStatLine3; BEGIN SaveP; StatusLine3(C0); AfterNext:=DoNothing; RestoreP END; {$F+}
  472. {$F+} PROCEDURE ClrStatLine2; BEGIN SaveP; StatusLine2(C0); AfterNext:=DoNothing; RestoreP END; {$F+}
  473.  
  474.  
  475. VAR
  476.   i : integer;
  477.  
  478. BEGIN
  479.   Blinking:=False;
  480.   disp:=ptr($B800,0);
  481.   whereyfix:=0;
  482.   FOR i:=1 TO ParamCount DO
  483.     IF TransformString(ParamStr(i))='/MONO' THEN disp:=ptr($B000,0);
  484.   PausePrompt:='[PAUSE]';
  485. END.