5748399 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n dosterm.bas
   1: DECLARE SUB LoadFont (f$)
   2: DECLARE SUB BackGround (c!)
   3: DECLARE SUB InputBox (x!, y!, t$, Prm$)
   4: DECLARE SUB Window2 (length!, height!, row!, column!, tt$)
   5: DECLARE SUB MsgBox (ms$, Tit$)
   6: DECLARE SUB UnLoadFont ()
   7: DECLARE SUB Font (t$)
   8: DECLARE SUB TextBx (SX!, SY!, eX!, Ey!, t$, r!, l!, pw$, tb$, del!)
   9: DECLARE SUB oldstart ()
  10: DECLARE SUB waitforcall ()
  11: DECLARE SUB callbbs ()
  12: DECLARE SUB setmodemoption ()
  13: DECLARE SUB endprog ()
  14: DECLARE SUB opencom ()
  15: DECLARE SUB connect ()
  16: DECLARE FUNCTION menu% ()
  17: DECLARE SUB Print2 (x!, y!, c!, t$)
  18: DIM SHARED txt(255) AS STRING
  19: SCREEN 12: CLS
  20: LoadFont "C:\ASCIN.FNT"
  21: BackGround 1
  22: G10:
  23: MsgBox "DOSTerm 1.0", "Welcome"
  24: oldstart
  25: UnLoadFont
  26: 
  27: SUB BackGround (c)
  28: LINE (0, 0)-(640, 480), c, BF
  29: END SUB
  30: 
  31: SUB Button1 (x, y, s, P, tle$)
  32: IF P = 0 THEN clr1 = 15: clr2 = 8 ELSE clr1 = 8: clr2 = 15
  33: eX = x + s: Ey = y + s
  34: LINE (x, y)-(eX, Ey), 7, BF
  35: LINE (x, y)-(eX, Ey), 0, B
  36: LINE (x + 5, y + 5)-(eX - 5, Ey - 5), 7, BF
  37: LINE (x + 4, y + 4)-(eX - 4, Ey - 4), 0, B
  38: LINE (x, Ey)-(x + 4, Ey - 4), 0
  39: LINE (eX, y)-(eX - 4, y + 4), 0
  40: PAINT (x + 1, y + 1), clr1, 0
  41: PAINT (eX - 1, Ey - 1), clr2, 0
  42: END SUB
  43: 
  44: SUB callbbs
  45: CLS : BackGround 1
  46: Window2 630, 470, 0, 0, "Terminal Window"
  47: COLOR 3
  48: InputBox 30, 30, number$, "Type in the number"
  49: opencom
  50: PRINT #1, "ATDT" + number$
  51: Print2 10, 40, 0, "Calling " + number$ + "...."
  52: connect
  53: END SUB
  54: 
  55: SUB connect
  56:   a = 40: a = a + 17
  57:   Print2 10, a, 0, "Start Typing when modems connect... Press <Esc> to hang up:"
  58:   a = a + 17: Print2 10, a, 0, ""
  59: DO UNTIL ch$ = CHR$(halt)
  60:     ch$ = INKEY$
  61:     IF ch$ <> "" THEN PRINT #1, ch$;
  62:     IF LOC(1) <> 0 THEN inchar$ = INPUT$(1, #1) ELSE inchar$ = ""
  63:     IF inchar$ = CHR$(8) AND POS(0) <> 1 THEN
  64:       LOCATE , POS(0) - 1
  65:       PRINT " ";
  66:       LOCATE , POS(0) - 1
  67:      ELSEIF inchar$ = CHR$(8) AND POS(0) = 1 AND CSRLIN <> 1 THEN
  68:       LOCATE CSRLIN - 1, 80
  69:       PRINT " ";
  70:       LOCATE , POS(0) - 1
  71:     ELSEIF inchar$ = CHR$(8) THEN
  72:     ELSEIF inchar$ = CHR$(13) THEN
  73:     ELSE Print2 -1, -1, 0, inchar$
  74:     END IF
  75:   LOOP
  76:   CLOSE #1
  77: END SUB
  78: 
  79: 'This is how the program ends
  80: SUB endprog
  81:   COLOR 7
  82:   MsgBox "Terminating Session...", "Bye"
  83: END SUB
  84: 
  85: SUB Font (t$)
  86: DRAW "C0"
  87: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END
  88: FOR qww = 1 TO LEN(t$)
  89: IF ASC(MID$(t$, qww, 1)) = 0 THEN DRAW "X" + VARPTR$(txt(32)) ELSE DRAW "X" + VARPTR$(txt(ASC(MID$(t$, qww, 1)))): GOTO 1011
  90: 1011 NEXT qww
  91: END SUB
  92: 
  93: SUB InputBox (x, y, t$, Prm$)
  94: Z = 90
  95: s = 50
  96: DIM back(1 TO 9998)
  97: GET (x, y)-(x + 100 + Z, y + 50 + Z), back
  98: LINE (x, y)-(x + 100 + Z, y + 50 + Z), 0, BF
  99: LINE (x + 2, y + 2)-(x + 98 + Z, y + 48 + Z), 1, BF
 100: LINE (x + 10, y + 10)-(x + 90 + Z, y + 40 + Z), 0, BF
 101: LINE (x + 12, y + 12)-(x + 88 + Z, y + 38 + Z), 7, BF
 102: Xy = x + 15
 103: yX = y + 67 - s + Z
 104: Xx = x + 85 + Z
 105: yY = y + 82 - s + Z
 106: Xyz$ = "BM" + STR$(x + 14) + "," + STR$(y + 25)
 107: DRAW "X" + VARPTR$(Xyz$)
 108: Font Prm$
 109: TextBx Xy, yX, Xx, yY, t$, 1, 17, "", "", 0
 110: PUT (x, y), back, PSET
 111: END SUB
 112: 
 113: SUB LoadFont (f$)
 114: OPEN f$ FOR INPUT AS #1: t = 0
 115: DO UNTIL EOF(1)
 116: LINE INPUT #1, a$
 117: txt(t) = a$
 118: t = t + 1
 119: LOOP
 120: CLOSE 1
 121: END SUB
 122: 
 123: FUNCTION menu%
 124: CLS
 125: BackGround 1
 126: Window2 300, 300, 10, 10, "DOSTerm Main Menu"
 127: Print2 20, 50, 0, "1. Wait For Call"
 128: Print2 20, 70, 0, "2. Call Somewhere"
 129: Print2 20, 90, 0, "3. Set Mode Options"
 130: Print2 20, 110, 0, "4. Quit"
 131: DO
 132: TextBx 20, 120, 40, 135, ch$, 1, 1, "", "", 1
 133: LOOP UNTIL VAL(ch$) >= 1 AND VAL(ch$) <= 4
 134: menu% = VAL(ch$)
 135: END FUNCTION
 136: 
 137: SUB MsgBox (ms$, Tit$)
 138: wt$ = "[ENTER]"
 139: s = 17
 140: v = 15
 141: s = s + v
 142: FOR w = 1 TO LEN(ms$): l = l + 1: IF MID$(ms$, w, 1) = CHR$(13) THEN s = s + v
 143: NEXT w
 144: IF LEN(Tit$) >= LEN(ms$) THEN pix = INT(LEN(Tit$) * 9.2) ELSE pix = INT(LEN(ms$) * 9.2)
 145: IF INT(LEN(wt$) * 9.2) > pix THEN pix = INT(LEN(" (Press ENTER to continue.)") * 9.2)
 146: x = 320 - INT(pix / 2)
 147: y = 175 - s
 148: DIM back(1 TO 9998)
 149: GET (x, y)-(x + pix, y + s + v), back
 150: LINE (x + 1, y + 1)-(x + pix - 1, y + v), 9, BF
 151: M$ = "BM" + RTRIM$(LTRIM$(STR$(x + 5))) + ", " + RTRIM$(LTRIM$(STR$(y + v + 1)))
 152: DRAW "X" + VARPTR$(M$)
 153: Font Tit$
 154: LINE (x, y)-(x + pix, y + s + v), 0, B
 155: LINE (x, y + v)-(x + pix, y + s + v), 0, B
 156: LINE (x + 1, y + v + 1)-(x + pix - 1, y + s + v - 1), 7, BF
 157: M$ = "BM" + RTRIM$(LTRIM$(STR$(x + 2))) + ", " + RTRIM$(LTRIM$(STR$(y + v + v + 1)))
 158: DRAW "X" + VARPTR$(M$)
 159: j = y
 160: FOR a = 1 TO LEN(ms$)
 161: 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$)
 162: Font MID$(ms$, a, 1)
 163: NEXT a
 164: j = j + v: M$ = "BM" + RTRIM$(LTRIM$(STR$(INT(x + (pix / 2) + (LEN(wt$) / 2) - 30)))) + ", " + RTRIM$(LTRIM$(STR$(j + v + v + 1))): DRAW "X" + VARPTR$(M$)
 165: Font wt$
 166: DO UNTIL INKEY$ = CHR$(13): LOOP
 167: PUT (x, y), back, PSET
 168: END SUB
 169: 
 170: SUB oldstart
 171: CONST halt = 27
 172: COLOR 15
 173: DO
 174:   item% = menu%
 175:   SELECT CASE item%
 176:     CASE 1: waitforcall
 177:     CASE 2: callbbs
 178:     CASE 3: setmodemoption
 179:     CASE 4: endprog
 180:   END SELECT
 181: LOOP UNTIL item% = 4
 182: END SUB
 183: 
 184: SUB opencom
 185: 
 186:   OPEN "BASTerm.CFG" FOR INPUT AS #2
 187:   INPUT #2, comport$
 188:   CLOSE #2
 189:   OPEN comport$ + ",N,8,1,RB2048,TB2048" FOR RANDOM AS #1
 190: END SUB
 191: 
 192: SUB Print2 (x, y, c, t$)
 193: IF x = -1 AND y = -1 THEN d$ = "C" + LTRIM$(RTRIM$(STR$(c))): GOTO 3
 194: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(c)))
 195: 3 DRAW "X" + VARPTR$(d$)
 196: Font t$
 197: END SUB
 198: 
 199: SUB SCapt (FIL$)
 200: OPEN FIL$ FOR BINARY AS #1 LEN = 10000
 201: FOR x = 0 TO 639
 202: FOR y = 0 TO 479
 203: vv$ = CHR$(POINT(x, y) + 32)
 204: PUT #1, y + x, vv$: PSET (x, y), 15
 205: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 206: NEXT y
 207: NEXT x
 208: CLOSE 1
 209: END SUB
 210: 
 211: SUB setmodemoption
 212:   COLOR 2
 213:   InputBox 10, 10, portno$, "COM(1 or 2): "
 214:   InputBox 10, 10, speed$, "Modem Speed: "
 215:     comport$ = "COM" + portno$ + ":" + speed$
 216:     OPEN "BASTerm.CFG" FOR OUTPUT AS #2
 217:     PRINT #2, comport$
 218:     CLOSE #2
 219: END SUB
 220: 
 221: SUB Sleep2 (t)
 222: a = TIMER
 223: DO UNTIL TIMER >= a + t: LOOP
 224: 
 225: 
 226: END SUB
 227: 
 228: SUB SLoad (FIL$)
 229: OPEN FIL$ FOR RANDOM AS #1
 230: FOR x = 0 TO 639
 231: FOR y = 0 TO 479
 232: GET #1, y + 1 * (x + 1), clr$
 233: IF INKEY$ = "" THEN  ELSE CLOSE 1: EXIT SUB
 234: IF EOF(1) THEN CLOSE 1: PSET (x, y), clr%: EXIT SUB
 235: PSET (x, y), ASC(clr$) - 32
 236: 10 NEXT y
 237: NEXT x
 238: END SUB
 239: 
 240: SUB TextBx (SX, SY, eX, Ey, t$, r, l, pw$, tb$, del)
 241: IF LEN(tb$) > l AND r = 1 THEN tb$ = MID$(tb$, 1, l)
 242: t$ = tb$: w = LEN(tb$)
 243: IF del = 1 THEN ds = 0 ELSE ds = LEN(tb$)
 244: IF LEN(pw$) > 1 THEN pw$ = LEFT$(pw$, 1)
 245: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B
 246: LINE (SX, SY)-(eX, Ey), 15, BF
 247: MX$ = "M" + STR$(SX + 2) + "," + STR$(Ey - 0)
 248: DRAW "BX" + VARPTR$(MX$)
 249: IF pw$ = "" THEN Font tb$ ELSE Font STRING$(LEN(tb$), pw$)
 250: IF r = 1 THEN  ELSE EXIT SUB
 251: 12 a$ = INKEY$
 252: IF a$ = "" GOTO 12
 253: IF a$ = CHR$(8) THEN IF LEN(t$) - ds = 0 THEN GOTO 12 ELSE t$ = LEFT$(t$, LEN(t$) - 1): w = w - 1: LINE (SX - 1, SY - 1)-(eX + 1, Ey + 1), 0, B: LINE (SX, SY)-(eX, Ey), 15, BF: DRAW "BX" + VARPTR$(MX$): IF pw$ = "" THEN Font t$: GOTO 12 ELSE Font STRING$(LEN(t$), pw$): GOTO 12
 254: IF a$ = CHR$(13) THEN EXIT SUB
 255: IF w >= l THEN GOTO 12
 256: t$ = t$ + a$: w = w + LEN(a$)
 257: B$ = a$
 258: IF pw$ = "" THEN Font B$ ELSE Font pw$
 259: GOTO 12
 260: END SUB
 261: 
 262: SUB UnLoadFont
 263: 'Free Up Memmory Used By Font
 264: 'Do Not Try To Use The Font After This Command Is Issued
 265: FOR q = 0 TO 255
 266: txt(q) = ""
 267: NEXT q
 268: END SUB
 269: 
 270: SUB waitforcall
 271: CLS : BackGround 1
 272: Window2 630, 470, 0, 0, "Terminal Window"
 273:  COLOR 3
 274:   opencom
 275:   PRINT #1, "ATS0=1"
 276:   connect
 277: END SUB
 278: 
 279: SUB Window2 (length, height, row, column, tt$)
 280: LINE (column, row)-(column + length, row + height), 0, B
 281: FOR i% = 1 TO 2
 282: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 283: LINE (column, row)-(column + length, row), 7
 284: LINE (column, row)-(column, row + height), 7
 285: NEXT i%
 286: row = row + 1: column = column + 1: height = height - 1: length = length - 1
 287: LINE (column, row)-(column + length, row), 0
 288: LINE (column, row)-(column, row + height), 0
 289: LINE (column, row)-(column + 18, row + 18), 7, BF
 290: LINE (column, row)-(column + 18, row + 18), 0, B
 291: LINE (column + 18, row - 2)-(column + 18, row + 5), 0
 292: LINE (column - 2, row + 18)-(column + 5, row + 18), 0
 293: LINE (column + 5, row + 7)-(column + 13, row + 9), 15, BF: LINE (column + 5, row + 7)-(column + 13, row + 9), 0, B
 294: LINE (column + 14, row + 7)-(column + 14, row + 9), 8
 295: LINE (column + 6, row + 10)-(column + 14, row + 10), 8, B
 296: LINE (column + 18, row)-(column + length, row + 18), 9, BF
 297: LINE (column + 18, row)-(column + length, row + 18), 0, B
 298: LINE (column + length, row - 3)-(column + length + 2, row + height), 7, BF
 299: LINE (column + length, row - 3)-(column + length + 3, row + height), 0, B
 300: LINE (column + length, row - 2)-(column + length, row - 1), 7
 301: LINE (column + length - 18, row - 2)-(column + length - 18, row - 1), 0
 302: LINE (column + length, row + 18)-(column + length + 2, row + 18), 0
 303: LINE (column, row + height - 3)-(column + length, row + height - 3), 0, B
 304: LINE (column, row + height - 2)-(column + length + 2, row + height), 7, BF
 305: LINE (column - 2, row + height)-(column + length + 2, row + height), 0, B
 306: LINE (column - 2, row + height - 18)-(column, row + height - 18), 0
 307: LINE (column + length - 2, row + height - 18)-(column + length + 2, row + height - 18), 0
 308: LINE (column + 18, row + height)-(column + 18, row + height - 2), 0
 309: LINE (column + length - 18, row + height)-(column + length - 18, row + height - 2), 0
 310: LINE (column + 1, row + 19)-(column + length - 1, row + height - 4), 7, BF
 311: mm$ = "BM" + RTRIM$(LTRIM$(STR$(column + 20))) + "," + LTRIM$(RTRIM$(STR$(row + 17)))
 312: 'pset (column+20,row+15),15
 313: DRAW "X" + VARPTR$(mm$)
 314: Font tt$
 315: END SUB
 316: 
5748400 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:01:58