'Copyright 1997 The American Cryptogram Association (ACA)
'One Pidgeon Drive, Wilbraham MA 01095-2604
'All rights reserved.

'Complete ND97 Program

100 DEFINT A-Z
200 GOSUB 400    'InitDisplay
210 GOSUB 500    'GetKey loop
220   IF KY=ESC THEN 9998 'Exit
230   GOSUB 600  'ProcessKey
240   GOTO  210  'Repeat Until ESC

400 '===== InitDisplay Routine =====
405 CT$="AIWFOCASLIASALSLNGTPOILEHKMESETAWOCANOLRONVLGIUEDTEF"
406 CT$=CT$+"RASORLHAHNNEINUANTDGRULAHGIANETGDETANHSDCEUOISET"
407 CT$=CT$+"USICSSCETRANASDLNTDYEXOEDEPEAFRNRSRGTOUEAMGX"
410 GN=INT(SQR(LEN(CT$)+1)+.1)
415 GO=(GN MOD 2): GM=(GN*GN+1)/2    
420 CB=1: CI=1: RB=2: RE=5: RI=1    
422 PI=6: PE=78
425 IF GN<13 THEN CI=2
430 CE=CB+CI*(GN*GN-1-GO)
435 CLS: C=CB-CI: R=1
440 FOR I=1 TO LEN(CT$)'Place ciphtxt
445  C=C+CI: GOSUB 800 'Update cursor
450  PRINT MID$(CT$,I,1);SPC(CI-1);
455 NEXT I
460 C=CB: R=RB: GOSUB 800: BL$="."
465 ESC=27 'ESC key ascii code
470 KEY OFF 'Disable F-key trapping
475 FOR I=1 TO 10: KEY I,"": NEXT I
491 DEF FNGT(X)= X - GO*INT(X/GM)
492 DEF FNTG(X)= X + GO*INT(X/GM)
493 DEF FNCG(X)= FNTG((X-CB)/CI+1)
494 DEF FNGC(X)= CB+(FNGT(X)-CB)*CI
495 DEF FNGR(X)= (X*GN)MOD(GN*GN+1)
499 RETURN '===== from InitDisplay

500 '===== GetKey Routine =====
510   KY$=INKEY$: IF KY$="" THEN 510
515   IF LEN(KY$)=2 THEN 535
520     KY=ASC(KY$)
525     IF KY<ESC THEN KY=0
530     RETURN
535   KY$=RIGHT$(KY$,1)
540   KY =ASC(KY$)-58
541   IF KY<1  THEN KY=0: GOTO 550
542   IF KY<13 THEN KY=KY+13:GOTO 550
543   IF KY<26 THEN KY=KY-12:GOTO 550
545   KY=0
550   RETURN '==== from GetKey

600 '===== ProcessKey Routine =====
610 IF KY>=ESC THEN 640 'key is char
620   ON KY GOSUB 1000,1100,1200,999,1400,999,1600,999,1800,1900,2000,2100,2200,3100,999,999,999,999,999,999,999,999,999,999,999
630   GOTO 650 'Done with editing key
640 GOSUB 700  'Handle normal char
650 RETURN '==== from ProcessKey

700 '===== Normal char key =====
704   ' Cvt char to upper case
705   K1 = ASC(KY$)-ASC("a")
710   K1$= CHR$(K1+ASC("A"))
715   IF K1<0 THEN K1$=KY$
720   P1=INSTR(1,CT$,K1$) 'Typo?
725   IF P1=0 THEN 760    'Yes->quit
729   ' Seek char, wrap to beginning
730   P2=FNGT(FNCG(C)) 'Posn in CT$
735   IF P2=LEN(CT$) THEN P2=P1-1
740   P2=INSTR(P2+1,CT$,K1$)
745   IF P2=0 THEN P2=P1
750   C=FNGC(FNTG(P2)) 'Char column
755   GOSUB 800 'Move cursor to col
760   RETURN '====from normal char

800 '===== Move cursor =====
810   PG= INT((C-1)/PE)   'Group #
820   PC= ((C-1)MOD PE)+1 'PhysCol
830   PR= R+PG*PI         'PhysRow
840   LOCATE PR,PC,1,1,26
850   RETURN '====from move cursor

999 RETURN 'Null: No such key

1000 '===== Home Key =====
1010   C=CB: GOSUB 800
1020   RETURN '==== from Home Key

1100 '===== Up Arrow Key =====
1110   R=R-RI: IF R<RB THEN R=RE
1120   GOSUB 800
1130   RETURN '==== from Up Arrow

1200 RETURN 'Null: PageUp Key

1400 '===== Left Arrow =====
1410   C=C-CI:  IF C<CB THEN C=CE
1420   GOSUB 800 
1430   RETURN '==== from Left Arrow

1600 '===== Right Arrow =====
1610   C=C+CI: IF C>CE THEN C=CB
1620   GOSUB 800
1630   RETURN '==== from Right Arrow

1800 '===== End Key =====
1810   C=CE: GOSUB 800
1820   RETURN '==== from End Key

1900 '===== Down Arrow =====
1910   R=R+RI: IF R>RE THEN R=RB
1920   GOSUB 800
1930   RETURN '==== from Down Arrow

2000 RETURN   'Null: PageDn

2100 '===== Insert =====
2105   FOR L1=1 TO 4   'Do 4 ltrs
2110     RS=R         'Save row #
2115     FOR R1=1 TO 4 'Clear col
2120       GOSUB 800: PRINT BL$;
2125       R=R+RI: IF R>RE THEN R=RB
2130     NEXT R1
2135     GOSUB 800  'Cursor for print
2140     GP=FNCG(C) 'Get grille posn
2145     IF BL$=" " THEN 2155
2150     PRINT MID$(CT$,FNGT(GP),1);
2155     C=FNGC(FNGR(GP)) 'Rotate
2160     R=RS+RI: IF R>RE THEN R=RB
2165   NEXT L1
2170   GOSUB 800: BL$="."
2175   RETURN '==== from Insert

2200 '===== Delete =====
2210   BL$=" ": GOSUB 2100
2220   RETURN '==== from Delete

3100 '===== F1: Clear Disp =====
3110    C2=C: R2=R: GOSUB 400
3120    C=C2: R=R2: GOSUB 800
3130    RETURN '==== from F1

9998 R=24: C=1: GOSUB 800 'Exit
9999 END