1: DECLARE SUB PlyBck () 2: 'Hello If you find this program usefull please let me know. I'm a 13 year old 3: 'That lives in AZ, I didn't see any kind of 3d Qbasic modler out there so 4: 'here one is. I am trying to get shading, but that is incredibly difficult. 5: 'If anyone out there does it before me please send me your Qbasic program. 6: 'I would like to see how you did it. My AOL address is Coyles, or 7: 'for you non-AOLers its coyles@AOL.com. I would really like so feedback. 8: ' THNX for reading. 9: '=========================================================================== 10: 'Edited by Roy Keene(RKeene12@Aol.com) & James Lampton for better coloring & 11: 'the saving/playback function. 12: '*************************************************************************** 13: DECLARE SUB DrawIt () 14: DECLARE SUB PlotIt () 15: DECLARE SUB ms () 16: DECLARE SUB PAUSE () 17: DECLARE SUB mousestatus (lb%, rb%, XMouse%, YMouse%) 18: DECLARE SUB MouseRange (x1%, y1%, x2%, y2%) 19: DECLARE SUB MousePut (x%, y%) 20: DECLARE SUB MouseHide () 21: DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%) 22: DECLARE SUB MouseShow () 23: DECLARE FUNCTION MouseInit% () 24: COMMON SHARED NODES 25: COMMON SHARED nx, ny, num 26: DIM SHARED Mouse$ 27: NODES = 2000 28: DIM SHARED nx(1 TO NODES) 29: DIM SHARED ny(1 TO NODES) 30: TYPE sammy 31: x AS INTEGER 32: y AS INTEGER 33: END TYPE 34: Mouse$ = SPACE$(57) 35: FOR i% = 1 TO 57 36: READ a$ 37: H$ = CHR$(VAL("&H" + a$)) 38: MID$(Mouse$, i%, 1) = H$ 39: NEXT i% 40: DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B 41: DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53 42: DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F 43: DATA 8B,5E,06,89,17,5D,CA,08,00 44: 10 CLS 45: SCREEN 12 46: DIM SHARED file$ 47: 1 LOCATE 1, 1: LINE INPUT "Metafilename-->"; file$ 48: file$ = UCASE$(LTRIM$(RTRIM$(file$))) 49: IF file$ = "" THEN file$ = "title.3d" 50: IF file$ = "Q" THEN END 51: OPEN file$ FOR RANDOM AS #1 LEN = NODES 52: IF LOF(1) = 0 THEN GOTO 121 ELSE PRINT file$; " exist!": INPUT "(O)verrite or (P)lay"; OOP$: IF LEFT$(OOP$, 1) = "o" OR LEFT$(OOP$, 1) = "O" GOTO 121 ELSE PlyBck: END 53: 121 CLOSE 1: KILL file$: OPEN file$ FOR RANDOM AS #1 LEN = NODES 54: MouseShow 55: PlotIt 56: DrawIt 57: PAUSE 58: 59: SUB DrawIt 60: DIM fs(1 TO NODES) 61: DIM f(1 TO NODES) 62: MouseHide 63: CLS 64: steps = 20 65: FOR gh% = 1 TO num 66: fs(gh%) = ny(gh%) / steps 67: NEXT gh% 68: 'PRINT f1; f2; f3; f4; f5; f6 69: FOR fi% = 1 TO steps * 1.75 70: FOR gh% = 1 TO num 71: f(gh%) = f(gh%) + fs(gh%) 72: NEXT gh% 73: FOR rt% = 1 TO num - 1 74: Tx = nx(rt%): ty = (240 - ny(rt%)) + f(rt%) 75: tx2 = nx(rt% + 1): ty2 = (240 - ny(rt%)) + f(rt%) 76: LINE (Tx, ty)-(tx2, ty2), CINT(Tx + Tx - (ty2 + tx2) / 1 + 70) 77: NEXT rt% 78: CLS 79: NEXT fi% 80: END SUB 81: 82: SUB MouseDriver (ax%, bx%, cx%, dx%) 83: DEF SEG = VARSEG(Mouse$) 84: Mouse% = SADD(Mouse$) 85: CALL Absolute(ax%, bx%, cx%, dx%, Mouse%) 86: END SUB 87: 88: SUB MouseHide 89: ax% = 2 90: MouseDriver ax%, 0, 0, 0 91: END SUB 92: 93: FUNCTION MouseInit% 94: ax% = 0 95: MouseDriver ax%, 0, 0, 0 96: MouseInit% = ax% 97: END FUNCTION 98: 99: SUB MousePut (x%, y%) 100: ax% = 4 101: cx% = x% 102: dx% = y% 103: MouseDriver ax%, 0, cx%, dx% 104: END SUB 105: 106: SUB MouseRange (x1%, y1%, x2%, y2%) 107: ax% = 7 108: cx% = x1% 109: dx% = x2% 110: MouseDriver ax%, 0, cx%, dx% 111: ax% = 8 112: cx% = y1% 113: dx% = y2% 114: MouseDriver ax%, 0, cx%, dx% 115: END SUB 116: 117: SUB MouseShow 118: ax% = 1 119: MouseDriver ax%, 0, 0, 0 120: END SUB 121: 122: SUB mousestatus (lb%, rb%, XMouse%, YMouse%) 123: ax% = 3 124: MouseDriver ax%, bx%, cx%, dx% 125: lb% = ((bx% AND 1) <> 0) 126: rb% = ((bx% AND 2) <> 0) 127: XMouse% = cx% 128: YMouse% = dx% 129: END SUB 130: 131: SUB PAUSE 132: 11 mousestatus lb%, rb%, x%, y% 133: IF lb% = 0 AND rb% = 0 AND INKEY$ = "" THEN GOTO 11 ELSE lb% = 0: rb% = 0: EXIT SUB 134: END SUB 135: 136: SUB PlotIt 137: CLS : SCREEN 12 138: MouseRange 0, 240, 640, 480 139: loops: 140: FOR yi = 1 TO 100 STEP .6: NEXT yi 141: DO 142: mousestatus lb%, rb%, x%, y% 143: IF lb% = -1 THEN GOTO spoint 144: IF rb% = -1 THEN GOTO dones 145: LOOP 146: spoint: 147: yu% = yu% + 1 148: nx(yu%) = x%: ny(yu%) = 480 - y% 149: CIRCLE (x%, y%), 2 150: PRINT #1, x%, y% 151: GOTO loops 152: dones: 153: num = yu% 154: CLOSE 1 155: END SUB 156: 157: SUB PlyBck 158: CLOSE 1 159: OPEN file$ FOR RANDOM AS 1 160: MouseRange 0, 240, 640, 480 161: CLS : SCREEN 12 162: LOCATE 1, 1: PRINT "Loading & Decoding..." 163: lops: 164: 'FOR yi = 1 TO 100 STEP .6: NEXT yi 165: DO 166: IF nd% = 1 THEN GOTO dnes 167: GOTO pute 168: LOOP 169: pute: 170: yu% = yu% + 1 171: IF EOF(1) THEN nd% = 1 ELSE INPUT #1, x%, y% 172: nx(yu%) = x%: ny(yu%) = 480 - y% 173: CIRCLE (x%, y%), 1, 2 174: GOTO lops 175: dnes: 176: num = yu% 177: CLOSE 1 178: LOCATE 1, 1: PRINT " " 179: DrawIt 180: END SUB 181: |