--- /dev/null
+' Galaxy explorer\r
+' made by Svjatoslav Agejenko\r
+' in 2003.12\r
+' E-Mail: svjatoslav@svjatoslav.eu\r
+' H-Page: svjatoslav.eu\r
+ \r
+DECLARE SUB temp ()\r
+DECLARE SUB mkgalaxy (x!, y!, z!)\r
+DECLARE SUB rndinit ()\r
+DECLARE FUNCTION rn! ()\r
+DECLARE SUB disp ()\r
+DECLARE SUB startext ()\r
+DECLARE SUB control ()\r
+DECLARE SUB putbyte (addr!, dat!)\r
+DECLARE SUB putword (addr!, dat!)\r
+DECLARE FUNCTION getword! (addr!)\r
+DECLARE FUNCTION getbyte! (addr!)\r
+DECLARE SUB start ()\r
+DECLARE SUB animate ()\r
+\r
+\r
+DIM SHARED an1, an2, an3\r
+\r
+DIM SHARED tim\r
+\r
+DIM SHARED extSEG, extADDR\r
+\r
+DIM SHARED myx, myy, myz\r
+DIM SHARED myxs, myys, myzs\r
+DIM SHARED buttL, buttR\r
+DIM SHARED maxmove\r
+\r
+\r
+DIM SHARED zoom\r
+DIM SHARED rndval(0 TO 10000)\r
+DIM SHARED rndp\r
+\r
+\r
+DIM SHARED px(1 TO 12000)\r
+DIM SHARED py(1 TO 12000)\r
+DIM SHARED pz(1 TO 12000)\r
+DIM SHARED pc(1 TO 12000)\r
+DIM SHARED nump\r
+\r
+DIM SHARED tempr(0 TO 10)\r
+\r
+\r
+nl = 0\r
+np = 0\r
+\r
+start\r
+\r
+\r
+cx = 0\r
+cy = 0\r
+cz = 0\r
+\r
+\r
+\r
+nump = 0\r
+mkgalaxy 0, 0, 0\r
+1\r
+\r
+\r
+\r
+\r
+va = INT(RND * 3)\r
+\r
+SELECT CASE va\r
+CASE 0\r
+ cx = RND * 500 - 250\r
+CASE 1\r
+ cy = RND * 100 - 50\r
+CASE 2\r
+ cz = RND * 500 - 250\r
+END SELECT\r
+\r
+\r
+control\r
+disp\r
+\r
+PCOPY 0, 1\r
+CLS\r
+GOTO 1\r
+\r
+SUB control\r
+\r
+\r
+IF getbyte(8) <> 0 THEN\r
+ putbyte 8, 0\r
+ xp = getword(2)\r
+ putword 2, 0\r
+ yp = getword(4)\r
+ putword 4, 0\r
+ butt = getword(6)\r
+ putword 6, 0\r
+ buttL = 0\r
+ buttR = 0\r
+ IF butt = 1 THEN buttL = 1\r
+ IF butt = 2 THEN buttR = 1\r
+ IF butt = 3 THEN buttL = 1: buttR = 1\r
+\r
+\r
+ IF buttR = 1 THEN\r
+ IF buttL = 1 THEN\r
+ myxs = myxs + SIN(an1) * yp / 4\r
+ myzs = myzs - COS(an1) * yp / 4\r
+ GOTO 3\r
+ END IF\r
+ myys = myys + yp / 4\r
+3\r
+ yp = 0\r
+ END IF\r
+\r
+END IF\r
+\r
+\r
+\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+an1 = an1 - xp / 150\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+an2 = an2 - yp / 150\r
+\r
+\r
+\r
+a$ = INKEY$\r
+\r
+IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)\r
+IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)\r
+IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)\r
+IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)\r
+IF a$ = "q" THEN SYSTEM\r
+\r
+\r
+myxs = myxs / 1.1\r
+myys = myys / 1.1\r
+myzs = myzs / 1.1\r
+\r
+myx = myx + myxs\r
+myz = myz + myzs\r
+myy = myy + myys\r
+\r
+END SUB\r
+\r
+SUB disp\r
+\r
+s1 = SIN(an1)\r
+c1 = COS(an1)\r
+s2 = SIN(an2)\r
+c2 = COS(an2)\r
+\r
+\r
+FOR a = 1 TO nump\r
+\r
+ \r
+ x = px(a) - myx\r
+ y = py(a) - myy\r
+ z = pz(a) - myz\r
+ \r
+\r
+ x1 = x * c1 + z * s1\r
+ z1 = z * c1 - x * s1\r
+\r
+ y1 = y * c2 + z1 * s2\r
+ z2 = z1 * c2 - y * s2\r
+\r
+\r
+' z2 = z2 + 10\r
+ \r
+ IF z2 > 3 THEN\r
+ rpx = x1 / z2 * 130 + 160\r
+ rpy = y1 / z2 * 130 + 100\r
+ PSET (rpx, rpy), pc(a)\r
+ \r
+ END IF\r
+\r
+\r
+NEXT a\r
+END SUB\r
+\r
+FUNCTION getbyte (addr)\r
+getbyte = PEEK(extADDR + addr)\r
+END FUNCTION\r
+\r
+FUNCTION getword (addr)\r
+a = PEEK(extADDR + addr)\r
+b = PEEK(extADDR + addr + 1)\r
+\r
+\r
+c$ = HEX$(a)\r
+IF LEN(c$) = 1 THEN c$ = "0" + c$\r
+IF LEN(c$) = 0 THEN c$ = "00"\r
+\r
+\r
+c = VAL("&H" + HEX$(b) + c$)\r
+\r
+getword = c\r
+END FUNCTION\r
+\r
+SUB mkgalaxy (lx, ly, lz)\r
+\r
+\r
+n1 = rn * 10\r
+n2 = rn * 10\r
+\r
+gs1 = SIN(n1)\r
+gc1 = COS(n1)\r
+gs2 = SIN(n2)\r
+gc2 = COS(n2)\r
+\r
+\r
+\r
+rndp = 0\r
+siz = 100\r
+pi = 3.14\r
+sbm = 3\r
+\r
+\r
+FOR a = 1 TO 10000\r
+\r
+ b = rn * 10\r
+ s = b * b / 30\r
+\r
+ v1 = rn * (11.5 - b) / 3\r
+ v1p = v1 / 2\r
+\r
+ ane = rn * (s / 2) / sbm * 2\r
+ sba = 2 * pi / sbm * INT(rn * sbm)\r
+\r
+ x = (SIN(b - sba + ane) * s + rn * v1 - v1p) * siz\r
+ z = (COS(b - sba + ane) * s + rn * v1 - v1p) * siz\r
+ y = (rn * v1 - v1p) * siz\r
+\r
+\r
+ x1 = x * gc1 + z * gs1\r
+ z1 = z * gc1 - x * gs1\r
+\r
+ y1 = y * gc2 + z1 * gs2\r
+ z2 = z1 * gc2 - y * gs2\r
+\r
+\r
+ nump = nump + 1\r
+\r
+ px(nump) = x1 + lx\r
+ py(nump) = y1 + ly\r
+ pz(nump) = z2 + lz\r
+ pc(nump) = INT(RND * 15) + 1\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB mousedemo\r
+\r
+\r
+\r
+cx = 150\r
+cy = 100\r
+maxmove = 50\r
+100\r
+frm = frm + 1\r
+\r
+\r
+LOCATE 1, 1\r
+PRINT cx, cy\r
+PRINT frm\r
+\r
+CIRCLE (cx, cy), 10, 0\r
+xp = getword(2)\r
+putword 2, 0\r
+yp = getword(4)\r
+putword 4, 0\r
+\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+cx = cx + xp\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+cy = cy + yp\r
+\r
+\r
+CIRCLE (cx, cy), 10, 10\r
+\r
+\r
+\r
+SOUND 0, .05\r
+GOTO 100\r
+\r
+\r
+END SUB\r
+\r
+SUB putbyte (addr, dat)\r
+\r
+POKE (extADDR + addr), dat\r
+END SUB\r
+\r
+SUB putword (addr, dat)\r
+\r
+b$ = HEX$(dat)\r
+\r
+2\r
+IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
+\r
+n1 = VAL("&H" + LEFT$(b$, 2))\r
+n2 = VAL("&H" + RIGHT$(b$, 2))\r
+\r
+\r
+POKE (extADDR + addr), n2\r
+POKE (extADDR + addr + 1), n1\r
+\r
+END SUB\r
+\r
+FUNCTION rn\r
+\r
+rndp = rndp + 1\r
+IF rndp > 10000 THEN rndp = 0\r
+rn = rndval(rndp)\r
+\r
+END FUNCTION\r
+\r
+SUB rndinit\r
+\r
+\r
+FOR a = 0 TO 10000\r
+ rndval(a) = RND\r
+NEXT a\r
+\r
+rndp = 0\r
+END SUB\r
+\r
+SUB start\r
+\r
+\r
+startext\r
+\r
+\r
+SCREEN 7, , , 1\r
+\r
+maxmove = 50\r
+rndinit\r
+\r
+END SUB\r
+\r
+SUB startext\r
+\r
+DEF SEG = 0 ' read first from interrupt table\r
+\r
+extSEG = PEEK(&H79 * 4 + 3) * 256\r
+extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
+\r
+PRINT "Segment is: " + HEX$(extSEG)\r
+\r
+extADDR = PEEK(&H79 * 4 + 1) * 256\r
+extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
+\r
+PRINT "relative address is:"; extADDR\r
+\r
+DEF SEG = extSEG\r
+\r
+IF getword(0) <> 1983 THEN\r
+ PRINT "FATAL ERROR: you must load"\r
+ PRINT "QBasic extension TSR first!"\r
+ SYSTEM\r
+END IF\r
+\r
+END SUB\r
+\r
--- /dev/null
+qbext\r
+qb /run explgala.bas
\ No newline at end of file
--- /dev/null
+' 3D Maze explorer\r
+' made by Svjatoslav Agejenko\r
+' in 2003.12\r
+' H-Page: svjatoslav.eu\r
+' E-Mail: svjatoslav@svjatoslav.eu\r
+ \r
+DECLARE SUB startext ()\r
+DECLARE SUB control ()\r
+DECLARE SUB putbyte (addr!, dat!)\r
+DECLARE SUB putword (addr!, dat!)\r
+DECLARE FUNCTION getword! (addr!)\r
+DECLARE FUNCTION getbyte! (addr!)\r
+DECLARE SUB start ()\r
+DECLARE SUB animate ()\r
+\r
+DIM SHARED px(1 TO 5000)\r
+DIM SHARED py(1 TO 5000)\r
+DIM SHARED pz(1 TO 5000)\r
+DIM SHARED rpx(1 TO 5000)\r
+DIM SHARED rpy(1 TO 5000)\r
+DIM SHARED rpe(1 TO 5000)\r
+\r
+DIM SHARED l1(1 TO 5000)\r
+DIM SHARED l2(1 TO 5000)\r
+DIM SHARED lc(1 TO 5000)\r
+\r
+DIM SHARED nl, np\r
+\r
+DIM SHARED an1, an2, an3\r
+\r
+DIM SHARED tim\r
+\r
+DIM SHARED extSEG, extADDR\r
+\r
+DIM SHARED myx, myy, myz\r
+DIM SHARED myxs, myys, myzs\r
+DIM SHARED buttL, buttR\r
+DIM SHARED maxmove\r
+\r
+nl = 0\r
+np = 0\r
+\r
+start\r
+\r
+\r
+cx = 0\r
+cy = 0\r
+cz = 0\r
+\r
+np = 1\r
+px(1) = 0\r
+py(1) = 0\r
+pz(1) = 0\r
+\r
+1\r
+\r
+\r
+\r
+\r
+np = np + 1\r
+px(np) = cx\r
+py(np) = cy\r
+pz(np) = cz\r
+\r
+\r
+\r
+nl = nl + 1\r
+l1(nl) = np\r
+l2(nl) = np - 1\r
+lc(nl) = INT(RND * 15) + 1\r
+'lc(nl) = ABS(cx / 20)\r
+\r
+\r
+\r
+va = INT(RND * 3)\r
+\r
+SELECT CASE va\r
+CASE 0\r
+ cx = RND * 500 - 250\r
+CASE 1\r
+ cy = RND * 100 - 50\r
+CASE 2\r
+ cz = RND * 500 - 250\r
+END SELECT\r
+\r
+\r
+control\r
+animate\r
+\r
+PCOPY 0, 1\r
+CLS\r
+GOTO 1\r
+\r
+SUB animate\r
+\r
+\r
+s1 = SIN(an1)\r
+s2 = SIN(an2)\r
+s3 = SIN(an3)\r
+\r
+c1 = COS(an1)\r
+c2 = COS(an2)\r
+c3 = COS(an3)\r
+\r
+\r
+\r
+FOR a = 1 TO np\r
+ x = px(a) - myx\r
+ y = py(a) - myy\r
+ z = pz(a) - myz\r
+ \r
+ \r
+ x1 = x * c1 + z * s1\r
+ z1 = z * c1 - x * s1\r
+\r
+ y1 = y * c2 + z1 * s2\r
+ z2 = z1 * c2 - y * s2\r
+\r
+\r
+' z2 = z2 + 10\r
+ \r
+ IF z2 > 3 THEN\r
+ rpe(a) = 1\r
+ rpx(a) = x1 / z2 * 130 + 160\r
+ rpy(a) = y1 / z2 * 130 + 100\r
+ ELSE\r
+ rpe(a) = 0\r
+ END IF\r
+\r
+NEXT a\r
+\r
+\r
+FOR a = 1 TO nl\r
+\r
+ p1 = l1(a)\r
+ p2 = l2(a)\r
+ IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a)\r
+\r
+NEXT a\r
+\r
+\r
+END SUB\r
+\r
+SUB control\r
+\r
+\r
+IF getbyte(8) <> 0 THEN\r
+ putbyte 8, 0\r
+ xp = getword(2)\r
+ putword 2, 0\r
+ yp = getword(4)\r
+ putword 4, 0\r
+ butt = getword(6)\r
+ putword 6, 0\r
+ buttL = 0\r
+ buttR = 0\r
+ IF butt = 1 THEN buttL = 1\r
+ IF butt = 2 THEN buttR = 1\r
+ IF butt = 3 THEN buttL = 1: buttR = 1\r
+\r
+\r
+ IF buttR = 1 THEN\r
+ IF buttL = 1 THEN\r
+ myxs = myxs + SIN(an1) * yp / 4\r
+ myzs = myzs - COS(an1) * yp / 4\r
+ GOTO 3\r
+ END IF\r
+ myys = myys + yp / 4\r
+3\r
+ yp = 0\r
+ END IF\r
+\r
+END IF\r
+\r
+\r
+\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+an1 = an1 - xp / 150\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+an2 = an2 - yp / 150\r
+\r
+\r
+\r
+a$ = INKEY$\r
+\r
+IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)\r
+IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)\r
+IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)\r
+IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)\r
+IF a$ = "q" THEN SYSTEM\r
+\r
+myxs = myxs / 1.1\r
+myys = myys / 1.1\r
+myzs = myzs / 1.1\r
+\r
+myx = myx + myxs\r
+myz = myz + myzs\r
+myy = myy + myys\r
+\r
+END SUB\r
+\r
+FUNCTION getbyte (addr)\r
+getbyte = PEEK(extADDR + addr)\r
+END FUNCTION\r
+\r
+FUNCTION getword (addr)\r
+a = PEEK(extADDR + addr)\r
+b = PEEK(extADDR + addr + 1)\r
+\r
+\r
+c$ = HEX$(a)\r
+IF LEN(c$) = 1 THEN c$ = "0" + c$\r
+IF LEN(c$) = 0 THEN c$ = "00"\r
+\r
+\r
+c = VAL("&H" + HEX$(b) + c$)\r
+\r
+getword = c\r
+END FUNCTION\r
+\r
+SUB mousedemo\r
+\r
+\r
+\r
+cx = 150\r
+cy = 100\r
+maxmove = 50\r
+100\r
+frm = frm + 1\r
+\r
+\r
+LOCATE 1, 1\r
+PRINT cx, cy\r
+PRINT frm\r
+\r
+CIRCLE (cx, cy), 10, 0\r
+xp = getword(2)\r
+putword 2, 0\r
+yp = getword(4)\r
+putword 4, 0\r
+\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+cx = cx + xp\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+cy = cy + yp\r
+\r
+\r
+CIRCLE (cx, cy), 10, 10\r
+\r
+\r
+\r
+SOUND 0, .05\r
+GOTO 100\r
+\r
+\r
+END SUB\r
+\r
+SUB putbyte (addr, dat)\r
+\r
+POKE (extADDR + addr), dat\r
+END SUB\r
+\r
+SUB putword (addr, dat)\r
+\r
+b$ = HEX$(dat)\r
+\r
+2\r
+IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
+\r
+n1 = VAL("&H" + LEFT$(b$, 2))\r
+n2 = VAL("&H" + RIGHT$(b$, 2))\r
+\r
+\r
+POKE (extADDR + addr), n2\r
+POKE (extADDR + addr + 1), n1\r
+\r
+END SUB\r
+\r
+SUB start\r
+startext\r
+\r
+\r
+SCREEN 7, , , 1\r
+\r
+maxmove = 50\r
+\r
+END SUB\r
+\r
+SUB startext\r
+\r
+DEF SEG = 0 ' read first from interrupt table\r
+\r
+extSEG = PEEK(&H79 * 4 + 3) * 256\r
+extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
+\r
+PRINT "Segment is: " + HEX$(extSEG)\r
+\r
+extADDR = PEEK(&H79 * 4 + 1) * 256\r
+extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
+\r
+PRINT "relative address is:"; extADDR\r
+\r
+DEF SEG = extSEG\r
+\r
+IF getword(0) <> 1983 THEN\r
+ PRINT "FATAL ERROR: you must load"\r
+ PRINT "QBasic extension TSR first!"\r
+ SYSTEM\r
+END IF\r
+\r
+END SUB\r
+\r
--- /dev/null
+qbext\r
+qb /run explmaze.bas
\ No newline at end of file
--- /dev/null
+ 0 1397293 6565525 -1.795911E+07 .9747545 5.336815E-02 \r
#+OPTIONS: H:20 num:20
#+OPTIONS: author:nil
-* General
-- This software is part of [[../../../../index.html][QBasic apps package]].
-- These programs are free software: released under Creative Commons Zero
- (CC0) license.
-
-- Program author:
- - Svjatoslav Agejenko
- - Homepage: http://svjatoslav.eu
- - Email: mailto://svjatoslav@svjatoslav.eu
-
-- [[https://www.svjatoslav.eu/projects/][Other software projects hosted at svjatoslav.eu]]
-
-** Operating principle
+* Operating principle
Parses scene definition language and creates 3D world based on
it. Result will be in a [[https://en.wikipedia.org/wiki/Wavefront_.obj_file][wavefront obj file]], witch can be then
omong any axis. Generator has built in cache for data input and output
to minimize file access.
-* Installation
-+ Update include path inside *bin/3dparse.bas* file.
+*Examples:*
-** System requirements
+Download Blender files:
+| file | size |
+|------------------------+--------|
+| [[file:rectangular city.blend][rectangular city.blend]] | 3.6 MB |
+| [[file:hexagonal city.blend][hexagonal city.blend]] | 21 MB |
-| software | tested version |
-|----------+----------------|
-| DOS | 6.22 |
-| QBasic | 4.5 |
+They were produced by importing generated [[https://en.wikipedia.org/wiki/Wavefront_.obj_file][wavefront obj files]] into
+[[https://www.blender.org/][Blender]].
-** Directory layout
+** Rectangular city
+[[file:rectangular city, 1.jpeg]]
-+ bin ::
- + 3dparse.bas :: 3D generator main executable
- + city1.3d :: city with square-like buildings
- + city2.3d :: city with hexangular buildings
- + result.mtl :: shared material library
- + *.bat :: quick launch scripts
+[[file:rectangular city, 2.jpeg]]
-+ include :: 3D objects used to compose the scene
+[[file:rectangular city, 3.jpeg]]
+** Hexagonal city
+[[file:hexagonal city, 1.jpeg]]
+
+[[file:hexagonal city, 2.jpeg]]
+[[file:hexagonal city, 3.jpeg]]
* Scene description language
See also examples.
** here
: dum
dummy function, does notheing
+* Installation
+Edit *bin/3dparse.bas* file and update include path in there.
+
+** System requirements
+
+| software | tested version |
+|----------+----------------|
+| DOS | 6.22 |
+| QBasic | 4.5 |
+
+** Directory layout
+
++ bin ::
+ + 3dparse.bas :: 3D generator main executable
+ + city1.3d :: city with square-like buildings
+ + city2.3d :: city with hexangular buildings
+ + result.mtl :: shared material library
+ + *.bat :: quick launch scripts
+
++ include :: 3D objects used to compose the scene
+
* Usage
Make sure you have QB binaries in your PATH. Execute
to generate example cities. After parsing is finished, appropriate
*.obj files will appear in the bin directory holding generated scene.
Visualize scene with your favourite renderer.
-
-* Examples
-
-Download Blender files:
-| file | size |
-|------------------------+--------|
-| [[file:rectangular city.blend][rectangular city.blend]] | 3.6 MB |
-| [[file:hexagonal city.blend][hexagonal city.blend]] | 21 MB |
-
-They were produced by importing generated [[https://en.wikipedia.org/wiki/Wavefront_.obj_file][wavefront obj files]] into
-[[https://www.blender.org/][Blender]].
-
-** Rectangular city
-[[file:rectangular city, 1.jpeg]]
-
-[[file:rectangular city, 2.jpeg]]
-
-[[file:rectangular city, 3.jpeg]]
-** Hexagonal city
-[[file:hexagonal city, 1.jpeg]]
-
-[[file:hexagonal city, 2.jpeg]]
-
-[[file:hexagonal city, 3.jpeg]]
+++ /dev/null
-' Galaxy explorer\r
-' made by Svjatoslav Agejenko\r
-' in 2003.12\r
-' E-Mail: svjatoslav@svjatoslav.eu\r
-' H-Page: svjatoslav.eu\r
- \r
-DECLARE SUB temp ()\r
-DECLARE SUB mkgalaxy (x!, y!, z!)\r
-DECLARE SUB rndinit ()\r
-DECLARE FUNCTION rn! ()\r
-DECLARE SUB disp ()\r
-DECLARE SUB startext ()\r
-DECLARE SUB control ()\r
-DECLARE SUB putbyte (addr!, dat!)\r
-DECLARE SUB putword (addr!, dat!)\r
-DECLARE FUNCTION getword! (addr!)\r
-DECLARE FUNCTION getbyte! (addr!)\r
-DECLARE SUB start ()\r
-DECLARE SUB animate ()\r
-\r
-\r
-DIM SHARED an1, an2, an3\r
-\r
-DIM SHARED tim\r
-\r
-DIM SHARED extSEG, extADDR\r
-\r
-DIM SHARED myx, myy, myz\r
-DIM SHARED myxs, myys, myzs\r
-DIM SHARED buttL, buttR\r
-DIM SHARED maxmove\r
-\r
-\r
-DIM SHARED zoom\r
-DIM SHARED rndval(0 TO 10000)\r
-DIM SHARED rndp\r
-\r
-\r
-DIM SHARED px(1 TO 12000)\r
-DIM SHARED py(1 TO 12000)\r
-DIM SHARED pz(1 TO 12000)\r
-DIM SHARED pc(1 TO 12000)\r
-DIM SHARED nump\r
-\r
-DIM SHARED tempr(0 TO 10)\r
-\r
-\r
-nl = 0\r
-np = 0\r
-\r
-start\r
-\r
-\r
-cx = 0\r
-cy = 0\r
-cz = 0\r
-\r
-\r
-\r
-nump = 0\r
-mkgalaxy 0, 0, 0\r
-1\r
-\r
-\r
-\r
-\r
-va = INT(RND * 3)\r
-\r
-SELECT CASE va\r
-CASE 0\r
- cx = RND * 500 - 250\r
-CASE 1\r
- cy = RND * 100 - 50\r
-CASE 2\r
- cz = RND * 500 - 250\r
-END SELECT\r
-\r
-\r
-control\r
-disp\r
-\r
-PCOPY 0, 1\r
-CLS\r
-GOTO 1\r
-\r
-SUB control\r
-\r
-\r
-IF getbyte(8) <> 0 THEN\r
- putbyte 8, 0\r
- xp = getword(2)\r
- putword 2, 0\r
- yp = getword(4)\r
- putword 4, 0\r
- butt = getword(6)\r
- putword 6, 0\r
- buttL = 0\r
- buttR = 0\r
- IF butt = 1 THEN buttL = 1\r
- IF butt = 2 THEN buttR = 1\r
- IF butt = 3 THEN buttL = 1: buttR = 1\r
-\r
-\r
- IF buttR = 1 THEN\r
- IF buttL = 1 THEN\r
- myxs = myxs + SIN(an1) * yp / 4\r
- myzs = myzs - COS(an1) * yp / 4\r
- GOTO 3\r
- END IF\r
- myys = myys + yp / 4\r
-3\r
- yp = 0\r
- END IF\r
-\r
-END IF\r
-\r
-\r
-\r
-\r
-IF xp < -maxmove THEN xp = -maxmove\r
-IF xp > maxmove THEN xp = maxmove\r
-an1 = an1 - xp / 150\r
-\r
-IF yp < -maxmove THEN yp = -maxmove\r
-IF yp > maxmove THEN yp = maxmove\r
-an2 = an2 - yp / 150\r
-\r
-\r
-\r
-a$ = INKEY$\r
-\r
-IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)\r
-IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)\r
-IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)\r
-IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)\r
-IF a$ = "q" THEN SYSTEM\r
-\r
-\r
-myxs = myxs / 1.1\r
-myys = myys / 1.1\r
-myzs = myzs / 1.1\r
-\r
-myx = myx + myxs\r
-myz = myz + myzs\r
-myy = myy + myys\r
-\r
-END SUB\r
-\r
-SUB disp\r
-\r
-s1 = SIN(an1)\r
-c1 = COS(an1)\r
-s2 = SIN(an2)\r
-c2 = COS(an2)\r
-\r
-\r
-FOR a = 1 TO nump\r
-\r
- \r
- x = px(a) - myx\r
- y = py(a) - myy\r
- z = pz(a) - myz\r
- \r
-\r
- x1 = x * c1 + z * s1\r
- z1 = z * c1 - x * s1\r
-\r
- y1 = y * c2 + z1 * s2\r
- z2 = z1 * c2 - y * s2\r
-\r
-\r
-' z2 = z2 + 10\r
- \r
- IF z2 > 3 THEN\r
- rpx = x1 / z2 * 130 + 160\r
- rpy = y1 / z2 * 130 + 100\r
- PSET (rpx, rpy), pc(a)\r
- \r
- END IF\r
-\r
-\r
-NEXT a\r
-END SUB\r
-\r
-FUNCTION getbyte (addr)\r
-getbyte = PEEK(extADDR + addr)\r
-END FUNCTION\r
-\r
-FUNCTION getword (addr)\r
-a = PEEK(extADDR + addr)\r
-b = PEEK(extADDR + addr + 1)\r
-\r
-\r
-c$ = HEX$(a)\r
-IF LEN(c$) = 1 THEN c$ = "0" + c$\r
-IF LEN(c$) = 0 THEN c$ = "00"\r
-\r
-\r
-c = VAL("&H" + HEX$(b) + c$)\r
-\r
-getword = c\r
-END FUNCTION\r
-\r
-SUB mkgalaxy (lx, ly, lz)\r
-\r
-\r
-n1 = rn * 10\r
-n2 = rn * 10\r
-\r
-gs1 = SIN(n1)\r
-gc1 = COS(n1)\r
-gs2 = SIN(n2)\r
-gc2 = COS(n2)\r
-\r
-\r
-\r
-rndp = 0\r
-siz = 100\r
-pi = 3.14\r
-sbm = 3\r
-\r
-\r
-FOR a = 1 TO 10000\r
-\r
- b = rn * 10\r
- s = b * b / 30\r
-\r
- v1 = rn * (11.5 - b) / 3\r
- v1p = v1 / 2\r
-\r
- ane = rn * (s / 2) / sbm * 2\r
- sba = 2 * pi / sbm * INT(rn * sbm)\r
-\r
- x = (SIN(b - sba + ane) * s + rn * v1 - v1p) * siz\r
- z = (COS(b - sba + ane) * s + rn * v1 - v1p) * siz\r
- y = (rn * v1 - v1p) * siz\r
-\r
-\r
- x1 = x * gc1 + z * gs1\r
- z1 = z * gc1 - x * gs1\r
-\r
- y1 = y * gc2 + z1 * gs2\r
- z2 = z1 * gc2 - y * gs2\r
-\r
-\r
- nump = nump + 1\r
-\r
- px(nump) = x1 + lx\r
- py(nump) = y1 + ly\r
- pz(nump) = z2 + lz\r
- pc(nump) = INT(RND * 15) + 1\r
-NEXT a\r
-\r
-END SUB\r
-\r
-SUB mousedemo\r
-\r
-\r
-\r
-cx = 150\r
-cy = 100\r
-maxmove = 50\r
-100\r
-frm = frm + 1\r
-\r
-\r
-LOCATE 1, 1\r
-PRINT cx, cy\r
-PRINT frm\r
-\r
-CIRCLE (cx, cy), 10, 0\r
-xp = getword(2)\r
-putword 2, 0\r
-yp = getword(4)\r
-putword 4, 0\r
-\r
-\r
-IF xp < -maxmove THEN xp = -maxmove\r
-IF xp > maxmove THEN xp = maxmove\r
-cx = cx + xp\r
-\r
-IF yp < -maxmove THEN yp = -maxmove\r
-IF yp > maxmove THEN yp = maxmove\r
-cy = cy + yp\r
-\r
-\r
-CIRCLE (cx, cy), 10, 10\r
-\r
-\r
-\r
-SOUND 0, .05\r
-GOTO 100\r
-\r
-\r
-END SUB\r
-\r
-SUB putbyte (addr, dat)\r
-\r
-POKE (extADDR + addr), dat\r
-END SUB\r
-\r
-SUB putword (addr, dat)\r
-\r
-b$ = HEX$(dat)\r
-\r
-2\r
-IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
-\r
-n1 = VAL("&H" + LEFT$(b$, 2))\r
-n2 = VAL("&H" + RIGHT$(b$, 2))\r
-\r
-\r
-POKE (extADDR + addr), n2\r
-POKE (extADDR + addr + 1), n1\r
-\r
-END SUB\r
-\r
-FUNCTION rn\r
-\r
-rndp = rndp + 1\r
-IF rndp > 10000 THEN rndp = 0\r
-rn = rndval(rndp)\r
-\r
-END FUNCTION\r
-\r
-SUB rndinit\r
-\r
-\r
-FOR a = 0 TO 10000\r
- rndval(a) = RND\r
-NEXT a\r
-\r
-rndp = 0\r
-END SUB\r
-\r
-SUB start\r
-\r
-\r
-startext\r
-\r
-\r
-SCREEN 7, , , 1\r
-\r
-maxmove = 50\r
-rndinit\r
-\r
-END SUB\r
-\r
-SUB startext\r
-\r
-DEF SEG = 0 ' read first from interrupt table\r
-\r
-extSEG = PEEK(&H79 * 4 + 3) * 256\r
-extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
-\r
-PRINT "Segment is: " + HEX$(extSEG)\r
-\r
-extADDR = PEEK(&H79 * 4 + 1) * 256\r
-extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
-\r
-PRINT "relative address is:"; extADDR\r
-\r
-DEF SEG = extSEG\r
-\r
-IF getword(0) <> 1983 THEN\r
- PRINT "FATAL ERROR: you must load"\r
- PRINT "QBasic extension TSR first!"\r
- SYSTEM\r
-END IF\r
-\r
-END SUB\r
-\r
+++ /dev/null
-qbext\r
-qb /run explgala.bas
\ No newline at end of file
+++ /dev/null
-' 3D Maze explorer\r
-' made by Svjatoslav Agejenko\r
-' in 2003.12\r
-' H-Page: svjatoslav.eu\r
-' E-Mail: svjatoslav@svjatoslav.eu\r
- \r
-DECLARE SUB startext ()\r
-DECLARE SUB control ()\r
-DECLARE SUB putbyte (addr!, dat!)\r
-DECLARE SUB putword (addr!, dat!)\r
-DECLARE FUNCTION getword! (addr!)\r
-DECLARE FUNCTION getbyte! (addr!)\r
-DECLARE SUB start ()\r
-DECLARE SUB animate ()\r
-\r
-DIM SHARED px(1 TO 5000)\r
-DIM SHARED py(1 TO 5000)\r
-DIM SHARED pz(1 TO 5000)\r
-DIM SHARED rpx(1 TO 5000)\r
-DIM SHARED rpy(1 TO 5000)\r
-DIM SHARED rpe(1 TO 5000)\r
-\r
-DIM SHARED l1(1 TO 5000)\r
-DIM SHARED l2(1 TO 5000)\r
-DIM SHARED lc(1 TO 5000)\r
-\r
-DIM SHARED nl, np\r
-\r
-DIM SHARED an1, an2, an3\r
-\r
-DIM SHARED tim\r
-\r
-DIM SHARED extSEG, extADDR\r
-\r
-DIM SHARED myx, myy, myz\r
-DIM SHARED myxs, myys, myzs\r
-DIM SHARED buttL, buttR\r
-DIM SHARED maxmove\r
-\r
-nl = 0\r
-np = 0\r
-\r
-start\r
-\r
-\r
-cx = 0\r
-cy = 0\r
-cz = 0\r
-\r
-np = 1\r
-px(1) = 0\r
-py(1) = 0\r
-pz(1) = 0\r
-\r
-1\r
-\r
-\r
-\r
-\r
-np = np + 1\r
-px(np) = cx\r
-py(np) = cy\r
-pz(np) = cz\r
-\r
-\r
-\r
-nl = nl + 1\r
-l1(nl) = np\r
-l2(nl) = np - 1\r
-lc(nl) = INT(RND * 15) + 1\r
-'lc(nl) = ABS(cx / 20)\r
-\r
-\r
-\r
-va = INT(RND * 3)\r
-\r
-SELECT CASE va\r
-CASE 0\r
- cx = RND * 500 - 250\r
-CASE 1\r
- cy = RND * 100 - 50\r
-CASE 2\r
- cz = RND * 500 - 250\r
-END SELECT\r
-\r
-\r
-control\r
-animate\r
-\r
-PCOPY 0, 1\r
-CLS\r
-GOTO 1\r
-\r
-SUB animate\r
-\r
-\r
-s1 = SIN(an1)\r
-s2 = SIN(an2)\r
-s3 = SIN(an3)\r
-\r
-c1 = COS(an1)\r
-c2 = COS(an2)\r
-c3 = COS(an3)\r
-\r
-\r
-\r
-FOR a = 1 TO np\r
- x = px(a) - myx\r
- y = py(a) - myy\r
- z = pz(a) - myz\r
- \r
- \r
- x1 = x * c1 + z * s1\r
- z1 = z * c1 - x * s1\r
-\r
- y1 = y * c2 + z1 * s2\r
- z2 = z1 * c2 - y * s2\r
-\r
-\r
-' z2 = z2 + 10\r
- \r
- IF z2 > 3 THEN\r
- rpe(a) = 1\r
- rpx(a) = x1 / z2 * 130 + 160\r
- rpy(a) = y1 / z2 * 130 + 100\r
- ELSE\r
- rpe(a) = 0\r
- END IF\r
-\r
-NEXT a\r
-\r
-\r
-FOR a = 1 TO nl\r
-\r
- p1 = l1(a)\r
- p2 = l2(a)\r
- IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a)\r
-\r
-NEXT a\r
-\r
-\r
-END SUB\r
-\r
-SUB control\r
-\r
-\r
-IF getbyte(8) <> 0 THEN\r
- putbyte 8, 0\r
- xp = getword(2)\r
- putword 2, 0\r
- yp = getword(4)\r
- putword 4, 0\r
- butt = getword(6)\r
- putword 6, 0\r
- buttL = 0\r
- buttR = 0\r
- IF butt = 1 THEN buttL = 1\r
- IF butt = 2 THEN buttR = 1\r
- IF butt = 3 THEN buttL = 1: buttR = 1\r
-\r
-\r
- IF buttR = 1 THEN\r
- IF buttL = 1 THEN\r
- myxs = myxs + SIN(an1) * yp / 4\r
- myzs = myzs - COS(an1) * yp / 4\r
- GOTO 3\r
- END IF\r
- myys = myys + yp / 4\r
-3\r
- yp = 0\r
- END IF\r
-\r
-END IF\r
-\r
-\r
-\r
-\r
-IF xp < -maxmove THEN xp = -maxmove\r
-IF xp > maxmove THEN xp = maxmove\r
-an1 = an1 - xp / 150\r
-\r
-IF yp < -maxmove THEN yp = -maxmove\r
-IF yp > maxmove THEN yp = maxmove\r
-an2 = an2 - yp / 150\r
-\r
-\r
-\r
-a$ = INKEY$\r
-\r
-IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)\r
-IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)\r
-IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)\r
-IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)\r
-IF a$ = "q" THEN SYSTEM\r
-\r
-myxs = myxs / 1.1\r
-myys = myys / 1.1\r
-myzs = myzs / 1.1\r
-\r
-myx = myx + myxs\r
-myz = myz + myzs\r
-myy = myy + myys\r
-\r
-END SUB\r
-\r
-FUNCTION getbyte (addr)\r
-getbyte = PEEK(extADDR + addr)\r
-END FUNCTION\r
-\r
-FUNCTION getword (addr)\r
-a = PEEK(extADDR + addr)\r
-b = PEEK(extADDR + addr + 1)\r
-\r
-\r
-c$ = HEX$(a)\r
-IF LEN(c$) = 1 THEN c$ = "0" + c$\r
-IF LEN(c$) = 0 THEN c$ = "00"\r
-\r
-\r
-c = VAL("&H" + HEX$(b) + c$)\r
-\r
-getword = c\r
-END FUNCTION\r
-\r
-SUB mousedemo\r
-\r
-\r
-\r
-cx = 150\r
-cy = 100\r
-maxmove = 50\r
-100\r
-frm = frm + 1\r
-\r
-\r
-LOCATE 1, 1\r
-PRINT cx, cy\r
-PRINT frm\r
-\r
-CIRCLE (cx, cy), 10, 0\r
-xp = getword(2)\r
-putword 2, 0\r
-yp = getword(4)\r
-putword 4, 0\r
-\r
-\r
-IF xp < -maxmove THEN xp = -maxmove\r
-IF xp > maxmove THEN xp = maxmove\r
-cx = cx + xp\r
-\r
-IF yp < -maxmove THEN yp = -maxmove\r
-IF yp > maxmove THEN yp = maxmove\r
-cy = cy + yp\r
-\r
-\r
-CIRCLE (cx, cy), 10, 10\r
-\r
-\r
-\r
-SOUND 0, .05\r
-GOTO 100\r
-\r
-\r
-END SUB\r
-\r
-SUB putbyte (addr, dat)\r
-\r
-POKE (extADDR + addr), dat\r
-END SUB\r
-\r
-SUB putword (addr, dat)\r
-\r
-b$ = HEX$(dat)\r
-\r
-2\r
-IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
-\r
-n1 = VAL("&H" + LEFT$(b$, 2))\r
-n2 = VAL("&H" + RIGHT$(b$, 2))\r
-\r
-\r
-POKE (extADDR + addr), n2\r
-POKE (extADDR + addr + 1), n1\r
-\r
-END SUB\r
-\r
-SUB start\r
-startext\r
-\r
-\r
-SCREEN 7, , , 1\r
-\r
-maxmove = 50\r
-\r
-END SUB\r
-\r
-SUB startext\r
-\r
-DEF SEG = 0 ' read first from interrupt table\r
-\r
-extSEG = PEEK(&H79 * 4 + 3) * 256\r
-extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
-\r
-PRINT "Segment is: " + HEX$(extSEG)\r
-\r
-extADDR = PEEK(&H79 * 4 + 1) * 256\r
-extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
-\r
-PRINT "relative address is:"; extADDR\r
-\r
-DEF SEG = extSEG\r
-\r
-IF getword(0) <> 1983 THEN\r
- PRINT "FATAL ERROR: you must load"\r
- PRINT "QBasic extension TSR first!"\r
- SYSTEM\r
-END IF\r
-\r
-END SUB\r
-\r
+++ /dev/null
-qbext\r
-qb /run explmaze.bas
\ No newline at end of file
+++ /dev/null
- 0 1397293 6565525 -1.795911E+07 .9747545 5.336815E-02 \r
--- /dev/null
+DECLARE SUB playsound (a$)
+DECLARE SUB turnon ()
+DECLARE SUB ellips (x!, y!, s!, v!, t!)
+DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
+DECLARE SUB timerAdd (element!, time!, value!)
+DECLARE SUB timerdisp ()
+DECLARE SUB timerinit ()
+DECLARE SUB timerprocess ()
+DECLARE SUB mo (x!, y!, an!, s!, w!)
+DIM SHARED depth
+DIM SHARED pi
+
+DIM SHARED sh1, sh2, sv1, sv2, hp, vp
+DIM SHARED timerTime(0 TO 50, 0 TO 100)
+DIM SHARED timerValue(0 TO 50, 0 TO 100)
+
+DIM SHARED timerCplace(0 TO 50)
+DIM SHARED timerCtime(0 TO 50)
+DIM SHARED timerCvalue(0 TO 50)
+DIM SHARED timerLast
+
+
+pi = 3.14128
+
+turnon
+
+SCREEN 7, , , 1
+
+timerinit
+s = 50
+2
+s1 = SIN(timerCvalue(1) * 1.3) * .5 + 1.1
+s2 = COS(timerCvalue(1) * 1.3) * .5 + 1.1
+
+
+frm = frm + 1
+sv1 = 5 * s1
+sv2 = 2
+vp = SIN(timerCvalue(1) * 1.3)
+
+sh1 = 2 * s2
+sh2 = 1.4
+hp = SIN(timerCvalue(1)) * .7
+
+
+mo timerCvalue(2), timerCvalue(3), timerCvalue(4), timerCvalue(0), 0
+
+ellips 100, timerCvalue(6), timerCvalue(7) + 4, 14, .5
+ellips 100, timerCvalue(6), timerCvalue(7) + 2, 10, .5
+ellips 100, timerCvalue(6), timerCvalue(7), 0, .5
+prn timerCvalue(5), 10, "KHK", 7, 250
+
+prn timerCvalue(8), 130, "Infotehno-", 2, 0
+prn timerCvalue(8), 150, " loogia", 2, 0
+
+timerprocess
+LOCATE 1, 1
+'PRINT timerCtime(0)
+IF timerCtime(0) > 26 THEN CHAIN "ray.bas"
+PCOPY 0, 1
+LINE (0, 0)-(319, 199), 15, BF
+GOTO 2
+SYSTEM
+
+SUB ellips (x, y, s, v, t)
+
+IF x > 0 THEN
+IF y > 0 THEN
+
+CIRCLE (x, y), s, v, , , t
+PAINT (x, y), v
+
+END IF
+END IF
+
+END SUB
+
+SUB mo (x, y, an, s, w)
+depth = depth + 1
+IF s < .2 THEN GOTO 1
+
+IF depth / 2 = depth \ 2 THEN c = 1 ELSE c = 3
+
+CIRCLE (x, y), s, c
+PAINT (x, y), c
+
+IF w <> 1 THEN
+x1 = SIN(an) * s * 2.5 + x
+y1 = COS(an) * s * 2.5 + y
+IF w = 3 THEN ns = s / sv2 ELSE ns = s / sv1
+mo x1, y1, an + vp, ns, 3
+END IF
+
+IF w <> 2 THEN
+x1 = SIN(an - pi / 2) * s * 2.5 + x
+y1 = COS(an - pi / 2) * s * 2.5 + y
+IF w = 4 THEN ns = s / sh2 ELSE ns = s / sh1
+mo x1, y1, an + hp, ns, 4
+END IF
+
+IF w <> 3 THEN
+x1 = SIN(an - pi) * s * 2.5 + x
+y1 = COS(an - pi) * s * 2.5 + y
+IF w = 1 THEN ns = s / sv2 ELSE ns = s / sv1
+mo x1, y1, an + vp, ns, 1
+END IF
+
+IF w <> 4 THEN
+x1 = SIN(an - pi * 1.5) * s * 2.5 + x
+y1 = COS(an - pi * 1.5) * s * 2.5 + y
+IF w = 2 THEN ns = s / sh2 ELSE ns = s / sh1
+mo x1, y1, an + hp, ns, 2
+END IF
+
+1
+depth = depth - 1
+END SUB
+
+SUB playsound (a$)
+SHELL "c:\progra~1\winamp\winamp.exe " + a$
+SCREEN 0
+SCREEN 7, , , 1
+
+END SUB
+
+SUB prn (x, y, msg$, siz, col1)
+IF x < 0 THEN GOTO prn1
+IF x > 319 THEN GOTO prn1
+
+DIM bck(10000)
+
+GET (0, 0)-(100, 7), bck
+LOCATE 1, 1
+PRINT msg$
+
+col = col1
+
+FOR x1 = 0 TO LEN(msg$) * 8 - 1
+FOR y1 = 0 TO 7
+ IF POINT(x1, y1) > 0 THEN
+ rx = x1 * siz + x
+ ry = y1 * siz + y
+ IF col1 > 100 THEN col = RND * 4 + 10
+ IF col1 > 200 THEN
+ LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
+ ELSE
+ LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+ END IF
+' LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+ END IF
+NEXT y1
+NEXT x1
+
+
+PUT (0, 0), bck, PSET
+prn1:
+END SUB
+
+SUB timerAdd (element, time, value)
+
+FOR a = 0 TO 100
+ IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
+NEXT a
+timer3:
+
+timerTime(element, a) = time
+timerValue(element, a) = value
+
+END SUB
+
+SUB timerdisp
+LOCATE 1, 1
+
+FOR a = 0 TO 10
+ PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
+NEXT a
+
+END SUB
+
+SUB timerinit
+timerLast = TIMER
+
+paus = 24
+
+' stuff size
+timerAdd 0, 0, 50
+timerAdd 0, 7, 10
+timerAdd 0, 20, 10
+timerAdd 0, 24, 0
+timerAdd 0, 1000, 0
+
+
+' stuff speed
+timerAdd 1, 0, .1
+timerAdd 1, 1000, 1000
+
+' stuff X & Y
+timerAdd 2, 0, 160
+timerAdd 3, 0, 100
+
+timerAdd 2, 5, 160
+timerAdd 3, 5, 100
+
+timerAdd 2, 9, 280
+timerAdd 3, 9, 160
+
+timerAdd 2, 10, 280
+timerAdd 3, 10, 160
+
+timerAdd 2, 20, 40
+timerAdd 3, 20, 160
+
+timerAdd 2, 1000, 40
+timerAdd 3, 1000, 160
+
+' stuff rotations
+timerAdd 4, 0, .1
+timerAdd 4, 10, .1
+timerAdd 4, 22, 18
+timerAdd 4, 2000, 10000
+
+' KHK message X
+
+timerAdd 5, 0, -1
+timerAdd 5, 5, -1
+timerAdd 5, 9, 50
+timerAdd 5, 10, 30
+timerAdd 5, paus, 30
+timerAdd 5, paus + 2, 321
+
+' Ellips Y & radius
+timerAdd 6, 0, -1
+timerAdd 6, 4, -1
+timerAdd 6, 10, 30
+timerAdd 6, 1000, 50
+
+timerAdd 7, 0, 1
+timerAdd 7, 6, 1
+timerAdd 7, 12, 130
+
+timerAdd 7, paus, 130
+timerAdd 7, paus + 2, 1
+
+' "Infotehnoloogia" message
+
+timerAdd 8, 0, 320
+timerAdd 8, 11, 320
+timerAdd 8, 20, 100
+timerAdd 8, paus, 100
+timerAdd 8, paus + 1, -1
+
+
+END SUB
+
+SUB timerprocess
+
+timerCurrent = TIMER
+timerDiff = timerCurrent - timerLast
+timerLast = timerCurrent
+
+FOR a = 0 TO 50
+ ctim = timerCtime(a) + timerDiff
+ Cplace = timerCplace(a)
+timer2:
+ IF timerTime(a, Cplace + 1) = -1 THEN
+ ctim = 0
+ Cplace = 0
+ END IF
+ IF timerTime(a, Cplace + 1) < ctim THEN
+ IF timerTime(a, Cplace + 1) = 0 THEN
+ timerCvalue(a) = timerValue(a, Cplace)
+ GOTO timer1:
+ END IF
+ Cplace = Cplace + 1
+ GOTO timer2
+ END IF
+
+ v1 = timerValue(a, Cplace)
+ t1 = timerTime(a, Cplace)
+ v2 = timerValue(a, Cplace + 1)
+ t2 = timerTime(a, Cplace + 1)
+
+ IF v1 = v2 THEN
+ timerCvalue(a) = v1
+ ELSE
+ Tdiff1 = t2 - t1
+ Tdiff2 = ctim - t1
+ Vdiff = v2 - v1
+ timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
+ END IF
+timer1:
+ timerCplace(a) = Cplace
+ timerCtime(a) = ctim
+NEXT a
+
+END SUB
+
+SUB turnon
+a$ = INPUT$(1)
+playsound "marine.mp3"
+
+SCREEN 7, , , 1
+
+FOR x = 0 TO 160 STEP 15
+
+ LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 1, BF
+ LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 3, BF
+ LINE (160 - x, 90)-(160 + x, 110), 15, BF
+
+ PCOPY 0, 1
+ CLS
+ SOUND 0, .5
+NEXT x
+
+FOR y = 10 TO 100 STEP 15
+ CLS
+
+ LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 1, BF
+ LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, BF
+ LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, BF
+
+ PCOPY 0, 1
+ SOUND 0, .5
+NEXT y
+
+FOR a = 1 TO 25
+ prn RND * 250, RND * 180, STR$(INT(RND * 2)), 3, 0
+ PCOPY 0, 1
+ SOUND 0, 1
+NEXT a
+
+DIM buf(1 TO 1000)
+FOR b = 1 TO 30
+FOR a = 0 TO 195
+ t = ABS(100 - a)
+
+ IF RND * 50 < t THEN
+ GET (1, a)-(318, a + 1), buf
+ IF a > 100 THEN
+ PUT (0, a), buf, PSET
+ ELSE
+ PUT (2, a), buf, PSET
+ END IF
+ END IF
+NEXT a
+PCOPY 0, 1
+'SOUND 0, 1
+NEXT b
+
+
+END SUB
+
--- /dev/null
+DECLARE SUB playsound (a$)
+DECLARE SUB start ()
+DECLARE SUB turnoff ()
+DECLARE SUB dispimg (a$)
+DECLARE SUB turnon ()
+DECLARE SUB ellips (x!, y!, s!, v!, t!)
+DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
+DECLARE SUB timerAdd (element!, time!, value!)
+DECLARE SUB timerdisp ()
+DECLARE SUB timerinit ()
+DECLARE SUB timerprocess ()
+DECLARE SUB mo (x!, y!, an!, s!, w!)
+DIM SHARED depth
+DIM SHARED pi
+
+DIM SHARED sh1, sh2, sv1, sv2, hp, vp
+DIM SHARED timerTime(0 TO 50, 0 TO 100)
+DIM SHARED timerValue(0 TO 50, 0 TO 100)
+
+DIM SHARED timerCplace(0 TO 50)
+DIM SHARED timerCtime(0 TO 50)
+DIM SHARED timerCvalue(0 TO 50)
+DIM SHARED timerLast
+
+
+pi = 3.14128
+
+playsound "luule.mp3"
+SCREEN 13
+start
+
+timerinit
+2
+
+
+timerprocess
+IF timerCtime(0) > 0 THEN
+ IF im1 = 0 THEN
+ dispimg "pikk.i01"
+ im1 = 1
+ END IF
+END IF
+
+
+
+IF timerCtime(0) > 1.5 THEN
+ IF im2 = 0 THEN
+ dispimg "pikk4.i01"
+ im2 = 1
+ END IF
+END IF
+
+
+IF timerCtime(0) > 9 THEN
+ IF im3 = 0 THEN
+ dispimg "pikk3.i01"
+ im3 = 1
+ END IF
+END IF
+
+IF timerCtime(0) > 17 THEN
+ IF im4 = 0 THEN
+ dispimg "pikk2.i01"
+ im4 = 1
+ END IF
+END IF
+
+IF timerCtime(0) > 24 THEN
+ IF im5 = 0 THEN
+ dispimg "pikk1.i01"
+ im5 = 1
+ END IF
+END IF
+
+IF timerCtime(0) > 33 THEN
+ IF im6 = 0 THEN
+ dispimg "pikk5.i01"
+ im6 = 1
+ END IF
+END IF
+
+IF timerCtime(0) > 41 THEN
+ IF im7 = 0 THEN
+ dispimg "pikk.i01"
+ im7 = 1
+ END IF
+END IF
+
+
+IF timerCtime(0) > 43 THEN
+ turnoff
+END IF
+
+'LOCATE 1, 1
+'PRINT timerCtime(0)
+GOTO 2
+SYSTEM
+
+SUB dispimg (a$)
+
+
+OPEN a$ FOR INPUT AS #1
+INPUT #1, xs
+INPUT #1, ys
+
+FOR y = 1 TO ys
+FOR x = 1 TO xs
+INPUT #1, a
+PSET (x - 1, 200 - y), a
+NEXT x
+NEXT y
+
+
+CLOSE #1
+END SUB
+
+SUB ellips (x, y, s, v, t)
+
+IF x > 0 THEN
+IF y > 0 THEN
+
+CIRCLE (x, y), s, v, , , t
+PAINT (x, y), v
+
+END IF
+END IF
+
+END SUB
+
+SUB playsound (a$)
+
+SHELL "c:\progra~1\winamp\winamp.exe " + a$
+SCREEN 0
+SCREEN 7, , , 1
+
+END SUB
+
+SUB prn (x, y, msg$, siz, col1)
+IF x < 0 THEN GOTO prn1
+IF x > 319 THEN GOTO prn1
+
+DIM bck(10000)
+
+GET (0, 0)-(100, 7), bck
+LOCATE 1, 1
+PRINT msg$
+
+col = col1
+
+FOR x1 = 0 TO LEN(msg$) * 8 - 1
+FOR y1 = 0 TO 7
+ IF POINT(x1, y1) > 0 THEN
+ rx = x1 * siz + x
+ ry = y1 * siz + y
+ IF col1 > 100 THEN col = RND * 4 + 10
+ IF col1 > 200 THEN
+ LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
+ ELSE
+ LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+ END IF
+' LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
+ END IF
+NEXT y1
+NEXT x1
+
+
+PUT (0, 0), bck, PSET
+prn1:
+END SUB
+
+SUB start
+c = 0
+FOR r = 0 TO 5
+FOR g = 0 TO 5
+FOR B = 0 TO 5
+OUT &H3C8, c
+c = c + 1
+OUT &H3C9, r * 12
+OUT &H3C9, g * 12
+OUT &H3C9, B * 12
+NEXT B
+NEXT g
+NEXT r
+
+END SUB
+
+SUB timerAdd (element, time, value)
+
+FOR a = 0 TO 100
+ IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
+NEXT a
+timer3:
+
+timerTime(element, a) = time
+timerValue(element, a) = value
+
+END SUB
+
+SUB timerdisp
+LOCATE 1, 1
+
+FOR a = 0 TO 10
+ PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
+NEXT a
+
+END SUB
+
+SUB timerinit
+timerLast = TIMER
+
+paus = 24
+
+' stuff size
+timerAdd 0, 0, 0
+timerAdd 0, 1000, 1000
+
+END SUB
+
+SUB timerprocess
+
+timerCurrent = TIMER
+timerDiff = timerCurrent - timerLast
+timerLast = timerCurrent
+
+FOR a = 0 TO 50
+ ctim = timerCtime(a) + timerDiff
+ Cplace = timerCplace(a)
+timer2:
+ IF timerTime(a, Cplace + 1) = -1 THEN
+ ctim = 0
+ Cplace = 0
+ END IF
+ IF timerTime(a, Cplace + 1) < ctim THEN
+ IF timerTime(a, Cplace + 1) = 0 THEN
+ timerCvalue(a) = timerValue(a, Cplace)
+ GOTO timer1:
+ END IF
+ Cplace = Cplace + 1
+ GOTO timer2
+ END IF
+
+ v1 = timerValue(a, Cplace)
+ t1 = timerTime(a, Cplace)
+ v2 = timerValue(a, Cplace + 1)
+ t2 = timerTime(a, Cplace + 1)
+
+ IF v1 = v2 THEN
+ timerCvalue(a) = v1
+ ELSE
+ Tdiff1 = t2 - t1
+ Tdiff2 = ctim - t1
+ Vdiff = v2 - v1
+ timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
+ END IF
+timer1:
+ timerCplace(a) = Cplace
+ timerCtime(a) = ctim
+NEXT a
+
+END SUB
+
+SUB turnoff
+x = 160
+
+FOR y = 100 TO 1 STEP -1
+
+ LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 0, B
+ LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, B
+ LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, B
+
+ SOUND 0, .1
+NEXT y
+
+
+
+FOR x = 160 TO 0 STEP -1
+
+ LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 0, B
+ LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 1, B
+ LINE (160 - x, 90)-(160 + x, 110), 15, B
+ SOUND 0, .05
+NEXT x
+
+playsound "silent.mp3"
+SCREEN 10
+SCREEN 13
+CLS
+1
+a$ = INPUT$(1)
+GOTO 1
+
+
+END SUB
+
+++ /dev/null
-DECLARE SUB playsound (a$)
-DECLARE SUB turnon ()
-DECLARE SUB ellips (x!, y!, s!, v!, t!)
-DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
-DECLARE SUB timerAdd (element!, time!, value!)
-DECLARE SUB timerdisp ()
-DECLARE SUB timerinit ()
-DECLARE SUB timerprocess ()
-DECLARE SUB mo (x!, y!, an!, s!, w!)
-DIM SHARED depth
-DIM SHARED pi
-
-DIM SHARED sh1, sh2, sv1, sv2, hp, vp
-DIM SHARED timerTime(0 TO 50, 0 TO 100)
-DIM SHARED timerValue(0 TO 50, 0 TO 100)
-
-DIM SHARED timerCplace(0 TO 50)
-DIM SHARED timerCtime(0 TO 50)
-DIM SHARED timerCvalue(0 TO 50)
-DIM SHARED timerLast
-
-
-pi = 3.14128
-
-turnon
-
-SCREEN 7, , , 1
-
-timerinit
-s = 50
-2
-s1 = SIN(timerCvalue(1) * 1.3) * .5 + 1.1
-s2 = COS(timerCvalue(1) * 1.3) * .5 + 1.1
-
-
-frm = frm + 1
-sv1 = 5 * s1
-sv2 = 2
-vp = SIN(timerCvalue(1) * 1.3)
-
-sh1 = 2 * s2
-sh2 = 1.4
-hp = SIN(timerCvalue(1)) * .7
-
-
-mo timerCvalue(2), timerCvalue(3), timerCvalue(4), timerCvalue(0), 0
-
-ellips 100, timerCvalue(6), timerCvalue(7) + 4, 14, .5
-ellips 100, timerCvalue(6), timerCvalue(7) + 2, 10, .5
-ellips 100, timerCvalue(6), timerCvalue(7), 0, .5
-prn timerCvalue(5), 10, "KHK", 7, 250
-
-prn timerCvalue(8), 130, "Infotehno-", 2, 0
-prn timerCvalue(8), 150, " loogia", 2, 0
-
-timerprocess
-LOCATE 1, 1
-'PRINT timerCtime(0)
-IF timerCtime(0) > 26 THEN CHAIN "ray.bas"
-PCOPY 0, 1
-LINE (0, 0)-(319, 199), 15, BF
-GOTO 2
-SYSTEM
-
-SUB ellips (x, y, s, v, t)
-
-IF x > 0 THEN
-IF y > 0 THEN
-
-CIRCLE (x, y), s, v, , , t
-PAINT (x, y), v
-
-END IF
-END IF
-
-END SUB
-
-SUB mo (x, y, an, s, w)
-depth = depth + 1
-IF s < .2 THEN GOTO 1
-
-IF depth / 2 = depth \ 2 THEN c = 1 ELSE c = 3
-
-CIRCLE (x, y), s, c
-PAINT (x, y), c
-
-IF w <> 1 THEN
-x1 = SIN(an) * s * 2.5 + x
-y1 = COS(an) * s * 2.5 + y
-IF w = 3 THEN ns = s / sv2 ELSE ns = s / sv1
-mo x1, y1, an + vp, ns, 3
-END IF
-
-IF w <> 2 THEN
-x1 = SIN(an - pi / 2) * s * 2.5 + x
-y1 = COS(an - pi / 2) * s * 2.5 + y
-IF w = 4 THEN ns = s / sh2 ELSE ns = s / sh1
-mo x1, y1, an + hp, ns, 4
-END IF
-
-IF w <> 3 THEN
-x1 = SIN(an - pi) * s * 2.5 + x
-y1 = COS(an - pi) * s * 2.5 + y
-IF w = 1 THEN ns = s / sv2 ELSE ns = s / sv1
-mo x1, y1, an + vp, ns, 1
-END IF
-
-IF w <> 4 THEN
-x1 = SIN(an - pi * 1.5) * s * 2.5 + x
-y1 = COS(an - pi * 1.5) * s * 2.5 + y
-IF w = 2 THEN ns = s / sh2 ELSE ns = s / sh1
-mo x1, y1, an + hp, ns, 2
-END IF
-
-1
-depth = depth - 1
-END SUB
-
-SUB playsound (a$)
-SHELL "c:\progra~1\winamp\winamp.exe " + a$
-SCREEN 0
-SCREEN 7, , , 1
-
-END SUB
-
-SUB prn (x, y, msg$, siz, col1)
-IF x < 0 THEN GOTO prn1
-IF x > 319 THEN GOTO prn1
-
-DIM bck(10000)
-
-GET (0, 0)-(100, 7), bck
-LOCATE 1, 1
-PRINT msg$
-
-col = col1
-
-FOR x1 = 0 TO LEN(msg$) * 8 - 1
-FOR y1 = 0 TO 7
- IF POINT(x1, y1) > 0 THEN
- rx = x1 * siz + x
- ry = y1 * siz + y
- IF col1 > 100 THEN col = RND * 4 + 10
- IF col1 > 200 THEN
- LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
- ELSE
- LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
- END IF
-' LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
- END IF
-NEXT y1
-NEXT x1
-
-
-PUT (0, 0), bck, PSET
-prn1:
-END SUB
-
-SUB timerAdd (element, time, value)
-
-FOR a = 0 TO 100
- IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
-NEXT a
-timer3:
-
-timerTime(element, a) = time
-timerValue(element, a) = value
-
-END SUB
-
-SUB timerdisp
-LOCATE 1, 1
-
-FOR a = 0 TO 10
- PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
-NEXT a
-
-END SUB
-
-SUB timerinit
-timerLast = TIMER
-
-paus = 24
-
-' stuff size
-timerAdd 0, 0, 50
-timerAdd 0, 7, 10
-timerAdd 0, 20, 10
-timerAdd 0, 24, 0
-timerAdd 0, 1000, 0
-
-
-' stuff speed
-timerAdd 1, 0, .1
-timerAdd 1, 1000, 1000
-
-' stuff X & Y
-timerAdd 2, 0, 160
-timerAdd 3, 0, 100
-
-timerAdd 2, 5, 160
-timerAdd 3, 5, 100
-
-timerAdd 2, 9, 280
-timerAdd 3, 9, 160
-
-timerAdd 2, 10, 280
-timerAdd 3, 10, 160
-
-timerAdd 2, 20, 40
-timerAdd 3, 20, 160
-
-timerAdd 2, 1000, 40
-timerAdd 3, 1000, 160
-
-' stuff rotations
-timerAdd 4, 0, .1
-timerAdd 4, 10, .1
-timerAdd 4, 22, 18
-timerAdd 4, 2000, 10000
-
-' KHK message X
-
-timerAdd 5, 0, -1
-timerAdd 5, 5, -1
-timerAdd 5, 9, 50
-timerAdd 5, 10, 30
-timerAdd 5, paus, 30
-timerAdd 5, paus + 2, 321
-
-' Ellips Y & radius
-timerAdd 6, 0, -1
-timerAdd 6, 4, -1
-timerAdd 6, 10, 30
-timerAdd 6, 1000, 50
-
-timerAdd 7, 0, 1
-timerAdd 7, 6, 1
-timerAdd 7, 12, 130
-
-timerAdd 7, paus, 130
-timerAdd 7, paus + 2, 1
-
-' "Infotehnoloogia" message
-
-timerAdd 8, 0, 320
-timerAdd 8, 11, 320
-timerAdd 8, 20, 100
-timerAdd 8, paus, 100
-timerAdd 8, paus + 1, -1
-
-
-END SUB
-
-SUB timerprocess
-
-timerCurrent = TIMER
-timerDiff = timerCurrent - timerLast
-timerLast = timerCurrent
-
-FOR a = 0 TO 50
- ctim = timerCtime(a) + timerDiff
- Cplace = timerCplace(a)
-timer2:
- IF timerTime(a, Cplace + 1) = -1 THEN
- ctim = 0
- Cplace = 0
- END IF
- IF timerTime(a, Cplace + 1) < ctim THEN
- IF timerTime(a, Cplace + 1) = 0 THEN
- timerCvalue(a) = timerValue(a, Cplace)
- GOTO timer1:
- END IF
- Cplace = Cplace + 1
- GOTO timer2
- END IF
-
- v1 = timerValue(a, Cplace)
- t1 = timerTime(a, Cplace)
- v2 = timerValue(a, Cplace + 1)
- t2 = timerTime(a, Cplace + 1)
-
- IF v1 = v2 THEN
- timerCvalue(a) = v1
- ELSE
- Tdiff1 = t2 - t1
- Tdiff2 = ctim - t1
- Vdiff = v2 - v1
- timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
- END IF
-timer1:
- timerCplace(a) = Cplace
- timerCtime(a) = ctim
-NEXT a
-
-END SUB
-
-SUB turnon
-a$ = INPUT$(1)
-playsound "marine.mp3"
-
-SCREEN 7, , , 1
-
-FOR x = 0 TO 160 STEP 15
-
- LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 1, BF
- LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 3, BF
- LINE (160 - x, 90)-(160 + x, 110), 15, BF
-
- PCOPY 0, 1
- CLS
- SOUND 0, .5
-NEXT x
-
-FOR y = 10 TO 100 STEP 15
- CLS
-
- LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 1, BF
- LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, BF
- LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, BF
-
- PCOPY 0, 1
- SOUND 0, .5
-NEXT y
-
-FOR a = 1 TO 25
- prn RND * 250, RND * 180, STR$(INT(RND * 2)), 3, 0
- PCOPY 0, 1
- SOUND 0, 1
-NEXT a
-
-DIM buf(1 TO 1000)
-FOR b = 1 TO 30
-FOR a = 0 TO 195
- t = ABS(100 - a)
-
- IF RND * 50 < t THEN
- GET (1, a)-(318, a + 1), buf
- IF a > 100 THEN
- PUT (0, a), buf, PSET
- ELSE
- PUT (2, a), buf, PSET
- END IF
- END IF
-NEXT a
-PCOPY 0, 1
-'SOUND 0, 1
-NEXT b
-
-
-END SUB
-
+++ /dev/null
-DECLARE SUB playsound (a$)
-DECLARE SUB start ()
-DECLARE SUB turnoff ()
-DECLARE SUB dispimg (a$)
-DECLARE SUB turnon ()
-DECLARE SUB ellips (x!, y!, s!, v!, t!)
-DECLARE SUB prn (x!, y!, msg$, siz!, col1!)
-DECLARE SUB timerAdd (element!, time!, value!)
-DECLARE SUB timerdisp ()
-DECLARE SUB timerinit ()
-DECLARE SUB timerprocess ()
-DECLARE SUB mo (x!, y!, an!, s!, w!)
-DIM SHARED depth
-DIM SHARED pi
-
-DIM SHARED sh1, sh2, sv1, sv2, hp, vp
-DIM SHARED timerTime(0 TO 50, 0 TO 100)
-DIM SHARED timerValue(0 TO 50, 0 TO 100)
-
-DIM SHARED timerCplace(0 TO 50)
-DIM SHARED timerCtime(0 TO 50)
-DIM SHARED timerCvalue(0 TO 50)
-DIM SHARED timerLast
-
-
-pi = 3.14128
-
-playsound "luule.mp3"
-SCREEN 13
-start
-
-timerinit
-2
-
-
-timerprocess
-IF timerCtime(0) > 0 THEN
- IF im1 = 0 THEN
- dispimg "pikk.i01"
- im1 = 1
- END IF
-END IF
-
-
-
-IF timerCtime(0) > 1.5 THEN
- IF im2 = 0 THEN
- dispimg "pikk4.i01"
- im2 = 1
- END IF
-END IF
-
-
-IF timerCtime(0) > 9 THEN
- IF im3 = 0 THEN
- dispimg "pikk3.i01"
- im3 = 1
- END IF
-END IF
-
-IF timerCtime(0) > 17 THEN
- IF im4 = 0 THEN
- dispimg "pikk2.i01"
- im4 = 1
- END IF
-END IF
-
-IF timerCtime(0) > 24 THEN
- IF im5 = 0 THEN
- dispimg "pikk1.i01"
- im5 = 1
- END IF
-END IF
-
-IF timerCtime(0) > 33 THEN
- IF im6 = 0 THEN
- dispimg "pikk5.i01"
- im6 = 1
- END IF
-END IF
-
-IF timerCtime(0) > 41 THEN
- IF im7 = 0 THEN
- dispimg "pikk.i01"
- im7 = 1
- END IF
-END IF
-
-
-IF timerCtime(0) > 43 THEN
- turnoff
-END IF
-
-'LOCATE 1, 1
-'PRINT timerCtime(0)
-GOTO 2
-SYSTEM
-
-SUB dispimg (a$)
-
-
-OPEN a$ FOR INPUT AS #1
-INPUT #1, xs
-INPUT #1, ys
-
-FOR y = 1 TO ys
-FOR x = 1 TO xs
-INPUT #1, a
-PSET (x - 1, 200 - y), a
-NEXT x
-NEXT y
-
-
-CLOSE #1
-END SUB
-
-SUB ellips (x, y, s, v, t)
-
-IF x > 0 THEN
-IF y > 0 THEN
-
-CIRCLE (x, y), s, v, , , t
-PAINT (x, y), v
-
-END IF
-END IF
-
-END SUB
-
-SUB playsound (a$)
-
-SHELL "c:\progra~1\winamp\winamp.exe " + a$
-SCREEN 0
-SCREEN 7, , , 1
-
-END SUB
-
-SUB prn (x, y, msg$, siz, col1)
-IF x < 0 THEN GOTO prn1
-IF x > 319 THEN GOTO prn1
-
-DIM bck(10000)
-
-GET (0, 0)-(100, 7), bck
-LOCATE 1, 1
-PRINT msg$
-
-col = col1
-
-FOR x1 = 0 TO LEN(msg$) * 8 - 1
-FOR y1 = 0 TO 7
- IF POINT(x1, y1) > 0 THEN
- rx = x1 * siz + x
- ry = y1 * siz + y
- IF col1 > 100 THEN col = RND * 4 + 10
- IF col1 > 200 THEN
- LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, B
- ELSE
- LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
- END IF
-' LINE (rx, ry)-(rx + siz - 1, ry + siz - 1), col, BF
- END IF
-NEXT y1
-NEXT x1
-
-
-PUT (0, 0), bck, PSET
-prn1:
-END SUB
-
-SUB start
-c = 0
-FOR r = 0 TO 5
-FOR g = 0 TO 5
-FOR B = 0 TO 5
-OUT &H3C8, c
-c = c + 1
-OUT &H3C9, r * 12
-OUT &H3C9, g * 12
-OUT &H3C9, B * 12
-NEXT B
-NEXT g
-NEXT r
-
-END SUB
-
-SUB timerAdd (element, time, value)
-
-FOR a = 0 TO 100
- IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
-NEXT a
-timer3:
-
-timerTime(element, a) = time
-timerValue(element, a) = value
-
-END SUB
-
-SUB timerdisp
-LOCATE 1, 1
-
-FOR a = 0 TO 10
- PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
-NEXT a
-
-END SUB
-
-SUB timerinit
-timerLast = TIMER
-
-paus = 24
-
-' stuff size
-timerAdd 0, 0, 0
-timerAdd 0, 1000, 1000
-
-END SUB
-
-SUB timerprocess
-
-timerCurrent = TIMER
-timerDiff = timerCurrent - timerLast
-timerLast = timerCurrent
-
-FOR a = 0 TO 50
- ctim = timerCtime(a) + timerDiff
- Cplace = timerCplace(a)
-timer2:
- IF timerTime(a, Cplace + 1) = -1 THEN
- ctim = 0
- Cplace = 0
- END IF
- IF timerTime(a, Cplace + 1) < ctim THEN
- IF timerTime(a, Cplace + 1) = 0 THEN
- timerCvalue(a) = timerValue(a, Cplace)
- GOTO timer1:
- END IF
- Cplace = Cplace + 1
- GOTO timer2
- END IF
-
- v1 = timerValue(a, Cplace)
- t1 = timerTime(a, Cplace)
- v2 = timerValue(a, Cplace + 1)
- t2 = timerTime(a, Cplace + 1)
-
- IF v1 = v2 THEN
- timerCvalue(a) = v1
- ELSE
- Tdiff1 = t2 - t1
- Tdiff2 = ctim - t1
- Vdiff = v2 - v1
- timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
- END IF
-timer1:
- timerCplace(a) = Cplace
- timerCtime(a) = ctim
-NEXT a
-
-END SUB
-
-SUB turnoff
-x = 160
-
-FOR y = 100 TO 1 STEP -1
-
- LINE (160 - x - 5, 90 - y - 5)-(160 + x + 5, 110 + y + 5), 0, B
- LINE (160 - x - 3, 90 - y - 3)-(160 + x + 3, 110 + y + 3), 3, B
- LINE (160 - x, 90 - y)-(160 + x, 110 + y), 15, B
-
- SOUND 0, .1
-NEXT y
-
-
-
-FOR x = 160 TO 0 STEP -1
-
- LINE (160 - x - 5, 90 - 5)-(160 + x + 5, 110 + 5), 0, B
- LINE (160 - x - 3, 90 - 3)-(160 + x + 3, 110 + 3), 1, B
- LINE (160 - x, 90)-(160 + x, 110), 15, B
- SOUND 0, .05
-NEXT x
-
-playsound "silent.mp3"
-SCREEN 10
-SCREEN 13
-CLS
-1
-a$ = INPUT$(1)
-GOTO 1
-
-
-END SUB
-
+++ /dev/null
-DECLARE SUB dispimg ()
-DECLARE SUB updateland ()
-DECLARE SUB makeland ()
-DECLARE FUNCTION getcol! (r!, g!, b!)
-DEFINT A-Y
-DECLARE SUB traceline (x%, y%, xl)
-DECLARE SUB dispframe ()
-DECLARE SUB tower (x%, y%)
-DECLARE SUB square (x1%, y1%, x2%, y2%, c%, h%)
-DECLARE SUB displand ()
-DECLARE SUB start ()
-DECLARE SUB setupal ()
-
-DIM SHARED landh(0 TO 180, 0 TO 180)
-DIM SHARED landc(0 TO 180, 0 TO 180)
-
-DIM SHARED zmyx, zmyy, zmyz
-DIM SHARED myx, myy, myz
-DIM SHARED zmyan, myan2
-DIM SHARED ste, stem, dist
-DIM SHARED tim$, frm, frmrate
-DIM SHARED pi
-DIM SHARED white
-
-sky = getcol(100, 100, 255)
-pi = 3.141592
-
-frmrate = 10 ' Desired framerate.
- ' Lower framerate, better quality
-
-start
-makeland
-
-'displand
-'a$ = INPUT$(1)
-myan2 = 2
-OPEN "cat.i01" FOR INPUT AS #1
-INPUT #1, pictxw
-INPUT #1, pictyw
-INPUT #1, pictx
-INPUT #1, picty
-
-
-1
-x1 = RND * 160
-y1 = RND * 160
-x2 = x1 + RND * 10 + 1
-y2 = y1 + RND * 10 + 1
-
-IF (frm > 50) AND (frm < 250) THEN square x1, y1, x2, y2, RND * 200, RND * 10
-IF (frm > 250) AND (picty < 177) THEN
-
- FOR ff = 1 TO 180 * 2
- INPUT #1, c
- landc(pictx, picty) = c
- landh(pictx, picty) = 0
- pictx = pictx + 1
- IF pictx >= pictxw THEN pictx = 0: picty = picty + 1
- IF picty >= pictyw THEN picty = 0
- NEXT ff
-END IF
-
-IF frm = 430 THEN dispimg
-LOCATE 1, 30
-'PRINT frm
-
-updateland
-dispframe
-GOTO 1
-CLOSE #1
-
-SUB dispframe
-
-l = 0
-zst = -.0031 * ste
-FOR z = .5 TO -.5 STEP zst
-traceline SIN(zmyan + z) * dist + myx, COS(zmyan + z) * dist + myy, l
-l = l + ste
-NEXT z
-
-END SUB
-
-SUB dispimg
-
-CLOSE #1
-
-
-OPEN "cat.i01" FOR INPUT AS #1
-INPUT #1, pictxw
-INPUT #1, pictyw
-
-FOR y = 0 TO pictyw - 1
-FOR x = 0 TO pictxw - 1
-INPUT #1, c
-PSET (x + 50, 150 - y), c
-NEXT x
-NEXT y
-
-CLOSE #1
-
-
-FOR a = 1 TO 50
- SOUND 0, 1
-NEXT a
-CHAIN "KHKDEMO2.BAS"
-
-END SUB
-
-SUB displand
-
-
-FOR z = 0 TO 180
-zs = 1
-IF z > 120 THEN zs = .7
-IF z > 160 THEN zs = .6
-FOR zx = 0 TO 180 STEP zs
-y1 = landh(zx, z) - 80
-zx1 = zx - 90
-z1 = 300 - z
-zx2 = zx1 / z1 * 190
-zy2 = y1 / z1 * 190
-
-LINE (zx2 + 160, 40 - zy2)-(zx2 + 160, 200), landc(zx, z)
-NEXT zx
-NEXT z
-
-LOCATE 1, 1
-PRINT "Press any key to continue..."
-
-END SUB
-
-DEFSNG A-Y
-FUNCTION getcol (r, g, b)
-IF r < 0 THEN r = 0
-IF g < 0 THEN g = 0
-IF b < 0 THEN b = 0
-IF r > 255 THEN r = 255
-IF g > 255 THEN g = 255
-IF b > 255 THEN b = 255
-getcol = INT(r / 43) * 36 + INT(g / 43) * 6 + INT(b / 43)
-END FUNCTION
-
-DEFINT A-Y
-SUB makeland
-
-square 0, 0, 180, 180, 15, 0
-
-FOR y = 0 TO 180
-FOR x = 0 TO 180
-x1 = (x \ 10) MOD 2
-y1 = (y \ 10) MOD 2
-c = (x1 + y1) MOD 2
-IF c = 0 THEN
- landc(x, y) = getcol(250, 250, 250)
-ELSE
- landc(x, y) = getcol(250, 50, 50)
-END IF
-NEXT x
-NEXT y
-
-FOR y = 10 TO 90
-FOR x = 90 TO 170
-v = SQR((ABS(50 - y)) ^ 2 + (ABS(130 - x)) ^ 2)
-h = SQR((60 - v) * (60 + v)) - 35
-IF h > 0 THEN landh(x, y) = h
-NEXT x
-NEXT y
-
-tower 20, 20
-tower 60, 20
-tower 40, 150
-
-
-FOR za = 0 TO 20 STEP .1
-x = SIN(za) * (1 + (za * 2)) + 100
-y = COS(za) * (1 + (za * 2)) + 100
-landc(x, y) = getcol(20, RND * 200, 20)
-landc(x + 1, y) = getcol(20, RND * 200, 20)
-landc(x, y + 1) = getcol(20, RND * 200, 20)
-landc(x + 1, y + 1) = getcol(20, RND * 200, 20)
-NEXT za
-
-END SUB
-
-SUB setupal
-c = 0
-FOR r = 0 TO 5
-FOR g = 0 TO 5
-FOR b = 0 TO 5
-OUT &H3C8, c
-c = c + 1
-OUT &H3C9, r * 12
-OUT &H3C9, g * 12
-OUT &H3C9, b * 12
-NEXT b
-NEXT g
-NEXT r
-END SUB
-
-SUB square (x1, y1, x2, y2, c, h)
-
-FOR y = y1 TO y2
-FOR x = x1 TO x2
-landh(x, y) = h
-landc(x, y) = c
-NEXT x
-NEXT y
-
-END SUB
-
-SUB start
-SCREEN 13
-'PRINT "please wait..."
-
-setupal
-
-zmyan = 4.14
-myan2 = 100
-ste = 1
-stem = ste - 1
-dist = 190
-tim$ = TIME$
-zmyx = 170
-zmyy = 170
-zmyz = 20
-
-END SUB
-
-SUB tower (x, y)
-
-FOR a = 10 TO 0 STEP -1
-square x - a, y - a, x + a, y + a, getcol(100, 0, a * 20), 20 - a
-NEXT a
-
-square x - 11, y - 11, x - 9, y - 9, getcol(255, 0, 0), 20
-square x + 9, y - 11, x + 11, y - 9, getcol(0, 255, 0), 20
-square x - 11, y + 9, x - 9, y + 11, getcol(0, 0, 255), 20
-square x + 9, y + 9, x + 11, y + 11, getcol(255, 255, 0), 20
-
-
-END SUB
-
-SUB traceline (x, y, xl)
-
-IF x < 0 THEN
-zpr = myx / (myx - x)
-x = 0
-y = myy - ((myy - y) * zpr)
-END IF
-
-IF y < 0 THEN
-zpr = myy / (myy - y)
-y = 0
-x = myx - ((myx - x) * zpr)
-END IF
-
-IF x > 180 THEN
-zpr = (180 - myx) / (x - myx)
-x = 180
-y = myy - ((myy - y) * zpr)
-END IF
-
-IF y > 180 THEN
-zpr = (180 - myy) / (y - myy)
-y = 180
-x = myx - ((myx - x) * zpr)
-END IF
-
-lp = SQR(ABS(myx - x) ^ 2 + ABS(myy - y) ^ 2)
-
-xp = x - myx
-yp = y - myy
-
-yo = 200
-
-FOR a = 1 TO lp
- cx = xp * a / lp + myx
- cy = yp * a / lp + myy
- yn = myan2 - ((landh(cx, cy) - myz) * 300) / a
- IF yn < yo THEN LINE (xl, yn)-(xl + stem, yo - 1), landc(cx, cy), BF: yo = yn
-NEXT a
-LINE (xl, yo - 1)-(xl + stem, 0), sky, BF
-
-END SUB
-
-SUB updateland
-
-frm = frm + 1
-ste = 4
-stem = ste - 1
-
-
-zmyan = frm / 15 + pi
-'myan2 = myan2 + 5
-'zmyx = SIN(zmyan) * 3 + zmyx
-'zmyy = COS(zmyan) * 3 + zmyy
-'zmyzs = 2
-
-zmyx = 90 - SIN(zmyan) * 91
-zmyy = 90 - COS(zmyan) * 91
-
-IF zmyx > 170 THEN zmyx = 170
-IF zmyy > 170 THEN zmyy = 170
-IF zmyx < 10 THEN zmyx = 10
-IF zmyy < 10 THEN zmyy = 10
-
-zmyz = SIN(zmyan / 2) * 4 + 4
-zmyz = SIN(zmyan / 2) * 50 + 50
-myan2 = -SIN(zmyan / 2) * 120 + 121
-myan2 = -(SIN(zmyan / 2) * 10 + 10)
-IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2
-
-myz = zmyz
-myy = zmyy
-myx = zmyx
-
-END SUB
-
--- /dev/null
+DECLARE SUB dispimg ()
+DECLARE SUB updateland ()
+DECLARE SUB makeland ()
+DECLARE FUNCTION getcol! (r!, g!, b!)
+DEFINT A-Y
+DECLARE SUB traceline (x%, y%, xl)
+DECLARE SUB dispframe ()
+DECLARE SUB tower (x%, y%)
+DECLARE SUB square (x1%, y1%, x2%, y2%, c%, h%)
+DECLARE SUB displand ()
+DECLARE SUB start ()
+DECLARE SUB setupal ()
+
+DIM SHARED landh(0 TO 180, 0 TO 180)
+DIM SHARED landc(0 TO 180, 0 TO 180)
+
+DIM SHARED zmyx, zmyy, zmyz
+DIM SHARED myx, myy, myz
+DIM SHARED zmyan, myan2
+DIM SHARED ste, stem, dist
+DIM SHARED tim$, frm, frmrate
+DIM SHARED pi
+DIM SHARED white
+
+sky = getcol(100, 100, 255)
+pi = 3.141592
+
+frmrate = 10 ' Desired framerate.
+ ' Lower framerate, better quality
+
+start
+makeland
+
+'displand
+'a$ = INPUT$(1)
+myan2 = 2
+OPEN "cat.i01" FOR INPUT AS #1
+INPUT #1, pictxw
+INPUT #1, pictyw
+INPUT #1, pictx
+INPUT #1, picty
+
+
+1
+x1 = RND * 160
+y1 = RND * 160
+x2 = x1 + RND * 10 + 1
+y2 = y1 + RND * 10 + 1
+
+IF (frm > 50) AND (frm < 250) THEN square x1, y1, x2, y2, RND * 200, RND * 10
+IF (frm > 250) AND (picty < 177) THEN
+
+ FOR ff = 1 TO 180 * 2
+ INPUT #1, c
+ landc(pictx, picty) = c
+ landh(pictx, picty) = 0
+ pictx = pictx + 1
+ IF pictx >= pictxw THEN pictx = 0: picty = picty + 1
+ IF picty >= pictyw THEN picty = 0
+ NEXT ff
+END IF
+
+IF frm = 430 THEN dispimg
+LOCATE 1, 30
+'PRINT frm
+
+updateland
+dispframe
+GOTO 1
+CLOSE #1
+
+SUB dispframe
+
+l = 0
+zst = -.0031 * ste
+FOR z = .5 TO -.5 STEP zst
+traceline SIN(zmyan + z) * dist + myx, COS(zmyan + z) * dist + myy, l
+l = l + ste
+NEXT z
+
+END SUB
+
+SUB dispimg
+
+CLOSE #1
+
+
+OPEN "cat.i01" FOR INPUT AS #1
+INPUT #1, pictxw
+INPUT #1, pictyw
+
+FOR y = 0 TO pictyw - 1
+FOR x = 0 TO pictxw - 1
+INPUT #1, c
+PSET (x + 50, 150 - y), c
+NEXT x
+NEXT y
+
+CLOSE #1
+
+
+FOR a = 1 TO 50
+ SOUND 0, 1
+NEXT a
+CHAIN "KHKDEMO2.BAS"
+
+END SUB
+
+SUB displand
+
+
+FOR z = 0 TO 180
+zs = 1
+IF z > 120 THEN zs = .7
+IF z > 160 THEN zs = .6
+FOR zx = 0 TO 180 STEP zs
+y1 = landh(zx, z) - 80
+zx1 = zx - 90
+z1 = 300 - z
+zx2 = zx1 / z1 * 190
+zy2 = y1 / z1 * 190
+
+LINE (zx2 + 160, 40 - zy2)-(zx2 + 160, 200), landc(zx, z)
+NEXT zx
+NEXT z
+
+LOCATE 1, 1
+PRINT "Press any key to continue..."
+
+END SUB
+
+DEFSNG A-Y
+FUNCTION getcol (r, g, b)
+IF r < 0 THEN r = 0
+IF g < 0 THEN g = 0
+IF b < 0 THEN b = 0
+IF r > 255 THEN r = 255
+IF g > 255 THEN g = 255
+IF b > 255 THEN b = 255
+getcol = INT(r / 43) * 36 + INT(g / 43) * 6 + INT(b / 43)
+END FUNCTION
+
+DEFINT A-Y
+SUB makeland
+
+square 0, 0, 180, 180, 15, 0
+
+FOR y = 0 TO 180
+FOR x = 0 TO 180
+x1 = (x \ 10) MOD 2
+y1 = (y \ 10) MOD 2
+c = (x1 + y1) MOD 2
+IF c = 0 THEN
+ landc(x, y) = getcol(250, 250, 250)
+ELSE
+ landc(x, y) = getcol(250, 50, 50)
+END IF
+NEXT x
+NEXT y
+
+FOR y = 10 TO 90
+FOR x = 90 TO 170
+v = SQR((ABS(50 - y)) ^ 2 + (ABS(130 - x)) ^ 2)
+h = SQR((60 - v) * (60 + v)) - 35
+IF h > 0 THEN landh(x, y) = h
+NEXT x
+NEXT y
+
+tower 20, 20
+tower 60, 20
+tower 40, 150
+
+
+FOR za = 0 TO 20 STEP .1
+x = SIN(za) * (1 + (za * 2)) + 100
+y = COS(za) * (1 + (za * 2)) + 100
+landc(x, y) = getcol(20, RND * 200, 20)
+landc(x + 1, y) = getcol(20, RND * 200, 20)
+landc(x, y + 1) = getcol(20, RND * 200, 20)
+landc(x + 1, y + 1) = getcol(20, RND * 200, 20)
+NEXT za
+
+END SUB
+
+SUB setupal
+c = 0
+FOR r = 0 TO 5
+FOR g = 0 TO 5
+FOR b = 0 TO 5
+OUT &H3C8, c
+c = c + 1
+OUT &H3C9, r * 12
+OUT &H3C9, g * 12
+OUT &H3C9, b * 12
+NEXT b
+NEXT g
+NEXT r
+END SUB
+
+SUB square (x1, y1, x2, y2, c, h)
+
+FOR y = y1 TO y2
+FOR x = x1 TO x2
+landh(x, y) = h
+landc(x, y) = c
+NEXT x
+NEXT y
+
+END SUB
+
+SUB start
+SCREEN 13
+'PRINT "please wait..."
+
+setupal
+
+zmyan = 4.14
+myan2 = 100
+ste = 1
+stem = ste - 1
+dist = 190
+tim$ = TIME$
+zmyx = 170
+zmyy = 170
+zmyz = 20
+
+END SUB
+
+SUB tower (x, y)
+
+FOR a = 10 TO 0 STEP -1
+square x - a, y - a, x + a, y + a, getcol(100, 0, a * 20), 20 - a
+NEXT a
+
+square x - 11, y - 11, x - 9, y - 9, getcol(255, 0, 0), 20
+square x + 9, y - 11, x + 11, y - 9, getcol(0, 255, 0), 20
+square x - 11, y + 9, x - 9, y + 11, getcol(0, 0, 255), 20
+square x + 9, y + 9, x + 11, y + 11, getcol(255, 255, 0), 20
+
+
+END SUB
+
+SUB traceline (x, y, xl)
+
+IF x < 0 THEN
+zpr = myx / (myx - x)
+x = 0
+y = myy - ((myy - y) * zpr)
+END IF
+
+IF y < 0 THEN
+zpr = myy / (myy - y)
+y = 0
+x = myx - ((myx - x) * zpr)
+END IF
+
+IF x > 180 THEN
+zpr = (180 - myx) / (x - myx)
+x = 180
+y = myy - ((myy - y) * zpr)
+END IF
+
+IF y > 180 THEN
+zpr = (180 - myy) / (y - myy)
+y = 180
+x = myx - ((myx - x) * zpr)
+END IF
+
+lp = SQR(ABS(myx - x) ^ 2 + ABS(myy - y) ^ 2)
+
+xp = x - myx
+yp = y - myy
+
+yo = 200
+
+FOR a = 1 TO lp
+ cx = xp * a / lp + myx
+ cy = yp * a / lp + myy
+ yn = myan2 - ((landh(cx, cy) - myz) * 300) / a
+ IF yn < yo THEN LINE (xl, yn)-(xl + stem, yo - 1), landc(cx, cy), BF: yo = yn
+NEXT a
+LINE (xl, yo - 1)-(xl + stem, 0), sky, BF
+
+END SUB
+
+SUB updateland
+
+frm = frm + 1
+ste = 4
+stem = ste - 1
+
+
+zmyan = frm / 15 + pi
+'myan2 = myan2 + 5
+'zmyx = SIN(zmyan) * 3 + zmyx
+'zmyy = COS(zmyan) * 3 + zmyy
+'zmyzs = 2
+
+zmyx = 90 - SIN(zmyan) * 91
+zmyy = 90 - COS(zmyan) * 91
+
+IF zmyx > 170 THEN zmyx = 170
+IF zmyy > 170 THEN zmyy = 170
+IF zmyx < 10 THEN zmyx = 10
+IF zmyy < 10 THEN zmyy = 10
+
+zmyz = SIN(zmyan / 2) * 4 + 4
+zmyz = SIN(zmyan / 2) * 50 + 50
+myan2 = -SIN(zmyan / 2) * 120 + 121
+myan2 = -(SIN(zmyan / 2) * 10 + 10)
+IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2
+
+myz = zmyz
+myy = zmyy
+myx = zmyx
+
+END SUB
+
+++ /dev/null
-qb /run khkdemo.bas
\ No newline at end of file
#+OPTIONS: H:20 num:20
#+OPTIONS: author:nil
-* General
-
-This collection contains lots of applications:
+* Applications
+This collection contains lots of toy applications:
- Games.
- Graphics tests (2D/3D/4D).
- Algorithms tests.
- Utilities.
-I wrote those applications largely more than 20 years ago, mostly in
-QBasic. Some are even written in x86 assembly for use under DOS
-operating system. Because programs are old, coding style and
-commenting is often times bad. I'm now using artificial intelligence
-to revive and modernize them one by one.
+I wrote those applications mostly more than 20 years ago, mostly in
+QBasic. Because programs are old, coding style and commenting was
+often times bad. I'm now using artificial intelligence to revive and
+modernize them one by one.
+
+Few examples:
+** Checkers
+Play checkers against the computer with any board size and any amount
+of caps. Does thinking by recursively testing many possible scenarios
+with any depth.
+
+Since it is slow QBasic implementation, it isn't practical to play
+with many caps or big thinking depth, for reasonable responce time.
+See directory:
+: games/checkers
+
+[[file:Games/Checkers/screenshot.png]]
+
+** 3D Synthezier
+Parses scene definition language and creates 3D world based on
+it. Result will be in a [[https://en.wikipedia.org/wiki/Wavefront_.obj_file][wavefront obj file]], witch can be then
+visualized using external renderer.
+
+See directory:
+: graphics/3D/3D Synthezier
+
+[[file:Graphics/3D/3D Synthezier/doc/hexagonal city, 2.jpeg]]
-- These programs are free software: released under Creative Commons Zero
- (CC0) license.
+[[file:Graphics/3D/3D Synthezier/doc/rectangular city, 3.jpeg]]
-- Programs author:
- - Svjatoslav Agejenko
- - Homepage: https://svjatoslav.eu
- - Email: mailto://svjatoslav@svjatoslav.eu
-- [[https://www.svjatoslav.eu/projects/][Other software projects hosted at svjatoslav.eu]]
+[[file:Graphics/3D/3D Synthezier/doc/index.html][Read more]]
+* Getting the source code
-** Source code
-- [[https://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=snapshot;h=HEAD;sf=tgz][Download latest snapshot in TAR GZ format]]
+Programs author is Svjatoslav Agejenko
+- Homepage: https://svjatoslav.eu (See also [[https://www.svjatoslav.eu/projects/][other software projects]].)
+- Email: mailto://svjatoslav@svjatoslav.eu
-- [[https://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=summary][Browse Git repository online]]
+*These programs are free software: released under Creative Commons
+Zero (CC0) license.*
-- Clone Git repository using command:
+- [[https://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=summary][Browse Git repository online]].
+- [[https://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=snapshot;h=HEAD;sf=tgz][Download latest snapshot in TAR GZ format]].
+- You can clone Git repository using git:
: git clone https://www3.svjatoslav.eu/git/qbasicapps.git
* Installation and Usage
To release mouse lock, press:
: CTRL-F10
-
-* Applications
-
-There are lot of applications. Few examples:
-
-** Checkers
-Play checkers against the computer with any board size and any amount
-of caps. Does thinking by recursively testing many possible scenarios
-with any depth.
-
-Since it is slow QBasic implementation, it isn't practical to play
-with many caps or big thinking depth, for reasonable responce time.
-See directory:
-: games/checkers
-
-[[file:Games/Checkers/screenshot.png]]
-
-** 3D Synthezier
-Parses scene definition language and creates 3D world based on
-it. Result will be in a [[https://en.wikipedia.org/wiki/Wavefront_.obj_file][wavefront obj file]], witch can be then
-visualized using external renderer.
-
-See directory:
-: graphics/3D/3D Synthezier
-
-[[file:Graphics/3D/3D Synthezier/doc/hexagonal city, 2.jpeg]]
-
-[[file:Graphics/3D/3D Synthezier/doc/rectangular city, 3.jpeg]]
-
-
-[[file:Graphics/3D/3D Synthezier/doc/index.html][Read more]]
projects / qbasicapps.git / commitdiff