Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : REMAP.CMD

 
Output of file : REMAP.CMD contained in archive : CA29-3.ZIP
S29 = "INTERNAL" ; Set your editor here
; ; .. "INTERNAL" -> Our own editor
; ----- COM-AND Compile remap table
;
; This script opens a window asking 1) to compile new remap, 2) turn
; remapping on, and 3) turn remap off.
;
; The big job, of course, if the compilation of remapping values.
; The result of the compilation is saved unconditionally as COM-AND.RMP.
;
; R.McG, commenced 2/89
; updated 3/92 (to use internal editor)
; ----- Usages -----------------
; S29 -----> The fully qualified EDITOR program file name
; S19 -----> COM-AND.RMP file name to be used
; S18 -----> Source file being compiled
; N99 -----> The # of errors in compilation
; N98 -----> The output file size
; N97 -----> # name commands to allow (set in SELECT)
; FLAG(9) -> Escape during compile (wait for another ESC)
; FLAG(8) -> If true, syntax check only
; ------------------------------
; Initialization
;
;* TRACE ON
ON ESCAPE GOSUB Exit ; SAVE is performed in Window
LEGEND " Remap compiler (ver 1.2)"
SET TTHRU OFF ; Disallow typeahead
GOSUB Set_Fname ; Get current fname
UPPER S19 ; Make nice for display
;
; Open a window
;
GOSUB Window ; Open main window
;
; Wait for a keystroke
;
Keyin:
LOCATE 18,20
ATSAY 18,20 (default) " "
KEYGET S0
IF NULL S0(1:3)
ATSAY 18,20 (default) S0
ENDIF
;
; Interpret the response
;
SWITCH S0
CASE "1" ; Compile
GOSUB Compile
ENDCASE
CASE "2" ; Syntax
GOSUB Syntax
ENDCASE
CASE "3" ; Search for file
GOSUB Alt_F
ENDCASE
CASE "4" ; Edit a file
GOSUB Edit
ENDCASE
CASE "5" ; Remap on
GOSUB Mapon
ENDCASE
CASE "6" ; Remap off
GOSUB Mapoff
ENDCASE
DEFAULT ; None of the above
SOUND 100,100
GOTO Keyin ; Try again
ENDCASE
ENDSWITCH
GOTO KEYIN
;
; ----- Subroutine Exit - terminate the process
;
Exit:
DO ; CLose any open windows
WCLOSE
UNTIL FAILURE
EXIT
;
; ----- Subroutine Mapon - turn on mapping (using current file)
;
MapOn:
SET REMAP ON ; Enable
RETURN
;
; ----- Subroutine MapOff - turn off mapping
;
MapOff:
SET REMAP OFF ; Disable
RETURN
;
; ----- Perform an Alt-F - file search
;
Alt_F:
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Search for files "
ATSAY 11,3 (default) "Enter a search template (e.g. 'd:\subd\x*.AR?')."
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0
WCLOSE
;
; If not null, perform the request
;
IF NOT NULL S0
DIR S0 ; Make upper case
ENDIF
RETURN
;
; ----- Invoke an editor to edit a file
;
Edit:
IF NOT NULL S29 GOTO Edit100
;
; Open a window and ask for the editor's name
;
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Edit file "
ATSAY 11,3 (default) "Enter the editor's name, fully qualified (e.g. C:\PE.EXE)."
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0 ; ErrEsc clears S0, so we use it
WCLOSE

IF NULL S0 RETURN ; Return on empty answer
S29 = S0 ; Save for next time
;
; Open another window and ask for the file name
;
Edit100:
WOPEN 10,1 13,78 (default) ErrEsc
ATSAY 10,3 (default) " Edit file "
ATSAY 11,3 (default) "Enter the file name to be edited:"
ATSAY 12,3 (default) "-> "
ATSAY 13,30 (default) " Press ESC to cancel "
ATGET 12,6 (default) 50 S0 ; ErrEsc clears S0, so we use it
WCLOSE
;
; If not null, perform the request
;
IF NOT NULL S0 and (NOT NULL S29 and NOT FIND S29 "INTERNAL")
RUN S29 * " " *S0 ; Make upper case
IF FAILED S29 = "INTERNAL" ; Clear S29 if failed
ENDIF
IF (NULL S29 or FIND S29 "INTERNAL") and NOT NULL S0 EDIT S0
RETURN
;
; ----- Construct the file name we'll use for COM-AND.RMP
;
Set_Fname:
S19 = "COM-AND.RMP" ; Default to current subdir
IF ISFILE S19 ; Look for file on default subdir
RETURN ; Exit here
ENDIF
;
; ----- Construct the file with the COM-AND= pathing (if provided)
;
ENVIRON S1 "COM-AND=" ; Look for COM-AND= environment var
IF FOUND ; If environment variable found
LENGTH S1 N0 ; Get its length
N0 = N0-1 ; Point to last char in string
IF not STRCMP S1(n0:n0) "\"
N0 = N0+1
CONCAT S1(n0) "\"
ENDIF
ENDIF
S19 = S1&"COM-AND.RMP" ; Concatenate path and name
RETURN
;
; ----- Subroutine: error
; .. Open a window, display, and and await keypress
; S0,S1 pass the message(s) to display
;
Error:
WOPEN 10,1, 13,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) S0(0:73)
ATSAY 12, 3 (contrast) S1(0:73)
ATSAY 13,26 (contrast) " Press any key to continue "
SOUND 880,100

KEYGET S0 ; Wait for any key
WCLOSE ; Restore screen under
RETURN ; And return to caller
;
; Escape during "Error" window
;
ErrEsc:
S0 = "" ; Make S0 null
RETURN ; And return to KEYGET above
;
; ----- Subroutine: Test S0 for a valid (known) keycode
; Parameter S0 ------> The keycode being passed
; Return: FLAG(0) <- TRUE if erroneous keycode
; S0 <------ The converted keycode (if FLAG(0) false)
; N0 <------ The length of the converted keycode
;
Keycode:
LJ S0 ; Force left justification
S0 = S0&"" ; Trim trailing blanks
SET FLAG(0) OFF ; Default return value
LENGTH S0 N0 ; Compute len of parm
;
; Catch decimal and hex numbers here
;
IF NUMERIC S0(0:0) ; Case insensitive test here
ATOI S0 N0 ; Convert value
IF (NOT ERROR) and (GE N0 0 and LE N0 255)
ITOC N0 S0 ; Return value 0-255 as char
N0 = 1 ; Set rtn length
RETURN
ENDIF
ENDIF
;
; Switch according to length here
;
SWITCH N0
CASE 1 ; 1 char wide
GOTO TEKE100
ENDCASE
CASE 2 ; 2 chars wide
GOTO TEKE200
ENDCASE
CASE 3 ; 3 chars wide
GOTO TEKE300
ENDCASE
CASE 4 ; 4 chars wide
GOTO TEKE400
ENDCASE
CASE 5 ; 5 chars wide
GOTO TEKE500
ENDCASE
CASE 6 ; 6 chars wide
GOTO TEKE600
ENDCASE
DEFAULT
SET FLAG(0) ON ; Others are errors
RETURN
ENDCASE
ENDSWITCH
;
; ***** Single character keycode here (take char as-is)
;
TEKE100:
N0 = 1 ; Return length here (char already in S0)
RETURN
;
; ***** Two character keycode here: First: ^chars
;
TEKE200:
IF STRCMP S0(0:0) "^" ; Caret initially
UPPER S0 ; Make upper case
CTOI S0(1:1) N0
ITOC (N0-64) S0 ; Convert to control form, and place
N0 = 1
RETURN
ENDIF
;
; Catch F0-F9
;
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0 N0
IF NE 0 (N0\3) ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
ITOC 0 S0
ITOC (0x3b+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Catch cr and bs here
;
SWITCH S0
CASE "CR" ; Carriage Rtn
ITOC 13 S0
N0 = 1
RETURN
ENDCASE
CASE "BS" ; Carriage Rtn
ITOC 8 S0
N0 = 1
RETURN
ENDCASE
ENDSWITCH
;
; Other pairs are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Three character keycode here: First, rtn a quoted character
;
TEKE300:
IF STRCMP S0(0:0) "`"" and STRCMP S0(2:2) "`""
S0 = S0(1:1)
N0 = 1 ; Return length here (char in S0)
RETURN
ENDIF
;
; Catch SF0-SF9, CF0-CF9, AF0-AF9, ^F0-^F9
;
UPPER S0
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(1:2) N0
IF NE (N0\3) 0 ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
;
; Look at the leading character
;
FIND "SCA^" S0(0:0) N1
SWITCH N1
CASE 0 ; AF0,AF1...
ITOC (0x54+N0/3) S0(1)
ENDCASE
CASE 1 ; CF0,CF1...
ITOC (0x5E+N0/3) S0(1)
ENDCASE
CASE 2 ; AF0,AF1...
ITOC (0x68+N0/3) S0(1)
ENDCASE
CASE 3 ; ^F0,^F1...
ITOC (0x5E+N0/3) S0(1)
ENDCASE
DEFAULT
SET FLAG(0) ON
RETURN
ENDCASE
ENDSWITCH
;
; Return with the goods
;
ITOC 0 S0 ; Modify S) after look for "SCA^"
N0 = 2
RETURN
ENDIF
;
; And finally, 'END','ESC', 'TAB' and 'F10'
;
SWITCH S0
CASE "END" ; Endkey
ITOC 0x4f S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "TAB" ; Tabkey
ITOC 9 S0
N0 = 1
RETURN
ENDCASE
CASE "ESC" ; Esckey
ITOC 0x1b S0
N0 = 1
RETURN
ENDCASE
CASE "F10" ; F10 key
ITOC 0x44 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "INS" ; Inskey
ITOC 0x52 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "DEL" ; Delkey
ITOC 0x53 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Four character keycode here
;
TEKE400:
;
; Catch AltA-AltZ, Alt0-Alt9, Alt-
;
UPPER S0
IF FIND "ALT" S0(0:2) ; Case insensitive test
;
; Catch Alt'd QWERTYUIOP
;
IF FIND "QWERTYUIOP" S0(3) N0
ITOC (0x10+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd ASDFGHJKL
;
IF FIND "ASDFGHJKL" S0(3) N0
ITOC (0x1E+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd ZXCVBNM
;
IF FIND "ZXCVBNM" S0(3) N0
ITOC (0x2C+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Catch Alt'd 1234567890-
;
IF FIND "1234567890-" S0(3) N0
ITOC (0x78+N0) S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Other Alt's are errors
;
SET FLAG(0) ON
RETURN
ENDIF
;
; Now, 'SF10', 'CF10' 'AF10' and '^F10'
;
IF FIND "F10" S0(1:3) ; Last 3 chars are F10
FIND "SCA^" S0(0:0) N0
SWITCH N0
CASE 0 ; AF0,AF1...
ITOC 0x5D S0(1)
ENDCASE
CASE 1 ; CF0,CF1...
ITOC 0x67 S0(1)
ENDCASE
CASE 2 ; AF0,AF1...
ITOC 0x71 S0(1)
ENDCASE
CASE 3 ; ^F0,^F1...
ITOC 0x67 S0(1)
ENDCASE
DEFAULT
SET FLAG(0) ON
RETURN
ENDCASE
ENDSWITCH
;
; Return with the goods
;
ITOC 0 S0
N0 = 2
RETURN
ENDIF
;
; Finally, Catch 'home', 'Pgup', 'PgDn', CURL', 'CURR', 'BELL' ,'^END'
;
SWITCH S0
CASE "^END" ; Ctl-Endkey
ITOC 0x75 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "HOME" ; Homekey
ITOC 0x47 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "PGUP" ; PgDnkey
ITOC 0x49 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "PGDN" ; PgUpkey
ITOC 0x51 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURL" ; Cursor left
ITOC 0x4B S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURR" ; Cursor right
ITOC 0x4D S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "BELL" ; Bell char
ITOC 7 S0
N0 = 1
RETURN
ENDCASE
CASE "NULL" ; Alt-NumKeyPad-0
ITOC 3 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Five character keycode here; First, catch AltF1-AltF9
;
TEKE500:
UPPER S0
IF FIND "ALT" S0(0:2) ; Case insensitive test
IF FIND "F1,F2,F3,F4,F5,F6,F7,F8,F9" S0(3:4) N0
IF NE (N0\3) 0 ; Modulo divide (remainder)
SET FLAG(0) ON ; .. catch e.g. "0,"
RETURN
ENDIF
ITOC 0 S0
ITOC (0x68+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Catch AltEq here (syntax doesn't allow Alt=)
;
IF FIND "EQ" S0(3:4)
ITOC 0 S0
ITOC (0x83+N0/3) S0(1)
N0 = 2
RETURN
ENDIF
;
; Other Alt's are errors
;
SET FLAG(0) ON
RETURN
ENDIF
;
; Catch "^Home", "^PgUp", "^PgDn" "^CurR", "^CurL", "CurUp" and "CurDn"
;
SWITCH S0
CASE "^HOME" ; Ctl-Homekey
ITOC 0x77 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PGUP" ; Ctl-PgDnkey
ITOC 0x84 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PGDN" ; Ctl-PgUpkey
ITOC 0x76 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^CURL" ; Cursor left
ITOC 0x73 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^CURR" ; Cursor right
ITOC 0x74 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURDN" ; Cursor down
ITOC 0x50 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "CURUP" ; Cursor up
ITOC 0x48 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; ***** Six character keycode here
; .. Catch 'AltF10', '^PrtSc'
;
TEKE600:
SWITCH S0
CASE "AltF10" ; Alt'd F10
ITOC 0x71 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "^PRTSC" ; Ctl-PrtSc
ITOC 0x72 S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
CASE "RevTab" ; Reverse tab
ITOC 0x0f S0(1)
ITOC 0 S0
N0 = 2
RETURN
ENDCASE
ENDSWITCH
;
; Others are errors
;
SET FLAG(0) ON ; Others are errors
RETURN
;
; Escape during "compile" window
; .. wait for a second esc
;
CompEsc:
IF FLAG(9)
SET FLAG(9) OFF
RETURN
ENDIF
MESS "^M^JEsc pressed^M^JPress any key again to continue^M^J"
SET FLAG(9) ON
Hang:
IF FLAG(9)
GOTO Hang
ENDIF
RETURN
;
; ----- Subroutine: Scan the input file for sections
; If sections found, ask for a selection
; Return: FLAG(0) <- TRUE if use ESC'd
; FLAG(0) <- FALSE -> File positioned for start
; N97 -> THe number of "NAME" commands to pass by
;
Select:
N97 = 1 ; Default one
N10 = 0 ; # of sections found
SET FLAG(1) OFF ; F -> Nothing compilable preceding 1st section
WOPEN 10,1 12,78 (default) ErrEsc
ATSAY 10,3 (default) " Select section "
ATSAY 11,3 (default) "Scanning for sections in the source file..."
ATSAY 12,30 (default) " ESC ends script "
;
; Save the current position, and read a line
;
SELE100:
FSAVEI ; Save current position
READ S0 80 N0 ; Len read into N0
IF EOF
FSAVEI POP ; Throw away the EOF position
GOTO End_Select
ENDIF
;
; Catch comments here (note save-stack pops)
;
IF NULL S0
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
LJ S0 ; Left justify
IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
;
; Extract the 1st field into S1
;
FIND S0 "=" N1 ; Find an '=' sign
S1 = S0(0:N1-1) ; Extract keycode
LJ S1
IF EQ N1 0 or NULL S1 ; = in col 0, or empty keycode
FSAVEI POP ; Throw away saved position
GOTO SELE100
ENDIF
;
; The section heading, (NAME = ...) terminates I/O
;
IF NOT FIND S1(0:3) "NAME" ; Case insensitive test
FSAVEI POP ; Throw away saved position
IF ZERO N10 ; Not in a section
SET FLAG(1) ON ; Mark a compilable line in unnamed section
ENDIF
GOTO SELE100 ; Skip if not section cmd
ENDIF
;
; Extract the operand field
;
S2 = S0(N1+1:79) ; Extract section name
LJ S2
;
; We have found a section command - if the first - open a window
;
IF NOT ZERO N10 ; Test if already found a section
GOTO SELE200 ; SKip if window is open
ENDIF

WCLOSE ; Close open window (scanning...)
WOPEN 0 ,10 19,70 (default)
ATSAY 0 ,12 (default) " Remap Select "
ATSAY 1 ,11 (default) " The source file contains multiple sections. These are: "
ATSAY 2 ,12 (default) " 1)"
ATSAY 3 ,12 (default) " 2)"
ATSAY 4 ,12 (default) " 3)"
ATSAY 5 ,12 (default) " 4)"
ATSAY 6 ,12 (default) " 5)"
ATSAY 7 ,12 (default) " 6)"
ATSAY 8 ,12 (default) " 7)"
ATSAY 9 ,12 (default) " 8)"
ATSAY 10,12 (default) " 9)"
ATSAY 11,12 (default) " 10)"
ATSAY 12,12 (default) " 11)"
ATSAY 13,12 (default) " 12)"
ATSAY 14,12 (default) " 13)"
ATSAY 15,12 (default) " 14)"
ATSAY 16,12 (default) " 15)"
ATSAY 17,10 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY 18,12 (default) "Select (1-10):"
ATSAY 19 32 (default) " Press ESC to exit "
;
; If there's an initial unnamed section, name it
;
IF NOT FLAG(1) ; If not compilable source before section...
GOTO SELE200 ; .. skip this
ENDIF
ATSAY N10+2,16 (default) "Unnamed 1st section"
INC N10
;
; Add the section name to the list
;
SELE200:
IF NULL S2
S2 = "Unnamed section #"&N10
ENDIF
ATSAY N10+2,16 (default) S2(0:48)
INC N10
IF LT N10 15 ; Allow up to 15 sections
GOTO SELE100
ENDIF
;
; End of file scan - ask for a selection if there're sections
;
End_Select:
IF ZERO N10 or EQ N10 1 ; No sections found or only one
REWIND ; Rewind input file
SET FLAG(0) OFF ; Return O-K
WCLOSE ; Close 'scanning...' window
RETURN
ENDIF
;
; Prompt for a selection
;
ENSE100:
MESS "^G"
ATGET 18,27 (default) 2 S0
IF NULL S0
SET FLAG(0) ON
ENDIF
;
; Interpret the response
;
ATOI S0 N0
IF LT N0 1 or GT N0 N10
SOUND 100,100
GOTO ENSE100
ENDIF
;
; Use the selected # to pop the save stack
;
WCLOSE ; Close 'select window'
WHILE LE N0 N10
FRESTOREI ; Move back through saved positions
DEC N10 ; .. and decremnet index
ENDWHILE
IF EQ N0 1 and FLAG(1) ; There was an unnamed section and we want it
REWIND ; .. move to beginning of file
N97 = 0 ; Pass by no NAME commands
ENDIF
;
; And return positioned OK
;
SET FLAG(0) OFF
FSAVEI CLEAR
RETURN
;
; ----- Subroutine Syntax check a source file
;
Syntax:
SET FLAG(8) ON
GOTO Start
;
; ----- Subroutine Compile: compile a source file into COM-AND.RMP
;
Compile:
SET FLAG(8) OFF ; Turnoff syntax check
SET FLAG(9) OFF ; ESC during compile
;
; ----- Start compilation
;
Start:
WOPEN 10,1, 13,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) "Enter the source file name (with or without path/drive)."
ATSAY 12, 3 (contrast) "-> "
ATSAY 13,29 (contrast) " Press ESC to cancel "
;
; Ask for a file name
;
ATGET 12, 7 (contrast) 60 S0 ; Get source file name
WCLOSE ; Restore screen under
IF NULL S0
RETURN ; End here
ENDIF
;
; Attempt to open the given file
;
IF NOT ISFILE S0
S1 = S0
S0 = "File does not exist (or cannot be opened)"
GOSUB Error
GOTO Compile ; Try again
ENDIF
FOPENI S0 TEXT ; Try to open as text
IF FAILURE
S1 = S0
S0 = "Source file cannot be opened"
GOSUB Error
GOTO Compile ; Try again
ENDIF
S18 = S0 ; Save open file name
;
; Scan the file for 'section' names... if found, ask for a selection
; On return, if FLAG(0) reset (off), file is positioned for I/O
; Else, user ESC'd
;
GOSUB Select
IF FLAG(0)
RETURN
ENDIF
;
; Open (and purge) the output file
;
IF NOT FLAG(8) ; If not syntax check
FOPENO S19 BINARY
IF FAILURE
S1 = S0
S0 = "Target file cannot be opened"
GOSUB Error
RETURN ; Error fatal to this subroutine
ENDIF
ENDIF
;
; Set a display window for compilation
;
WOPEN 5,15 20,65 (contrast) CompESC
ATSAY 5,17 (contrast) " Remap compilation "
ATSAY 20,30 (contrast) " Press ESC to pause "
DWINDOW 6,17 19,63 ; Actual scrolling region
CLEAR ; Clear the whole region
;
; Other initialization
;
N99 = 0 ; # errors
N98 = 0 ; Output file size
SET FLAG(9) OFF ; Escape during compile
;
; ***** Read a line and display it
; N99 -----> Counts the # errors
;
Loop:
READ S0 80 N0 ; Len read into N0
IF EOF
GOTO End_Compile
ENDIF
S1 = S0 ; Replicate
PRESERVE S1 ; Keep bangs and carets
MESS S1 ; Display the line (just as read)
;
; Catch comments here
;
IF NULL S0
GOTO LOOP
ENDIF
LJ S0 ; Left justify
IF STRCMP S0(0:0) ";" or STRCMP S0(0:0) "*"
GOTO LOOP
ENDIF
;
; Extract the keycode into S1
;
FIND S0 "=" N1 ; Find an '=' sign
S1 = S0(0:N1-1) ; Extract keycode
LJ S1
IF EQ N1 0 or NULL S1 ; = in col 0, or empty keycode
MESS "*** Missing keycode ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; The 2nd time we hit a section heading, (NAME = ...) make an EOF
;
IF FIND S1(0:3) "NAME" ; Case insensitive test
IF ZERO N97 ; # NAME = lines found so far
GOTO End_Compile ; pseudo EOF
ENDIF
DEC N97 ; Pass this one by, byt count it
GOTO Loop ; Throw away 1st
ENDIF
;
; Extract the operand into S2
;
S2 = S0(N1+1:79) ; Extract operand
LJ S2
IF NULL S2 ; Empty assignment
MESS "*** Missing assignment ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Look at the keycode in S1
;
S0 = S1 ; Parameter passed
GOSUB Keycode
IF FLAG(0)
MESS "*** Invalid keycode ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
S3 = S0 ; Keep converted value
N3 = N0 ; Keep length of conversion so far
;
; Initialize the output operand
;
S4 = "" ; Nake it null
N4 = 0 ; Length so far
;
; ***** Now - begin handling the operand
;
LOOP100:
LJ S2 ; Throw away leading blanks
IF NULL S2
GOTO LOOP300 ; When its null, end of operand
ENDIF

IF STRCMP "," S2(0:0) ; Look for a leading comma
S2 = S2(1:79) ; Throw away comma
GOTO LOOP100 ; And continue
ENDIF
;
; Catch quotes here
;
IF STRCMP "`"" S2(0:0) ; Look for a leading double quote
GOTO LOOP200 ; Handle it specially in operand
ENDIF
;
; ";" terminator allows comments in-line
;
IF STRCMP ";" S2(0:0) ; Look for a leading semi-colon
GOTO LOOP300 ; Treat as-if end of line
ENDIF
;
; Parse out something
;
FIND S2 " " N5 ; Find position of next blank
FIND S2 "," N6 ; Find position of next comma
IF EQ N6 N5 ; Both -1 if neither found
S0 = S2 ; Neither a ' ' or ',' - use whole string
S2 = "" ; Null remaining operand
ELSE
IF EQ N6 -1 ; use N5
ELSE
IF EQ N5 -1 or LT N6 N5
N5 = N6 ; Set N5 to smaller legit value
ENDIF
ENDIF
S0 = S2(0:N5-1) ; Extract what we found
S2 = S2(N5+1:79) ; And remove it from the string
ENDIF
;
; One keycode is an operand only... handle it
;
IF FIND S0(0:5) "Functn"; Special function
ITOC 0 S4(N4)
ITOC 0x80 S4(N4+1) ; Made-up extended code for COM-AND
N4 = N4+2
GOTO LOOP100
ENDIF
;
; Test for a token
;
GOSUB Keycode
IF FLAG(0)
MESS "*** Invalid code in operand ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Test for a circular definition
;
IF N0 eq 2 AND STRCMP S3(1) S0(1)
MESS "*** Remap would be circular ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; Add the non-ascii key to the operand
;
CONCAT S4(N4) S0(0:N0-1); Concatenate converted string into S4
N4 = N4+N0 ; Keep length of conversion so far
GOTO LOOP100
;
; ***** Handle a quoted string in the operand here
;
LOOP200:
S2 = S2(1:79) ; Eliminate leading char
IF NULL S2 ; Missing terminating ""
MESS "*** Invalid quoted string ***"
INC N99 ; Count the error
GOTO Loop
ENDIF

IF STRCMP S2(0:0) "`"" ; If we find a second ""
S2 = S2(1:79) ; .. Eliminate it
GOTO LOOP100 ; .. and continue
ENDIF

IF STRCMP S2(0:0) "^^"
S2 = S2(1:79) ; Eliminate leading caret
IF STRCMP S2(0:0) "^^"
CONCAT S4(N4) "^^"; ^^ -> ^ in output
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ELSE
S5 = S2(0:0) ; Take just 1st char
UPPER S5 ; Upper case it alone
CTOI S5 N5
ITOC (N5-64) S4(N4)
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ENDIF
ENDIF

IF STRCMP S2(0:0) "!!" ; DOn't want STRCMP to collapse it
IF STRCMP S2(1:1) "!!"
S2 = S2(1:79) ; Eliminate leading bang
CONCAT S4(N4) "!!"; !! -> ! in output
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ELSE
ITOC 13 S4(N4) ; Else "!" -> C/r
N4 = N4+1 ; Keep length of conversion so far
GOTO LOOP200
ENDIF
ENDIF

IF STRCMP S2(0:0) "``"
S2 = S2(1:79) ; Eliminate leading grave
IF NULL S2 ; Ignore final grave...
GOTO LOOP200
ENDIF
ENDIF

CTOI S2 N5 ; Take char as-is
ITOC N5 S4(N4)
N4 = N4+1
GOTO LOOP200
;
; ***** Look for an empty operand
; N3 -> The length of the keycode (1,2) in S3
; N4 -> The length of the operand in S4
;
LOOP300:
IF LE N4 0
MESS "*** Empty operand out ***"
INC N99 ; Count the error
GOTO Loop
ENDIF
;
; ***** Write the remap to disk
;
N98 = N98+N3+1+N4 ; Track output file size
IF LE N98 768 ; Do not write too much
IF NOT FLAG(8) ; IF table size OK, and not syntax
ITOC N4 S5 ; Move len to a char string
WRITE S3 N3 ; Write keycode
WRITE S5 1 ; Write 1 byte length
WRITE S4 N4 ; And write the operand
ENDIF
ELSE
MESS "*** Output max size exceeded ***"
INC N99 ; Count the error
ENDIF
GOTO Loop
;
; End of compilation - clear the window limits and close output
;
End_Compile:
DWINDOW CLEAR ; CLEAR THE display window
FCLOSEO ; CLose the output (OK if not open)
FCLOSEI ; CLose the input
;
; Open a descriptive window
;
WOPEN 10,1, 14,77 (contrast) ErrEsc
ATSAY 11, 3 (contrast) "The output file is "*N98*" bytes"
ATSAY 12, 3 (contrast) "There were "*N99*" errors"
IF GT N98 768
ATSAY 13,3 (contrast) "Warning: ^GThe output file was truncated to the maximum allowed"
ENDIF
ATSAY 14,26 (contrast) " Press any key to continue "
KEYGET S0 ; Wait for any key
WCLOSE ; Restore screen under
;
; Drop the Final window and we're done
;
WCLOSE
RETURN
;
; ----- Open a window and display a menu
;
Window:
WOPEN 0 ,10 19,70 (default)
ATSAY 0 ,12 (default) " COM-AND Remapping "
ATSAY 1 ,11 (default) " COM-AND version 2.4 allows the keyboard to be remapped. "
ATSAY 2 ,11 (default) " Any keystroke COM-AND can detect (it cannot detect all) "
ATSAY 3 ,11 (default) " may be assigned to another key or keys. Macros may be "
ATSAY 4 ,11 (default) " created using this facility, as well as simple remaps. "

ATSAY 6 ,11 (default) " Source text files are created indpendantly and compiled "
ATSAY 7 ,11 (default) " with this script into the COM-AND.RMP file for use. "

ATSAY 8 ,10 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY 9 12 (default) "1) Compile source into a new remap"
ATSAY 10 12 (default) "2) Syntax check a source file"
ATSAY 11 12 (default) "3) Search for files (Alt-F)"
ATSAY 12 12 (default) "4) Edit a file (you supply the editor)"
ATSAY 13 12 (default) "5) Turn remap on (using current map)"
ATSAY 14 12 (default) "6) Turn remap off"
ATSAY 15,10 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY 16,12 (default) "Output: "*S19(0:48)
ATSAY 17,10 (default) "ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´"
ATSAY 18,12 (default) "Select:"
ATSAY 19 32 (default) " Press ESC to exit "
RETURN


  3 Responses to “Category : Communication (modem) tools and utilities
Archive   : CA29-3.ZIP
Filename : REMAP.CMD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/