home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pick
/
picsub.bas
< prev
next >
Wrap
BASIC Source File
|
2020-01-01
|
3KB
|
92 lines
OPENFILE
001 SUBROUTINE (DICT,NAME,FV)
002 *OPEN A FILE;FIND LOCKS
003 *2/3/86 JF3
004 IF DICT="L" THEN
005 DICT="DICT";GOSUB 4;IF FLAG THEN DICT=-1;GO 2
006 CALL READITEM(0,"DICT ":NAME,FV,0,"F/LOCK",ITEM,FLAG)
007 IF FLAG AND ITEM<1>="A" THEN LOCK.ATTR=ITEM<2> ELSE LOCK.ATTR=0
008 DICT=""
009 END ELSE LOCK.ATTR=0
010 GOSUB 4;IF FLAG THEN DICT=-1 ELSE DICT=LOCK.ATTR
011 2 RETURN;*TO CALLER
012 4 FLAG=0;OPEN DICT,NAME TO FV ELSE
013 OPEN "","ERRFILE" TO FV ELSE PRINT "NO ERRFILE!";INPUT NAME;STOP
014 IF DICT#"" THEN DICT=DICT:" "
015 CALL PERR(0,0,FV,19,DICT:NAME);FLAG=1
016 END;RETURN;END
017 * * * * * Interface Info * * * * *
018 *
019 * DICT NAME FV
020 * ____ ____ __
021 *Entry: nul
022 * L filename
023 * DICT
024 *
025 *Exit:
026 * IF L lock-attr#:=open w/locking
027 * -1:= no open, error
028 * else
029 *
030 * nul| -1
031 * 0
BXTD
001 SUBROUTINE (N)
002 *CONVERT HEX STRING TO DECIMAL
003 *5/22/84 JF3
004 d=0;i=1;LOOP c=N[i,1] UNTIL c="" DO
005 d=d*16;IF c>"@" THEN c=SEQ(c)-55
006 d=d+c
007 i=i+1;REPEAT;N=d;RETURN
008 * * * * * Interface Info * * * * *
009 *Entry: N := Hex number as a char string
010 *
011 *Exit: N := equivalent number (decimal)
012 END
PERR
001 SUBROUTINE (C,R,F,ID,RESP)
002 *GENERAL ERROR MESSAGE SUBROUTINE
003 *10/11/85 JF3
004 EQU VM TO CHAR(253),PARAM TO RESP,CRTFUNC TO "U51A5"
005 PRINTER.WAS.ON=SYSTEM(1);PRINTER OFF;*SAVE PRINTER ON/OFF STATUS
006 CALL GTRMCHR(ITEM);EOL=ITEM<1,3>
007 IF R OR C THEN OMSG=@(C,R):EOL ELSE OMSG=""
008 READV MSG FROM F,ID,2 ELSE MSG="NO '":ID:"' IN ERRFILE!"
009 IF NUM(ID[1,1]) THEN OMSG=OMSG:CHAR(7)
010 I=1;J=1;LOOP SEG=FIELD(MSG,VM,I) UNTIL COL2()=0 DO
011 IF SEG="" THEN SEG=PARAM<1,J>;J=J+1
012 IF SEG[1,1]='@' THEN
013 SEG=OCONV(SEG<1,1,1>,CRTFUNC):SEG<1,1,2>
014 END;OMSG=OMSG:SEG
015 I=I+1;REPEAT;PRINT OMSG:
016 OMSG=ID[1,1];IF NUM(OMSG) OR OMSG="P" THEN
017 INPUT RESP:;IF R OR C THEN PRINT @(C,R):EOL:
018 END;IF PRINTER.WAS.ON THEN PRINTER ON
019 RETURN;END
GTRMCHR
001 SUBROUTINE (chrstr)
002 *SHARE TERMINAL CHARACTERISTICS STRING
003 *6/19/87 JF3
004 *]OPENFILE]PERR
005 EQU ERRFILE TO chrstr,VM TO CHAR(253)
006 chrstr=@(-1):VM:@(-3):VM:@(-4)
007 chrstr<4>=SYSTEM(2):",":SYSTEM(3)
008 IF chrstr="" THEN
009 CALL OPENFILE("","ERRFILE",ERRFILE)
010 CALL PERR(0,0,ERRFILE,"A1",0)
011 END;RETURN
012 * * * * * Interface info * * * * *
013 *Entry: none
014 *
015 *Exit: chrstr := dynamic array of CRT control codes
016 * <1,1> = clear screen and home
017 * <1,2> = erase to end of page
018 * <1,3> = erase to end of line
019 * <4> = arg string for TERM verb at TCL
020 END