Attribute VB_Name = "bbsinterpriter"
DefInt A-Z
Global ltime$, CR$, keval$, PRFUNCTION$, PROLIST$, traceline$
Global lplace
Global msh1, msv1, LISTSCROLL, PROGRAMRUN
Global MHH, MVV, cur0, mousex, mousey, mousebutton
Global grmousex, grmousey, grbutton
Global TXT$
Global MX, MY
Global WINCOL
Global wht, wwt: Rem (wht height) (wwt width)
Global FONTV
Global bc
Global tonefrequency, NODEVAR
Global toneduration
Global qbmo ' 0 is set to off
Global maintxt$
Global blink, EQ, LP1, CURRENTXX

' rem basic
Rem variables
 Global TON1, TON4, TON7
 Global TON2, TON5
 Global TON3, TON6
 Global scsvr ' turns on or shuts off screen saver
 Global ramdiskonflag 'toggles ramdisk file action
 Global F1$
 Global chrkey$, ke$, PROMPT$, OUTTOCRTTEXT$, miditextscroll$
 'ke$  used for keyboard input
 Global lt$, auxsp$ 'lt$ used with time to hold last read
 Global opp$ 'opp$ opperating system prompt also used in timing
 Global akb2 '
 Global AKB1 ' used for aux keyboards
 Global BBSPAGE$, bbstext$, bbstrailtext$
 Global ltext$ ' used with osheader6
 Global text$, chprompt2$, prompt2text$
 Global text0$, text1$, text2$, text3$, TEXT4$, text5$, text6$, text7$
 Global TEXT8$, text9$, text10$, text11$
 
 ' time$ qbasic real time clock variable ##:##:## hr mn se
 Global oppv, ctxvar, TSPEED
 Global auxsp1, DRAWQA, DRAWTA
 Global AUXTEXT$, LGOTO$, prnsd$
 Global PROGLENGTH
 Global prnbr ' used for printer
 Global lx, ly
 Global cxh, cyv
 Global prnouttext$ ' used to hold the temporary out text to lpt1
 Global SWTH, SHHT
 Global SPEED ' used for cpu speed
 Global cart1$, cart2$
 Global ms$
 Global HEBTRANS$, prompt2ke$
 Global htext$
 Global DUAL, TEXTSHOW
 Global WX, WY, NX, NY
 Global jx, jy, jbu, closedjoystick ' REM used for joystick

Global PROGRAMARRY$(800): Global programarry1$(805, 80)
Global MAXPROGSIZE, RUNTIMER
Global varrs$(200, 4)
Global BBSCHOICE$(100, 4)
Global musictransfers$(10, 4)

Global nodelistdatabase$(128, 5)
Global prompt2mousex, prompt2mousey, prompt2mousebutton, PROMPT2MBU
' rem io node variables
Global ramdisklist$, INCOMMINGCHAT$
Global qbasictext$
Global node1text$, node2text$
Global NODE3TEXT$, node4text$, NODE5TEXT$, node6text$, node7text$, node8text$, node9text$
Global node10text$, node11text$, node12text$, node13text$, node14text$, node15text$
Global node16text$, node17text$, node18text$, node19text$, node20text$, node21text$
Global node22text$, node23text$, node24text$
Global qbasicouttext$
Global node1outtext$, node2outtext$
Global NODE3OUTTEXT$, node4outtext$, NODE5OUTTEXT$, NODE6OUTTEXT$, NODE7OUTTEXT$, NODE8OUTTEXT$
Global NODE9OUTTEXT$, NODE10OUTTEXT$, NODE11OUTTEXT$, NODE12OUTTEXT$, NODE13OUTTEXT$, NODE14OUTTEXT$
Global NODE15OUTTEXT$, NODE16OUTTEXT$, NODE17OUTTEXT$, NODE18OUTTEXT$, NODE19OUTTEXT$, NODE20OUTTEXT$
Global NODE21OUTTEXT$, NODE22OUTTEXT$, NODE23OUTTEXT$, NODE24OUTTEXT$
Global qbasicsettings$
Global node1settings$, node2settings$
Global node3settings$, node4settings$, NODE5SETTINGS$, NODE6SETTINGS$, NODE7SETTINGS$
Global NODE8SETTINGS$, NODE9SETTINGS$, NODE10SETTINGS$, NODE11SETTINGS$, NODE12SETTINGS$
Global NODE13SETTINGS$, NODE14SETTINGS$, NODE15SETTINGS$, NODE16SETTINGS$, NODE17SETTINGS$
Global NODE18SETTINGS$, NODE19SETTINGS$, NODE20SETTINGS$, NODE21SETTINGS$, NODE22SETTINGS$
Global NODE23SETTINGS$, NODE24SETTINGS$
Global patchnode0$, patchnode1$, patchnode2$, patchnode3$, patchnode4$
Global patchnode5$, patchnode6$, patchnode7$, patchnode8$, patchnode9$
Global patchnode10$, patchnode11$, patchnode12$, patchnode13$, patchnode14$
Global patchnode15$, patchnode16$, patchnode17$, patchnode18$, patchnode19$
Global patchnode20$, patchnode21$, patchnode22$, patchnode23$, patchnode24$
Global bintextlist$
' Rem telnet
Global Socket_Numberport1
'**************************************
'Windows API/Global Declarations for :_
'     Authenticate via HTTP 401, digest calcul
'     ator (You have no idea how long this too
'     k to work out! ) _
'**************************************
'IF YOU DO NOT HAVE THE MD5 DLL, GET IT
'     HERE:
'http://www.esquadro.com.br/md5bas.zip

Private Declare Sub MDFile Lib "aamd532.dll" (ByVal f As String, ByVal r As String)


Private Declare Sub MDStringFix Lib "aamd532.dll" (ByVal f As String, ByVal T As Long, ByVal r As String)

Public Sub buildbin(inchar$, out$)
Rem build binanry number
T$ = ""
If inchar$ <> "" Then V = Asc(inchar$)

If V >= 1048576 Then T$ = T$ + "1": V = V - 1048576: Else T$ = T$ + "0"
If V >= 524288 Then T$ = T$ + "1": V = V - 524288: Else T$ = T$ + "0"
If V >= 262144 Then T$ = T$ + "1": V = V - 262144: Else T$ = T$ + "0"
If V >= 131072 Then T$ = T$ + "1": V = V - 131072: Else T$ = T$ + "0"
If V >= 65536 Then T$ = T$ + "1": V = V - 65536: Else T$ = T$ + "0"
If V >= 32768 Then T$ = T$ + "1": V = V - 32768: Else T$ = T$ + "0"
If V >= 16384 Then T$ = T$ + "1": V = V - 16384: Else T$ = T$ + "0"
If V >= 8192 Then T$ = T$ + "1": V = V - 8192: Else T$ = T$ + "0"
If V >= 4096 Then T$ = T$ + "1": V = V - 4096: Else T$ = T$ + "0"
If V >= 2048 Then T$ = T$ + "1": V = V - 2048: Else T$ = T$ + "0"
If V >= 1024 Then T$ = T$ + "1": V = V - 1024: Else T$ = T$ + "0"
If V >= 512 Then T$ = T$ + "1": V = V - 512: Else T$ = T$ + "0"
If V >= 256 Then T$ = T$ + "1": V = V - 256 Else T$ = T$ + "0"
If V >= 128 Then T$ = T$ + "1": V = V - 128 Else T$ = T$ + "0"
If V >= 64 Then T$ = T$ + "1": V = V - 64 Else T$ = T$ + "0"
If V >= 32 Then T$ = T$ + "1": V = V - 32 Else T$ = T$ + "0"
If V >= 16 Then T$ = T$ + "1": V = V - 16 Else T$ = T$ + "0"
If V >= 8 Then T$ = T$ + "1": V = V - 8 Else T$ = T$ + "0"
If V >= 4 Then T$ = T$ + "1": V = V - 4 Else T$ = T$ + "0"
If V >= 2 Then T$ = T$ + "1": V = V - 2 Else T$ = T$ + "0"
If V = 1 Then T$ = T$ + "1": V = V - 1 Else T$ = T$ + "0"

out$ = T$









End Sub

Public Sub CLEARBBSCHOICE()
Rem CLEAR THE CHOICE VARIABLES
Rem   FOR THE BBS

For cx = 0 To 100
BBSCHOICE$(cx, 0) = ""
BBSCHOICE$(cx, 1) = ""


Next cx

End Sub

Public Sub cutchr1310(a$, RETVAL$)
text0$ = a$
l = Len(text0$)
 ttt$ = ""
 For z = 1 To (l)
 ch$ = Mid$(text0$, z, 1)
  If ch$ <> Chr$(10) Then
    ttt$ = ttt$ + ch$
  End If
 
 Next z
 text0$ = ttt$
 
 
 l = Len(text0$)
 ttt$ = ""
 For z = 1 To (l)
 ch$ = Mid$(text0$, z, 1)
  If ch$ <> Chr$(13) Then
    ttt$ = ttt$ + ch$
  End If
 
 Next z
 RETVAL$ = ttt$
 
End Sub

Public Sub LOGINUSERTOBBS(NODE$, NA$, PW$)
Rem LOGIN USERS TO THE BBS
Rem


Open App.Path + "\USERS\mainusers.txt" For Input As 1
NA$ = UCase$(NA$)
 'var$ = NA$
  'Call cut32(var$, retval$)
   'NA$ = retval$
PW$ = UCase$(PW$)
 'var$ = PW$
  'Call cut32(var$, retval$)
   'PW$ = retval$
Do
Line Input #1, d$
Debug.Print "CHECKING "; NA$; " "; PW$
text$ = d$ + " "
Q = 1
Call gnpart(text$, otxt$, Q): NTC$ = otxt$: otxt$ = ""
Call gnpart(text$, otxt$, Q): PWTC$ = otxt$: otxt$ = ""
 var$ = NTC$
  Call cut32(var$, RETVAL$)
   NTC$ = RETVAL$
 var$ = PW$
  Call cut32(var$, RETVAL$)
   PW$ = RETVAL$
 
 NTC$ = UCase$(NTC$)
  PWTC$ = UCase$(PWTC$)

Debug.Print "AGAINST "; NTC$; " "; PWTC$

If NA$ = (NTC$) And PW$ = (PWTC$) Then

T$ = "BBS@TEXT *********" + CR$
T$ = T$ + "BBS@TEXT username & password accepted " + CR$
T$ = T$ + "BBS@TEXT YOU ARE LOGGED IN " + NA$ + CR$
T$ = T$ + "-------------------------------------" + CR$
T$ = T$ + "BBS@LOGINHIDE" + CR$
Open App.Path + "\BBS\MAINMENU.TXT" For Input As #2
 G$ = ""
 Do
  Line Input #2, W$
  G$ = G$ + W$ + CR$
 Loop Until EOF(2)
Close #2
T$ = T$ + G$ + CR$

N$ = NODE$
Call NODEOUT(N$, T$ + CR$)

Select Case (N$)
Case Is = "1", "NODE1", "VBTERM", "PROMPT"
 patchnode1$ = "BBS"
  nodelistdatabase$(1, 5) = NTC$
Case Is = "2", "NODE2"
 patchnode1$ = "BBS"
  nodelistdatabase$(2, 5) = NTC$
Case Is = "3", "NODE3"
 patchnode4$ = "BBS"
  nodelistdatabase$(3, 5) = NTC$
Case Is = "4", "NODE4"
 patchnode4$ = "BBS"
  nodelistdatabase$(4, 5) = NTC$
Case Is = "5", "NODE5"
 patchnode5$ = "BBS"
  nodelistdatabase$(5, 5) = NTC$

Case Is = "6", "NODE6"
 patchnode6$ = "BBS"
  nodelistdatabase$(6, 5) = NTC$
Case Is = "7", "NODE7"
 patchnode7$ = "BBS"
  nodelistdatabase$(7, 5) = NTC$


End Select

End If


Loop Until EOF(1)

Close #1



End Sub

Public Sub main()
BASICPROMPT.Show
End Sub

Public Sub mtbp(cmd$, otxt$, Q)
ext = 0
If Q = 0 Then Q = 1
l = Len(cmd$)
If l > 0 Then ch$ = Mid$(cmd$, Q, 1)
If ch$ <> Chr$(32) Then Exit Sub
Do
If Q <= (l) And l > 0 Then ch$ = Mid$(cmd$, Q, 1)
If Q > (l) Then ext = 1
If ch$ <> Chr$(32) Then
ext = 1
Else
Q = Q + 1
End If
Loop Until ext = 1
End Sub

Public Sub procbbsentry(NODENAME$, bbstext$)
Rem process cr input from bbs window
Rem uses the bbschoice$(x,x)
ext = 0
cx = 0
d$ = UCase$(bbstext$)
Do
ch$ = BBSCHOICE$(cx, 0)
 N$ = BBSCHOICE$(cx, 1)
 N2$ = BBSCHOICE$(cx, 2)
 N2$ = UCase$(N2$)
 var$ = N2$
 Call cut32(var$, RETVAL$)
 N2$ = RETVAL$
Debug.Print "N2$ "; N2$; ">"
ch$ = UCase$(ch$)
If ch$ = (d$) Then
   Select Case (N2$)
    Case Is = "QUPLOAD"
     Speechform.text1 = "Q BASIC UPLOAD INITIATED "
      Speechform.Command1 = True
        Debug.Print "QBASIC LOADING " + N$
        z$ = "BBS@REQUESTQBASIC " + N$
         Call NODEOUT(NODENAME$, z$ + CR$)
      'Open App.Path + "\QBASIC\" + N$ For Input As #15
      
    
    
    Case Is = "RUPLOAD"
     Speechform.text1 = "R BASIC UPLOAD INITIATED "
      Speechform.Command1 = True
        Debug.Print "R LOADING " + N$
        z$ = "BBS@REQUESTRBASIC " + N$
         Call NODEOUT(NODENAME$, z$ + CR$)
    Case Is = "MUSICSHARE"
      Speechform.text1 = "MUSIC SHARE OF " + N$ + " INITIATED."
      Speechform.Command1 = True
        OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "DOWNLOADING MP3" + N$ + " TO " + NODENAME$
         z$ = "BBS@TEXT STARTING DOWNLOAD OF " + N$ + " FROM " + NODENAME$ + CR$
         z$ = z$ + "BBS@REQUESTMUSIC " + N$
         Open App.Path + "\MUSIC\" + N$ For Output As #51
         Call NODEOUT(NODENAME$, z$ + CR$)
        Case Else
    Call NODEOUT(NODENAME$, "BBS@REQUESTPAGE " + N$ + CR$)
   End Select
   ext = 1
 End If
cx = cx + 1
Loop Until cx > 100 Or ext = 1


End Sub

Public Sub PROCBBSPAGE(BBSPAGE$)
Rem THIS SUB BUILD GR BBS TEXT AND HANDELS THE BBS CALLS
Speechform.text1 = "PROCESSING B B S PAGE ": Speechform.Command1 = True
l = Len(BBSPAGE$)
ct = 1
Do
ch$ = Mid$(BBSPAGE$, ct, 1)
SENT$ = SENT$ + ch$

If ch$ = Chr$(13) Then
z = Len(SENT$)
 B$ = Left$(SENT$, 8)
  B$ = UCase$(B$)
  'Debug.Print "Z TEXT.. < " + B$
  If B$ = "BBS@TEXT" Then
    ENDTEXT$ = Right$(SENT$, z - 8)
    'Debug.Print "BBSTEXT " + ENDTEXT$
    bbstrailtext$ = bbstrailtext$ + ENDTEXT$
  End If
  NODENAME$ = "PROMPT"
 BB$ = Left$(SENT$, 10)
 BB$ = UCase$(BB$)
 'Debug.Print "PROC BASIC COMMAND ["; BB$ + " "
 If BB$ = "BBS@BASIC" Then
  ENDTEXT$ = Right$(SENT$, z - 9)
  text$ = ENDTEXT$
  Call PROCTEXT(NODENAME$, text$, nodereturndata$)
  
 End If


SENT$ = ""
End If






ct = ct + 1




Loop Until ct >= (l)

End Sub

Public Sub procportatco(a$)
a$ = a$ + CR$
l = Len(a$)
cmd$ = a$
word$ = ""
 l = Len(cmd$)
Q = 1

 Call mtbp(cmd$, otxt$, Q)
 Call gnpart(cmd$, otxt$, Q): word$ = otxt$
 REST$ = Right$(cmd$, l - Q + 1)
 word$ = UCase$(word$)
' Call gnpart(text$, otxt$, Q)
 var$ = word$
 Call cut32(var$, RETVAL$)
 word$ = RETVAL$
 wl = Len(word$)
' MsgBox ("<" + a$ + ">")
 Select Case (word$)
 Case Is = "VBTERM", "NODE0", "0"
  ConfigScrn.Show
   ConfigScrn.text2 = REST$
    ConfigScrn.OKButton = True
 
 Case Is = "NODE1", "1"
  ConfigScrnnode1.Show
   ConfigScrnnode1.text2 = REST$
    ConfigScrnnode1.OKButton = True
 
 
 Case Is = "NODE2", "2"
 ConfigScrnnode2.Show
   ConfigScrnnode2.text2 = REST$
    ConfigScrnnode2.OKButton = True
 Case Is = "NODE3", "3"
 ConfigScrnnode3.Show
   ConfigScrnnode3.text2 = REST$
    ConfigScrnnode3.OKButton = True
 Case Is = "NODE4", "4"
 ConfigScrnnode4.Show
   ConfigScrnnode4.text2 = REST$
    ConfigScrnnode4.OKButton = True
 Case Is = "NODE5", "5"
 ConfigScrnnode5.Show
   ConfigScrnnode5.text2 = REST$
    ConfigScrnnode5.OKButton = True
 Case Is = "NODE6", "6"
 ConfigScrnnode6.Show
   ConfigScrnnode6.text2 = REST$
    ConfigScrnnode6.OKButton = True
 Case Is = "NODE7", "7"
 ConfigScrnnode7.Show
   ConfigScrnnode7.text2 = REST$
    ConfigScrnnode7.OKButton = True
 
 Case Is = "NODE8", "8"
 ConfigScrnnode8.Show
   ConfigScrnnode8.text2 = REST$
    ConfigScrnnode8.OKButton = True
 Case Is = "NODE9", "9"
 ConfigScrnnode9.Show
   ConfigScrnnode9.text2 = REST$
    ConfigScrnnode9.OKButton = True
 Case Is = "NODE10", "10"
 ConfigScrnnode10.Show
   ConfigScrnnode10.text2 = REST$
    ConfigScrnnode10.OKButton = True
 Case Is = "NODE11", "11"
 ConfigScrnnode11.Show
   ConfigScrnnode11.text2 = REST$
    ConfigScrnnode11.OKButton = True
Case Is = "NODE12", "12"
 ConfigScrnnode12.Show
   ConfigScrnnode12.text2 = REST$
    ConfigScrnnode12.OKButton = True
Case Is = "NODE13", "13"
 ConfigScrnnode13.Show
   ConfigScrnnode13.text2 = REST$
    ConfigScrnnode13.OKButton = True
Case Is = "NODE14", "14"
 ConfigScrnnode14.Show
   ConfigScrnnode14.text2 = REST$
    ConfigScrnnode14.OKButton = True
 
Case Is = "NODE15", "15"
 ConfigScrnnode15.Show
   ConfigScrnnode15.text2 = REST$
    ConfigScrnnode15.OKButton = True

Case Is = "NODE16", "16"
 ConfigScrnnode16.Show
   ConfigScrnnode16.text2 = REST$
    ConfigScrnnode16.OKButton = True
 
Case Is = "NODE17", "17"
 ConfigScrnnode17.Show
   ConfigScrnnode17.text2 = REST$
    ConfigScrnnode17.OKButton = True
 
Case Is = "NODE18", "18"
 ConfigScrnnode18.Show
   ConfigScrnnode18.text2 = REST$
    ConfigScrnnode18.OKButton = True

Case Is = "NODE19", "19"
 ConfigScrnnode19.Show
   ConfigScrnnode19.text2 = REST$
    ConfigScrnnode19.OKButton = True

Case Is = "NODE20", "20"
 ConfigScrnnode20.Show
   ConfigScrnnode20.text2 = REST$
    ConfigScrnnode20.OKButton = True

Case Is = "NODE21", "21"
 ConfigScrnnode21.Show
   ConfigScrnnode21.text2 = REST$
    ConfigScrnnode21.OKButton = True

Case Is = "NODE22", "22"
 ConfigScrnnode22.Show
   ConfigScrnnode22.text2 = REST$
    ConfigScrnnode22.OKButton = True

Case Is = "NODE23", "23"
 ConfigScrnnode23.Show
   ConfigScrnnode23.text2 = REST$
    ConfigScrnnode23.OKButton = True

Case Is = "NODE24", "24"
 ConfigScrnnode24.Show
   ConfigScrnnode24.text2 = REST$
    ConfigScrnnode24.OKButton = True

 
 End Select

End Sub

Public Sub PUTBBSCHOICE(p1$, p2$, NODEREST2$)

cx = 0
Do
ch$ = BBSCHOICE$(cx, 0)


If ch$ = (p1$) Or ch$ = "" Then
   BBSCHOICE$(cx, 0) = p1$
   BBSCHOICE$(cx, 1) = p2$
   BBSCHOICE$(cx, 2) = NODEREST2$
End If
cx = cx + 1


Loop Until ch$ = (p1$) Or ch$ = "" Or cx >= 100

End Sub

Public Sub recieveramdisk(NODENAME$, recname$, phr$, nodereturndata$)
Rem call ramdisk data and blank out file
phr$ = ""
ph$ = ""
a$ = ""

Open recname$ For Input As 1
If LOF(1) > 0 Then
 Do
  Line Input #1, a$
  ph$ = ph$ + a$
 Loop Until EOF(1)
Close #1
      
  Qtext$ = ph$: l = Len(Qtext$)
  If l > 1 Then
      Call PROCTEXT(NODENAME$, Qtext$, nodereturndata$)
  End If


Open recname$ For Output As 1
Print #1, " "
Close #1

End If
Close #1

phr$ = ph$

End Sub
Sub PROCTEXT(NODENAME$, text$, nodereturndata$)
Dim BB As Integer
'l = Len(text$)
 'CLAG$ = Left$(text$, 4)
 'CLAG$ = UCase$(CLAG$)
 
 'If CLAG$ = "BBS@" Then
 'BBSPAGE$ = BBSPAGE$ + text$ + CR$
 'FLAG3$ = Left$(text$, 8)
 ' FLAG3$ = UCase$(FLAG3$)
  
 ' FLAG2$ = Left$(text$, 7)
  ' FLAG2$ = UCase$(FLAG2$)
  'FLAG$ = Left$(text$, 9)
   
  'Debug.Print "--- FLAG3$ "; FLAG3$
    
  'If FLAG3$ = "BBS@TEXT" Then
  ' TXT$ = Right$(text$, l - 8)
  
  'bbstrailtext$ = bbstrailtext$ + TXT$ + CR$
  'End If

 If text$ <> "" Then
htext$ = text$

'AXTEXTC >=
AXTEXTCL = Len(htext$)
AXTEXTC = 1
Do
 text$ = ""
 Do
  ch$ = Mid$(htext$, AXTEXTC, 1)
  If ch$ <> Chr$(13) And ch$ <> Chr$(10) Then text$ = text$ + ch$
  AXTEXTC = AXTEXTC + 1
 Loop Until ch$ = Chr$(13) Or AXTEXTC > (AXTEXTCL)
 l = Len(text$)
If l > 10 Then qbasictextin$ = Right$(text$, l - 10)
If l > 14 Then MUSICDATAINBINARY$ = Right$(text$, l - 14)
 musicoption$ = ""
 If l > 13 Then musicoption$ = Left$(text$, 13)
 'Debug.Print "processing ["; text$; "]"
 
 'text$ = UCase$(text$)

  text$ = text$ + " "
alltext$ = text$
alltextcl = Len(alltext$)
ALLTEXTC = 1
Do
 text$ = ""
 Q = 0
 Do
   ch$ = Mid$(alltext$, ALLTEXTC, 1)
   
   text$ = text$ + ch$
    If ch$ = Chr$(34) Then
    ALLTEXTC = ALLTEXTC + 1
     Do
      ch$ = Mid$(alltext$, ALLTEXTC, 1)
      ALLTEXTC = ALLTEXTC + 1
       text$ = text$ + ch$
     Loop Until ch$ = Chr$(34) Or (ALLTEXTC) >= (alltextcl)
    End If
 ALLTEXTC = ALLTEXTC + 1
 Loop Until ch$ = ":" Or ch$ = Chr$(13) Or ALLTEXTC > (alltextcl)
 


 word$ = ""
 l = Len(text$)
 X = 1
 Call gnpart(text$, otxt$, Q): word$ = otxt$: REST$ = Right$(text$, l - Q + 1): word$ = UCase$(word$)
If musicoption$ <> "BBS@MUSICDATA" Then
 Call gnpart(text$, otxt$, Q): p1$ = otxt$: NODEREST$ = Right$(text$, l - Q + 1)
 Call gnpart(text$, otxt$, Q): p2$ = otxt$: NODEREST2$ = Right$(text$, l - Q + 1)
 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$
   var$ = p1$: Call getvar(var$, RETVAL$): V1 = Val(RETVAL$)
   var$ = p2$: Call getvar(var$, RETVAL$): v2 = Val(RETVAL$)
   var$ = P3$: Call getvar(var$, RETVAL$): v3 = Val(RETVAL$)
   var$ = p4$: Call getvar(var$, RETVAL$): V4 = Val(RETVAL$)
   var$ = p5$: Call getvar(var$, RETVAL$): V5 = Val(RETVAL$)
   var$ = p6$: Call getvar(var$, RETVAL$): V6 = Val(RETVAL$)
   var$ = p7$: Call getvar(var$, RETVAL$): V7 = Val(RETVAL$)
   var$ = p8$: Call getvar(var$, RETVAL$): V8 = Val(RETVAL$)
  
  LNV = Val(word$)
  If LNV > 0 Or word$ = "0" Then
   INCERT$ = REST$
  'Debug.Print " INCERT "; INCERT$
  
  PROGRAMARRY$(LNV) = INCERT$
  If LNV > (PROGLENGTH) Then PROGLENGTH = LNV
  End If
  End If
 Debug.Print word$; "-"; REST$
 'SLEEP

Select Case (word$)
Case Is = "SHOWSETTINGS"
 Call showtermsettings(V1)
Case Is = "SAVENODESETTINGS"
 Call savemodemsettings
Case Is = "FONTSIZE"
BASICPROMPT.FontSize = V1

Case Is = "SHOWMENU"
frmracbbsmenu1.Show
Case Is = "SHOWTERMINAL"
 N1 = V1
 Call showterminal(N1)


Case Is = "DEBUG"
 DTEXT$ = debugform.text1
  TXT$ = REST$
    
Call buildinexp(TXT$, outtext$)
 
 
 DTEXT$ = DTEXT$ + outtext$ + CR$
debugform.text1 = DTEXT$
Case Is = "DEBUGSHOW"
debugform.Show
Case Is = "BBS@USERNAME"
 NA$ = p1$
  PW$ = p2$
NODE$ = NODENAME$
Call LOGINUSERTOBBS(NODE$, NA$, PW$)
Case Is = "BBS@LOGINHIDE"
 BBSLOGINFRM.Hide
Case Is = "BBS@LOGIN"
BBSLOGINFRM.Show

Case Is = "SAY", "SPEECH"
  TXT$ = REST$
   'Call buildinexp(TXT$, outtext$)
    'REST$ = outtext$
     Speechform.text1 = REST$
   Speechform.Command1 = True
Case Is = "BBS@MUSICEND"
 Close #51
 OUTTOCRTTEXT$ = OUTTOOCRTTEXT$ + " MUSIC DOWNLOAD FINISHED."
 
Case Is = "BBS@MUSICDATA"
Print #51, MUSICDATAINBINARY$;

Case Is = "BBS@REQUESTMUSIC"
N$ = REST$
Nd$ = NODENAME$
Call ADDMUSICUPLOAD(Nd$, N$)

Case Is = "BBS@QBASICNAME"
Open App.Path + "\QBASIC\" + p1$ For Output As #15

Case Is = "BBS@QBASICEND"
Close #15
Case Is = "BBS@QBASIC"
Print #15, qbasictextin$

Case Is = "BBS@REQUESTQBASIC"
N$ = REST$

OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "SENDING " + N$ + " TO " + NODENAME$
Open App.Path + "\QBASIC\" + N$ For Input As 1
Do
 Line Input #1, a$
 T$ = T$ + "BBS@QBASIC " + a$ + CR$
 'Call NODEOUT(NODENAME$, "BBS@QBASIC " + a$ + CR$)
Loop Until EOF(1)

Close #1
nodereturndata$ = nodereturndata$ + "BBS@TEXT TIME STARTED " + Time$ + CR$
nodereturndata$ = nodereturndata$ + "BBS@TEXT RETRIVING " + N$ + " FOR QBASIC" + CR$
nodereturndata$ = nodereturndata$ + "BBS@QBASICNAME " + N$ + CR$
nodereturndata$ = nodereturndata$ + T$ + CR$
nodereturndata$ = nodereturndata$ + "BBS@QBASICEND" + CR$
Case Is = "BBS@REQUESTRBASIC"
N$ = REST$

OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "SENDING " + N$ + " TO " + NODENAME$
Open App.Path + "\BASIC\" + N$ For Input As 1
Do
 Line Input #1, a$
 T$ = T$ + a$ + CR$
 'Call NODEOUT(NODENAME$, "BBS@RBASIC " + a$ + CR$)
Loop Until EOF(1)

Close #1
nodereturndata$ = nodereturndata$ + "BBS@TEXT RETRIVING" + N$ + CR$

nodereturndata$ = nodereturndata$ + T$ + CR$
Case Is = "BBS@RBASIC"

  LNV = Val(p1$)
   PROGRAMARRY$(LNV) = NODEREST$
 Debug.Print "BBS@RBASIC "; Str$(LNV) + " " + NODEREST$
Case Is = "BBS@CHOICE"

    Call PUTBBSCHOICE(p1$, p2$, NODEREST2$)
Case Is = "BBSWINDOW", "BBSSHOW"
bbswindow.Show
Case Is = "BBS@TEXT"
bbstrailtext$ = bbstrailtext$ + REST$ + CR$
Case Is = "BBS@CLS"
bbstrailtext$ = ""
Call CLEARBBSCHOICE

Case Is = "BBS@REQUESTPAGE"
 On Error GoTo ERNOPAGE:
 Open App.Path + "\BBS\" + REST$ For Input As #1
   Do
      Line Input #1, a$
     T$ = T$ + a$ + CR$
       Loop Until EOF(1)
  Close #1
   nodereturndata$ = nodereturndata$ + T$ + CR$
     Debug.Print "NODERETURNDATA " + nodereturndata$ + "-----"
   Speechform.text1 = "someone is logging in to the bulliten board."
      Speechform.Command1 = True

Case Is = "BBS@OPEN"
        Open App.Path + "\bbs\welcome.txt" For Input As #1
   Do
      Line Input #1, a$
     T$ = T$ + a$ + CR$
       Loop Until EOF(1)
  Close #1
   nodereturndata$ = nodereturndata$ + T$ + CR$
     Debug.Print "NODERETURNDATA " + nodereturndata$ + "-----"
   Speechform.text1 = "someone is logging in to the bulliten board."
      Speechform.Command1 = True
Case Is = "EXCEL"
excelform.text1 = p1$
excelform.text2 = p2$
excelform.text3 = NODEREST2$
excelform.Command1 = True


Case Is = "NODEOUT"

 Call NODEOUT(p1$, NODEREST$)

Case Is = "SENDNODE0"
 qbasicouttext$ = qbasicouttext$ + REST$ + Chr$(13)

Case Is = "SENDNODE1"

 node1outtext$ = REST$ + Chr$(13)
Case Is = "SENDNODE2"
 node2outtext$ = REST$ + Chr$(13)

Case Is = "SENDNODE3"
 NODE3OUTTEXT$ = REST$ + Chr$(13)

Case Is = "SENDNODE4"
 node4outtext$ = REST$ + Chr$(13)

Case Is = "SENDNODE5"
 NODE5OUTTEXT$ = REST$ + Chr$(13)

Case Is = "SENDNODE6"
 NODE6OUTTEXT$ = REST$ + Chr$(13)

Case Is = "SENDNODE7"
 NODE7OUTTEXT$ = REST$ + Chr$(13)

'Case Is = "CONNECTNODE"
'NODEVAR = V1
'Call Vbterm.CONNECTNODE(NODEVAR)

Case Is = "TESTNODES"
For KZL = 1 To 127
 nodelistdatabase$(KZL, 1) = REST$
Next KZL

Case Is = "NODELIST"
nodelist.Show
Case Is = "VBTERMOPEN", "NODE1OPEN"
 Vbterm.MOpen = True
Case Is = "VBTERMLOGIN"
 Vbterm.forcelogin1 = True
Case Is = "MSCOMM", "VBTERM", "NODE1SHOW"
 Vbterm.Show
Case Is = "NODE2SHOW"
Vbtermnode2.Show

Case Is = "NODE3SHOW"
Vbtermnode3.Show

Case Is = "NODE4SHOW"
Vbtermnode4.Show

Case Is = "NODE5SHOW"
Vbtermnode5.Show

Case Is = "NODE6SHOW"
Vbtermnode6.Show

Case Is = "NODE7SHOW"
Vbtermnode7.Show

Case Is = "CHATNODE"
chatform.text3 = REST$

Case Is = "CHAT"
'p1$
'noderest$
If NODENAME$ = "VBTERM" Or NODENAME$ = "PROMPT" Then INCOMMINGCHAT$ = INCOMMINGCHAT$ + NODEREST$ + CR$
Case Is = "SENDCHAT"
chatform.text2 = REST$
chatform.Command1 = True

Case Is = "DOSPROMPT"

    'ChDrive Variables.Drive1.Drive
    Dim I
    'ChDir Variables.Dir1.Path
    Rem PATH CHANGED FOR xp
    I = Shell("C:\WINDOWS\SYSTEM32\Command.com", 1)
OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "DOS # " + Str$(I) + CR$

 Call UPDATECTRSCREEN

Case Is = "PLAYFORMSHOW"
playform.Show
Case Is = "PLAY"
'EnablePlay = False
Call Play(REST$)
playform.text1 = REST$
Case Is = "PROGRAMDATABASESHOW"
 programdatabase.Show
 Case Is = "MIDISHOW"
  mainmidi.Show
 Case Is = "MIDI"
  If V1 > 127 Then
     V1 = 127
     OUTTOCRTTEXT$ = "Midi number value cannot exceed 127 "
     Call UPDATECTRSCREEN

  End If
  mainmidi.Label7 = Str$(V1)
 Case Is = "SPEECHSHOW"
 Speechform.Show
 Case Is = "MAINJOYSTICK"
 Joystickdebug.text1 = p1$
 Case Is = "JOYSTICK"
 Joystickdebug.Show
 Case Is = "SYS"
   If p1$ = "STILL" Or p1$ = "STOP" Then moveupdown$ = "STILL": moverightleft$ = "STILL"
   If p1$ = "MF" Then moveupdown$ = "UP"
   If p1$ = "MB" Then moveupdown$ = "DOWN"
   If p1$ = "MR" Then moverightleft$ = "RIGHT"
   If p1$ = "ML" Then moverightleft$ = "LEFT"
   If p1$ = "PAUSE" Then grpause = 1
   If p1$ = "RESUME" Then grpause = 0
   If p1$ = "SLOW" Then GR.Timer1.Interval = 1000
   If p1$ = "SPEED" Then
      GR.Timer1.Interval = v2
        OUTTOCRTTEXT$ = "SYS TIMER SET TO " + Str$(v2)
   End If
   If p1$ = "TARON" Then target1sent = 1
   If p1$ = "TAROFF" Then target1sent = 0
   If p1$ = "FIRE" Then GRTARGET1BUTTON = 1
   If p1$ = "RAYON" Then grpause = 2
 Case Is = "PROMPT2"
 prompt2.Show
 Case Is = "CLIPBOARD"
 Clipboard.SetText (REST$)
 
 Case Is = "QBASICFEED", "QBFEEDON"
 BASICPROMPT.Timer2 = True
 
 Case Is = "QBASICFEEDOFF", "QBFEEDOFF"
 BASICPROMPT.Timer2 = False
 
 Case Is = "TONE", "SOUND"
 tonefrequency = V1
 toneduration = v2
 
 Case Is = "QBASIC"
 Shell "QBASIC.BAT"
 
 Case Is = "DRAWTA"
  DRAWTA = V1
 Case Is = "DRAWQA"
  DRAWQA = V1
  
 Case Is = "DRAW"
  dta$ = REST$
   'cad.text1 = DTA$
    frmn = 1
 AG = 3
 QA = DRAWQA
 TA = DRAWTA
 BB = 6
   Call grdraw(AG, QA, TA, dta$, H, V, BB, 1, scal)
 
 
 Case Is = "MOVE"
  Call getvar(p1$, OUTVAL$)
    AA = Val(OUTVAL$)
  Call getvar(p2$, OUTVAL$)
    B = Val(OUTVAL$)
  Call getvar(P3$, OUTVAL$)
    C = Val(P3$)
    If B > (AA) Then AA = AA + C
    If B < (AA) Then AA = AA - C
   Call putval(p1$, Str$(AA))
 
 Case Is = "STOPTIMER"
  RUNTIMER = 0
 Case Is = "RUNTIMER"
 RUNTIMER = 1
 
 Case Is = "INCERTTIMER", "LOADTIMER"
  PROMPT$ = PROMPT$ + "INCERTTIMER " + REST$ + ":"
  zz = 0
  Do
   N$ = programarry1$(MAXPROGSIZE + 2, zz)
       If Len(N$) > 0 Then zz = zz + 1
  Loop Until Len(N$) = 0 Or zz >= 80
   programarry1$(MAXPROGSIZE + 2, zz) = REST$
   programarry1$(MAXPROGSIZE + 1, zz) = "0"
    Rem
Rem LOADS PROGRAM INTO INTEGER BASIC TIMNER WRAPPER
Rem
z$ = REST$
Call cut32(z$, RETVAL$)
 z$ = RETVAL$
 If Right$(z$, 4) <> ".COB" Then z$ = z$ + ".COB"
PROMPT$ = PROMPT$ + " PUTTING " + z$ + " INTO TIMER"
ChDir App.Path + "\basic\"
Close #8
Open z$ For Input As #8
X = 1
Do
 If EOF(8) = False Then Line Input #8, a$
 programarry1$(X, zz) = a$
 X = X + 1
Loop Until EOF(8)
Close #8
  PROMPT$ = PROMPT$ + Chr$(13) + REST$ + " IN TIMER MEMORY -" + Str$(zz)
 Case Is = "INCERTLINE"
   Call PROCTEXT(NODENAME$, REST$, nodereturndata$)
 Case Is = "PROGRAMTOSOURCE"
  W$ = ""
  For AX = 0 To (MAXPROGSIZE)
    T$ = PROGRAMARRY$(AX)
     l = Len(T$)
     If l > 0 Then W$ = W$ & Str$(AX) + " " + T$ + Chr$(13) + Chr$(13)
  Next AX
  Source.text1 = Source.text1 + W$
 Case Is = "PRINT", "?"
   
   TXT$ = REST$
    
Call buildinexp(TXT$, outtext$)
   If NODENAME$ = "PROMPT" Or NODENAME$ = "PROMPT$" Then OUTTOCRTTEXT$ = outtext$
  nodereturndata$ = outtext$ + CR$ ' to be passed to node
  
 Case Is = "RUN"

  Call progrun
 
Case Is = "GOTO"
  LGOTO$ = REST$
Case Is = "MATHINVAL"
 TXT$ = REST$
  Call buildinexp(TXT$, outtext$)
   TiCalculator.txtExpr = outtext$
Case Is = "MATHRETVAL"
Call putval(p1$, TiCalculator.text1)

Case Is = "MATH"
TXT$ = REST$

Call buildinexp(TXT$, outtext$)
TiCalculator.text1 = avaliarExpr(outtext$)
 
 Case Is = "LET"
 var$ = p2$
 Call getvar(var$, RETVAL$)
 p2$ = RETVAL$
 Call putval(p1$, p2$)
 
 'Debug.Print p1$, p2$
 Case Is = "VARIABLES"
 Variables.Show
 Case Is = "NEW"
 xx = 1
Break = 0

Do
 xx = xx + 1
PROGRAMARRY$(xx) = ""

Loop Until xx >= (MAXPROGSIZE) Or xx > (PROGLENGTH)
PROGLENGTH = 0
 MsgBox ("PROGRAM CLEARED")

 
 Case Is = "FILES"
 filepad2.Show
 
 Case Is = "GRMAX"

 Case Is = "BYE", "EXIT"
  Call exitprogsub
 Case Is = "KEYBOARD"
  Keyboard.Show
  
  Case Is = "END"
 PRFUNCTION$ = "BREAK"
 
 Case Is = "DTA"
 PROMPT$ = vbcad.text1
 Case Is = "HELP"
  PROMPT$ = PROMPT$ + "----------- HELP ----------- " + CR$
  PROMPT$ = PROMPT$ + "Beep tone print srun task source sendnode0" + CR$
  PROMPT$ = PROMPT$ + "goto node1show sendnode1  " + CR$
  PROMPT$ = PROMPT$ + "nodelist               CirCle Pset " + CR$
  PROMPT$ = PROMPT$ + "              line   Box " + CR$
  PROMPT$ = PROMPT$ + "GR SYS  " + CR$
 
 
 Case Is = "SRUN"
 PRFUNCTION$ = "RUN"
 Case Is = "TASK"
 PROMPT$ = PROMPT$ + PRFUNCTION$ + CR$
 Case Is = "SOURCE"
 Source.Show
 
 Case Is = "L", "LINE"
 GR.Line (V1, v2)-(v3, V4), QBColor(V5)
 
 Case Is = "CLS"
PROMPT$ = "READY" + CR$
 
 Case Is = "GR"
 GR.Show
 
 Case Is = "GRCLS"
 GR.Cls
 
 Case Is = "CLS", "TEXT", "AUDIO"
      TEXTSHOW = 1


 Case Is = "NOTEXT"
 TEXTSHOW = 0

 Case Is = "CIRCLE", "CIRC", "C"
    GR.Circle (V1, v2), v3, QBColor(V4)

 Case Is = "CADDATABASE"
   caddatabase.Show

 Case Is = "CAD"
 Close #1
 Open Root$ + "CADOBJ.DAT" For Output As #1
 'Print "BUILDING CAD DATA"
 Print #1, SWTH / 2
 Print #1, SHHT / 2
 Print #1, Chr$(34) + p1$ + Chr$(34)
 Close #1
 'CHAIN Root$ + "QBCAD.BAS"

 
  
 Case Is = "SAVE"
  Call SVPROGRAM(p1$)


 Case Is = "LOAD"
  l = Len(REST$)
  If l > 2 Then Call LDPROGRAM(p1$)


 Case Is = "SAY"
 speaker (REST$)
   GR.Cls
 

 Case Is = "LPRINT"
     Rem If LP1 = 1 Then Print #8, SUFFIX$

      Rem If prnbr = 0 Then LPRINT P1$

 'Select Case (prnsd$)
 'Case Is = "S"
 'prnouttext$ = P1$
 'Case Is = "P"
 'LPRINT P1$
 Case Is = "CLS"
 PROMPT$ = "Ready" + CR$

 
 Case Is = "LIST"
  
  PROLIST$ = "1"
  
 Case Is = "BEEP"
 Beep
 
 
 End Select


 text$ = ""
 ' 10, 1: PRINT STRING$(20, " ")
Loop Until ALLTEXTC >= (alltextcl)
Loop Until AXTEXTC >= (AXTEXTCL)

End If
Exit Sub
ERNOPAGE:
'REST$ = "MENU.TXT"
RETURNNODEDATA$ = "BBS@TEXT ERROR 404 PAGE " + REST$ + "   DOES NOT EXIST " + CR$
Close #1
End Sub
Public Sub ADDMUSICUPLOAD(Nd$, N$)
Rem add an upload to the music upload list


cx = 0
Do
ch$ = musictransfers$(cx, 0)


If ch$ = (p1$) Or ch$ = "" Then
   musictransfers$(cx, 0) = Nd$
   musictransfers$(cx, 1) = N$
   musictransfers$(cx, 2) = Str$(cx)
   musictransfers$(cx, 3) = "OPEN"
   Select Case (cx)
   Case Is = 0
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #40
   Case Is = 1
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #41
   Case Is = 2
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #42
   Case Is = 3
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #43
   Case Is = 4
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #44
   Case Is = 5
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #45
   Case Is = 6
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #46
   Case Is = 7
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #47
   Case Is = 8
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #48
   Case Is = 9
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #49
   Case Is = 10
    Open App.Path + "\MUSIC\" + N$ For Binary Access Read As #50
   
    
    
    
    
   
   
   End Select
   
   'BBSCHOICE$(cx, 0) = p1$
   'BBSCHOICE$(cx, 1) = p2$
   'BBSCHOICE$(cx, 2) = NODEREST2$
End If
cx = cx + 1


Loop Until ch$ = (p1$) Or ch$ = "" Or cx >= 10




End Sub

Public Sub savemodemsettings()
Rem sub that backs up settings and <at> commands
Call savenodesettings
Call saveportATcom
Call saveportbaud

OUTTOCRTTEXT$ = CR$ + Date$ + CR$ + Time$ + CR$ + "Node settings saved." + CR$

End Sub

Public Sub savenodesettings()
Rem setup the node ports
Rem and save them to portsetup.ini
fre = FreeFile
Open App.Path + "\PORTSETUP.INI" For Output As #fre
 ct = 0
  Do
   Select Case (ct)
   Case Is = 0
    ed$ = ConfigScrn.text1
   Case Is = 1
    ed$ = ConfigScrnnode1.text1
   Case Is = 2
    ed$ = ConfigScrnnode2.text1
   Case Is = 3
    ed$ = ConfigScrnnode3.text1
   Case Is = 4
    ed$ = ConfigScrnnode4.text1
   Case Is = 5
    ed$ = ConfigScrnnode5.text1
   Case Is = 6
    ed$ = ConfigScrnnode6.text1
   Case Is = 7
    ed$ = ConfigScrnnode7.text1
   Case Is = 8
    ed$ = ConfigScrnnode8.text1
   Case Is = 9
    ed$ = ConfigScrnnode9.text1
   Case Is = 10
    ed$ = ConfigScrnnode10.text1
   Case Is = 11
    ed$ = ConfigScrnnode11.text1
   Case Is = 12
    ed$ = ConfigScrnnode12.text1
   Case Is = 13
    ed$ = ConfigScrnnode13.text1
   Case Is = 14
    ed$ = ConfigScrnnode14.text1
   
   End Select
   a$ = Str$(ct) + " " + ed$
   Print #fre, a$ + CR$
  

   ct = ct + 1
  Loop Until ct >= 24
Close #fre


End Sub
Public Sub saveportATcom()
fre = FreeFile
Open App.Path + "\PORTATco.INI" For Output As #fre
 ct = 0
  Do
   Select Case (ct)
   Case Is = 0
    ed$ = ConfigScrn.text2
   Case Is = 1
    ed$ = ConfigScrnnode1.text2
   Case Is = 2
    ed$ = ConfigScrnnode2.text2
   Case Is = 3
    ed$ = ConfigScrnnode3.text2
   Case Is = 4
    ed$ = ConfigScrnnode4.text2
   Case Is = 5
    ed$ = ConfigScrnnode5.text2
   Case Is = 6
    ed$ = ConfigScrnnode6.text2
   Case Is = 7
    ed$ = ConfigScrnnode7.text2
   Case Is = 8
    ed$ = ConfigScrnnode8.text2
   Case Is = 9
    ed$ = ConfigScrnnode9.text2
   Case Is = 10
    ed$ = ConfigScrnnode10.text2
   Case Is = 11
    ed$ = ConfigScrnnode11.text2
   Case Is = 12
    ed$ = ConfigScrnnode12.text2
   Case Is = 13
    ed$ = ConfigScrnnode13.text2
   Case Is = 14
    ed$ = ConfigScrnnode14.text2
   
   End Select
   a$ = Str$(ct) + " " + ed$
   Print #fre, a$
  

   ct = ct + 1
  Loop Until ct >= 24
Close #fre



End Sub


Public Sub saveportbaud()
fre = FreeFile
Open App.Path + "\PORTbaud.INI" For Output As #fre
 ct = 0
  Do
   Select Case (ct)
   Case Is = 0
    ed$ = Vbterm.MSComm1.Settings
   Case Is = 1
    ed$ = Vbtermnode1.MSComm1.Settings
   Case Is = 2
    ed$ = Vbtermnode2.MSComm1.Settings
  Case Is = 3
    ed$ = Vbtermnode3.MSComm1.Settings
  Case Is = 4
    ed$ = Vbtermnode4.MSComm1.Settings
  Case Is = 5
    ed$ = Vbtermnode5.MSComm1.Settings
  Case Is = 6
    ed$ = Vbtermnode6.MSComm1.Settings
  Case Is = 7
    ed$ = Vbtermnode7.MSComm1.Settings
  Case Is = 8
    ed$ = Vbtermnode8.MSComm1.Settings
  Case Is = 9
    ed$ = Vbtermnode9.MSComm1.Settings
  Case Is = 10
    ed$ = Vbtermnode10.MSComm1.Settings
  Case Is = 11
    ed$ = Vbtermnode11.MSComm1.Settings
  Case Is = 12
    ed$ = Vbtermnode12.MSComm1.Settings
  Case Is = 13
    ed$ = Vbtermnode13.MSComm1.Settings
  Case Is = 14
    ed$ = Vbtermnode14.MSComm1.Settings
  Case Is = 15
    ed$ = Vbtermnode15.MSComm1.Settings
  Case Is = 16
    ed$ = Vbtermnode16.MSComm1.Settings
  Case Is = 17
    ed$ = Vbtermnode17.MSComm1.Settings
  Case Is = 18
    ed$ = Vbtermnode18.MSComm1.Settings
  Case Is = 19
    ed$ = Vbtermnode19.MSComm1.Settings
  Case Is = 20
    ed$ = Vbtermnode20.MSComm1.Settings
  Case Is = 21
    ed$ = Vbtermnode21.MSComm1.Settings
  Case Is = 22
    ed$ = Vbtermnode22.MSComm1.Settings
  Case Is = 23
    ed$ = Vbtermnode23.MSComm1.Settings
  Case Is = 24
    ed$ = Vbtermnode24.MSComm1.Settings
  
   
   End Select
   a$ = Str$(ct) + " " + ed$
   Print #fre, a$ + CR$
  

   ct = ct + 1
  Loop Until ct >= 24
Close #fre
End Sub


Public Sub sendramdisk(sendname$, phr$)
Rem send data to ramdisk file
l = Len(phr$)
If l > 0 Then
Open sendname$ For Output As 1
 Print #1, phr$ + Chr$(13)
 Debug.Print
Close #1
End If
End Sub
Public Sub cutchr13(text0$)
 l = Len(text0$)
 ttt$ = ""
 For z = 1 To (l)
 ch$ = Mid$(text0$, z, 1)
  If ch$ <> Chr$(13) Then
    ttt$ = ttt$ + ch$
  End If
 
 Next z
 text0$ = ttt$

End Sub

Public Sub cutchr10(text0$)
l = Len(text0$)
 ttt$ = ""
 For z = 1 To (l)
 ch$ = Mid$(text0$, z, 1)
  If ch$ <> Chr$(10) Then
    ttt$ = ttt$ + ch$
  End If
 
 Next z
 text0$ = ttt$
End Sub
Public Sub exitprogsub()
N$ = "1"
NODEREST$ = "BBS@TEXT dissconnected from host " + CR$
NODEREST$ = NODEREST$ + "BBS@TEXT port closed at " + Time$ + CR$
Call NODEOUT(N$, NODEREST$)
N$ = "2"
Call NODEOUT(N$, NODEREST$)



midi_out_close
OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + CR$ + Date$ + CR$ + Time$ + "Exiting BBS" + CR$ + "shutting down."

MsgBox (" closing all nodes .")

End

End Sub

Public Function MD5String(KeyAndPass As String) As String

    Dim r As String * 32, T As Long
    r = Space(32)
    T = Len(KeyAndPass)
    MDStringFix KeyAndPass, T, r
    MD5String = r
End Function

Function GetResponse(Nonce As String, CNonce As String, NonceCount As String, QOP As String, Username As String, Password As String, Realm As String, Method As String, URi As String)

    Dim Buffer As String
    Dim Buffer2 As String
    Dim Buffer3 As String
    
    Buffer = MD5String(Username & ":" & Realm & ":" & Password)
    Buffer2 = MD5String(Method & ":" & URi)
    Buffer3 = MD5String(Buffer & ":" & Nonce & ":" & NonceCount & ":" & CNonce & ":" & QOP & ":" & Buffer2)
    
    GetResponse = Val(Buffer3)
End Function
Public Sub boot()

mainmidi.Show
toneform.Show
GR.Show
Source.Show
Vbterm.Show
nodelist.Show
chatform.Show
excelform.Show
ConfigScrn.Show
ConfigScrnnode1.Show

CR$ = Chr$(13) + Chr$(10)

OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "Raccoon BASIC 1.00    all rights reserved (c)" + CR$

OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + "path is " + App.Path

Open App.Path + "\qbasic\incom.txt" For Output As 1
 Print #1, " "
Close #1

Open App.Path + "\qbasic\outcom.txt" For Output As 1
 Print #1, "print bbs on" + Time$
Close


Open App.Path + "\ramdrives\disklist.txt" For Input As 1
 Do
  Input #1, a$
 
 ramdisklist$ = ramdisklist$ + a$ + CR$
 Loop Until EOF(1)
 
OUTTOCRTTEXT$ = OUTTOCRTTEXT$ + CR$ + "Ramdisk is set to " + ramdisklist$ + CR$
Close



Source.Show
Joystickdebug.Show

'RESPONSE RECEIVED FROM HTTP SERVER:
'HTTP/1.1 401 Authorization Required..Server: Microsoft-IIS/5.0..Date: Tue, 07 May 2002 17:14:49 GMT..P3P:CP="BUS CUR CONo FIN IVDo ONL OUR PHY SAMo TELo"..Connection: close..Content-Type: text/html..WWW-Authenticate: Digest realm="hotmail.com", nonce="MTAyMDc5MTY4OTowZjY5YmE1NjEzNmM5YTE4NGZmNGQ1ZWFkNzU3ZTIxNw==", qop="auth"..X-Dav-Error: 401 Wrong email address....HMServer: H: DAV73 V: WIN2K 09.04.50.0031 i D: Apr 18 2002 12:14:38...
'=============================================
'To CALCULATE THE RESPONSE VALUE:
'MsgBox (GetResponse("MTAyMDc5MTY4OTowZjY5YmE1NjEzNmM5YTE4NGZmNGQ1ZWFkNzU3ZTIxNw==", "b6327c933ceeb677f8d6056c60aeabcb", "00000001", "auth", "[USERNAME]", "[PASSWORD]", "hotmail.com", "PROPFIND", "/cgi-bin/hmdata"))
'=============================================

'Agent1.Characters.Load "merlin", path1
'    Set merlin = Agent1.Characters("merlin")
'    merlin.LanguageID = &H409
'    merlin.Show ' show merlin
'    merlin.Speak "whatever" ' merlin says what you
'    ' tell him to say




CR$ = Chr$(13) + Chr$(10)
 cart1$ = "Basic Interpriter Raccoon BBS"
 cart2$ = "<empty>"
 
 PROMPT$ = " " + CR$ + " ##" + CR$
 PROMPT$ = PROMPT$ + cart1$ + CR$
 PROMPT$ = PROMPT$ + cart2$
 'CART1$ THIS IS CARTRIGE 1
  B$ = "BBS"
  patchnode0$ = B$
  patchnode1$ = B$
  patchnode2$ = B$
  patchnode3$ = B$
  patchnode4$ = B$
  patchnode5$ = B$
  patchnode6$ = B$
  patchnode7$ = B$
  patchnode8$ = B$
  patchnode9$ = B$
  patchnode10$ = B$
  patchnode11$ = B$
  patchnode12$ = B$
  patchnode13$ = B$
  patchnode14$ = B$
  patchnode15$ = B$
  patchnode16$ = B$
  patchnode17$ = B$
  patchnode18$ = B$
  patchnode19$ = B$
  patchnode20$ = B$
  patchnode21$ = B$
  patchnode22$ = B$
  patchnode23$ = B$
  patchnode24$ = B$
vbcad.Show
bbswindow.Show

bbstrailtext = "< not connected >"
Rem setup node baud parity stop bit ect

'On Error GoTo noportbaud:
fre = FreeFile
Open App.Path + "\PORTbaud.INI" For Input As fre
 Do
 Line Input #fre, a$
' MsgBox (a$)
  Call procportbaud(a$)

 Loop Until EOF(fre)
Close #fre

Rem setup the node ports
On Error GoTo noportsetup:
fre = FreeFile
Open App.Path + "\PORTSETUP.INI" For Input As fre
 Do
 Line Input #fre, a$
  Call PROCPORTSETUP(a$)

 Loop Until EOF(fre)
Close #fre
'On Error GoTo noportatco:
fre = FreeFile
Open App.Path + "\PORTATco.INI" For Input As fre
 Do
 Line Input #fre, a$
' MsgBox (a$)
  Call procportatco(a$)

 Loop Until EOF(fre)
Close #fre



Exit Sub
noportatco:
fre1 = FreeFile
Open App.Path + "\PORTATco.INI" For Output As fre1
Print #fre1, " rem ***" + CR$
Close fre1

Resume

noportbaud:
fre2 = FreeFile
Open App.Path + "\PORTbaud.INI" For Output As fre2
Print #fre2, " rem ***" + CR$
Close fre2

Resume

noportsetup:

fre1 = FreeFile
Open App.Path + "\PORTSETUP.INI" For Output As fre1
Print #fre1, " rem ***" + CR$
Close fre1

Resume
End Sub
Public Sub PROCPORTSETUP(a$)
Rem SETUP PORTS FOR
Rem  BBS LINES
l = Len(a$)
text$ = a$

word$ = ""
 l = Len(text$)
 X = 1
 Call mtbp(text$, otxt$, Q)
 Call gnpart(text$, otxt$, Q): word$ = otxt$: REST$ = Right$(text$, l - Q + 1): word$ = UCase$(word$)
 Call gnpart(text$, otxt$, Q): p1$ = otxt$
 Select Case (word$)
 Case Is = "VBTERM", "NODE0", "0"
   ConfigScrn.Show
   ConfigScrn.text1 = REST$
    ConfigScrn.OKButton = True
 Case Is = "NODE1", "1"
 ConfigScrnnode1.Show
   ConfigScrnnode1.text1 = REST$
    ConfigScrnnode1.OKButton = True
 Case Is = "NODE2", "2"
 ConfigScrnnode2.Show
   ConfigScrnnode2.text1 = REST$
    ConfigScrnnode2.OKButton = True
 Case Is = "NODE3", "3"
 ConfigScrnnode3.Show
   ConfigScrnnode3.text1 = REST$
    ConfigScrnnode3.OKButton = True
 Case Is = "NODE4", "4"
 ConfigScrnnode4.Show
   ConfigScrnnode4.text1 = REST$
    ConfigScrnnode4.OKButton = True
 Case Is = "NODE5", "5"
 ConfigScrnnode5.Show
   ConfigScrnnode5.text1 = REST$
    ConfigScrnnode5.OKButton = True
 Case Is = "NODE6", "6"
 ConfigScrnnode6.Show
   ConfigScrnnode6.text1 = REST$
    ConfigScrnnode6.OKButton = True
 Case Is = "NODE7", "7"
 ConfigScrnnode7.Show
   ConfigScrnnode7.text1 = REST$
    ConfigScrnnode7.OKButton = True
 
 Case Is = "NODE8", "8"
 ConfigScrnnode8.Show
   ConfigScrnnode8.text1 = REST$
    ConfigScrnnode8.OKButton = True
 Case Is = "NODE9", "9"
 ConfigScrnnode9.Show
   ConfigScrnnode9.text1 = REST$
    ConfigScrnnode9.OKButton = True
 Case Is = "NODE10", "10"
 ConfigScrnnode10.Show
   ConfigScrnnode10.text1 = REST$
    ConfigScrnnode10.OKButton = True
 Case Is = "NODE11", "11"
 ConfigScrnnode11.Show
   ConfigScrnnode11.text1 = REST$
    ConfigScrnnode11.OKButton = True
Case Is = "NODE12", "12"
 ConfigScrnnode12.Show
   ConfigScrnnode12.text1 = REST$
    ConfigScrnnode12.OKButton = True
Case Is = "NODE13", "13"
 ConfigScrnnode13.Show
   ConfigScrnnode13.text1 = REST$
    ConfigScrnnode13.OKButton = True
Case Is = "NODE14", "14"
 ConfigScrnnode14.Show
   ConfigScrnnode14.text1 = REST$
    ConfigScrnnode14.OKButton = True
 
 End Select
End Sub
Public Sub buildnodearray()
 CR$ = Chr$(13) + Chr$(10)
  stplvar = Val(nodelist.text2)
For NXX = stplvar To 127
 z$ = nodelistdatabase$(NXX, 0)
 zz$ = nodelistdatabase$(NXX, 1)
 ZZZZ$ = nodelistdatabase$(NXX, 3)
 ZUSERNAME$ = nodelistdatabase$(NXX, 5)
 zzz$ = ""
 If ZZZZ$ = "ON" Then
   'Call Vbterm.GETNODE(NNX, NODEINTEXT$)
   zzz$ = NODEINTEXT$
 End If
 nodelistdatabase$(NXX, 2) = zzz$
 
 ZZZZZ$ = nodelistdatabase$(NXX, 4)
  nodeTXT$ = nodeTXT$ + ZUSERNAME$ + " - ON [" + Str$(NXX) + "]" + z$ + " " + zz$ + " " + zzz$ + " " + ZZZZ$ + " " + ZZZZZ$ + CR$
Next NXX

nodelist.text1 = nodeTXT$
nodeTXT$ = ""

End Sub
Public Sub buildinexp(TXT$, outtext$)
l = Len(TXT$)
outtext$ = ""

'If X <= (l) Then ch$ = Mid$(TXT$, X, 1)
'If X >= (l) Or ch$ = " " Or ch$ = "," Or ch$ = "+" Or ch$ = "-" Or ch$ = "*" Or ch$ = "/" Or ch$ = "(" Or ch$ = ")" Then
'   var$ = WD$
'   Call cut32(var$, retval$)
'   var$ = retval$
'   Call getvar(var$, retval$)
'   WD$ = ""
'   outtext$ = outtext + retval$
'End If

Q = 1
cmd$ = TXT$ + " "
Do

'WD$ = WD$ + ch$

Call gnpart(cmd$, otxt$, Q)
Q = Q - 1
var$ = otxt$
Call cut32(var$, RETVAL$)
   var$ = RETVAL$
   Call getvar(var$, RETVAL$)
   WD$ = ""
   outtext$ = outtext + RETVAL$ + " "
Q = Q + 1
Loop Until Q > (l)
'Debug.Print "outtext$ "; ouTtext$

End Sub


Public Sub cut32(var$, RETVAL$)
RETVAL$ = ""
z$ = var$
l = Len(z$)
For X = 1 To (l)
ch$ = Mid$(z$, X, 1)
If ch$ <> Chr$(32) Then
 W$ = W$ + ch$
End If
Next X
RETVAL$ = W$
'Debug.Print "cut32 "; retval$
End Sub


Public Sub procportbaud(a$)
a$ = a$ + CR$
l = Len(a$)
cmd$ = a$
word$ = ""
 l = Len(cmd$)
Q = 1

 Call mtbp(cmd$, otxt$, Q)
 Call gnpart(cmd$, otxt$, Q): word$ = otxt$
 REST$ = Right$(cmd$, l - Q + 1)
 var$ = REST$
 Call cut32(var$, RETVAL$)
 REST$ = RETVAL$
a$ = REST$
Call cutchr1310(a$, RETVAL$)
 REST$ = RETVAL$
 word$ = UCase$(word$)
' Call gnpart(text$, otxt$, Q)
 var$ = word$
 Call cut32(var$, RETVAL$)
 word$ = RETVAL$
 wl = Len(word$)
 l = Len(REST$)
'MsgBox ("<" + REST$ + ">" + Str$(l))
 Select Case (word$)
 Case Is = "VBTERM", "NODE0", "0"
 Vbterm.MSComm1.Settings = REST$
 
 Case Is = "NODE1", "1"
 Vbtermnode1.MSComm1.Settings = REST$
 
 Case Is = "NODE2", "2"
 Vbtermnode2.MSComm1.Settings = REST$
 
 
 Case Is = "NODE3", "3"
 Vbtermnode3.MSComm1.Settings = REST$
 Case Is = "NODE4", "4"
 Vbtermnode4.MSComm1.Settings = REST$
 
 
 Case Is = "NODE5", "5"
 Vbtermnode5.MSComm1.Settings = REST$
 
 Case Is = "NODE6", "6"
 Vbtermnode6.MSComm1.Settings = REST$
 
 
 Case Is = "NODE7", "7"
 Vbtermnode7.MSComm1.Settings = REST$
 
 
 Case Is = "NODE8", "8"
 Vbtermnode8.MSComm1.Settings = REST$
 
 
 Case Is = "NODE9", "9"
 Vbtermnode9.MSComm1.Settings = REST$
 
 Case Is = "NODE10", "10"
 Vbtermnode10.MSComm1.Settings = REST$
 
 Case Is = "NODE11", "11"
 Vbtermnode11.MSComm1.Settings = REST$
 
 
 Case Is = "NODE12", "12"
 Vbtermnode12.MSComm1.Settings = REST$
 
 Case Is = "NODE13", "13"
 Vbtermnode13.MSComm1.Settings = REST$
 
 Case Is = "NODE14", "14"
 Vbtermnode14.MSComm1.Settings = REST$
 
 Case Is = "NODE15", "15"
 Vbtermnode15.MSComm1.Settings = REST$
 
 Case Is = "NODE16", "16"
 Vbtermnode16.MSComm1.Settings = REST$
 
 Case Is = "NODE17", "17"
 Vbtermnode17.MSComm1.Settings = REST$
 
 Case Is = "NODE18", "18"
 Vbtermnode18.MSComm1.Settings = REST$
 
 Case Is = "NODE19", "19"
 Vbtermnode19.MSComm1.Settings = REST$
 
 Case Is = "NODE20", "20"
 Vbtermnode20.MSComm1.Settings = REST$
 
 Case Is = "NODE21", "21"
 Vbtermnode21.MSComm1.Settings = REST$
 
 Case Is = "NODE22", "22"
 Vbtermnode22.MSComm1.Settings = REST$
 
 Case Is = "NODE23", "23"
 Vbtermnode23.MSComm1.Settings = REST$
 
 Case Is = "NODE24", "24"
 Vbtermnode24.MSComm1.Settings = REST$
 
 
 End Select
End Sub

Sub getjoystick(MH, MV, MH1, MV1)


  

End Sub

Public Sub getvar(var$, RETVAL$)

If Left$(var$, 1) = Chr$(34) Then
   RETVAL$ = var$
Else
   On Error GoTo BADVAR:
   z = Val(var$)
   If z <> 0 Then
    RETVAL$ = var$
   Else

    X = 0
    Do
    ch$ = varrs$(X, 0)
    If ch$ = (var$) Then RETVAL$ = varrs$(X, 1)
    X = X + 1
    Loop Until X >= 200

    End If
  End If
If RETVAL$ = "" Then RETVAL$ = var$
var$ = UCase$(var$)
Debug.Print "evaluating ..."; var$; "-"
Select Case (var$)
Case Is = "RAMDISK$"
RETVAL$ = ""

Case Is = "DATE$"
RETVAL$ = Date$
Case Is = "TIME$"
RETVAL$ = Time$
Case Is = "MOUSEX"
        RETVAL$ = Str$(mousex)
Case Is = "MOUSEY"
        RETVAL$ = Str$(mousey)
Case Is = "MOUSEBUTTON"
        RETVAL$ = Str$(mousebutton)
Case Is = "GRMOUSEX"
        RETVAL$ = Str$(grmousex)
Case Is = "GRMOUSEY"
        RETVAL$ = Str$(grmousey)
Case Is = "GRBUTTON"
        RETVAL$ = Str$(grbutton)
        
Case Is = "JOY0HVAL"
        RETVAL$ = Joystickdebug.Label1
Case Is = "JOY0VVAL"
        RETVAL$ = Joystickdebug.Label2
Case Is = "JOYBUT0"
        RETVAL$ = Joystickdebug.Label3
Case Is = "JOY1HVAL"
        RETVAL$ = Joystickdebug.Label5
Case Is = "JOY1VVAL"
        RETVAL$ = Joystickdebug.Label6
Case Is = "JOYBUT1"
        RETVAL$ = Joystickdebug.Label7
        




Case Is = "DRAWQA"
       RETVAL$ = Str$(DRAWQA)
Case Is = "DRAWTA"
       RETVAL$ = Str$(DRAWTA)
End Select
Exit Sub
BADVAR:
RETVAR$ = var$

End Sub

Sub gnpart(cmd$, otxt$, Q)
ext = 0
ll = Len(cmd$)
If Q <= (ll) Then
If Q = 0 Then Q = 1

otxt$ = ""
ch$ = ""


 ch$ = Mid$(cmd$, Q, 1)
If ch$ = Chr$(34) Then
Do
Q = Q + 1
ch$ = Mid$(cmd$, Q, 1)
If ch$ <> Chr$(34) Then otxt$ = otxt$ + ch$
If ch$ = Chr$(34) Then ext = 1
Loop Until ext = 1 Or Q >= (ll)


End If

If ext = 1 Then Exit Sub
Do
 
  ch$ = Mid$(cmd$, Q, 1)

If ch$ <> "=" And 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
If Q + 1 <= (l1) Then nch$ = Mid$(cmd$, Q + 1, 1)

Loop Until nch$ = Chr$(32) Or ch$ = "=" Or ch$ = Chr$(13) Or ch$ = ":" Or ch$ = "," Or ch$ = Chr$(34) Or ch$ = Chr$(32) Or Q >= (ll)

End If

'MsgBox ("otxt$ " + otxt$)
End Sub






Public Sub INITVAR()

MAXPROGSIZE = 800


var$ = "GRDRAWH"
Call putval(var$, putvaR$)
var$ = "GRDRAWV"
Call putval(var$, putvaR$)

End Sub

Sub LDPROGRAM(p1$)
Rem
Rem LOADS PROGRAM INTO INTEGER BASIC
Rem
GR.Cls
PROMPT$ = ""
z$ = p1$

Call cut32(z$, RETVAL$)
z$ = RETVAL$

If Right$(z$, 4) <> ".COB" Then z$ = z$ + ".COB"


PROMPT$ = PROMPT$ + " getting " + z$
ChDir App.Path + "\basic\"

Open z$ For Input As #8
X = 1
Do
'PROMPT$ = PROMPT$ + a$

 If EOF(8) = False Then Line Input #8, a$
pl = Len(a$)
Debug.Print PROMPT$
If pl > 0 Then
   NODENAME$ = "PROMPT$"
   Debug.Print "[" + a$
   ZL = Len(a$)
   If Left$(a$, 1) = Chr$(32) Then
    If ZL > 2 Then a$ = Right$(a$, ZL - 1)
   Q = 1
   cmd$ = a$
   Call gnpart(cmd$, otxt$, Q)
   X = Val(otxt$)
   End If
   Call PROCTEXT(NODENAME$, a$, nodereturndata$)
End If
 'PROGRAMARRY$(X) = a$


 X = X + 1
Loop Until EOF(8)


Close #8
   PROGLENGTH = X



End Sub


Sub lstprog()
 GR.Cls
 PROMPT$ = PROMPT$ + PROGLENGTH + CR$

For X = 1 To (PROGLENGTH)

  PROMPT$ = PROMPT$ + Str$(X) + PROGRAMARRY$(X)

 a$ = keval$

 'If A$ = Chr$(32) Then SLEEP



Next X
End Sub

Sub modemsettings()

Rem self explanatory
Rem   change the baud parity port ect
Rem





End Sub






Public Sub NODEOUT(N$, NODEREST$)

Select Case (N$)
Case Is = "0"
qbasicouttext$ = qbasicouttext$ + NODEREST$ + Chr$(13)
Case Is = "1", "PROMPT", "VBTERM"
node1outtext$ = NODEREST$ + Chr$(13)
Case Is = "2"
node2outtext$ = NODEREST$ + Chr$(13)
Case Is = "3"
NODE3OUTTEXT$ = NODEREST$ + Chr$(13)
Case Is = "4"
node4outtext$ = NODEREST$ + Chr$(13)
Case Is = "5"
NODE5OUTTEXT$ = NODEREST$ + Chr$(13)



End Select
End Sub



Sub OSERR(z)



For H = 1 To 5

PROMPT$ = PROMPT$ + String$(79, " ")

Next H

PROMPT$ = PROMPT$ + "ERROR >" + Str$(z)

Select Case (z)
Case Is = 1
mess$ = " NEXT WITHOUT FOR"

Case Is = 2
mess$ = " SYNTAX ERROR"

Case Is = 3
mess$ = " RETURN WITHOUT GOSUB"

Case Is = 4
mess$ = "OUT OF DATA"

Case Is = 5

mess$ = "ILLEAGLE FUNCTION CALL"

Case Is = 6
mess$ = "OVERFLOW"

Case Is = 7
mess$ = "OUT OF MEMORY"

Case Is = 8

mess$ = "LABEL NOT DEFINED"

Case Is = 9

mess$ = "SUBSCRIPT OUT OF RANGE"

Case Is = 10

mess$ = "DUPLICATE DEFINITION"

Case Is = 11

mess$ = "DIVISION BY ZERO"

Case Is = 12

mess$ = "ILLEAGLE IN DIRECT MODE"

Case Is = 13

mess$ = "TYPE MISMATCH"

Case Is = 14

mess$ = "OUT OF STRING SPACE"

Case Is = 15

mess$ = "YOUR GUESS IS AS GOOD AS MINE ??"

Case Is = 16

mess$ = ""
Case Is = 24
mess$ = " device timeout "

Case Is = 52
mess$ = "BAD FILE NAME OR NUMBER"
Case Is = 62
mess$ = "INPUT PAST END OF FILE"

Case Is = 64
mess$ = "bad file name"


Case Is = 68

mess$ = "DEVISE UNAVAILABLE"


End Select


PROMPT$ = PROMPT$ + "  ##  ERROR " + mess$









ynb$ = UCase$(ynb$)

If ynb$ = "YES" Or ynb$ = "Y" Then

PROMPT$ = PROMPT$ + "going into Qbasic - bye !!!"


'End
Else




End If


End Sub





Public Sub EXTRACTVAR(REST$, RETVAL$)
cmd$ = REST$
ll = Len(cmd$)
SECT$ = ""
Do
otxt$ = ""
Call gnpart(cmd$, otxt$, Q)
 var$ = otxt$: 'Debug.Print var$
 
 
 Call getvar(var$, RETVAL$)
  
  
  SECT$ = SECT$ + RETVAL$ + " "
Loop Until Q > (ll)

RETVAL$ = SECT$

End Sub

Public Sub progrun()
Rem
Rem
Rem RUN THE PROGRAM
BASICPROMPT.Cls
CURRENTXX = 0
Break = 0
PROGRAMRUN = 1
'PRFUNCTION$ = "RUN"


End Sub



Public Sub putval(var$, putvaR$)
ext = 0
Do
ch$ = varrs$(X, 0)
If ch$ = "" Or ch$ = (var$) Then varrs$(X, 0) = var$: varrs$(X, 1) = putvaR$: ext = 1
X = X + 1
Loop Until X >= 200 Or ext = 1
End Sub

Sub SAVESET()


Close #1
Open "TISET.WND" For Output As #1

Print #1, WX
Print #1, WY
Print #1, NX
Print #1, NY
Print #1, H
Print #1, V
Print #1, htext$

Close #1


End Sub





Public Sub showterminal(N)
Select Case (N)
Case Is = 0
Vbterm.Show
Case Is = 1
Vbtermnode1.Show
Case Is = 2
Vbtermnode2.Show
Case Is = 3
Vbtermnode3.Show
Case Is = 4
Vbtermnode4.Show
Case Is = 5
Vbtermnode5.Show
Case Is = 6
Vbtermnode6.Show
Case Is = 7
Vbtermnode7.Show
Case Is = 8
Vbtermnode8.Show
Case Is = 9
Vbtermnode9.Show
Case Is = 10
Vbtermnode10.Show
Case Is = 11
Vbtermnode11.Show
Case Is = 12
Vbtermnode12.Show
Case Is = 13
Vbtermnode13.Show
Case Is = 14
Vbtermnode14.Show
Case Is = 15
Vbtermnode15.Show
Case Is = 16
Vbtermnode16.Show
Case Is = 17
Vbtermnode17.Show
Case Is = 18
Vbtermnode18.Show
Case Is = 19
Vbtermnode19.Show
Case Is = 20
Vbtermnode20.Show
Case Is = 21
Vbtermnode21.Show
Case Is = 22
Vbtermnode22.Show
Case Is = 23
Vbtermnode23.Show
Case Is = 24
Vbtermnode24.Show
End Select
End Sub

Public Sub showtermsettings(N)
Select Case (N)
Case Is = 0
ConfigScrn.Show
Case Is = 1
ConfigScrnnode1.Show
Case Is = 2
ConfigScrnnode2.Show
Case Is = 3
ConfigScrnnode3.Show
Case Is = 4
ConfigScrnnode4.Show
Case Is = 5
ConfigScrnnode5.Show
Case Is = 6
ConfigScrnnode6.Show
Case Is = 7
ConfigScrnnode7.Show
Case Is = 8
ConfigScrnnode8.Show
Case Is = 9
ConfigScrnnode9.Show
Case Is = 10
ConfigScrnnode10.Show
Case Is = 11
ConfigScrnnode11.Show
Case Is = 12
ConfigScrnnode12.Show
Case Is = 13
ConfigScrnnode13.Show
Case Is = 14
ConfigScrnnode14.Show
Case Is = 15
ConfigScrnnode15.Show
Case Is = 16
ConfigScrnnode16.Show
Case Is = 17
ConfigScrnnode17.Show
Case Is = 18
ConfigScrnnode18.Show
Case Is = 19
ConfigScrnnode19.Show
Case Is = 20
ConfigScrnnode20.Show
Case Is = 21
ConfigScrnnode21.Show
Case Is = 22
ConfigScrnnode22.Show
Case Is = 23
ConfigScrnnode23.Show
Case Is = 24
ConfigScrnnode24.Show

End Select

End Sub

Sub speaker(pa$)
'   +-----------------------------------------------------------------------+
'   ¦A1 Ale  ¦D1 Dig  ¦G1 Go   ¦J1 Jug  ¦O1 Over ¦R1 Real ¦U1 Usurp¦Y1 Yard ¦
'   ¦A2 Add  ¦D2 biD  ¦G2 Gem  +--------¦O2 Odd  ¦R2 evER ¦U2 Under¦Y2 monEY¦
'   ¦A3 Above¦D3 buDGE¦G3 baG  ¦K1 Key  ¦O3 nOt  ¦R3 veRy ¦U3 rUde ¦Y3 bAY  ¦
'   ¦A4 AUto +--------¦G4 siNG ¦K2 maKE ¦O4 shORt+--------¦U4 mUte ¦Y4 bOY  ¦
'  ¦A5 tAke ¦E1 Even +--------¦K3 sKate¦O5 bOOt ¦S1 Seem ¦U5 mUd  +--------¦
'   ¦A6 mAt  ¦E2 Ever ¦H1 Hut  +--------¦O6 bOAt ¦S2 miSS ¦U6 pUll ¦Z1 Zone ¦
'   ¦A7 cAr  ¦E3 bEt  ¦H2 WHale¦L1 Like ¦O7 wOOd ¦S3 SHy  ¦U7 hOUse¦Z2 buZZ ¦
'   ¦A8 sAW  ¦E4 wEll +--------¦L2 bowL ¦O8 lOUd ¦S4 waSH ¦U8 awfUL¦Z3 aZure¦
'   +--------¦E5 bEAt ¦I1 Irate¦L3 siLLy+--------+--------+--------+--------¦
'   ¦B1 Bad  ¦E6 hEEl ¦I2 Inane+--------¦P1 Pie  ¦T1 Tie  ¦V1 Very ¦SP short¦
'   ¦B2 daB  ¦E7 vERy ¦I3 tIp  ¦M1 May  ¦P2 naP  ¦T2 laTE ¦V2 aliVE¦   pause¦
'   +--------¦E8 nERd ¦I4 hId  ¦M2 huM  ¦P3 sPin ¦T3 THis +--------+--------¦
'   ¦C1 Cent +--------¦I5 sIte +--------+--------¦T4 baTHE¦W1 Witch¦LP long ¦
'   ¦C2 Case ¦F1 Fat  ¦I6 hIde ¦N1 Nice ¦        ¦T5 THing¦W2 WHich¦   pause¦
'   ¦C3 CHin ¦F2 halF ¦I7 thINK¦N2 saNE ¦Q1 QUeen¦T6 wiTH +--------+--------¦
'   ¦        ¦        ¦I8 thING¦        ¦        ¦        ¦X1 aXis ¦^Z exit ¦
'   +-----------------------------------------------------------------------+
 rword$ = ""
 phr$ = pa$
 phr$ = phr$ + " "
 phr$ = LCase$(phr$)
 reader = 0: wpb = 1: wpl = 1
'Get phrase size and check all letters
   lsize = Len(phr$)

   For lc = 1 To lsize
   letr$ = Mid$(phr$, lc, 1)
   If letr$ = Chr$(32) Or lc = (lsize) Then word$ = Mid$(phr$, wpb, wpl): reader = 1
    rword$ = ""
    For chc = 1 To Len(word$): ch$ = Mid$(word$, chc, 1): If ch$ <> Chr$(32) Then rword$ = rword$ + ch$
    Next chc

      wpl = wpl + 1 ' needed to prevent contiuous loop
' show Reader status in
'   IF reader = 0 THEN PRINT "Idle"

'   IF reader = 1 THEN PRINT "Reading"
While reader = 1
    If wpl > 2 Then lltr$ = Mid$(rword$, wpl - 2, 1)
   If wpl > 2 Then nlltr$ = Mid$(rword$, wpl - 2, 1):

   word$ = word$ + " ": word$ = " " + word$
   ' Show the word being read in cell "e:6"

   For wc = 2 To wpl + 1 ' Read entire word compinsating for character placement
   If wpl > 2 Then pltr$ = Mid$(word$, wc - 1, 1)
   ltr$ = Mid$(word$, wc, 1): nltr$ = Mid$(word$, wc + 1, 1)
   ltva = Val(ltr$)
' sgl stands for single letter
' the below 'if then' statement test to see if the word is a single letter
' sgl returns a 1 if true 0 if false
   pltv = Val(pltr$): nltv = Val(nltr$) ' get the number values of the character if present
   If pltr$ = Chr$(32) And nltr$ = Chr$(32) Then sgl = 1 Else sgl = 0
   If wpl - wc >= 3 Then L3tr$ = Mid$(word$, wc + 2, 1)
' show l3tr$ in cell ("b:3")


' below section of this macro accesses the speech fragments
' it is concerned with assembling speech for numbers
' and commonly used words under united states English western dilect


   lv = 0
  'check to see if word has long vowels "a,e,i,o,u"
   If ltr$ = "a" Or ltr$ = "e" Or ltr$ = "i" Or ltr$ = "o" Or ltr$ = "u" Or ltr$ = "y" Then cfv = 1: vowels = vowels + 1
    If cfv = 1 Then

   If nltr$ = "a" Or nltr$ = "e" Or nltr$ = "i" Or nltr$ = "o" Or nltr$ = "u" Then lv = 1: ntv = 1: moc = 1
   If lltr$ = "a" Or lltr$ = "e" Or lltr$ = "i" Or lltr$ = "o" Or lltr$ = "u" Or lltr$ = "y" Then lv = 1
   If wc < wpl - 3 Then If ltr$ <> "o" And nlltr$ = "a" Or nlltr$ = "e" Or nlltr$ = "i" Or nlltr$ = "o" Or nlltr$ = "u" Then lv = 1

   'return check for vowel to zero hence cfv=0
   'cfv =1 if true 0 if false
   End If

   cfv = 0
   If rsword = 1 Then ltr$ = rword$

   '         [[[[[[[[   ]]]]]]]]
   ' [[[[[[[[  standard letters ]]]]]]]
   '         [[[[[[[[   ]]]]]]]]

' PRINT ltr$ 'for testing purposes only
If ltr$ = "y" And sgl = 1 Then say$ = "w1 i1": ltr$ = ""
If ltr$ = "y" And nltr$ = Chr$(32) Then say$ = "e5": ltr$ = ""
'scope of "a"

   If ltr$ = "a" And sgl = 1 Then say$ = "a1": ltr$ = ""

    ' a cont aeiou section
' Scope of "b"
   If ltr$ = "b" And sgl = 1 Then say$ = "b1 e1"
    If ltr$ = "b" And sgl = 0 And pltr$ = Chr$(32) Then say$ = "b1"
    If ltr$ = "b" And sgl = 0 And nltr$ = Chr$(32) Then say$ = "b2"

    'scope of "c"
If ltr$ = "c" And sgl = 1 Then say$ = "c1 e5": ltr$ = ""

If ltr$ = "c" And nltr$ = "k" Then moc = 1: say$ = "c2": ltr$ = ""
If ltr$ = "c" And pltr$ = "s" Then say$ = "c2": ltr$ = ""
If ltr$ = "c" And lv = 1 Then say$ = "c1": ltr$ = ""
If ltr$ = "c" And rword$ = "nice" Then say$ = "c1": ltr$ = ""
 If ltr$ = "c" And rword$ = "space" Then say$ = "c1": ltr$ = ""
  If ltr$ = "c" And rword$ = "come" Then say$ = "c2": ltr$ = ""
   If ltr$ = "c" And sgl = 1 Then say$ = "c": ltr$ = ""
    If ltr$ = "c" And nltr$ = "h" Then say$ = "ch": ltr$ = "": moc = 1 ' ch as in church
  
      If ltr$ = "c" And rword$ = "cell" Then say$ = "c1": ltr$ = ""
       If ltr$ = "c" And ntv = 1 Then say$ = "c1": ltr$ = ""
        If ltr$ = "c" And sgl = 0 And ntv = 0 Then say$ = "c1": ltr$ = ""
         If ltr$ = "c" And ntv = 1 Then say$ = "c2": ltr$ = ""
          If ltr$ = "c" And sgl = 0 And L3tr$ <> "t" Then say$ = "c1": ltr$ = ""
           If ltr$ = "c" And nltr$ = "c" Then moc = 1: say$ = "c2"


         
' scope of "d"
   If ltr$ = "d" And sgl = 1 Then say$ = "d1 e1"
     If ltr$ = "d" And sgl = 0 Then say$ = "d1"
' scope of "e"
   If ltr$ = "e" And sgl = 1 Then say$ = "e1": ltr$ = ""
     ' e phonix at aeiou section
' scope of "f"
   If ltr$ = "f" And sgl = 1 Then say$ = "e3 f1"
      If ltr$ = "f" And sgl = 0 Then say$ = "f1"
' scope of "g"
  'PRINT ltr$
 If ltr$ = "g" And rword$ = "sign" Then say$ = "": ltr$ = ""
  If ltr$ = "g" And pltr$ = "e" Then say$ = "g1": ltr$ = ""
   If ltr$ = "g" And nltr$ = "r" Then say$ = "g1": ltr$ = ""
    If ltr$ = "g" And pltr$ <> Chr$(32) And nltr$ <> Chr$(32) Then say$ = "g2": ltr$ = ""
     If ltr$ = "g" And sgl = 1 Then say$ = "g2 e1"
      If ltr$ = "g" And sgl = 0 Then say$ = "g1"
' scope of "h"
   If ltr$ = "h" And sgl = 1 Then say$ = "a1 c3"
      If ltr$ = "h" And sgl = 0 Then say$ = "h1" 'h as in horse
' scope of "i"
   If ltr$ = "i" And sgl = 1 Then say$ = "i1": ltr$ = ""
' scope of "j"
   If ltr$ = "j" And sgl = 1 Then say$ = "g2 a1"
      If ltr$ = "j" And sgl = 0 Then say$ = "g2"
' scope of "k"
   If ltr$ = "k" And sgl = 1 Then say$ = "c2 a1"
      If ltr$ = "k" And sgl = 0 Then say$ = "c2"
' scope of "l"
   If ltr$ = "l" And sgl = 1 Then say$ = "e2 l1"
      If ltr$ = "l" And sgl = 0 Then say$ = "l2": Rem  If nltr$ = "l" Then moc = 2
      If ltr$ = "l" And nltr$ <> Chr$(32) And sgl = 0 Then say$ = "l2": Rem  If nltr$ = "l" Then moc = 2
 
  
  
      If ltr$ = "l" And nltr$ = "l" Then moc = 1: say$ = "l1": Rem  If nltr$ = "l" Then moc = 2


' scope of "m"
   If ltr$ = "m" And sgl = 1 Then say$ = "i2 m2"
      If ltr$ = "m" And agl = 0 Then say$ = "m2" ' m as in mouse
' scope of "n"
   If ltr$ = "n" And sgl = 1 Then say$ = "i2 n1"
      If ltr$ = "n" And sgl = 0 Then say$ = "n1"
' scope of "o"
   If ltr$ = "o" And sgl = 1 Then say$ = "o1"
      ' o's phonixe cont at aeiou section
' scope of "p"
   If ltr$ = "p" And sgl = 1 Then say$ = "p1 e1"
  If ltr$ = "p" And pltr$ = Chr$(32) And nltr$ <> Chr$(32) Then say$ = "p1": ltr$ = ""
  If ltr$ = "p" And pltr$ <> Chr$(32) And nltr$ = Chr$(32) Then say$ = "p2": ltr$ = ""

  If ltr$ = "p" And sgl = 0 Then say$ = "p3": ltr$ = ""

' scope of "q"
   If ltr$ = "q" And sgl = 1 Then say$ = "q"
      If ltr$ = "q" And sgl = 0 Then say$ = "c2 a1"
' scope of "r"
   If ltr$ = "r" And sgl = 1 Then say$ = "a4 r2"
      If ltr$ = "r" And sgl = 0 Then say$ = "r2"
       If ltr$ = "r" And nltr$ = "r" Then moc = 1
' scope of "s"

   If ltr$ = "s" And sgl = 1 Then say$ = "s"
     If ltr$ = "s" And nltr$ = "h" Then say$ = "sh": moc = 1: ltr$ = "" ' sh as in shack
      If ltr$ = "s" And sgl = 0 Then say$ = "c1"

' scope of "t"
   If ltr$ = "t" And sgl = 1 Then say$ = "t1"
    ' "th" as in the
     If ltr$ = "t" And nltr$ = "h" And pltr$ = "" Then moc = 1: say$ = "t3": ltr$ = "" ' rem th
     If ltr$ = "t" And nltr$ = "h" Then moc = 1: say$ = "t4": ltr$ = "" ' rem th
 
  
      If ltr$ = "t" And sgl = 0 Then say$ = "t1"
       If ltr$ = "t" And nltr$ = "t" Then moc = 1: ltr$ = ""

' scope of "u"
   If ltr$ = "u" And sgl = 1 Then say$ = "y1 o5": ltr$ = ""
' scope of "v"
   If ltr$ = "v" And sgl = 1 Then say$ = "v2 e5"
      If ltr$ = "v" And sgl = 0 Then say$ = "v2"
' scope of "w"
   If ltr$ = "w" And sgl = 1 Then say$ = "d2 u2 b2 l2 u1 o5"
      If ltr$ = "w" And sgl = 0 Then say$ = "w1"
' scope of "x"
   If ltr$ = "x" Then say$ = "e2 c2 x1"
' scope of "y"

If ltr$ = "y" And pltr$ = "n" Then say$ = "E5": ltr$ = ""
If ltr$ = "y" And sgl = 0 Then say$ = "y1"
If ltr$ = "y" And rword$ = "by" Then say$ = "i1": ltr$ = ""
 If ltr$ = "y" And nltr$ = Chr$(32) Then say$ = "e5": ltr$ = ""
  If ltr$ = "y" And nltr$ = "e" Then say$ = "y1": ltr$ = ""

   If ltr$ = "y" And rword$ = "you" Then say$ = "y1 o5": ltr$ = "": wc = lsize: word$ = ""

    If ltr$ = "y" And nltr$ = "o" Then say$ = "y1": ltr$ = ""
  
      If ltr$ = "y" And rword$ = "byte" Then say$ = "i1": ltr$ = ""
       If ltr$ = "y" And sgl = 0 And lv = 0 Then say$ = "y1": ltr$ = ""
        If ltr$ = "y" And sgl = 1 Then say$ = "w1 i1"
         If ltr$ = "y" And pltr$ <> Chr$(32) Then say$ = "e5"

' scope of "z"
   If ltr$ = "z" And sgl = 1 Then say$ = "z"
      If ltr$ = "z" And sgl = 0 Then say$ = "s2"
' end of standard letters

' special phonix section 'a,e,i,o,u'
' vowel "a"
  If ltr$ = "a" And rword$ = "gates" Then say$ = "a1": ltr$ = ""
   If ltr$ = "a" And rword$ = "have" Then say$ = "a2": ltr$ = ""
    If ltr$ = "a" And rword$ = "start" Then say$ = "R": ltr$ = ""
  
      If ltr$ = "a" And rword$ = "happy" Then say$ = "a2": ltr$ = ""
       If ltr$ = "a" And lv = 1 And nltr$ <> "r" Then say$ = "a1": ltr$ = ""
        If ltr$ = "a" And nltr$ = "r" And lv = 1 Then say$ = "r": ltr$ = "": moc = 1
         If ltr$ = "a" And lv = 0 Then say$ = "a2": ltr$ = ""
          If ltr$ = "a" And lltr$ = "e" Then say$ = "a1": ltr$ = ""
           If ltr$ = "a" And sgl = 0 And lltr$ <> "e" Then say$ = "a1": ltr$ = ""
            If ltr$ = "a" And lv = 0 Then say$ = "a2": ltr$ = ""



' vowel "e
 '  PRINT "lv "; lv

If ltr$ = "e" And pltr$ <> Chr$(32) And nltr$ <> Chr$(32) And sgl = 0 And lv = 0 Then say$ = "e2": ltr$ = ""
If ltr$ = "e" And rword$ = "me" Then say$ = "e1": ltr$ = ""
If ltr$ = "e" And rword$ = "hello" Then say$ = "e4": ltr$ = ""
If ltr$ = "e" And rword$ = "the" Then say$ = "e": ltr$ = ""
 If ltr$ = "e" And rword$ = "zero" Then say$ = "e": ltr$ = ""
  If ltr$ = "e" And rword$ = "error" Then say$ = "a1": ltr$ = ""
   If ltr$ = "e" And rword$ = "welcome" And pltr$ = "w" Then say$ = "e1": ltr$ = ""
    If ltr$ = "e" And rword$ = "byte" Then say$ = "": ltr$ = ""
     If ltr$ = "e" And rword$ = "here" And pltr$ <> "r" Then say$ = "e"
      If ltr$ = "e" And rword$ = "come" Then say$ = "": ltr$ = ""
       If ltr$ = "e" And rword$ = "there" Then say$ = "eee": ltr$ = ""
        If ltr$ = "e" And rword$ = "the" Then say$ = "e": ltr$ = "":    ' force long e for "the"
         If ltr$ = "e" And ntv = 1 Then say$ = "e1": ltr$ = ""
         If ltr$ = "e" And nltr$ = Chr$(32) And lv = 1 Then say$ = "": ltr$ = ""
          If ltr$ = "e" And nltr$ = Chr$(32) Then say$ = "e1": ltr$ = ""
           If ltr$ = "e" And nltr$ = "r" Then say$ = "": ltr$ = ""
            If ltr$ = "e" And lltr$ = "y" Then say$ = "e1": ltr$ = ""
             If ltr$ = "e" And ntv = 0 And nltr$ <> Chr$(32) Then say$ = "e1": ltr$ = ""
              If ltr$ = "e" And nltr$ = "n" Then say$ = "i2": ltr$ = ""
           
               If ltr$ = "e" And nltr$ = "r" Then say$ = "e1": ltr$ = ""
                If ltr$ = "e" And wc < wpl And pltr$ <> "p" And lltr$ <> "o" And lv = 1 Then say$ = "e":  ltr$ = ""
                 If ltr$ = "e" And lv = 1 And ntv = 1 And wc < wpl And pltr$ <> "P" And lltr$ <> "o" Then say$ = "e": ltr$ = ""
                  If ltr$ = "e" And lv = 1 And sgl = 0 And pltr$ <> "p" And wc < wpl Then say$ = "e1": ltr$ = ""
                   If ltr$ = "e" And lv = 0 Then say$ = "e1": ltr$ = ""
                    If ltr$ = "e" And lv = 1 Then say$ = "e1": ltr$ = ""
                 
                       'when all else fails long "e"




  ' vowel "i"
 If ltr$ = "i" And rword$ = "sign" Then say$ = "i1": ltr$ = ""
  If ltr$ = "i" And rword$ = "hi" Then say$ = "i1": ltr$ = "" ' force long i as in "hi"
   If ltr$ = "i" And ntv = 0 And lv = 0 Then say$ = "i2": ltr$ = ""
      If ltr$ = "i" And lv = 1 Then say$ = "i1": ltr$ = ""

' vowel "o"
 If ltr$ = "o" And nltr$ = "t" Then say$ = "o3": ltr$ = ""
 If ltr$ = "o" And rword$ = "do" Then say$ = "o5 ": ltr$ = ""
  If ltr$ = "o" And nltr$ = "u" And lltr$ <> "d" Then say$ = "o5 ": moc = 1: ltr$ = ""
   If ltr$ = "o" And nltr$ = "u" Then say$ = "a2": ltr$ = ""
    ' "OU" AS IN FOUND OR SOUND = FORCES AA.WAV
     If ltr$ = "o" And pltr$ = "c" And lv = 0 Then say$ = "aaa": ltr$ = ""
      If ltr$ = "o" And nltr$ = "m" Then say$ = "u2 ": ltr$ = ""
       If ltr$ = "o" And rword$ = "come" Then say$ = "o1"
        If ltr$ = "o" And rword$ = "tron" Then say$ = "aaa": ltr$ = ""
         If ltr$ = "o" And nltr$ = "w" Then say$ = "o8": ltr$ = ""
          If ltr$ = "o" And plltr$ = "z" Then say$ = "o1": ltr$ = ""
           If ltr$ = "o" And nltr$ = "o" Then say$ = "o5 ": ltr$ = ""
            If ltr$ = "o" And pltr$ = "t" Then say$ = "o5 ": ltr$ = ""
             If ltr$ = "o" And nltr$ = Chr$(32) And lv = 1 Then say$ = "o1": ltr$ = ""
              ' o as in 'on'
               If ltr$ = "o" And pltr$ = Chr$(32) Then say$ = "aaa": ltr$ = ""
                If ltr$ = "o" And lv = 1 And nltr$ <> "o" And ntv = 1 Then say$ = "o1": ltr$ = ""
                 If ltr$ = "o" Then say$ = "o1"
' vowel "u"
  If ltr$ = "u" And rword$ = "yuck" Then say$ = "u2": ltr$ = ""
  If ltr$ = "u" And lv = 0 Then say$ = "u2 ": ltr$ = ""
  If ltr$ = "u" And rword$ = "stupid" Then say$ = "o5 ": ltr$ = ""
  If ltr$ = "u" And rword$ = "user" Then say$ = "u": ltr$ = ""

     If ltr$ = "u" And lv = 1 Then say$ = "o5 ": 'leave open for next test of "u"






'   end of vowel section

     If moc > 0 Then wc = wc + moc: moc = 0
     If wc > wpl Then word$ = ""
   lv = 0
' end of special vowel "a,e,i,o,u" section

  If wc >= wpl Then reader = 0: ltr$ = "": rword$ = ""
  If wpl = 1 Then word$ = "": rword$ = "": ltr$ = ""

  ltr$ = ""
   text$ = text$ + say$ + " "
 '  PRINT say$
  say$ = ""
Next wc

 nlltr$ = "": wpl = 1: wpb = lc: ntv = 0: vowels = 0: lv = 0: L3tr$ = ""
 Wend
  Next lc


ChDir "c:\pcspeak"


  Open "textf.txt" For Output As #1
  Print #1, text$
  Close #1
  cc = 0

Shell "read.bat"





End Sub

Sub SVPROGRAM(p1$)


z$ = p1$

If Right$(z$, 4) <> ".COB" Then z$ = z$ + ".COB"

ChDir App.Path + "\basic\"

Open z$ For Output As #9
X = 1
Do

outtxt$ = PROGRAMARRY$(X)
 l = Len(outtxt$)
 If l > 0 Then Print #9, Str$(X) + " " + outtxt$: Debug.Print outtext$
  
  X = X + 1
Loop Until X > (PROGLENGTH)

Close #9



End Sub

Public Sub UPDATECTRSCREEN()
Text12$ = text11$
    text11$ = text10$
    text10$ = text9$
    text9$ = TEXT8$
    TEXT8$ = text7$
    text7$ = text6$
    text6$ = text5$
    text5$ = TEXT4$
    TEXT4$ = text3$
    text3$ = text2$
    text2$ = text1$
    text1$ = text0$
    text0$ = text$
    Call cutchr13(text0$)
End Sub







