home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / SORT3.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  1.5 KB  |  62 lines
  1. PROGRAM d8r6(input,output,dfile);
  2. (* driver for routine SORT3 *)
  3. CONST
  4.    nlen=64;
  5. TYPE
  6.    glsarray = ARRAY [1..nlen] OF real;
  7.    gliarray = ARRAY [1..nlen] OF integer;
  8. VAR
  9.    i,j : integer;
  10.    a,b,c,wksp : glsarray;
  11.    indx : gliarray;
  12.    amsg1 : PACKED ARRAY [1..40] OF char;
  13.    amsg2 : PACKED ARRAY [1..24] OF char;
  14.    n1,n2 : integer;
  15.    amsg,bmsg,cmsg : PACKED ARRAY [1..nlen] OF char;
  16.    dfile : text;
  17.  
  18. (*$I MODFILE.PAS *)
  19. (*$I INDEXX.PAS *)
  20.  
  21. (*$I SORT3.PAS *)
  22.  
  23. BEGIN
  24.    amsg1 := 'i''d rather have a bottle in front of me ';
  25.    n1 := 40;
  26.    amsg2 := 'than a frontal lobotomy.';
  27.    n2 := 24;
  28.    FOR i := 1 to n1 DO amsg[i] := amsg1[i];
  29.    FOR i := 1 to n2 DO amsg[n1+i] := amsg2[i];
  30.    writeln;
  31.    writeln ('original message:');
  32.    writeln (amsg);
  33. (* read array of random numbers *)
  34.    glopen(dfile,'tarray.dat');
  35.    readln(dfile);
  36.    FOR i := 1 to nlen DO read(dfile,a[i]);
  37.    close(dfile);
  38. (* create array b and array c *)
  39.    FOR i := 1 to nlen DO BEGIN
  40.       b[i] := i;
  41.       c[i] := nlen+1-i
  42.    END;
  43. (* sort array a while mixing ib and ic *)
  44.    sort3(nlen,a,b,c,wksp,indx);
  45. (* scramble message according to array b *)
  46.    FOR i := 1 to nlen DO BEGIN
  47.       j := round(b[i]);
  48.       bmsg[i] := amsg[j]
  49.    END;
  50.    writeln;
  51.    writeln ('scrambled message:');
  52.    writeln (bmsg);
  53. (* unscramble according to array c *)
  54.    FOR i := 1 to nlen DO BEGIN
  55.       j := round(c[i]);
  56.       cmsg[j] := bmsg[i]
  57.    END;
  58.    writeln;
  59.    writeln ('mirrored message:');
  60.    writeln (cmsg)
  61. END.
  62.