1: DECLARE FUNCTION ReadLn$ (ln!) 2: DECLARE FUNCTION FGF! (tt!) 3: DECLARE SUB GetTxt () 4: DECLARE FUNCTION Dateint$ (dtt$) 5: DECLARE SUB TskBrPrn (r$) 6: DECLARE SUB TopPrn () 7: DECLARE SUB ReadKey (t$, prm$, chrs!) 8: DECLARE FUNCTION Encptyd$ (aa!, enc$) 9: DECLARE FUNCTION LastByte! (tt$) 10: DIM SHARED txt$(1 TO 6) 11: DIM SHARED fg, bg 12: und$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 13: Cipher$ = STRING$(26, 32) 14: ON TIMER(1) GOSUB PrnTop: TIMER ON 15: 100 CLS 16: TopPrn 17: LOCATE 2, 1: PRINT CHR$(186) + STRING$(78, 32) + CHR$(186) 18: FOR q = 3 TO 23 19: LOCATE q, 1: PRINT CHR$(186): LOCATE q, 80: PRINT CHR$(186) 20: NEXT q 21: TskBrPrn " F1=HELP F5=NEW CIPHER" 22: LOCATE 25, 1: PRINT CHR$(200) + STRING$(78, 205) + CHR$(188); 23: bg = 1: fg = 7 24: COLOR fg, bg: 25: 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) 26: 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) 27: LOCATE 5, 2: PRINT " Unused "; und$; STRING$(39, 32) 28: FOR qq = 7 TO 23 STEP 3 29: 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 " " 30: LOCATE qq - 1, 2: fg = 7: bg = 1: COLOR fg, bg: PRINT STRING$(78, 32) 31: 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) 32: NEXT qq 33: 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$); 34: 20 a$ = INKEY$ 35: IF a$ = "" THEN 20 36: a$ = UCASE$(a$) 37: 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 38: 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 39: IF a$ = CHR$(8) AND LEN(t$) = 0 THEN GOTO 10 40: IF a$ = CHR$(27) THEN END 41: IF a$ = CHR$(0) + "?" THEN GetTxt: GOTO 100 42: IF a$ = CHR$(0) + "M" AND LEN(t$) < 26 THEN t$ = t$ + " ": GOTO 10 43: IF ASC(a$) > 64 AND ASC(a$) < 91 THEN ELSE GOTO 10 44: 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 45: IF LEN(t$) < 26 THEN LOCATE 3, 15: PRINT UCASE$(t$); 46: IF LEN(t$) >= 26 THEN LOCATE 3, 15 + 26, 1 ELSE t$ = t$ + a$ 47: MID$(und$, INSTR(und$, a$), 1) = " " 48: 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 49: 30 bg = 1: fg = 7: COLOR fg, bg: LOCATE 5, 2: PRINT " Unused "; und$; STRING$(39, 32) 50: GOTO 10 51: END 52: 53: PrnTop: 54: IF TIME$ <> oltm$ THEN TopPrn: oltm$ = TIME$ 55: COLOR fg, bg 56: RETURN 57: 58: 230 RESUME NEXT 59: 60: FUNCTION Dateint$ (dtt$) 61: Dateint$ = MID$(dtt$, 1, 2) + "/" + MID$(dtt$, 4, 2) + "/" + MID$(dtt$, 9, 2) 62: END FUNCTION 63: 64: FUNCTION Encptyd$ (aa, enc$) 65: FOR mm = 1 TO LEN(txt$(aa)) 66: 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 67: 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) 68: 101 NEXT mm 69: Encptyd$ = m$ 70: END FUNCTION 71: 72: FUNCTION FGF (tt) 73: FOR f = 15 TO 0 STEP -1 74: IF FIX((tt - f) / 16) = (tt - f) / 16 THEN FGF = f 75: NEXT f 76: END FUNCTION 77: 78: SUB GetTxt 79: bg = 7: fg = 14: COLOR fg, bg 80: LOCATE 8, 2: PRINT CHR$(218) + STRING$(76, 196) + CHR$(191) 81: FOR mma = 9 TO 15 82: LOCATE mma, 2: PRINT CHR$(179) + STRING$(76, 32) + CHR$(179) 83: NEXT mma 84: LOCATE 16, 2: PRINT CHR$(192) + STRING$(76, 196) + CHR$(217) 85: LOCATE 9, 3 86: FOR nq = 1 TO 6 87: ReadKey txt$(nq), "", 76 88: IF INSTR(txt$(nq), CHR$(219)) THEN txt$(nq) = LEFT$(txt$(nq), LEN(txt$(nq)) - 1): EXIT SUB 89: LOCATE , 3 90: NEXT nq 91: END SUB 92: 93: FUNCTION LastByte (tt$) 94: IF LEN(tt$) = 0 THEN LastByte = 32: EXIT FUNCTION ELSE LastByte = ASC(RIGHT$(tt$, 1)) 95: END FUNCTION 96: 97: SUB ReadKey (t$, prm$, chrs) 98: t$ = "" 99: PRINT prm$; 100: DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27) 101: 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 102: i$ = INKEY$ 103: IF i$ = CHR$(0) + "?" THEN t$ = t$ + CHR$(219): PRINT : EXIT SUB 104: IF i$ = "" THEN GOTO 60 105: q = 0 106: IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60 107: IF ASC(i$) > 200 THEN GOTO 60 108: IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70 109: IF ASC(i$) < 123 AND ASC(i$) > 96 THEN i$ = CHR$(ASC(i$) - 32): PRINT i$; ELSE PRINT i$; 110: t$ = t$ + i$ 111: IF LEN(t$) >= chrs THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 112: 60 LOOP 113: 70 PRINT "" 114: END SUB 115: 116: FUNCTION ReadLn$ (ln) 117: x% = CSRLIN: y% = POS(0) 118: FOR q = 1 TO 80 119: bgf = (SCREEN(ln, q, 1) - FGF(SCREEN(ln, q, 1))) / 16 120: mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(bgf) + CHR$(FGF(SCREEN(ln, q, 1))) 121: NEXT q 122: ReadLn$ = mm$ 123: END FUNCTION 124: 125: SUB TopPrn 126: x = CSRLIN: y = POS(0) 127: COLOR 15, 3 128: ttl$ = "CRYPTOMATIC V1.1" 129: dt$ = Dateint$(DATE$) + " " + TIME$ 130: LOCATE 1, 1: PRINT CHR$(201) + CHR$(205) + "[" + ttl$ + "]" + STRING$(80 - (LEN(ttl$) + 8 + LEN(dt$)), 205) + "[" + dt$ + "]" + CHR$(205) + CHR$(187) 131: LOCATE x, y 132: END SUB 133: 134: SUB TskBrPrn (r$) 135: COLOR 15, 3 136: LOCATE 24, 1: PRINT CHR$(186) + r$ + STRING$(78 - LEN(r$), 32) + CHR$(186); 137: END SUB 138: 139: SUB WriteLn (ln, tt$) 140: LOCATE ln, 1 141: FOR q = 1 TO LEN(tt$) STEP 3 142: 'bgf = (ASC(MID$(tt$, q + 1, 1)) - FGF(ASC(MID$(tt$, q + 1, 1)))) / 16 143: 'PRINT ASC(MID$(tt$, q + 2, 1)); ASC(MID$(tt$, q + 1, 1)) 144: COLOR ASC(MID$(tt$, q + 2, 1)), ASC(MID$(tt$, q + 1, 1)) 145: PRINT MID$(tt$, q, 1); 146: NEXT q 147: END SUB 148: |