DECLARE SUB PlyBck ()
'Hello If you find this program usefull please let me know. I'm a 13 year old
'That lives in AZ, I didn't see any kind of 3d Qbasic modler out there so
'here one is. I am trying to get shading, but that is incredibly difficult.
'If anyone out there does it before me please send me your Qbasic program.
'I would like to see how you did it. My AOL address is Coyles, or
'for you non-AOLers its coyles@AOL.com. I would really like so feedback.
'   THNX for reading.
'===========================================================================
'Edited by Roy Keene(RKeene12@Aol.com) & James Lampton for better coloring &
'the saving/playback function.
'***************************************************************************
DECLARE SUB DrawIt ()
DECLARE SUB PlotIt ()
DECLARE SUB ms ()
DECLARE SUB PAUSE ()
DECLARE SUB mousestatus (lb%, rb%, XMouse%, YMouse%)
DECLARE SUB MouseRange (x1%, y1%, x2%, y2%)
DECLARE SUB MousePut (x%, y%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB MouseShow ()
DECLARE FUNCTION MouseInit% ()
COMMON SHARED NODES
COMMON SHARED nx, ny, num
DIM SHARED Mouse$
NODES = 2000
DIM SHARED nx(1 TO NODES)
DIM SHARED ny(1 TO NODES)
TYPE sammy
x AS INTEGER
y AS INTEGER
END TYPE
Mouse$ = SPACE$(57)
FOR i% = 1 TO 57
  READ a$
  H$ = CHR$(VAL("&H" + a$))
  MID$(Mouse$, i%, 1) = H$
NEXT i%
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00 
10 CLS
SCREEN 12
DIM SHARED file$
1 LOCATE 1, 1: LINE INPUT "Metafilename-->"; file$
file$ = UCASE$(LTRIM$(RTRIM$(file$)))
IF file$ = "" THEN file$ = "title.3d"
IF file$ = "Q" THEN END
OPEN file$ FOR RANDOM AS #1 LEN = NODES
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
121 CLOSE 1: KILL file$: OPEN file$ FOR RANDOM AS #1 LEN = NODES
MouseShow
PlotIt
DrawIt
PAUSE

SUB DrawIt
DIM fs(1 TO NODES)
DIM f(1 TO NODES)
MouseHide
CLS
steps = 20
FOR gh% = 1 TO num
fs(gh%) = ny(gh%) / steps
NEXT gh%
'PRINT f1; f2; f3; f4; f5; f6
FOR fi% = 1 TO steps * 1.75
FOR gh% = 1 TO num
f(gh%) = f(gh%) + fs(gh%)
NEXT gh%
FOR rt% = 1 TO num - 1
Tx = nx(rt%): ty = (240 - ny(rt%)) + f(rt%)
tx2 = nx(rt% + 1): ty2 = (240 - ny(rt%)) + f(rt%)
LINE (Tx, ty)-(tx2, ty2), CINT(Tx + Tx - (ty2 + tx2) / 1 + 70)
NEXT rt%
CLS
NEXT fi%
END SUB

SUB MouseDriver (ax%, bx%, cx%, dx%)
  DEF SEG = VARSEG(Mouse$)
  Mouse% = SADD(Mouse$)
  CALL Absolute(ax%, bx%, cx%, dx%, Mouse%)
END SUB

SUB MouseHide
 ax% = 2
 MouseDriver ax%, 0, 0, 0
END SUB

FUNCTION MouseInit%
  ax% = 0
  MouseDriver ax%, 0, 0, 0
  MouseInit% = ax%
END FUNCTION

SUB MousePut (x%, y%)
  ax% = 4
  cx% = x%
  dx% = y%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseRange (x1%, y1%, x2%, y2%)
  ax% = 7
  cx% = x1%
  dx% = x2%
  MouseDriver ax%, 0, cx%, dx%
  ax% = 8
  cx% = y1%
  dx% = y2%
  MouseDriver ax%, 0, cx%, dx%
END SUB

SUB MouseShow
  ax% = 1
  MouseDriver ax%, 0, 0, 0
END SUB

SUB mousestatus (lb%, rb%, XMouse%, YMouse%)
  ax% = 3
  MouseDriver ax%, bx%, cx%, dx%
  lb% = ((bx% AND 1) <> 0)
  rb% = ((bx% AND 2) <> 0)
  XMouse% = cx%
  YMouse% = dx%
END SUB

SUB PAUSE
11 mousestatus lb%, rb%, x%, y%
IF lb% = 0 AND rb% = 0 AND INKEY$ = "" THEN GOTO 11 ELSE lb% = 0: rb% = 0: EXIT SUB
END SUB

SUB PlotIt
CLS : SCREEN 12
MouseRange 0, 240, 640, 480
loops:
FOR yi = 1 TO 100 STEP .6: NEXT yi
DO
mousestatus lb%, rb%, x%, y%
IF lb% = -1 THEN GOTO spoint
IF rb% = -1 THEN GOTO dones
LOOP
spoint:
yu% = yu% + 1
nx(yu%) = x%: ny(yu%) = 480 - y%
CIRCLE (x%, y%), 2
PRINT #1, x%, y%
GOTO loops
dones:
num = yu%
CLOSE 1
END SUB

SUB PlyBck
CLOSE 1
OPEN file$ FOR RANDOM AS 1
MouseRange 0, 240, 640, 480
CLS : SCREEN 12
LOCATE 1, 1: PRINT "Loading & Decoding..."
lops:
'FOR yi = 1 TO 100 STEP .6: NEXT yi
DO
IF nd% = 1 THEN GOTO dnes
GOTO pute
LOOP
pute:
yu% = yu% + 1
IF EOF(1) THEN nd% = 1 ELSE INPUT #1, x%, y%
nx(yu%) = x%: ny(yu%) = 480 - y%
CIRCLE (x%, y%), 1, 2
GOTO lops
dnes:
num = yu%
CLOSE 1
LOCATE 1, 1: PRINT "                    "
DrawIt
END SUB