home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / totallyamos / issue4 / source_progs / vignere / vignere.amos / vignere.amosSourceCode
Encoding:
AMOS Source Code  |  1991-11-16  |  2.5 KB  |  109 lines
  1. Rem *******************
  2. Rem ** vignere table **  
  3. Rem ** by s.bradley  **
  4. Rem *******************
  5. Hide : Colour 1,$FF0
  6. Rem ****************** 
  7. Rem ***set up table*** 
  8. Rem ****************** 
  9. Dim VN$(27,27) : C=1
  10. Global VN$(),C$,PW$,FL
  11. For I=2 To 27
  12.  VN$(1,I)=Chr$(63+I)
  13.  VN$(I,1)=Chr$(63+I)
  14. Next I
  15. For I=2 To 27
  16.  For F=2 To 27
  17.   VN$(I,F)=Chr$(64+C)
  18.   Inc C : If C>26 Then C=1
  19.  Next F : Inc C : Next I
  20. VN$(1,1)=Chr$(32)
  21. Rem *******************  
  22. Rem ***title screen ***
  23. Rem *******************  
  24. TITLE:
  25. Set Rainbow 0,0,100,"(9,2,9)","(9,2,9)",""
  26. Rainbow 0,1,50,80
  27. Curs Off : Paper(0) : Pen(2) : Cls 
  28. Print : Centre "vignere table" : Print 
  29. Centre "by" : Print 
  30. Centre "s.bradley"
  31. Print : Print : Pen(6)
  32. Print "   1 - encipher message"
  33. Print "   2 - decipher code"
  34. Print "   3 - end program"
  35. Do 
  36.  IP$=Inkey$
  37.  If IP$="1" Then Proc ENCIPHER : Goto TITLE : 
  38.  If IP$="2" Then Proc DEIPHER : Goto TITLE : 
  39.  If IP$="3" Then Edit 
  40. Loop 
  41. Rem ************************ 
  42. Rem *** check for errors *** 
  43. Rem ************************ 
  44. Procedure ERR
  45. FL=0
  46. If PW$="" Then FL=1 : Pop Proc
  47. If C$="" Then FL=1 : Pop Proc
  48. For I=1 To Len(PW$)
  49.  D=Asc(Mid$(PW$,I,1))
  50.  If D<65 or D>90 Then Pen(3) : Print "bad password" : FL=1 : I=Len(PW$)
  51. Next I
  52. For I=1 To Len(C$)
  53.  D=Asc(Mid$(C$,I,1))
  54.  If D=32 Then Goto JMP : 
  55.  If D<65 or D>90 Then Pen(3) : Print "bad input" : FL=1 : I=Len(C$) : 
  56. JMP:
  57. Next I
  58. End Proc
  59. Rem ******************** 
  60. Rem *** code message *** 
  61. Rem ******************** 
  62. Procedure ENCIPHER
  63. BEGIN:
  64. Locate 0,10 : Pen(7) : Cls ,0,71 To 320,200
  65. Input "enter password ";PW$
  66. Input "enter message ";C$
  67. Curs Off 
  68. PW$=Upper$(PW$)
  69. C$=Upper$(C$)
  70. Proc ERR
  71. If FL=1 Then Bell : Wait 100 : Goto BEGIN : 
  72. Print : Print 
  73. For I=1 To Len(C$)
  74.  R=Asc(Mid$(C$,I,1))-64
  75.  Inc PC : If PC>Len(PW$) Then PC=1
  76.  If R=-32 Then R=0 : B=0 : Goto PRINEN : 
  77.  B=Asc(Mid$(PW$,PC,1))-64
  78. PRINEN:
  79.  Pen(1) : Print VN$(B+1,R+1); : Play 1,R+20,2
  80. Next I
  81. Pen(3) : Print : Print : Print "press a key to return"
  82. Wait Key : Bell 80
  83. End Proc
  84. Rem ****************** 
  85. Rem *** crack code *** 
  86. Rem ****************** 
  87. Procedure DEIPHER
  88. BEGIN:
  89. Locate 0,10 : Pen(7) : Cls ,0,71 To 320,200
  90. Input "enter password ";PW$
  91. Input "enter code ";C$
  92. Curs Off 
  93. PW$=Upper$(PW$)
  94. C$=Upper$(C$)
  95. Proc ERR
  96. If FL=1 Then Bell : Wait 100 : Goto BEGIN : 
  97. Print : Print 
  98. For G=1 To Len(C$)
  99.  Inc PC : If PC>Len(PW$) Then PC=1
  100.  H=Asc(Mid$(PW$,PC,1))-64
  101.  T=Asc(Mid$(C$,G,1))-64
  102.  If T=-32 Then Print " ";
  103.   For Z=2 To 27
  104.    A=Asc(VN$(H+1,Z))-64
  105.    If T=A Then Pen(1) : Print VN$(1,Z); : Play 1,H+30,2
  106.  Next Z : Next G
  107. Pen(3) : Print : Print : Print "press a key to return"
  108. Wait Key : Bell 80
  109. End Proc