1: DECLARE SUB Print3 (x!, y!, cv!, t$) 2: DECLARE SUB Msgbox (ms$, Tit$) 3: DECLARE SUB Button2 (x1!, y1!, x2!, y2!, p!, t$) 4: DECLARE SUB ExeC (oof$) 5: DECLARE SUB UnloadFont () 6: DECLARE SUB LoadFont (f$) 7: DECLARE SUB Print2 (t$, cv!) 8: DECLARE SUB Font (t$, cl!) 9: DECLARE FUNCTION ReadLn$ (ln!) 10: DECLARE SUB Comport (port$) 11: DECLARE SUB ClrBot () 12: DECLARE SUB Corr (n$) 13: DECLARE SUB ReadKey (prm$, t$, chrs!, brd$, rd!) 14: DECLARE FUNCTION GetPrmt$ (pt$) 15: DECLARE SUB arch (dd$) 16: DECLARE SUB Hlppr () 17: DECLARE SUB connect () 18: DECLARE SUB MakFnt (f$) 19: DECLARE SUB SCRNSVR () 20: DECLARE SUB GetFnt (a!, bg!, os!, f$) 21: DECLARE FUNCTION FORO$ () 22: DECLARE SUB RestFat () 23: DECLARE SUB Sleep2 (t!) 24: DECLARE SUB Errorr (Msg$) 25: DECLARE FUNCTION TextWidth! (t$) 26: ON ERROR GOTO RuntimeErr 27: DIM SHARED ENV(1 TO 500) AS STRING 28: DIM SHARED ENV1(1 TO 500) AS STRING 29: DIM SHARED mxenv AS INTEGER 30: DIM SHARED wt$ 31: DIM SHARED LastTyped AS STRING 32: DIM SHARED Lstln AS INTEGER 33: DIM SHARED HRes AS INTEGER 34: DIM SHARED Txt(255) AS STRING 35: DIM SHARED CPort$ 36: DIM SHARED CMM 37: DIM SHARED DFnt 38: DIM SHARED CMmPrt 39: DIM SHARED tmrr 40: DIM SHARED Egaa 41: tmrr = 30 42: LoadFont "C:\ASCIN.FNT" 43: 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "VGA" OR UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "" THEN SCREEN 12: HRes = 1: DFnt = 1: Lstln = 30 44: 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "EGA" THEN SCREEN 9: HRes = 1: DFnt = 1: Lstln = 25: Egaa = 1 45: 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "TEXT" THEN SCREEN 0: HRes = 0: DFnt = 0: Lstln = 25 46: HRes = 1 47: Lstln = 30 48: ver$ = "1.00" 49: PRINT 50: Print2 " RK-DOS Version " + ver$, 15 51: PRINT 52: ENV(1) = "$ $L$P$G" 53: ENV1(1) = "PATH" 54: mxenv = 1 55: nn = 0 56: wt$ = curdir$ 57: 10 ReadKey GetPrmt(ENV(1)), cmd$, 70, Msg$, nn 58: wt$ = curdir$ 59: cmd$ = LTRIM$(cmd$) 60: IF cmd$ = "" GOTO 10 61: 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$, " ")) 62: IF UCASE$(ff$) = "EXIT" THEN UnloadFont: END 63: IF UCASE$(ff$) = "FREE" THEN Print2 "Memmory left:" + STR$(FRE(-1)) + " bytes", 15: PRINT : GOTO 10 64: IF UCASE$(ff$) = "SEND" THEN IF cmdlne$ = "" THEN Print2 "Syntax: SEND msg", 7: PRINT : GOTO 10 ELSE IF CMM = 1 THEN PRINT #3, cmdlne$: GOTO 10 ELSE Print2 "Com port not open", 7: PRINT "": GOTO 10 65: IF UCASE$(ff$) = "CLS" OR UCASE$(ff$) = "CLEAR" THEN CLS : GOTO 10 66: IF UCASE$(ff$) = "PROMPT" THEN IF cmdlne$ = "" THEN Print2 ENV(1), 7: PRINT : GOTO 10 ELSE ENV(1) = cmdlne$: GOTO 10 67: IF UCASE$(ff$) = "NOWAIT" THEN nn = 0: GOTO 10 68: IF UCASE$(ff$) = "WAIT" THEN IF cmdlne$ = "" THEN Print2 "WAIT message is" + Msg$, 7: PRINT : GOTO 10 ELSE nn = 1: Corr cmdlne$: Msg$ = cmdlne$: GOTO 10 69: IF UCASE$(ff$) = "DOS" THEN IF cmdlne$ = "" THEN Print2 "Syntax: DOS dos_prog", 7: PRINT : GOTO 10 ELSE ClrBot: SHELL (cmdlne$): wt$ = curdir$: GOTO 10 70: IF UCASE$(ff$) = "COM_ON" THEN IF cmdlne$ = "" THEN Print2 "Syntax: COM_ON comport#: speed", 7: PRINT : GOTO 10 ELSE Comport cmdlne$: CMM = 1: GOTO 10 71: IF UCASE$(ff$) = "LINES" THEN IF cmdlne$ <> "" AND (VAL(cmdlne$) = 25 OR VAL(cmdlne$) = 43 OR VAL(cmdlne$) = 50) THEN SCREEN 0: WIDTH 80, VAL(cmdlne$): Lstln = VAL(cmdlne$): HRes = 0: GOTO 10 ELSE Print2 "Syntax: LINES {25,43,50}", 7: PRINT : GOTO _ 72: 10 73: IF UCASE$(ff$) = "LOWRES" THEN Lstln = 25: SCREEN 0: WIDTH 80, 25: HRes = 0: GOTO 10 74: IF UCASE$(ff$) = "HIRES" AND HRes = 0 THEN Lstln = 30: SCREEN 12: HRes = 1: GOTO 10 75: IF UCASE$(ff$) = "VER" AND HRes = 1 THEN Print2 "RK-DOS Version " + ver$, 15: PRINT : PRINT : GOTO 10 76: IF UCASE$(ff$) = "VER" AND HRes = 0 THEN COLOR 15, 1: PRINT "RK-DOS Version " + ver$: PRINT : COLOR 7, 0: GOTO 10 77: IF UCASE$(ff$) = "FONT" THEN IF cmdlne$ <> "" AND (RTRIM$(LTRIM$(cmdlne$)) = "ON" OR RTRIM$(LTRIM$(cmdlne$)) = "OFF") THEN ExeC RTRIM$(LTRIM$(cmdlne$)): GOTO 10 ELSE Print2 "FONT is " + FORO$, 7: PRINT : GOTO 10 78: IF UCASE$(ff$) = "LOADFONT" THEN IF cmdlne$ = "" THEN Print2 "Syntax: LOADFONT fontname", 7: PRINT : GOTO 10 ELSE UnloadFont: LoadFont cmdlne$: GOTO 10 79: IF UCASE$(ff$) = "UNLOADFONT" THEN UnloadFont: GOTO 10 80: IF UCASE$(ff$) = "MOVE" THEN IF cmdlne$ = "" THEN Print2 "X=" + STR$(CSRLIN - 1) + " Y=" + STR$(POS(0)), 7: PRINT : GOTO 10 ELSE LOCATE VAL(MID$(cmdlne$, 1, INSTR(cmdlne$, " ") - 1)), VAL(MID$(cmdlne$, INSTR(cmdlne$, " ") + 1, LEN(cmdlne$) - INSTR( _ 81: cmdlne$, " "))): GOTO 10 82: IF UCASE$(ff$) = "TERM" THEN GOSUB CMPRT: GOTO 10 83: IF UCASE$(ff$) = "COM_OFF" THEN IF CMM = 0 THEN Print2 "Com port not open", 7: PRINT : GOTO 10 ELSE CLOSE #3: CMM = 0: COM(CMmPrt) OFF: GOTO 10 84: IF UCASE$(ff$) = "TIMER" THEN IF cmdlne$ = "" THEN Print2 "TIMER =" + STR$(tmrr), 7: PRINT : GOTO 10 ELSE tmrr = VAL(cmdlne$): GOTO 10 85: IF UCASE$(ff$) = "DIR" THEN s$ = "dir " + cmdlne$: SHELL s$: s$ = "": GOTO 10'ListFls:goto 10 86: IF MID$(ff$, 1, 3) = "!AT" THEN IF CMM = 0 THEN Print2 "Com port not open", 7: PRINT ELSE PRINT #3, MID$(ff$, 2, LEN(ff$) - 1) + " " + cmdlne$ 87: IF UCASE$(ff$) = "AR" THEN arch cmdlne$: GOTO 10 88: IF UCASE$(ff$) = "//?" THEN Hlppr: GOTO 10 89: Print2 "Unkown command:" + ff$, 7 90: PRINT 91: GOTO 10 92: 93: CMPRT: 94: IF CMM = 0 THEN Print2 "Com port not open", 7: PRINT : GOTO 121 95: COM(CMmPrt) OFF 96: connect 97: FOR q = 1 TO 39 98: Print2 CHR$(219), 8 99: Print2 CHR$(219), 15 100: NEXT q 101: PRINT 102: 121 RETURN 103: 104: RuntimeErr: 105: Errorr "Runtime error number: " + RTRIM$(LTRIM$(STR$(ERR))) + " using device: " + ERDEV$ + ", aborting" 106: RESUME NEXT 107: 108: SUB arch (dd$) 109: DIM B AS STRING * 1 110: IF INSTR(dd$, "-") = 0 OR dd$ = "" OR INSTR(dd$, "A:") = 0 THEN Print2 "Syntax: AR -{l|a|r} A:archive [F:file] ", 7: PRINT : EXIT SUB ELSE arcc$ = MID$(dd$, INSTR(dd$, "A:") + 2, LEN(dd$) - 2 - INSTR(INSTR(dd$, "A:"), dd$, " ")) 111: IF INSTR(dd$, "F:") = 0 THEN fspc$ = "*.*" ELSE fspc$ = MID$(dd$, INSTR(dd$, "F:") + 2, 12) 112: 'crf$ = dir$(fspc$) 113: IF INSTR(arcc$, ".") = 0 THEN arcc$ = arcc$ + ".A" 114: Print2 "Opening archive " + arcc$, 7: PRINT 115: OPEN arcc$ FOR BINARY AS #5 116: IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "A" THEN GOTO 12 117: IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "L" THEN GOTO 13 118: IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "R" THEN GOTO 14 119: Print2 "Invaild switch: " + MID$(dd$, INSTR(dd$, "-"), 2), 7: PRINT : CLOSE 5: EXIT SUB 120: 12 DO UNTIL crf$ = "" 121: Print2 "Proccessing " + crf$, 7: PRINT 122: OPEN crf$ FOR BINARY AS #6 123: PUT #5, , crf$ 124: ddd = LOF(6) 125: PUT #5, , ddd 126: FOR q = 0 TO LOF(6) 127: GET #6, q, B 128: PUT #5, , B 129: NEXT q 130: CLOSE 6 131: crf$ = dir$ 132: LOOP 133: CLOSE 5 134: EXIT SUB 135: 13 PRINT "Not availble yet (L)" 136: CLOSE 5 137: EXIT SUB 138: 14 PRINT "Not availble yet (R)" 139: CLOSE 5 140: END SUB 141: 142: SUB Button2 (x1, y1, x2, y2, p, t$) 143: IF p = 1 OR p = 4 THEN q = 1: GOTO PUSHED 144: 'PRINT Clk; Clx; Cly; p; x1; x2; Y1; y2 145: LINE (x1, y1)-(x1, y2 - 1), 15 146: LINE (x1, y1)-(x2 - 1, y1), 15 147: LINE (x2 - 1, y1 + 1)-(x2 - 1, y2 - 1), 8 148: LINE (x2 - 1, y2 - 1)-(x1 + 1, y2 - 1), 8 149: LINE (x1, y2)-(x2, y2), 0 150: LINE (x2, y2)-(x2, y1), 0 151: LINE (x1 + 1, y1 + 1)-(x2 - 2, y2 - 2), 7, BF 152: IF p = 6 THEN Print3 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: DO UNTIL Clk = 1 AND Clx > x1 - 1 AND Clx < x2 + 1 AND Cly > y1 - 1 AND Cly < y2 + 1 OR INKEY$ = CHR$(13): LOOP: Sleep2 .13: GOTO PUSHED 153: IF p = 5 THEN Print3 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: DO UNTIL Clk = 1 AND Clx > x1 - 1 AND Clx < x2 + 1 AND Cly > y1 - 1 AND Cly < y2 + 1: LOOP: Sleep2 .13: GOTO PUSHED 154: IF p = 3 THEN Print3 INT(((x2 - x1) / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14, 0, t$: DO UNTIL INKEY$ = CHR$(13): LOOP: q = 1 ELSE GOTO ssd 155: PUSHED: 156: LINE (x1, y1)-(x1, y2), 0 157: LINE (x1, y1)-(x2, y1), 0 158: LINE (x1 + 1, y1 + 1)-(x1 + 1, y2 - 1), 8 159: LINE (x1 + 1, y1 + 1)-(x2 - 1, y1 + 1), 8 160: LINE (x1 + 1, y2)-(x2, y2), 15 161: LINE (x2, y2)-(x2, y1 + 1), 15 162: LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 7, BF 163: ssd: 164: IF LEN(t$) * 8 > x2 - x1 THEN EXIT SUB 165: wdt = x2 - x1 166: Print3 INT((wdt / 2) - ((LEN(t$) / 2) * 8) + x1), y1 + 14 + q, 0, t$ 167: IF p > 2 THEN Sleep2 .13 168: IF p > 2 THEN Button2 x1, y1, x2, y2, 0, t$ 169: END SUB 170: 171: SUB ClrBot 172: x% = CSRLIN: y% = POS(0) 173: LOCATE Lstln, 1, 0 174: PRINT STRING$(80, 32); 175: LOCATE x%, y%, 1 176: END SUB 177: 178: SUB Comport (port$) 179: CLOSE #3 180: f$ = "COM" + RTRIM$(LTRIM$(port$)) 181: OPEN f$ FOR RANDOM AS #3 182: COM(VAL(port$)) ON 183: ON COM(VAL(port$)) GOSUB CMPRT 184: CMmPrt = VAL(port$) 185: CPort$ = port$ 186: END SUB 187: 188: SUB connect 189: IF CMM = 0 THEN Print2 "Com port not open", 7: PRINT : EXIT SUB 190: Print2 "Terminal Emulation", 14: PRINT 191: DO UNTIL ch$ = CHR$(27) 192: ch$ = INKEY$ 193: IF ch$ = CHR$(13) THEN ch$ = CHR$(13) + CHR$(10) 194: IF ch$ <> "" THEN PRINT #3, ch$; 195: IF LOC(3) <> 0 THEN inchar$ = INPUT$(1, #3) ELSE inchar$ = "" 196: IF inchar$ = CHR$(8) AND POS(0) > 1 THEN 197: LOCATE CSRLIN, POS(0) - 1 198: PRINT " "; 199: LOCATE CSRLIN, POS(0) - 1 200: ELSEIF inchar$ = CHR$(8) AND POS(0) = 1 AND CSRLIN > 1 THEN 201: LOCATE CSRLIN - 1, 79 202: PRINT " "; 203: LOCATE , POS(0) - 1 204: END IF 205: IF inchar$ = CHR$(8) THEN inchar$ = "" 206: IF POS(0) = 79 THEN PRINT 207: IF inchar$ = CHR$(13) THEN LOCATE CSRLIN, 1 ELSE IF inchar$ = CHR$(10) THEN cxx% = POS(0): PRINT : LOCATE CSRLIN, cxx%: cxx% = 0 ELSE Print2 inchar$, 14 208: 'IF inchar$ = CHR$(168) THEN END 209: LOOP 210: PRINT #3, "+++" 211: PRINT #3, "ATH" 212: PRINT #3, "ATS0=0" 213: PRINT 214: Print2 "Flushing com port buffer", 8: PRINT 215: CLOSE #3 216: CMM = 0 217: CMM = 1 218: SLEEP 1 219: Comport CPort$ 220: END SUB 221: 222: SUB Corr (n$) 223: lnn$ = UCASE$(MID$(n$, 1, 1)) 224: FOR q = 2 TO LEN(n$) 225: IF MID$(n$, q, 1) = " " OR MID$(n$, q, 1) = CHR$(255) THEN lnn$ = lnn$ + " ": GOTO 122 226: IF MID$(n$, q, 1) <> "&" AND cptl = 0 THEN lnn$ = lnn$ + LCASE$(MID$(n$, q, 1)) 227: IF cptl = 1 THEN lnn$ = lnn$ + UCASE$(MID$(n$, q, 1)): cptl = 0 228: IF MID$(n$, q, 1) = "." OR MID$(n$, q, 1) = "&" THEN cptl = 1 229: 122 NEXT q 230: n$ = lnn$ 231: 232: END SUB 233: 234: SUB DCHK 235: IF CSRLIN = Lstln - 1 OR CSRLIN = Lstln THEN LOCATE Lstln, 1: PRINT : LOCATE Lstln - 1, 1 236: END SUB 237: 238: SUB Errorr (Msg$) 239: Msgbox Msg$, "Error" 240: END SUB 241: 242: SUB ExeC (oof$) 243: IF oof$ = "ON" THEN DFnt = 1 244: IF oof$ = "OFF" THEN DFnt = 0 245: END SUB 246: 247: SUB Font (t$, cl) 248: IF cl = -1 THEN ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$) 249: IF Txt(32) = "" THEN PRINT t$; : DFnt = 0: EXIT SUB 250: FOR qww = 1 TO LEN(t$) 251: 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 252: 1011 NEXT qww 253: END SUB 254: 255: FUNCTION FORO$ 256: IF DFnt = 1 THEN FORO$ = "on" 257: IF DFnt = 0 THEN FORO$ = "off" 258: END FUNCTION 259: 260: SUB GetFnt (a, bg, os, f$) 261: 'LINE (d * 8, m)-((d + 1) * 8, 15 + m), 1, B 262: d = a - os: u = 15: r = 0 263: FOR x = (d) * 8 TO (1 + d) * 8 264: FOR y = 0 + m TO 15 + m 265: u = u - 1 266: IF POINT(x, y) = bg THEN ELSE GOTO 310 267: uh$ = LTRIM$(RTRIM$(STR$(u))) 268: ur$ = LTRIM$(RTRIM$(STR$(u - 1))) 269: lt$ = lt$ + "BU" + uh$ + "DBD" + ur$ 270: PSET (x, y), 14 271: 310 NEXT y 272: r = r + 1: u = 15 273: lt$ = lt$ + "br" 274: NEXT x 275: f$ = lt$ 276: END SUB 277: 278: FUNCTION GetPrmt$ (pt$) 279: FOR q = 1 TO LEN(pt$) 280: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "P" THEN q = q + 1: mm$ = mm$ + wt$: GOTO nextl 281: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "G" THEN q = q + 1: mm$ = mm$ + ">": GOTO nextl 282: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "_" THEN q = q + 1: mm$ = mm$ + CHR$(10) + CHR$(13): GOTO nextl 283: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "T" THEN q = q + 1: mm$ = mm$ + TIME$: GOTO nextl 284: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "D" THEN q = q + 1: mm$ = mm$ + DATE$: GOTO nextl 285: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "L" THEN q = q + 1: mm$ = mm$ + "<": GOTO nextl 286: mm$ = mm$ + MID$(pt$, q, 1) 287: nextl: 288: NEXT q 289: GetPrmt$ = mm$ 290: END FUNCTION 291: 292: SUB Hlppr 293: Print2 "-- COMMANDS --", 15: PRINT 294: Print2 "EXIT - Quits RK-DOS", 1: PRINT 295: Print2 "FREE - Displays the amount of free low memmory", 2: PRINT 296: Print2 "SEND - Sends text to an open com port", 3: PRINT 297: Print2 "CLS - Clears the screen", 4: PRINT 298: Print2 "NOWAIT - Turns off the reminder", 5: PRINT 299: Print2 "WAIT - Turns on the reminder", 6: PRINT 300: Print2 "PROMPT - Changes the prompt", 7: PRINT 301: Print2 "DOS - Runs a dos program", 8: PRINT 302: Print2 "LINES - Changes the number of lines on the screen", 9: PRINT 303: Print2 "COM_ON - Opens a com port", 10: PRINT 304: Print2 "LOWRES - Changes to text mode", 11: PRINT 305: Print2 "HIRES - Changes to VGA graphics mode", 12: PRINT 306: Print2 "VER - Displays the RK-DOS version", 13: PRINT 307: Print2 "FONT - Turns the Font on or off", 14: PRINT 308: Print2 "LOADFONT - Loads a font", 15: PRINT 309: Print2 "UNLOADFONT - Unloads the font from memmory", 14: PRINT 310: Print2 "MOVE - Moves to a line and position on the screen", 13: PRINT 311: Print2 "TERM - Activates the terminal emulation", 12: PRINT 312: Print2 "COM_OFF - Closes the open com port", 11: PRINT 313: Print2 "TIMER - Sets the timer for the WAIT statement", 10: PRINT 314: END SUB 315: 316: SUB ListFls 317: 'lbl$ = dir$("*.*", 8) 318: PRINT " Label in drive C is " + lbl$ 319: DO UNTIL EOF(4) 320: LINE INPUT #4, ffm$ 321: f$ = MID$(ffm$, 1, 8) 322: ext$ = MID$(ffm$, 9, 3) 323: hh$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 11, 1))))) 324: mm$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 12, 1))))) 325: dd$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 13, 1))))) 326: mn$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 14, 1))))) 327: yy$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 15, 1))))) 328: IF LEN(hh$) = 1 THEN hh$ = "0" + hh$ 329: IF LEN(mm$) = 1 THEN mm$ = "0" + mm$ 330: IF LEN(dd$) = 1 THEN dd$ = "0" + dd$ 331: IF LEN(mn$) = 1 THEN mn$ = "0" + mn$ 332: IF LEN(yy$) = 1 THEN yy$ = "0" + yy$ 333: Print2 f$ + " " + ext$ + " " + hh$ + ":" + mm$ + " " + dd$ + "/" + mn$ + "/" + yy$, 7: PRINT 334: LOOP 335: RestFat 336: PRINT 337: END SUB 338: 339: SUB LoadFont (f$) 340: OPEN f$ FOR RANDOM AS #1 341: IF LOF(1) = 0 THEN CLOSE 1: MakFnt f$ ELSE CLOSE 1 342: IF Egaa = 1 THEN SCREEN 9 ELSE SCREEN 12 343: OPEN f$ FOR INPUT AS #1: t = 0 344: DO UNTIL EOF(1) OR t = 120 345: LINE INPUT #1, a$ 346: Txt(t) = a$ 347: t = t + 1 348: LOOP 349: CLOSE 1 350: END SUB 351: 352: SUB MakFnt (f$) 353: SCREEN 9: CLS 354: OPEN f$ FOR OUTPUT AS #1 355: FOR c = 0 TO 31: PRINT #1, "": NEXT c 356: FOR q = 32 TO 170 357: 'PRINT q 358: 'STOP 359: IF q = 0 THEN d = 32 ELSE d = q 360: LOCATE 1, 1: PRINT CHR$(d); 361: GetFnt 33, 15, 33, lt$ 362: CLS 363: tt = LEN(lt$) + tt 364: IF tt > 25000 THEN CLOSE 1: EXIT SUB 365: PRINT #1, lt$ 366: DRAW "X" + VARPTR$(lt$) 367: NEXT q 368: CLOSE 1 369: END SUB 370: 371: SUB Msgbox (ms$, Tit$) 372: waitn$ = "OK" 373: s = 17 374: v = 15 375: s = s + v 376: FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v 377: NEXT w 378: IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 8.4) ELSE pix = INT(LEN(ms$) * 8) 379: IF INT(LEN(waitn$) * 8.4) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 8.4) 380: x = 320 - INT(pix / 2) 381: y = 175 - s 382: DIM back(1 TO 10998) 383: GET (x, y)-(x + pix, y + s + v), back 384: LINE (x + 1, y + 1)-(x + pix - 1, y + v), 1, BF 385: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 5))) + ", " + RTRIM$(LTRIM$(STR$(y + v + 1))) 386: DRAW "X" + VARPTR$(m$) 387: Font Tit$, 15 388: LINE (x, y)-(x + pix, y + s + v), 0, B 389: LINE (x, y + v)-(x + pix, y + s + v), 0, B 390: LINE (x + 1, y + v + 1)-(x + pix - 1, y + s + v - 1), 7, BF 391: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(y + v + v + 1))) 392: DRAW "X" + VARPTR$(m$) 393: j = y 394: FOR a = 1 TO LEN(ms$) 395: IF MID$(ms$, a, 1) = CHR$(13) THEN j = j + v: m$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(j + v + v + 1))): DRAW "X" + VARPTR$(m$) 396: Font MID$(ms$, a, 1), 0 397: NEXT a 398: j = j + v: m$ = "BM" + RTRIM$(LTRIM$(STR$(INT(x + (pix / 2) + (LEN(waitn$) / 2) - 30)))) + ", " + RTRIM$(LTRIM$(STR$(j + v + v + 1))): DRAW "X" + VARPTR$(m$) 399: 'Font waitn$ 400: d = INT(x + (pix / 2) + (LEN(waitn$) / 2) - 30) 401: j = INT(j + v + v + 1) 402: m = 117 403: n = -107 404: Button2 j - n, d - m, j + 35 - n, d + 14 - m, 6, waitn$ 405: PUT (x, y), back, PSET 406: END SUB 407: 408: SUB Print2 (t$, cv) 409: IF HRes = 1 AND DFnt = 1 THEN ELSE GOTO 2111 410: x = -2: y = -2 411: IF x = -2 THEN x = (POS(0) * 8) - 7 412: IF y = -2 THEN y = CSRLIN * 16 413: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv))) 414: 3 DRAW "X" + VARPTR$(d$) 415: Font t$, cv 416: 417: IF LEN(t$) >= 80 THEN EXIT SUB 418: LOCATE CSRLIN, POS(0) + LEN(t$) 419: IF CSRLIN = Lstln THEN ClrBot: PRINT : LOCATE Lstln - 1, 1 420: IF POS(0) = 80 THEN PRINT 421: EXIT SUB 422: 2111 COLOR cv 423: PRINT t$; 424: END SUB 425: 426: SUB Print3 (x, y, cv, t$) 427: IF DFnt = 0 THEN GOTO 2122 428: IF x = -1 AND y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(cv))): GOTO 23 429: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2 430: IF y = -2 THEN y = CSRLIN * 16: n = -2 431: IF x = -3 THEN x = POINT(0) 432: xxx$ = LTRIM$(RTRIM$(STR$(x))) 433: yyy$ = LTRIM$(RTRIM$(STR$(y))) 434: ccc$ = " C" + LTRIM$(RTRIM$(STR$(cv))) 435: d$ = "BM" + xxx$ 436: d$ = d$ + "," + yyy$ 437: d$ = d$ + ccc$ 438: 'LOCATE 1, 1: PRINT d$ 439: 23 DRAW "X" + VARPTR$(d$) 440: Font t$, cv 441: 'IF n = -2 THEN PSET (POINT(0) + TextWidth(t$), POINT(1)), POINT(POINT(0) + TextWidth(t$), POINT(1)) 442: EXIT SUB 443: 2122 COLOR cv 444: PRINT t$; 445: END SUB 446: 447: SUB ReadKey (prm$, t$, chrs, brd$, rd) 448: brd$ = LTRIM$(RTRIM$(brd$)) 449: IF CSRLIN = Lstln THEN ClrBot: PRINT : LOCATE Lstln - 1, 1 450: t$ = "" 451: Print2 prm$, 7 452: DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27) 453: IF q = tmrr AND MID$(brd$, 1, 2) = "$$" THEN t$ = MID$(brd$, 3, LEN(brd$) - 2): Print2 t$, 7: PRINT : ClrBot: EXIT SUB 454: IF q = tmrr AND MID$(brd$, 1, 2) <> "$$" THEN IF POS(0) > 1 THEN PRINT : Print2 "Computer>" + brd$, 7: PRINT : q = 0: Print2 prm$ + t$, 7: ELSE PRINT "IS2000>"; TAB(10); brd$: : q = 0: Print2 prm$ + t$, 7 455: vv = -3: ww = -2 456: IF i$ = CHR$(8) THEN 457: IF DFnt = 1 AND LEN(t$) = 0 = 0 THEN Dstnc = TextWidth(RIGHT$(t$, 1)) - 1 458: IF LEN(t$) = 0 THEN i$ = "": GOTO 60 459: IF DFnt = 0 THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 ELSE t$ = MID$(t$, 1, LEN(t$) - 1): LINE (POINT(0), POINT(1))-(POINT(0) - Dstnc, POINT(1) - 16), 0, BF: PSET (POINT(0), POINT(1) + 16) _ 460: , POINT(POINT(0), POINT(1)): vv = POINT(1): ww = POINT(0) 461: END IF 462: i$ = UCASE$(INKEY$) 463: x% = CSRLIN: y% = POS(0) 464: 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 < tmrr AND rd = 1 THEN q = q + 1 465: 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 < tmrr AND rd = 1 THEN q = q + 1 466: 467: IF i$ = "" THEN GOTO 60 468: IF i$ = CHR$(0) + "=" THEN GOSUB 1009 469: IF i$ = CHR$(0) + ";" THEN SCRNSVR: CLS : Print2 prm$ + t$, 7 470: oldtm$ = TIME$ 471: q = 0 472: IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60 473: IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70 474: Print3 vv, ww, 7, UCASE$(i$) 475: t$ = t$ + i$ 476: IF LEN(t$) >= chrs THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 477: 60 LOOP 478: 70 Print2 "", 7 479: LastTyped = t$ 480: IF CSRLIN = Lstln - 1 OR CSRLIN = Lstln THEN ClrBot: LOCATE Lstln, 1: PRINT : LOCATE Lstln - 1, 1 ELSE PRINT 481: EXIT SUB 482: 483: 1009 t$ = t$ + MID$(LastTyped, 1, chrs - LEN(t$) - 1) 484: LOCATE CSRLIN, LEN(prm$) + 1, 1: Print2 t$, 7 485: RETURN 486: END SUB 487: 488: FUNCTION ReadLn$ (ln) 489: FOR q = 1 TO 80 490: mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(SCREEN(ln, q, 1)) 491: NEXT q 492: ReadLn$ = mm$ 493: END FUNCTION 494: 495: SUB RestFat 496: CLOSE 4 497: OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 498: END SUB 499: 500: SUB SCRNSVR 501: IF HRes = 1 THEN ELSE GOTO 102 502: CLS 503: ROT = 240 - 45 504: IF RTRIM$(LTRIM$(LCASE$(COMMAND$))) = "ega" THEN SCREEN 9: mma = 25: HT = 100 ELSE SCREEN 12: mma = 30: HT = 200 505: sz = 200 506: 'HT = 200 507: WZ = 0 508: DO UNTIL INKEY$ = CHR$(13) 509: QW = RND * 43 + 1 510: QW = WZ * 5 511: FOR AD = 0 TO 16 512: LINE (320 - sz + QW, ROT + HT + AD)-(320 + sz - QW, 240 + HT + AD), 2 513: NEXT AD 514: IF WZ < 39 AND d = 0 THEN WZ = WZ + 1 ELSE d = 1 515: IF WZ > 0 AND d = 1 THEN WZ = WZ - 1 ELSE d = 0 516: LOCATE mma, 1: PRINT "" 517: LOOP 518: EXIT SUB 519: 102 CLS 520: a$ = CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219) + CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176) 521: B$ = CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176) + CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219) 522: FOR q = 1 TO 10 523: f$ = f$ + a$ 524: g$ = g$ + B$ 525: NEXT q 526: COLOR 15, 1 527: LOCATE , , 0 528: DO UNTIL INKEY$ = CHR$(13) 529: PRINT f$; 530: FOR q = 1 TO 100: NEXT q 531: PRINT g$; 532: FOR q = 1 TO 100: NEXT q 533: LOOP 534: COLOR 7, 0 535: LOCATE , , 1 536: END SUB 537: 538: SUB Sleep2 (t) 539: a = TIMER 540: DO UNTIL TIMER >= a + t: LOOP 541: END SUB 542: 543: FUNCTION TextWidth (t$) 544: FOR q = 1 TO LEN(t$) 545: ta$ = Txt$(ASC(MID$(t$, q, 1))) 546: FOR m = 1 TO LEN(ta$) 547: IF LCASE$(MID$(ta$, m, 2)) = "br" THEN sz = sz + 1 548: IF LCASE$(MID$(ta$, m, 2)) = "bl" THEN sz = sz - 1 549: NEXT m 550: NEXT q 551: TextWidth = sz 552: END FUNCTION 553: 554: SUB UnloadFont 555: FOR q = 0 TO 255 556: Txt(q) = "" 557: NEXT q 558: END SUB 559: 560: SUB WriteFat (f$, ext$, hh, mm, dd, mn, yy) 561: f$ = f$ + STRING$(8, 32): f$ = MID$(f$, 1, 8) 562: ext$ = ext$ + " ": ext$ = MID$(ext$, 1, 3) 563: tt$ = f$ + ext$ + CHR$(hh) + CHR$(mm) + CHR$(dd) + CHR$(mn) + CHR$(yy) 564: CLOSE 4 565: OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 566: DO UNTIL EOF(4) 567: LINE INPUT #4, ff$ 568: IF UCASE$(ff$) = UCASE$(tt$) THEN exst = 1: CLOSE 4: GOTO 111 569: LOOP 570: CLOSE 4 571: OPEN "C:\YOUNICKS.FAT" FOR APPEND AS #4 572: PRINT #4, tt$ 573: CLOSE 4 574: 111 OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 575: END SUB 576: 577: SUB WriteLn (Msg$, ln, bg) 578: x% = CSRLIN: y% = POS(0) 579: IF ln = 0 OR ln > 25 THEN EXIT SUB 580: LOCATE ln, 1, 0 581: FOR q = 1 TO LEN(Msg$) STEP 2 582: COLOR ASC(MID$(Msg$, q + 1, 1)), bg 583: PRINT MID$(Msg$, q, 1); 584: NEXT q 585: LOCATE x%, y%, 1 586: END SUB 587: |