'Program: teatry.tea
'Written in Teapro which uses the OpenTea technology
'Test a number to see if it is a prime number
'lines beginning with an apostrophe are comment lines
'wild_bill encryption
'old toe encryption
'People need computer software that actually works.
vari dg_pass1, dg_pass2

'call the subroutine sub_main
sub_main

'end the program
endp

subr sub_main
'updated 2006/08/27, 2006/04/14, 2006/03/03, 2003/03/23
    vari d_any, s_any, d_dot, s_dot
    vari s_pick, d_pick, d_loop

    d_loop = 1
        dwhi d_loop = 1
        $out "Program: teatry.tea, build 22, 2009/10/25"
	  $out "Copyright (c) 2002-2009 by D La Pierre Ballard"
	  $out "Written in Teapro which uses the OpenTea technology"

	  $out "People need computer software that actually works."
	  $out " "  

        $out "1. subroutine sub_try to test a number for primeness"
        $out "2. run subroutine sub_pnq30 to find PNQ30s"
        $out "3. test wild_bill encryption algorithm"
        $out "4. run wild_bill encryption"
	  $out "11. test old toe"
	  $out "12. old toe a file"
	  $out "98. prime speed test"
	  $out "99. speed test"
        $inp s_pick, "enter a number, * to end"
        $ift s_pick = "*": dinc d_loop

	  d_pick = 0
        $isd d_any, s_pick
        dift d_any = 1: $tod d_pick, s_pick

        dift d_pick = 1: sub_try
        dift d_pick = 2: sub_pnq30
        dift d_pick = 3: sub_test_wild_bill
        dift d_pick = 4: sub_wild_bill
	  dift d_pick = 11: sub_test_old_toe
	  dift d_pick = 12: sub_old_toe_file
	  dift d_pick = 98: sub_prime_speed_test
	  dift d_pick = 99: sub_speed_test
    endw
ends sub_main


subr sub_pnq30
'find pnq30s
'updated 2003/01/15
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_good, d_modulus
    vari d_count, d_primetest, s_date
    vari d_number, d_index, d_loop, d_divisor

    $out "finding PNQ30s"
    $out "enter the number to begin with which to begin testing"

    d_primetest = 0
    $inp s_any, "12345678901234567890123456789"
    $isd d_any, s_any
    dift d_any = 1: $tod d_primetest, s_any

    'get the first possible to test by finding the PIVCOM
    'and subtracting 19 from it
    d_primetest = d_primetest \ 210 * 210 - 19
    dift d_primetest < 1: d_primetest = d_primetest + 210

    'starting with 11 put 2000 primes in the decimal array
    d_number = 11
    d_index = 1

    dwhi d_index <= 2000
	  d_modulus = 99999
	  dwhi d_modulus > 1
		'test d_number to see if it is prime
		dfac d_modulus, d_number
		dift d_modulus > 1: d_number = d_number + 2
	  endw

	  'store the prime d_number at index d_index
	  'in the decimal array
	  dtoi d_index, d_number
	  dinc d_index

	  d_number = d_number + 2
    endw

    d_count = 0

    'go until the program is stopped
    dwhi 1 = 1

	  'the test number is the highest in a PNQ30 set
	  d_number = d_primetest + 38
	  d_index = 1
	  d_loop = 1

	  dwhi d_loop = 1
		itod d_divisor, d_index
		d_modulus = d_number % d_divisor

		dift d_modulus = 0: dinc d_loop
		dift d_modulus = 2: dinc d_loop
		dift d_modulus = 6: dinc d_loop
		dift d_modulus = 8: dinc d_loop
		dift d_modulus = 30: dinc d_loop
		dift d_modulus = 32: dinc d_loop
		dift d_modulus = 36: dinc d_loop
		dift d_modulus = 38: dinc d_loop

		dinc d_index
		dift d_index > 2000: d_loop = 99999
	  endw

	  dift d_loop = 99999
	      dfac d_good, d_primetest
	  else
		dinc d_good
	  endi

	  dift d_good = 1
		
		'we have a prime
		ded$ s_any, d_primetest, 0, 0
		$sho "prime=" + s_any 

		'is d_primetest + 2 a prime
		d_any = d_primetest + 2
	      dfac d_good, d_any
	 
	      dift d_good = 1
		    'is d_primetest + 6 a prime
		    d_any = d_primetest + 6
		    dfac d_good, d_any

		    dift d_good = 1
			  'is d_primetest + 8 a prime
			  d_any = d_primetest + 8
			  dfac d_good, d_any

			  dift d_good = 1

				
				'is d_primetest + 30 a prime
				d_any = d_primetest + 30
				dfac d_good, d_any

				dift d_good = 1
				    'is d_primetest + 32 a prime
				    d_any = d_primetest + 32
				    dfac d_good, d_any

				    dift d_good = 1
					  'is d_primetest + 36 a prime
					  d_any = d_primetest + 36
					  dfac d_good, d_any

					  dift d_good = 1
						'is d_primetest + 38 a prime
						d_any = d_primetest + 38
						dfac d_good, d_any

					      dift d_good = 1
						    'we have a PNQ30
						    $dat s_date
						    dinc d_count
	                                  ded$ s_dot, d_primetest, 0, 0

	                                  s_out = d_count + ". PNQ30= " 
						    s_out = s_out + s_dot + "  " + s_date

						    $out s_out
	                              endi
					  endi
				    endi
				endi
			  endi
		    endi
		endi
	  endi

        'go to next possible PNQ30
        d_primetest = d_primetest + 210
    endw
ends sub_pnq30


'define subroutine sub_try
subr sub_try
'updated 2002/11/10
    'setup local variables for this subroutine
    vari s_input, d_number, d_result, d_loop, d_good
    vari d_sec1, d_sec2, d_sec3

    $out "Program: teatry.tea, build 3, 2005/09/09"
    $out "Copyright (c) 2002-2005 D La Pierre Ballard"
    $out "Written in the Teapro programming Language"
    $out "Copyright (c) 1997-2005 D La Pierre Ballard"

    'put 1 into decimal variable d_loop
    d_loop = 1

    'loop while decimal variable d_loop is equal to 1
    dwhi d_loop = 1
	  'output a bunch of asterisks to separate different number tries
	  $out "******************************"

	  'output line "test a number to see if it is prime" on the screen
	  $out "test a number to see if it is prime"

	  'print "enter the number, return to end" on screen
	  'and enter use input into string s_input
	  $inp s_input, "enter the number, return to end"

	  'test s_input to see if it is a number then put 1 into d_good
	  'otherwise put 2 into d_good
	  $isd d_good, s_input

	  'if s_input is a decimal number
	  dift d_good = 1
		'change the string s_input into the number d_number
		$tod d_number, s_input

		'find the number of seconds since midnight 30-NOV-1899
		dsec d_sec1

		'find the lowest divisor of d_number and put into d_result
		dfac d_result, d_number

		'find the number of seconds since midnight 30-NOV-1899
		dsec d_sec2

		'find the number of seconds that have elapsed
		d_sec3 = d_sec2 - d_sec1

		'output the number of seconds that elapsed
		$out "seconds = " + d_sec3

		'show the lowest divisor of d_number
		$out "lowest divisor is = " + d_result

		'if the lowest divisor is 1 then the number is prime
		dift d_result = 1: $out "the number is prime"
	  else
		'increment d_loop to drop out of the loop
		dinc d_loop
 	  endi

    'end the while loop: dwhi d_loop = 1
    endw

'end the subroutine sub_try
ends sub_try


subr sub_wild_bill
'wild_bill file encryption
'updated 2003/03/23
    vari d_any, s_any, d_dot, s_dot
    vari d_grab, s_file1, s_file2, d_encryptyes
    vari d_char, s_char, d_shift, d_good
    vari d_byte, s_record, d_loop, d_long, d_filelen
    vari d_numbernew, d_numberbeg, d_count
    vari s_out, d_high, d_low, d_bigprime
    vari s_alpha, s_keyword

    s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    d_good = 1
    $tod d_bigprime, "10531061"

    $inp s_file1, "Enter the name of the first file"
    $inp s_file2, "Enter the name of the second file"

    $inp s_keyword, "Enter a keyword, alphanumeric please"

    $inp s_char, "1 = encrypt, 2= unencrypt"
    d_encryptyes = 1
    $ift s_char = "2": d_encryptyes = 2

    'numbers are 48/57
    'letters are 65/90
    'char are 33/126
    'the space is 32

    dift d_good = 1
        $cup s_keyword, s_keyword
        $trb s_keyword, s_keyword
        $cut s_keyword, s_keyword, 1, 10

        'validate
	  $len d_long, s_keyword
	  d_numberbeg = 0
        d_dot = 1

	  'change s_keyword to a beginning number d_numberbeg
        dwhi d_dot <= d_long
	      $cut s_char, s_keyword, d_dot, 1
	      $lok d_char, s_alpha, 1, s_char
		dift d_char > 0: d_numberbeg = d_numberbeg * 36 + d_char
		$out d_numberbeg

	      dinc d_dot
        endw

	  d_numberbeg = d_numberbeg % d_bigprime
	  d_numbernew = d_numberbeg
    endi

    dift d_good = 1
	  'validate the file names
	  $cup s_file1, s_file1
	  $cup s_file2, s_file2

	  flen d_filelen, s_file1
	  dift d_filelen < 1
		dinc d_good
		$out "the first file does not exist"
	  endi
    endi

    dift d_good = 1
	  'delete s_file2
	  fdel d_any, s_file2

	  'set the record size at 4000 bytes
	  d_grab = 4000
	  d_byte = 1
	  d_count = 0
    endi

    d_loop = d_good
    dwhi d_loop = 1
	  'show where we are reading in the file
	  $out d_byte

	  'read from s_file1 at d_byte for length d_grab
	  frea s_record, s_file1, d_byte, d_grab

	  'if s_record has 0 length we have finished
	  $len d_long, s_record
	  dift d_long > 0
		d_dot = 1
		dwhi d_dot <= d_long
		    'get the next number
		    d_numbernew = d_numbernew + 17 * 3 % d_bigprime

		    dinc d_count

		    'cut from the record the character at d_dot
		    $cut s_char, s_record, d_dot, 1

		    'change the character to its ascii number
		    $chd d_char, s_char

		    'skip if less than blank or greater than tilde
		    'from blank to tilde there are 95 characters
		    dift d_char >= 32
			  dift d_char <= 126

				'get amount to shift				
				d_shift = d_numbernew % 95 + 1

				'shift + if encrypting - if not
		    		dift d_encryptyes = 1
				    d_char = d_char + d_shift			
			      else
				    d_char = d_char - d_shift			
			      endi 

				'make sure new character is within
				'blank to tilde
				dift d_char < 32: d_char = d_char + 95
				dift d_char > 126: d_char = d_char - 95

				'change ascii number back to character
				dch$ s_char, d_char, 1

				'put back in the record at byte d_dot
				$rep s_record, d_dot, s_char
			  endi
		    endi

		    dinc d_dot
		endw

		'output the record to the new file
		fwri d_any, s_file2, d_byte, s_record		
	  endi
	  d_byte = d_byte + d_grab
	  dift d_byte > d_filelen: dinc d_loop
    endw
    $out "count of bytes=" + d_count
ends sub_wild_bill


subr sub_test_wild_bill
'updated 2003/03/23
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_good, d_loop
    vari d_numbernew, d_numberbeg, d_count
    vari d_high, d_low, d_tellcount, d_bigprime

    d_good = 1
    $tod d_bigprime, "10531061"
    dift d_good = 1
	  $inp s_any, "enter any number to start ie. 1234567"
	  $tod d_numbernew, s_any

	  dpow d_tellcount, 10, 5
	  dpow d_low, 10, 10
	  d_high = 0
	  d_count = 0
	  d_numberbeg = d_numbernew
	  d_loop = 1

 	  dwhi d_loop = 1
		'show every so often
		d_any = d_count % d_tellcount
		dift d_any = 0
		    ded$ s_any, d_count, 0, 15
		    ded$ s_dot, d_numbernew, 0, 15
		    s_out = "count=" + s_any + " number=" + s_dot

		    ded$ s_any, d_low, 0, 15
		    ded$ s_dot, d_high, 0, 15
		    $app s_out, ", low=" + s_any + ", high=" + s_dot

		    $out s_out
		endi

		'calculate the next number in the sequence
	      d_numbernew = d_numbernew + 17 * 3 % d_bigprime

		'count and keep highest and lowest
	      dinc d_count
		dift d_numbernew > d_high: d_high = d_numbernew
		dift d_numbernew < d_low: d_low = d_numbernew

		'when sequence returns to beginning number
	      dift d_numbernew = d_numberbeg
		    ded$ s_any, d_count, 0, 15
		    ded$ s_dot, d_numbernew, 0, 15
		    s_out = "count=" + s_any + " number=" + s_dot

		    ded$ s_any, d_low, 0, 15
		    ded$ s_dot, d_high, 0, 15
		    $app s_out, ", low=" + s_any + ", high=" + s_dot

		    $out s_out

		    dinc d_loop
	      endi
	  endw
    endi
    $inp s_any, "return"
ends sub_test_wild_bill


subr sub_test_old_toe
'updated 2006/04/08, 2003/03/23
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_good, d_loop
    vari d_numbernew, d_numberbeg, d_count
    vari d_high, d_low, d_tellcount, d_bigprime

    d_good = 1
    $tod d_bigprime, "61,000,001"
    dift d_good = 1
	  d_numbernew = 12345678
	  $inp s_any, "enter number to start default=12,345,678"
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_numbernew, s_any

	  dpow d_tellcount, 10, 5
	  dpow d_low, 10, 10
	  d_high = 0
	  d_count = 0
	  d_numberbeg = d_numbernew
	  d_loop = 1

 	  dwhi d_loop = 1
		'show every so often
		d_any = d_count % d_tellcount
		dift d_any = 0
		    ded$ s_any, d_count, 0, 0
		    ded$ s_dot, d_numbernew, 0, 0
		    s_out = "count=" + s_any + " number=" + s_dot

		    ded$ s_any, d_low, 0, 0
		    ded$ s_dot, d_high, 0, 0
		    $app s_out, ", low=" + s_any + ", high=" + s_dot

		    $out s_out
		endi

		'calculate the next number in the sequence
	      d_numbernew = d_numbernew * 7 + 23 % d_bigprime

		'count and keep highest and lowest
	      dinc d_count
		dift d_numbernew > d_high: d_high = d_numbernew
		dift d_numbernew < d_low: d_low = d_numbernew

		'when sequence returns to beginning number
	      dift d_numbernew = d_numberbeg
		    ded$ s_any, d_count, 0, 0
		    ded$ s_dot, d_numbernew, 0, 0
		    s_out = "count=" + s_any + " number=" + s_dot

		    ded$ s_any, d_low, 0, 0
		    ded$ s_dot, d_high, 0, 0
		    $app s_out, ", low=" + s_any + ", high=" + s_dot

		    $out s_out

		    dinc d_loop
	      endi
	  endw
    endi
    $inp s_any, "return"
ends sub_test_old_toe


subr sub_old_toe_file
'updated 2006/04/14
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_good, d_loop, d_process, d_long, d_byte, s_byte
    vari d_number, d_count, d_char, d_slip
    vari d_high, d_low, d_tellcount, d_bigprime
    vari s_filename1, s_filename2, s_key, s_data, d_which

    d_process = 1
    dift d_process = 1
	  $inp s_filename1, "enter name of file1"
	  $ift s_filename1 = "*": dinc d_process
    endi
    dift d_process = 1
	  $inp s_filename2, "enter name of file2"
	  $ift s_filename2 = "*": dinc d_process
    endi
    dift d_process = 1
	  $inp s_key, "enter keyword"
	  $ift s_key = "*": dinc d_process
    endi
    dift d_process = 1
	  $inp s_any, "1=code, 2=decode"
	  $ift s_any = "*": dinc d_process
	  d_which = 1
	  $ift s_any <> "1": d_which = 2
    endi
    dift d_process = 1
        $tod d_bigprime, "61,000,001"
	  fdel d_any, s_filename2
    endi
    dift d_process = 1
	  finp s_data, s_filename1

	  $cup s_key, s_key
	  $cut s_key, s_key, 1, 8
	  $len d_long, s_key

	  d_number = 0
	  d_byte = 1
	  dwhi d_byte <= d_long
		$cut s_byte, s_key, d_byte, 1
		$ift s_byte >= "0"
		    $ift s_byte <= "9"
			  $chd d_char, s_byte
			  d_number = d_number * 10 + d_char
			  dift d_number > d_bigprime
				d_number = d_number - d_bigprime
			  endi			  
		    endi
		endi
		$ift s_byte >= "A"
		    $ift s_byte <= "Z"
			  $chd d_char, s_byte
			  d_number = d_number * 10 + d_char
			  dift d_number > d_bigprime
				d_number = d_number - d_bigprime
			  endi			  
		    endi
		endi
		dinc d_byte
	  endw

	  $len d_long, s_data
	  d_count = 0
	  d_byte = 1
	  d_loop = 1

 	  dwhi d_loop = 1
		'calculate the next number in the sequence
	      d_number = d_number * 7 + 23 % d_bigprime
		d_slip = d_number \ 103 % 95 + 1

		$cut s_byte, s_data, d_byte, 1
		$chd d_char, s_byte
		dift d_char >= 32
		    dift d_char <= 126
			  dift d_which = 1
				d_char = d_char + d_slip
				dift d_char > 126: d_char = d_char - 95
			  else
				d_char = d_char - d_slip
				dift d_char < 32: d_char = d_char + 95
			  endi
			  dch$ s_byte, d_char, 1
			  $rep s_data, d_byte, s_byte

			  dinc d_count
		    endi
		endi

		dinc d_byte
		dift d_byte > d_long: dinc d_loop
	  endw

	  fout d_any, s_filename2, s_data
	  dbad d_any = 0
    endi

    $inp s_any, "done, ct=" + d_count
ends sub_old_toe_file


subr sub_prime_speed_test
'updated 2006/08/27, 2006/08/26
'2006/03/03, 2005/12/11, 2005/10/08, 2004/02/15, 2004/02/14
'find the first 500,000 or 100,000 primes to test for speed
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_sec1, d_sec2, d_sec3, d_loop, d_count
    vari d_todocount, s_dash, d_action, d_tealines
    vari d_testprime, d_primetotal, d_lastprime

    dsys d_tealines, 2

    'd_action=1 for using DFAC
    'd_action=2 for not using DFAC
    d_action = 2
    dift d_action < 99
        $ch$ s_dash, "-", 76

        $inp s_any, "1=use dfac"
	  $ift s_any = "*": d_action = 99999
        $ift s_any = "1": d_action = 1
    endi
    dift d_action = 1
	  'use DFAC 500,000
        d_todocount = 500 * 1000
	  ded$ s_any, d_todocount, 0, 0
        $out "finding the first " + s_any + " primes"
    endi
    dift d_action = 2
	  'do not use DFAC 100,000
        d_todocount = 100 * 1000
	  ded$ s_any, d_todocount, 0, 0
        $out "finding the first " + s_any + " primes"
    endi

    dsec d_sec1
    d_primetotal = 1 + 2 + 3
    d_lastprime = 3

    '1,2,3 are presumed
    d_count = 3
    d_testprime = 5
    d_loop = d_action

    dwhi d_loop = 1 
	  'find primes with DFAC
	  dfac d_any, d_testprime
	  dift d_any = 1
	      'we have a prime
		d_lastprime = d_testprime
		d_primetotal = d_primetotal + d_testprime

		dinc d_count
		dift d_count >= d_todocount: d_loop = 99
	  endi

	  d_testprime = d_testprime + 2
    endw
    dwhi d_loop = 2 
	  'find primes without DFAC
	  dg_pass1 = d_testprime
	  sub_prime_test_simple
	  dift dg_pass1 = 1
	      'we have a prime
		d_lastprime = d_testprime
		d_primetotal = d_primetotal + d_testprime

		dinc d_count
		dift d_count >= d_todocount: d_loop = 99
	  endi

	  d_testprime = d_testprime + 2
    endw

    dsec d_sec2
    dift d_action < 99
        d_sec3 = d_sec2 - d_sec1

        $out s_dash
    
        ded$ s_any, d_primetotal, 0, 0
        $out "Prime total = " + s_any

        ded$ s_any, d_lastprime, 0, 0
        $out "Last prime = " + s_any

        ded$ s_any, d_count, 0, 0
        $out "Primes count = " + s_any

        $out s_dash
    endi
    dift d_action = 1
        $out "The above numbers should be as follows."
        $out "Prime total = 1,774,817,902,653"
        $out "Last prime = 7,368,743"
        $out "Primes count = 500,000"

        $out s_dash

        $out "The time was " + d_sec3 + " seconds."

        $out s_dash
    endi
    dift d_action = 2
        $out "The above numbers should be as follows."
        $out "Prime total = 62,259,399,013"
        $out "Last prime = 1,299,689"
        $out "Primes count = 100,000"

        $out s_dash

        $out "The time was " + d_sec3 + " seconds."

        $out s_dash
    endi
       
    dsys d_any, 2
    d_tealines = d_any - d_tealines
    ded$ s_any, d_tealines, 0, 0
    $out "total lines=" + s_any

    $inp s_any, "return"
ends sub_prime_speed_test


subr sub_prime_test_simple
'updated 2006/08/27, 2006/08/26, 2006/08/04, 2005/02/14, 2005/02/13
'2005/02/09, 2005/02/06, 2005/01/30, 2004/11/27, 2003/04/11
'simple test dg_pass1 for prime, if prime set dg_pass1 to 1
'otherwise set dg_pass1 to the divisor
'return number of tealines in dg_pass2
    vari d_any, s_any, d_dot, s_dot
    vari d_number, d_try, d_root, d_mod
    vari d_loop, d_result

    'make positive whole number 
    d_number = dg_pass1 \ 1
    dabs d_number, d_number

    'get root of
    d_any = 1 / 2
    dpow d_root, d_number, d_any

    d_result = 1

    dift d_number > 3
        'first try 2
        d_mod = d_number % 2
        dift d_mod = 0: d_result = 2
    endi

    d_try = 3
    d_loop = d_result
    dift d_try > d_root: dinc d_loop

    dwhi d_loop = 1
	  'test d_try
	  d_mod = d_number % d_try

	  dift d_mod = 0
	      'd_number is not prime
	      dinc d_loop
	      d_result = d_try
	  else
	      d_try = d_try + 2
	      dift d_try > d_root: dinc d_loop
	  endi		
    endw

    dg_pass1 = d_result
ends sub_prime_test_simple


subr sub_speed_test
'updated 2005/10/08, 2004/02/14
'speed of computer
    vari d_any, s_any, d_dot, s_dot
    vari d_sec1, d_sec2, d_sec3, d_count, d_total

    $ch$ s_dot, "-", 76
    $out s_dot

    $out "We are looping 10,000,000 times"

    d_count = 0
    d_total = 10000 * 1000

    'loop ten million times
    dsec d_sec1
    dwhi d_count < d_total
	  dinc d_count
    endw
    dsec d_sec2

    d_sec3 = d_sec2 - d_sec1

    $out "The time was " + d_sec3 + " seconds."

    $out s_dot  
    $inp s_any, "return"
ends sub_speed_test