From: Svjatoslav Agejenko Date: Thu, 12 Sep 2024 20:39:34 +0000 (+0300) Subject: Improve file and documentation organization X-Git-Url: http://www2.svjatoslav.eu/gitweb/?a=commitdiff_plain;h=c734bccd3f9df7fb29f38930d692f956b47b58a9;p=qbasicapps.git Improve file and documentation organization --- diff --git a/Graphics/3D/3D Explorer/explgala.bas b/Graphics/3D/3D Explorer/explgala.bas new file mode 100755 index 0000000..49e6abb --- /dev/null +++ b/Graphics/3D/3D Explorer/explgala.bas @@ -0,0 +1,372 @@ +' Galaxy explorer +' made by Svjatoslav Agejenko +' in 2003.12 +' E-Mail: svjatoslav@svjatoslav.eu +' H-Page: svjatoslav.eu + +DECLARE SUB temp () +DECLARE SUB mkgalaxy (x!, y!, z!) +DECLARE SUB rndinit () +DECLARE FUNCTION rn! () +DECLARE SUB disp () +DECLARE SUB startext () +DECLARE SUB control () +DECLARE SUB putbyte (addr!, dat!) +DECLARE SUB putword (addr!, dat!) +DECLARE FUNCTION getword! (addr!) +DECLARE FUNCTION getbyte! (addr!) +DECLARE SUB start () +DECLARE SUB animate () + + +DIM SHARED an1, an2, an3 + +DIM SHARED tim + +DIM SHARED extSEG, extADDR + +DIM SHARED myx, myy, myz +DIM SHARED myxs, myys, myzs +DIM SHARED buttL, buttR +DIM SHARED maxmove + + +DIM SHARED zoom +DIM SHARED rndval(0 TO 10000) +DIM SHARED rndp + + +DIM SHARED px(1 TO 12000) +DIM SHARED py(1 TO 12000) +DIM SHARED pz(1 TO 12000) +DIM SHARED pc(1 TO 12000) +DIM SHARED nump + +DIM SHARED tempr(0 TO 10) + + +nl = 0 +np = 0 + +start + + +cx = 0 +cy = 0 +cz = 0 + + + +nump = 0 +mkgalaxy 0, 0, 0 +1 + + + + +va = INT(RND * 3) + +SELECT CASE va +CASE 0 + cx = RND * 500 - 250 +CASE 1 + cy = RND * 100 - 50 +CASE 2 + cz = RND * 500 - 250 +END SELECT + + +control +disp + +PCOPY 0, 1 +CLS +GOTO 1 + +SUB control + + +IF getbyte(8) <> 0 THEN + putbyte 8, 0 + xp = getword(2) + putword 2, 0 + yp = getword(4) + putword 4, 0 + butt = getword(6) + putword 6, 0 + buttL = 0 + buttR = 0 + IF butt = 1 THEN buttL = 1 + IF butt = 2 THEN buttR = 1 + IF butt = 3 THEN buttL = 1: buttR = 1 + + + IF buttR = 1 THEN + IF buttL = 1 THEN + myxs = myxs + SIN(an1) * yp / 4 + myzs = myzs - COS(an1) * yp / 4 + GOTO 3 + END IF + myys = myys + yp / 4 +3 + yp = 0 + END IF + +END IF + + + + +IF xp < -maxmove THEN xp = -maxmove +IF xp > maxmove THEN xp = maxmove +an1 = an1 - xp / 150 + +IF yp < -maxmove THEN yp = -maxmove +IF yp > maxmove THEN yp = maxmove +an2 = an2 - yp / 150 + + + +a$ = INKEY$ + +IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1) +IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1) +IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1) +IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1) +IF a$ = "q" THEN SYSTEM + + +myxs = myxs / 1.1 +myys = myys / 1.1 +myzs = myzs / 1.1 + +myx = myx + myxs +myz = myz + myzs +myy = myy + myys + +END SUB + +SUB disp + +s1 = SIN(an1) +c1 = COS(an1) +s2 = SIN(an2) +c2 = COS(an2) + + +FOR a = 1 TO nump + + + x = px(a) - myx + y = py(a) - myy + z = pz(a) - myz + + + x1 = x * c1 + z * s1 + z1 = z * c1 - x * s1 + + y1 = y * c2 + z1 * s2 + z2 = z1 * c2 - y * s2 + + +' z2 = z2 + 10 + + IF z2 > 3 THEN + rpx = x1 / z2 * 130 + 160 + rpy = y1 / z2 * 130 + 100 + PSET (rpx, rpy), pc(a) + + END IF + + +NEXT a +END SUB + +FUNCTION getbyte (addr) +getbyte = PEEK(extADDR + addr) +END FUNCTION + +FUNCTION getword (addr) +a = PEEK(extADDR + addr) +b = PEEK(extADDR + addr + 1) + + +c$ = HEX$(a) +IF LEN(c$) = 1 THEN c$ = "0" + c$ +IF LEN(c$) = 0 THEN c$ = "00" + + +c = VAL("&H" + HEX$(b) + c$) + +getword = c +END FUNCTION + +SUB mkgalaxy (lx, ly, lz) + + +n1 = rn * 10 +n2 = rn * 10 + +gs1 = SIN(n1) +gc1 = COS(n1) +gs2 = SIN(n2) +gc2 = COS(n2) + + + +rndp = 0 +siz = 100 +pi = 3.14 +sbm = 3 + + +FOR a = 1 TO 10000 + + b = rn * 10 + s = b * b / 30 + + v1 = rn * (11.5 - b) / 3 + v1p = v1 / 2 + + ane = rn * (s / 2) / sbm * 2 + sba = 2 * pi / sbm * INT(rn * sbm) + + x = (SIN(b - sba + ane) * s + rn * v1 - v1p) * siz + z = (COS(b - sba + ane) * s + rn * v1 - v1p) * siz + y = (rn * v1 - v1p) * siz + + + x1 = x * gc1 + z * gs1 + z1 = z * gc1 - x * gs1 + + y1 = y * gc2 + z1 * gs2 + z2 = z1 * gc2 - y * gs2 + + + nump = nump + 1 + + px(nump) = x1 + lx + py(nump) = y1 + ly + pz(nump) = z2 + lz + pc(nump) = INT(RND * 15) + 1 +NEXT a + +END SUB + +SUB mousedemo + + + +cx = 150 +cy = 100 +maxmove = 50 +100 +frm = frm + 1 + + +LOCATE 1, 1 +PRINT cx, cy +PRINT frm + +CIRCLE (cx, cy), 10, 0 +xp = getword(2) +putword 2, 0 +yp = getword(4) +putword 4, 0 + + +IF xp < -maxmove THEN xp = -maxmove +IF xp > maxmove THEN xp = maxmove +cx = cx + xp + +IF yp < -maxmove THEN yp = -maxmove +IF yp > maxmove THEN yp = maxmove +cy = cy + yp + + +CIRCLE (cx, cy), 10, 10 + + + +SOUND 0, .05 +GOTO 100 + + +END SUB + +SUB putbyte (addr, dat) + +POKE (extADDR + addr), dat +END SUB + +SUB putword (addr, dat) + +b$ = HEX$(dat) + +2 +IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2 + +n1 = VAL("&H" + LEFT$(b$, 2)) +n2 = VAL("&H" + RIGHT$(b$, 2)) + + +POKE (extADDR + addr), n2 +POKE (extADDR + addr + 1), n1 + +END SUB + +FUNCTION rn + +rndp = rndp + 1 +IF rndp > 10000 THEN rndp = 0 +rn = rndval(rndp) + +END FUNCTION + +SUB rndinit + + +FOR a = 0 TO 10000 + rndval(a) = RND +NEXT a + +rndp = 0 +END SUB + +SUB start + + +startext + + +SCREEN 7, , , 1 + +maxmove = 50 +rndinit + +END SUB + +SUB startext + +DEF SEG = 0 ' read first from interrupt table + +extSEG = PEEK(&H79 * 4 + 3) * 256 +extSEG = extSEG + PEEK(&H79 * 4 + 2) + +PRINT "Segment is: " + HEX$(extSEG) + +extADDR = PEEK(&H79 * 4 + 1) * 256 +extADDR = extADDR + PEEK(&H79 * 4 + 0) + +PRINT "relative address is:"; extADDR + +DEF SEG = extSEG + +IF getword(0) <> 1983 THEN + PRINT "FATAL ERROR: you must load" + PRINT "QBasic extension TSR first!" + SYSTEM +END IF + +END SUB + diff --git a/Graphics/3D/3D Explorer/explgala.bat b/Graphics/3D/3D Explorer/explgala.bat new file mode 100755 index 0000000..c250eb2 --- /dev/null +++ b/Graphics/3D/3D Explorer/explgala.bat @@ -0,0 +1,2 @@ +qbext +qb /run explgala.bas \ No newline at end of file diff --git a/Graphics/3D/3D Explorer/explmaze.bas b/Graphics/3D/3D Explorer/explmaze.bas new file mode 100755 index 0000000..9401d81 --- /dev/null +++ b/Graphics/3D/3D Explorer/explmaze.bas @@ -0,0 +1,320 @@ +' 3D Maze explorer +' made by Svjatoslav Agejenko +' in 2003.12 +' H-Page: svjatoslav.eu +' E-Mail: svjatoslav@svjatoslav.eu + +DECLARE SUB startext () +DECLARE SUB control () +DECLARE SUB putbyte (addr!, dat!) +DECLARE SUB putword (addr!, dat!) +DECLARE FUNCTION getword! (addr!) +DECLARE FUNCTION getbyte! (addr!) +DECLARE SUB start () +DECLARE SUB animate () + +DIM SHARED px(1 TO 5000) +DIM SHARED py(1 TO 5000) +DIM SHARED pz(1 TO 5000) +DIM SHARED rpx(1 TO 5000) +DIM SHARED rpy(1 TO 5000) +DIM SHARED rpe(1 TO 5000) + +DIM SHARED l1(1 TO 5000) +DIM SHARED l2(1 TO 5000) +DIM SHARED lc(1 TO 5000) + +DIM SHARED nl, np + +DIM SHARED an1, an2, an3 + +DIM SHARED tim + +DIM SHARED extSEG, extADDR + +DIM SHARED myx, myy, myz +DIM SHARED myxs, myys, myzs +DIM SHARED buttL, buttR +DIM SHARED maxmove + +nl = 0 +np = 0 + +start + + +cx = 0 +cy = 0 +cz = 0 + +np = 1 +px(1) = 0 +py(1) = 0 +pz(1) = 0 + +1 + + + + +np = np + 1 +px(np) = cx +py(np) = cy +pz(np) = cz + + + +nl = nl + 1 +l1(nl) = np +l2(nl) = np - 1 +lc(nl) = INT(RND * 15) + 1 +'lc(nl) = ABS(cx / 20) + + + +va = INT(RND * 3) + +SELECT CASE va +CASE 0 + cx = RND * 500 - 250 +CASE 1 + cy = RND * 100 - 50 +CASE 2 + cz = RND * 500 - 250 +END SELECT + + +control +animate + +PCOPY 0, 1 +CLS +GOTO 1 + +SUB animate + + +s1 = SIN(an1) +s2 = SIN(an2) +s3 = SIN(an3) + +c1 = COS(an1) +c2 = COS(an2) +c3 = COS(an3) + + + +FOR a = 1 TO np + x = px(a) - myx + y = py(a) - myy + z = pz(a) - myz + + + x1 = x * c1 + z * s1 + z1 = z * c1 - x * s1 + + y1 = y * c2 + z1 * s2 + z2 = z1 * c2 - y * s2 + + +' z2 = z2 + 10 + + IF z2 > 3 THEN + rpe(a) = 1 + rpx(a) = x1 / z2 * 130 + 160 + rpy(a) = y1 / z2 * 130 + 100 + ELSE + rpe(a) = 0 + END IF + +NEXT a + + +FOR a = 1 TO nl + + p1 = l1(a) + p2 = l2(a) + IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a) + +NEXT a + + +END SUB + +SUB control + + +IF getbyte(8) <> 0 THEN + putbyte 8, 0 + xp = getword(2) + putword 2, 0 + yp = getword(4) + putword 4, 0 + butt = getword(6) + putword 6, 0 + buttL = 0 + buttR = 0 + IF butt = 1 THEN buttL = 1 + IF butt = 2 THEN buttR = 1 + IF butt = 3 THEN buttL = 1: buttR = 1 + + + IF buttR = 1 THEN + IF buttL = 1 THEN + myxs = myxs + SIN(an1) * yp / 4 + myzs = myzs - COS(an1) * yp / 4 + GOTO 3 + END IF + myys = myys + yp / 4 +3 + yp = 0 + END IF + +END IF + + + + +IF xp < -maxmove THEN xp = -maxmove +IF xp > maxmove THEN xp = maxmove +an1 = an1 - xp / 150 + +IF yp < -maxmove THEN yp = -maxmove +IF yp > maxmove THEN yp = maxmove +an2 = an2 - yp / 150 + + + +a$ = INKEY$ + +IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1) +IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1) +IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1) +IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1) +IF a$ = "q" THEN SYSTEM + +myxs = myxs / 1.1 +myys = myys / 1.1 +myzs = myzs / 1.1 + +myx = myx + myxs +myz = myz + myzs +myy = myy + myys + +END SUB + +FUNCTION getbyte (addr) +getbyte = PEEK(extADDR + addr) +END FUNCTION + +FUNCTION getword (addr) +a = PEEK(extADDR + addr) +b = PEEK(extADDR + addr + 1) + + +c$ = HEX$(a) +IF LEN(c$) = 1 THEN c$ = "0" + c$ +IF LEN(c$) = 0 THEN c$ = "00" + + +c = VAL("&H" + HEX$(b) + c$) + +getword = c +END FUNCTION + +SUB mousedemo + + + +cx = 150 +cy = 100 +maxmove = 50 +100 +frm = frm + 1 + + +LOCATE 1, 1 +PRINT cx, cy +PRINT frm + +CIRCLE (cx, cy), 10, 0 +xp = getword(2) +putword 2, 0 +yp = getword(4) +putword 4, 0 + + +IF xp < -maxmove THEN xp = -maxmove +IF xp > maxmove THEN xp = maxmove +cx = cx + xp + +IF yp < -maxmove THEN yp = -maxmove +IF yp > maxmove THEN yp = maxmove +cy = cy + yp + + +CIRCLE (cx, cy), 10, 10 + + + +SOUND 0, .05 +GOTO 100 + + +END SUB + +SUB putbyte (addr, dat) + +POKE (extADDR + addr), dat +END SUB + +SUB putword (addr, dat) + +b$ = HEX$(dat) + +2 +IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2 + +n1 = VAL("&H" + LEFT$(b$, 2)) +n2 = VAL("&H" + RIGHT$(b$, 2)) + + +POKE (extADDR + addr), n2 +POKE (extADDR + addr + 1), n1 + +END SUB + +SUB start +startext + + +SCREEN 7, , , 1 + +maxmove = 50 + +END SUB + +SUB startext + +DEF SEG = 0 ' read first from interrupt table + +extSEG = PEEK(&H79 * 4 + 3) * 256 +extSEG = extSEG + PEEK(&H79 * 4 + 2) + +PRINT "Segment is: " + HEX$(extSEG) + +extADDR = PEEK(&H79 * 4 + 1) * 256 +extADDR = extADDR + PEEK(&H79 * 4 + 0) + +PRINT "relative address is:"; extADDR + +DEF SEG = extSEG + +IF getword(0) <> 1983 THEN + PRINT "FATAL ERROR: you must load" + PRINT "QBasic extension TSR first!" + SYSTEM +END IF + +END SUB + diff --git a/Graphics/3D/3D Explorer/explmaze.bat b/Graphics/3D/3D Explorer/explmaze.bat new file mode 100755 index 0000000..d4c909e --- /dev/null +++ b/Graphics/3D/3D Explorer/explmaze.bat @@ -0,0 +1,2 @@ +qbext +qb /run explmaze.bas \ No newline at end of file diff --git a/Graphics/3D/3D Explorer/qbext.com b/Graphics/3D/3D Explorer/qbext.com new file mode 100755 index 0000000..ae54fc4 Binary files /dev/null and b/Graphics/3D/3D Explorer/qbext.com differ diff --git a/Graphics/3D/3D Explorer/script.dat b/Graphics/3D/3D Explorer/script.dat new file mode 100755 index 0000000..4841c38 --- /dev/null +++ b/Graphics/3D/3D Explorer/script.dat @@ -0,0 +1 @@ + 0 1397293 6565525 -1.795911E+07 .9747545 5.336815E-02 diff --git a/Graphics/3D/3D Synthezier/doc/index.org b/Graphics/3D/3D Synthezier/doc/index.org index dc911d4..641003c 100644 --- a/Graphics/3D/3D Synthezier/doc/index.org +++ b/Graphics/3D/3D Synthezier/doc/index.org @@ -8,20 +8,8 @@ #+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 @@ -36,27 +24,29 @@ Objects with all its subobjects can be rotated, mirrored or resized 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 @@ -117,6 +107,27 @@ See also examples. : 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 @@ -126,27 +137,3 @@ or 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]] diff --git a/Graphics/3D/3dexplor/explgala.bas b/Graphics/3D/3dexplor/explgala.bas deleted file mode 100755 index 49e6abb..0000000 --- a/Graphics/3D/3dexplor/explgala.bas +++ /dev/null @@ -1,372 +0,0 @@ -' Galaxy explorer -' made by Svjatoslav Agejenko -' in 2003.12 -' E-Mail: svjatoslav@svjatoslav.eu -' H-Page: svjatoslav.eu - -DECLARE SUB temp () -DECLARE SUB mkgalaxy (x!, y!, z!) -DECLARE SUB rndinit () -DECLARE FUNCTION rn! () -DECLARE SUB disp () -DECLARE SUB startext () -DECLARE SUB control () -DECLARE SUB putbyte (addr!, dat!) -DECLARE SUB putword (addr!, dat!) -DECLARE FUNCTION getword! (addr!) -DECLARE FUNCTION getbyte! (addr!) -DECLARE SUB start () -DECLARE SUB animate () - - -DIM SHARED an1, an2, an3 - -DIM SHARED tim - -DIM SHARED extSEG, extADDR - -DIM SHARED myx, myy, myz -DIM SHARED myxs, myys, myzs -DIM SHARED buttL, buttR -DIM SHARED maxmove - - -DIM SHARED zoom -DIM SHARED rndval(0 TO 10000) -DIM SHARED rndp - - -DIM SHARED px(1 TO 12000) -DIM SHARED py(1 TO 12000) -DIM SHARED pz(1 TO 12000) -DIM SHARED pc(1 TO 12000) -DIM SHARED nump - -DIM SHARED tempr(0 TO 10) - - -nl = 0 -np = 0 - -start - - -cx = 0 -cy = 0 -cz = 0 - - - -nump = 0 -mkgalaxy 0, 0, 0 -1 - - - - -va = INT(RND * 3) - -SELECT CASE va -CASE 0 - cx = RND * 500 - 250 -CASE 1 - cy = RND * 100 - 50 -CASE 2 - cz = RND * 500 - 250 -END SELECT - - -control -disp - -PCOPY 0, 1 -CLS -GOTO 1 - -SUB control - - -IF getbyte(8) <> 0 THEN - putbyte 8, 0 - xp = getword(2) - putword 2, 0 - yp = getword(4) - putword 4, 0 - butt = getword(6) - putword 6, 0 - buttL = 0 - buttR = 0 - IF butt = 1 THEN buttL = 1 - IF butt = 2 THEN buttR = 1 - IF butt = 3 THEN buttL = 1: buttR = 1 - - - IF buttR = 1 THEN - IF buttL = 1 THEN - myxs = myxs + SIN(an1) * yp / 4 - myzs = myzs - COS(an1) * yp / 4 - GOTO 3 - END IF - myys = myys + yp / 4 -3 - yp = 0 - END IF - -END IF - - - - -IF xp < -maxmove THEN xp = -maxmove -IF xp > maxmove THEN xp = maxmove -an1 = an1 - xp / 150 - -IF yp < -maxmove THEN yp = -maxmove -IF yp > maxmove THEN yp = maxmove -an2 = an2 - yp / 150 - - - -a$ = INKEY$ - -IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1) -IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1) -IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1) -IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1) -IF a$ = "q" THEN SYSTEM - - -myxs = myxs / 1.1 -myys = myys / 1.1 -myzs = myzs / 1.1 - -myx = myx + myxs -myz = myz + myzs -myy = myy + myys - -END SUB - -SUB disp - -s1 = SIN(an1) -c1 = COS(an1) -s2 = SIN(an2) -c2 = COS(an2) - - -FOR a = 1 TO nump - - - x = px(a) - myx - y = py(a) - myy - z = pz(a) - myz - - - x1 = x * c1 + z * s1 - z1 = z * c1 - x * s1 - - y1 = y * c2 + z1 * s2 - z2 = z1 * c2 - y * s2 - - -' z2 = z2 + 10 - - IF z2 > 3 THEN - rpx = x1 / z2 * 130 + 160 - rpy = y1 / z2 * 130 + 100 - PSET (rpx, rpy), pc(a) - - END IF - - -NEXT a -END SUB - -FUNCTION getbyte (addr) -getbyte = PEEK(extADDR + addr) -END FUNCTION - -FUNCTION getword (addr) -a = PEEK(extADDR + addr) -b = PEEK(extADDR + addr + 1) - - -c$ = HEX$(a) -IF LEN(c$) = 1 THEN c$ = "0" + c$ -IF LEN(c$) = 0 THEN c$ = "00" - - -c = VAL("&H" + HEX$(b) + c$) - -getword = c -END FUNCTION - -SUB mkgalaxy (lx, ly, lz) - - -n1 = rn * 10 -n2 = rn * 10 - -gs1 = SIN(n1) -gc1 = COS(n1) -gs2 = SIN(n2) -gc2 = COS(n2) - - - -rndp = 0 -siz = 100 -pi = 3.14 -sbm = 3 - - -FOR a = 1 TO 10000 - - b = rn * 10 - s = b * b / 30 - - v1 = rn * (11.5 - b) / 3 - v1p = v1 / 2 - - ane = rn * (s / 2) / sbm * 2 - sba = 2 * pi / sbm * INT(rn * sbm) - - x = (SIN(b - sba + ane) * s + rn * v1 - v1p) * siz - z = (COS(b - sba + ane) * s + rn * v1 - v1p) * siz - y = (rn * v1 - v1p) * siz - - - x1 = x * gc1 + z * gs1 - z1 = z * gc1 - x * gs1 - - y1 = y * gc2 + z1 * gs2 - z2 = z1 * gc2 - y * gs2 - - - nump = nump + 1 - - px(nump) = x1 + lx - py(nump) = y1 + ly - pz(nump) = z2 + lz - pc(nump) = INT(RND * 15) + 1 -NEXT a - -END SUB - -SUB mousedemo - - - -cx = 150 -cy = 100 -maxmove = 50 -100 -frm = frm + 1 - - -LOCATE 1, 1 -PRINT cx, cy -PRINT frm - -CIRCLE (cx, cy), 10, 0 -xp = getword(2) -putword 2, 0 -yp = getword(4) -putword 4, 0 - - -IF xp < -maxmove THEN xp = -maxmove -IF xp > maxmove THEN xp = maxmove -cx = cx + xp - -IF yp < -maxmove THEN yp = -maxmove -IF yp > maxmove THEN yp = maxmove -cy = cy + yp - - -CIRCLE (cx, cy), 10, 10 - - - -SOUND 0, .05 -GOTO 100 - - -END SUB - -SUB putbyte (addr, dat) - -POKE (extADDR + addr), dat -END SUB - -SUB putword (addr, dat) - -b$ = HEX$(dat) - -2 -IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2 - -n1 = VAL("&H" + LEFT$(b$, 2)) -n2 = VAL("&H" + RIGHT$(b$, 2)) - - -POKE (extADDR + addr), n2 -POKE (extADDR + addr + 1), n1 - -END SUB - -FUNCTION rn - -rndp = rndp + 1 -IF rndp > 10000 THEN rndp = 0 -rn = rndval(rndp) - -END FUNCTION - -SUB rndinit - - -FOR a = 0 TO 10000 - rndval(a) = RND -NEXT a - -rndp = 0 -END SUB - -SUB start - - -startext - - -SCREEN 7, , , 1 - -maxmove = 50 -rndinit - -END SUB - -SUB startext - -DEF SEG = 0 ' read first from interrupt table - -extSEG = PEEK(&H79 * 4 + 3) * 256 -extSEG = extSEG + PEEK(&H79 * 4 + 2) - -PRINT "Segment is: " + HEX$(extSEG) - -extADDR = PEEK(&H79 * 4 + 1) * 256 -extADDR = extADDR + PEEK(&H79 * 4 + 0) - -PRINT "relative address is:"; extADDR - -DEF SEG = extSEG - -IF getword(0) <> 1983 THEN - PRINT "FATAL ERROR: you must load" - PRINT "QBasic extension TSR first!" - SYSTEM -END IF - -END SUB - diff --git a/Graphics/3D/3dexplor/explgala.bat b/Graphics/3D/3dexplor/explgala.bat deleted file mode 100755 index c250eb2..0000000 --- a/Graphics/3D/3dexplor/explgala.bat +++ /dev/null @@ -1,2 +0,0 @@ -qbext -qb /run explgala.bas \ No newline at end of file diff --git a/Graphics/3D/3dexplor/explmaze.bas b/Graphics/3D/3dexplor/explmaze.bas deleted file mode 100755 index 9401d81..0000000 --- a/Graphics/3D/3dexplor/explmaze.bas +++ /dev/null @@ -1,320 +0,0 @@ -' 3D Maze explorer -' made by Svjatoslav Agejenko -' in 2003.12 -' H-Page: svjatoslav.eu -' E-Mail: svjatoslav@svjatoslav.eu - -DECLARE SUB startext () -DECLARE SUB control () -DECLARE SUB putbyte (addr!, dat!) -DECLARE SUB putword (addr!, dat!) -DECLARE FUNCTION getword! (addr!) -DECLARE FUNCTION getbyte! (addr!) -DECLARE SUB start () -DECLARE SUB animate () - -DIM SHARED px(1 TO 5000) -DIM SHARED py(1 TO 5000) -DIM SHARED pz(1 TO 5000) -DIM SHARED rpx(1 TO 5000) -DIM SHARED rpy(1 TO 5000) -DIM SHARED rpe(1 TO 5000) - -DIM SHARED l1(1 TO 5000) -DIM SHARED l2(1 TO 5000) -DIM SHARED lc(1 TO 5000) - -DIM SHARED nl, np - -DIM SHARED an1, an2, an3 - -DIM SHARED tim - -DIM SHARED extSEG, extADDR - -DIM SHARED myx, myy, myz -DIM SHARED myxs, myys, myzs -DIM SHARED buttL, buttR -DIM SHARED maxmove - -nl = 0 -np = 0 - -start - - -cx = 0 -cy = 0 -cz = 0 - -np = 1 -px(1) = 0 -py(1) = 0 -pz(1) = 0 - -1 - - - - -np = np + 1 -px(np) = cx -py(np) = cy -pz(np) = cz - - - -nl = nl + 1 -l1(nl) = np -l2(nl) = np - 1 -lc(nl) = INT(RND * 15) + 1 -'lc(nl) = ABS(cx / 20) - - - -va = INT(RND * 3) - -SELECT CASE va -CASE 0 - cx = RND * 500 - 250 -CASE 1 - cy = RND * 100 - 50 -CASE 2 - cz = RND * 500 - 250 -END SELECT - - -control -animate - -PCOPY 0, 1 -CLS -GOTO 1 - -SUB animate - - -s1 = SIN(an1) -s2 = SIN(an2) -s3 = SIN(an3) - -c1 = COS(an1) -c2 = COS(an2) -c3 = COS(an3) - - - -FOR a = 1 TO np - x = px(a) - myx - y = py(a) - myy - z = pz(a) - myz - - - x1 = x * c1 + z * s1 - z1 = z * c1 - x * s1 - - y1 = y * c2 + z1 * s2 - z2 = z1 * c2 - y * s2 - - -' z2 = z2 + 10 - - IF z2 > 3 THEN - rpe(a) = 1 - rpx(a) = x1 / z2 * 130 + 160 - rpy(a) = y1 / z2 * 130 + 100 - ELSE - rpe(a) = 0 - END IF - -NEXT a - - -FOR a = 1 TO nl - - p1 = l1(a) - p2 = l2(a) - IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a) - -NEXT a - - -END SUB - -SUB control - - -IF getbyte(8) <> 0 THEN - putbyte 8, 0 - xp = getword(2) - putword 2, 0 - yp = getword(4) - putword 4, 0 - butt = getword(6) - putword 6, 0 - buttL = 0 - buttR = 0 - IF butt = 1 THEN buttL = 1 - IF butt = 2 THEN buttR = 1 - IF butt = 3 THEN buttL = 1: buttR = 1 - - - IF buttR = 1 THEN - IF buttL = 1 THEN - myxs = myxs + SIN(an1) * yp / 4 - myzs = myzs - COS(an1) * yp / 4 - GOTO 3 - END IF - myys = myys + yp / 4 -3 - yp = 0 - END IF - -END IF - - - - -IF xp < -maxmove THEN xp = -maxmove -IF xp > maxmove THEN xp = maxmove -an1 = an1 - xp / 150 - -IF yp < -maxmove THEN yp = -maxmove -IF yp > maxmove THEN yp = maxmove -an2 = an2 - yp / 150 - - - -a$ = INKEY$ - -IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1) -IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1) -IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1) -IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1) -IF a$ = "q" THEN SYSTEM - -myxs = myxs / 1.1 -myys = myys / 1.1 -myzs = myzs / 1.1 - -myx = myx + myxs -myz = myz + myzs -myy = myy + myys - -END SUB - -FUNCTION getbyte (addr) -getbyte = PEEK(extADDR + addr) -END FUNCTION - -FUNCTION getword (addr) -a = PEEK(extADDR + addr) -b = PEEK(extADDR + addr + 1) - - -c$ = HEX$(a) -IF LEN(c$) = 1 THEN c$ = "0" + c$ -IF LEN(c$) = 0 THEN c$ = "00" - - -c = VAL("&H" + HEX$(b) + c$) - -getword = c -END FUNCTION - -SUB mousedemo - - - -cx = 150 -cy = 100 -maxmove = 50 -100 -frm = frm + 1 - - -LOCATE 1, 1 -PRINT cx, cy -PRINT frm - -CIRCLE (cx, cy), 10, 0 -xp = getword(2) -putword 2, 0 -yp = getword(4) -putword 4, 0 - - -IF xp < -maxmove THEN xp = -maxmove -IF xp > maxmove THEN xp = maxmove -cx = cx + xp - -IF yp < -maxmove THEN yp = -maxmove -IF yp > maxmove THEN yp = maxmove -cy = cy + yp - - -CIRCLE (cx, cy), 10, 10 - - - -SOUND 0, .05 -GOTO 100 - - -END SUB - -SUB putbyte (addr, dat) - -POKE (extADDR + addr), dat -END SUB - -SUB putword (addr, dat) - -b$ = HEX$(dat) - -2 -IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2 - -n1 = VAL("&H" + LEFT$(b$, 2)) -n2 = VAL("&H" + RIGHT$(b$, 2)) - - -POKE (extADDR + addr), n2 -POKE (extADDR + addr + 1), n1 - -END SUB - -SUB start -startext - - -SCREEN 7, , , 1 - -maxmove = 50 - -END SUB - -SUB startext - -DEF SEG = 0 ' read first from interrupt table - -extSEG = PEEK(&H79 * 4 + 3) * 256 -extSEG = extSEG + PEEK(&H79 * 4 + 2) - -PRINT "Segment is: " + HEX$(extSEG) - -extADDR = PEEK(&H79 * 4 + 1) * 256 -extADDR = extADDR + PEEK(&H79 * 4 + 0) - -PRINT "relative address is:"; extADDR - -DEF SEG = extSEG - -IF getword(0) <> 1983 THEN - PRINT "FATAL ERROR: you must load" - PRINT "QBasic extension TSR first!" - SYSTEM -END IF - -END SUB - diff --git a/Graphics/3D/3dexplor/explmaze.bat b/Graphics/3D/3dexplor/explmaze.bat deleted file mode 100755 index d4c909e..0000000 --- a/Graphics/3D/3dexplor/explmaze.bat +++ /dev/null @@ -1,2 +0,0 @@ -qbext -qb /run explmaze.bas \ No newline at end of file diff --git a/Graphics/3D/3dexplor/qbext.com b/Graphics/3D/3dexplor/qbext.com deleted file mode 100755 index ae54fc4..0000000 Binary files a/Graphics/3D/3dexplor/qbext.com and /dev/null differ diff --git a/Graphics/3D/3dexplor/script.dat b/Graphics/3D/3dexplor/script.dat deleted file mode 100755 index 4841c38..0000000 --- a/Graphics/3D/3dexplor/script.dat +++ /dev/null @@ -1 +0,0 @@ - 0 1397293 6565525 -1.795911E+07 .9747545 5.336815E-02 diff --git "a/Graphics/Presentations/KHK j\303\265ulud/joulud.bas" "b/Graphics/Presentations/KHK j\303\265ulud/joulud.bas" new file mode 100755 index 0000000..f56e70e --- /dev/null +++ "b/Graphics/Presentations/KHK j\303\265ulud/joulud.bas" @@ -0,0 +1,352 @@ +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 + diff --git "a/Graphics/Presentations/KHK j\303\265ulud/joulud2.bas" "b/Graphics/Presentations/KHK j\303\265ulud/joulud2.bas" new file mode 100755 index 0000000..c8d7a53 --- /dev/null +++ "b/Graphics/Presentations/KHK j\303\265ulud/joulud2.bas" @@ -0,0 +1,294 @@ +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 + diff --git "a/Graphics/Presentations/KHK j\303\265ulud/khkdemo.bas" "b/Graphics/Presentations/KHK j\303\265ulud/khkdemo.bas" deleted file mode 100755 index f56e70e..0000000 --- "a/Graphics/Presentations/KHK j\303\265ulud/khkdemo.bas" +++ /dev/null @@ -1,352 +0,0 @@ -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 - diff --git "a/Graphics/Presentations/KHK j\303\265ulud/khkdemo2.bas" "b/Graphics/Presentations/KHK j\303\265ulud/khkdemo2.bas" deleted file mode 100755 index c8d7a53..0000000 --- "a/Graphics/Presentations/KHK j\303\265ulud/khkdemo2.bas" +++ /dev/null @@ -1,294 +0,0 @@ -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 - diff --git "a/Graphics/Presentations/KHK j\303\265ulud/ray.bas" "b/Graphics/Presentations/KHK j\303\265ulud/ray.bas" deleted file mode 100755 index cf8a8b1..0000000 --- "a/Graphics/Presentations/KHK j\303\265ulud/ray.bas" +++ /dev/null @@ -1,318 +0,0 @@ -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 - diff --git "a/Graphics/Presentations/KHK j\303\265ulud/ray2.bas" "b/Graphics/Presentations/KHK j\303\265ulud/ray2.bas" new file mode 100755 index 0000000..cf8a8b1 --- /dev/null +++ "b/Graphics/Presentations/KHK j\303\265ulud/ray2.bas" @@ -0,0 +1,318 @@ +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 + diff --git "a/Graphics/Presentations/KHK j\303\265ulud/run.bat" "b/Graphics/Presentations/KHK j\303\265ulud/run.bat" deleted file mode 100755 index 43fe403..0000000 --- "a/Graphics/Presentations/KHK j\303\265ulud/run.bat" +++ /dev/null @@ -1 +0,0 @@ -qb /run khkdemo.bas \ No newline at end of file diff --git a/index.org b/index.org index 0cb76f4..3982218 100644 --- a/index.org +++ b/index.org @@ -8,37 +8,58 @@ #+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 @@ -154,34 +175,3 @@ screen, it should get locked (confined to the DOSBox window) and work. 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]]