Stars of Shareware: DFÜ und Kommunikation

home *** CD-ROM | disk | FTP | other *** search

/ Stars of Shareware: DFÜ und Kommunikation / SOS-DFUE.ISO / programm / dos / terminal / ca_29 / remap.cmd < prev next >

Wrap

Text File | 1992-03-23 | 27.8 KB | 1,165 lines

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