Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #59019

Re: Rosetta: Caesar cipher

Show all headers | View raw

On 5/9/2017 4:47 PM, Robert L. wrote:
>> Implement a Caesar cipher, both encoding and decoding.
>> The key is an integer from 1 to 25.
>>
>> This cipher rotates (either towards left or right) the letters
>> of the alphabet (A to Z).
>>
>> The encoding replaces each letter with the 1st to 25th next
>> letter in the alphabet (wrapping Z to A).
>>
>> So key 2 encrypts "HI" to "JK", but key 20 encrypts "HI" to "BC".
>
>
> (use srfi-13)
>
> (define lower-alphabet
>   (string-tabulate
>     (lambda(i) (integer->char (+ (char->integer #\a) i))) 26))
>
> (define (shifted-alphabet n)
>   ;; Rotate the lowercase letters.
>   (define s (xsubstring lower-alphabet n))
>   (string-append s (string-upcase s)))
>
> (define (encipher n str)
>   (string-translate str
>     (shifted-alphabet 0)
>     (shifted-alphabet n)))
>
> (define (decipher n str) (encipher (- n) str))
>
>
> (encipher 3 "However, the man wasn't there.[9]")
>  ===>
> "Krzhyhu, wkh pdq zdvq'w wkhuh.[9]"
>
> (decipher 3 (encipher 3 "However, the man wasn't there.[9]"))
>  ===>
> "However, the man wasn't there.[9]"
>
>
> In Forth?

Here is my attempt.   I had to work on this a bit as my string knowledge 
is a bit rusty... no, positively seized up!  I couldn't remember how to 
create strings in the various modes.  I'm not sure the test code will 
work universally.  It runs under Win32Forth.

marker rotc

: ScreenChar ( char -- char flag )  \ Check for alpha char
     dup [char] A dup 26 + within if [char] A else
         dup [char] a dup 26 + within if [char] a else
         FALSE then then ;

: RotChar ( char1 flag key -- char2 )  \ Rotate alpha char
     -rot tuck - rot + 26 mod + ;

0 value rotkey
variable tmpstr 30 chars allot

\ En/Decrypt the Caesar cipher with key
: RotCypher ( caddr u key -- ) \ Output to tmpstr
     to rotkey
     0 do                                ( caddr -- )
         dup I + c@ ScreenChar dup if    ( caddr char flag -- )
             rotkey RotChar else
             drop then                   ( caddr char -- )
         tmpstr I + c!                   ( caddr -- )
         loop
     drop ;

: "type" ( caddr u -- ) cr [char] " emit type [char] " emit .s ;

cr cr .( Start testing) .s
cr S" ABC mno 1, 2, 3" .s
2dup "type"
tuck 1 RotCypher tmpstr swap 2dup "type"
2dup 25 RotCypher "type"


-- 

Rick C

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Rosetta: Caesar cipher "Robert L." <No_spamming@noWhere_7073.org> - 2017-05-09 20:47 +0000
  Re: Rosetta: Caesar cipher Joel Rees <joel.rees@gmail.com> - 2017-05-09 20:20 -0700
    Re: Rosetta: Caesar cipher hughaguilar96@gmail.com - 2017-05-12 13:52 -0700
  Re: Rosetta: Caesar cipher rickman <gnuarm@gmail.com> - 2017-05-10 20:07 -0400
    Re: Rosetta: Caesar cipher Julian Fondren <julian.fondren@gmail.com> - 2017-05-10 21:12 -0700
      Re: Rosetta: Caesar cipher rickman <gnuarm@gmail.com> - 2017-05-11 01:50 -0400
        Re: Rosetta: Caesar cipher Julian Fondren <julian.fondren@gmail.com> - 2017-05-11 05:34 -0700
          Re: Rosetta: Caesar cipher Alex <alex@rivadpm.com> - 2017-05-11 14:39 +0100
            Re: Rosetta: Caesar cipher anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2017-05-11 16:04 +0000
              Re: Rosetta: Caesar cipher Alex <alex@rivadpm.com> - 2017-05-11 21:35 +0100
            Re: Rosetta: Caesar cipher mhx@iae.nl - 2017-05-11 10:21 -0700
          Re: Rosetta: Caesar cipher rickman <gnuarm@gmail.com> - 2017-05-12 13:41 -0400

csiph-web