home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FILER.ZIP / FILER2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  7.4 KB  |  222 lines
  1. {================================================================}
  2. {                  WRITE MESSAGE PROCEDURE                       }
  3. {================================================================}
  4. PROCEDURE WRITEMESSAGE(VAR MESSAGE : STRING60);
  5. BEGIN
  6.   REVVIDEO;
  7.   WRITE(MESSAGE);
  8.   REGVIDEO;
  9. END;
  10.  
  11. {================================================================}
  12. {                      KEYIN PROCEDURE                           }
  13. {================================================================}
  14. PROCEDURE KEYIN(VAR MESSAGE : STRING60; XPOS,YPOS,LEN : INTEGER);
  15.  
  16. CONST
  17.   CONTROLS       : SET OF CHAR = [^H..^R,^U..^Y,^[..^_,'\'];
  18.  
  19. VAR
  20.   W, COUNT       :  INTEGER;
  21.   FLDLEN         :  INTEGER;
  22.   CONDITION      :  BOOLEAN;
  23.  
  24. BEGIN
  25.   IF DATAFORM[Z]  = ASCII THEN FLDLEN := LEN
  26.   ELSE
  27.     BEGIN
  28.       IF DATAFORM[Z] = 0 THEN FLDLEN := LEN +((LEN-1)DIV 3)
  29.       ELSE FLDLEN := LEN+((LEN-DATAFORM[Z]-2)DIV 3);
  30.       EDIT(MESSAGE);
  31.     END;
  32.   COUNT := 0;
  33.     IF LENGTH(MESSAGE)>FLDLEN THEN MESSAGE := COPY(MESSAGE,1,FLDLEN);
  34.     IF DATAFORM[Z] <> ASCII THEN TIDE(MESSAGE);
  35.     GOTOXY(XPOS,YPOS);
  36.     WRITEMESSAGE(MESSAGE);
  37.     GOTOXY(XPOS+COUNT,YPOS);
  38.     REPEAT
  39.       READ (KBD,CH);
  40.       IF CH = #27 THEN
  41.         READ (KBD,CH1)
  42.       ELSE CH1 := ' ';  { INTIIALIZE FOR CHAR WHICH FOLLOWS ESC }
  43.  
  44.       IF ABORTCHAR = TRUE THEN            { THIS CODE IS REQUIRED TO  }
  45.         BEGIN                             { ELIMINATE THE ENTRY OF    }
  46.           ABORTCHAR := FALSE;             { UNWANTED CHARACTERS AFTER }
  47.           CH := ^S;                       { A SEARCH IS ABORTED       }
  48.         END;
  49.       CASE CH OF
  50.  
  51.         ^A  :                                    { LEFT ONE WORD }
  52.             BEGIN
  53.               WHILE(MESSAGE[COUNT-1] = ' ') AND (COUNT>1) DO
  54.                 COUNT := PRED(COUNT);
  55.               WHILE(MESSAGE[COUNT-1] <> ' ') AND (COUNT>1) DO
  56.                 COUNT := PRED(COUNT);
  57.               IF COUNT>0 THEN COUNT := PRED(COUNT);
  58.             END;
  59.  
  60.         ^C  :          { EXIT FIELD MODE, RETURN TO RRECORD MODE }
  61.             BEGIN
  62.               CH  := #27;              { SAME AS F1 FUNCTION KEY }
  63.               CH1 := #59;
  64.             END;
  65.  
  66.         ^D  :                                { RIGHT 1 CHARACTER }
  67.             BEGIN
  68.               IF COUNT < LEN THEN COUNT := COUNT +1;
  69.             END;
  70.  
  71.         ^E  :
  72.             BEGIN
  73.               CH := #27;          { CTRL E = WORDSTAR'S UP 1 LINE }
  74.               CH1 := #64;
  75.             END;
  76.  
  77.         ^F  :                                     { RIGHT 1 WORD }
  78.             BEGIN
  79.               WHILE(MESSAGE[COUNT+1] <> ' ') AND (COUNT<FLDLEN) DO
  80.                 COUNT := SUCC(COUNT);
  81.               WHILE(MESSAGE[COUNT+1] = ' ') AND (COUNT<FLDLEN) DO
  82.                 COUNT := SUCC(COUNT);
  83.             END;
  84.  
  85.         ^G  :                    { DELETE CHARACTER UNDER CURSOR }
  86.             BEGIN
  87.               IF COUNT>=0 THEN
  88.                 BEGIN
  89.                   MESSAGE := MESSAGE + ' ';
  90.                   DELETE(MESSAGE,COUNT+1,1);
  91.                   GOTOXY(XPOS,YPOS);
  92.                   WRITEMESSAGE(MESSAGE);
  93.                 END;
  94.             END;
  95.  
  96.         ^I  :                { TAB = MOVE CURSOR 6 CHAR TO RIGHT }
  97.             BEGIN
  98.               COUNT := COUNT + 6;
  99.               IF COUNT > LEN THEN COUNT := LEN;
  100.             END;
  101.  
  102.         ^Q  :  COUNT := 0;                  { CURSOR TO LEFT END }
  103.  
  104.         ^S  :                                 { LEFT 1 CHARACTER }
  105.             BEGIN
  106.               IF COUNT >0 THEN COUNT := COUNT -1;
  107.             END;
  108.  
  109.         ^T  :                             { DELETE WORD TO RIGHT }
  110.             BEGIN
  111.               W := FLDLEN - COUNT;
  112.               IF MESSAGE[COUNT+1] = ' ' THEN
  113.                 BEGIN
  114.                  WHILE (MESSAGE[COUNT+1] = ' ') AND (W>0) DO
  115.                    BEGIN
  116.                     DELETE(MESSAGE,COUNT+1,1);
  117.                     MESSAGE := MESSAGE + ' ';
  118.                     W := PRED(W);
  119.                   END;
  120.                 END
  121.               ELSE
  122.                 BEGIN
  123.                   WHILE MESSAGE[COUNT+1] <> ' ' DO
  124.                     BEGIN
  125.                       DELETE (MESSAGE,COUNT+1,1);
  126.                       MESSAGE := MESSAGE + ' ';
  127.                       W := PRED(W);
  128.                     END;
  129.                   WHILE (MESSAGE[COUNT+1] = ' ') AND (W>0) DO
  130.                     BEGIN
  131.                       DELETE (MESSAGE,COUNT+1,1);
  132.                       MESSAGE := MESSAGE + ' ';
  133.                       W := PRED(W);
  134.                     END;
  135.                 END;
  136.               GOTOXY(XPOS,YPOS);
  137.               WRITEMESSAGE(MESSAGE);
  138.             END;
  139.  
  140.         ^W  :  COUNT := LEN-1;               { CURSOR TO RIGHT END }
  141.  
  142.         ^X  :  CH := ^M;                { WORDSTAR'S DOWN 1 LINE }
  143.  
  144.         ^Y  :                           { WORDSTAR'S CLEAR FIELD }
  145.             BEGIN
  146.               MESSAGE := '';
  147.               FOR W := 1 TO FLDLEN DO
  148.               MESSAGE := MESSAGE + '_';
  149.               GOTOXY(XPOS,YPOS);
  150.               WRITEMESSAGE(MESSAGE);
  151.             END;
  152.  
  153.         ^Z  :                         { CLEAR REMAINDER OF FIELD }
  154.             BEGIN
  155.               FOR W := COUNT +1 TO FLDLEN+1 DO
  156.                   MESSAGE[W] := '_';
  157.               IF LENGTH(MESSAGE)>FLDLEN THEN
  158.                 MESSAGE := COPY(MESSAGE,1,FLDLEN);
  159.               GOTOXY(XPOS,YPOS);
  160.               WRITEMESSAGE(MESSAGE);
  161.             END;
  162.  
  163.         ^H  :                  { DELETE CHARACTER BEFORE CURSOR }
  164.             BEGIN
  165.               IF COUNT>0 THEN
  166.                 BEGIN
  167.                   DELETE(MESSAGE,COUNT,1);
  168.                   MESSAGE := MESSAGE + ' ';
  169.                   IF LENGTH(MESSAGE)>FLDLEN THEN
  170.                     MESSAGE := COPY(MESSAGE,1,FLDLEN);
  171.                   GOTOXY(XPOS,YPOS);
  172.                   WRITEMESSAGE(MESSAGE);
  173.                   COUNT := COUNT-1;
  174.                 END;
  175.             END;
  176.  
  177.  
  178.       END; { CASE CH OF }
  179.  
  180.       IF ORD(CH) IN [32..91,93..126] THEN    { PROCESS IF ALPHA/NUMERIC }
  181.         BEGIN
  182.           IF COUNT < FLDLEN THEN
  183.             BEGIN
  184.               COUNT := COUNT +1;
  185.               INSERT(CH,MESSAGE,COUNT);
  186.               IF LENGTH(MESSAGE)>FLDLEN THEN
  187.                 MESSAGE := COPY(MESSAGE,1,FLDLEN);
  188.               GOTOXY(XPOS,YPOS);
  189.               WRITEMESSAGE(MESSAGE);
  190.             END;
  191.         END;
  192.       GOTOXY(XPOS+COUNT,YPOS);
  193.  
  194.  
  195.     UNTIL CH IN [#27,^J..^M,^R,^V,'\']; { EXIT KEYIN ONLY ON THESE CHAR }
  196.  
  197.  
  198.     IF DATAFORM[Z] <> ASCII THEN TIDE(MESSAGE);  {ELIM COMMAS IF NUMERIC}
  199.     IF LENGTH(MESSAGE)>0 THEN
  200.       BEGIN
  201.         IF CH = ^M THEN CH := MESSAGE[1];
  202.       END;
  203.     COUNT := FLDLEN+1;
  204.     CONDITION := FALSE;
  205.     REPEAT                     { ESTABLISH END OF DATA IN STRING }
  206.       COUNT := COUNT -1;
  207.       IF MESSAGE[COUNT] = '_' THEN MESSAGE[COUNT] := ' ';
  208.       IF MESSAGE[COUNT] <> ' ' THEN CONDITION := TRUE;
  209.       IF COUNT = 0 THEN CONDITION := TRUE;
  210.     UNTIL CONDITION = TRUE;
  211.     MESSAGE := COPY(MESSAGE,1,COUNT);
  212. END;
  213. {================================================================}
  214. {           CALCULATE DISKRECORD & PRECBYTE PROCEDURE            }
  215. {================================================================}
  216. PROCEDURE CALCULATE;
  217.   BEGIN
  218.     DISKRECORD := TRUNC((DATARECORD-1)/BLOCKINGFACTOR)*2+7;
  219.     PRECBYTE := ((DATARECORD-1) MOD BLOCKINGFACTOR)*RCDLEN;
  220.   END;
  221. {================================================================}
  222.