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

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$="MHGLVYISMOEDXONT"
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
425   IF GN<7 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 ctext
445    C=C+CI: GOSUB 800 'Update curs
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
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$)-70
545   IF KY<1 OR KY>13 THEN 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
630   GOTO 650 'Done with editing key
640 GOSUB 700  'Handle normal char
650 RETURN '==== from ProcessKey

700 RETURN 'Null: normal char key

800 LOCATE R,C,1,1,26: RETURN

999 RETURN 'Null: No such key

1000 RETURN 'Null: 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 RETURN   'Null: 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
9998 R=24: C=1: GOSUB 800 'Exit
9999 END