home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / fileutil / stripbit.arj / STRIPBIT.PRO < prev   
Encoding:
Text File  |  1992-01-23  |  7.2 KB  |  255 lines
  1. code=1000
  2. nobreak       /* no CTRL-C or CTRL-Break allowed */
  3.  
  4. /***************************************************************************/
  5. /*                                       */
  6. /* This Program has been written specifically to help out people who use   */
  7. /* Wordstar and need to convert to other formats. Plus some tricks...      */
  8. /*                                       */
  9. /***************************************************************************/
  10.  
  11. DOMAINS
  12.  
  13.          file = input ; output
  14.  
  15. PREDICATES
  16.  
  17.     start1
  18.     start(string)
  19.     get_file(string,integer)
  20.     strip_bit(string,integer)
  21.     write_header
  22.     convert(string,integer)
  23.     get_numb(string,integer)
  24.     
  25. /**------------------------------------------------------------------------**/
  26.     
  27. GOAL
  28.     start1.
  29.  
  30.  
  31. /**------------------------------------------------------------------------**/
  32. /**                             CLAUSES BODY                               **/
  33. /**------------------------------------------------------------------------**/
  34.  
  35. CLAUSES
  36.  
  37. /* Get the Command Line Parameters and pass them on */
  38.  
  39.     START1 if
  40.         write_header,
  41.         comline(X),
  42.         X = "?",!,
  43.         clearwindow,
  44.         write("StripBit 1.0 Options List"),nl,nl,
  45.         write("Command Line Parameters are required in the format"),nl,nl,
  46.         write(" STRIPBIT sourcefile destinationfile functionhexnumber"),nl,
  47.         write(" where -"),nl,
  48.         write("             sourcefile - any legal DOS path and filename"),nl,
  49.         write("        destinationfile - any legal DOS path and filename"),nl,
  50.         write("      functionhexnumber - "),nl,
  51.         write("                          a or A is AND followed by any 2 digit"),nl,
  52.         write("                                        hex number (00 to FF)"),nl,
  53.         write("                          o or O is OR  followed by any 2 digit"),nl,
  54.         write("                                        hex number (00 to FF)"),nl,
  55.         write("                          x or X is XOR followed by any 2 digit"),nl,
  56.         write("                                        hex number (00 to FF)"),nl,nl,
  57.         write("Example; STRIPBIT myfile.lst myfile.tst"),nl,
  58.         write("Example; STRIPBIT \\dos\\myfile.lst \\temp\\myfile.tst"),nl,
  59.         write("Example; STRIPBIT myfile.lst myfile.tst X20"),nl,
  60.         write("Example; STRIPBIT \\dos\\myfile.lst \\temp\\myfile.tst a7F"),nl,nl,
  61.         write("Default operation when not using functionhexnumber AND's file with 7F"),nl,
  62.         exit.
  63.                 
  64.     START1 if
  65.         write_header,
  66.         comline(X),
  67.         X <> "",!,
  68.         start(X).
  69.  
  70. /* No parameters !, exit with grace and inform user */
  71.         
  72.     START1 if !,
  73.         write("This program requires command line parameters in the"),nl,
  74.         write("following format;"),nl,nl,
  75.         write("  STRIPBIT source_path_file.ext destination_path_file.ext"),nl,
  76.         write("       or"),nl,
  77.         write("  STRIPBIT source_path_file.ext destination_path_file.ext function_hex_number"),nl,nl,
  78.         write("  where function_hex_number can be A (AND), O (OR) or X (XOR) followed"),nl,
  79.         write("  by any 2 digit hexidecimal number from 00 to FF, ie. X20 or A20 or O20"),nl,nl,nl,
  80.         write("Abnormal Exit.....Missing parameters"),nl,
  81.         exit.
  82.     
  83. /* Routine to test for source/destination/functionhexnumber if all are */
  84. /* present then run this routine only into get_number               */
  85.     
  86.     START(X) if
  87.         str_len(X,A),
  88.         searchstring(X," ",Ra),
  89.         frontstr(Ra,X,_,Raa),
  90.         searchstring(Raa," ",Sa),
  91.         str_len(Raa,Aa),
  92.  
  93.         B = A - Ra + 1,        /* B=stringlength-" " position */
  94.         Ba = A - B,
  95.         frontstr(Ba,X,Y,_),     /* source filename */
  96.  
  97.         C = Aa - Sa + 1,
  98.         Ca= Aa - C,
  99.         frontstr(Ca,Raa,Z,Daa),
  100.         frontstr(2,Daa,Type,Andwith),
  101.         str_len(Andwith,Ua),
  102.         frontstr(1,Type,_,Process),
  103.         Ua = 2,
  104.         existfile(Y),!,
  105.         write("Source = ",Y,"  --> Destination = ",Z,"  And_with --> ",Andwith),nl,nl,
  106.         openread(input,Y),
  107.         openwrite(output,Z),
  108.         filemode(output,1),
  109.         readdevice(input),
  110.         writedevice(output),
  111.         convert(Andwith,Bitnum),
  112.         get_file(Process,Bitnum),
  113.         removewindow,
  114.         closefile(input),
  115.         closefile(output),
  116.         readdevice(keyboard),
  117.         writedevice(screen),
  118.         write("Operation Completed....."),nl,
  119.         exit.
  120.  
  121. /* Run this routine if only source/destination are present */
  122.     
  123.     START(X) if
  124.         str_len(X,A),
  125.         searchchar(X,$20,Position),
  126.         B = A - Position,
  127.         C = Position + 1,
  128.         D = Position - 1,
  129.         substring(X,1,D,Y),
  130.         existfile(Y),!,
  131.         substring(X,C,B,Z),
  132.         write("Source = ",Y,"  --> Destination = ",Z),nl,nl,
  133.         openread(input,Y),
  134.         openwrite(output,Z),
  135.         filemode(output,1),
  136.         readdevice(input),
  137.         writedevice(output),
  138.         Bitnum = $7F,
  139.         Tza = "A",
  140.         get_file(Tza,Bitnum),
  141.         removewindow,
  142.         closefile(input),
  143.         closefile(output),
  144.         readdevice(keyboard),
  145.         writedevice(screen),
  146.         write("Operation Completed....."),nl,
  147.         exit.
  148.  
  149. /* Exist with grace if the weiner used a non-existant filename or tried to */
  150. /* run with a hex number length greater than 2 or no destination */
  151.         
  152.     START(_) if !,
  153.         write("The source file does not exist or destination file"),nl,
  154.         write("was not specified"),nl,nl,
  155.         write("Check the disk, path and filename..."),nl,nl,
  156.         write("Abnormal Exit....."),nl,
  157.         exit.
  158.  
  159. /* File conversion loops follow */
  160.     
  161.     GET_FILE(A,Bitnum) if
  162.         writedevice(output),
  163.         strip_bit(A,Bitnum).
  164.         
  165.     GET_FILE(_,_) if !.
  166.         
  167.     STRIP_BIT("A",Bitnum) if    
  168.         readchar(A),!,
  169.         bitand(A,Bitnum,B),
  170.         char_int(C,B),
  171.         write(C),
  172.         strip_bit("A",Bitnum).
  173.     
  174.     STRIP_BIT("a",Bitnum) if    
  175.         readchar(A),!,
  176.         bitand(A,Bitnum,B),
  177.         char_int(C,B),
  178.         write(C),
  179.         strip_bit("a",Bitnum).
  180.     
  181.     STRIP_BIT("O",Bitnum) if    
  182.         readchar(A),!,
  183.         bitor(A,Bitnum,B),
  184.         char_int(C,B),
  185.         write(C),
  186.         strip_bit("O",Bitnum).
  187.     
  188.     STRIP_BIT("o",Bitnum) if    
  189.         readchar(A),!,
  190.         bitor(A,Bitnum,B),
  191.         char_int(C,B),
  192.         write(C),
  193.         strip_bit("o",Bitnum).
  194.     
  195.     STRIP_BIT("X",Bitnum) if    
  196.         readchar(A),!,
  197.         bitxor(A,Bitnum,B),
  198.         char_int(C,B),
  199.         write(C),
  200.         strip_bit("X",Bitnum).
  201.     
  202.     STRIP_BIT("x",Bitnum) if    
  203.         readchar(A),!,
  204.         bitxor(A,Bitnum,B),
  205.         char_int(C,B),
  206.         write(C),
  207.         strip_bit("x",Bitnum).
  208.     
  209.     STRIP_BIT(_,_) if !.
  210.  
  211. /* Opening Statement */
  212.         
  213.     WRITE_HEADER if
  214.         clearwindow,nl,
  215.         write("HighBit Reset Character Converter for Wordstar and other formats"),nl,
  216.         write("Copyright (c) 1991, Steve Marett, Toronto"),nl,
  217.         write("Written in PDC Prolog v3.21 - Time: 21 minutes"),nl,nl,
  218.         write("This program converts characters with any hexidecimal value"),nl,
  219.         write("to it's OR'd AND'd or XOR'd product dependant on your input"),nl,
  220.         write("value. The default conversion is AND with 7F to convert data"),nl,
  221.         write("higher than 80h to it's ASCII counterpart. No warranties"),nl,nl,
  222.         write("are expressed or implied, this is freeware."),nl,nl.
  223.  
  224. /* Hex to Decimal Converter */
  225.  
  226.     CONVERT(X,Y) if
  227.         frontstr(1,X,A,B),
  228.         get_numb(A,Ya),
  229.         get_numb(B,Yb),
  230.         Y = ((Ya*15)+Yb).
  231.         
  232.     GET_NUMB("0",0) if !.
  233.     GET_NUMB("1",1) if !.
  234.     GET_NUMB("2",2) if !.
  235.     GET_NUMB("3",3) if !.
  236.     GET_NUMB("4",4) if !.
  237.     GET_NUMB("5",5) if !.
  238.     GET_NUMB("6",6) if !.
  239.     GET_NUMB("7",7) if !.
  240.     GET_NUMB("8",8) if !.
  241.     GET_NUMB("9",9) if !.
  242.     GET_NUMB("A",10) if !.
  243.     GET_NUMB("B",11) if !.
  244.     GET_NUMB("C",12) if !.
  245.     GET_NUMB("D",13) if !.
  246.     GET_NUMB("E",14) if !.
  247.     GET_NUMB("F",15) if !.
  248.     GET_NUMB("a",10) if !.
  249.     GET_NUMB("b",11) if !.
  250.     GET_NUMB("c",12) if !.
  251.     GET_NUMB("d",13) if !.
  252.     GET_NUMB("e",14) if !.
  253.     GET_NUMB("f",15) if !.
  254.     
  255.