'===========================================================================
' Subject: ANSI MODEM TERMINAL                Date: 05-16-94 (23:20)       
'  Author: Erik Olson                         Code: PB                     
'  Origin: Rolf@ice.prima.ruhr.de           Packet: MODEM.ABC
'===========================================================================
' Ansi modem terminal program for PowerBASIC
' Public Domain by Erik Olson

$OPTION CNTLBREAK OFF
$COM 2048
$STRING 4
$LIB GRAPH OFF
$LIB IPRINT OFF
$LIB LPT ON
$LIB COM ON
$FLOAT EMULATE
$COMPILE EXE

%FALSE = 0
%TRUE  = NOT %FALSE

' sound effects
DECLARE SUB BELL()
DECLARE SUB DAGNABBIT()
DECLARE SUB FWEEP()
DECLARE SUB FWOP()
DECLARE SUB YIPPEE()

' support routines
DECLARE SUB TERMINAL(STRING)
DECLARE FUNCTION POPDIR$(STRING)

ON ERROR GOTO ErrorHandler

DIM MENU$(10)
SHARED MENU$(), TermScreen$, Termx%, Termy%, ScrnBuf%

CLS
FWEEP
MESSAGE "ANSI MODEM TERMINAL"
DELAY .5
MESSAGE "PowerBASIC 3.00b"
DELAY .5
MESSAGE "INITIALIZING PORTS"
SETPORTS
DELAY .3
MESSAGE "VERIFY PARAMETERS"
BELL

A$ = DIR$("OPENCOM.DAT")
IF A$="" THEN
	P$="COM2:2400,N,8,1,RS,CS,CD,DS,ME    "
ELSE
	OPEN A$ FOR INPUT AS #1
	LINE INPUT #1, P$
	CLOSE #1
END IF
P$=P$+SPACE$(40-LEN(P$))
P$=EDITBOX$(P$)
IF P$="" THEN END ELSE OPEN "OPENCOM.DAT" FOR OUTPUT AS #1:PRINT #1, P$:CLOSE

TERMINAL P$

LOCATE 25,1:END


' ==========[subroutines]=============



SUB TERMINAL(Parameter$)
IF Parameter$ = "" THEN EXIT SUB
ComBuf% = FREEFILE
CapBuf% = 9
PrnBuf% = 10
OPEN Parameter$ FOR RANDOM AS #ComBuf%
ScrnBuf% = FREEFILE
OPEN "CONS:" FOR OUTPUT AS #ScrnBuf%
IF LEN(TermScreen$) THEN
	RESTORESCREEN TermScreen$:ANSILOCATE Termx%, Termy%
	LOCATE Termx%,Termy%,1
ELSE
	CLS:ANSILOCATE 1,1:LOCATE 1,1,1
END IF
PRINT #ScrnBuf%, "PowerBASIC 3.00b Modem Terminal Program"
PRINT #ScrnBuf%, "Terminal Mode þ Press INSERT for menu"
PRINT #ScrnBuf%, "RESETTING MODEM..."
RESETMODEM ComBuf%
BELL

DO
	A$=INKEY$
	IF A$=CHR$(27) THEN A$=CHR$(0,82)
	IF LEN(A$) = 2 THEN
		ANSICURSOR x%,y%
		LOCATE x%,y%,0
		SELECT CASE A$
		CASE CHR$(0,45)   'alt-X = quit
		CLS:PRINT "Wait...":RESETMODEM ComBuf%:PRINT "*** End Program"
		LOCATE 25,1,1:CHAIN "PA(CAR).EXE"     'END

			CASE CHR$(0,72) '  up arrow
			Print #Combuf%,chr$(27)+"]A";
			CASE CHR$(0,75) '  left arrow
			Print #Combuf%,chr$(27)+"]C";
			CASE CHR$(0,77) '  right arrow
			Print #Combuf%,chr$(27)+"]D";
			CASE CHR$(0,79) '  end
			Print #Combuf%,chr$(27)+"]K";
			CASE CHR$(0,80) '  down arrow
			Print #Combuf%,chr$(27)+"]B";
			CASE CHR$(0,71) '  home
			Print #Combuf%,chr$(27)+"]H";
			CASE CHR$(0,83) '  Delete
			Print #Combuf%,chr$(&H7F);

			CASE CHR$(0,104) ' ALT-F1
			O$=SAVESCREEN$
			FWEEP
			IF Capture%=0 THEN MESSAGE "CAPTURE FILENAME:"
			INCR Capture%
			IF Capture% THEN Cap$=EditBox$("                      ")
			IF Cap$="" THEN Capture%=0
			FWEEP
			IF Capture%=1 THEN
				Capture%=-1
				MESSAGE "CAPTURE ON"
				OPEN Cap$ FOR APPEND AS #CapBuf%
			ELSE
				MESSAGE "CAPTURE OFF"
				CLOSE #CapBuf%
			END IF
			DELAY 1
			RESTORESCREEN O$

			CASE CHR$(0,38)  ' ALT-L
			O$=SAVESCREEN$
			INCR Printer%
			FWEEP
			IF Printer%=1 THEN
				Printer%=-1
				MESSAGE "PRINTER ON"
			ELSE
				MESSAGE "PRINTER OFF"
			END IF
			DELAY 1
			RESTORESCREEN O$
			CASE CHR$(0,35)  ' ALT-H
				O$=SAVESCREEN$
				FWEEP
				MESSAGE "RESETTING MODEM..."
				RESETMODEM Combuf%
				FWOP
				RESTORESCREEN O$
		ANSILOCATE x%,y%
                CASE ELSE
                'menu
                O$ = SAVESCREEN$
                ANSICURSOR X%, Y%
                MENU$(1) = "Dial a Number  "
		MENU$(2) = "Toggle Capture "
		MENU$(3) = "Toggle Printing"
		MENU$(4) = "End Session    "
		MENU$(5) = ""
                FWEEP
                SELECT CASE POPMENU(MENU$())
                        CASE 1
				O2$=SAVESCREEN$
				MESSAGE "Number to Dial"
				A$ = EDITBOX$("                      ")
				RESTORESCREEN O2$
				IF LEN(A$) THEN
					RESETMODEM ComBuf%
					DELAY 1
					PRINT #ComBuf%, "ATDT"+A$
				END IF

			CASE 2
			FWEEP
			IF Capture%=0 THEN MESSAGE "CAPTURE FILENAME:"
			INCR Capture%
			IF Capture% THEN Cap$=EditBox$("                      ")
			IF Cap$="" THEN Capture%=0
			FWEEP
			IF Capture%=1 THEN
				Capture%=-1
				MESSAGE "CAPTURE ON"
				OPEN Cap$ FOR APPEND AS #CapBuf%
			ELSE
				MESSAGE "CAPTURE OFF"
				CLOSE #CapBuf%
			END IF
			DELAY 1
			CASE 3
			INCR Printer%
			FWEEP
			IF Printer%=1 THEN
				Printer%=-1
				MESSAGE "PRINTER ON"
			ELSE
				MESSAGE "PRINTER OFF"
			END IF
			DELAY 1
			CASE 4   ' end session
			MESSAGE "RESETTING MODEM"
			RESETMODEM ComBuf%
			AbortFlag% = %TRUE:CHAIN "PA(CAR).EXE"
                        CASE ELSE
                        FWOP
                END SELECT
                RESTORESCREEN O$
		FWOP
		ANSILOCATE X%,Y%
        END SELECT
        IF AbortFlag% THEN EXIT LOOP
        ELSE  ' len a$ does not equal 2
                PRINT #ComBuf%,A$;
	END IF ' len a$

                IF LOC(ComBuf%) THEN
                        A$=INPUT$(1,ComBuf%)
                        IF A$=CHR$(8) THEN A$=CHR$(8)+" "+CHR$(8)
                        IF A$ = CHR$(7) THEN A$ = "": BELL

			IF Printer% THEN LPRINT A$;
			IF Capture% THEN PRINT #CapBuf%, A$;
			PRINT #ScrnBuf% , A$;
                END IF
LOOP
CLOSE #ComBuf
TermScreen$ = SAVESCREEN$
ANSICURSOR Termx%, Termy%
END

END SUB

SUB SETPORTS
def seg=&h40
poke 0,&hf8  '03F8  sets com1 address irq 4
poke 1,&h03
poke 2,&hf8  '02F8  sets com2 address irq 3
poke 3,&h02
poke 4,&he8  '03E8  sets com3 address irq 4
poke 5,&h03
poke 6,&he8  '02E8  sets com4 address irq 3
poke 7,&h02
def seg

END SUB

SUB RESETMODEM(m%)
	DELAY 1.1
	PRINT #m%,"+"; : DELAY .3
	PRINT #m%,"+"; : DELAY .3
	PRINT #m%,"+"; : DELAY 1.1
	PRINT #m%,"ATZ"
	DELAY .5
END SUB


FUNCTION SaveScreen$
REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
DEF SEG = ADDRESS
SaveScreen$=PEEK$(0,4000)
DEF SEG
END FUNCTION

SUB RestoreScreen(S$)
REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address=&HB000 else Address=&HB800
DEF SEG = Address
POKE$ 0, S$
DEF SEG
END SUB

FUNCTION PopMenu(item$())
' Center a scrolling menu on the screen containing options in Item$()
' This function returns the number of the selected item, or 0 if ESC pressed.
COLOR 0,7
MenWid=0:MenHi=0
DO:MenHi=MenHi+1:IF LEN(Item$(MenHi))>MenWid then MenWid=LEN(Item$(MenHi))
LOOP WHILE LEN(Item$(MenHi))
MenHi=MenHi:MenWid=MenWid+4

' Menu box is MenHi x MenWid
		wa% = 12 - (MenHi\2)
		wb% = 40 - (MenWid\2)
		wc% = wa% + MenHi
		wd% = wb% + MenWid
CALL SingleBox(Wa%,Wb%,Wc%,Wd%)

For y=1 to MenHi-1
	Locate 12 - (MenHi\2) + y, 42 - (MenWid\2):Print Item$(y)
Next y

	PopMe=1
	DO
	Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2),0
		 Color 7,0 : Print Item$(PopMe) : Color 0,7
	do:a$ = Inkey$:loop while a$=""
		If Len(a$) = 2 THEN a=asc(right$(a$,1)) else a=asc(a$)


		SELECT CASE a

		CASE &H48 ' up arrow
		Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
		Print Item$(PopMe)
		PopMe=PopMe-1
		If PopMe = 0 then PopMe = MenHi-1

		CASE &H50 ' dn arrow
		Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
		Print Item$(PopMe)
		PopMe=PopMe+1
		If PopMe = MenHi then PopMe = 1


		CASE &H47   ' home
                Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
		Print Item$(PopMe)
		PopMe=1


		CASE      &H4D      ' right arrow ........ it could happen
		CASE      &H4B      ' left arrow
				    ' these keys might indicate that the
				    ' user wants to move horizontally to
				    ' another menu.  See CASEKEYS.BAS for
				    ' a generic keyboard polling CASE struct



		CASE      &H51      ' page down
		Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
		Print Item$(PopMe)
		PopMe=MenHi

		CASE      &H49      ' page up
                Locate 12 - (MenHi\2) + PopMe,42-(MenWid\2)
		Print Item$(PopMe)
		PopMe=1

		CASE 27   ' escape
		PopMenu=0 : Exit Loop

		CASE 13
		PopMenu=PopMe : Exit Loop

		CASE ELSE
		END SELECT


loop

COLOR 7,0
END FUNCTION




FUNCTION EditBox$(Default$)

COLOR 0,7
CALL SingleBox(19, 38-(LEN(Default$)\2), 21, 42+(LEN(Default$)\2))
y = 40 - (LEN(Default$) \ 2) : YY=len(rtrim$(default$))
DO


   LOCATE 20,Y,0:PRINT Default$  ' if you want to put the box somewhere
   LOCATE  20,Y+yy,1             ' else, change these locate statements


   DO:A$=INKEY$:LOOP WHILE LEN(A$)=0
   IF LEN(A$) THEN
      SELECT CASE(A$)
      CASE CHR$(27), CHR$(13)
         EXIT SELECT
      CASE CHR$(8)
         IF YY THEN
            YY=YY-1
            IF YY THEN
               Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "
            ELSE
               Default$=MID$(Default$,yy+2) + " "
            END IF
         END IF
      CASE CHR$(0)+CHR$(83)
         IF YY THEN
            Default$=LEFT$(Default$,yy)+MID$(Default$,yy+2) + " "
         ELSE
            Default$=MID$(Default$,yy+2) + " "
         END IF
      CASE CHR$(0)+CHR$(&H4D)
         IF YY < LEN(Default$) THEN YY=YY+1
      CASE CHR$(0)+CHR$(&H4B)
         IF YY THEN YY=YY-1
      CASE CHR$(0)+CHR$(79) 'end
         yy=LEN(RTRIM$(default$))
      CASE CHR$(0)+CHR$(71)
         yy=0

      CASE ELSE
         IF LEN(A$)=1 and YY=0 THEN Default$=SPACE$(LEN(default$))
         IF LEN(A$)=1 and YY < LEN(Default$) THEN_
         MID$(Default$,YY+1,1) = A$ : YY=YY+1

      END SELECT
      IF A$=CHR$(27) THEN EditBox$="":EXIT LOOP
      IF A$=CHR$(13) THEN EditBox$=RTRIM$(Default$):EXIT LOOP

   END IF
LOOP
COLOR 7,0
END FUNCTION


SUB SingleBox (Wa%, Wb%, Wc%, Wd%) PUBLIC

REG 1, 15*256
CALL INTERRUPT &H10
IF Reg(1) - (Reg(1)\256) * 256 = 7 THEN Address&=&HB000 else Address&=&HB800
DEF SEG = ADDRESS&

   LOCATE Wa%, Wb%,0: PRINT CHR$(213) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(184)
   LOCATE Wc%, Wb%: PRINT CHR$(212) + STRING$((Wd% - Wb%) - 1, 205) + CHR$(190)

   FOR zxy% = 1 TO Wc% - Wa% - 1
      LOCATE Wa% + zxy%, Wb%
      PRINT CHR$(179) + SPACE$((Wd% - Wb%) - 1) + CHR$(179)
        ' right side of the box is Wa+zxy *80 + Wd + 1
	' stuff an attribute into there
	POKE ( (Wa%+Zxy%) * 160 ) + (Wd%*2) + 1,8
   NEXT zxy%
        for i%=(Wc% * 160) + ((wb%+2)*2)-1 TO (Wc%*160) + ((Wd%*2)+2)-1 STEP 2
        ' What this does is calculate the memory locations of the characters
        ' in video ram
        POKE i%, 8
	Next i%
DEF SEG
END SUB

SUB Message (E$)
   CALL SingleBox(10, 20, 12, 60)
   LOCATE 11, 40 - (LEN(E$) \ 2)
   PRINT E$;
END SUB

FUNCTION YesNo (Prompt$)
IF LEN(Prompt$) < 15 THEN Prompt$ = SPACE$(8 - LEN(Prompt$) \ 2) + Prompt$ + SPACE$(8 - LEN(Prompt$) \ 2)
Wb% = 38 - LEN(Prompt$) \ 2
Wd% = 42 + LEN(Prompt$) \ 2
Wa% = CSRLIN
Wc% = Wa% + 3
CALL SingleBox(Wa%, Wb%, Wc%, Wd%)
LOCATE Wa% + 1, 40 - LEN(Prompt$) \ 2: PRINT Prompt$
YorN = -1
LET YorN$ = "<Yes>    No "
DO
   LOCATE Wa% + 2, 34: PRINT YorN$
   DO: A$ = INKEY$: LOOP WHILE A$ = ""
   IF UCASE$(A$) = "Y" THEN YorN = -1
   IF UCASE$(A$) = "N" THEN YorN = 0
   IF A$ = CHR$(0) + CHR$(&H4D) THEN YorN = 0
   IF A$ = CHR$(0) + CHR$(&H4B) THEN YorN = -1
   IF A$ = CHR$(13) THEN EXIT LOOP
   IF YorN THEN LET YorN$ = "<Yes>    No " ELSE LET YorN$ = " Yes    <No>"

LOOP
YesNo = YorN

END FUNCTION

SUB SETHIBIT ' toggle blink to intensity bit
	REG 1,&H1003
	REG 2,0
	CALL INTERRUPT &H10
END SUB

SUB ANSILOCATE(ROW%, COL%)   'Sets BIOS cursor
	LOCATE Row%,Col%,1
	REG 1,&H0200
	REG 2,0
	REG 3,(Row%*256)+COL%
	CALL INTERRUPT &H10
END SUB

SUB ANSICURSOR(ROW%, COL%)   'Returns the current position of the cursor
REG 1,&H0300
REG 2,0
CALL INTERRUPT &H10
ROW% = (REG(4) \ 256) + 1
COL% = (REG(4) AND &HFF) + 1
END SUB

SUB FWEEP
For y% = 800 TO 1800 STEP 200
SOUND y%,.1
NEXT y%
END SUB

SUB FWOP
FOR y% = 1800 TO 800 STEP -200
SOUND y%, .1
NEXT y%
END SUB

SUB YIPPEE
SOUND 1000,1:SOUND 2000,1:SOUND 3000,1
END SUB

SUB DAGNABBIT
SOUND 50,5
END SUB

SUB BELL
Sound 1000,.1
SOUND 5000,.1
SOUND 2500,.1
SOUND 1000,.1
DELAY 1
END SUB


ErrorHandler:

E = Err
EO$=SAVESCREEN$
DAGNABBIT
FWOP:FWOP:FWOP
MESSAGE "ERROR:" + STR$(E)
LOCATE 19,1
IF YesNo("Continue?") THEN RESTORESCREEN EO$:RESUME NEXT
FWEEP
LOCATE 19,1
IF YesNo("Exit to DOS?") THEN CLS:END
FWEEP
RESTORESCREEN EO$:MESSAGE "RESETTING MODEM...":RESETMODEM ComBuf%
RESTORESCREEN EO$
RUN