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