+++ /dev/null
-' by Svjatoslav Agejenko\r
-' homeage: http://svjatoslav.eu\r
-' e-mail: svjatoslav@svjatoslav.eu\r
-\r
-' Before running, make sure include path is correct. See below.\r
-\r
-DECLARE SUB parsel (a$)\r
-DECLARE SUB stat2 (b!)\r
-DECLARE SUB stat ()\r
-DECLARE SUB getchc (a$, b!)\r
-DECLARE SUB start ()\r
-DECLARE SUB qui ()\r
-DECLARE SUB flushpoly (a!)\r
-DECLARE SUB usemtl (a$)\r
-DECLARE SUB flushp ()\r
-DECLARE SUB parse (a$)\r
-DECLARE SUB geth (b!)\r
-DECLARE SUB cmd (a$)\r
-DECLARE SUB getson (a$)\r
-DIM SHARED px(1 TO 1000)\r
-DIM SHARED py(1 TO 1000)\r
-DIM SHARED pz(1 TO 1000)\r
-DIM SHARED nump\r
-DIM SHARED numpa\r
-DIM SHARED numpo\r
-\r
-DIM SHARED fil(1 TO 100)\r
-DIM SHARED mitus\r
-DIM SHARED sona$(1 TO 20)\r
-DIM SHARED res\r
-\r
-DIM SHARED mtlm\r
-DIM SHARED mtl$(1 TO 50)\r
-DIM SHARED mtlp1(1 TO 50, 1 TO 100)\r
-DIM SHARED mtlp2(1 TO 50, 1 TO 100)\r
-DIM SHARED mtlp3(1 TO 50, 1 TO 100)\r
-DIM SHARED mtlp4(1 TO 50, 1 TO 100)\r
-DIM SHARED mtll(1 TO 50)\r
-DIM SHARED cmtl\r
-\r
-DIM SHARED stkf(1 TO 500)\r
-DIM SHARED stks(1 TO 500)\r
-DIM SHARED stkp, fc, ipath$\r
-\r
-DIM SHARED chc$(1 TO 10, 1 TO 500)\r
-DIM SHARED chcl(1 TO 10)\r
-DIM SHARED chcf$(1 TO 10)\r
-DIM SHARED chct(1 TO 10)\r
-DIM SHARED chctim\r
-DIM SHARED mtmprs\r
-DIM SHARED tmr\r
-\r
-DIM SHARED var$(0 TO 100)\r
-DIM SHARED flag(1 TO 50, 0 TO 9)\r
-DIM SHARED cstatt, cstatm\r
-\r
-\r
-ipath$ = "c:\3dgen\include\" ' include path\r
-\r
-\r
-\r
-start\r
-\r
-IF COMMAND$ = "" THEN END\r
-CLS\r
-\r
-cmd "obj ~" + COMMAND$\r
-qui\r
-CLOSE #res\r
-fil(res) = 0\r
-\r
-PRINT "done"\r
-SYSTEM\r
-\r
-SUB cmd (z$)\r
-a$ = z$\r
-IF LEFT$(a$, 1) = "?" THEN\r
-IF flag(mtmprs, VAL(RIGHT$(LEFT$(a$, 2), 1))) = 1 THEN a$ = RIGHT$(a$, LEN(a$) - 3) ELSE GOTO 10\r
-END IF\r
-getson a$\r
-SELECT CASE sona$(1)\r
-CASE "end"\r
-qui\r
-PRINT "terminated from file"\r
-SYSTEM\r
-\r
-CASE "warn"\r
-COLOR 12\r
-PRINT sona$(2)\r
-COLOR 7\r
-b$ = INPUT$(1)\r
-\r
-CASE "p"\r
-nump = nump + 1\r
-numpa = numpa + 1\r
-x = VAL(sona$(2))\r
-y = VAL(sona$(3))\r
-z = VAL(sona$(4))\r
-\r
-FOR b = stkp TO 1 STEP -1\r
-SELECT CASE stkf(b)\r
-CASE 1\r
-c1 = SIN(stks(b) / fc)\r
-s1 = COS(stks(b) / fc)\r
-z1 = x * c1 + z * s1\r
-x1 = x * s1 - z * c1\r
-x = x1\r
-z = z1\r
-\r
-CASE 2\r
-c1 = SIN(stks(b) / fc)\r
-s1 = COS(stks(b) / fc)\r
-z1 = y * c1 + z * s1\r
-y1 = y * s1 - z * c1\r
-y = y1\r
-z = z1\r
-\r
-CASE 3\r
-s1 = SIN(stks(b) / fc)\r
-c1 = COS(stks(b) / fc)\r
-y1 = y * c1 + x * s1\r
-x1 = y * s1 - x * c1\r
-x = x1\r
-y = y1\r
-\r
-CASE 10\r
-x = x + stks(b)\r
-CASE 11\r
-y = y + stks(b)\r
-CASE 12\r
-z = z + stks(b)\r
-CASE 20\r
-x = x - stks(b)\r
-CASE 21\r
-y = y - stks(b)\r
-CASE 22\r
-z = z - stks(b)\r
-CASE 30\r
-x = x * stks(b)\r
-CASE 31\r
-y = y * stks(b)\r
-CASE 32\r
-z = z * stks(b)\r
-END SELECT\r
-NEXT b\r
-\r
-px(nump) = x\r
-py(nump) = y\r
-pz(nump) = z\r
-IF nump > 900 THEN flushp\r
-\r
-CASE "here"\r
-numpo = numpa\r
-\r
-CASE "mtl"\r
-usemtl sona$(2)\r
-\r
-CASE "mtlrnd"\r
-b = INT(RND * (mitus - 1)) + 2\r
-usemtl sona$(b)\r
-\r
-CASE "f"\r
-IF mtll(cmtl) > 90 THEN flushpoly cmtl\r
-b = mtll(cmtl)\r
-b = b + 1\r
-mtll(cmtl) = b\r
-mtlp1(cmtl, b) = VAL(sona$(2)) + numpo\r
-mtlp2(cmtl, b) = VAL(sona$(3)) + numpo\r
-mtlp3(cmtl, b) = VAL(sona$(4)) + numpo\r
-IF sona$(5) = "" THEN mtlp4(cmtl, b) = -32000 ELSE mtlp4(cmtl, b) = VAL(sona$(5)) + numpo\r
-\r
-CASE "obj"\r
-d = stkp\r
-FOR a = mitus TO 3 STEP -1\r
-b$ = LEFT$(sona$(a), 2)\r
-c = VAL(RIGHT$(sona$(a), LEN(sona$(a)) - 2))\r
-stkp = stkp + 1\r
-stks(stkp) = c\r
-SELECT CASE b$\r
-CASE "xz"\r
-stkf(stkp) = 1\r
-CASE "yz"\r
-stkf(stkp) = 2\r
-CASE "xy"\r
-stkf(stkp) = 3\r
-CASE "x+"\r
-stkf(stkp) = 10\r
-CASE "y+"\r
-stkf(stkp) = 11\r
-CASE "z+"\r
-stkf(stkp) = 12\r
-CASE "x-"\r
-stkf(stkp) = 20\r
-CASE "y-"\r
-stkf(stkp) = 21\r
-CASE "z-"\r
-stkf(stkp) = 22\r
-CASE "x*"\r
-stkf(stkp) = 30\r
-CASE "y*"\r
-stkf(stkp) = 31\r
-CASE "z*"\r
-stkf(stkp) = 32\r
-END SELECT\r
-NEXT a\r
-\r
-a$ = sona$(2)\r
-mtmprs = mtmprs + 1\r
-cstatt = cstatt + 1\r
-LOCATE 10 + mtmprs, 1\r
-PRINT a$\r
-getchc a$, b\r
-c = 1\r
-2\r
-d$ = chc$(b, c)\r
-cmd d$\r
-IF chcf$(b) <> a$ THEN getchc a$, b\r
-c = c + 1\r
-IF c <= chcl(b) THEN GOTO 2\r
-tmr = tmr + 1\r
-IF tmr > 20 THEN tmr = 0: stat\r
-LOCATE 10 + mtmprs, 1\r
-PRINT SPACE$(LEN(a$))\r
-mtmprs = mtmprs - 1\r
-\r
-stkp = d\r
-\r
-CASE "#"\r
-\r
-CASE "out"\r
-geth res\r
-OPEN sona$(2) + ".obj" FOR OUTPUT AS #res\r
-PRINT #res, "mtllib result.mtl"\r
-\r
-CASE "rnd"\r
-b = INT(RND * (mitus - 1)) + 2\r
-c$ = sona$(b)\r
-f$ = ""\r
-FOR d = 1 TO LEN(c$)\r
-e$ = RIGHT$(LEFT$(c$, d), 1)\r
-IF e$ = "^" THEN e$ = " "\r
-f$ = f$ + e$\r
-NEXT d\r
-cmd f$\r
-\r
-CASE "set"\r
-var$(VAL(sona$(2))) = sona$(3)\r
-\r
-CASE "cmp"\r
-IF sona$(3) = sona$(4) THEN b = 1 ELSE b = 0\r
-flag(mtmprs, VAL(sona$(2))) = b\r
-END SELECT\r
-\r
-10\r
-END SUB\r
-\r
-SUB flushp\r
-\r
-FOR a = 1 TO nump\r
-PRINT #res, "v " + STR$(px(a)) + " " + STR$(py(a)) + " " + STR$(-pz(a))\r
-NEXT a\r
-nump = 0\r
-\r
-END SUB\r
-\r
-SUB flushpoly (a)\r
-IF mtll(a) = 0 THEN GOTO 5\r
-\r
-PRINT #res, "usemtl " + mtl$(a)\r
-FOR b = 1 TO mtll(a)\r
-c$ = "f " + STR$(mtlp1(a, b) + 1) + STR$(mtlp2(a, b) + 1) + STR$(mtlp3(a, b) + 1)\r
-IF mtlp4(a, b) <> -32000 THEN c$ = c$ + STR$(mtlp4(a, b) + 1)\r
-PRINT #res, c$\r
-NEXT b\r
-mtll(a) = 0\r
-\r
-5\r
-END SUB\r
-\r
-SUB getchc (a$, b)\r
-'DIM SHARED cstatt, cstatm\r
-FOR c = 1 TO 10\r
-IF chcf$(c) = a$ THEN b = c: GOTO 6\r
-NEXT c\r
-\r
-d = 32000\r
-FOR c = 1 TO 10\r
-IF chct(c) < d THEN d = chct(c): e = c\r
-NEXT c\r
-g = 0\r
-geth f\r
-'PRINT "file " + a$ + " loaded"\r
-cstatm = cstatm + 1\r
-b$ = a$\r
-IF LEFT$(b$, 1) = "~" THEN b$ = RIGHT$(b$, LEN(b$) - 1) ELSE b$ = ipath$ + b$\r
-OPEN b$ + ".3d" FOR INPUT AS #f\r
-8\r
-IF EOF(f) <> 0 THEN GOTO 7\r
-LINE INPUT #f, c$\r
-IF (LEFT$(c$, 1) <> "#") AND (c$ <> SPACE$(LEN(c$))) THEN g = g + 1: chc$(e, g) = c$\r
-GOTO 8\r
-7\r
-CLOSE #f\r
-fil(f) = 0\r
-chcl(e) = g\r
-b = e\r
-chcf$(e) = a$\r
-stat\r
-6\r
-chctim = chctim + 1\r
-chct(b) = chctim\r
-\r
-IF chctim > 10000 THEN\r
-FOR c = 1 TO 10\r
-chct(c) = chct(c) / 2\r
-NEXT c\r
-chctim = chctim / 2\r
-END IF\r
-END SUB\r
-\r
-SUB geth (b)\r
-\r
-FOR a = 1 TO 100\r
-IF fil(a) = 0 THEN fil(a) = 1: b = a: GOTO 1\r
-NEXT a\r
-1\r
-'PRINT "handle ", b, " allocated"\r
-\r
-END SUB\r
-\r
-SUB getson (a$)\r
-b$ = a$ + " "\r
-\r
-FOR a = 1 TO 20\r
-sona$(a) = ""\r
-NEXT a\r
-\r
-mitus = 0\r
-e = 1\r
-FOR c = 1 TO LEN(b$)\r
-d$ = RIGHT$(LEFT$(b$, c), 1)\r
-IF d$ = " " OR d$ = CHR$(9) THEN\r
-e = 1\r
-ELSE\r
-IF e = 1 THEN mitus = mitus + 1\r
-sona$(mitus) = sona$(mitus) + d$\r
-e = 0\r
-END IF\r
-NEXT c\r
-\r
-FOR c = 1 TO mitus\r
-IF LEFT$(sona$(c), 1) = "%" THEN\r
-sona$(c) = var$(VAL(RIGHT$(sona$(c), LEN(sona$(c)) - 1)))\r
-END IF\r
-NEXT c\r
-END SUB\r
-\r
-SUB qui\r
-\r
-flushp\r
-FOR a = 1 TO mtlm\r
-flushpoly a\r
-NEXT a\r
-stat\r
-END SUB\r
-\r
-SUB start\r
-RANDOMIZE TIMER\r
-\r
-FOR a = 1 TO 50\r
-FOR b = 0 TO 9\r
-flag(a, b) = 0\r
-NEXT b\r
-NEXT a\r
-\r
-FOR a = 0 TO 100\r
-var$(a) = ""\r
-NEXT a\r
-\r
-FOR a = 1 TO 10\r
-FOR b = 1 TO 500\r
-chc$(a, b) = ""\r
-NEXT b\r
-chcl(a) = 0\r
-chcf$(a) = ""\r
-chct(a) = 0\r
-NEXT a\r
-\r
-FOR a = 1 TO 50\r
-mtll(a) = 0\r
-NEXT a\r
-\r
-FOR a = 1 TO 100\r
-fil(a) = 0\r
-NEXT a\r
-nump = 0\r
-numpa = 0\r
-numpo = 0\r
-mtlm = 0\r
-stkp = 0\r
-fc = 180 / 3.141285\r
-chctim = 0\r
-mtmprs = 0\r
-cstatt = 0\r
-cstatm = 0\r
-END SUB\r
-\r
-SUB stat\r
-LOCATE 1, 1\r
-FOR a = 1 TO 10\r
-PRINT a, chcf$(a), chct(a), chcl(a)\r
-NEXT a\r
-COLOR 10\r
-LOCATE 1, 50\r
-PRINT cstatt; "parsed"\r
-LOCATE 2, 50\r
-PRINT cstatm; "chache miss"\r
-LOCATE 3, 50\r
-PRINT INT(cstatm / cstatt * 100); "% chache miss "\r
-\r
-COLOR 7\r
-\r
-END SUB\r
-\r
-SUB stat2 (b)\r
-CLS\r
-FOR a = 1 TO chcl(b)\r
-PRINT chc$(b, a)\r
-NEXT a\r
-\r
-c$ = INPUT$(1)\r
-END SUB\r
-\r
-SUB usemtl (a$)\r
-FOR b = 1 TO mtlm\r
-IF mtl$(b) = a$ THEN cmtl = b: GOTO 4\r
-NEXT b\r
-\r
-mtlm = mtlm + 1\r
-mtl$(mtlm) = a$\r
-cmtl = mtlm\r
-4\r
-END SUB\r
-\r
projects / qbasicapps.git / blobdiff