DECLARE SUB arch (dd$) DECLARE SUB Hlppr () DECLARE SUB connect () DECLARE SUB MakFnt (f$) DECLARE SUB SCRNSVR () DECLARE SUB GetFnt (a!, bg!, os!, f$) DECLARE SUB DCHK () DECLARE FUNCTION FORO$ () DECLARE SUB ListFls () DECLARE SUB RestFat () DECLARE SUB ExeC (oof$) DECLARE SUB UnloadFont () DECLARE SUB LoadFont (f$) DECLARE SUB print2 (t$, cv!) DECLARE SUB Font (t$, cl!) DECLARE SUB Errorr (Msg$) DECLARE FUNCTION ReadLn$ (ln!) DECLARE SUB Comport (port$) DECLARE SUB ClrBot () DECLARE SUB Corr (n$) DECLARE SUB ReadKey (prm$, t$, chrs!, brd$, rd!) DECLARE FUNCTION GetPrmt$ (pt$) DIM SHARED ENV(1 TO 500) AS STRING DIM SHARED ENV1(1 TO 500) AS STRING DIM SHARED mxenv AS INTEGER DIM SHARED wt$ DIM SHARED LastTyped AS STRING DIM SHARED LstLn AS INTEGER DIM SHARED HRes AS INTEGER DIM SHARED txt(255) AS STRING DIM SHARED CPort$ DIM SHARED CMM DIM SHARED DFnt DIM SHARED CMmPrt DIM SHARED tmrr DIM SHARED Egaa tmrr = 30 LoadFont "C:\ASCIN.FNT" 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) <> "EGA" THEN SCREEN 12: HRes = 1: DFnt = 1: Lstln = 30 ELSE Egaa = 1 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "EGA" THEN SCREEN 9: HRes = 1: DFnt = 1: Lstln = 25: Egaa = 1 'IF UCASE$(LTRIM$(RTRIM$(COMMAND$))) = "TEXT" THEN SCREEN 0: HRes = 0: DFnt = 0: Lstln = 25 HRes = 1: SCREEN 12: LstLn = 30: DFnt = 1 ver$ = "1.00" PRINT print2 " RK-DOS Version " + ver$, 15 PRINT ENV(1) = "$ $L$P$G" ENV1(1) = "PATH" mxenv = 1 nn = 0 'OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 wt$ = curdir$ 10 ReadKey GetPrmt(ENV(1)), cmd$, 70, Msg$, nn wt$ = curdir$ cmd$ = LTRIM$(cmd$) IF cmd$ = "" GOTO 10 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$, " ")) IF UCASE$(ff$) = "EXIT" THEN UnloadFont: END IF UCASE$(ff$) = "FREE" THEN print2 "Memmory left:" + STR$(FRE(-1)) + " bytes", 15: PRINT : GOTO 10 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 IF UCASE$(ff$) = "CLS" OR UCASE$(ff$) = "CLEAR" THEN CLS : GOTO 10 IF UCASE$(ff$) = "PROMPT" THEN IF cmdlne$ = "" THEN print2 ENV(1), 7: PRINT : GOTO 10 ELSE ENV(1) = cmdlne$: GOTO 10 IF UCASE$(ff$) = "NOWAIT" THEN nn = 0: GOTO 10 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 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 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 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 10 IF UCASE$(ff$) = "LOWRES" THEN LstLn = 25: SCREEN 0: WIDTH 80, 25: HRes = 0: GOTO 10 IF UCASE$(ff$) = "HIRES" AND HRes = 0 THEN LstLn = 30: SCREEN 12: HRes = 1: GOTO 10 IF UCASE$(ff$) = "VER" AND HRes = 1 THEN print2 "RK-DOS Version " + ver$, 15: PRINT : PRINT : GOTO 10 IF UCASE$(ff$) = "VER" AND HRes = 0 THEN COLOR 15, 1: PRINT "RK-DOS Version " + ver$: PRINT : COLOR 7, 0: GOTO 10 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 IF UCASE$(ff$) = "LOADFONT" THEN IF cmdlne$ = "" THEN print2 "Syntax: LOADFONT fontname", 7: PRINT : GOTO 10 ELSE UnloadFont: LoadFont cmdlne$: GOTO 10 IF UCASE$(ff$) = "UNLOADFONT" THEN UnloadFont: GOTO 10 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(cmdlne$, " "))): GOTO 10 IF UCASE$(ff$) = "TERM" THEN GOSUB CMPRT: GOTO 10 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 IF UCASE$(ff$) = "TIMER" THEN IF cmdlne$ = "" THEN print2 "TIMER =" + STR$(tmrr), 7: PRINT : GOTO 10 ELSE tmrr = VAL(cmdlne$): GOTO 10 IF UCASE$(ff$) = "DIR" THEN ListFls: GOTO 10 's$ = "dir " + cmdlne$: SHELL s$: s$ = "": GOTO 10 IF UCASE$(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$: GOTO 10 IF UCASE$(ff$) = "AR" THEN arch cmdlne$: GOTO 10 IF UCASE$(ff$) = "//?" THEN Hlppr: GOTO 10 print2 "Unkown command:" + ff$, 7 PRINT GOTO 10 CMPRT: IF CMM = 0 THEN print2 "Com port not open", 7: PRINT : GOTO 121 COM(CMmPrt) OFF connect FOR q = 1 TO 39 print2 CHR$(219), 8 print2 CHR$(219), 15 NEXT q PRINT 121 RETURN SUB arch (dd$) DIM b AS STRING * 1 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$, " ")) IF INSTR(dd$, "F:") = 0 THEN fspc$ = "*.*" ELSE fspc$ = MID$(dd$, INSTR(dd$, "F:") + 2, 12) 'crf$ = Dir$(fspc$) IF INSTR(arcc$, ".") = 0 THEN arcc$ = arcc$ + ".A" print2 "Opening archive " + arcc$, 7: PRINT OPEN arcc$ FOR RANDOM AS #5 IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "A" THEN GOTO 12 IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "L" THEN GOTO 13 IF MID$(dd$, INSTR(dd$, "-") + 1, 1) = "R" THEN GOTO 14 print2 "Invaild switch: " + MID$(dd$, INSTR(dd$, "-"), 2), 7: PRINT : CLOSE 5: EXIT SUB 12 DO UNTIL crf$ = "" print2 "Proccessing " + crf$, 7: PRINT OPEN crf$ FOR BINARY AS #6 ff$ = crf$ + CHR$(175) + LTRIM$(RTRIM$(STR$(LOF(6)))) + CHR$(174) PUT #6, , ff$ PRINT ff$ FOR q = 1 TO LOF(6) GET #6, q, b PUT #5, , b NEXT q CLOSE 6 crf$ = Dir$ LOOP CLOSE 5 EXIT SUB 13 PRINT "Not availble yet (L)" CLOSE 5 EXIT SUB 14 PRINT "Not availble yet (R)" CLOSE 5 END SUB SUB ClrBot x% = CSRLIN: y% = POS(0) LOCATE LstLn, 1, 0 PRINT STRING$(80, 32); LOCATE x%, y%, 1 END SUB SUB Comport (port$) CLOSE #3 f$ = "COM" + RTRIM$(LTRIM$(port$)) OPEN f$ FOR RANDOM AS #3 COM(VAL(port$)) ON ON COM(VAL(port$)) GOSUB CMPRT CMmPrt = VAL(port$) CPort$ = port$ END SUB SUB connect IF CMM = 0 THEN print2 "Com port not open", 7: PRINT : EXIT SUB print2 "Terminal Emulation", 14: PRINT DO UNTIL ch$ = CHR$(27) ch$ = INKEY$ IF ch$ = CHR$(13) THEN ch$ = CHR$(13) + CHR$(10) IF ch$ <> "" THEN PRINT #3, ch$; IF LOC(3) <> 0 THEN inchar$ = INPUT$(1, #3) ELSE inchar$ = "" IF inchar$ = CHR$(8) AND POS(0) > 1 THEN LOCATE CSRLIN, POS(0) - 1 PRINT " "; LOCATE CSRLIN, POS(0) - 1 ELSEIF inchar$ = CHR$(8) AND POS(0) = 1 AND CSRLIN > 1 THEN LOCATE CSRLIN - 1, 79 PRINT " "; LOCATE , POS(0) - 1 END IF IF inchar$ = CHR$(8) THEN inchar$ = "" IF POS(0) = 79 THEN PRINT 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 'IF inchar$ = CHR$(168) THEN END LOOP PRINT #3, "+++" PRINT #3, "ATH" PRINT #3, "ATS0=0" PRINT print2 "Flushing com port buffer", 8: PRINT CLOSE #3 CMM = 0 CMM = 1 'delay 1 Comport CPort$ END SUB SUB Corr (n$) lnn$ = UCASE$(MID$(n$, 1, 1)) FOR q = 2 TO LEN(n$) IF MID$(n$, q, 1) = " " OR MID$(n$, q, 1) = CHR$(255) THEN lnn$ = lnn$ + " ": GOTO 122 IF MID$(n$, q, 1) <> "&" AND cptl = 0 THEN lnn$ = lnn$ + LCASE$(MID$(n$, q, 1)) IF cptl = 1 THEN lnn$ = lnn$ + UCASE$(MID$(n$, q, 1)): cptl = 0 IF MID$(n$, q, 1) = "." OR MID$(n$, q, 1) = "&" THEN cptl = 1 122 NEXT q n$ = lnn$ END SUB SUB DCHK 'IF CSRLIN = LstLn - 1 OR CSRLIN = LstLn THEN LOCATE LstLn, 1: PRINT : LOCATE LstLn - 1, 1 END SUB SUB Errorr (Msg$) print2 Msg$, 14 END SUB SUB ExeC (oof$) IF oof$ = "ON" THEN DFnt = 1 IF oof$ = "OFF" THEN DFnt = 0 END SUB SUB Font (t$, cl) IF cl = -1 THEN ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$) IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END FOR qww = 1 TO LEN(t$) 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 1011 NEXT qww END SUB FUNCTION FORO$ IF DFnt = 1 THEN FORO$ = "on" IF DFnt = 0 THEN FORO$ = "off" END FUNCTION SUB GetFnt (a, bg, os, f$) 'LINE (d * 8, m)-((d + 1) * 8, 15 + m), 1, B D = a - os: u = 15: r = 0 FOR x = (D) * 8 TO (1 + D) * 8 FOR y = 0 + m TO 15 + m u = u - 1 IF POINT(x, y) = bg THEN ELSE GOTO 310 uh$ = LTRIM$(RTRIM$(STR$(u))) ur$ = LTRIM$(RTRIM$(STR$(u - 1))) lt$ = lt$ + "BU" + uh$ + "DBD" + ur$ PSET (x, y), 14 310 NEXT y r = r + 1: u = 15 lt$ = lt$ + "br" NEXT x f$ = lt$ END SUB FUNCTION GetPrmt$ (pt$) FOR q = 1 TO LEN(pt$) IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "P" THEN q = q + 1: mm$ = mm$ + wt$: GOTO nextl IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "G" THEN q = q + 1: mm$ = mm$ + ">": GOTO nextl IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "_" THEN q = q + 1: mm$ = mm$ + CHR$(10) + CHR$(13): GOTO nextl IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "T" THEN q = q + 1: mm$ = mm$ + TIME$: GOTO nextl IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "D" THEN q = q + 1: mm$ = mm$ + DATE$: GOTO nextl IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "L" THEN q = q + 1: mm$ = mm$ + "<": GOTO nextl mm$ = mm$ + MID$(pt$, q, 1) nextl: NEXT q GetPrmt$ = mm$ END FUNCTION SUB Hlppr print2 "-- COMMANDS --", 15: PRINT DCHK print2 "EXIT - Quits RK-DOS", 1: PRINT DCHK print2 "FREE - Displays the amount of free low memmory", 2: PRINT DCHK print2 "SEND - Sends text to an open com port", 3: PRINT DCHK print2 "CLS - Clears the screen", 4: PRINT DCHK print2 "NOWAIT - Turns off the reminder", 5: PRINT DCHK print2 "WAIT - Turns on the reminder", 6: PRINT DCHK print2 "PROMPT - Changes the prompt", 7: PRINT DCHK print2 "DOS - Runs a dos program", 8: PRINT DCHK print2 "LINES - Changes the number of lines on the screen", 9: PRINT DCHK print2 "COM_ON - Opens a com port", 10: PRINT DCHK print2 "LOWRES - Changes to text mode", 11: PRINT DCHK print2 "HIRES - Changes to VGA graphics mode", 12: PRINT DCHK print2 "VER - Displays the RK-DOS version", 13: PRINT DCHK print2 "FONT - Turns the Font on or off", 14: PRINT DCHK print2 "LOADFONT - Loads a font", 15: PRINT DCHK print2 "UNLOADFONT - Unloads the font from memmory", 14: PRINT DCHK print2 "MOVE - Moves to a line and position on the screen", 13: PRINT DCHK print2 "TERM - Activates the terminal emulation", 12: PRINT DCHK print2 "COM_OFF - Closes the open com port", 11: PRINT DCHK print2 "TIMER - Sets the timer for the WAIT statement", 10: PRINT DCHK END SUB SUB ListFls 'lbl$ = Dir$("*.*", 8) PRINT " Label in drive C is " + lbl$ DO UNTIL EOF(4) LINE INPUT #4, ffm$ FOR q = 12 TO 18 IF MID$(ffm$, q, 1) = CHR$(219) THEN MID$(ffm$, q, 1) = CHR$(0) NEXT q f$ = MID$(ffm$, 1, 8) ext$ = MID$(ffm$, 9, 3) hh$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 12, 1))))) mm$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 13, 1))))) dd$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 14, 1))))) mn$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 15, 1))))) yy$ = RTRIM$(LTRIM$(STR$(ASC(MID$(ffm$, 16, 1))))) IF LEN(hh$) = 1 THEN hh$ = "0" + hh$ IF LEN(mm$) = 1 THEN mm$ = "0" + mm$ IF LEN(dd$) = 1 THEN dd$ = "0" + dd$ IF LEN(mn$) = 1 THEN mn$ = "0" + mn$ IF LEN(yy$) = 1 THEN yy$ = "0" + yy$ print2 f$ + " " + ext$ + " " + hh$ + ":" + mm$ + " " + dd$ + "/" + mn$ + "/" + yy$ + dr$, 7: PRINT LOOP RestFat PRINT END SUB SUB LoadFont (f$) OPEN f$ FOR RANDOM AS #1 IF LOF(1) = 0 THEN CLOSE 1: MakFnt f$ ELSE CLOSE 1 IF Egaa = 1 THEN SCREEN 9 ELSE SCREEN 12 OPEN f$ FOR INPUT AS #1: t = 0 DO UNTIL EOF(1) OR t = 123 LINE INPUT #1, a$ txt(t) = a$ t = t + 1 LOOP CLOSE 1 END SUB SUB MakFnt (f$) SCREEN 9: CLS OPEN f$ FOR OUTPUT AS #1 FOR c = 0 TO 31: PRINT #1, "": NEXT c FOR q = 32 TO 170 IF q = 0 THEN D = 32 ELSE D = q LOCATE 1, 1: PRINT CHR$(D); GetFnt 33, 15, 33, lt$ CLS tt = LEN(lt$) + tt IF tt > 25000 THEN CLOSE 1: EXIT SUB PRINT #1, lt$ DRAW "X" + VARPTR$(lt$) NEXT q CLOSE 1 END SUB SUB print2 (t$, cv) IF HRes = 1 AND DFnt = 1 THEN ELSE GOTO 2111 x = -2: y = -2 IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2 IF y = -2 THEN y = CSRLIN * 16: n = -2 D$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv))) 3 DRAW "X" + VARPTR$(D$) Font t$, cv IF LEN(t$) >= 80 THEN EXIT SUB LOCATE CSRLIN, POS(0) + LEN(t$) IF CSRLIN = LstLn THEN ClrBot: PRINT : LOCATE LstLn - 1, 1 IF POS(0) = 80 THEN PRINT EXIT SUB 2111 COLOR cv PRINT t$; END SUB SUB ReadKey (prm$, t$, chrs, brd$, rd) brd$ = LTRIM$(RTRIM$(brd$)) IF CSRLIN = LstLn THEN ClrBot: PRINT : LOCATE LstLn - 1, 1 t$ = "" print2 prm$, 7 DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27) IF q = tmrr AND MID$(brd$, 1, 2) = "$$" THEN t$ = MID$(brd$, 3, LEN(brd$) - 2): print2 t$, 7: PRINT : ClrBot: EXIT SUB 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 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$ = UCASE$(INKEY$) x% = CSRLIN: y% = POS(0) 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 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 IF i$ = "" THEN GOTO 60 IF i$ = CHR$(0) + "=" THEN GOSUB 1009 IF i$ = CHR$(0) + ";" THEN SCRNSVR: CLS : print2 prm$ + t$, 7 oldtm$ = TIME$ q = 0 IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60 IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70 IF HRes = 1 THEN print2 UCASE$(i$), 7 IF HRes = 0 THEN PRINT UCASE$(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 print2 "", 7 LastTyped = t$ IF CSRLIN = LstLn - 1 OR CSRLIN = LstLn THEN ClrBot: LOCATE LstLn, 1: PRINT : LOCATE LstLn - 1, 1 ELSE PRINT EXIT SUB 1009 t$ = t$ + MID$(LastTyped, 1, chrs - LEN(t$) - 1) LOCATE CSRLIN, LEN(prm$) + 1, 1: print2 t$, 7 RETURN END SUB FUNCTION ReadLn$ (ln) FOR q = 1 TO 80 mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(SCREEN(ln, q, 1)) NEXT q ReadLn$ = mm$ END FUNCTION SUB RestFat CLOSE 4 OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 END SUB SUB SCRNSVR IF HRes = 1 THEN ELSE GOTO 102 CLS ROT = 240 - 45 IF RTRIM$(LTRIM$(LCASE$(COMMAND$))) = "ega" THEN SCREEN 9: mma = 25: HT = 100 ELSE SCREEN 12: mma = 30: HT = 200 SZ = 200 'HT = 200 WZ = 0 DO UNTIL INKEY$ = CHR$(13) QW = RND * 43 + 1 QW = WZ * 5 FOR AD = 0 TO 16 LINE (320 - SZ + QW, ROT + HT + AD)-(320 + SZ - QW, 240 + HT + AD), 2 NEXT AD IF WZ < 39 AND D = 0 THEN WZ = WZ + 1 ELSE D = 1 IF WZ > 0 AND D = 1 THEN WZ = WZ - 1 ELSE D = 0 LOCATE mma, 1: PRINT "" LOOP EXIT SUB 102 CLS a$ = CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219) + CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176) b$ = CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176) + CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219) FOR q = 1 TO 10 f$ = f$ + a$ g$ = g$ + b$ NEXT q COLOR 15, 1 LOCATE , , 0 DO UNTIL INKEY$ = CHR$(13) PRINT f$; 'delay .1 PRINT g$; 'delay .1 LOOP COLOR 7, 0 LOCATE , , 1 END SUB SUB UnloadFont FOR q = 0 TO 255 txt(q) = "" NEXT q END SUB SUB WriteFat (f$, ext$) hh = VAL(MID$(TIME$, 1, 2)) mm = VAL(MID$(TIME$, 4, 2)) dd = VAL(MID$(DATE$, 4, 2)) mn = VAL(MID$(DATE$, 1, 2)) yy = VAL(MID$(DATE$, 9, 2)) f$ = f$ + STRING$(8, 32): f$ = MID$(f$, 1, 8) ext$ = ext$ + " ": ext$ = MID$(ext$, 1, 3) tt$ = f$ + ext$ + CHR$(hh) + CHR$(mm) + CHR$(dd) + CHR$(mn) + CHR$(yy) CLOSE 4 OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 DO UNTIL EOF(4) LINE INPUT #4, ff$ IF UCASE$(ff$) = UCASE$(tt$) THEN exst = 1: CLOSE 4: GOTO 111 LOOP CLOSE 4 OPEN "C:\YOUNICKS.FAT" FOR APPEND AS #4 PRINT #4, tt$ CLOSE 4 111 OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 END SUB SUB WriteLn (Msg$, ln, bg) x% = CSRLIN: y% = POS(0) IF ln = 0 OR ln > 25 THEN EXIT SUB LOCATE ln, 1, 0 FOR q = 1 TO LEN(Msg$) STEP 2 COLOR ASC(MID$(Msg$, q + 1, 1)), bg PRINT MID$(Msg$, q, 1); NEXT q LOCATE x%, y%, 1 END SUB