Cryptogram generator

cryptogram.reb

REBOL [
	title: "Cryptogram generator"
	author: "James Irwin"
	email: "rebolyte at Google's email thingy"
	date: 23-Mar-2015
]

alpha: [A B C D E F G H I J K L M N O P Q R S T U V W X Y Z]

the-file: ask "File of strings to encode: " 

if empty? the-file [
	the-file: "quotes.dat"
]

quotes: read/lines to file! the-file

out-blk: []

generate-code: does [
	print "--generating code"
	alpha-iter: copy alpha

	alpha-table: copy []

	foreach letter alpha [
		until [
			if (length? alpha-iter) = 1 and (letter = first alpha-iter) [
				print "** Hold on a sec, let's try this again"
				wait 0:0:01
				return generate-code
			]
			random/seed now/precise
			crypto-equiv: pick alpha-iter random length? alpha-iter
			; prin rejoin [length? alpha-iter " "]
			letter <> crypto-equiv
		]
		; print mold reduce [letter crypto-equiv]
		; print mold alpha-iter
		append alpha-table to char! form letter
		append alpha-table to char! form crypto-equiv
		remove/part find alpha-iter crypto-equiv 1
	]
	alpha-table
]

crypto: func [char-table string /local loc result] [
    result: copy ""
    foreach char string [
        append result either loc: find/case/skip char-table char 2
            [first next loc]
            [char]
    ]
    result
]

reverse-table: func [char-table [series!] /local reversed-table] [
	reversed-table: copy []
	foreach [alpha equiv] char-table [
		append reversed-table reduce [equiv alpha]
	]
	reversed-table
]

decrypto: func [char-table [series!] str [string!]] [
	crypto reverse-table char-table str
]

validate: does [
	foreach record out-blk [
		print decrypto record/1 record/2
	]
]

prettyprint: does [
	q-out-str: copy ""
	a-out-str: copy ""
	n: 1
	foreach record out-blk [
		; Write out the encoded string
		append q-out-str rejoin [n ". " record/2 newline newline]
		; Write out the formatted code table
		cur-a: copy ""
		sorted-table: copy reverse-table record/1
		sort/skip sorted-table 2
		foreach [char equiv] sorted-table [
			append cur-a reduce [char " = " equiv newline]
		]
		append a-out-str rejoin [
			n ". " newline 
			cur-a
		]
		n: n + 1
	]
	print q-out-str
	print a-out-str
]

print ["About to process" length? quotes "quotes."]
foreach quote quotes [
	record: copy []
	append/only record generate-code
	append record crypto first record uppercase quote
	append/only out-blk record
	; probe last out-blk
	wait 0:0:01
]

; print crypto generate-code uppercase quote

print "Done processing. Use PRETTYPRINT to generate a nicely-formatted string."

halt

quotes.dat

People who think they know everything are a great annoyance to those of us who do. --Isaac Asimov
When you are courting a nice girl an hour seems like a second. When you sit on a red-hot cinder a second seems like an hour. That's relativity. --Albert Einstein
I may be drunk, Miss, but in the morning I will be sober and you will still be ugly. --Winston Churchill
My fake plants died because I did not pretend to water them. --Mitch Hedberg
My grandmother started walking five miles a day when she was sixty. She's ninety-seven now, and we don't know where the hell she is. --Ellen DeGeneres