1: DECLARE SUB ExeC (oof$) 2: DECLARE SUB UnloadFont () 3: DECLARE SUB LoadFont (f$) 4: DECLARE SUB PRINT2 (t$, cv!) 5: DECLARE SUB Font (t$, cl!) 6: DECLARE SUB Errorr (Msg$) 7: DECLARE FUNCTION ReadLn$ (ln!) 8: DECLARE SUB Comport (Port$) 9: DECLARE SUB ClrBot () 10: DECLARE SUB Corr (n$) 11: DECLARE SUB ReadKey (prm$, t$, chrs!, brd$, rd!) 12: DECLARE FUNCTION GetPrmt$ (pt$) 13: DIM SHARED ENV(1 TO 500) AS STRING 14: DIM SHARED ENV1(1 TO 500) AS STRING 15: DIM SHARED mxenv AS INTEGER 16: DIM SHARED wt$ 17: DIM SHARED LastTyped AS STRING 18: DIM SHARED Lstln AS INTEGER 19: DIM SHARED HRes AS INTEGER 20: DIM SHARED txt(255) AS STRING 21: DIM SHARED DFnt 22: UnloadFont 23: LoadFont "C:\ASCIN.FNT" 24: SCREEN 12 25: HRes = 1 26: DFnt = 1 27: CONST ver$ = "1.00" 28: Lstln = 30 29: PRINT 30: PRINT2 " RK-DOS Version " + ver$, 15 31: PRINT 32: ENV(1) = "$P$G" 33: ENV1(1) = "PATH" 34: mxenv = 1 35: wt$ = "C:\" 36: nn = 0 37: 10 ReadKey GetPrmt(ENV(1)), cmd$, 70, Msg$, nn 38: cmd$ = LTRIM$(cmd$) 39: IF cmd$ = "" GOTO 10 40: IF MID$(cmd$, 1, INSTR(cmd$, " ")) = "" THEN ff$ = cmd$: cmdlne$ = "" ELSE ff$ = MID$(cmd$, 1, INSTR(cmd$, " ") - 1): cmdlne$ = MID$(cmd$, INSTR(cmd$, " ") + 1, LEN(cmd$) - INSTR(cmd$, " ")) 41: IF UCASE$(ff$) = "EXIT" THEN UnloadFont: END 42: IF UCASE$(ff$) = "CLS" THEN CLS : GOTO 10 43: IF UCASE$(ff$) = "PROMPT" THEN ENV(1) = cmdlne$: GOTO 10 44: IF UCASE$(ff$) = "WAIT" THEN nn = 0: GOTO 10 45: IF UCASE$(ff$) = "NOWAIT" THEN IF cmdlne$ = "" THEN PRINT2 "Syntax: NOWAIT msg", 7: PRINT : GOTO 10 ELSE nn = 1: Corr cmdlne$: Msg$ = cmdlne$: GOTO 10 46: IF UCASE$(ff$) = "DOS" THEN IF cmdlne$ = "" THEN PRINT2 "Syntax: DOS dos_prog", 7: PRINT : GOTO 10 ELSE ClrBot: SHELL (cmdlne$): GOTO 10 47: IF UCASE$(ff$) = "COM_ON" THEN IF cmdlne$ = "" THEN PRINT2 "Syntax: COM_ON comport#", 7: PRINT : GOTO 10 ELSE Comport cmdlne$: GOTO 10 48: IF UCASE$(ff$) = "LINES" THEN IF cmdlne$ <> "" AND (VAL(cmdlne$) = 25 OR VAL(cmdlne$) = 43 OR VAL(cmdlne$) = 50) THEN WIDTH 80, VAL(cmdlne$): Lstln = VAL(cmdlne$): HRes = 0: GOTO 10 ELSE PRINT2 "Syntax: LINES {25,43,50}", 7: PRINT : GOTO 10 49: IF UCASE$(ff$) = "LOWRES" THEN Lstln = 25: SCREEN 0: HRes = 0: GOTO 10 50: IF UCASE$(ff$) = "HIRES" AND HRes = 0 THEN Lstln = 30: SCREEN 12: HRes = 1: GOTO 10 51: IF UCASE$(ff$) = "VER" AND HRes = 1 THEN PRINT2 "RK-DOS Version " + ver$, 15: PRINT : PRINT : GOTO 10 52: IF UCASE$(ff$) = "VER" AND HRes = 0 THEN COLOR 15, 1: PRINT "RK-DOS Version " + ver$: PRINT : COLOR 7, 0: GOTO 10 53: IF UCASE$(ff$) = "FONT" THEN IF cmdlne$ <> "" AND (cmdlne$ = "ON" OR cmdlne$ = "OFF") THEN ExeC cmdlne$: GOTO 10 ELSE PRINT2 "Syntax: FONT {ON,OFF}", 7: PRINT : GOTO 10 54: PRINT "Unkown command:"; ff$ 55: PRINT 56: GOTO 10 57: 58: CMPRT: 59: LINE INPUT #3, f1$ 60: Errorr f1$ 61: RETURN 62: 63: SUB ClrBot 64: x% = CSRLIN: y% = POS(0) 65: LOCATE Lstln, 1, 0 66: PRINT STRING$(80, 32); 67: LOCATE x%, y%, 1 68: END SUB 69: 70: SUB Comport (Port$) 71: f$ = "COM" + RTRIM$(LTRIM$(Port$)) + ":9600" 72: OPEN f$ FOR RANDOM SHARED AS #3 73: COM(VAL(Port$)) ON 74: ON COM(VAL(Port$)) GOSUB CMPRT 75: END SUB 76: 77: SUB Corr (n$) 78: lnn$ = UCASE$(MID$(n$, 1, 1)) 79: FOR q = 2 TO LEN(n$) 80: IF MID$(n$, q, 1) = " " OR MID$(n$, q, 1) = "ÿ" THEN lnn$ = lnn$ + " ": GOTO 122 81: IF MID$(n$, q, 1) <> "&" AND cptl = 0 THEN lnn$ = lnn$ + LCASE$(MID$(n$, q, 1)) 82: IF cptl = 1 THEN lnn$ = lnn$ + UCASE$(MID$(n$, q, 1)): cptl = 0 83: IF MID$(n$, q, 1) = "." OR MID$(n$, q, 1) = "&" THEN cptl = 1 84: 122 NEXT q 85: n$ = lnn$ 86: 87: END SUB 88: 89: SUB Errorr (Msg$) 90: IF HRes = 1 THEN EXIT SUB 91: mxy = 19 92: x% = CSRLIN: y% = POS(0) 93: IF LEN(Msg$) <= mxy THEN DO UNTIL LEN(Msg$) >= mxy + 1: Msg$ = " " + Msg$ + " ": LOOP 94: IF INT(LEN(Msg$) / 2) * 2 = LEN(Msg$) THEN ELSE Msg$ = Msg$ + " " 95: COLOR 0, 7: LOCATE 10, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "ÚÄÄ"; STRING$(LEN(Msg$), 196); "ÄÄ¿" 96: COLOR 0, 7: LOCATE 11, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; STRING$(LEN(Msg$), 32); " ³" 97: COLOR 0, 7: LOCATE 12, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; Msg$; " ³" 98: COLOR 0, 7: LOCATE 13, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; STRING$(LEN(Msg$), 32); " ³" 99: COLOR 0, 7: LOCATE 14, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "ÃÄÄ"; STRING$(LEN(Msg$), 196); "ÄÄ´" 100: COLOR 0, 7: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; STRING$(INT((LEN(Msg$) - mxy) / 2), 32); : COLOR 15, 7: PRINT "<"; : COLOR 0, 7: PRINT " OK "; : COLOR 15, 7: PRINT ">"; : COLOR 0, 7: PRINT " < Help >"; STRING$(INT((LEN(Msg$) - mxy) / 2), 32); " ³" 101: COLOR 0, 7: LOCATE 16, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "ÀÄÄ"; STRING$(LEN(Msg$), 196); "ÄÄÙ" 102: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) + 2 103: Top: 104: i$ = INKEY$ 105: IF i$ = "" THEN GOTO Top 106: IF ASC(i$) = 9 AND mm = 0 THEN COLOR 0, 7: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; STRING$(INT((LEN(Msg$) - mxy) / 2), 32); : PRINT "< OK > "; : COLOR 15, 7: PRINT "<"; : COLOR 0, 7: PRINT " Help "; : COLOR 15, 7: PRINT ">"; : COLOR 0, 7: PRINT STRING$(INT((LEN(Msg$) - mxy) / 2), 32); " ³": mm = 1: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) + 13: GOTO Top 107: IF ASC(i$) = 9 AND mm = 1 THEN COLOR 0, 7: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) - 4: PRINT "³ "; STRING$(INT((LEN(Msg$) - mxy) / 2), 32); : COLOR 15, 7: PRINT "<"; : COLOR 0, 7: PRINT " OK "; : COLOR 15, 7: PRINT ">"; : COLOR 0, 7: PRINT " < Help >"; STRING$(INT((LEN(Msg$) - mxy) / 2), 32); " ³": mm = 0: LOCATE 15, (40 - INT(LEN(Msg$) / 2)) + 2: GOTO Top 108: IF ASC(i$) = 13 THEN ELSE GOTO Top 109: LOCATE x%, y%: COLOR 7, 0 110: END SUB 111: 112: SUB ExeC (oof$) 113: IF oof$ = "ON" THEN DFnt = 1 114: IF oof$ = "OFF" THEN DFnt = 0 115: END SUB 116: 117: SUB Font (t$, cl) 118: IF cl = -1 THEN ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$) 119: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END 120: FOR qww = 1 TO LEN(t$) 121: IF ASC(MID$(t$, qww, 1)) = 0 THEN DRAW "X" + VARPTR$(txt(32)) ELSE DRAW "X" + VARPTR$(txt(ASC(MID$(t$, qww, 1)))): DRAW "BL": GOTO 1011 122: 1011 NEXT qww 123: END SUB 124: 125: FUNCTION GetPrmt$ (pt$) 126: FOR q = 1 TO LEN(pt$) 127: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "P" THEN q = q + 1: mm$ = mm$ + wt$: GOTO nextl 128: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "G" THEN q = q + 1: mm$ = mm$ + ">": GOTO nextl 129: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "_" THEN q = q + 1: mm$ = mm$ + CHR$(13): GOTO nextl 130: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "T" THEN q = q + 1: mm$ = mm$ + TIME$: GOTO nextl 131: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "D" THEN q = q + 1: mm$ = mm$ + DATE$: GOTO nextl 132: mm$ = mm$ + MID$(pt$, q, 1) 133: nextl: 134: NEXT q 135: GetPrmt$ = mm$ 136: END FUNCTION 137: 138: SUB LoadFont (f$) 139: OPEN f$ FOR INPUT AS #1: t = 0 140: DO UNTIL EOF(1) OR t = 127 141: LINE INPUT #1, a$ 142: txt(t) = a$ 143: t = t + 1 144: LOOP 145: CLOSE 1 146: END SUB 147: 148: SUB PRINT2 (t$, cv) 149: IF HRes = 1 AND DFnt = 1 THEN ELSE GOTO 2111 150: x = -2: y = -2 151: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2 152: IF y = -2 THEN y = CSRLIN * 16: n = -2 153: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv))) 154: 3 DRAW "X" + VARPTR$(d$) 155: Font t$, cv 156: IF LEN(t$) >= 80 THEN EXIT SUB 157: LOCATE CSRLIN, POS(0) + LEN(t$) 158: 'IF n = -2 AND y < 25 THEN LOCATE CSRLIN + 1, 1 159: EXIT SUB 160: 2111 COLOR cv 161: PRINT t$; 162: END SUB 163: 164: SUB ReadKey (prm$, t$, chrs, brd$, rd) 165: t$ = "" 166: PRINT2 prm$, 7 167: DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27) 168: IF q = 3600 THEN IF POS(0) > 1 THEN PRINT : PRINT2 "Computer>" + brd$, 7: q = 0: PRINT2 prm$ + t$, 7: ELSE PRINT "IS2000>"; TAB(10); brd$: : q = 0: PRINT2 prm$ + t$, 7 169: 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 170: i$ = UCASE$(INKEY$) 171: x% = CSRLIN: y% = POS(0) 172: IF TIME$ <> oldtm$ AND HRes = 0 THEN COLOR 15, 1: LOCATE Lstln, 1, 0: PRINT TIME$; STRING$(80 - LEN(TIME$), 32); : COLOR 7, 0: LOCATE x%, y%, 1: oldtm$ = TIME$: IF q < 3600 AND rd = 1 THEN q = q + 1 173: IF TIME$ <> oldtm$ AND HRes = 1 THEN COLOR 15: LOCATE Lstln, 1, 0: PRINT TIME$ + STRING$(80 - LEN(TIME$), 32); : COLOR 7: LOCATE x%, y%, 1: oldtm$ = TIME$: IF q < 3600 AND rd = 1 THEN q = q + 1 174: IF i$ = "" THEN GOTO 60 175: IF i$ = CHR$(0) + "=" THEN GOSUB 1009 176: oldtm$ = TIME$ 177: q = 0 178: IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60 179: IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70 180: IF HRes = 1 THEN PRINT2 UCASE$(i$), 7 181: IF HRes = 0 THEN PRINT UCASE$(i$); 182: t$ = t$ + i$ 183: IF LEN(t$) >= chrs THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 184: 60 LOOP 185: 70 PRINT2 "", 7 186: LastTyped = t$ 187: IF CSRLIN = 29 THEN LOCATE CSRLIN + 1, 1: PRINT ELSE LOCATE CSRLIN + 1, 1 188: EXIT SUB 189: 190: 1009 t$ = t$ + MID$(LastTyped, 1, chrs - LEN(t$) - 1) 191: LOCATE CSRLIN, LEN(prm$) + 1, 1: PRINT2 t$, 7 192: RETURN 193: END SUB 194: 195: FUNCTION ReadLn$ (ln) 196: FOR q = 1 TO 80 197: mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(SCREEN(ln, q, 1)) 198: NEXT q 199: ReadLn$ = mm$ 200: END FUNCTION 201: 202: SUB UnloadFont 203: FOR q = 0 TO 255 204: txt(q) = "" 205: NEXT q 206: END SUB 207: 208: SUB WriteLn (Msg$, ln, bg) 209: x% = CSRLIN: y% = POS(0) 210: IF ln = 0 OR ln > 25 THEN EXIT SUB 211: LOCATE ln, 1, 0 212: FOR q = 1 TO LEN(Msg$) STEP 2 213: COLOR ASC(MID$(Msg$, q + 1, 1)), bg 214: PRINT MID$(Msg$, q, 1); 215: NEXT q 216: LOCATE x%, y%, 1 217: END SUB 218: |