home *** CD-ROM | disk | FTP | other *** search
/ Falcon 030 Power 2 / F030_POWER2.iso / ST_STE / MAGS / ICTARI10.ARJ / ictari.10 / PASCAL / PIPEMON / PIPE_MON.PAS next >
Pascal/Delphi Source File  |  1993-12-26  |  11KB  |  409 lines
  1. {compile with all checks off and linker 4 4 4 10}
  2.  
  3. PROGRAM davis_window_thing;
  4. USES gemaes, gemdecl, gemvdi, printer, bios, dos;
  5. TYPE
  6.   pipearray                   = array [0..7] OF integer;
  7.  
  8. CONST
  9.   elements                    = 4095;
  10.   strnlen                     = 120;
  11.   max_elements                = 50;
  12.   wh            : integer     = -1;
  13.   acchandle     : integer     = -1;
  14.   aeshandle     : integer     = -1;
  15.   vdihandle     : integer     = -1;
  16.   charw         : integer     = 0;
  17.   charh         : integer     = 0;
  18.   charbw        : integer     = 0;
  19.   charbh        : integer     = 0;
  20.   minx          : integer     = 0;
  21.   miny          : integer     = 0;
  22.   maxw          : integer     = 0;
  23.   maxh          : integer     = 0;
  24.   atpos         : integer     = 0;
  25.   atelement     : integer     = 0;
  26.   winx          : integer     = 50;
  27.   winy          : integer     = 50;
  28.   winw          : integer     = 150;
  29.   winh          : integer     = 100;
  30.   accname       : string[17]  = '  Pipe Monitor'#00#00;
  31.   winname       : string[15]  = 'Pipe Monitor'#00#00;
  32.   wininfo       : string[50]  = '  By David Gunby | At : 0'#00#00;
  33.   filt          : boolean     = FALSE;
  34.  
  35. VAR
  36.   big_array     : packed array[0..max_elements, 0..7] OF integer;
  37.   pipe          : pipearray;
  38.  
  39. PROCEDURE alert (s  : string);
  40. BEGIN
  41.   s:='[3]['+s+'][  OK  ]';
  42.   IF FORM_ALERT (1, s[1])=3 THEN ;
  43. END;
  44.  
  45. PROCEDURE tidyup;
  46. BEGIN
  47.   IF wh>=0 THEN
  48.   BEGIN
  49.     WIND_CLOSE (wh);
  50.     WIND_DELETE (wh);
  51.   END;
  52.   wh:=-1;
  53. END;
  54.  
  55. PROCEDURE termchain;
  56. BEGIN
  57.   tidyup;
  58.   V_CLSVWK (vdihandle);
  59.   APPL_EXIT;
  60. END;
  61.  
  62. PROCEDURE setup;
  63. VAR
  64.   n               : byte;
  65.   workin          : intin_array;
  66.   workout         : workout_array;
  67. BEGIN
  68.   FOR n:=0 TO 50 DO
  69.     FOR workin[0]:=0 TO 7 DO
  70.       big_array[n, workin[0]]:=0;
  71.   aeshandle:=APPL_INIT;
  72.   vdihandle:=graf_handle (charw, charh, charbw, charbh);
  73.   FOR n:=0 TO 9 DO
  74.     workin[n]:=1;
  75.   workin[10]:=2;
  76.   V_OPNVWK (workin, vdihandle, workout);
  77.   WIND_GET (0, WF_FULLXYWH, minx, miny, maxw, maxh);
  78. END;
  79.  
  80. PROCEDURE setslidersize;
  81. VAR
  82.   hsize, hat, wsize, wat,
  83.   x, y, w, h        : integer;
  84. BEGIN
  85.   WIND_CALC (1, elements, winx, winy, winw, winh, x, y, w, h);
  86.   hsize:=MIN (1000, ROUND (1000*(w / charw) / strnlen));
  87.   wsize:=MIN (1000, ROUND (1000*(h / charh) / max_elements));
  88.   WIND_SET (wh, WF_HSLSIZE, hsize, 0, 0, 0);
  89.   WIND_SET (wh, WF_VSLSIZE, wsize, 0, 0, 0);
  90.   IF atpos<>0 THEN
  91.     wat:=ROUND (1000*((atpos)/(strnlen-(w DIV charw))))
  92.   ELSE
  93.     wat:=0;
  94.   IF atelement<>0 THEN
  95.     hat:=ROUND (1000*((atelement)/(max_elements-(h DIV charh))))
  96.   ELSE
  97.     hat:=0;
  98.   WIND_SET (wh, WF_HSLIDE, wat, 0, 0, 0);
  99.   WIND_SET (wh, WF_VSLIDE, hat, 0, 0, 0);
  100. END;
  101.  
  102. FUNCTION strf (l  : integer)  : string;
  103. VAR
  104.   s               : string[10];
  105. BEGIN
  106.   STR (l:4, s);
  107.   strf:=s;
  108. END;
  109.  
  110. FUNCTION getline (atline : integer)  : string;
  111. VAR
  112.   m                   : integer;
  113.   linestr             : string;
  114. BEGIN
  115.   linestr:=' '+strf (atline);
  116.   FOR m:=0 TO 7 DO
  117.     linestr:=linestr+' | '+strf (m)+' : '+strf (big_array[atline, m]);
  118.   linestr:=linestr+#0+#0;
  119.   getline:=linestr;
  120. END;
  121.  
  122. PROCEDURE doredraw (w : integer);
  123. VAR
  124.   b1, b2        : grect;
  125.   a             : array_4;
  126.   atline,
  127.   n             : integer;
  128.   linestr       : string;
  129. BEGIN
  130.   WIND_UPDATE (BEG_UPDATE);
  131.   GRAF_MOUSE (M_OFF, NIL);
  132.   b1.x:=pipe[4];
  133.   b1.y:=pipe[5];
  134.   b1.w:=pipe[6];
  135.   b1.h:=pipe[7];
  136.   VSF_COLOR (vdihandle, WHITE);
  137.   VSF_STYLE (vdihandle, SOLID);
  138.   WIND_GET (wh, WF_FIRSTXYWH, b2.x, b2.y, b2.w, b2.h);
  139.   WHILE (b2.w<>0) AND (b2.h<>0) DO
  140.   BEGIN
  141.     IF intersect (b1, b2) THEN
  142.     BEGIN
  143.       a[0]:=b2.x;
  144.       a[1]:=b2.y;
  145.       a[2]:=b2.x+b2.w-1;
  146.       a[3]:=b2.y+b2.h-1;
  147.       VS_CLIP (vdihandle, 1, a);
  148.       V_BAR (vdihandle, a); 
  149.       n:=b2.y+charbh;
  150.       atline:=ROUND (atelement +((b2.y-(winy+(2*charh))) / charh))-1;
  151.       INC (b2.h, charh);
  152.       REPEAT
  153.         IF atline<=max_elements THEN
  154.         BEGIN 
  155.           linestr:=getline (atline);
  156.           V_GTEXT (vdihandle, (b2.x DIV charw)*charw, ((n-1) DIV charh)*charh , 
  157.             COPY (linestr, (atpos+((b1.x-winx) DIV charw))+1, (b2.w DIV charw)+1));
  158.         END;
  159.         INC (atline);
  160.         INC (n, charh);
  161.       UNTIL n>b2.y+b2.h;
  162.     END;
  163.     WIND_GET (wh, WF_NEXTXYWH, b2.x, b2.y, b2.w, b2.h);
  164.   END;  
  165.   GRAF_MOUSE (M_ON, NIL);
  166.   WIND_UPDATE (END_UPDATE);
  167. END;
  168.  
  169. PROCEDURE send_redraw;
  170. BEGIN
  171.   pipe[0]:=WM_REDRAW;
  172.   pipe[3]:=wh;
  173.   pipe[4]:=winx;
  174.   pipe[5]:=winy;
  175.   pipe[6]:=winw;
  176.   pipe[7]:=winh;
  177.   APPL_WRITE (aeshandle, SIZEOF (pipe), pipe);
  178. END;
  179.  
  180. PROCEDURE openwindow;
  181. BEGIN
  182.   IF wh<0 THEN
  183.   BEGIN
  184.     wh:=WIND_CREATE (elements, minx, miny, maxw, maxh);
  185.     IF wh>=0 THEN
  186.     BEGIN
  187.       WIND_SET (wh, WF_NAME, HIPTR (winname[1]), LOPTR (winname[1]), 0, 0);
  188.       WIND_SET (wh, WF_INFO, HIPTR (wininfo[1]), LOPTR (wininfo[1]), 0, 0);
  189.       setslidersize;
  190.       WIND_OPEN (wh, winx, winy, winw, winh);
  191.     END ELSE alert ('||Window Creation error');
  192.   END ELSE   
  193.     send_redraw;
  194. END;
  195.  
  196. PROCEDURE window (x, y, w, h  : integer);
  197. BEGIN
  198.   winx:=((x DIV charw) *charw)+2;
  199.   winy:=((y DIV charh) *charh)+2;
  200.   winw:=w;
  201.   winh:=h;
  202.   WIND_SET (wh, WF_CURRXYWH, winx, winy, w, h);
  203.   setslidersize;
  204. END;
  205.  
  206. PROCEDURE full_window;
  207. VAR
  208.   x, y, w, h            : integer;
  209. BEGIN
  210.   WIND_GET (wh, WF_CURRXYWH, x, y, w, h);
  211.   IF (x<>minx) OR (y<>miny) OR (w<>maxw) OR (h<>maxh) THEN
  212.     window (minx, miny, maxw, maxh)
  213.   ELSE BEGIN
  214.     WIND_GET (wh, WF_PREVXYWH, x, y, w, h);
  215.     window (x, y, w, h);
  216.   END;
  217. END;
  218.  
  219. PROCEDURE hslidtopos;
  220. VAR
  221.   x, y, w, h        : integer;
  222. BEGIN
  223.   WIND_CALC (1, elements, winx, winy, winw, winh, x, y, w, h);
  224.   atpos:=ROUND ((pipe[4] / 1000)*(strnlen-(w DIV charw)));
  225.   WIND_SET (wh, WF_HSLIDE, pipe[4], 0, 0, 0);
  226.   send_redraw;
  227. END;
  228.  
  229. PROCEDURE vslidtopos;
  230. VAR
  231.   x, y, w, h        : integer;
  232. BEGIN
  233.   WIND_CALC (1, elements, winx, winy, winw, winh, x, y, w, h);
  234.   atelement:=ROUND ((pipe[4] / 1000)*(max_elements-(h DIV charh)+1));
  235.   WIND_SET (wh, WF_VSLIDE, pipe[4], 0, 0, 0);
  236.   send_redraw;
  237. END;
  238.  
  239. PROCEDURE doarrows;
  240. VAR
  241.   ph, pw          : integer;
  242. BEGIN
  243.   ph:=((winh-(3*charbh)) DIV charh);
  244.   pw:=(winw-(2*charbw)) DIV charw;
  245.   CASE pipe[4] OF
  246.     1 : atelement:=MIN (atelement+ph, max_elements-ph+1);
  247.     0 : atelement:=MAX (0, atelement-ph);
  248.     3 : atelement:=MIN (atelement+1, max_elements-ph+1);
  249.     2 : atelement:=MAX (0, atelement-1);
  250.     5 : atpos:=MIN (atpos+pw, strnlen-pw);
  251.     4 : atpos:=MAX (atpos-pw, 0);
  252.     7 : atpos:=MIN (atpos+1, strnlen-pw);
  253.     6 : atpos:=MAX (atpos-1, 0);
  254.   END;
  255.   setslidersize;
  256.   send_redraw;
  257. END;
  258.  
  259. PROCEDURE specdraw(w  : integer);
  260. BEGIN
  261.   pipe[3]:=wh;
  262.   pipe[4]:=winx;
  263.   pipe[5]:=winy+(w*charh);
  264.   pipe[6]:=winw;
  265.   pipe[7]:=charh;
  266.   doredraw (w);
  267. END;
  268.  
  269. PROCEDURE topwindow;
  270. VAR
  271.   n, m              : integer;
  272. BEGIN
  273.   WIND_SET (wh, WF_TOP, winx, winy, winw, winh);
  274. END;
  275.  
  276. PROCEDURE doclipboard;
  277. VAR
  278.   myfile            : text;
  279.   s                 : string;
  280.   m                 : integer;
  281.   ok                : searchrec;
  282. BEGIN
  283.   SCRP_READ (s[1]);
  284.   m:=1;
  285.   REPEAT
  286.     s[0]:=CHAR (m);
  287.     INC (m);
  288.   UNTIL s[m]=#0;
  289.   IF s='' THEN s:='A:\SCRAP'+#0;
  290.   IF (DRVMAP AND 4)=4 THEN s[1]:='C';
  291.   SCRP_WRITE (s[1]);
  292.   FINDFIRST (s, $10, ok);
  293.   IF DOSERROR<>0 THEN MKDIR (s);
  294.   IF s[LENGTH (s)]<>'\' THEN s:=s+'\';
  295.   FINDFIRST (s+'SCRAP.*', $27, ok);
  296.   WHILE DOSERROR=0 DO
  297.   BEGIN
  298.     ERASE (s+ok.name);
  299.     FINDNEXT (ok);
  300.   END;
  301.   ASSIGN (myfile, s+'SCRAP.TXT');
  302.   REWRITE (myfile);
  303.   FOR m:=0 TO max_elements DO
  304.     WRITELN (myfile, getline (m));
  305.   CLOSE (myfile);
  306. END;
  307.  
  308. PROCEDURE acopen;
  309. VAR
  310.   s           : string;
  311.   n, m        : integer;
  312. BEGIN
  313.   openwindow;
  314.   s:='[1][    Pipe Monitor|   By David Gunby|(in HighSpeed Pascal)][  OK  | MORE ]'#0#0;
  315.   n:=FORM_ALERT (2, s[1]);
  316.   IF n=1 THEN EXIT;
  317.   alert ('|David Gunby, 12 Windrush Drive|Oadby, Leiceste,LE2 4GH');
  318.   s:='[2][||Filter Shaping Messages][ Yes | No ]'+#0+#0;
  319.   n:=FORM_ALERT (1, s[1]);
  320.   IF n=1 THEN filt:=TRUE ELSE filt:=FALSE;
  321.   s:='[2][||Output To Which Device][ Printer | ClipBoard | Non ]'+#0+#0;
  322.   n:=FORM_ALERT (1, s[1]);
  323.   IF (n=1) THEN FOR m:=0 TO max_elements DO
  324.                   WRITELN (lst, getline (m));
  325.   IF (n=2) THEN doclipboard;     
  326. END;
  327.  
  328. PROCEDURE evnt_mesag (VAR pipe : pipearray);
  329. VAR
  330.   k, rt, d            : integer;
  331. BEGIN
  332.   REPEAT
  333.     pipe[0]:=32123;
  334.     pipe[4]:=32123;
  335.     WIND_GET (0, WF_TOP, k, rt, rt, rt);
  336.     IF k=wh THEN d:=17 ELSE d:=16;
  337.     rt:=EVNT_MULTI (d, 0, 0, 0, 0, 0, 0, 0, 0, 
  338.                     0, 0, 0, 0, 0, pipe, 0, 0, 
  339.                     d, d, d, d, k, d);
  340.     IF (rt=1) THEN
  341.     BEGIN
  342.       CASE k OF
  343.         $6200 : pipe[0]:=AC_OPEN;
  344.         24832 : pipe[0]:=AC_CLOSE;
  345.         $4800 : pipe[4]:=2;
  346.         $5000 : pipe[4]:=3;
  347.         $4b00 : pipe[4]:=6;
  348.         $4d00 : pipe[4]:=7;
  349.       END;
  350.       IF pipe[4]<>32123 THEN pipe[0]:=WM_ARROWED;
  351.     END;
  352.   UNTIL pipe[0]<>32123;
  353. END;
  354.  
  355. PROCEDURE domainloop;
  356. VAR
  357.   n, w, o         : byte;
  358.   byebye          : boolean;
  359. BEGIN
  360.   REPEAT
  361.     byebye:=FALSE;
  362.     o:=w;
  363.     evnt_mesag (pipe);
  364.     IF (NOT (filt)) OR (NOT (pipe[0] in [20..28])) THEN 
  365.     BEGIN
  366.       w:=(w+1) MOD (max_elements);
  367.       FOR n:=0 TO 7 DO
  368.         big_array [w, n]:=pipe[n];
  369.     END;
  370.     CASE pipe[0] OF
  371.       MN_SELECTED : ;
  372.       WM_FULLED   : full_window;
  373.       WM_REDRAW   : doredraw (w);
  374.       WM_ARROWED  : doarrows;
  375.       WM_HSLID    : hslidtopos;
  376.       WM_VSLID    : vslidtopos;
  377.       WM_MOVED,
  378.       WM_SIZED    : window (pipe[4], pipe[5], pipe[6], pipe[7]);
  379.       WM_TOPPED   : topwindow;
  380.       AC_OPEN     : acopen;
  381.       30,
  382.       33          : WIND_SET (wh, 25, winx, winy, winw, winh);
  383.       WM_CLOSED,
  384.       AC_CLOSE    : IF APPFLAG THEN byebye:=TRUE ELSE tidyup;
  385.     END;
  386.     IF o<>w THEN
  387.     BEGIN
  388.       IF w in [atelement..atelement+(winh DIV charh)] THEN specdraw (w+2);
  389.       REPEAT
  390.         wininfo[0]:=PRED (wininfo[0]);
  391.       UNTIL wininfo[LENGTH(wininfo)]=':';
  392.       wininfo:=wininfo+strf (w)+#0+#0;
  393.       WIND_SET (wh, WF_INFO, HIPTR (wininfo[1]), LOPTR (wininfo[1]), 0, 0);
  394.     END;
  395.   UNTIL byebye=TRUE;
  396. END;
  397.  
  398. BEGIN
  399.   GRAF_MOUSE (2, NIL);
  400.   setup;
  401.   IF APPFLAG THEN 
  402.   BEGIN
  403.     wininfo:=' Press HELP | '+wininfo;
  404.     openwindow
  405.   END ELSE acchandle:=menu_register (aeshandle, accname[1]);
  406.   GRAF_MOUSE (0, NIL);
  407.   domainloop;
  408.   termchain;
  409. END.