Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FILER.ZIP/FILER1.PAS

Pascal/Delphi Source File | 1985-11-18 | 5.9 KB | 179 lines

{================================================================}
{        BINARY CODED DECIMAL TO INTEGER FUNCTION                }
{================================================================}
FUNCTION BCDTOIN (CHA : CHAR) : INTEGER;
BEGIN
  BCDTOIN := ORD(CHA) - TRUNC(ORD(CHA)/16)*6;
END;
{================================================================}
{             CHARACTER TO INTEGER FUNCTION                      }
{================================================================}
FUNCTION CHTOIN(VAR CHARRAY : RANGE; START, LEN : INTEGER)  : INTEGER;
VAR
  CODE, RESULT : INTEGER;
  WORKSTRING   : STRING[10];
BEGIN
  WORKSTRING := '';
  FOR RESULT := 0 TO LEN-1  DO
    BEGIN
      IF CHARRAY[START + RESULT ] = ' ' THEN
        WORKSTRING := WORKSTRING + '0'
      ELSE WORKSTRING := WORKSTRING + CHARRAY[START+RESULT];
    END;
  VAL(WORKSTRING,RESULT,CODE);
  CHTOIN := RESULT;
END;
{================================================================}
{                   BIG CURSOR PROCEDURE                         }
{================================================================}
procedure curson;
var
  result      : record
      ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
      end;
begin
  if mem[$0000:$0449] = 7 then
      result.cx := $000d
  else
      result.cx := $0007;
  result.ax := $0100;
  intr($10,result);
end;
{================================================================}
{                   REGULAR VIDEO PROCEDURE                      }
{================================================================}
PROCEDURE REGVIDEO;
BEGIN
  TEXTCOLOR(YELLOW);
  TEXTBACKGROUND(BLUE);
END;
{================================================================}
{                   REVERSE VIDEO PROCEDURE                      }
{================================================================}
PROCEDURE REVVIDEO;
BEGIN
  TEXTCOLOR(WHITE);
  TEXTBACKGROUND(BLACK);
END;
{================================================================}
{           PRINT GETDATA PROCEDURE (TEMPORARY)                  }
{================================================================}
PROCEDURE PRTGETDATA;
VAR W : INTEGER;
  BEGIN
    GOTOXY(1,18);
    FOR W := 1 TO 128 DO
    WRITE(GETDATA[W]);
    WRITELN;
    READ(KBD,CH);
  END;
{================================================================}
{               GET DATA FROM ARRAY PROCEDURE                    }
{================================================================}
PROCEDURE GETDATAFROMARRAY(VAR MESSAGE : STRING60);
VAR W,X :  INTEGER;
BEGIN
  MESSAGE := '';
  FOR W := PRECBYTE+DATAPOSN[Z] TO PRECBYTE+DATAPOSN[Z+1]-1 DO
    MESSAGE := MESSAGE + GETDATA[W];
  IF DATAFORM[Z] <> ASCII THEN      { CHANGE TRAILING MINUS SIGN }
    BEGIN                           { TO LEADING MINUS SIGN      }
      X := LENGTH(MESSAGE);
      IF MESSAGE[X] = '-' THEN
        BEGIN
          DELETE(MESSAGE,X,1);
          W := 1;
          WHILE (W<X) AND (MESSAGE[W] = ' ') DO
            W := SUCC(W);
          INSERT('-',MESSAGE,W);
        END;
    END;
END;
{================================================================}
{                       EDIT PROCEDURE                           }
{================================================================}
PROCEDURE EDIT(VAR MESSAGE : STRING60);
VAR
  W           :  INTEGER;
  DECPTR      :  INTEGER;

BEGIN
  IF LENGTH(MESSAGE) > 0 THEN
    BEGIN
      IF DATAFORM[Z] = 0 THEN DECPTR := DATALEN[Z]-2
      ELSE DECPTR := DATALEN[Z]-DATAFORM[Z]-3;
      WHILE DECPTR > 1 DO
        BEGIN
          IF MESSAGE[DECPTR-1] <> '-' THEN
            BEGIN
              IF MESSAGE[DECPTR-1] IN [' ','$'] THEN
                INSERT(' ',MESSAGE,DECPTR)
              ELSE INSERT(',',MESSAGE,DECPTR);
            END;
          DECPTR := DECPTR -3;
        END;
    END; { IF LENGTH BEGIN }
END;
{================================================================}
{               TIDE (EDIT BACKWARDS) PROCEDURE                  }
{================================================================}
PROCEDURE TIDE( VAR MESSAGE : STRING60);
VAR W  :  INTEGER;
BEGIN
  W := LENGTH(MESSAGE);
  WHILE W>0 DO
    BEGIN
      IF MESSAGE[W] IN [',', '$', '+'] THEN
        BEGIN
          DELETE(MESSAGE,W,1);
          MESSAGE := ' ' + MESSAGE;
        END
      ELSE W := W-1;
    END;
END;
{================================================================}
{                         BEEP PROCEDURE                         }
{================================================================}
PROCEDURE BEEP;
BEGIN
  SOUND(800);
  DELAY(100);
  NOSOUND;
END;
{================================================================}
{               STRING TO REAL NUMBER PROCEDURE                  }
{================================================================}
PROCEDURE STRINGTOREAL(VAR SOURCE:STRING60;VAR NUMB:REAL;VAR CODE:INTEGER);
VAR
  X,W  :  INTEGER;
BEGIN
  W := 1;
  WHILE (W < LENGTH(SOURCE)+1) AND (SOURCE[W] = ' ') DO
    W := W+1;
  X := W;
  WHILE (W < LENGTH(SOURCE)+1) AND (SOURCE[W] <> ' ') DO
    W := W+1;
  SOURCE := COPY(SOURCE,X,W-X);
  VAL( SOURCE,NUMB,CODE );
  IF CODE <> 0 THEN BEEP;
END;
{================================================================}
{           STORE DATA IN ARRAY GETDATA PROCEDURE                }
{================================================================}
PROCEDURE STOREDATAINARRAY;

BEGIN
  FIRST := 1;
  IF DATAFORM[Z] <> ASCII THEN
    BEGIN                       { RIGHT JUSTIFY NUMBER }
      IF LENGTH(ANS) > 0 THEN STRINGTOREAL(ANS,NUMVALUE,CODE)
        ELSE NUMVALUE := 0;
      STR(NUMVALUE:20:8,ANS);
      FIRST := POS('.',ANS)-DATALEN[Z];
      IF DATAFORM[Z] <> 0 THEN FIRST := FIRST + DATAFORM[Z] + 1;
      IF DATAFORM[Z] = ASCII THEN FIRST := 1;
    END;
  FILLCHAR(GETDATA[PRECBYTE+DATAPOSN[Z]],DATALEN[Z],' ');
  MOVE(ANS[FIRST],GETDATA[PRECBYTE+DATAPOSN[Z]],DATALEN[Z]);
END;