' window engine, 2003 ' Svjatoslav Agejenko ' svjatoslav@svjatoslav.eu DECLARE SUB demo () DECLARE FUNCTION getline$ (w%, l%) DECLARE SUB loadfile (file$, d%) DECLARE SUB sendline (w%, l%, newstring$) DECLARE FUNCTION getflin% () DECLARE SUB refresh () DECLARE FUNCTION addpage% (x%, y%, xs%, ys%, title$) DECLARE SUB box (x%, y%, xl%, yl%, e$) DEFINT A-Z DECLARE SUB shpage (a) DECLARE SUB start () DIM SHARED stamo stamo = 5000 DIM SHARED st$(1 TO stamo) DIM SHARED stpn DIM SHARED pag(1 TO 10, 1 TO 1000) DIM SHARED pagx(1 TO 10), pagy(1 TO 10), pagxs(1 TO 10), pagys(1 TO 10) DIM SHARED pagon(1 TO 10) DIM SHARED pagtitle$(1 TO 10) DIM SHARED pagshx(1 TO 10) ' x & y shift DIM SHARED pagshy(1 TO 10) DIM SHARED pageactive ' active page start demo FUNCTION addpage (x, y, xs, ys, title$) FOR a = 1 TO 10 IF pagon(a) = 0 THEN b = a: GOTO 1 NEXT a 1 pagon(b) = 1 pagx(b) = x pagy(b) = y pagxs(b) = xs pagys(b) = ys pagtitle$(b) = title$ addpage = b END FUNCTION SUB clrwnd (w) FOR a = 1 TO 1000 IF pag(w, a) > 0 THEN st$(pag(w, a)) = "": pag(w, a) = 0 NEXT a END SUB SUB demo w1 = addpage(1, 1, 30, 10, "window 1.") w2 = addpage(1, 12, 80, 30, "second window") w3 = addpage(31, 2, 30, 10, "last window") loadfile "wsystem.bas", w2 loadfile "wsystem.bas", w1 loadfile "wsystem.bas", w3 4 pageactive = INT(RND * 3) + 1 refresh FOR a = 1 TO 100 pagshx(pageactive) = SIN(a / 10) * 10 + 10 pagshy(pageactive) = a shpage pageactive SOUND 0, 1 IF INKEY$ <> "" THEN SYSTEM NEXT a GOTO 4 END SUB FUNCTION getflin ' Get free line 2 IF stpn > 1000 THEN stpn = 1 IF st$(stpn) = "" THEN getflin = stpn stpn = stpn + 1 ELSE stpn = stpn + 1 GOTO 2 END IF END FUNCTION FUNCTION getline$ (w, l) IF pag(w, l) = 0 THEN getline$ = "" ELSE getline$ = st$(pag(w, l)) END IF END FUNCTION SUB loadfile (file$, d) OPEN file$ FOR INPUT AS #1 FOR a = 1 TO 1000 IF EOF(1) <> 0 THEN GOTO 3 LINE INPUT #1, a$ sendline d, a, a$ NEXT a 3 CLOSE #1 FOR b = a TO 1000 sendline d, b, "" NEXT b END SUB SUB refresh CLS FOR a = 1 TO 10 IF pagon(a) > 0 THEN shpage (a) NEXT a END SUB SUB sendline (w, l, newstring$) ' window, lineNum, lineItself ' send string into window memory a$ = newstring$ IF a$ = SPACE$(LEN(a$)) THEN a$ = "" IF LEN(a$) > 0 THEN 5 IF RIGHT$(a$, 1) = " " THEN a$ = LEFT$(a$, LEN(a$) - 1) GOTO 5 END IF END IF IF a$ = "" THEN IF pag(w, l) > 0 THEN st$(pag(w, l)) = "": pag(w, l) = 0 ELSE IF pag(w, l) = 0 THEN pag(w, l) = getflin st$(pag(w, l)) = a$ END IF END SUB SUB shpage (page) IF page = pageactive THEN bg = 1 ELSE bg = 0 x = pagx(page) y = pagy(page) xl = pagxs(page) yl = pagys(page) e$ = pagtitle$(page) COLOR 11, bg a$ = "" d$ = "" FOR a = 1 TO xl - 2 a$ = a$ + CHR$(205) NEXT a b$ = CHR$(201) + a$ + CHR$(187) c$ = CHR$(200) + a$ + CHR$(188) LOCATE y, x PRINT b$ LOCATE y + yl - 1, x PRINT c$ FOR a = 1 TO yl - 2 LOCATE y + a, x d$ = getline(page, a + pagshy(page)) d$ = d$ + SPACE$(300) d$ = RIGHT$(d$, LEN(d$) - pagshx(page)) d$ = LEFT$(d$, xl - 2) PRINT CHR$(186) + d$ + CHR$(186) NEXT a xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2) LOCATE y, xt PRINT "[ " xt = xt + 2 COLOR 10 LOCATE y, xt PRINT e$ xt = xt + LEN(e$) COLOR 11 LOCATE y, xt PRINT " ]" COLOR 7, 0 END SUB SUB start WIDTH 80, 50 VIEW PRINT 1 TO 50 FOR a = 1 TO stamo st$(a) = "" NEXT a stpn = 1 END SUB