home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / COMM / CTA6_SRC.ZIP / RipParse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-01-20  |  12.3 KB  |  314 lines
  1. unit RipParse;
  2.  
  3. {
  4. Shawn - Another unit I borrowed from Swag too... lost the original
  5. author of the unit but the name was Ripsee.
  6. Thanks whoever you are
  7. }
  8.  
  9. interface
  10.  
  11. function Display_Rip(ch : char) : boolean;
  12.  
  13. implementation
  14.  
  15. Uses Main, sysutils, VGAGlobal;
  16.  
  17. CONST Place : ARRAY [1..5] OF LONGINT = (1, 36, 1296, 46656, 1679616);
  18.       Seq = ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');
  19.  
  20. VAR
  21.   ccol : INTEGER;
  22.   Clipboard : POINTER;
  23.   LLL : INTEGER;
  24.   command : STRING;
  25.   bslash : BOOLEAN;
  26.   ButtonColor : integer;
  27.   RipEsc      : byte;
  28.  
  29. FUNCTION Convert (SS : STRING) : LONGINT;
  30. VAR PrLoop, Counter : INTEGER;
  31.     CA, Tag : LONGINT;
  32. BEGIN
  33.   IF LENGTH (ss) = 1 THEN ss := '0' + ss;
  34.   Counter := 0; CA := 0;
  35.   FOR PrLoop := LENGTH (SS) DOWNTO 1 DO BEGIN
  36.     Counter := Counter + 1;
  37.     Tag := POS (SS [PrLoop], Seq) - 1;
  38.     CA := CA + (Tag * Place [Counter]);
  39.   END;
  40.   Convert := CA;
  41. END;
  42.  
  43. PROCEDURE ResetWindows;
  44. BEGIN
  45.   {SETVIEWPORT (0, 0, GETMAXX, GETMAXY, ClipOn);
  46.   CLEARDEVICE;
  47.   IF clipboard <> NIL THEN DISPOSE (clipboard);
  48.   clipboard := NIL;}
  49.   MF.VgaEmu1.ClearDevice;
  50.   MF.ClearAreas;
  51. END;
  52.  
  53. PROCEDURE usersetf;
  54. VAR ii, jj : INTEGER;
  55.     zz : FillPatternType;
  56. BEGIN
  57.   jj := 0;
  58.   FOR ii := 1 TO 8 DO BEGIN
  59.     jj := jj + 2;
  60.     zz [ii] := Convert (COPY (command, jj, 2) );
  61.   END;
  62. //  SETFILLPATTERN (zz, Convert (COPY (command, 18, 2) ) );
  63. END;
  64.  
  65. PROCEDURE DPoly (fillit, ifpoly : BOOLEAN; np : INTEGER);
  66. VAR ii, zz, yy : INTEGER;
  67.     poly : ARRAY [1..200] OF PointType;
  68. BEGIN
  69.   ii := 4;
  70.   FOR zz := 1 TO np DO BEGIN
  71.     poly [zz].x := Convert (COPY (command, ii, 2) );
  72.     poly [zz].y := Convert (COPY (command, ii + 2, 2) );
  73.     ii := ii + 4;
  74.   END; IF ifpoly THEN BEGIN
  75.     poly [np + 1] := poly [1];
  76.     IF NOT fillit THEN MF.VgaEmu1.DrawPoly (np + 1, poly) ELSE MF.VgaEmu1.FillPoly (np + 1, poly);
  77.   END ELSE IF NOT fillit THEN MF.VgaEmu1.DrawPoly (np, poly) ELSE MF.VgaEmu1.FillPoly (np, poly);
  78. END;
  79.  
  80. //x0:2 y0:2 x1:2 y1:2 hotkey:2 flags:1 res:1
  81. PROCEDURE Button( x0,y0,x1,y1, hotkey : word; flags, res : byte; Text : string);
  82. var
  83.   lbl,
  84.   cmd : string;
  85.   xpos,
  86.   ypos : integer;
  87. begin
  88.   lbl := copy(text,0,pos('<>',text)-1);
  89.   cmd := copy(text,pos('<>',text)+2, length(text));
  90. //  MF.VgaEmu1.SetColor(ButtonColor);
  91.   MF.VgaEmu1.SetColor(7);
  92.   MF.VgaEmu1.Rectangle( x0,y0,x1,y1);
  93.  
  94.   MF.VgaEmu1.SetColor(15);
  95.   MF.VgaEmu1.MoveTo(X0,Y1);
  96.   MF.VgaEmu1.LineTo(x0,y1);
  97.   MF.VgaEmu1.LineTo(x0,y0);
  98.   MF.VgaEmu1.LineTo(x1,y0);
  99.   MF.VgaEmu1.SetColor(8);
  100.   MF.VgaEmu1.LineTo(x1,y1);
  101.   MF.VgaEmu1.LineTo(x0,y1);
  102.  
  103.   MF.VgaEmu1.SetColor(1);
  104.   xpos := ((x0 + x1) div 2) - ((length(lbl) * 9) div 2);
  105.   ypos := ((y0+y1) div 2) - 3;
  106.   MF.VgaEmu1.OutTextXY( xpos, ypos, lbl);
  107.   MF.AddArea(x0,y0,x1,y1,0,cmd);
  108. end;
  109.  
  110. PROCEDURE ParseCommand (command : STRING);
  111. BEGIN
  112.   IF command = '*' THEN resetwindows;
  113. //  IF command [1] = 'W' THEN SetWriteMode (Convert (COPY (command, 2, 2) ) );
  114. //  IF command [1] = 'S' THEN SETFILLSTYLE (Convert (COPY (command, 2, 2) ),
  115. //                                      Convert (COPY (command, 4, 2) ) );
  116. //  IF command [1] = 'E' THEN CRT.CLEARVIEWPORT;
  117. //  IF command [1] = 'v' THEN SETVIEWPORT (Convert (COPY (command, 2, 2) ),
  118. //                          Convert (COPY (command, 4, 2) ),
  119. //                          Convert (COPY (command, 6, 2) ),
  120. //                          Convert (COPY (command, 8, 2) ), ClipOn);
  121.   IF command [1] = 'c' THEN IF LENGTH (command) = 2 THEN
  122.     BEGIN
  123.       ccol := (POS (command [2], Seq) - 1);
  124.       MF.VgaEmu1.SETCOLOR (ccol);
  125.     END ELSE BEGIN
  126.       ccol := (Convert (COPY (command, 2, 2) ) );
  127.       MF.VgaEmu1.SETCOLOR (ccol);
  128.     END;
  129. //  IF command [1] = 'Y' THEN SETTEXTSTYLE (Convert (COPY (command, 2, 2) ),
  130. //                                      Convert (COPY (command, 4, 2) ),
  131. //                                      Convert (COPY (command, 6, 2) ) );
  132. //  IF command [1] = 's' THEN usersetf;
  133. //  IF command [1] = 'Q' THEN allpalette;
  134.   IF command [1] = '@' THEN MF.VgaEmu1.OUTTEXTXY (Convert (COPY (command, 2, 2) ),
  135.                                    Convert (COPY (command, 4, 2) ),
  136.                                    COPY (command, 6, LENGTH (command) - 5) );
  137.   IF command [1] = 'F' THEN MF.VgaEmu1.FLOODFILL (Convert (COPY (command, 2, 2) ),
  138.                           Convert (COPY (command, 4, 2) ),
  139.                           Convert (COPY (command, 6, 2) ) );
  140.   IF command [1] = 'C' THEN MF.VgaEmu1.CIRCLE (Convert (COPY (command, 2, 2) ),
  141.                           Convert (COPY (command, 4, 2) ),
  142.                           Convert (COPY (command, 6, 2) ) );
  143.   IF command [1] = 'B' THEN MF.VgaEmu1.BAR (Convert (COPY (command, 2, 2) ),
  144.                           Convert (COPY (command, 4, 2) ),
  145.                           Convert (COPY (command, 6, 2) ),
  146.                           Convert (COPY (command, 8, 2) ) );
  147.   IF command [1] = 'A' THEN MF.VgaEmu1.ARC (Convert (COPY (command, 2, 2) ),
  148.                           Convert (COPY (command, 4, 2) ),
  149.                           Convert (COPY (command, 6, 2) ),
  150.                           Convert (COPY (command, 8, 2) ),
  151.                           Convert (COPY (command, 10, 2) ) );
  152.   IF command [1] = 'I' THEN MF.VgaEmu1.PIESLICE (Convert (COPY (command, 2, 2) ),
  153.                           Convert (COPY (command, 4, 2) ),
  154.                           Convert (COPY (command, 6, 2) ),
  155.                           Convert (COPY (command, 8, 2) ),
  156.                           Convert (COPY (command, 10, 2) ) );
  157.   IF command [1] = 'i' THEN MF.VgaEmu1.Sector (Convert (COPY (command, 2, 2) ),
  158.                           Convert (COPY (command, 4, 2) ),
  159.                           Convert (COPY (command, 6, 2) ),
  160.                           Convert (COPY (command, 8, 2) ),
  161.                           Convert (COPY (command, 10, 2) ),
  162.                           Convert (COPY (command, 12, 2) ) );
  163.   IF command [1] = 'L' THEN MF.VgaEmu1.LINE (Convert (COPY (command, 2, 2) ),
  164.                           Convert (COPY (command, 4, 2) ),
  165.                           Convert (COPY (command, 6, 2) ),
  166.                           Convert (COPY (command, 8, 2) ) );
  167.   IF command [1] = 'R' THEN MF.VgaEmu1.RECTANGLE (Convert (COPY (command, 2, 2) ),
  168.                           Convert (COPY (command, 4, 2) ),
  169.                           Convert (COPY (command, 6, 2) ),
  170.                           Convert (COPY (command, 8, 2) ) );
  171.   IF command [1] = 'o' THEN MF.VgaEmu1.FillEllipse (Convert (COPY (command, 2, 2) ),
  172.                           Convert (COPY (command, 4, 2) ),
  173.                           Convert (COPY (command, 6, 2) ),
  174.                           Convert (COPY (command, 8, 2) ) );
  175. //  IF (command [1] = 'O') OR (command [1] = 'V') THEN
  176. //                          MF.VgaEmu1.ELLIPSE (Convert (COPY (command, 2, 2) ),
  177. //                          Convert (COPY (command, 4, 2) ),
  178. //                          Convert (COPY (command, 6, 2) ),
  179. //                          Convert (COPY (command, 8, 2) ),
  180. //                          Convert (COPY (command, 10, 2) ),
  181. //                          Convert (COPY (command, 12, 2) ) );
  182.   IF command [1] = 'P' THEN Dpoly (FALSE, TRUE, Convert (COPY (command, 2, 2) ) );
  183.   IF command [1] = 'p' THEN Dpoly (TRUE, TRUE, Convert (COPY (command, 2, 2) ) );
  184.   IF command [1] = 'X' THEN MF.VgaEmu1.PUTPIXEL (Convert (COPY (command, 2, 2) ),
  185.                                   Convert (COPY (command, 4, 2) ), ccol);
  186. //  IF command [1] = 'a' THEN SETPALETTE (Convert (COPY (command, 2, 2) ),
  187. //                                    Convert (COPY (command, 4, 2) ) );
  188. //  IF command [1] = '=' THEN SETLINESTYLE (Convert (COPY (command, 2, 2) ),
  189. //                                      Convert (COPY (command, 4, 4) ),
  190. //                                      Convert (COPY (command, 8, 2) ) );
  191.   IF command [1] = 'l' THEN Dpoly (FALSE, FALSE, Convert (COPY (command, 2, 2) ) );
  192.   IF command [1] = 'Z' THEN MF.VgaEmu1.Curve (Convert (COPY (command, 2, 2) ),
  193.                           Convert (COPY (command, 4, 2) ),
  194.                           Convert (COPY (command, 6, 2) ),
  195.                           Convert (COPY (command, 8, 2) ),
  196.                           Convert (COPY (command, 10, 2) ),
  197.                           Convert (COPY (command, 12, 2) ),
  198.                           Convert (COPY (command, 14, 2) ),
  199.                           Convert (COPY (command, 16, 2) ),
  200.                           Convert (COPY (command, 18, 2) ) );
  201.   IF command [1] = '1' THEN BEGIN {level one commands}
  202. //    IF command [2] = 'C' THEN Toclip (Convert (COPY (command, 3, 2) ),
  203. //                                  Convert (COPY (command, 5, 2) ),
  204. //                                  Convert (COPY (command, 7, 2) ),
  205. //                                  Convert (COPY (command, 9, 2) ) );
  206. //    IF (command [2] = 'P') AND (Clipboard <> NIL)
  207. //                               THEN PUTIMAGE (Convert (COPY (command, 3, 2) ),
  208. //                                    Convert (COPY (command, 5, 2) ),
  209. //                                    Clipboard^,
  210. //                                    Convert (COPY (command, 7, 2) ) );
  211. //    IF command [2] = 'I' THEN LoadIcon (Convert (COPY (command, 3, 2) ),
  212. //                                    Convert (COPY (command, 5, 2) ),
  213. //                                    Convert (COPY (command, 7, 2) ),
  214. //                                    Convert (COPY (command, 9, 1) ),
  215. //                                    COPY (command, 12, LENGTH (command) - 11) );
  216. //    IF command [2] = 'G' THEN Scrollgraph (Convert (COPY (command, 3, 2) ),
  217. //                                       Convert (COPY (command, 5, 2) ),
  218. //                                       Convert (COPY (command, 7, 2) ),
  219. //                                       Convert (COPY (command, 9, 2) ),
  220. //                                       Convert (COPY (command, 13, 2) ) );
  221.     IF command[2] = 'K' then MF.ClearAreas;  //Kill mouse fields
  222.     IF command[2] = 'U' then Button( Convert (COPY (command, 3, 2) ),
  223.                                      Convert (COPY (command, 5, 2) ),
  224.                                      Convert (COPY (command, 7, 2) ),
  225.                                      Convert (COPY (command, 9, 2) ),
  226.                                      Convert (COPY (command, 13, 2) ),
  227.                                      Convert (COPY (command, 15, 1) ),
  228.                                      Convert (COPY (command, 16, 1) ),
  229.                                      COPY (command, 17, LENGTH (command) - 16)
  230.                                    );
  231.   END;
  232. END;
  233.  
  234. PROCEDURE Init;
  235. BEGIN
  236.   clipboard := NIL;
  237.   MF.VgaEmu1.CLEARDEVICE;
  238.   LLL := 0;
  239.   command := '';
  240.   bslash := FALSE;
  241.   ripline := FALSE;
  242.   ButtonColor := 8;
  243. END;
  244.  
  245. procedure detectRip(ch : char);
  246. begin
  247.     if (RipEsc = 3) and (Ch = '!') then begin
  248.       MF.DataOut('RIPSCRIP015410');
  249.       RipEsc := 0;
  250.     end else if (RipEsc = 3) then RipEsc := 0;
  251.  
  252.     if (RipEsc = 2) and (Ch = '!') then begin
  253.       MF.DataOut('RIPSCRIP015410');
  254.       RipEsc := 0;
  255.     end;
  256.  
  257.     if (RipEsc = 2) and (Ch = '0') then
  258.       RipEsc := 3
  259.     else if (RipEsc = 2) then RipEsc := 0;
  260.  
  261.     if (RipEsc = 1) and (Ch = '[') then
  262.       RipEsc := 2;
  263.  
  264.     if (Ch = #27) then  //check for RIP escape codes
  265.      RipEsc := 1;
  266. end;
  267.  
  268. function Display_Rip(ch : char) : boolean;
  269. begin
  270.    DetectRip(ch);
  271.  
  272.     IF (ORD (ch) = 13) OR (ORD (ch) = 10) THEN BEGIN
  273.       IF bslash = TRUE THEN BEGIN
  274. //        READ (f, ch);
  275.           bslash := FALSE;
  276.           ripline := false;
  277.       END ELSE BEGIN
  278.         LLL := 0;
  279.         ripline := false;
  280. //        READ (f, ch);
  281.       END;
  282.     END ELSE BEGIN
  283.       LLL := LLL + 1;
  284.       IF (LLL = 1) AND (Ch = '!') THEN ripline := TRUE ELSE BEGIN
  285.         IF ripline THEN BEGIN
  286.           CASE ch OF
  287.           '|' : BEGIN
  288.             IF bslash THEN BEGIN
  289.               command := command + ch; bslash := FALSE;
  290.             END ELSE BEGIN
  291.               IF command <> '' THEN ParseCommand (command);
  292.               command := '';
  293.             END;
  294.           END;
  295.           '\' : BEGIN
  296.             IF bslash THEN BEGIN
  297.               command := command + ch; bslash := FALSE;
  298.             END ELSE
  299.               bslash := TRUE;
  300.           END;
  301.           ELSE
  302.             command := command + ch;
  303.           END;
  304.         END ELSE BEGIN
  305. //          WriteString (ch, 15);
  306.             RipLine := false;
  307.         END;
  308.       END;
  309.     END;
  310.   Display_Rip := RipLine;  
  311. end;
  312.  
  313. end.
  314.