DECLARE SUB gnpart (cmd$, otxt$, q!)
DECLARE SUB SHOWMOUSE ()
DECLARE SUB MOUSE ()
DECLARE SUB MOUSEPOINTER (SW)
DECLARE SUB SHOWDRW ()
DECLARE SUB BUILDKEY ()
DECLARE SUB prockey (KE$, nt$)
DECLARE SUB JSHOW ()
DECLARE SUB speaker (suffix$)
DECLARE SUB gwindow (x!, y!)
DECLARE SUB WINDLAY ()
DECLARE SUB PROC (nt$)
DECLARE SUB showprinter ()
DECLARE SUB setupprinter ()
DECLARE SUB migratefromdrive ()
DECLARE SUB setupsoundspeech ()
DECLARE SUB migrateos ()
DECLARE SUB UPDPROMPT ()
 DIM SHARED programarry$(150)
 COMMON SHARED KBDK' USED TO TURN ON HOT KEYS
 COMMON SHARED CR$, KE$, nt$, SYSMESS$
 'ke$  used for keyboard input
 COMMON SHARED lt$'lt$ used with time to hold last read
 COMMON SHARED opp$'opp$ opperating system prompt also used in timing
 COMMON SHARED ROOT$


SCREEN 0, 0, 0

COLOR 8, 2
'=============== MOUSE STUFF ==============
'
'
'              ********************************************
'              *              QBOS9.BAS                  *
'              *  Mouse Routine for MS-QBasic/IBM-QBasic  *
'              *                1 9 9 5                   *
'              ********************************************

'********************************* INI *************************************

    DIM SHARED A(9)                 'Set up array for code
                                                         
    DEF SEG = VARSEG(A(0))          'Get array segment (nnnn:    )
                                    '    (two 8 bit)
    FOR i = 0 TO 17                 'length of DATA to
       READ r                       'read
       POKE VARPTR(A(0)) + i, r     'into array/2 (nnnn:iiii) (one 8 bit)
    NEXT i                          'until 17

'**************************** Machine Code *********************************

DATA &HB8,&H00,&H00   :   ' mov  AX,[n]       [Swap code-(L),(H)] in AX
DATA &H55             :   ' push BP           Save BP
DATA &H8B,&HEC        :   ' mov  BP,SP        Get BP to c Seg
DATA &HCD,&H33        :   ' int  33           Interrupt 33
DATA &H92             :   ' xchg AX,[reg]     [Swap code-reg] in AX
DATA &H8B,&H5E,&H06   :   ' mov  BX,[BP+6]    Point to (variable)
DATA &H89,&H07        :   ' mov  [BX],AX      Put AX in (variable)
DATA &H5D             :   ' pop  BP           Restore BP
DATA &HCA,&H02,&H00   :   ' ret  2            Far return

'*********************** P R O G R A M   S C R E E N ***********************
CALL MOUSEPOINTER(0)

CALL MOUSEPOINTER(1)

' ==========================================


 OPEN "root.dat" FOR INPUT AS #1
 LINE INPUT #1, ROOT$
 LINE INPUT #1, sospcrt$
 CLOSE #1
 'ROOT$ = "C:\QBASIC\"
  CLS
  PRINT "root directory is"
  PRINT ROOT$
  PRINT "speech directory is"
  PRINT sospcrt$
  SLEEP 2
CR$ = CHR$(13)
SYS$ = ""

       SYS$ = "  2 FOR ROM COCO GUI  <R> to change machein type" + CR$
SYS$ = SYS$ + "  3 FOR DOS           <O> for OS9" + CR$
SYS$ = SYS$ + "  4 FOR MS WINDOWS    <S> sound speech cart " + sospcrt$ + CR$
SYS$ = SYS$ + "  5 to copy CoCo os onto a floppy" + CR$
SYS$ = SYS$ + "  6 to migrate os from floppy to c:\qbasic" + CR$
SYS$ = SYS$ + "  7 to setup smart printing >" + CR$
SYS$ = SYS$ + "  8 TO TURN ON DUAL MON" + CR$
SYS$ = SYS$ + "  9 TO SEE WINDOW LAYOUT" + CR$
SYS$ = SYS$ + " <A> to see a:\ dir   " + CR$
SYS$ = SYS$ + " <B> to see b:\ dir   <SHAPE>." + CR$

SYSMESS$ = SYS$

'root$ = "c:\qbasic\"
LEXIT = 0



CLS
ON ERROR GOTO er


DO

nmbr = VAL(tn$)
LOCATE 20, 1

PRINT "  1 FOR ROM INTEGER BASIC  " + nt$; : COLOR blkcol: PRINT CHR$(219); " ": COLOR 0
IF KBDK = 1 THEN
LOCATE 1, 1
PRINT SYSMESS$
END IF
CALL UPDPROMPT

  LOCATE 12, 1: PRINT TEXT$; : COLOR blkcol: PRINT CHR$(219); " ": COLOR 0
      
      
      
      
      
              

        tpx = tpx + 1
        IF tpx > 3 THEN
          blkcol = blkcol + 1: IF blkcol > 16 THEN blkcol = 0
           tpx = 0
        END IF

       'IF KBDK = 1 THEN CALL prockey(KE$)

    IF KE$ <> "" THEN : nt$ = nt$ + KE$



LOOP UNTIL LEXIT = 1

er:

'
PRINT


PRINT " i cant do that"

SLEEP
RUN

ERKEY:
PRINT "AN ERROR HAVING TO DO WITH THE SYSTEM KEY"
END
SOUND 100 + 22, 4

SUB BUILDKEY
CLS
CALL UPDPROMPT


LOCATE 21, 1
INPUT "DISK A OR B "; D$
T$ = RIGHT$(D$, 1)
CLOSE

OPEN D$ + ":COCO2KEY.KEY" FOR RANDOM AS #1


ON ERROR GOTO ERKEY:
 W = 1

FS = LOF(1)
DO
l = LOC(1)
PRINT l
SLEEP
   IF l < (FS) THEN INPUT #1, A$
 PRINT A$
 W = W + 1
LOOP UNTIL EOF(1)


PRINT "---- THESE FILES ARE CURRENTLY REGISTERED"
SLEEP

DO
SHELL "DIR *.BAS/W"

PRINT "_____________"
 INPUT "ADD NAME "; N$

IF N$ <> "" THEN PRINT #1, N$
PRINT LOF(1)




LOOP UNTIL N$ = ""
CLOSE #1


CLS
END SUB

SUB gnpart (cmd$, otxt$, q)

ll = LEN(cmd$)
IF q <= (ll) THEN
IF q = 0 THEN q = 1

otxt$ = ""
CH$ = ""

DO

  CH$ = MID$(cmd$, q, 1)

IF CH$ <> "," AND CH$ <> ":" AND CH$ <> "(" AND CH$ <> ")" AND CH$ <> CHR$(32) AND CH$ <> CHR$(34) THEN
otxt$ = otxt$ + CH$
END IF

IF q <= (ll) THEN
  q = q + 1

END IF


LOOP UNTIL CH$ = CHR$(13) OR CH$ = ":" OR CH$ = "," OR CH$ = CHR$(34) OR CH$ = CHR$(32) OR q >= (ll)

END IF

END SUB

SUB gwindow (x, y)
'
'
'
LINE (x, y)-(x + 80, y + 20), 1, BF
LINE (x, y)-(x + 5, y + 5), 2, BF
LINE (x, y)-(x + 180, y + 50), 1, B



'
END SUB

SUB JSHOW
CLOSE
CLS
'
PRINT " put your coco bootdisk in drive a:\"
PRINT "  "
PRINT "  "
SLEEP
aroot$ = "a:\"
OPEN aroot$ + "job1.do" FOR INPUT AS #1
DO
INPUT #1, A$
PRINT A$


LOOP UNTIL EOF(1)

SLEEP


END SUB

SUB migratefromdrive
CLS
PRINT "####"
INPUT "taking from  Disk <a,b,c>"; from$
       T$ = RIGHT$(from$, 1)
       IF T$ <> ":" THEN from$ = from$ + ":"
 PRINT " #### disk 1 ####"
 SLEEP
 
SHELL "copy " + from$ + "cocorom.bas " + destination$
PRINT "cocorom.bas..."
SHELL "copy " + from$ + "qbmenu.bas " + destination$
PRINT "qbmenu.bas..."
SHELL "copy " + from$ + "qbwin01.bas " + destination$
PRINT " the gui OS"
SHELL "copy " + from$ + "screens.bas " + destination$
PRINT " the screen saver "

SHELL "copy " + from$ + "DISKCOPY.bas " + destination$
PRINT " diskcopy.bas"


SHELL "copy " + from$ + "clock1.bas " + destination$
PRINT " and the clock"
                                 
PRINT
PRINT
PRINT
PRINT " #### Disk  2 ####"
'
SLEEP
SHELL "copy " + from$ + "qbos9.bas " + destination$

PRINT " OS9 copyed"
SHELL "copy " + from$ + "ti994a.bas " + destination$
PRINT "ti994a copyed - another basic emulator"


'

SLEEP

PRINT " model2.bas "
SHELL " copy " + from$ + "model2.bas " + destination$




END SUB

SUB migrateos
REM
REM does what it says this put the complete coco opperating system onto a disk
REM  the source can be a disk or the hard drive


PRINT " ####### "
INPUT "Put onto disk <A,B,C>"; destination$
INPUT "taking from  Disk <a,b,c>"; from$
    IF from$ = "c:" THEN from$ = "c:\qbasic\"


IF destination$ = "" THEN destination$ = "a:"



IF from$ = "" THEN from$ = "c:\qbasic\"



 PRINT " #### disk 1 ####"
 SLEEP

SHELL "copy " + from$ + "cocorom.bas " + destination$
PRINT "cocorom.bas..."
SHELL "copy " + from$ + "qbmenu.bas " + destination$
PRINT "qbmenu.bas..."
SHELL "copy " + from$ + "qbwin01.bas " + destination$
PRINT " the gui OS"
SHELL "copy " + from$ + "screens.bas " + destination$
PRINT " the screen saver "

SHELL "copy " + from$ + "DISKCOPY.bas " + destination$
PRINT " diskcopy.bas"


SHELL "copy " + from$ + "clock1.bas " + destination$
PRINT " and the clock"
                                  
PRINT
PRINT
PRINT
PRINT " #### Disk  2 ####"
'
SLEEP
SHELL "copy " + from$ + "qbos9.bas " + destination$

PRINT " OS9 copyed"
SHELL "copy " + from$ + "ti994a.bas " + destination$
PRINT "ti994a copyed - another basic emulator"


'

SLEEP
 CLS

END SUB

SUB MOUSE
       
           POKE VARPTR(A(4)), &H92           'Swap code,Get CX setup
          CALL absolute(Cx, VARPTR(A(0)))     'Run Code
              Cx = Cx
                                   'Adjust 25x80
           POKE VARPTR(A(4)), &H91           'Swap code,Get DX setup
          CALL absolute(Dx, VARPTR(A(0)))     'Run Code
            
              Dx = Dx                    'Adjust 25x80
           POKE VARPTR(A(4)), &H93           'Swap code,Get BX setup
          CALL absolute(bx, VARPTR(A(0)))     'Run Code

                   BU = bx              'Note :
                                   'Remove the /8
                                   'for graphics modes.




        MX = Dx
        MY = Cx










END SUB

SUB MOUSEPOINTER (SW)


      
           POKE VARPTR(A(0)) + 1, SW         'Swap code,Set AX = (SW)
          CALL absolute(C, VARPTR(A(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

SUB PROC (nt$)

  
 TEXT$ = UCASE$(nt$)

 TEXT$ = TEXT$ + " "

 word$ = ""
 l = LEN(TEXT$)
 x = 1
 CALL gnpart(TEXT$, otxt$, q): word$ = otxt$
   rest$ = RIGHT$(TEXT$, (l - q) + 1)
 CALL gnpart(TEXT$, otxt$, q): p1$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P2$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P3$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P4$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P5$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P6$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P7$ = otxt$
 CALL gnpart(TEXT$, otxt$, q): P8$ = otxt$


   V1 = VAL(p1$)
   V2 = VAL(P2$)
   V3 = VAL(P3$)
   V4 = VAL(P4$)
   V5 = VAL(P5$)
   V6 = VAL(P6$)
   V7 = VAL(P7$)
   V8 = VAL(P8$)

  
  lnv = VAL(word$)
  IF lnv > 0 OR word$ = "0" THEN
   programarry$(lnv) = rest$
   IF lnv > (PROGLENGTH) THEN PROGLENGTH = lnv
   PRINT p1$, "stored in "; lnv
   SLEEP
  END IF
 

'PRINT WORD$, V1
 'SLEEP
  

 
  SELECT CASE (word$)
   CASE IS = "JOYTEST"
   RUN "JOYTEST.BAS"
   CASE IS = "TRONM"
   RUN "TRONM.BAS"
   CASE IS = "SCREENSAVER", "SLEEP"
   RUN "SCREENS.BAS"
   CASE IS = "BYE", "EXIT"
   END
   CASE IS = "ROOT"
   CLS
   RUN "fixroot.bas"

   CASE IS = "PLAY"
   CLS
   PRINT "MUSICAL TESTER."
   INPUT "TYPE IN MUSICAL NOTES"; NOTE$
   PLAY NOTE$
   CASE IS = "CLS"
   CLS
   CASE IS = "CAD"
   RUN ROOT$ + "QBCAD.BAS"

   CASE IS = "SLEEP"
    RUN ROOT$ + "REST.BAS"


   CASE IS = "SHELL"
    CLS
    INPUT "SHELL -"; SH$
     SHELL SH$
  
   CASE IS = "DRAW"
    RUN ROOT$ + "ZDRAW.BAS"
   CASE IS = "MOUSE"
    CALL SHOWMOUSE
  
   CASE IS = "MODEL2"
    RUN ROOT$ + "MODEL2.BAS"
  
   CASE IS = "QBMENU"
    RUN ROOT$ + "QBMENU.BAS"
   CASE IS = "SHAPE", "DRW"
    CALL SHOWDRW

  
   CASE IS = "TIME"
    RUN ROOT$ + "CLOCK1.BAS"

  
   CASE IS = "ZDRAW"

    RUN ROOT$ + "ZDRAW.BAS"
  
   CASE IS = "TI994A"
    RUN ROOT$ + "TI994A.BAS"


   CASE IS = "KEY"
          SYS$ = ""
          SYS$ = "################" + CR$
    SYS$ = SYS$ + "# BUILDING KEY #" + CR$
    SYS$ = SYS$ + "################" + CR$
      CLS
      KBDK = 1

      SYSMESS$ = SYS$
      
      CALL BUILDKEY

   CASE IS = "JOB"
    CALL JSHOW
   CASE IS = "BEEP"
   SOUND 1001, 1

   CASE IS = "KEYON"
    KBDK = 1
   CASE IS = "KEYOFF"
     KBDK = 0
     CLS
   CASE IS = "PLEXER"
   CHDIR "C:\QBASIC"
   RUN "PLEXEROS.BAS"
   CASE IS = "SAY"
    CLS
    PRINT " speech engein tester "
    INPUT "say what"; phr$
   
    suffix$ = phr$
    speaker (suffix$)


   CASE IS = "CLOCK3"
   RUN "clock3.bas"

   CASE IS = "LPT1"
   
    PRINT "##########"
    PRINT "#  lpt1  #"
    PRINT "##########"

    PRINT "printer explore routines"
       SLEEP 2

    RUN "lpt1expl.bas"


  CASE IS = "CLOCK"
  RUN "clock1.bas"
  CASE IS = "HELP"
  RUN "cocohelp.bas"



  CASE IS = "CALC", "QBCALC"
   RUN "qbcalc.bas"
 
  CASE IS = "TALK"
 
   SHELL "c:\pcspeak\SPEECH.COM"
   CASE ELSE
  
   CALL prockey(K$, nt$)


  END SELECT



END SUB

SUB prockey (KE$, nt$)

'root$ = "C:\BASIC\"
      l = LEN(nt$)


SELECT CASE (KE$)
  CASE IS = CHR$(0) + CHR$(59)
  LOCATE 22, 1
  KBDK = 0
  INPUT "COMMAND"; C$
    nt$ = C$
    CALL PROC(nt$)



  CASE IS = "A"
   CLS
   FILES "a:"
   SLEEP

   CLS

  CASE IS = "B"
   CLS

   FILES "b:"
   SLEEP


   CLS

  CASE IS = "1"
  RUN "C:\QBASIC\QBMENU.BAS"
  CASE IS = "2"
  RUN "QBWIN01.BAS"
  CASE IS = "3"
  SYSTEM

  CASE IS = "4"


  SHELL "C:\TYPE MENU"

   SHELL "EXIT"
  CASE IS = "5"
  CLS
  CALL migrateos
  CASE IS = "6"
  CALL migratefromdrive
  CASE IS = "7"
  CALL setupprinter
  CASE IS = "8"
  CHDIR ROOT$
  OPEN "DUAL.INF" FOR OUTPUT AS #1

  PRINT #1, "ON"
  CLOSE

  PRINT "DONE ..."
  PRINT " YOU MUST HAVE THE OTHER SYSTEM CONNECTED TO COM1 "
  SLEEP
  CLS
  CASE IS = "9"



  CALL WINDLAY



 
END SELECT

END SUB

SUB setupprinter
CLS
PRINT "your computer can pass printer data from its seriol port to"
PRINT " the other for printing "
INPUT " which port will be used <1 - 2> "; N
PRINT "now will this system be the <P> printer side"
PRINT " or the <S> seriol side "
INPUT " S or P "; SD$

SD$ = UCASE$(SD$)
OPEN "c:\qbasic\printer.set" FOR OUTPUT AS #1

PRINT #1, N
PRINT #1, SD$
CLOSE #1


BEEP
PRINT " Done setting up printer"


END SUB

SUB setupsoundspeech

CLS
PRINT "the speech cartridge will remain on after reboot"
PRINT " so come back here to turn it off"
INPUT " choose the port <1/2>"; CH

PRINT " please wait..."
OPEN "c:\qbasic\auxsp.set" FOR OUTPUT AS #1

PRINT #1, CH
PRINT #1, "change made at " + DATE$
CLOSE




END SUB

SUB SHOWDRW
SCREEN 12
TA = 1
DO
CLS
SHELL "dir/w *.drw"
INPUT "what shape do you want to see"; na$


IF na$ <> "" THEN
TT$ = ROOT$ + na$ + ".drw"
 PRINT TT$
OPEN TT$ FOR INPUT AS #1

INPUT #1, DR$
CLOSE #1
PRINT "---"; DR$
END IF
SLEEP 1
CLS
DO
KE$ = INKEY$


DRAW "bm200,150c7ta" + STR$(TA) + DR$
IF KE$ <> "" THEN DRAW "bm200,150c0ta" + STR$(TA1) + DR1$: DR1$ = DR$: TA1 = TA

 IF KE$ = "Q" THEN GOTO extsub:
IF KE$ = "." THEN TA = TA + 1: IF TA > 360 THEN TA = 1
IF KE$ = "," THEN TA = TA - 1: IF TA < 1 THEN TA = 360
LOOP UNTIL KE$ = CHR$(13)
LOOP
extsub:
SCREEN 0, 0, 0

COLOR 8, 2

CLS

END SUB

SUB SHOWMOUSE

CLS
SCREEN 12

CALL MOUSEPOINTER(1)
DO
LOCATE 1, 1
PRINT PRN0$
PRINT PRN1$
PRINT PRN2$
PRINT PRN3$
PRINT PRN4$
PRINT PRN5$
PRINT PRN6$
PRINT PRN7$
PRINT PRN8$
PRINT PRN9$
PRINT PRN10$
PRINT TEXT$ + CU$ + " "


KE$ = INKEY$
IF KE$ = CHR$(13) THEN
   nt$ = TEXT$: CALL PROC(nt$)
  PRN0$ = PRN1$: PRN1$ = PRN2$
  PRN2$ = PRN3$: PRN3$ = PRN4$: PRN4$ = PRN5$
  PRN5$ = PRN6$: PRN6$ = PRN7$: PRN7$ = PRN8$: PRN8$ = PRN9$
  PRN9$ = PRN10$: PRN10$ = TEXT$
 TEXT$ = ""
KE$ = ""
END IF

IF KE$ <> "" AND KE$ <> CHR$(8) THEN TEXT$ = TEXT$ + KE$
IF KE$ = CHR$(8) THEN l = LEN(TEXT$): IF l > 0 THEN TEXT$ = LEFT$(TEXT$, l - 1)

CLX = CLX + 1
IF CLX > 1 THEN CLX = 0
IF CLX = 0 THEN CU$ = "_"
IF CLX = 1 THEN CU$ = " "

LOOP UNTIL KE$ = CHR$(27)
SCREEN 0, 0, 0
COLOR 8, 2
CLS


END SUB

SUB showprinter
CLS
OPEN "c:\qbasic\printer.set" FOR INPUT AS #1
INPUT #1, prnbr
INPUT #1, prNsd$


CLOSE #1

SELECT CASE (prNsd$)
  CASE IS = "S"
  m$ = " seriol out "
  CASE IS = "P"
  m$ = " reading seriol direct printer"

END SELECT


PRINT "#####"
PRINT " your printer is on port ("; prnbr; ")"
PRINT " you are in "; m$; " mode "
BEEP
SLEEP



END SUB

SUB speaker (suffix$)
PRINT suffix$; " IN THE SPEAKER SUB:"
'SLEEP
CLOSE
' = "C:\QBASIC\"
WROOT$ = "C:\WORK\"
OPEN WROOT$ + "SPEAK.TXT" FOR OUTPUT AS #1
PRINT #1, suffix$
CLOSE #1

OPEN ROOT$ + "RPROG.TXT$" FOR OUTPUT AS #1
PRINT #1, "cocorom.BAS"
CLOSE

PRINT
PRINT
PRINT

PRINT "PROCESSING "; p1$

'SLEEP
RUN ROOT$ + "cocosay.BAS"


END SUB

SUB UPDPROMPT
  REM readkey board

   LOCATE 1, 1: PRINT SYSMESS$

 KE$ = INKEY$
 l = LEN(nt$)
 IF KE$ = CHR$(13) THEN CALL PROC(nt$): nt$ = "": KE$ = ""
 
 
  IF KE$ = CHR$(8) THEN KE$ = "": IF l > 0 THEN nt$ = LEFT$(nt$, l - 1)

     


   IF KE$ = CHR$(0) + CHR$(67) THEN scsvr = 0
   IF KE$ <> "" THEN
      ctxvar = 0
      IF AKB1 = 1 THEN
     
     
     
     
        IF KE$ = CHR$(0) + CHR$(77) THEN
            PRINT #4, CHR$(13)

         KE$ = ""
        END IF
        PRINT #4, KE$
      END IF

   END IF

   A$ = ""

   IF AKB1 = 1 THEN

    IF LOC(4) > 0 THEN
    LINE INPUT #4, A$
     IF A$ <> "" THEN KE$ = A$: ctxvar = 0
     IF A$ = "~" THEN KE$ = CHR$(13)

    END IF

   END IF



  IF TIME$ <> (lt$) THEN

  oppv = oppv + 1

  IF oppv = 1 THEN opp$ = CHR$(219)
  IF oppv > 1 THEN oppv = 0
  IF oppv = 0 THEN opp$ = " "

   lt$ = TIME$: ctxvar = ctxvar + 1

   REM we call the screen saver here

   IF ctxvar > 120 THEN
    IF scsvr = 1 THEN RUN "screens"
   END IF
  END IF

 IF KE$ <> "" THEN TEXT$ = TEXT$ + KE$

END SUB

SUB WINDLAY

REM
REM  THIS SUB ILLUSTRATES HOW TO USE WINDOWS SETTINGS
REM
REM

OPEN "TISET.WND" FOR INPUT AS #1

INPUT #1, wx
INPUT #1, wy
INPUT #1, nx
INPUT #1, ny
INPUT #1, H
INPUT #1, V




CLOSE #1


SCREEN 10



CALL gwindow(wx, wy)
CALL gwindow(nx, ny)








SLEEP


RUN

END SUB

