Home » Personal collection » Acorn DFS disks » dfs_box03_disk12_bcpl.scp » ENCODEB
ENCODEB
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
Tape/disk: | Home » Personal collection » Acorn DFS disks » dfs_box03_disk12_bcpl.scp |
Filename: | ENCODEB |
Read OK: | ✔ |
File size: | 036B bytes |
Load address: | 0000 |
Exec address: | 0000 |
File contents
SECTION "ENCODE" GET "LIBHDR" MANIFEST $( avsize = 20 $) LET start() BE $( LET ch = ? LET infile, outfile = ?, ? LET argvec = VEC avsize IF RDARGS("FROM/A,TO/A", argvec, avsize) = 0 THEN STOP(11) // invalid arguments infile := FINDINPUT(argvec!0) IF infile = 0 THEN STOP(RESULT2) // invalid in file outfile := FINDOUTPUT(argvec!1) IF outfile = 0 THEN STOP(RESULT2) // invalid out file SELECTINPUT(infile) SELECTOUTPUT(outfile) ch := RDCH() WHILE ch NE endstreamch DO $( WRCH( codechar(ch) ) ch := RDCH() $) ENDREAD() // not strictly necessary ENDWRITE() // but good practice $) AND codechar(char) = VALOF $( TEST 'A' <= char <= 'Z' THEN char := 'A' + 'Z' - char ELSE IF 'a' <= char <= 'z' THEN char := 'a' + 'z' - char RESULTIS char $)
00000000 53 45 43 54 49 4f 4e 20 22 45 4e 43 4f 44 45 22 |SECTION "ENCODE"| 00000010 0d 0a 47 45 54 20 22 4c 49 42 48 44 52 22 0d 0a |..GET "LIBHDR"..| 00000020 0d 0a 4d 41 4e 49 46 45 53 54 20 24 28 20 61 76 |..MANIFEST $( av| 00000030 73 69 7a 65 20 3d 20 32 30 20 24 29 0d 0a 0d 0a |size = 20 $)....| 00000040 4c 45 54 20 73 74 61 72 74 28 29 20 42 45 0d 0a |LET start() BE..| 00000050 24 28 20 4c 45 54 20 63 68 20 3d 20 3f 0d 0a 20 |$( LET ch = ?.. | 00000060 20 20 4c 45 54 20 69 6e 66 69 6c 65 2c 20 6f 75 | LET infile, ou| 00000070 74 66 69 6c 65 20 3d 20 3f 2c 20 3f 0d 0a 20 20 |tfile = ?, ?.. | 00000080 20 4c 45 54 20 61 72 67 76 65 63 20 3d 20 56 45 | LET argvec = VE| 00000090 43 20 61 76 73 69 7a 65 0d 0a 0d 0a 20 20 20 49 |C avsize.... I| 000000a0 46 20 52 44 41 52 47 53 28 22 46 52 4f 4d 2f 41 |F RDARGS("FROM/A| 000000b0 2c 54 4f 2f 41 22 2c 20 61 72 67 76 65 63 2c 20 |,TO/A", argvec, | 000000c0 61 76 73 69 7a 65 29 20 3d 20 30 20 54 48 45 4e |avsize) = 0 THEN| 000000d0 0d 0a 20 20 20 20 20 20 53 54 4f 50 28 31 31 29 |.. STOP(11)| 000000e0 20 20 2f 2f 20 69 6e 76 61 6c 69 64 20 61 72 67 | // invalid arg| 000000f0 75 6d 65 6e 74 73 0d 0a 0d 0a 20 20 20 69 6e 66 |uments.... inf| 00000100 69 6c 65 20 3a 3d 20 46 49 4e 44 49 4e 50 55 54 |ile := FINDINPUT| 00000110 28 61 72 67 76 65 63 21 30 29 0d 0a 20 20 20 49 |(argvec!0).. I| 00000120 46 20 69 6e 66 69 6c 65 20 3d 20 30 20 54 48 45 |F infile = 0 THE| 00000130 4e 0d 0a 20 20 20 20 20 20 53 54 4f 50 28 52 45 |N.. STOP(RE| 00000140 53 55 4c 54 32 29 20 2f 2f 20 69 6e 76 61 6c 69 |SULT2) // invali| 00000150 64 20 69 6e 20 66 69 6c 65 0d 0a 20 20 20 6f 75 |d in file.. ou| 00000160 74 66 69 6c 65 20 3a 3d 20 46 49 4e 44 4f 55 54 |tfile := FINDOUT| 00000170 50 55 54 28 61 72 67 76 65 63 21 31 29 0d 0a 20 |PUT(argvec!1).. | 00000180 20 20 49 46 20 6f 75 74 66 69 6c 65 20 3d 20 30 | IF outfile = 0| 00000190 20 54 48 45 4e 0d 0a 20 20 20 20 20 20 53 54 4f | THEN.. STO| 000001a0 50 28 52 45 53 55 4c 54 32 29 20 2f 2f 20 69 6e |P(RESULT2) // in| 000001b0 76 61 6c 69 64 20 6f 75 74 20 66 69 6c 65 0d 0a |valid out file..| 000001c0 0d 0a 20 20 20 53 45 4c 45 43 54 49 4e 50 55 54 |.. SELECTINPUT| 000001d0 28 69 6e 66 69 6c 65 29 0d 0a 20 20 20 53 45 4c |(infile).. SEL| 000001e0 45 43 54 4f 55 54 50 55 54 28 6f 75 74 66 69 6c |ECTOUTPUT(outfil| 000001f0 65 29 0d 0a 0d 0a 20 20 20 63 68 20 3a 3d 20 52 |e).... ch := R| 00000200 44 43 48 28 29 0d 0a 20 20 20 57 48 49 4c 45 20 |DCH().. WHILE | 00000210 63 68 20 4e 45 20 65 6e 64 73 74 72 65 61 6d 63 |ch NE endstreamc| 00000220 68 20 44 4f 0d 0a 20 20 20 24 28 20 57 52 43 48 |h DO.. $( WRCH| 00000230 28 20 63 6f 64 65 63 68 61 72 28 63 68 29 20 29 |( codechar(ch) )| 00000240 0d 0a 20 20 20 20 20 20 63 68 20 3a 3d 20 52 44 |.. ch := RD| 00000250 43 48 28 29 0d 0a 20 20 20 24 29 0d 0a 0d 0a 20 |CH().. $).... | 00000260 20 20 45 4e 44 52 45 41 44 28 29 20 20 2f 2f 20 | ENDREAD() // | 00000270 6e 6f 74 20 73 74 72 69 63 74 6c 79 20 6e 65 63 |not strictly nec| 00000280 65 73 73 61 72 79 0d 0a 20 20 20 45 4e 44 57 52 |essary.. ENDWR| 00000290 49 54 45 28 29 20 2f 2f 20 62 75 74 20 67 6f 6f |ITE() // but goo| 000002a0 64 20 70 72 61 63 74 69 63 65 0d 0a 24 29 0d 0a |d practice..$)..| 000002b0 0d 0a 41 4e 44 20 63 6f 64 65 63 68 61 72 28 63 |..AND codechar(c| 000002c0 68 61 72 29 20 3d 20 56 41 4c 4f 46 0d 0a 24 28 |har) = VALOF..$(| 000002d0 20 54 45 53 54 20 27 41 27 20 3c 3d 20 63 68 61 | TEST 'A' <= cha| 000002e0 72 20 3c 3d 20 27 5a 27 20 54 48 45 4e 0d 0a 20 |r <= 'Z' THEN.. | 000002f0 20 20 20 20 20 63 68 61 72 20 3a 3d 20 27 41 27 | char := 'A'| 00000300 20 2b 20 27 5a 27 20 2d 20 63 68 61 72 0d 0a 20 | + 'Z' - char.. | 00000310 20 20 45 4c 53 45 20 49 46 20 27 61 27 20 3c 3d | ELSE IF 'a' <=| 00000320 20 63 68 61 72 20 3c 3d 20 27 7a 27 20 54 48 45 | char <= 'z' THE| 00000330 4e 0d 0a 20 20 20 20 20 20 63 68 61 72 20 3a 3d |N.. char :=| 00000340 20 27 61 27 20 2b 20 27 7a 27 20 2d 20 63 68 61 | 'a' + 'z' - cha| 00000350 72 0d 0a 20 20 20 52 45 53 55 4c 54 49 53 20 63 |r.. RESULTIS c| 00000360 68 61 72 0d 0a 24 29 0d 0a 0d 0a |har..$)....| 0000036b