X-Git-Url: http://www2.svjatoslav.eu/gitweb/?p=qbasicapps.git;a=blobdiff_plain;f=graphics%2F3D%2F3D%20Synthezier%2Fbin%2F3dparse.bas;fp=graphics%2F3D%2F3D%20Synthezier%2Fbin%2F3dparse.bas;h=0f6c09a172aef34ff9a6ec5032d60f87a4a47082;hp=0000000000000000000000000000000000000000;hb=c6aaa433dedff2dd8063983c7716c0cdb296a0f9;hpb=3779e9035f2c67e36111585e10d956a3e9e3c0fa

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