X-Git-Url: http://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=blobdiff_plain;f=misc%2Fwsystem.bas;fp=misc%2Fwsystem.bas;h=be1c40643341946307dfac8bb99168c308a0834d;hp=0000000000000000000000000000000000000000;hb=c6aaa433dedff2dd8063983c7716c0cdb296a0f9;hpb=3779e9035f2c67e36111585e10d956a3e9e3c0fa

diff --git a/misc/wsystem.bas b/misc/wsystem.bas
new file mode 100755
index 0000000..be1c406
--- /dev/null
+++ b/misc/wsystem.bas
@@ -0,0 +1,206 @@
+' 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
+