DECLARE FUNCTION ReadLn$ (ln!)
DECLARE FUNCTION FGF! (tt!)
DECLARE SUB GetTxt ()
DECLARE FUNCTION Dateint$ (dtt$)
DECLARE SUB TskBrPrn (r$)
DECLARE SUB TopPrn ()
DECLARE SUB ReadKey (t$, prm$, chrs!)
DECLARE FUNCTION Encptyd$ (aa!, enc$)
DECLARE FUNCTION LastByte! (tt$)
DIM SHARED txt$(1 TO 6)
DIM SHARED fg, bg
und$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Cipher$ = STRING$(26, 32)
ON TIMER(1) GOSUB PrnTop: TIMER ON
100 CLS
TopPrn
LOCATE 2, 1: PRINT CHR$(186) + STRING$(78, 32) + CHR$(186)
FOR q = 3 TO 23
LOCATE q, 1: PRINT CHR$(186): LOCATE q, 80: PRINT CHR$(186)
NEXT q
TskBrPrn "  F1=HELP  F5=NEW CIPHER"
LOCATE 25, 1: PRINT CHR$(200) + STRING$(78, 205) + CHR$(188);
bg = 1: fg = 7
COLOR fg, bg:
LOCATE 3, 2: PRINT "  Plaintext  "; : bg = 4: fg = 15: COLOR fg, bg: PRINT Cipher$; : bg = 1: fg = 7: COLOR fg, bg: PRINT STRING$(39, 32)
LOCATE 4, 2: PRINT "     Cipher  "; : bg = 1: fg = 3: COLOR fg, bg: PRINT "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; : bg = 1: fg = 7: COLOR fg, bg: PRINT STRING$(39, 32)
LOCATE 5, 2: PRINT "     Unused  "; und$; STRING$(39, 32)
FOR qq = 7 TO 23 STEP 3
LOCATE qq, 2: bg = 1: fg = 7: COLOR fg, bg: PRINT " "; : bg = 4: fg = 15: COLOR fg, bg: PRINT Encptyd$(((qq - 7) / 3) + 1, t$); STRING$(76 - LEN(Encptyd$(((qq - 7) / 3) + 1, t$)), 32); : bg = 1: fg = 7: COLOR fg, bg: PRINT " "
LOCATE qq - 1, 2: fg = 7: bg = 1: COLOR fg, bg: PRINT STRING$(78, 32)
LOCATE qq + 1, 2: fg = 7: bg = 1: COLOR fg, bg: PRINT " "; txt$(((qq - 7) / 3) + 1); STRING$(78 - LEN(txt$(((qq - 7) / 3) + 1)) - 1, 32)
NEXT qq
10 bg = 4: fg = 15: COLOR fg, bg: LOCATE 3, 15, 1: LOCATE , , 0: LOCATE 3, 15, 1: bg = 4: fg = 15: COLOR fg, bg: PRINT UCASE$(t$);
20 a$ = INKEY$
IF a$ = "" THEN 20
a$ = UCASE$(a$)
IF (a$ = CHR$(8) OR a$ = CHR$(0) + "K") AND LEN(t$) > 0 AND LastByte(t$) <> 32 THEN MID$(und$, ASC(RIGHT$(t$, 1)) - 64, 1) = RIGHT$(t$, 1): t$ = LEFT$(t$, LEN(t$) - 1): LOCATE 3, 15: PRINT UCASE$(t$) + STRING$(26 - LEN(t$), 32); : LOCATE 3, 15 + LEN(t$): FOR qq = 7 TO 23 STEP 3: LOCATE qq, 3, 0: bg = 4: fg = 15: COLOR fg, bg: PRINT Encptyd$(((qq - 7) / 3) + 1, t$); STRING$(76 - LEN(Encptyd$(((qq - 7) / 3) + 1, t$)), 32); : NEXT qq: GOTO 30
IF (a$ = CHR$(0) + "K" OR a$ = CHR$(8)) AND LastByte(t$) = 32 AND LEN(t$) > 0 THEN t$ = LEFT$(t$, LEN(t$) - 1): LOCATE 3, 15: PRINT UCASE$(t$) + STRING$(26 - LEN(t$), 32); : LOCATE 3, 15 + LEN(t$): FOR qq = 7 TO 23 STEP 3: LOCATE qq, 3, 0: bg = 4: fg = 15: COLOR fg, bg: PRINT Encptyd$(((qq - 7) / 3) + 1, t$); STRING$(76 - LEN(Encptyd$(((qq - 7) / 3) + 1, t$)), 32); : NEXT qq: GOTO 30
IF a$ = CHR$(8) AND LEN(t$) = 0 THEN GOTO 10
IF a$ = CHR$(27) THEN END
IF a$ = CHR$(0) + "?" THEN GetTxt: GOTO 100
IF a$ = CHR$(0) + "M" AND LEN(t$) < 26 THEN t$ = t$ + " ": GOTO 10
IF ASC(a$) > 64 AND ASC(a$) < 91 THEN  ELSE GOTO 10
IF INSTR(und$, a$) = 0 THEN LOCATE , , 0: bg = 6: fg = 15: COLOR fg, bg: x% = CSRLIN: y% = POS(0): LOCATE 24, 2: msg$ = "Letter already used.": PRINT msg$; STRING$(78 - LEN(msg$), 32); : SLEEP: TskBrPrn "  F1=HELP  F5=NEW CIPHER": LOCATE x%, y%, 1: bg = 4: fg = 15: COLOR fg, bg: GOTO 10
IF LEN(t$) < 26 THEN LOCATE 3, 15: PRINT UCASE$(t$);
IF LEN(t$) >= 26 THEN LOCATE 3, 15 + 26, 1 ELSE t$ = t$ + a$
MID$(und$, INSTR(und$, a$), 1) = " "
FOR qq = 7 TO 23 STEP 3: LOCATE qq, 3, 0: bg = 4: fg = 15: COLOR fg, bg: PRINT Encptyd$(((qq - 7) / 3) + 1, t$); STRING$(76 - LEN(Encptyd$(((qq - 7) / 3) + 1, t$)), 32); : NEXT qq
30 bg = 1: fg = 7: COLOR fg, bg: LOCATE 5, 2: PRINT "     Unused  "; und$; STRING$(39, 32)
GOTO 10
END

PrnTop:
IF TIME$ <> oltm$ THEN TopPrn: oltm$ = TIME$
COLOR fg, bg
RETURN

230 RESUME NEXT

FUNCTION Dateint$ (dtt$)
Dateint$ = MID$(dtt$, 1, 2) + "/" + MID$(dtt$, 4, 2) + "/" + MID$(dtt$, 9, 2)
END FUNCTION

FUNCTION Encptyd$ (aa, enc$)
FOR mm = 1 TO LEN(txt$(aa))
IF ASC(MID$(txt$(aa), mm, 1)) > 64 AND ASC(MID$(txt$(aa), mm, 1)) < 91 THEN  ELSE m$ = m$ + MID$(txt$(aa), mm, 1): GOTO 101
IF MID$(enc$, ASC(MID$(txt$(aa), mm, 1)) - 64, 1) = "" THEN m$ = m$ + " " ELSE m$ = m$ + MID$(enc$, ASC(MID$(txt$(aa), mm, 1)) - 64, 1)
101 NEXT mm
Encptyd$ = m$
END FUNCTION

FUNCTION FGF (tt)
FOR f = 15 TO 0 STEP -1
IF FIX((tt - f) / 16) = (tt - f) / 16 THEN FGF = f
NEXT f
END FUNCTION

SUB GetTxt
bg = 7: fg = 14: COLOR fg, bg
LOCATE 8, 2: PRINT CHR$(218) + STRING$(76, 196) + CHR$(191)
FOR mma = 9 TO 15
LOCATE mma, 2: PRINT CHR$(179) + STRING$(76, 32) + CHR$(179)
NEXT mma
LOCATE 16, 2: PRINT CHR$(192) + STRING$(76, 196) + CHR$(217)
LOCATE 9, 3
FOR nq = 1 TO 6
ReadKey txt$(nq), "", 76
IF INSTR(txt$(nq), CHR$(219)) THEN txt$(nq) = LEFT$(txt$(nq), LEN(txt$(nq)) - 1): EXIT SUB
LOCATE , 3
NEXT nq
END SUB

FUNCTION LastByte (tt$)
IF LEN(tt$) = 0 THEN LastByte = 32: EXIT FUNCTION ELSE LastByte = ASC(RIGHT$(tt$, 1))
END FUNCTION

SUB ReadKey (t$, prm$, chrs)
t$ = ""
PRINT prm$;
DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27)
IF i$ = CHR$(8) THEN IF LEN(t$) = 0 THEN i$ = "": GOTO 60 ELSE t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1
i$ = INKEY$
IF i$ = CHR$(0) + "?" THEN t$ = t$ + CHR$(219): PRINT : EXIT SUB
IF i$ = "" THEN GOTO 60
q = 0
IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60
IF ASC(i$) > 200 THEN GOTO 60
IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70
IF ASC(i$) < 123 AND ASC(i$) > 96 THEN i$ = CHR$(ASC(i$) - 32): PRINT i$;  ELSE PRINT i$;
t$ = t$ + i$
IF LEN(t$) >= chrs THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1
60 LOOP
70 PRINT ""
END SUB

FUNCTION ReadLn$ (ln)
x% = CSRLIN: y% = POS(0)
FOR q = 1 TO 80
bgf = (SCREEN(ln, q, 1) - FGF(SCREEN(ln, q, 1))) / 16
mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(bgf) + CHR$(FGF(SCREEN(ln, q, 1)))
NEXT q
ReadLn$ = mm$
END FUNCTION

SUB TopPrn
x = CSRLIN: y = POS(0)
COLOR 15, 3
ttl$ = "CRYPTOMATIC V1.1"
dt$ = Dateint$(DATE$) + " " + TIME$
LOCATE 1, 1: PRINT CHR$(201) + CHR$(205) + "[" + ttl$ + "]" + STRING$(80 - (LEN(ttl$) + 8 + LEN(dt$)), 205) + "[" + dt$ + "]" + CHR$(205) + CHR$(187)
LOCATE x, y
END SUB

SUB TskBrPrn (r$)
COLOR 15, 3
LOCATE 24, 1: PRINT CHR$(186) + r$ + STRING$(78 - LEN(r$), 32) + CHR$(186);
END SUB

SUB WriteLn (ln, tt$)
LOCATE ln, 1
FOR q = 1 TO LEN(tt$) STEP 3
'bgf = (ASC(MID$(tt$, q + 1, 1)) - FGF(ASC(MID$(tt$, q + 1, 1)))) / 16
'PRINT ASC(MID$(tt$, q + 2, 1)); ASC(MID$(tt$, q + 1, 1))
COLOR ASC(MID$(tt$, q + 2, 1)), ASC(MID$(tt$, q + 1, 1))
PRINT MID$(tt$, q, 1);
NEXT q
END SUB