-' by Svjatoslav Agejenko\r
-' homeage: http://svjatoslav.eu\r
-' e-mail: svjatoslav@svjatoslav.eu\r
+' Program that parses special programmable 3D scene description language\r
+' and generates from it 3D objects in Wavefront .obj format.\r
+' By Svjatoslav Agejenko.\r
+' Email: svjatoslav@svjatoslav.eu\r
+' Homepage: http://www.svjatoslav.eu\r
+'\r
+' Changelog:\r
+' ?, Initial version\r
+' 2024, Improved program readability using AI\r
\r
' Before running, make sure include path is correct. See below.\r
\r
DECLARE SUB geth (b!)\r
DECLARE SUB cmd (a$)\r
DECLARE SUB getson (a$)\r
+\r
DIM SHARED px(1 TO 1000)\r
DIM SHARED py(1 TO 1000)\r
DIM SHARED pz(1 TO 1000)\r
\r
DIM SHARED stkf(1 TO 500)\r
DIM SHARED stks(1 TO 500)\r
-DIM SHARED stkp, fc, ipath$\r
+DIM SHARED stkp\r
+DIM SHARED fc\r
+DIM SHARED ipath$\r
\r
DIM SHARED chc$(1 TO 10, 1 TO 500)\r
DIM SHARED chcl(1 TO 10)\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
+DIM SHARED cstatt\r
+DIM SHARED cstatm\r
\r
+' Path to include resources from. Adjust according to your installation!\r
+ipath$ = "C:\GRAPHICS\3D\3DSYNT~1\INCLUDE\"\r
\r
start\r
\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
+ a$ = z$\r
+ IF LEFT$(a$, 1) = "?" THEN\r
+ IF flag(mtmprs, VAL(RIGHT$(LEFT$(a$, 2), 1))) = 1 THEN\r
+ a$ = RIGHT$(a$, LEN(a$) - 3)\r
+ ELSE\r
+ GOTO 10\r
+ END IF\r
+ END IF\r
+\r
+ getson a$\r
+\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
+ ' Transform the coordinates based on the stack\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
+\r
+ CASE 11\r
+ y = y + stks(b)\r
+\r
+ CASE 12\r
+ z = z + stks(b)\r
+\r
+ CASE 20\r
+ x = x - stks(b)\r
+\r
+ CASE 21\r
+ y = y - stks(b)\r
+\r
+ CASE 22\r
+ z = z - stks(b)\r
+\r
+ CASE 30\r
+ x = x * stks(b)\r
+\r
+ CASE 31\r
+ y = y * stks(b)\r
+\r
+ CASE 32\r
+ z = z * stks(b)\r
+ END SELECT\r
+ NEXT b\r
+\r
+ ' Store the transformed coordinates\r
+ px(nump) = x\r
+ py(nump) = y\r
+ pz(nump) = z\r
+\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
+\r
+ ' Handle the optional fourth vertex\r
+ IF sona$(5) = "" THEN\r
+ mtlp4(cmtl, b) = -32000\r
+ ELSE\r
+ mtlp4(cmtl, b) = VAL(sona$(5)) + numpo\r
+ END IF\r
+\r
+ CASE "obj"\r
+ d = stkp\r
+\r
+ ' Parse the transformation stack\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
+\r
+ SELECT CASE b$\r
+ CASE "xz"\r
+ stkf(stkp) = 1\r
+\r
+ CASE "yz"\r
+ stkf(stkp) = 2\r
+\r
+ CASE "xy"\r
+ stkf(stkp) = 3\r
+\r
+ CASE "x+"\r
+ stkf(stkp) = 10\r
+\r
+ CASE "y+"\r
+ stkf(stkp) = 11\r
+\r
+ CASE "z+"\r
+ stkf(stkp) = 12\r
+\r
+ CASE "x-"\r
+ stkf(stkp) = 20\r
+\r
+ CASE "y-"\r
+ stkf(stkp) = 21\r
+\r
+ CASE "z-"\r
+ stkf(stkp) = 22\r
+\r
+ CASE "x*"\r
+ stkf(stkp) = 30\r
+\r
+ CASE "y*"\r
+ stkf(stkp) = 31\r
+\r
+ CASE "z*"\r
+ stkf(stkp) = 32\r
+ END SELECT\r
+ NEXT a\r
+\r
+ ' Process the object command\r
+ a$ = sona$(2)\r
+ mtmprs = mtmprs + 1\r
+ cstatt = cstatt + 1\r
+\r
+ LOCATE 10 + mtmprs, 1\r
+ PRINT a$\r
+\r
+ ' Read and execute the next command\r
+ getchc a$, b\r
+ c = 1\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
+ d$ = chc$(b, c)\r
+ cmd d$\r
+\r
+ ' Check if the current command matches the expected one\r
+ IF chcf$(b) <> a$ THEN\r
+ getchc a$, b\r
+ END IF\r
+\r
+ c = c + 1\r
+\r
+ ' Continue reading and executing commands until the stack is empty\r
+ IF c <= chcl(b) THEN GOTO 2\r
+\r
+ tmr = tmr + 1\r
+\r
+ ' If more than 20 commands have been processed, update statistics\r
+ IF tmr > 20 THEN\r
+ tmr = 0\r
+ stat\r
+ END IF\r
+\r
+ LOCATE 10 + mtmprs, 1\r
+ PRINT SPACE$(LEN(a$))\r
+\r
+ ' Decrement the command parser stack\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
+\r
+ ' Replace caret characters with spaces\r
+ f$ = ""\r
+ FOR d = 1 TO LEN(c$)\r
+ e$ = RIGHT$(LEFT$(c$, d), 1)\r
+ IF e$ = "^" THEN\r
+ e$ = " "\r
+ END IF\r
+ f$ = f$ + e$\r
+ NEXT d\r
+\r
+ cmd f$\r
+\r
+ CASE "set"\r
+ var$(VAL(sona$(2))) = sona$(3)\r
+\r
+ CASE "cmp"\r
+ ' Compare two strings\r
+ IF sona$(3) = sona$(4) THEN\r
+ b = 1\r
+ ELSE\r
+ b = 0\r
+ END IF\r
+\r
+ ' Store the comparison result in the flag array\r
+ flag(mtmprs, VAL(sona$(2))) = b\r
+\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
+ FOR a = 1 TO nump\r
+ PRINT #res, "v " + STR$(px(a)) + " " + STR$(py(a)) + " " + STR$(-pz(a))\r
+ NEXT a\r
+\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
+ IF mtll(a) = 0 THEN GOTO 5\r
+\r
+ ' Write the material usage line\r
+ PRINT #res, "usemtl " + mtl$(a)\r
+\r
+ ' Write the face definitions\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
+\r
+ ' Handle the optional fourth vertex\r
+ IF mtlp4(a, b) <> -32000 THEN\r
+ c$ = c$ + STR$(mtlp4(a, b) + 1)\r
+ END IF\r
+\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
+SUB getchc (a$, b!)\r
+\r
+ ' Search for the command in the cache\r
+ FOR c = 1 TO 10\r
+ IF chcf$(c) = a$ THEN\r
+ b = c\r
+ GOTO 6\r
+ END IF\r
+ NEXT c\r
+\r
+ ' Find the least recently used entry in the cache\r
+ d = 32000\r
+ FOR c = 1 TO 10\r
+ IF chct(c) < d THEN\r
+ d = chct(c)\r
+ e = c\r
+ END IF\r
+ NEXT c\r
+\r
+ ' Load the command file\r
+ g = 0\r
+ geth f\r
+\r
+ cstatm = cstatm + 1\r
+ b$ = a$\r
+\r
+ ' Remove leading tilde if present\r
+ IF LEFT$(b$, 1) = "~" THEN\r
+ b$ = RIGHT$(b$, LEN(b$) - 1)\r
+ ELSE\r
+ b$ = ipath$ + b$\r
+ END IF\r
+\r
+ \r
+ PRINT "File:" + b$\r
+ OPEN b$ + ".3d" FOR INPUT AS #f\r
+\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
+\r
+ ' Read commands from the file until EOF\r
+ IF EOF(f) <> 0 THEN GOTO 7\r
+\r
+ LINE INPUT #f, c$\r
+\r
+ ' Skip empty lines\r
+ IF (LEFT$(c$, 1) <> "#") AND (c$ <> SPACE$(LEN(c$))) THEN\r
+ g = g + 1\r
+ chc$(e, g) = c$\r
+ END IF\r
+\r
+ GOTO 8\r
+\r
7\r
-CLOSE #f\r
-fil(f) = 0\r
-chcl(e) = g\r
-b = e\r
-chcf$(e) = a$\r
-stat\r
+\r
+ ' Close the file and update statistics\r
+ CLOSE #f\r
+ fil(f) = 0\r
+ chcl(e) = g\r
+\r
+ b = e\r
+ chcf$(e) = a$\r
+\r
+ stat\r
+\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
+\r
+ ' Update the cache timestamps\r
+ chctim = chctim + 1\r
+ chct(b) = chctim\r
+\r
+ ' If the cache is full, halve all timestamps\r
+ IF chctim > 10000 THEN\r
+ FOR c = 1 TO 10\r
+ chct(c) = chct(c) / 2\r
+ NEXT c\r
+\r
+ chctim = chctim / 2\r
+ END IF\r
END SUB\r
\r
-SUB geth (b)\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
+ ' Find an unused file handle\r
+ FOR a = 1 TO 100\r
+ IF fil(a) = 0 THEN\r
+ fil(a) = 1\r
+ b = a\r
+ GOTO 1\r
+ END IF\r
+ NEXT a\r
\r
+1\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
+\r
+ ' Prepare the sona array for parsing\r
+ b$ = a$ + " "\r
+\r
+ FOR a = 1 TO 20\r
+ sona$(a) = ""\r
+ NEXT a\r
+\r
+ mitus = 0\r
+\r
+ e = 1\r
+\r
+ ' Parse the input string\r
+ FOR c = 1 TO LEN(b$)\r
+ d$ = RIGHT$(LEFT$(b$, c), 1)\r
+\r
+ IF d$ = " " OR d$ = CHR$(9) THEN\r
+ e = 1\r
+ ELSE\r
+ IF e = 1 THEN\r
+ mitus = mitus + 1\r
+ END IF\r
+\r
+ sona$(mitus) = sona$(mitus) + d$\r
+ e = 0\r
+ END IF\r
+ NEXT c\r
+\r
+ ' Replace variable names with their values\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
+ ' Flush the vertex buffer and write all polygons\r
+ flushp\r
+\r
+ FOR a = 1 TO mtlm\r
+ flushpoly a\r
+ NEXT a\r
+\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
+\r
+ RANDOMIZE TIMER\r
+\r
+ ' Initialize arrays\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
+ ' Initialize command cache\r
+ FOR a = 1 TO 10\r
+ FOR b = 1 TO 500\r
+ chc$(a, b) = ""\r
+ NEXT b\r
+\r
+ chcl(a) = 0\r
+ chcf$(a) = ""\r
+ chct(a) = 0\r
+ NEXT a\r
+\r
+ ' Initialize material lists\r
+ FOR a = 1 TO 50\r
+ mtll(a) = 0\r
+ NEXT a\r
+\r
+ ' Initialize file handles\r
+ FOR a = 1 TO 100\r
+ fil(a) = 0\r
+ NEXT a\r
+\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
+ ' Display statistics\r
+ LOCATE 1, 1\r
+\r
+ FOR a = 1 TO 10\r
+ PRINT a, chcf$(a), chct(a), chcl(a)\r
+ NEXT a\r
+\r
+ COLOR 10\r
+\r
+ LOCATE 1, 50\r
+ PRINT cstatt; "parsed"\r
+\r
+ LOCATE 2, 50\r
+ PRINT cstatm; "cache miss"\r
+\r
+ LOCATE 3, 50\r
+ PRINT INT(cstatm / cstatt * 100); "% cache miss "\r
+\r
+ COLOR 7\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
+SUB stat2 (b!)\r
\r
-c$ = INPUT$(1)\r
+ ' Display the contents of a specific command cache\r
+ CLS\r
+\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
+ ' Find the material in the list\r
+ FOR b = 1 TO mtlm\r
+ IF mtl$(b) = a$ THEN\r
+ cmtl = b\r
+ GOTO 4\r
+ END IF\r
+ NEXT b\r
+\r
+ ' If not found, add it to the list\r
+ mtlm = mtlm + 1\r
+ mtl$(mtlm) = a$\r
+ cmtl = mtlm\r
+\r
4\r
END SUB\r
\r
projects / qbasicapps.git / commitdiff