128 Cryptogram-Helper
              by Rick Kephart October 20, 1988

   I wrote this short program to help to solve cryptograms.  It will not
solve them automatically, but it will make it much easier and faster to
solve them than working them out by completely by hand.  It will replace
all occurrences of a letter immediately, and may easily be changed, and
will not allow a letter to be accidentally repeated.  It will also save a
cryptogram in the process of being solved.

   The program only functions in 40-column mode.

   After the screen blanks for a half-second while machine-language
subroutines are POKEd in, a blinking cursor appears in the top half of a
screen divided through the middle.  In the top half of the screen, copy
the cryptogram exactly.  All cursor controls, as well as the INSERT key,
are active.  You can use SHIFT-RETURN or LINE FEED to go down to the next
line.  When you're finished, press RETURN.  In the bottom half of the
screen, the puzzle will immediately appear, with all alphabetic characters
replaced by ='s.  Any numbers or punctuation will be copied below as is.

   To make a guess, first press the key of the letter in the puzzle to be
replaced.  It will appear in the upper left corner, followed by an equal
sign.  Then press the letter to replace it with.  If the letter has
already been used, you will be alerted to this and the substitution will
not take place.

   If you make a mistake, simply press "=" as the character to replace the
letter with.  You can also start all over again by pressing "=" as the
character to be replaced.

   If you find you made a mistake in copying the cryptogram, press RETURN
instead of a character to replace, and you will be able to edit the
puzzle; after which the bottom screen will return to all ='s.

   You can save a puzzle in process of solving by pressing SHIFT-S instead
of a character to replace.  You will then be asked for a filename, and it
will save the screen to disk.  You can load it again by pressing SHIFT-L
instead of a letter to replace.  At the beginning of a puzzle, to load in
an old puzzle right away, you must first press RETURN.

   The program starts by clearing the screen, and then uses PLOT to
position the cursor and draw the dividing-line.  It sets up a WINDOW and
uses BASIN to allow free typing in the top half of the screen, until
RETURN is pressed.  Then the first subroutine is called to instantly
replace all the cryptogram's letters with "=".  It then uses the SCREEN
EDITOR ROM to clear the top line (this is really for after the LOAD and
SAVE routines).  It removes the window with two HOMEs, and a character is
gotten with GETKEY.  Then the top line is cleared (it may have had a
previous substitution in it).  The INSTR command is then used to check for
RETURN,=,S, or L.  If one of those has been pressed, it is dealt with. 
Otherwise, the letter is printed at the top, and GETKEY is used to get the
character for the replacement.  It then goes to the second ML subroutine,
which checks for repetitions and performs the substitution if the letter
hasn't already been used.  The letter is printed at the top of the screen,
with the substitution done if the letter is not a repetition, or the
message "USED" on the top line.  If the screen is to be SAVEd or LOADed,
the filename is requested and ",S" is added (note the syntax to BSAVE or
BLOAD a SEQ file), and the screen from 1064 to 2023 is BSAVEd or BLOADed.

10 FAST:FOR I=4864 TO 4968:READ A:POKE I,A:NEXT:SLOW
20 SCNCLR:SYS 65520,,12,0,0:PRINT"{40 shift-O}"
30 WINDOW 0,1,39,11:SYS 65487
40 SYS 4864
50 SYS 50341,,0
60 PRINT"{home}{home}";:GETKEY A$:SYS 50341,,0
70 ON INSTR(CHR$(13)+"={shift-L}{shift-S}",A$) GOTO 30,40,100,100
80 PRINT A$" = ";:GETKEY B$:PRINT B$;:SYS 4891:RREG A:IF A THEN PRINT
  TAB(18)"{rvs}USED!"
90 GOTO 60
100 INPUT"FILENAME";F$:F$=F$+",S":IF A$="{shift-S}" THEN
   BSAVE(F$),P1064 TO P2023:GOTO 50:ELSE:BLOAD(F$):GOTO 50
110 DATA 32,86,19,177,251,201,27,176,2,169,61,145,253,200,208,243,230,254
120 DATA 230,252,165,254,201,8,208,233,96,169,61,205,4,4,240,21,32,94
130 DATA 19,177,253,205,4,4,240,41,200,208,246,230,254,165,254,201,8,208
140 DATA 238,32,86,19,173,0,4,209,251,208,5,173,4,4,145,253,200,208
150 DATA241,230,254,230,252,165,254,201,8,208,231,169,0,96,160,40,132,251
160 DATA 169,4,133,252,169,48,133,253,169,6,133,254,160,0,96
____________________________________________________________________

1300  20 56 13 JSR $1356   ; set up pointers

1303  B1 FB    LDA ($FB),Y ; get char from top

1305  C9 1B    CMP #$1B    ; non-alphabetic?
1307  B0 02    BCS $130B   ; if so, print as is

1309  A9 3D    LDA #$3D    ; =
130B  91 FD    STA ($FD),Y ; put in place on bottom

130D  C8       INY         ; next character
130E  D0 F3    BNE $1303   ; loop for 256 characters

1310  E6 FE    INC $FE     ; increase low pointer
1312  E6 FC    INC $FC     ; increase top pointer

1314  A5 FE    LDA $FE     ; check for end
1316  C9 08    CMP #$08    ; end of screen ($0800)?
1318  D0 E9    BNE $1303   ; if not, continue
131A  60       RTS         ; finished

131B  A9 3D    LDA #$3D    ; =

131D  CD 04 04 CMP $0404   ; erase guess?
1320  F0 15    BEQ $1337   ; if so, skip check routine

1322  20 5E 13 JSR $135E   ; set up pointers to bottom

1325  B1 FD    LDA ($FD),Y ; get a character
1327  CD 04 04 CMP $0404   ; compare to replacement char
132A  F0 29    BEQ $1355   ; if repeat, exit

132C  C8       INY         ; next character
132D  D0 F6    BNE $1325   ; loop for 256 characters

132F  E6 FE    INC $FE     ; increase pointer

1331  A5 FE    LDA $FE     ; check for end
1333  C9 08    CMP #$08    ; end of screen ($0800)?
1335  D0 EE    BNE $1325   ; if not, continue
1337  20 56 13 JSR $1356   ; set up both pointers

133A  AD 00 04 LDA $0400   ; letter to replace
133D  D1 FB    CMP ($FB),Y ; check current position on top
133F  D0 05    BNE $1346   ; branch if not a char to replace

1341  AD 04 04 LDA $0404   ; get replacement letter
1344  91 FD    STA ($FD),Y ; replace
1346  C8       INY         ; next character
1347  D0 F1    BNE $133A   ; loop for 256 characters

1349  E6 FE    INC $FE     ; increase low pointer
134B  E6 FC    INC $FC     ; increase top pointer

134D  A5 FE    LDA $FE     ; check for end
134F  C9 08    CMP #$08    ; end of screen ($0800)?
1351  D0 E7    BNE $133A   ; if not, continue

1353  A9 00    LDA #$00    ; signal for non-repeated letter
1355  60       RTS         ; finish

1356  A0 28    LDY #$28    ; set up upper pointer:
1358  84 FB    STY $FB     ;   $0428 = second line of screen
135A  A9 04    LDA #$04
135C  85 FC    STA $FC

135E  A9 30    LDA #$30    ; set up lower pointer
1360  85 FD    STA $FD     ;   $0630 = 13th line of screen
1362  A9 06    LDA #$06
1364  85 FE    STA $FE

1366  A0 00    LDY #$00    ; prepare Y-index

1368  60       RTS

Some Online Cryptogram Games to Solve: Search for Cryptograms

You can write to me at  .

HOME Religion Latin  Mass Denton Prayer  Requests Homeschooling
Stories Art ******* Commodore Miniatures
England Italy Florida Musical Gregorian  Chant LPH  Resource  Center