Hi All,
I can't seem to figure out why my program is now only accepting 2 characters
of input and then the edit field isn't editable anymore I want the edit
field to be editable all the time
Thanks,
Brian
"main"
RESOURCES "TBASIC.rsrc","APPLtbX~"
OUTPUT FILE "TBASIC.app"
Include "Subs AppleScript.Incl"
OVERRIDE RUNTIME FBStop(where&)
// FBStopinResourceFork
END FN
#if cpuPPC
#if CarbonLib == 0
library "CarbonLib"
#endif
toolbox fn IsMenuBarVisible = boolean
toolbox ShowMenuBar
toolbox HideMenuBar
library
#endif
LOCAL FN HelpManager
RESOURCES "TBASIC.rsrc","APPLtbX~"
'---------------------------------------------------------------
: 'CONSTANTS
'---------------------------------------------------------------
_help = 3 'TBASIC Help window
_list1class3 = 1
_scrlBar2WClass3 = 2
_picFld3class3 = 3
_EF4WClass3 = 4
_tbhbtn = 5
WINDOW _help,"TBASIC Help",( 211, 118)-( 784, 501), 1541
BUTTON _list1class3, 4001,"Help Topics",( 20, 100)-( 230, 294), 113
SCROLL BUTTON _scrlBar2WClass3, 1, 1, 10, 5,( 229, 100)-( 245, 294),0
PICTURE FIELD _picFld3class3,%4001,( 266, 21)-( 501, 98), 7,_cropPict
EDIT FIELD _EF4WClass3,%4001,( 259, 100)-( 532, 294), 5,_leftJust
BUTTON _tbhbtn,_enable,"Close",( 218, 322)-( 359, 342), 4
' If you're not using PG, add...
DIM gObjT,gObjL,gObjB,gObjR
END FN
Dim gFileSpec //as FSSpec
helloworld$ = FN loadSTR$(141)
windemo$ = FN loadSTR$(142)
prinp$ = FN loadSTR$(143)
gui$ = FN loadSTR$(144)
graphics$ = FN loadSTR$(145)
LOCAL FN donothing
BEEP
END FN
LOCAL FN sc2
ish$ = FN loadSTR$(147)
BEEP
Call ParamText (ish$,"","","")
i = Fn StopAlert(130,0)
End
END FN
LOCAL FN sc1
ish$ = FN loadSTR$(147)
BEEP
Call ParamText (ish$,"","","")
i = Fn StopAlert(130,0)
End
END FN
LOCAL FN sc3
ish$ = FN loadSTR$(147)
BEEP
CALL ParamText (ish$,"","","")
i = Fn StopAlert (130,0)
End
END FN
prefs$ = FN loadSTR$(149)
// Fix problem making window smaller but use SYSTEM(_scrnWidth) &
SYSTEM(_scrnHeight)
EDIT MENU 2 ' this puts in a standard edit menu
edselall$ = FN loadSTR$(132)
menu 2,7,1, edselall$ ' this adds Select All to the edit menu.
menu 2,8,1, "-"
menu 2,9,1, prefs$
CURSOR 128
sysHeight = SYSTEM(_scrnHeight)-50
sysWidth = SYSTEM(_scrnWidth)
IF sysHeight = 768 and sysWidth = 1024 then fn sc1
IF sysHeight = 720 and sysWidth = 1152 then fn sc2
IF sysHeight <> 900 and sysWidth <> 1440 then fn sc3
_tbsplsh = 1 'TBASIC_Splash window
_picFld1class1 = 1
Dim err,container$,menuid,itemid,runcode
Dim RUNCODE$,EVNT,ID
Dim right,bottom
DEF Fn SaveDoc
DEF Fn OpenDoc
wndtitl1$ = FN loadSTR$(137)
dim gMyFileSpec as fsSpec
LOCAL FN buildTbsplsh
RESOURCES "TBASIC.rsrc"
WINDOW _tbsplsh,wndtitl1$,( 433, 225)-(1147,630), 1028 '1147,630
PICTURE FIELD _picFld1class1,%4000,( 0, 0)-(739,423), 7,_cropPict
'739,423
AUTOCLIP=1
version$ = FN loadSTR$(153)
copyright$ = FN loadSTR$(154)
allrightsreserved$ = FN loadSTR$(155)
portionsby$ = FN loadSTR$(156)
mailinglist$ = FN loadSTR$(157)
createdin$ = FN loadSTR$(158)
mouse$ = FN loadSTR$(159)
LOCATE 3,16: PRINT " "+version$
LOCATE 25,17:PRINT ""+copyright$
LOCATE 25,20:PRINT allrightsreserved$
LOCATE 25,21:PRINT " "+portionsby$
LOCATE 25,22:PRINT " "+mailinglist$
LOCATE 25,24:PRINT createdin$
LOCATE 25,26:PRINT mouse$
END FN
LOCAL FN updateTbsplsh
' If you're not using PG, add...
DIM gObjT,gObjL,gObjB,gObjR
PICTURE FIELD _picFld1class1,%4000,( 0, 0)-( 739, 423), 7,_cropPict
AUTOCLIP=1
version$ = FN loadSTR$(153)
copyright$ = FN loadSTR$(154)
allrightsreserved$ = FN loadSTR$(155)
portionsby$ = FN loadSTR$(156)
mailinglist$ = FN loadSTR$(157)
createdin$ = FN loadSTR$(158)
mouse$ = FN loadSTR$(159)
LOCATE 3,16: PRINT " "+version$
LOCATE 25,17:PRINT ""+copyright$
LOCATE 25,20:PRINT allrightsreserved$
LOCATE 25,21:PRINT " "+portionsby$
LOCATE 25,22:PRINT " "+mailinglist$
LOCATE 25,24:PRINT createdin$
LOCATE 25,26:PRINT mouse$
END FN
FN buildTbSplsh
FN updateTbsplsh
Local Mode
Local Fn KillSpinningCursor
Dim evnt as EventRecord
End Fn = Fn EventAvail( 0, evnt )
include "Tlbx SpeechSynthesis.Incl"
clear local
#if ndef _gestaltSpeechMgrPresent
_gestaltSpeechMgrPresent = 0
#endif
local fn hasSpeechMgr' returns non-zero if Speech Mgr present
dim @ speechAttr as long
end fn = fn Gestalt(_"ttsc",speechAttr) = _noErr and (speechAttr and
_gestaltSpeechMgrPresent%)
syszx$ = FN loadSTR$(140)
do
If System(_sysVers) => 1000 Then Fn KillSpinningCursor
until mouse(_down)
sysz1$ = FN loadSTR$(131)
local fn sysvdlg
BEEP
Call ParamText (sysz1$,"","","")
i = Fn StopAlert(131,0)
End
end fn
WINDOW CLOSE #_tbsplsh
Call ParamText("","","","")
I = Fn Alert (145,0)
IF I = "L" then beep
sysv = SYSTEM(_sysvers)
IF sysv < 1030 then fn sysvdlg
long if fn hasSpeechMgr
welcome$ = FN loadSTR$(133)
err = fn SpeakString (welcome$)
while fn SpeechBusy
wend
xelse
BEEP
spch1$ = FN loadSTR$(134)
Call ParamText (spch1$,"","","")
i = Fn StopAlert(128,0)
End
DO
FN KillSpinningCursor
UNTIL MOUSE(_down)
WINDOW CLOSE #855
end if
_tbeditor = 2 'TBASIC window
_EF1WClass2 = 8001
LOCAL FN buildTbeditor
wndtitl2$ = FN loadSTR$(138)
WINDOW _tbeditor,wndtitl2$,( 24, 80)-(1023, 806), _docNoGrow
TEXT _Times,11,0
//LONG COLOR 60675,61087,48266
//EDIT FIELD _EF1WClass2,%4000,(1, 1)-(1022, 805), 4,_leftJust
left = 1
top = 1
right = 1500
bottom = 50
Edit Field #8001, "", @FieldRect, _framed
END FN
Local Fn BuildScrollFld (EditID,Left,Top,Wide,NumLines)
left = 1
top = 1
right = 1022
bottom = 1000
'---> Variables
DIM FieldRect AS RECT ' Make it a var of type RECT
FieldRect.top = 0
FieldRect.left = 0
_scrollWidth = 20
FieldRect.right = WINDOW(_width) - _scrollWidth ' You would have set
//_scrollWidth, probably to 20?
FieldRect.bottom = WINDOW(_height)-1
Edit Field -1, "", @FieldRect, _Framed
FieldRect.left = FieldRect.right + 1
FieldRect.right = FieldRect.left + 16
Call InsetRect (FieldRect,0,-2)
Scroll Button -1, 1, 1, 1, 1, @FieldRect, _scrollOther
End Fn
LOCAL FN updateTbeditor
DIM gObjT,gObjL,gObjB,gObjR
END FN
FN buildTbeditor
FN updateTbeditor
//EDIT FIELD #8001, container2$
Fn BuildScrollFld(-8001,20,20,180,10)
container$ = EDIT$(1)
clear local
#if ndef _gestaltSpeechMgrPresent
_gestaltSpeechMgrPresent = 0
#endif
' To get a menu working
' use this: MENU 3, UserMenu, User 1, You-sir, U2 sir, -, Pusher"
dim err
local fn UserMenu(s$)
' Parses syntax following MENU: " id, title, item..., item". Example:
' "MENU 3, UserMenu, User 1, You-sir, U2 sir, -, Pusher"
' Requires comma & space after id and each item but last
' Creates a menu immediately.
dim delim, id, item
id = val(s)
if id < 3 then exit fn 'Make sure not to mess with File or Edit menus;
//abort if no #
item = 0 'Item 0 is menu title
delim = instr(2, s, " ") 'Find space after id number
s = mid$(s, delim + 1)'Remove id number from s
while s[0]'Any more items?
delim = instr(1, s, ",")'Find comma
if delim = 0 then delim = s[0] + 1'If no comma, last item
menu id, item, _enable, left$(s, delim - 1) 'Create menu item
s = mid$(s, delim + 2) 'Remove this item and ", " from s
item ++
wend
end fn
LOCAL FN doInput
//Dim As Str255
//Dim as STR255 myr$
//Dim As Str255 MyStr
Dim As Str255 answer
Dim As Handle H
Dim as STR255 myr
Include "Subs AppleScript.Incl"
Route _toAppleScript
Print "display dialog "+MyStr+" enter your answer"
//Print "display dialog """""+myr$+"""" enter your answer """""
Print "return text returned of result"
Route _toScreen
Long If Usr AppleScriptRun( answer ) = _noErr
Long If answer[0]// if answer is not empty
answer[0]--// remove trailing quote
answer = Mid$( answer, 2 )// remove leading quote
Edit$( 1 ) = "Hello "// add something to EF
Edit$( 1, _maxInt,_maxInt ) = answer + Chr$(13)
SetSelect _maxInt,_maxInt
End If
Xelse
aecmd$ = "Error! Couldn't run AppleScript. AppleScript is required to do
user input in TBASIC."
CALL PARAMTEXT (aecmd$"","","")
butnPressed = FN STOPALERT (129,0)
End If
H = Usr AppleScriptGetResult
If H Then DisposeHandle( H )
END FN
local fn ParseEFLines( efID as long )
dim as handle efH
dim as long i, numLines
dim as str255 lineStr
efH = TeHandle( efID )
numLines = efH..teNLines%
for i = 1 to numLines
lineStr = edit$( efID, i )
// Do your stuff with each line here
SELECT
CASE UCASE$(LEFT$(lineStr,6)) = "INPUT "
// doesn't work
MyStr = MID$(lineStr,7)
Fn doInput
CASE UCASE$(LineStr) = "REPEATLASTLINE"
// Begin Repeat Code
CASE UCASE$(LEFT$(UCASE$(LineStr),5)) = "MENU "
//CASE UCASE$(MID$(UCASE$(LineStr),5)) = "MENU "
// mnu$ = MID$(lineStr, 7)
fn UserMenu(mid$(LineStr,6))
CASE UCASE$(LineStr) = "RESTOREMENUBAR"
//put restore code here
/*CASE UCASE$(LEFT$(lineStr,4)) = "WIN " // doesn't work
Lft=VAL(MID$(lineStr,5))
Md$= STR$(MID$(lineStr,7))
Sz1 = VAL(MID$(lineStr,2))
Sz2 = VAL(MID$(lineStr,2))
Sz3 = VAL(MID$(lineStr,2))
Sz4 = VAL(MID$(lineStr,2))
WINDOW #lft,md$, (Sz1,Sz2) - (Sz3,Sz4)
PRINT lft
PRINT md
*/
CASE UCASE$(LEFT$(lineStr,4)) = "WIN "
// ex. WIN 7,WELCOME,130,250,400,444,5
// with commas to separate the items
WINDOW #wNum, wTtl$, (wLft,wTop)-(wRt,wBtm), wType
txt$ = MID$(lineStr, 5 ) ' get rest of instruction after "WIN "
// now: txt$ = "7,WELCOME,130,250,400,444,5"
p = INSTR(1,txt$,",") ' find position of comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wNum = val( b4$ ) ' convert to window # (7 in ex)
WINDOW #wNum, wTtl$, (wLft,wTop)-(wRt,wBtm), wType
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item & , from start of txt
// now: txt$ = "WELCOME,130,250,400,444,5"
p = INSTR (1,txt$,",") ' find position of next comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wTtl = b4$ ' store window title (WELCOME in ex.)
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item from txt
// now: txt$ = "130,250,400,444,5"
p = INSTR (1,txt,",") ' find position of comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wLft = VAL(b4$) ' store window title (30 in ex.)
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item from txt
// now: txt$ = "250,400,444,5"
p = INSTR (1,txt,",") ' find position of comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wTop = VAL(b4$) ' store window title (150 in ex.)
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item from txt
// now: txt$ = "400,444,5"
p = INSTR (1,txt,",") ' find position of comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wRt = VAL(b4$) ' store window title (400 in ex.)
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item from txt
// now: txt$ = "444,5"
p = INSTR (1,txt,",") ' find position of comma
b4$ = LEFT$(txt$,p-1) ' extract item before comma
wBtm = VAL(b4$) ' store window title (444 in ex)
WINDOW #wNum, wTtl$, (wLft,wTop)-(wRt,wBtm), wType
PRINT txt$; tab(35) p; tab(40) b4$
txt$ = MID$(txt$,p+1) ' remove item from txt
// now: txt$ = "5"
' last item doesn't have comma after it
wType = VAL(txt$)' store window title (444 in ex)
WINDOW #wNum, wTtl$, (wLft,wTop)-(wRt,wBtm), wType
PRINT txt$
CASE UCASE$((lineStr)) = "DOLOOP"
whatever=1
Do
SELECT
CASE UCASE$(LineStr) = "BEEP" : BEEP : whatever=0
End select
Until whatever=0
CASE UCASE$((lineStr)) = "//"
COLOR=_zRed
CALL TEXTFACE(1)
setselect 0,1
CASE UCASE$(LEFT$(lineStr,6)) = "FONT "
fnum = VAL(mid$(lineStr,7))
CALL TEXTFONT(fnum)
setselect 0,0
CASE left$(lineStr,6) = "PRINT "
' If window exists place in window otherwise create default window
//TEXT fnum doesn't work
//WINDOW #wNum
PRINT MID$(lineStr,7)
CASE LEFT$(lineStr,8 ) = "SHOWURL "
DIM URL$
URL$ = MID$(lineStr, 9)
FN LaunchURL (URL$)
CASE LEFT$(lineStr,8) = "MAILTO: "
URL$ = MID$(lineStr,9)
FN LaunchURL ("mailto: "+URL$)
CASE LEFT$(lineStr,7 ) = "ICHAT: "
URL$ = MID$(lineStr, 8)
FN LaunchURL ("iChat: "+URL$)
CASE LEFT$(lineStr, 5) = "AOL: "
URL$ = MID$(lineStr, 6)
FN LaunchURL ("AOL:"+URL$)
//SPEAKABLE ALERTS don't work
CASE UCASE$(LEFT$(lineStr,15)) = "SPEAKABLEALERT "
alertText$ = MID$(lineStr, 16)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (alertText$)
xelse
beep
end if
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN ALERT(129,0)
CASE UCASE$(LEFT$(lineStr,22)) = "SPEAKABLECAUTIONALERT "
alertText$ = MID$(lineStr, 23)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (alertText$)
xelse
beep
end if
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN CAUTIONALERT(129,0)
CASE UCASE$(LEFT$(lineStr,19)) = "SPEAKABLESTOPALERT "
alertText$ = MID$(lineStr, 20)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (alertText$)
xelse
beep
end if
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN STOPALERT(129,0)
CASE UCASE$(LEFT$(lineStr,6)) = "ALERT "
alertText$ = MID$(lineStr,7)
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN ALERT(129,0)
CASE UCASE$(LEFT$(lineStr,13)) = "CAUTIONALERT "
alertText1$ = MID$(lineStr,14)
CALL PARAMTEXT (alertText1$, "","","")
butnPressed = FN CAUTIONALERT (129,0)
CASE UCASE$(LEFT$(lineStr,10)) = "STOPALERT "
alertText2$ = MID$(lineStr,11)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN STOPALERT (129,0)
CASE UCASE$(LEFT$(lineStr,10)) = "NOTEALERT "
alertText2$ = MID$(lineStr,11)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN NOTEALERT (129,0)
CASE UCASE$(LEFT$(lineStr,19)) = "SPEAKABLENOTEALERT "
alertText$ = MID$(lineStr, 20)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (alertText$)
xelse
beep
end if
CALL PARAMTEXT (alertText$, "", "", "")
butnPressed = FN STOPALERT(129,0)
CASE UCASE$(LEFT$(lineStr,4)) = "SUB " // doesn't work
CASE UCASE$(lineStr) = "REGISTER"
Call ParamText("","","","")
I = Fn Alert (145,0)
//IF I = "L" then beep
CASE UCASE$(LEFT$(lineStr,7)) = "LPRINT "
Dim gPrintOpen// ex. LPRINT Hello World
printout$ = MID$(lineStr,8)
gPrintOpen = _true
ROUTE _toPrinter
LPRINT printout$
ROUTE _toScreen
LONG IF gPrintOpen = _True
CLOSE LPRINT
END IF
CASE UCASE$ (lineStr) = "EXITLPRINT"
Dim gPrinterOpn // ex. END ' of user program
LONG IF gPrinterOpn = _True
CLOSE LPRINT
END IF
CASE UCASE$(LEFT$(lineStr,6 )) = "SPEAK "
DIM sp$
sp$ = MID$(lineStr, 7)
Include "Tlbx SpeechSynthesis.Incl"
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (sp$)
xelse
beep
Stop "Doesn't work without MacOS X & Speech."
end if
CASE UCASE$(LEFT$(lineStr,7)) = "STRING$="
Dim strx$,snp$
strx$ = MID$(lineStr,8)
snp$ = FN loadSTR$(151)
IF strx$ = "" THEN strx$ = snp$
CASE UCASE$(lineStr) = "PRINTSTRING$"
PRINT strx$
CASE UCASE$(LEFT$(lineStr,17)) = "NOTEALERTSTRING$"
strx$ = MID$(lineStr,19)
alertText2$ = strx$
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN NOTEALERT (129,0)
CASE UCASE$(lineStr) = "LAUNCH_ICHAT"
CASE UCASE$(LEFT$(lineStr,15)) = "ALERTSTRING$"
alertText2$ = MID$(lineStr,17)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN ALERT (129,0)
CASE UCASE$(LEFT$(lineStr,18)) = "NOTEALERTSTRING$"
alertText2$ = MID$(lineStr,20)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN NOTEALERT (129,0)
CASE UCASE$(LEFT$(lineStr,22)) = "CAUTIONALERTSTRING$"
alertText2$ = MID$(lineStr,24)
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN CAUTIONALERT (129,0)
CASE UCASE$(LEFT$(lineStr,18)) = "STOPALERTSTRING$"
alertText2$ = mid$(lineStr,20)
CALL PARAMTEXT (alertText2$, "","","")
butnPressed = FN STOPALERT (129,0)
CASE UCASE$(LEFT$(lineStr,27)) = "SPEAKABLEALERTSTRING$"
alertText2$ = mid$(lineStr,29)
Include "Tlbx SpeechSynthesis.Incl"
strx$ = MID$(lineStr,28)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (strx$)
xelse
beep
end if
alertText2$ = strx$
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN ALERT (129,0)
CASE UCASE$(LEFT$(lineStr,24)) = "SPEAKABLENOTEALERTSTRING$"
strx$ = MID$(lineStr,26)
Include "Tlbx SpeechSynthesis.Incl"
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (strx$)
xelse
beep
end if
alertText2$ = strx$
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN NOTEALERT (129,0)
//CASE UCASE$(lineStr,29) = "SPEAKABLECAUTIONALERTSTRING$"
CASE UCASE$(LEFT$(lineStr,28 )) = "SPEAKABLECAUTIONALERTSTRING$"
Include "Tlbx SpeechSynthesis.Incl"
strx$ = MID$(lineStr,30)
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (strx$)
xelse
beep
end if
alertText2$ = strx$
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN CAUTIONALERT (129,0)
CASE UCASE$(lineStr) = "SPEAKABLESTOPALERTSTRING$"
Include "Tlbx SpeechSynthesis.Incl"
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (strx$)
xelse
beep
end if
alertText2$ = strx$
CALL PARAMTEXT (alertText2$,"","","")
butnPressed = FN STOPALERT (129,0)
CASE UCASE$(LEFT$(lineStr,16)) = "BEGINAPPLESCRIPT "
Include "Subs AppleScript.Incl"
CASE UCASE$(LEFT$(lineStr,14)) = "SPEAKSTRING$"
strx$ = MID$(lineStr,16)
Include "Tlbx SpeechSynthesis.Incl"
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (strx$)
xelse
beep
end if
CASE UCASE$(LineStr) = "RANDOMIZETIMER"
RANDOMIZE TIMER
CASE UCASE$(LineStr) = "BEEP"
BEEP
CASE UCASE$(LEFT$(LineStr,7 )) = "RANDOM "
Dim rndg,rng
rndg = RIGHT$(lineStr,8)
rng = INT(RND(rndg))
PRINT rng
CASE UCASE$(LineStr) = "SHOWMENUBAR"
SHOWMENUBAR
CASE UCASE$(LineStr) = "HIDEMENUBAR"
HIDEMENUBAR
CASE UCASE$(LineStr) = "FLASHMENUBAR"
HIDEMENUBAR
SHOWMENUBAR
HIDEMENUBAR
SHOWMENUBAR
CASE UCASE$(LineStr) = "CLEARMENUBAR"
CLEARMENUBAR
CASE UCASE$(LEFT$(lineStr,7)) = "SHELL "
DIM scmd$
scmd$ = MID$(lineStr, 8)
OPEN "UNIX",1,scmd$
PRINT scmd$
CASE UCASE$(lineStr) = "STOP"
STOP "Are you sure you want to stop TBASIC?"
CASE UCASE$(lineStr) = "OUTPUTTIME$"
Dim theTime$
theTime$ = TIME$
PRINT theTime$
Call ParamText (theTime$,"","","")
i = Fn Alert(129,0)
PRINT theTime$
CASE UCASE$(LEFT$(lineStr,7)) = "MSGBOX "
DIM msgbox$
msgbox$ = MID$(lineStr,8)
CALL PARAMTEXT (msgbox$,"","","")
butnPressed = FN ALERT (129,0)
CASE UCASE$(LEFT$(lineStr, 15)) = "MSGBOXSTRING$= "
DIM msgboxstr$
msgboxstr$ = MID$(lineStr, 16)
CASE UCASE$(lineStr) = "DISPLAYMSGBOXWITHSTRING$"
CALL PARAMTEXT (msgboxstr$,"","","")
butnPressed = FN ALERT (129,0)
CASE UCASE$(LEFT$(lineStr,33)) = "SPEAKABLEDISPLAYMSGBOXWITHSTRING$"
long if fn hasSpeechMgr
while fn SpeechBusy
wend
err = fn SpeakString (msgboxstr$)
xelse
beep
Stop "Doesn't work without MacOS X & Speech."
end if
Include "Tlbx SpeechSynthesis.Incl"
CALL PARAMTEXT (msgboxstr$,"","","")
butnPressed = FN ALERT (129,0)
END SELECT
NEXT
end fn = numLines
Fn BuildScrollFld(-8001,20,20,180,10)
container$ = EDIT$(1)
//GET FIELD ZTXThandle&, 1
local fn PrintEditField( whichEF as long )
def PrintEditField( whichEF )
end fn
LOCAL FN buildTbsplsh1
RESOURCES "TBASIC.rsrc"
WINDOW _tbsplsh,wndtitl1$,( 433, 225)-(1147, 630), 1028
PICTURE FIELD _picFld1class1,%4000,( 0, 0)-( 739, 423), 7,_cropPict
AUTOCLIP=1
version$ = FN loadSTR$(153)
copyright$ = FN loadSTR$(154)
allrightsreserved$ = FN loadSTR$(155)
portionsby$ = FN loadSTR$(156)
mailinglist$ = FN loadSTR$(157)
createdin$ = FN loadSTR$(158)
mouse$ = FN loadSTR$(159)
LOCATE 3,16: PRINT " "+version$
LOCATE 25,17:PRINT " "+copyright$
LOCATE 25,20:PRINT " "+allrightsreserved$
LOCATE 25,21:PRINT " "+portionsby$
LOCATE 25,22:PRINT " "+mailinglist$
LOCATE 25,24:PRINT " "+ createdin$
LOCATE 25,26:PRINT " "+mouse$
END FN
LOCAL FN updateTbsplsh1
RESOURCES "TBASIC.rsrc"' If you're not using PG, add...
DIM gObjT,gObjL,gObjB,gObjR
PICTURE FIELD _picFld1class1,%4000,( 0, 0)-( 739, 423), 7,_cropPict
AUTOCLIP=1
version$ = FN loadSTR$(153)
copyright$ = FN loadSTR$(154)
allrightsreserved$ = FN loadSTR$(155)
portionsby$ = FN loadSTR$(156)
mailinglist$ = FN loadSTR$(157)
createdin$ = FN loadSTR$(158)
mouse$ = FN loadSTR$(159)
LOCATE 3,16: PRINT " "+version$
LOCATE 25,17:PRINT " "+copyright$
LOCATE 25,20:PRINT " "+allrightsreserved$
LOCATE 25,21:PRINT " "+portionsby$
LOCATE 25,22:PRINT " "+mailinglist$
LOCATE 25,24:PRINT " "+ createdin$
LOCATE 25,26:PRINT " "+mouse$
END FN
LOCAL FN doMenus
menuid = Menu(_menuID)
itemid = Menu(_itemID)
//PRINT menuID
//PRINT itemID
Menu
'adds SELECT ALL to EDIT menu
CURSOR 128
Select MenuID
case 127
Select itemID
case 2
Dim urls$,url1x$
//urls1$ = FN loadSTR$(128)
//Fn LaunchURL (urls1$)
urls$ = FN loadSTR$(146)
Fn LaunchURL (urls$)
case 3
url1x$ = FN loadSTR$(148)
Fn LaunchURL (url1x$)
case 5
case 1
//FN buildTbsplsh1
//FN updateTbsplsh1
RESOURCES "TBASIC.rsrc"
WINDOW _tbsplsh,wndtitl1$,( 433, 225)-(1147, 630), 1028
PICTURE FIELD _picFld1class1,%4000,( 0, 0)-( 739, 423), 7,_cropPict
AUTOCLIP=1
version$ = FN loadSTR$(153)
copyright$ = FN loadSTR$(154)
allrightsreserved$ = FN loadSTR$(155)
portionsby$ = FN loadSTR$(156)
mailinglist$ = FN loadSTR$(157)
createdin$ = FN loadSTR$(158)
mouse$ = FN loadSTR$(159)
LOCATE 3,16: PRINT " "+version$
LOCATE 25,17:PRINT " "+copyright$
LOCATE 25,20:PRINT " "+allrightsreserved$
LOCATE 25,21:PRINT "
"+portionsby$
LOCATE 25,22:PRINT " "+mailinglist$
LOCATE 25,24:PRINT " "+ createdin$
LOCATE 25,26:PRINT " "+mouse$
DO
FN KillSpinningCursor
UNTIL MOUSE(_down)
WINDOW CLOSE #_tbsplsh
end select
case 7
Select itemID
case 1
DEF Fn HelpManager
Fn HelpManager
case 3
Dim url1c$,url2c$,url3c$
url1c$ = FN loadSTR$(129)
Fn LaunchURL(url1c$)
case 4
url2c$ = FN loadSTR$(128)
Fn LaunchURL(url2c$)
case 5
url3c$ = FN loadSTR$(146)
Fn LaunchURL (url3c$)
end select
case 1
Select itemID
case 1 ' New
FN buildTbeditor
FN updateTbeditor
Fn BuildScrollFld(1,20,20,180,10)
case 2
WINDOW #_tbEditor'Open
FN OpenDoc
case 3 'Close
RESOURCES "TBASIC.rsrc"
'3 = close & create new window
window close #_tbEditor
window close #_help
case 5'Save
Fn SaveDoc
case 6 'Save As...
Fn SaveDoc
case 8'Page Setup...
DEF PAGE
case 9 'Print...
Fn PrintEditField(1)
case else
end
end select
case 2
select itemID
case 7
setselect 0, 32767 ' Select All
case 9
//Preferences
def fn prefs
fn prefs
case 5
Select itemID
case 1
DEF Fn HelpManager
Fn HelpManager
case 4
dim url1$
url1$ = FN loadSTR$ (128)
Fn LaunchURL(url1$)
case 3
Dim url2$
url2$ = FN loadSTR$(129)
Fn LaunchURL(url2$)
case 5
Dim urls$
urls$ = FN loadSTR$(146)
Fn LaunchURL (urls$)
end select
case 3
Select itemID
case 1
runcode$ = EDIT$(1)
FN ParseEFLines(1)
case 2
// Compiler goes here
def fn compiler
fn compiler
case else
Dim item, menuid
//stop "You selected item "+str(item)+" from menu "+str(menuid)
stop "You selected item "+str$(item)+" from menu "+str$(menuid)
// program execution goes here
end select
end select
end select
end fn
INCLUDE "FileManagement.incl"
_PopClickMenu = 150
_kCMHelpItemRemoveHelp = 3
DO
If System(_sysVers) => 1000 Then Fn KillSpinningCursor
UNTIL MOUSE(_down)
clear local
dim enableRemove
LOCAL FN prefs
RESOURCES "TBASIC.rsrc"
'---------------------------------------------------------------
: 'CONSTANTS
'---------------------------------------------------------------
_tPrefs = 7790 'Preferences window
_picFld1class4 = 1
_btn2WClass4 = 2
_btn2WClass5 = 3
_btn2WClass6 = 4
_btn2WClass7 = 5
_btn2WClass8 = 6
_btn2WClass9 = 7
_picFld9class4 = 9
_picFld8class4 = 8
_nameofcompiledapp= 10
_btn11WClass4 = 11
_picFld12class4 = 12
_SNO = 13
WINDOW _tPrefs,"Preferences",( 363, 215)-( 705, 599), _dialogFrame
PICTURE FIELD _picFld1class4,%4002,( -12, 4)-( 330, 32), 7,_cropPict
BUTTON _btn2WClass4,_enable,"Times New Roman",( 33, 96)-( 192, 112), 3
BUTTON _btn2WClass5,_enable,"Times",( 33, 112)-( 192, 128), 3
BUTTON _btn2WClass6,_enable,"New York",( 33, 128)-( 192, 144), 3
BUTTON _btn2WClass7,_enable,"Geneva",( 33, 144)-( 176, 160), 3
BUTTON _btn2WClass8,_enable,"Arial",( 33, 160)-( 192, 176), 3
BUTTON _btn2WClass9,_enable,"Helvetica",( 33, 176)-( 176, 192), 3
PICTURE FIELD _picFld9class4,%4004,( 36, 68)-( 217, 80), 7,_cropPict
PICTURE FIELD _picFld8class4,%4003,( 36, 212)-( 210, 224), 7,_cropPict
EDIT FIELD _nameofcompiledapp,%4002,( 32, 224)-( 208, 240), 1,_leftJust
BUTTON _btn11WClass4,_enable,"Save",( 144, 320)-( 224, 340), 4
PICTURE FIELD _picFld12class4,%4005,( 36, 260)-( 74, 272), 7,_cropPict
EDIT FIELD _SNO,%4003,( 96, 256)-( 288, 272), 1,_leftJust
' If you're not using PG, add...
DIM gObjT,gObjL,gObjB,gObjR
DEF FN doDialog
ON DIALOG FN doDialog
END FN
BEGIN ENUM
_TimesNewRomanf = 2010
_Timesf = 20
_NewYorkf = 2
_Genevaf = 3
_Arialf = 12
_Helveticaf = 21
END ENUM
LOCAL FN doDialog
evnt = DIALOG(0)
id = DIALOG(evnt)
SELECT CASE (evnt)
CURSOR 128
CASE _wndClose
WINDOW CLOSE #_help
WINDOW CLOSE #wNum
WINDOW CLOSE #_tbEditor
CURSOR 128
CASE _btn2WClass4
TEXT _TimesNewRomanf
Edit Field #8001, "", @FieldRect, _framed
CASE _btn2WClass5
TEXT _Timesf
Edit Field #8001, "", @FieldRect, _framed
CASE _btn2WClass6
TEXT _NewYorkf
Edit Field #8001, "", @FieldRect, _framed
CASE _btn2WClass7
TEXT _Genevaf
Edit Field #8001, "", @FieldRect, _framed
CASE _btn2WClass8
TEXT _Arialf
Edit Field #8001, "", @FieldRect, _framed
CASE _btn2WClass9
TEXT _Helveticaf
Edit Field #8001, "", @FieldRect, _framed
END SELECT
END FN
LOCAL FN compiler
long if runcode$ = ""
CALL PARAMTEXT ("","","","")
butnPressed = FN STOPALERT (140,0)
end if
END FN
LOCAL FN doStop
//CALL PARAMTEXT ("Are you sure you want to Stop TBASIC & the currently open
program?","",,"","")
DIM true
Call ParamText ("","","","")
butnPressed = FN STOPALERT (5,0)
'1 is stop 4 is cancel
if butnPressed = 1 then gFBQuit=true
if butnPressed = 4 then beep
END FN
ON DIALOG FN doDialog
ON MENU FN doMenus
CURSOR 128
Do
HANDLEEVENTS
CURSOR 128
UNTIL gFBQuit