'===========================================================================
' Subject: Detect if a disk drive is ready    Date: 09-15-02 (  :  )       
'  Author: Antoni Gual                        Code: QB, Qbasic, PDS        
'  Origin: agual@eic.ictnet.es              Packet: DISK.ABC
'===========================================================================
DECLARE FUNCTION Driveready% (d$)
DECLARE FUNCTION mouseint% (func%, c%, r%)
DECLARE FUNCTION MFilesel$ ()
'$INCLUDE: 'QB.BI'
DEFINT A-Z
A$ = MFilesel$
PRINT "File: "; A$; " selected"
END
fileselerr: errata% = ERR: RESUME NEXT

FUNCTION Driveready% (d$)
'Check if a disk is ready.
'by Antoni Gual 9/2002 agual@eic.ictnet.es
' 53 if disk is ready
' 71 if disk exists but is not ready
' 76 if disk is not ready
' 64 if disk letter is out of range
' 0  if disk is ready but is an audio CD!
'you need to setup this error handler at the end of the main module:
'fileselerr: errata% = ERR: RESUME NEXT
'--------------------------------------------------------------------
 SHARED errata%
 'If disk B is disabled, don't check for it!
 IF d$ = "B:" THEN
   OUT &H70, &H10: IF (INP(&H71) AND 7) = 0 THEN Driveready% = 64: EXIT FUNCTION
 END IF
 ON ERROR GOTO fileselerr
 F% = FREEFILE
 OPEN d$ + "\track01.cda" FOR INPUT AS F%
 IF errata% = 0 THEN CLOSE F%
 Driveready% = errata%
 errata% = 0
 ON ERROR GOTO 0
END FUNCTION

FUNCTION MFilesel$
'returns file selected by user
'by Antoni Gual 9/2002 agual@eic.ictnet.es
'uses :
' my all-in-one mouse function or any mouse function returning cursor pos in text lines and cols
' Driveready function
'--------------------------------------------------------
SHARED errata
'create a string with all available drivers
aa$ = " "
FOR i = 65 TO 90
 B$ = CHR$(i) + ":"
 SELECT CASE Driveready(B$)
  CASE 53, 71, 0: aa$ = aa$ + B$ + "  "
  CASE 64, 76:
  CASE ELSE: STOP
 END SELECT
NEXT
SCREEN 0: WIDTH 80, 50: CLS
'selection loop
DO
 fil$ = ""
 'refresh directory display
 COLOR 7, 0:
 CLS
 'format screen
 SHELL ("dir *.bas  /z/w")
 'get last line with directory entries
 bttm = CSRLIN - 2
 COLOR 7, 12:
 LOCATE 5, 1: PRINT SPACE$(80); : LOCATE , 1: PRINT aa$ + "--CANCEL--";
 LOCATE 1, 1: PRINT SPACE$(80); : LOCATE , 1: PRINT "Select drive, dir or file";
   
 'get mouse running
 dummy = mouseint(0, 0, 0)
 dummy = mouseint(1, 0, 0)
 'get the word in screen the  user has  clicked
 DO
   DO
	 click = mouseint(3, c, r)
	 IF LEN(INKEY$) THEN dummy = mouseint(2, 0, 0): EXIT FUNCTION
   LOOP UNTIL click
   'returns only words in a certain area
   IF SCREEN(r, c) <> 32 AND r < bttm AND r > 4 THEN
	 B$ = "": C1 = c
	 DO
	   A = SCREEN(r, C1): B$ = B$ + CHR$(A): C1 = C1 + 1:
	 LOOP UNTIL A = 32 OR C1 = 80
	 IF c > 1 THEN
	   C1 = c - 1
	   DO
		 A = SCREEN(r, C1): B$ = CHR$(A) + B$: C1 = C1 - 1
	   LOOP UNTIL A = 32 OR C1 = 0
	 END IF
	 B$ = LTRIM$(RTRIM$(B$))
   END IF
 LOOP UNTIL LEN(B$)
   
 'depending on the word clicked
 SELECT CASE LCASE$(B$)
 CASE "[..]": SHELL "cd.."
 CASE "a:", "b:", "c:", "d:", "e:", "f:", "g:", "h:", "i:", "j:", "k:", "l:", "m:", "n:", "o:", "p:", "q:", "r:", "s:", "t:", "u:", "v:", "x:", "y:", "z:"
   DO
	 A% = Driveready%(B$)
	 SELECT CASE A%
	 CASE 53: SHELL B$: EXIT DO
	 CASE 71, 0: LOCATE 1, 60: INPUT "Retry/Abort"; c$:
	   IF UCASE$(c$) = "A" THEN : LOCATE 1, 60: PRINT SPACE$(20); : EXIT DO
	 CASE ELSE: STOP
	 END SELECT
   LOOP
 CASE "--cancel--":
   dummy = mouseint(2, 0, 0): EXIT DO
 CASE ELSE
   IF LEFT$(B$, 1) = "[" AND RIGHT$(B$, 1) = "]" THEN
	 SHELL "cd " + MID$(B$, 2, LEN(B$) - 2)
   ELSE
	 fil$ = B$
	 END IF
   END SELECT
   dummy = mouseint(2, 0, 0)
LOOP UNTIL LEN(fil$)
MFilesel$ = fil$
COLOR 7, 0: CLS
END FUNCTION

FUNCTION mouseint% (func%, c%, r%) STATIC
'---------------------------------------------------------------------------'
'QBASIC MOUSE ROUTINE BY ANTONI GUAL agual@eic.ictnet.es            
'Needs only 'Include QB.BI' in the main module
'Can work with user (integer) scaling and offset or automatic scaling
'---------------------------------------------------------------------------'
'DOS Mouse Interrupt requires first call to be to Func 0 (mouse init)
' You should call also Func 0 after changing screen mode!
'Functions implemented:                       
'   Func%=-2  C%=Hoffset factor R%=Voffset factor. Sets user's offsets factors
'
'   Func%=-1  C%=Hscale factor  R%=Vscale factor.  Sets user's scale factors
'
'   Func%=0   Mouse init.  Mouseint returns 0 if mouse not present
'             If called with c%=-1 does'nt change user scale factors
'             if called with c%=0  sets scale factors matching text positions
'             if called with c%=SCREEN mode sets scale factors for graph mode
'
'   Func%=1   Show Cursor. No params taken.Returns nothing                                  '
'
'   Func%=2   Hide Cursor. no params taken.Returns nothing.                                 '
'             (You should hide cursor before writing or drawing to the screen)       '
'
'   Func%=3   Get status. Returns coords of the cursor in c% r% and
'               button status in the function name
'               Mouseint AND 1 => left button pressed
'               Mouseint AND 2 => right button pressed
'               Mouseint AND 4 => middle button pressed (if allowed by Mouse Driver)
'
'   Func%=4   Set mouse position to c% . r%. (scale units)
'
'   Func%=7   Set mouse pos limits between columns c% at left and r% at right
'
'   Func%=8   Set mouse pos limits between rows c% at top and r% at bottom
'
'   Func%=9   Change graph mode cursor shape c%= varseg(mask) r%=varptr(mask)
'             Hot spot defaults to top left corner!
'
'   Func%=10  Change text mode cursor shape c%= AND mask, r%= XOR mask
'             Examples: c = &H0   r=&Hxyzz   back color x fore y character zz
'                       c = &Hff  r=&Hxy00   back color x fore y preserve char
'-----------------------------------------------------------------------------
STATIC hsc%, vsc%, hoff%, voff%
SHARED regs AS RegTypeX

 regs.ax% = func%
 SELECT CASE regs.ax%
 CASE 1, 2: GOSUB imouse                         'show, hide

 CASE 3                                          'Get params
	GOSUB imouse
	c% = regs.cx% \ hsc% + hoff%
	r% = regs.dx% \ vsc% + voff%
	mouseint% = regs.bx%
 CASE 0                                          'reset
	GOSUB imouse: mouseint% = regs.ax%           'mouse reset result
	IF regs.ax% = 0 THEN EXIT FUNCTION
	SELECT CASE c%                               'set default scaling
	CASE -1 'do nothing with scale, if it's not 0
		IF vsc% = 0 THEN vsc% = 1
		IF hsc% = 0 THEN hsc% = 1
	CASE 0  'text scaling
		DEF SEG = &H40: hsc% = 640 / PEEK(&H4A): hoff% = 1: voff% = 1
		SELECT CASE PEEK(&H49)
		CASE 15, 16:  vsc% = 16: IF PEEK(&H84) = 42 THEN vsc% = 8
		CASE 17, 18: vsc% = 16: IF PEEK(&H84) = 59 THEN vsc% = 8
		CASE ELSE: vsc% = 8
		END SELECT
	CASE 2:  'graph mode scaling
		DEF SEG = &H40: hoff% = 1: voff% = 1: vsc% = 1: dummy = PEEK(&H4A)
		SELECT CASE PEEK(&H49)
		CASE 4, 13, 19: hsc% = 2
		CASE ELSE: hsc% = 1
		END SELECT
	END SELECT
	DEF SEG
 CASE 4                                          'set pos
	regs.cx% = (c% - hoff%) * hsc%
	regs.dx% = (r% - voff%) * vsc%
	GOSUB imouse
 CASE 7
	regs.cx% = (c% - voff%) * vsc% + vsc% \ 2      'set limits
	regs.dx% = (r% - voff%) * vsc% + vsc% \ 2
	GOSUB imouse
 CASE 8
	regs.cx% = (c% - hoff%) * hsc% + hsc% \ 2       'set limits
	regs.dx% = (r% - hoff%) * hsc% + hsc% \ 2
	GOSUB imouse
 CASE 9
	regs.bx = 0
	regs.cx = 0
	regs.es = c%
	regs.dx = r%
	GOSUB imouse
 CASE 10, -10
	IF func% > 0 THEN regs.bx = 0 ELSE regs.bx = 1
	regs.cx = c%
	regs.dx = r%
	GOSUB imouse
 CASE -1
	hsc% = c%: vsc% = r%
 CASE -2
	hoff% = c%: voff% = r%
 END SELECT
EXIT FUNCTION

imouse: CALL INTERRUPTX(&H33, regs, regs): RETURN
END FUNCTION