home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / PRINTTXT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-07  |  6KB  |  179 lines
  1. procedure printtext (sector:integer);
  2. var q:message;
  3.     x,bub,done:boolean;
  4.     n,m,t,w,b,y,mm,i,apexiscool,e:integer;
  5.     p:byte;
  6.     s,a,cornerstone,sunbane:string;
  7.     cs,css,keithmillerisafag:char;
  8.     kay,thegog:char;
  9. begin
  10.   reloadtext (sector,q);
  11.   writeln (^B);
  12.   n:=1;
  13.   repeat
  14.    mm:=0;
  15.    repeat
  16.     if length(q.text[n])>0 then begin
  17.     p:=0;
  18.     mm:=mm+1;
  19.     s:=copy(q.text[n],mm,1);
  20.     if s='|' then p:=mm
  21.      else p:=0;
  22.     if p>0 then begin
  23.      cornerstone:=copy(q.text[n],p+1,1);
  24.      sunbane:=copy(q.text[n],p+2,1);
  25.      a:=(upcase(cornerstone[1]))+(upcase(sunbane[1]));
  26.      if
  27.       (a='00') or (a='01') or (a='02') or (a='03') or (a='04') or (a='05') or
  28.       (a='06') or (a='07') or (a='08') or (a='09') or (a='10') or (a='11') or
  29.       (a='12') or (a='13') or (a='14') or (a='15') or (a='16') or (a='17') or
  30.       (a='18') or (a='19') or (a='20') or (a='21') or (a='22') or (a='23') or
  31.       (a='KE') or (a='UN') or (a='CL') or (a='TI') or (a='DA'){ or (a='B0') or
  32.       (a='B1') or (a='B2') or (a='B3') or (a='B4') or (a='B5') or (a='B6') or
  33.       (a='B7')} or ((a[1]='P') and (valu(a[2])>0))
  34.       then begin
  35.       if
  36.       (a='00') or (a='01') or (a='02') or (a='03') or (a='04') or (a='05') or
  37.       (a='06') or (a='07') or (a='08') or (a='09') or (a='10') or (a='11') or
  38.       (a='12') or (a='13') or (a='14') or (a='15') or (a='16') or (a='17') or
  39.       (a='18') or (a='19') or (a='20') or (a='21') or (a='22') or (a='23') then
  40.      begin
  41.       delete (q.text[n],p+1,2);
  42.       b:=valu(a);
  43.       case b of
  44.        16:case curattrib of
  45.            0..15:b:=curattrib;
  46.            16..31:b:=curattrib-16;
  47.            32..47:b:=curattrib-32;
  48.            48..63:b:=curattrib-48;
  49.            64..79:b:=curattrib-64;
  50.            80..95:b:=curattrib-80;
  51.            96..111:b:=curattrib-96;
  52.            112..127:b:=curattrib-111;
  53.           end;
  54.        17:case curattrib of
  55.            0..15:b:=curattrib+16;
  56.            16..31:b:=curattrib;
  57.            32..47:b:=curattrib-16;
  58.            48..63:b:=curattrib-32;
  59.            64..79:b:=curattrib-48;
  60.            80..95:b:=curattrib-64;
  61.            96..111:b:=curattrib-80;
  62.            112..127:b:=curattrib-96;
  63.           end;
  64.        18:case curattrib of
  65.            0..15:b:=curattrib+32;
  66.            16..31:b:=curattrib+16;
  67.            32..47:b:=curattrib;
  68.            48..63:b:=curattrib-16;
  69.            64..79:b:=curattrib-32;
  70.            80..95:b:=curattrib-48;
  71.            96..111:b:=curattrib-64;
  72.            112..127:b:=curattrib-80;
  73.           end;
  74.        19:case curattrib of
  75.            0..15:b:=curattrib+48;
  76.            16..31:b:=curattrib+32;
  77.            32..47:b:=curattrib+16;
  78.            48..63:b:=curattrib;
  79.            64..79:b:=curattrib-16;
  80.            80..95:b:=curattrib-32;
  81.            96..111:b:=curattrib-48;
  82.            112..127:b:=curattrib-64;
  83.           end;
  84.        20:case curattrib of
  85.            0..15:b:=curattrib+64;
  86.            16..31:b:=curattrib+48;
  87.            32..47:b:=curattrib+32;
  88.            48..63:b:=curattrib+16;
  89.            64..79:b:=curattrib;
  90.            80..95:b:=curattrib-16;
  91.            96..111:b:=curattrib-32;
  92.            112..127:b:=curattrib-48;
  93.           end;
  94.        21:case curattrib of
  95.            0..15:b:=curattrib+80;
  96.            16..31:b:=curattrib+64;
  97.            32..47:b:=curattrib+48;
  98.            48..63:b:=curattrib+32;
  99.            64..79:b:=curattrib+16;
  100.            80..95:b:=curattrib;
  101.            96..111:b:=curattrib-16;
  102.            112..127:b:=curattrib-32;
  103.           end;
  104.        22:case curattrib of
  105.            0..15:b:=curattrib+96;
  106.            16..31:b:=curattrib+80;
  107.            32..47:b:=curattrib+64;
  108.            48..63:b:=curattrib+48;
  109.            64..79:b:=curattrib+32;
  110.            80..95:b:=curattrib+16;
  111.            96..111:b:=curattrib;
  112.            112..127:b:=curattrib-16;
  113.           end;
  114.        23:case curattrib of
  115.            0..15:b:=curattrib+111;
  116.            16..31:b:=curattrib+96;
  117.            32..47:b:=curattrib+80;
  118.            48..63:b:=curattrib+64;
  119.            64..79:b:=curattrib+48;
  120.            80..95:b:=curattrib+32;
  121.            96..111:b:=curattrib+16;
  122.            112..127:b:=curattrib;
  123.           end;
  124.         end;
  125.       if b=0 then ansicolor (0);
  126.       if (b<>0) then ansicolor (b);
  127.      end;
  128.      end;
  129.      if a='KE' then
  130.      begin
  131.       delete (q.text[n],p+1,1);
  132.       delete (q.text[n],p+1,1);
  133.       write ('*');
  134.       getstr (2);
  135.      end;
  136.      if a='UN' then
  137.      begin
  138.       delete (q.text[n],p+1,1);
  139.       delete (q.text[n],p+1,1);
  140.       write (urec.handle);
  141.      end;
  142.      if a='TI' then
  143.      begin
  144.       delete (q.text[n],p+1,1);
  145.       delete (q.text[n],p+1,1);
  146.       write (timestr(now));
  147.      end;
  148.      if a='DA' then
  149.      begin
  150.       delete (q.text[n],p+1,1);
  151.       delete (q.text[n],p+1,1);
  152.       write (datestr(now));
  153.      end;
  154.      if a='CL' then
  155.      begin
  156.       delete (q.text[n],p+1,1);
  157.       delete (q.text[n],p+1,1);
  158.       if (ansigraphics in urec.config) then write (#27+'[2J') else
  159.        write (^L);
  160.      end;
  161.      if ((a[1]='P') and (valu(a[2])>0)) then
  162.      begin
  163.       delete (q.text[n],p+1,1);
  164.       delete (q.text[n],p+1,1);
  165.       apexiscool:=valu(a[2]);
  166.       delay (apexiscool*1000);
  167.      end;
  168.    end else write (s);
  169.   end;
  170.   until mm=length(q.text[n]);
  171.    writeln;
  172.    n:=n+1;
  173.   until break or (n>q.numlines) or hungupon;
  174.   x:=xpressed; bub:=break;
  175.   writeln (^B^M);
  176.   xpressed:=x; break:=bub;
  177.   ansicolor (urec.regularcolor)
  178. end;
  179.