'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.
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$
'***************************************************************************
'***if you get a "subscript out of range" error increase this variable.****
nodes = 1000
'***if you get a "subscript out of range" error increase this variable.****
'***************************************************************************
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                 
CLS
SCREEN 12
mouseshow
plotit
drawit

SUB drawit
DIM fs(1 TO nodes)
DIM f(1 TO nodes)
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 * 2
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), 2
NEXT rt%
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
  'This sub used for demo, not needed for mouse calls
  PRINT "Press any key to continue..."
  G$ = INPUT$(1)
  PRINT
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
GOTO loops
dones:
num = yu%
END SUB

