wsystem.bas

   1 ' window engine, 2003\r
   2 ' Svjatoslav Agejenko\r
   3 ' svjatoslav@svjatoslav.eu\r
   4 \r
   5 DECLARE SUB demo ()\r
   6 DECLARE FUNCTION getline$ (w%, l%)\r
   7 DECLARE SUB loadfile (file$, d%)\r
   8 DECLARE SUB sendline (w%, l%, newstring$)\r
   9 DECLARE FUNCTION getflin% ()\r
  10 DECLARE SUB refresh ()\r
  11 DECLARE FUNCTION addpage% (x%, y%, xs%, ys%, title$)\r
  12 DECLARE SUB box (x%, y%, xl%, yl%, e$)\r
  13 DEFINT A-Z\r
  14 DECLARE SUB shpage (a)\r
  15 DECLARE SUB start ()\r
  16 \r
  17 DIM SHARED stamo\r
  18 stamo = 5000\r
  19 DIM SHARED st$(1 TO stamo)\r
  20 DIM SHARED stpn\r
  21 \r
  22 DIM SHARED pag(1 TO 10, 1 TO 1000)\r
  23 DIM SHARED pagx(1 TO 10), pagy(1 TO 10), pagxs(1 TO 10), pagys(1 TO 10)\r
  24 DIM SHARED pagon(1 TO 10)\r
  25 DIM SHARED pagtitle$(1 TO 10)\r
  26 \r
  27 DIM SHARED pagshx(1 TO 10)      ' x & y shift\r
  28 DIM SHARED pagshy(1 TO 10)\r
  29 \r
  30 DIM SHARED pageactive            ' active page\r
  31 \r
  32 start\r
  33 \r
  34 demo\r
  35 \r
  36 FUNCTION addpage (x, y, xs, ys, title$)\r
  37 FOR a = 1 TO 10\r
  38   IF pagon(a) = 0 THEN b = a: GOTO 1\r
  39 NEXT a\r
  40 1\r
  41 \r
  42 pagon(b) = 1\r
  43 pagx(b) = x\r
  44 pagy(b) = y\r
  45 pagxs(b) = xs\r
  46 pagys(b) = ys\r
  47 pagtitle$(b) = title$\r
  48 \r
  49 addpage = b\r
  50 END FUNCTION\r
  51 \r
  52 SUB clrwnd (w)\r
  53 FOR a = 1 TO 1000\r
  54   IF pag(w, a) > 0 THEN st$(pag(w, a)) = "": pag(w, a) = 0\r
  55 NEXT a\r
  56 END SUB\r
  57 \r
  58 SUB demo\r
  59 w1 = addpage(1, 1, 30, 10, "window 1.")\r
  60 w2 = addpage(1, 12, 80, 30, "second window")\r
  61 w3 = addpage(31, 2, 30, 10, "last window")\r
  62 \r
  63 loadfile "wsystem.bas", w2\r
  64 loadfile "wsystem.bas", w1\r
  65 loadfile "wsystem.bas", w3\r
  66 \r
  67 4\r
  68 pageactive = INT(RND * 3) + 1\r
  69 refresh\r
  70 \r
  71 FOR a = 1 TO 100\r
  72   pagshx(pageactive) = SIN(a / 10) * 10 + 10\r
  73   pagshy(pageactive) = a\r
  74   shpage pageactive\r
  75   SOUND 0, 1\r
  76   IF INKEY$ <> "" THEN SYSTEM\r
  77 NEXT a\r
  78 \r
  79 GOTO 4\r
  80 END SUB\r
  81 \r
  82 FUNCTION getflin ' Get free line\r
  83 2\r
  84 IF stpn > 1000 THEN stpn = 1\r
  85 IF st$(stpn) = "" THEN\r
  86   getflin = stpn\r
  87   stpn = stpn + 1\r
  88 ELSE\r
  89   stpn = stpn + 1\r
  90   GOTO 2\r
  91 END IF\r
  92 END FUNCTION\r
  93 \r
  94 FUNCTION getline$ (w, l)\r
  95 IF pag(w, l) = 0 THEN\r
  96   getline$ = ""\r
  97 ELSE\r
  98   getline$ = st$(pag(w, l))\r
  99 END IF\r
 100 END FUNCTION\r
 101 \r
 102 SUB loadfile (file$, d)\r
 103 \r
 104 OPEN file$ FOR INPUT AS #1\r
 105 FOR a = 1 TO 1000\r
 106   IF EOF(1) <> 0 THEN GOTO 3\r
 107   LINE INPUT #1, a$\r
 108   sendline d, a, a$\r
 109 NEXT a\r
 110 3\r
 111 CLOSE #1\r
 112 \r
 113 FOR b = a TO 1000\r
 114   sendline d, b, ""\r
 115 NEXT b\r
 116 END SUB\r
 117 \r
 118 SUB refresh\r
 119 CLS\r
 120 FOR a = 1 TO 10\r
 121 IF pagon(a) > 0 THEN shpage (a)\r
 122 NEXT a\r
 123 END SUB\r
 124 \r
 125 SUB sendline (w, l, newstring$) ' window, lineNum, lineItself\r
 126                         ' send string into window memory\r
 127 a$ = newstring$\r
 128 \r
 129 IF a$ = SPACE$(LEN(a$)) THEN a$ = ""\r
 130 \r
 131 IF LEN(a$) > 0 THEN\r
 132 5\r
 133   IF RIGHT$(a$, 1) = " " THEN\r
 134     a$ = LEFT$(a$, LEN(a$) - 1)\r
 135     GOTO 5\r
 136   END IF\r
 137 END IF\r
 138 \r
 139 IF a$ = "" THEN\r
 140   IF pag(w, l) > 0 THEN st$(pag(w, l)) = "": pag(w, l) = 0\r
 141 ELSE\r
 142   IF pag(w, l) = 0 THEN pag(w, l) = getflin\r
 143   st$(pag(w, l)) = a$\r
 144 END IF\r
 145 END SUB\r
 146 \r
 147 SUB shpage (page)\r
 148 IF page = pageactive THEN bg = 1 ELSE bg = 0\r
 149 \r
 150 x = pagx(page)\r
 151 y = pagy(page)\r
 152 xl = pagxs(page)\r
 153 yl = pagys(page)\r
 154 e$ = pagtitle$(page)\r
 155 \r
 156 COLOR 11, bg\r
 157 \r
 158 a$ = ""\r
 159 d$ = ""\r
 160 FOR a = 1 TO xl - 2\r
 161 a$ = a$ + CHR$(205)\r
 162 NEXT a\r
 163 b$ = CHR$(201) + a$ + CHR$(187)\r
 164 c$ = CHR$(200) + a$ + CHR$(188)\r
 165 \r
 166 LOCATE y, x\r
 167 PRINT b$\r
 168 LOCATE y + yl - 1, x\r
 169 PRINT c$\r
 170 \r
 171 FOR a = 1 TO yl - 2\r
 172   LOCATE y + a, x\r
 173   d$ = getline(page, a + pagshy(page))\r
 174   d$ = d$ + SPACE$(300)\r
 175   d$ = RIGHT$(d$, LEN(d$) - pagshx(page))\r
 176   d$ = LEFT$(d$, xl - 2)\r
 177   PRINT CHR$(186) + d$ + CHR$(186)\r
 178 NEXT a\r
 179 \r
 180 xt = INT(x + (xl / 2) - (LEN(e$) / 2) - 2)\r
 181 LOCATE y, xt\r
 182 PRINT "[ "\r
 183 xt = xt + 2\r
 184 \r
 185 COLOR 10\r
 186 LOCATE y, xt\r
 187 PRINT e$\r
 188 \r
 189 xt = xt + LEN(e$)\r
 190 COLOR 11\r
 191 LOCATE y, xt\r
 192 PRINT " ]"\r
 193 COLOR 7, 0\r
 194 END SUB\r
 195 \r
 196 SUB start\r
 197 WIDTH 80, 50\r
 198 VIEW PRINT 1 TO 50\r
 199 \r
 200 FOR a = 1 TO stamo\r
 201 st$(a) = ""\r
 202 NEXT a\r
 203 \r
 204 stpn = 1\r
 205 END SUB\r
 206 \r