home *** CD-ROM | disk | FTP | other *** search
10 rem 'cryptogram assistant' for the commodore 64 20 : 30 rem (c) 1988 by ian adam vancouver, british columbia 40 : 50 rem published by softdisk publishing incorporated 60 : 70 rem these extra functions available: 80 : 90 rem sys 828 ,r [,c] move cursor: 100 rem sys 853 ,w ,v screens 4, 8, 12 110 rem sys 883 unlink screen 120 rem sys 894 printer check 130 : 140 gosub 2660, data 150 gosub 2890, instructions 160 gosub 5240, printer controls 170 dim s(255), xr(128), e(128) 180 : 190 rem **** main control loop **** 200 : 210 gosub 4990:rem print menu, screen 3 220 gosub 5730 230 if ff then on ff gosub 380, 340, 6120, 340, 2890, 3100, 5240, 260:goto 210 240 goto 220 250 : 260 m$(2)="[150] [197]nd the [208]rogram" 265 if peek(56)=128 then if peek(32768)=76 then up=1 270 if up then m$(3)="[150] & [210]eturn to [213]p[212]ime" 280 m$(5)=" -[193]re you [211]ure? [217]/[206]" 290 gosub 7260, message box 300 gosub 5730, response 310 if a$<>"y" then return 320 poke 44,8:poke 2048,0:sys 853,4,4 330 if up then sys 32772 335 end 340 return 350 : 360 : ***** puzzle solution ***** 370 : 380 print"[147]";:sys 853,8,12:gosub 3580 390 print "[159]enter the message you want to decode," 400 print "then press return when finished, or:" 410 print " press f3 for a sample puzzle to solve." 420 print " press f5 to retrieve a puzzle you" 430 print " saved earlier." 440 print " press f7 to quit and go to the menu." 450 sys 853,8,8:print"[142]";:sys 828,20:print"[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]" 460 s1=8:sl=9:ex=0 470 gosub 1970 480 : 490 if ff=3 then gosub 5810:goto 510 500 if ff=5 then gosub 1840 510 if n<2 thenreturn 520 s1=4 530 sys 853,4,4:gosub 2270:gosub 2120 540 sys 853,8,4:gosub 2280:gosub 1050 550 : 560 rem ** solution loop ** 570 : 580 for m=1 to 2 step 0 590 if p1<0 then poke 53265,11:sys 853,12,s1:sys 883:gosub 1080:gosub 2280,paint 600 if p1>3 then sys 853,4,s1:gosub 2270:gosub 2200:sys 853,8,s1:gosub 2270 610 if p1 and 1 then gosub 1520,do pg 1 620 if p1>1 then gosub 1050, do pg 2 630 p1=0:b$="":sys 853,s1,s1 640 : 650 sys 828,22:print " [145]":rem clear input 660 print b$; 670 print "[166][157]";:poke 204,.:gosub 5730:poke 204,1 680 : 690 if as>=k then if as<=l then b$=b$+a$:goto 650 700 if as=j then gosub 1220:next 710 if as=20 or as=157 then if b$>"" then print " [157][157] [157]";:b$=left$(b$,len(b$)-1):goto 670 720 if a$="_" then s1=12-s1:next:change screens 730 for i=1 to 3 740 if a$=mid$("+-*",i,1) then print a$;:on i gosub 1360, 1450, 960:next m 750 next 760 on ff goto 2440, 1680, 1600, 2110, 810, 770, 2500, 2580 770 next 780 : 790 : ** print trial solution ** 800 : 810 poke 2,sa:sys 894 820 if peek(144)<k7 then 870:rem is printer there? 830 close 4 840 print"[150]can't find the printer- press space bar"; 850 gosub 5730:next m 860 : 870 print#4:close 4:open 4,4,sa:cmd 4 880 print:print "[195]ryptogram [193]ssistant":print 890 print "[195]ryptogram entered:":print:print r$:print 900 print "[212]rial solution:":print:gosub 1550:print:print 910 print:gosub 1110:print#4 920 close 4:next m 930 : 940 : ** offsets ** 950 : 960 s1=4:poke 648,4:sys 828,22 970 print "[158][208]ress [193]ny [203]ey to [211]top..." 980 for a=k to l:gosub 1380:if peek(kb)=0 then next:return 990 poke kb,0:a=a-k+1:for i=k to l:e(i)=e(i)+a:if e(i)>l then e(i)=e(i)-k3 1000 next:if os<l then os=os+a:if os>25 then os=os-k3 1010 return 1020 : 1030 : ** count letters ** 1040 : 1050 for i=k to l:xr(i)=.:next 1060 for i=1 to n:xr(s(i))=xr(s(i))+1:next 1070 sys 853,8,s1 1080 print "[159]"; 1090 for i=0 to j:print " ":next 1100 print "[159]"; 1110 print "frequency: cipher: "; 1120 if os<l then sys 828,0,28:print "offset:"os; 1130 sys 883:poke 646,1 1140 print:for i=k to 77:ii=i+j 1150 print chr$(i) spc(1+(xr(i)>9)) xr(i) " " chr$(ii) spc(1+(xr(ii)>9)) xr(ii); 1160 print " " chr$(i) " " chr$(e(i)) " " chr$(ii) " " chr$(e(ii)) 1170 next 1180 return 1190 : 1200 rem ** exchange letters ** 1210 : 1220 if len(b$)<2 then b$=c$ 1230 a=asc(b$):if a<k or a>l then return 1240 for i=2 to len(b$):c=asc(mid$(b$,i)):if c<k or c>l then next:return 1250 for i=1 to n:if s(i)=a then s(i)=c:next:goto 1280 1260 if s(i)=c then s(i)=a 1270 next 1280 for i=k to l:if e(i)=a then e(i)=c:next:goto 1310 1290 if e(i)=c then e(i)=a 1300 next 1310 os=l:c$=b$:p1=3 1320 return 1330 : 1340 : ** advance alphabet ** 1350 : 1360 for i=k to l:e(i)=e(i)+1+k3*(e(i)=l):next 1370 if os<l then os=(os+1)*abs(os<25) 1380 for i=1 to n 1390 if s(i)=l then s(i)=k:next:goto 1520 1400 if s(i)>=k then if s(i)<l then s(i)=s(i)+1 1410 next:p1=2:goto 1520 1420 : 1430 : ** retract alphabet ** 1440 : 1450 for i=k to l:e(i)=e(i)-1-k3*(e(i)=k):next 1460 if os<l then os=(os-1)-k3*(os<-11) 1470 for i=1 to n:if s(i)>=k then if s(i)<=l then s(i)=s(i)-1-k3*(s(i)=k) 1480 next:p1=2 1490 : 1500 rem ** show solution ** 1510 : 1520 sys 853,4,s1 1530 sys 828,sl 1540 print ""; 1550 for i=1 to n:print chr$(s(i));:next 1560 sys 883:return 1570 : 1580 : ** modify puzzle ** 1590 : 1600 sys 853,8,s1 1610 print "[147]modify puzzle." 1620 print "[158]make necessary changes, then return:[159]" 1630 sys 853,8,8:gosub 1980 1640 goto 510, start again 1650 : 1660 : ** save puzzle ** 1670 : 1680 sys 853,12,s1 1690 print "[147][158][211]ave [212]his [208]uzzle:" 1700 print "[159][213]p to 8 cryptograms may be held in" 1710 print " temporary program buffers." 1720 if sp=0 then 1760 1730 print:print "[194]uffers occupied:"; 1740 for i=1 to 8:if b(i) then print i; 1750 next:print 1760 print:print "[159][208]ress [198]1 to [198]8 to designate the" 1770 print "buffer, any other key to cancel:" 1780 sys 853,12,12:poke 204,1:gosub 5730:print ff 1790 if ff then sp$(ff)=r$:sp=1:b(ff)=1 1800 p1=-8:next 1810 : 1820 : ** retrieve saved puzzle ** 1830 : 1840 n=0:ii=0:print "[147][210]etrieve [211]aved [208]uzzle: [158]"; 1850 if sp=0 then print:print "[206]o saved puzzles in memory!![159]":gosub 5590:return 1860 : 1870 for c=1 to 8 1880 if b(c)=0 then 1910 1890 if peek(214)>19 then if len(sp$(c))>79 then if ii=0 then gosub 5520 1900 print:print "[158][208]ress "c"[157][157][157][198]: [159]" sp$(c);:if c<8 then print 1910 next 1920 gosub 5730:if ff then r$=sp$(ff):n=len(r$) 1930 return 1940 : 1950 : ** enter puzzle ** 1960 : 1970 r$="":n=0:poke 53272,37 1980 sys 828,21 1990 print r$;:for n=n to 158 2000 poke 204,0 2010 gosub 5730:if ff or as=j then 2070 2020 as=as and k7 2030 if as>=k2 then 2060 2040 if a$=chr$(20) then if n then print a$;:n=n-1:r$=left$(r$,n) 2050 goto 2000 2060 print a$;:r$=r$+a$:next 2070 poke 204,1:print "[147]":return 2080 : 2090 : ** organize & display puzzle ** 2100 : 2110 gosub 2120:s1=4:p1=2:next m:rem from submenu 2120 c$="aa" 2130 for i=1 to n:s(i)=asc(mid$(r$,i)) and k7 2140 if s(i)<k2 then s(i)=k2 2150 next 2160 for i=k to l:e(i)=i:next:os=0 2170 : 2180 rem ** display page 1 ** 2190 : 2200 sys 853,4,s1:print "[159] ":print "[195][210][217][208][212][207][199][210][193][205] [197][206][212][197][210][197][196]:":print r$ 2210 sys 828,sl*.85:print "[212][210][201][193][204] [211][207][204][213][212][201][207][206]:" 2220 gosub 1530:sys 853,4,4 2230 return 2240 : 2250 rem ** command area ** 2260 : 2270 print "[147]" 2280 sys 828,14 2290 print "[158][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][181]"; 2300 print "[150] [195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212] [194]y [201]an [193]dam [158][146][181][157][181][157][181][157][181][157][181][157][181][157][181][157][181][157][181]"; 2310 print"[150] [208]ublished by [211]oftdisk [208]ublishing, [201]nc.":poke56295,7:poke2023,117 2320 sys 883:sys 828,16 2330 print "[159][197]nter two letters to exchange, or:" 2340 print "_ [211]witch +- [207]ffset * [204]oop [193]dvance" 2350 print "[198]1 [201]nstructions [198]2 [210]emember this" 2360 print "[198]3 [205]odify [208]uzzle [198]4 [210]estore [208]uzzle" 2370 print "[198]5 [208]rint [208]uzzle [198]7 [209]uit [208]uzzle" 2380 poke 53265,27:if ex then print "[145][198]8 [211]ee [211]olution" 2390 print " " 2400 return 2410 : 2420 : ** help ** 2430 : 2440 gosub 2890, instructions 2450 print "[147]":s1=4:p1=7 2460 c=0:gosub 5690:next m 2470 : 2480 : ** scrap puzzle ** 2490 : 2500 sys 828,22 2510 print "[150][193]bandon this [208]uzzle: [193]re [217]ou [211]ure? [217]/[206]" 2520 gosub 5730 2530 if a$="y" then ex=0:print "[147][145]":return 2540 next m 2550 : 2560 : ** see solution ** 2570 : 2580 if ex=0 then next m 2590 s1=4:sys 853,s1,s1:sys 828,sl 2600 print "[150]"s$"";:sys 883 2610 sys 828,22:gosub 5600:gosub 5730 2620 p1=1:next m 2630 : 2640 : ** setup & instr'ns ** 2650 : 2660 print "[147]":for i=828 to 920:read a:poke i,a:next 2670 l=90:k=65:k3=26:j=13 2680 dim c,ii,os,ff,as,ex,s1,n,m,p1,sp,a$,b$,c$,r$,s$ 2690 k2=32:k7=127:sl=9:kb=198:c0=53280:c1=c0+1:sa=7 2700 return 2710 rem ------- 2720 : 2730 data 32, 241, 183, 138, 72, 160, 1, 136, 177, 122, 201, 44, 208 2740 data 5, 32, 241, 183, 138, 168, 104, 170, 24, 76, 240, 255 2750 rem ------- 2760 : 2770 data 32, 241, 183, 134, 210, 142, 136, 2, 162, 0, 134, 209, 134, 243 2780 data 162, 216, 134, 244, 32, 241, 183, 138, 10, 10, 9, 7, 141, 24, 208, 96 2790 rem ------- 2800 : 2810 data 162, 24, 54, 217, 56, 118, 217, 202, 208, 248, 96 2820 rem ------- 2830 : 2840 data 169, 4, 32, 195, 255, 162, 4, 138, 164, 2, 32, 186, 255 2850 data 169, 0, 32, 189, 255, 32, 192, 255, 162, 4, 32, 201, 255, 96 2860 : 2870 rem ** instructions ** 2880 : 2890 b$=chr$(j) 2900 gosub 3510:rem print page 1 2910 if ff then return 2920 sys 853,4,8:gosub 3840:rem print 2 2930 sys 853,8,4:gosub 4060:rem print 3 2940 a=1:gosub 5660:rem user, show #2 2950 if ff then return 2960 gosub 4250:rem print #4 2970 a=2:gosub 5660:rem show #3 2980 if ff then return 2990 gosub 4510:rem print #5 3000 a=1:gosub 5660:rem show #4 3010 if ff then return 3020 gosub 4770:rem print #6 3030 if ff then return 3040 a=2:c=0:gosub 5670:rem show #5 3050 sys 853,4,4:gosub 5520:rem hold #6 3060 return 3070 : 3080 : ** print instructions ** 3090 : 3100 sys 853,12,s1:b$="" 3110 print "[147][158]" tab(49) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]":print 3120 print "[158][208]rint the [201]nstructions:" 3130 print " [197]nsure printer is turned on, and" 3140 print " lined up at the top of the page." 3150 print:print:print "[158][208]ress:" 3160 print:print " [198]1 [208]roceed to [208]rint" 3170 print:print " [198]3 [195]hange [211]econdary [193]ddress" 3180 print:print " [198]5 [195]ancel" 3190 sys 853,12,12:s1=12:c=6:gosub 5690:gosub 5730 3200 if ff=1 then 3250 3210 if ff=3 then gosub 5240:goto 3100 3220 if ff=5 or ff=7 then return 3230 goto 3190 3240 : 3250 print "[158][208][210][201][206][212][201][206][199]...." 3260 poke 2,sa:sys 894 3270 if peek(144)<k7 then 3370:rem is printer there? 3280 : 3290 close 4:rem no printer 3300 m$(2)="[150] can't find" 3310 m$(3)="[150] the printer!!" 3320 m$(5)=" press space bar" 3330 c=0:gosub 5690 3340 gosub 7260 3350 gosub 5730:return 3360 : 3370 print:print:print " [195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212] for the 64":print:print 3380 print "(c) [201]an [193]dam [214]ancouver [194].[195]. and [211]oftdisk [208]ublishing [201]nc.":print 3390 gosub 3700:print:rem 1st page 3400 gosub 3850:rem 2nd page 3410 gosub 4070:rem 3rd page 3420 gosub 4260:rem 4th page 3430 print chr$(12) 3440 gosub 4520:rem 5th page 3450 gosub 4780:rem 6th page 3460 print#4:print#4, chr$(12) 3470 close 4:return 3480 : 3490 : ** 1st page instructions ** 3500 : 3510 print "[147]":poke 648,4:print "[147]" 3520 sys 853,8,4 3530 gosub 3580:gosub 3700 3540 poke c1,0:poke c0,0:poke 53272,37 3550 gosub 5520 3560 print "[147]":return 3570 : 3580 print "[147][142]" tab(9) "[158][169] [223] [223] [223] [169] [223]" 3590 print tab(9) " " 3600 print tab(9) " [146][169][223] [146][169] [146][169] " 3610 print tab(9) " [146][223][223] " 3620 print tab(9) "[223] [146][169] [146][223][223] [146][223] [146][169]" 3630 print "[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]" 3640 print tab(8) "[149][169] [146][169][169][146][169][169][146][169][169][146][169][169][146][169][169][146][169][169][146][169]" 3650 print tab(7) "[169][146][169][185][206][169] [183][146][169][169] [183][183][146][169][169][146][169][169][146][169]" 3660 print tab(6) "[169][146][169][169][146][169][223][223] [169][146][169][169][146][169][169][146][169][169][146][169]" 3670 print tab(6) " [146][169] [146][169] [146][169] [146][169] [146][169]" 3680 return 3690 : 3700 print "welcome to cryptogram assistant!":print 3710 print " - the cryptogram is a form of secret "; 3720 print "message that can be read by means of" 3730 print "a code, or cipher. each letter of the "b$; 3740 print "alphabet is replaced by another letter." 3750 print "the encoded message appears at first to "; 3760 print "be just a random collection of letters;" 3770 print "however, once you know the code, it is "b$; 3780 print "easy to discover the original message," 3790 print "by restoring the letters."; 3800 return 3810 : 3820 : ** 2nd page instructions ** 3830 : 3840 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]" 3850 print:print "[211]olving a cryptogram will require "b$; 3860 print "considerable ingenuity on your part." 3870 print "[212]rial and error is not a practical way "b$; 3880 print "of discovering the code: the number of" 3890 print "possible ciphers is 26 factorial, about "; 3900 print "400 million billion billion! [201]f you" 3910 print "programmed a computer to search for all "; 3920 print "the possible solutions, it would take" 3930 print "more time than the universe has been in "; 3940 print "existence just to print them out.":print b$ 3950 print "[195]learly, deciphering a message depends "b$; 3960 print "on finding some clues to narrow the" 3970 print "range of solutions. [212]he combination of "; 3980 print "human intellect and the computer's" 3990 print "speed can be very successful in solving "; 4000 print "the puzzle." 4010 if len(b$) then print:print "[208]ress [198]7 to bypass instructions, or..." 4020 return 4030 : 4040 : ** 3rd page instructions ** 4050 : 4060 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]" 4070 print:print "[212]his program will help in several ways. "; 4080 print "[198]irst, it keeps track of how often each" 4090 print "letter appears in the puzzle, because "b$; 4100 print "this often gives clues when deciding" 4110 print "on substitutions. [211]econd, the program "; 4120 print "will assist you by making the changes" 4130 print "you have requested quickly and easily. "; 4140 print "[198]inally, if the cipher consists of a" 4150 print "simple offset, then there are only 26 "b$; 4160 print "solutions, a more manageable total!" 4170 print "[212]he program will generate and display "b$; 4180 print "all possible results for you.":print 4190 print "* - [212]he most common letters, in order:":print 4195 print "e t o a n i r s h":print 4200 print "[212]he most common combinations:":print 4205 print "th he an er on re the and tha" 4210 return 4220 : 4230 : ** 4th page instructions ** 4240 : 4250 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]" 4260 print:print "[197]ach substitution is made by trading a "b$; 4270 print "pair of letters. [193]t the prompt, simply" 4280 print "type the two letters to be exchanged & "b$; 4290 print "press [210][197][212][213][210][206]. [212]he modified puzzle will" 4300 print "be updated and displayed. [201]f the result"; 4310 print " [157]isn't [207][203], press [210][197][212][213][210][206] to reverse the" 4320 print "exchange. [212]his makes it easy to "b$; 4330 print "experiment. [215]ith successive exchanges," 4340 print "the cipher is completed. [212]o see this, "; 4350 print " choose 'demonstration solution'.":print 4360 print "[212]he program deals with two basic kinds "b$; 4370 print "of cryptogram. [201]n the most common kind" 4380 print "the code is completely random, so you "b$; 4390 print "need to know or deduce all the letters" 4400 print "to solve the puzzle. [212]his is the more "b$; 4410 print "difficult kind of message to decipher." 4420 print "[193]s mentioned, the second kind of puzzle "; 4430 print "is easier to solve, because each letter" 4440 print "is offset by a fixed number of places "b$; 4450 print "in the alphabet: in order to solve it," 4460 print "you only need know the offset amount."; 4470 return 4480 : 4490 : ** 5th page instructions ** 4500 : 4510 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]" 4520 print:print "[217]ou can actually use the program three "b$; 4530 print "different ways. [198]irst, it is used for" 4540 print "decoding secret messages. [211]econd, the "; 4550 print "program has four cryptograms in memory," 4560 print "to solve as exercises. [198]inally, you can"; 4570 print "use it in reverse: type in an original" 4580 print "message, and use the program to encode "b$; 4590 print "it. [194]e sure that you have the cipher" 4600 print "recorded, so that the original message "b$; 4610 print "can be reconstructed later. [215]hen you" 4620 print "display the message on your printer, "b$; 4630 print "this data will be shown automatically.":print 4640 print "[193]s you work on a solution, the program "b$; 4650 print "will print the original message at the" 4660 print "top of the screen and the evolving "b$; 4670 print "solution immediately below. [212]here is a" 4680 print "second screen showing the frequency of "b$; 4690 print "each letter in the solution and the" 4700 print "current status of the cipher. [201]f you "b$; 4710 print "examine the frequency of the letters," 4720 print "you can often gain valuable clues." 4730 return 4740 : 4750 : ** 6th page instructions ** 4760 : 4770 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]":print 4780 print:print "[200]ere are your command options while "b$; 4790 print "solving the puzzle:":print 4800 print "2 letters & [210][197][212][213][210][206]:" 4810 print " [197]xchange positions of letters" 4820 print "[210][197][212][213][210][206] [210]everse previous exchange.":print 4830 print "+ or - [207]ffset letters by 1 position." 4840 print "* [209]uickly advance through whole" 4850 print " alphabet (any key = quit.)" 4860 print "_ [207]ther screen: [208]uzzle or [195]ipher." 4870 print "[198]1 [200]elp - [210]eview [201]nstructions." 4880 print "[198]2 [211]ave [208]uzzle in [195]urrent [205]emory." 4890 print "[198]3 [205]odify [208]uzzle & [211]tart [193]gain." 4900 print "[198]4 [210]estore [208]uzzle (as modified.)" 4910 print "[198]5 [208]rint the [212]rial [211]olution." 4920 print "[198]7 [193]bandon [208]uzzle, get [205]ain [205]enu." 4930 print "[198]8 [211]ee [211]olution of [211]ample [208]uzzle." 4940 poke 646,1:print 4950 return 4960 : 4970 rem **** main menu **** 4980 : 4990 poke 648,4:print"[147]":sys 853,12,4 5000 print "[147][158]"tab(10)"[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212][154]" 5010 rem (c) 1988 by ian adam vancouver, british columbia 5020 : 5030 print " [182][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][181]" 5040 print " [182] [158] [208]ress: [154][146] [181]" 5050 print " [182][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][181]" 5060 for i=1 to 8 5070 print " [182]" spc(32) "[181]":next 5080 print " [182][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][181]" 5090 print "[153]" 5100 print tab(6) "[198]1 [211]olve a [195]ryptogram" 5110 print tab(6) "[198]3 [196]emonstration [211]olution" 5120 print tab(6) "[198]5 [210]eview [201]nstructions" 5130 print tab(6) "[198]6 [208]rint the [201]nstructions" 5140 print tab(6) "[198]7 [211]et [208]rinter [195]ontrol" 5150 print tab(6) "[198]8 [197]nd the [208]rogram[154]" 5160 print "[182][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][181]"; 5170 print "[182] [194]y [201]an [193]dam [214]ancouver [194].[195]. 1988 [154][181]"; 5180 print "[182][208]ublished by [211]oftdisk [208]ublishing, [201]nc.[154][181]"; 5190 print "[182][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][181]"; 5200 poke c1,0:poke c0,0:sys 853,12,12:return 5210 : 5220 rem ** printer control ** 5230 : 5240 b$="":s1=12:print "[147]":poke 648,s1 5250 print "[147][158]" tab(9) "[195][210][217][208][212][207][199][210][193][205] [193][211][211][201][211][212][193][206][212]" 5260 print " [217]our cryptograms, their solutions, and" 5270 print " program instructions can be sent to" 5280 print " your printer. [212]he printer file will" 5290 print " be opened with a secondary address of" 5300 print sa "to produce upper and lower case," 5310 print " with line feeds. [201]f this is [207][203], or if" 5320 print " you're not using a printer, then" 5330 print " press the space bar." 5340 print " [201]f your combination of printer and" 5350 print " interface requires a different" 5360 print " secondary address, then enter the" 5370 print " number now and press [210][197][212][213][210][206]:" 5380 c=6:gosub 5690:sys 853,12,12:sys 828,19,1 5390 gosub 5730 5400 if as=13 or as=32 then 5450 5410 if a or as=48 then print a$;:b$=b$+a$ 5420 if as=20 and b$>"" then print a$;:b$=left$(b$,len(b$)-1) 5430 goto 5390 5440 : 5450 if len(b$) then sa=val(b$) and 255 5460 print "[147]":c=0:gosub 5690:return 5470 : 5480 rem ** message, switches ** 5490 : 5500 : gosub 5520: flash message, wait for space bar 5510 : 5520 ii=1 5530 on ii gosub 5590, 5610 5540 for i=1 to 25:gosub 5740:if as then 5610 5550 next:ii=3-ii:goto 5530 5560 : 5570 : gosub 5590: move cursor & print message only 5580 : 5590 sys 828,24,6 5600 print "[150]...press the space bar to proceed[145]";:return 5610 sys 828,24,6:print " [145]";:return 5620 : 5630 : gosub 5660: switch colour, switch screen, & wait 5640 : gosub 5670: leave colour, switch screen, & wait 5650 : 5660 c=10-a*4 5670 s1=4*a 5680 sys 853,s1,s1:gosub 5520:sys 853,s1,12-s1 5690 poke c0,c:poke c1,c:return 5700 : 5710 : gosub 5730:get input, translate 5720 : 5730 poke198,0:wait kb,7 5740 get a$:a=val(a$):as=asc(a$+chr$(0)) 5750 if as<133 or as>141 then ff=.:return 5760 ff=2*as-265:if ff>7 then ff=ff-7 5770 a=ff:return 5780 : 5790 : **** exercises **** 5800 : 5810 print "[147][158][211]elect a sample puzzle to solve." 5820 print "[158][208]ress [198]1 for:[159]" 5830 gosub 5940:print r$ 5840 print "[158][208]ress [198]3 for:[159]" 5850 gosub 5980:print r$ 5860 print "[158][208]ress [198]5 for:[159]" 5870 gosub 6020:print r$ 5880 print "[158][208]ress [198]7 for:[159]" 5890 gosub 6060:print r$; 5900 ex=0:gosub 5730 5910 on ff gosub 5940, 5920, 5980, 5920, 6020, 5920, 6060 5920 print "[147]":n=len(r$):return 5930 : 5940 r$="ctp upem fcjwecwjp ih ctp djnuqp nf v hkvc rkvcp jwggngq pvfc-ypfc, rvjvkkpk ci ctp jiwcp. nc'f ig v 2-upqjpp fkirp, ynct qiiu veepff hjio pvet fnup." 5950 s$="[212]he deck structure of the bridge is a flat plate running east-west, parallel to the route. [201]t's on a 2-degree slope, with good access from each side." 5960 ex=1:return 5970 : 5980 r$="[204]m. [197]hnbl lvhkxw makxx mhnvawhpgl bg max ybgte mph fbgnmxl mh pbg bml ybklm ahfx hixgxk bg 12 rxtkl. [205]hgbzam max [218]btgml mktoxe mh [214]abvtzh." 5990 s$="[211]t. [204]ouis scored three touchdowns in the final two minutes to win its first home opener in 12 years. [212]onight the [199]iants travel to [195]hicago." 6000 ex=1:return 6010 : 6020 r$="[212]lx ctxgnw amrr kevynx fj vyn xmznx'w nhkn tp [195]xmhej nznpmpk ecvnx hexo. [214]yn mpzewmtp amrr veon sregn tp [215]evlxhej ev heap; ctrrta vyn newvnxp xtlvn." 6030 s$="[207]ur forces will gather by the river's edge on [198]riday evening after dark. [212]he invasion will take place on [211]aturday at dawn; follow the eastern route." 6040 ex=1:return 6050 : 6060 r$="[209]b ouiv luyo psa boa gizpn u lzpgiog xsigv [211]e alua aspjzo'v zaaoiupfo boa [203] npsx alo vszpg. [213]ia alsz psa isqos upg u qspaujzo? [216]khhkuq [214]lunovrouio" 6070 s$="[205]y ears have not yet drunk a hundred words [207]f that tongue's utterance yet [201] know the sound. [193]rt thou not [210]omeo and a [205]ontague? [215]illiam [211]hakespeare" 6080 ex=1:return 6090 : 6100 : *** demonstration solution *** 6110 : 6120 print "[147][145]":sl=6:s1=4:b$=chr$(j) 6130 r$="vw'r wvyq wn dqhtq wjq znyafwqs uns h ijvdq hol znyq wn wjq whbdq uns lvooqs." 6140 n=len(r$):poke 648,8:print "[147]" 6150 sys 853,4,12:gosub 2270:gosub 2120, setup 6160 sys 853,8,4:gosub 2280:gosub 1050, page 2 6170 sys 853,4,4 6180 : 6190 m$(1)="[129] [212]he cryptogram is printed above," 6200 m$(2)="[129] then the solution just beneath." 6210 m$(3)="[129] [217]our input goes in the area below." 6220 m$(4)=" [204]et's give it a try..." 6230 gosub 7180:gosub 7340:if ff then 7130 6240 : 6250 m$(1)="[153] [212]his sample puzzle appears to be" 6260 m$(2)="[153] meaningless. [200]owever, with a" 6270 m$(3)="[153] little care it is easily decoded," 6280 m$(4)="[153] in this case in seven easy steps." 6290 gosub 7330:if ff then 7130 6300 : 6310 m$(1)="[158] [211]tep 1: [129][204]et's see if it's a" 6320 m$(2)="[129] simple offset puzzle by pressing" 6330 m$(3)="[129] '*' and watching a few of the" 6340 m$(4)="[129] 26 solutions that are generated." 6350 : 6360 b$="*":gosub 7410 6370 if ff then 7130 6380 for a=k to 71:gosub 1380:a=a+k*peek(kb):next:poke kb,. 6390 for i=1 to n:s(i)=asc(mid$(r$,i,1)) and k7:next 6400 for i=k to l:e(i)=i:next:os=0:gosub 1520 6410 : 6420 m$(1)=" - [206]o [204]uck [212]here -" 6430 m$(2)="[153] [208]ress _ to view the" 6440 m$(3)="[153] second screen, and check" 6450 m$(4)="[153] the frequency of letters." 6460 b$="_":gosub 7410 6470 s1=8:if ff then 7130 6480 : 6490 poke 53265,11:sys 853,8,8:gosub 1080:poke 53265,27 6500 m$(1)=" [158][211]tep 2: [153][209] appears" 6510 m$(2)=" [153]most often, but [197]" 6520 m$(3)=" [153]is most common in" 6530 m$(4)=" [153][197]nglish. [211]witch" 6540 m$(5)=" [153]these two letters" 6550 m$(6)=" [153]by pressing 'qe':" 6560 b$="qe":gosub 7410:if ff then 7130 6570 : 6580 gosub 1050:sys 853,8,8 6590 m$(1)=" [158][212]hat's better!" 6600 m$(3)=" [158][208]ress '_' to" 6610 m$(4)=" [158]see the first" 6620 m$(5)=" [158]screen again..." 6630 b$="_":gosub 7410 6640 s1=4:if ff then 7130 6650 : 6660 poke 53265,11:gosub 1520 6670 m$(1)=" [158][211]tep 3: [129][204]ook at the puzzle: the" 6680 m$(2)=" [129]one-letter word in the middle must" 6690 m$(3)=" [129]be [193] or [201]. [204]et's assume it's [193]," 6700 m$(4)=" [129]and enter 'ha' to switch these:" 6710 b$="ha":gosub 7410:if ff then 7130 6720 sys 853,4,4 6730 : 6740 m$(1)=" [158][211]tep 4: [153][206]ote the 3-letter word" 6750 m$(2)=" [153]ending in [197]: 'wje'. [211]ince it" 6760 m$(3)=" [153]occurs twice, assume it's [212][200][197]." 6770 m$(4)=" [153][197]nter 'wt', then 'jh' to switch:" 6780 b$="wt":gosub 7410:sys 853,4,4:if ff then 7130 6790 b$="jh":gosub 7420:sys 853,4,4:if ff then 7130 6800 : 6810 m$(1)=" [158][211]tep 5: [129][212]he apostrophe has one" 6820 m$(2)=" [129]letter after- likely [211] or [212], and" 6830 m$(3)=" [129]since we've already solved for [212]," 6840 m$(4)=" [129]it must be [211]. [197]nter 'rs':" 6850 b$="rs":gosub 7410:if ff then 7130 6860 sys 853,4,4 6870 : 6880 m$(1)=" [158][211]tep 6: [153][195]heck the 1st word again." 6890 m$(2)=" [153][215]e've identified [164][212]'[211], so the 1st" 6900 m$(3)=" [153]letter must be a vowel, likely" 6910 m$(4)=" [153][201]. [210]eplace the letter [214] with [201]:" 6920 b$="vi":gosub 7410:if ff then 7130 6930 sys 853,4,4 6940 : 6950 m$(1)=" [158][211]tep 7: [150][212]he third word must be [212][207]." 6960 m$(2)=" [150][212]he second is likely [212][201][205][197]." 6970 m$(3)=" [150][212]here are now enough clues to" 6980 m$(4)=" [150]make the remaining substitutions:" 6990 b$="no":gosub 7330:if ff then 7130 7000 gosub 7450:sys 853,4,4 7010 b$="ym":gosub 7450 7020 b$="dl":gosub 7450 7030 b$="zc":gosub 7450 7040 b$="jp":gosub 7450 7050 b$="uf":gosub 7450 7060 b$="wv":gosub 7450 7070 : 7080 m$(1)=" [214]oila: [212]he message" 7090 m$(2)=" has been decoded!" 7100 m$(3)="[159] [217]ou would now print the" 7110 m$(4)="[159] solution, or exit." 7120 gosub 7330 7130 print"[147][145]":return 7140 : 7150 : ** message (NULL) ** 7160 : 7170 if s1=8 then 7260 7180 sys 828,8,2:print "[156][180][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][185][170]" 7190 for i=1 to 4 7200 print tab(2) "[156][180][146] [170][145]" 7210 print tab(3) m$(i):m$(i)="" 7220 next 7230 print "[156] [180][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][170]" 7240 return 7250 : 7260 c$="[156][182] [181][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]":b=17:c=828 7270 sys 828,6,b:print "[156][182][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][181]" 7280 for i=1 to 6:print tab(b) c$ m$(i):next 7290 print tab(b) "[156][182][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][181]" 7300 for i=1 to 6:m$(i)="":next 7310 return 7320 : 7330 gosub 7170 7340 sys 828,13,9:print "[181] [208]ress the [211]pace [194]ar [146][156][182]" 7350 for i=1 to 1500:gosub 5740:if as=32 then return 7360 if a$=right$(b$,1) then return 7370 if a$=left$(b$,1) then sys 828,22:print a$ "[166][157]"; 7380 if ff then return 7390 next:return 7400 : 7410 gosub 7170:poke 53265,27 7420 sys 828,22:print "[159][166] [157][157][157]"; 7430 sys 828,22:poke 204,0 7440 gosub 7350:poke 204,1 7450 sys 828,22:print "[159]"b$"[166]" 7460 gosub 1230:if s1=4 then gosub 1520 7470 return 7480 : 
(.txt)