home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PROG_GEN
/
FSTTER31.ZIP
/
FAST
/
TERMINAL
/
TERM.PRG
< prev
Wrap
Text File
|
1994-03-20
|
19KB
|
686 lines
/*
Clipper term /A/M/N/L/W
Blinker fi term lib fast,apistd
*/
#include "setcurs.ch"
#include "inkey.ch"
#include "Error.ch"
#xtranslate ROJO => if( iscolor(), "W+/R+", "W+/N+" )
#xtranslate VERDE => if( iscolor(), "W+/G+", "W+/N+" )
#xtranslate AZUL => if( iscolor(), "W+/B+", "W+/N+" )
#xtranslate DEFAULT <var> TO <to> ;
=> <var> := if( <var> == nil, <to> , <var> )
#define COM1 1
#define COM2 2
#define COM3 3
#define COM4 4
#define PUERTO aSetUp[1]
#define BAUDIOS aSetUp[2]
#define DIALSTRING aSetUp[3]
#define INICIALIZACION aSetUp[4]
#define V_NORMAL 3
#define CRLF chr( 13 ) + chr( 10 )
#define ISDEBUG aGeneralSetUp[1]
#define ISACAPTURE aGeneralSetUp[2]
#define ISDCAPTURE aGeneralSetUp[3]
#define NACAP aGeneralSetUp[4]
#define NDCAP aGeneralSetUp[5]
#define MACRO_F1 aMacro[1]
#define MACRO_F2 aMacro[2]
#define MACRO_F3 aMacro[3]
#define MACRO_F4 aMacro[4]
#define MACRO_F5 aMacro[5]
static aSetUp, aPhone, aMacro
static aGeneralSetUp := { .f., .f., .f., -1, -1 }
FUNCTION Terminal()
local cTemp
local nError
local lContinue := .t.
local nTecla := 0
local nLastCursor
local cLastColor
set scoreboard off
if .not. file( "SetUp.def" )
BoxWarning( "Setup file not found, creating..." )
MakeSetUp()
EndIf
if .not. file( "PhoneBk.def" )
BoxWarning( "Bookphone not founf, creating..." )
MakePhoneBook()
EndIf
if .not. file( "Macro.def" )
BoxWarning( "Macro file not found, creating..." )
MakeMacro()
EndIf
aSetUp := RestArray( "SetUp.def", @nError )
aPhone := RestArray( "PhoneBk.def", @nError )
aMacro := RestArray( "Macro.def", @nError )
nLastCursor := setcursor( SC_SPECIAL1 )
cLastColor := setcolor( AZUL )
ReDrawScreen()
setpos( 2,0 )
cTemp := "CA-Clipper (tm) Terminal|Terminal Created with:||" + ;
"Fast Library 3.00 (c) 93 Manu Roibal|"
WriteScreen( cTemp )
Delay( 2 )
ReInstala()
Inicializacion()
while( lContinue )
setcursor( SC_SPECIAL1 )
nTecla := inkey()
if nTecla == K_F1
_eValMacro( MACRO_F1 )
Elseif nTecla == K_F2
_eValMacro( MACRO_F2 )
ElseIf nTecla == K_F3
_eValMacro( MACRO_F3 )
Elseif nTecla == K_F4
_eValMacro( MACRO_F4 )
Elseif nTecla == K_F5
_eValMacro( MACRO_F5 )
EndIf
if IsAlt()
setcursor( 0 )
SetMenu()
EndIf
if .not. ComInEmpt()
cTemp := ""
while .not. ComInEmpt()
cTemp += chr( ComInput() )
Enddo
if ISDEBUG
_WriteDebug( cTemp )
EndIf
WriteScreen( cTemp )
EndIf
if( nTecla != 0 )
do case
case nTecla > 31 .and. nTecla < 257
while .not. ComReady()
Enddo
ComOutput( nTecla )
case nTecla == 13
ComOutput( 13 )
case nTecla == K_BS
WriteScreen( chr( K_BS ) )
end case
nTecla := 0
EndIf
Enddo
inkey(0)
exit( 0 )
RETURN ( Nil )
FUNCTION exit( nError )
if( nError != 0 )
do case
case nError == 1
WriteScreen( "I/O buffer errors.|" )
case nError == 2
WriteScreen( "COM port not specified.|" )
case nError == 3
WriteScreen( "The specified port have not UART.|" )
case nError == 4
WriteScreen( "Interrupt manager is installed.|" )
endcase
EndIf
WriteScreen( "|Push any key to return to DOS..." )
inkey( 0 )
ComUnInst()
VideoMode( V_NORMAL )
Quit
RETURN Nil
FUNCTION WriteScreen( cTexto )
static nRow, nCol
local cLine
local lLineFeed := .f.
local cAux := ""
local cChar := ""
if ISACAPTURE
fwrite( NACAP, cTexto, len( cTexto ) )
EndIf
while( len( cTexto ) != 0 )
cChar := Cut( @cTexto )
do case
case asc( cChar ) == 13
cAux += "|"
case asc( cChar ) == 10
otherwise
cAux += cChar
endcase
Enddo
cTexto := cAux
DEFAULT nRow TO 2
DEFAULT nCol TO 0
while( len( cTexto ) != 0 )
cLine := CutTo( "|", @cTexto, @lLineFeed )
@ nRow,nCol say cLine color AZUL
nCol := col()
if lLineFeed
nRow++
if nRow == 23
if ISDEBUG
dispbegin()
_DebugSave( .f. )
EndIf
scroll( 2,0,22,79,1 )
nRow--
if ISDEBUG
_DebugSave( .t. )
_DebugSave( nil )
dispend()
EndIf
EndIf
setpos( nRow,nCol := 0 )
lLineFeed := .f.
EndIf
Enddo
RETURN ( Nil )
FUNCTION _WriteDebug( cTexto, lCols )
static nDRow, nDCol
static nCounter
local cColor
local cChar
if lCols != nil .and. cTexto == ""
nDrow := 4
nDCol := 0
RETURN ( Nil )
EndIf
DEFAULT nDRow TO 4
DEFAULT nDCol TO 0
DEFAULT nCounter TO 0
while( len( cTexto ) != 0 )
@ nDRow, nDCol say " " + Byte2Hex( cChar := Cut( @cTexto ) ) color VERDE
if ISDCAPTURE
fwrite( NDCAP, " " + Byte2Hex( cChar ), 3 )
EndIf
nDCol += 3
if( ++nCounter%26 ) == 0
if( ++nDRow==7 )
cColor := setcolor( VERDE )
scroll( 5,0,6,79,1 )
setcolor( cColor )
--nDRow
nDCol := 0
EndIf
if ISDCAPTURE
fwrite( NDCAP, CRLF, 2 )
EndIf
EndIf
Enddo
RETURN ( Nil )
FUNCTION _SetDOn()
_DrawDebug()
ISDEBUG := .t.
RETURN ( Nil )
FUNCTION _SetDOff()
ISDEBUG := .f.
_DebugSave( .f. )
RETURN ( Nil )
FUNCTION _DebugSave( lMode )
static cPantalla, cPantalla2
if lMode == nil
restscreen( 3,0,7,79, cPantalla2 )
ElseIf lMode
cPantalla := savescreen( 3,0,7,79 )
Else
cPantalla2 := savescreen( 3,0,7,79 )
restscreen( 3,0,7,79, cPantalla )
EndIf
RETURN ( Nil )
FUNCTION _DrawDebug()
local nCounter
_DebugSave( .t. )
@ 3,0 say replicate( chr( 196 ), 80 ) color VERDE
@ 3,2 say chr( 180 ) + " Debug " + chr( 195 ) color VERDE
for nCounter := 4 to 6
@ nCounter, 0 say replicate( chr( 32 ), 80 ) color VERDE
next nCounter
@ 7,0 say replicate( chr( 196 ), 80 ) color VERDE
RETURN ( Nil )
FUNCTION CutTo( cChar, cChain, lLineFeed )
local nAt := at( cChar,cChain )
local cTexto
if( nAt!=0 )
cTexto := substr( cChain, 1, nAt - 1 )
cChain := substr( cChain, nAt + 1 )
lLineFeed := .t.
else
cTexto := cChain
cChain := ""
EndIf
RETURN cTexto
FUNCTION Cut( cChain )
local cChar := substr( cChain, 1, 1 )
cChain := substr( cChain, 2 )
RETURN cChar
FUNCTION SetMenu()
local aMiMenu := {}
local nOpcion
local nItem
local nRow := row()
local nCol := col()
local nError
local cMenu := { " C^redits "," De^bug ", " M^isc ", " ^Modem "," M^acros " }
aMiMenu := NewMenu( cMenu,;
{ "R/W", "RG+/W", "W+/R", "RG+/R+",;
"W+/R+", "RG+/N+", "G+/R+" } )
AddItem( aMiMenu, 1, "Exit" )
AddItem( aMiMenu, 2, "Debug On" )
AddItem( aMiMenu, 2, "Debug Off" )
AddItem( aMiMenu, 3, "Book Phone" )
AddLine( aMiMenu, 3 )
AddItem( aMiMenu, 3, "Open ASCII capture" )
AddItem( aMiMenu, 3, "Open DEBUG capture" )
AddItem( aMiMenu, 3, "Close ASCII capture" )
AddItem( aMiMenu, 3, "Close DEBUG capture" )
AddItem( aMiMenu, 4, "Call string" )
AddLine( aMiMenu, 4 )
AddItem( aMiMenu, 4, "Inicialization string" )
AddItem( aMiMenu, 4, "COM port number" )
AddItem( aMiMenu, 4, "COM port Speed" )
AddLine( aMiMenu, 4 )
AddItem( aMiMenu, 4, "Inicialize Modem" )
AddLine( aMiMenu, 4 )
AddItem( aMiMenu, 4, "Save Configuration" )
AddItem( aMiMenu, 5, "Edit Macros" )
OffItem( aMiMenu, 5, 1 )
AddLine( aMiMenu, 5 )
AddItem( aMiMenu, 5, "F1: " + MACRO_F1 )
AddItem( aMiMenu, 5, "F2: " + MACRO_F2 )
AddItem( aMiMenu, 5, "F3: " + MACRO_F3 )
AddItem( aMiMenu, 5, "F4: " + MACRO_F4 )
AddItem( aMiMenu, 5, "F5: " + MACRO_F5 )
AddLine( aMiMenu, 5 )
AddItem( aMiMenu, 5, "Save Macros" )
nOpcion := DispMenu( aMiMenu )
nItem := nOpcion - 10000 * Int( nOpcion / 10000 )
if nOpcion == 0
@ 00,00 say replicate( chr( 177 ), 80 )
RETURN ( Nil )
Elseif( int( nOpcion / 10000 ) == 5 )
do case
case( nItem/100 ) == 2
MACRO_F1 := _AskFor2( "Macro F1: ", MACRO_F1, len( MACRO_F1 ) )
case( nItem/100 ) == 3
MACRO_F2 := _AskFor2( "Macro F2: ", MACRO_F2, len( MACRO_F2 ) )
case( nItem/100 ) == 4
MACRO_F3 := _AskFor2( "Macro F3: ", MACRO_F3, len( MACRO_F3 ) )
case( nItem/100 ) == 5
MACRO_F4 := _AskFor2( "Macro F4: ", MACRO_F4, len( MACRO_F4 ) )
case( nItem/100 ) == 6
MACRO_F5 := _AskFor2( "Macro F5: ", MACRO_F5, len( MACRO_F5 ) )
case( nItem/100 ) == 7
SaveArray( aMacro, "Macro.def", @nError )
end case
ElseIf( int( nOpcion / 10000 ) == 4 )
do case
case( nItem/100 ) == 1
DIALSTRING := _AskFor2( "Call String: ", DIALSTRING, len( DIALSTRING ) )
case( nItem/100 ) == 2
INICIALIZACION := _AskFor2( "Inicialization String: ", INICIALIZACION, len( INICIALIZACION ) )
case( nItem/100 ) == 3
RePuerto()
case( nItem/100 ) == 4
ReBaudios()
case( nItem/100 ) == 5
Inicializa()
case( nItem/100 ) == 6
nError := 0
SaveArray( aSetUp, "SetUp.def", @nError )
if( nError!=0 )
BoxWarning( "I can not create Setup file" )
EndIf
end case
ElseIf( int( nOpcion / 10000 ) == 1 )
do case
case( nItem/100 ) == 1
exit( 0 )
end case
ElseIf( int( nOpcion / 10000 ) == 2 )
do case
case( nItem/100 ) == 1
if ISDEBUG
BoxWarning( "Debug is actived." )
else
_SetDOn()
_WriteDebug( "",.t. )
ISDEBUG := .t.
EndIf
case( nItem/100 ) == 2
if .not. ISDEBUG
BoxWarning( "Debug is not actived." )
else
_SetDOff()
ISDEBUG := .f.
if ISDCAPTURE
ISDCAPTURE := .f.
fclose( NDCAP )
NDCAP := -1
BoxWarning( "Debug capture closed." )
EndIf
EndIf
end case
ElseIf( int( nOpcion /10000 ) == 3 )
do case
case( nItem/100 ) == 1
Agenda()
case( nItem/100 ) == 2
if ISACAPTURE
BoxWarning( "ASCII capture is opened." )
else
NACAP := fcreate( _AskFor2( "ASCII capture file name: ", space( 13 ), 13 ) )
ISACAPTURE := .t.
EndIf
case( nItem/100 ) == 3
if ISDEBUG
if ISDCAPTURE
BoxWarning( "DEBUG capture is opended." )
else
NDCAP := fcreate( _AskFor2( "DEBUG capture file name", space( 13 ), 13 ) )
ISDCAPTURE := .t.
EndIf
else
BoxWarning( "Sorry, active DEBUG before active DEBUG capture" )
EndIf
case( nItem/100 ) == 4
if ISACAPTURE
ISACAPTURE := .f.
fclose( NACAP )
NACAP := -1
else
BoxWarning( "ASCII capture closed." )
EndIf
case( nItem/100 ) == 5
if ISDCAPTURE
ISDCAPTURE := .f.
fclose( NDCAP )
NDCAP := -1
else
BoxWarning( "DEBUG capture closed." )
EndIf
end case
EndIf
@ 00,00 say replicate( chr( 177 ), 80 )
setpos( nRow,nCol )
RETURN ( Nil )
FUNCTION ReInstala()
local nError
ComUnInst()
nError := ComInst( PUERTO )
ComSpeed( BAUDIOS )
if( nError!=0 )
if( nError == 2 )
WriteScreen( "COM port not selected.|" )
EndIf
EndIf
ComInFlh()
ComOutFlh()
if .not. ComInEmpt()
WriteScreen( "There's problems with I/O buffers.|" )
endif
if .not. ComOutEmpty()
WriteScreen( "There's problems with I/O buffers.|" )
endif
Inicializacion()
if ComCarrier()
WriteScreen( "Carrier Detected.|" )
EndIf
ComHighDTR()
RETURN ( Nil )
FUNCTION Inicializa()
while .not. ComReady()
Enddo
ComOutputs( alltrim( INICIALIZACION ) + CRLF )
RETURN ( Nil )
FUNCTION MakeSetUp()
local aSetUp := { 4,2400,"ATDP ", "atm1l1&c1&v " }
local nError := 0
SaveArray( aSetUp, "SetUp.def", @nError )
if( nError!=0 )
BoxWarning( "Configuration file not created." )
EndIf
RETURN ( Nil )
FUNCTION MakeMacro()
local aMacro := { space(30), space(30), space(30), space(30), space(30) }
local nError := 0
SaveArray( aMacro, "Macro.def", @nError )
if( nError!=0 )
BoxWarning( "Macro file not created." )
EndIf
RETURN ( Nil )
FUNCTION MakePhoneBook()
local aPhoneBook := {}
local nCounter
local nError := 0
for nCounter := 1 to 10
aadd( aPhoneBook, { space( 20 ), space( 15 ) } )
next nCounter
SaveArray( aPhoneBook, "PhoneBk.def", @nError )
if( nError!=0 )
BoxWarning( "Bookphone file not created." )
EndIf
RETURN ( Nil )
FUNCTION ReDrawScreen()
Local GetList := {}
Local nInd
clear
@ 00,00 say replicate( chr( 177 ), 80 )
@ 01,00 say replicate( chr( 196 ), 80 )
@ 23,00 say replicate( chr( 196 ), 80 )
@ 24,00 say replicate( chr( 177 ), 80 )
for nInd := 2 to 22
@ nInd, 0 say Space( 80 )
next
RETURN ( Nil )
FUNCTION Agenda()
Local GetList := {}
#define NAME( x ) aPhone[ x ][1]
#define PHONE( x ) aPhone[ x ][2]
#define Tr2( x ) str( x,2 )
local aPhoneBook := {}
local nCounter := 0
local nOpcion
local nColor := setcolor( ROJO )
local lMore := .t.
local nRow := 2
local nTecla
local nToEdit := 1
local lUpdated := .f.
local nError := 0
local sPantalla := savescreen( 0,0,24,79 )
while lMore
aPhoneBook := {}
nCounter := 0
while( ++nCounter!=len( aPhone ) + 1 )
aadd( aPhoneBook, Tr2( nCounter ) + ") " + ;
Capital( NAME( nCounter ) ) + ;
" - " + PHONE( nCounter ) )
Enddo
scroll( 2,2,15,51 )
dispbox( 2,2,16,51,1 )
dispbox( 2,2,13,51,1 )
@ 13,2 say chr( 195 ) ; @ 13,51 say chr( 180 )
@ 14,3 say " E)dit, D)ial, eX)it "
aeval( aPhoneBook, {|x| xDisp( nRow := if( ++nRow > 12,3,nRow ), 3, x ) } )
nTecla := upper( chr( inkey(0) ) )
do case
case nTecla == "X"
lMore := .f.
case nTecla == "E"
nToEdit := AskFor( "Number to Edit: ", nToEdit, "99" )
@ 2 + nToEdit, 7 get NAME( nToEdit ) color ROJO
@ 2 + nToEdit, 30 get PHONE( nToEdit ) color ROJO
setcursor( SC_SPECIAL1 )
read
setcursor( 0 )
lUpdated := .t.
case nTecla == "D"
nToEdit := AskFor( "Number to call: ", nToEdit, "99" )
if( .not. empty( PHONE( nToEdit ) ) )
ComOutputs( alltrim( DIALSTRING ) + PHONE( nToEdit ) + CRLF )
lMore := .f.
else
BoxWarning( "There isn't no phone to call." )
EndIf
end case
Enddo
if lUpdated
SaveArray( aPhone, "PhoneBk.def", @nError )
EndIf
restscreen( 0,0,24,79,sPantalla )
RETURN setcolor( nColor )
FUNCTION xDisp( nRow, nCol, cText )
setpos( nRow, nCol )
QQout( cText )
RETURN Nil
FUNCTION AskFor( cText, xWhat, cPict )
Local GetList := {}
@ 15,4 say cText get xWhat color ROJO pict cPict
setcursor( SC_SPECIAL1 )
read
setcursor( 0 )
@ 15,3 say space( 40 )
RETURN xWhat
FUNCTION _AskFor2( cText, xWhat, nLen )
Local GetList := {}
local nCursor := setcursor( SC_SPECIAL1 )
local cColor := setcolor( ROJO )
local sPantalla := savescreen( 10,10,12,10 + len( cText ) + nLen + 4 )
scroll( 10,10,12,10 + len( cText ) + nLen + 4 )
dispbox( 10,10,12,10 + len( cText ) + nLen + 4 )
@ 11,12 say cText color ROJO get xWhat color ROJO
read
restscreen( 10,10,12,10 + len( cText ) + nLen + 4, sPantalla )
setcursor( nCursor )
setcolor( cColor )
RETURN xWhat
FUNCTION _eValMacro( cMacro )
local nCounter := 0
local cChar
cMacro := rtrim( cMacro )
while( len( cMacro ) != 0 )
++nCounter
cChar := Cut( @cMacro )
do case
case cChar == "|"
while .not. ComReady()
Enddo
ComOutput( 13 )
ComOutput( 10 )
case cChar == "^"
Delay( 0.5 )
otherwise
while .not. ComReady()
Enddo
ComOutput( asc( cChar ) )
end case
Enddo
Return( Nil )
FUNCTION ReBaudios()
local cIniColor := setcolor( VERDE )
local nOpcion, sPantalla := savescreen( 6,50,10,60 )
scroll( 6,50,10,60 )
dispbox( 6,50,10,60 )
@ 7,52 prompt " 1.200 "
@ 8,52 prompt " 2.400 "
@ 9,52 prompt " 9.600 "
menu to nOpcion
do case
case nOpcion == 1
BAUDIOS := 1200
case nOpcion == 2
BAUDIOS := 2400
case nOpcion == 3
BAUDIOS := 9600
otherwise
BAUDIOS := 2400
end case
restscreen( 6,50,10,60, sPantalla )
RETURN setcolor( cIniColor )
FUNCTION RePuerto()
local cIniColor := setcolor( VERDE )
local nOpcion, sPantalla := savescreen( 6,50,11,60 )
scroll( 6,50,11,60 )
dispbox( 6,50,11,60 )
@ 7,52 prompt " COM 1 "
@ 8,52 prompt " COM 2 "
@ 9,52 prompt " COM 3 "
@10,52 prompt " COM 4 "
menu to nOpcion
do case
case nOpcion == 1
PUERTO := 1
case nOpcion == 2
PUERTO := 2
case nOpcion == 3
PUERTO := 3
otherwise
PUERTO := 4
end case
restscreen( 6,50,11,60, sPantalla )
RETURN setcolor( cIniColor )