silvert@cs.dal.ca (Bill Silvert) (01/02/90)
In article <#!G4|_@rpi.edu> jefu@pawl.rpi.edu (Jeffrey Putnam) writes: > >Now I need a simple answer (I hope the answer will not be as simple as "no"), >Is it possible to have MS Fortran detect a single (non <cr>) keypress, and >return a single character? Ideally I would like a couple functions, say >kbdhit() and getsinglechar(). I cannot find a way to do this in MS or Lahey Fortran, but I have assembler code that does the job. Write me at ...!dalcs!biomel!bill and I will send it, or post it if there is enough demand. It will come as a uuencoded ARC or ZOO file with source and the two OBJ files for MS and Lahey (they use different calls). One problem I would like help with is that they do not go through the keyboard translator, so if you use a German keyboard mapping the Y and Z are interchanged, and so on. -- Bill Silvert, Habitat Ecology Division. Bedford Institute of Oceanography, Dartmouth, NS, Canada B2Y 4A2 UUCP: ...!{uunet,watmath}!dalcs!biomel!bill Internet: bill%biomel@cs.dal.CA BITNET: bill%biomel%dalcs@dalac
HONGHE@pucc.Princeton.EDU (Hong He) (01/05/90)
In article <1990Jan1.194328.24966@cs.dal.ca>, silvert@cs.dal.ca (Bill Silvert) writes: >In article <#!G4|_@rpi.edu> jefu@pawl.rpi.edu (Jeffrey Putnam) writes: >> >>Now I need a simple answer (I hope the answer will not be as simple as "no"), >>Is it possible to have MS Fortran detect a single (non <cr>) keypress, and >>return a single character? Ideally I would like a couple functions, say >>kbdhit() and getsinglechar(). > >I cannot find a way to do this in MS or Lahey Fortran, but I have >assembler code that does the job. The Spindrift Library, available in MS and Lahey versions, has the functions you need, as well as other keyboard and screen manipulation functions. The address is : Spindrift Laboratories 116 S. Harvard Ave. Arlington Heights, IL 60005 (312) 255-6909 I've used the library mostly in its Lahey version, and mostly for its keyboard functions. Hope this helps. Barbara Vaughan BVAUGHAN@PUCC.princeton.edu
br0w+@andrew.cmu.edu (Bruno W. Repetto) (01/05/90)
Bill Silvert posts: >From: silvert@cs.dal.ca (Bill Silvert) >Subject: Re: Getting a single keystroke >Date: 1 Jan 90 19:43:28 GMT > >In article <#!G4|_@rpi.edu> jefu@pawl.rpi.edu (Jeffrey Putnam) writes: >> >>Now I need a simple answer (I hope the answer will not be as simple as "no"), >>Is it possible to have MS Fortran detect a single (non <cr>) keypress, and >>return a single character? Ideally I would like a couple functions, say >>kbdhit() and getsinglechar(). > >I cannot find a way to do this in MS or Lahey Fortran, but I have >assembler code that does the job. Write me at ...!dalcs!biomel!bill and >I will send it, or post it if there is enough demand. It will come as >a uuencoded ARC or ZOO file with source and the two OBJ files for MS and >Lahey (they use different calls). > >One problem I would like help with is that they do not go through the >keyboard translator, so if you use a German keyboard mapping the Y and Z >are interchanged, and so on. > >-- >Bill Silvert, Habitat Ecology Division. >Bedford Institute of Oceanography, Dartmouth, NS, Canada B2Y 4A2 >UUCP: ...!{uunet,watmath}!dalcs!biomel!bill >Internet: bill%biomel@cs.dal.CA BITNET: bill%biomel%dalcs@dalac I tried your address, but my message couldn't get through, so I'll try it here. I am interested in this code. Could you send it to me? (If my address works from your end) Or please post it, if you have enough demand for it. aTdHvAaNnKcSe! Bruno. br0w+@andrew.cmu.edu
silvert@cs.dal.ca (Bill Silvert) (01/06/90)
In article <IZcz4My00Uh-A2FUt0@andrew.cmu.edu> br0w+@andrew.cmu.edu (Bruno W. Repetto) writes: >Bill Silvert posts: >>In article <#!G4|_@rpi.edu> jefu@pawl.rpi.edu (Jeffrey Putnam) writes: >> >>>Now I need a simple answer (I hope the answer will not be as simple as "no"), >>>Is it possible to have MS Fortran detect a single (non <cr>) keypress, and >>>return a single character? Ideally I would like a couple functions, say >>>kbdhit() and getsinglechar(). >> >>I cannot find a way to do this in MS or Lahey Fortran, but I have >>assembler code that does the job. Write me at ...!dalcs!biomel!bill and >>I will send it, or post it if there is enough demand. It will come as >>a uuencoded ARC or ZOO file with source and the two OBJ files for MS and >>Lahey (they use different calls). >> >>One problem I would like help with is that they do not go through the >>keyboard translator, so if you use a German keyboard mapping the Y and Z >>are interchanged, and so on. I received several requests, so here it is. This is actually a small assembly-language file containing GETKEY as well as a test for whether ANSI.SYS is installed and a directory lister. They come together because they are a single adjunct to a Fortran program of mine (by the way, I have similar packages to do the same thing for Unix systems and for the Atari ST and Macintosh AbSoft compilers if anyone is interested). The source code assembles with TASM, although I have used MASM. The uuencoded OBJ files are for Microsoft and Lahey Fortran. #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create: #### xcode.asm #### lxcode.uue (Lahey) #### mxcode.uue (Microsoft) # This archive created: Fri Jan 5 13:15:31 1990 # By: Bill Silvert (Habitat Ecology Div., Bedford Inst. of Oceanography) export PATH; PATH=/bin:/usr/bin:$PATH case $# in 0) wish= ;; *) wish=$1 ;; esac if test -f 'xcode.asm' then echo shar: "existing file 'xcode.asm' is unchanged" else echo shar: "extracting file 'xcode.asm'" cat << \SHAR_EOF > 'xcode.asm' ; Assembly routines for MS-DOS version of BSIM. Functions are: ; GETKEY: get a single character with echo and pass it on to Fortran. ; The Fortran call is "CHARACTER BYTE/CALL GETKEY(BYTE)". ; ANSI: check for presence of ANSI.SYS for highlighting strings. ; FILES: display directory of files by path and extension. ; The Fortran call is " CHARACTER*? PATH, SUFFIX ; CALL FILES(PATH, LEN_PATH, SUFFIX, LEN_SUFFIX)" ; @(#)xcode.s Ver. 89.1, 89/10/25 15:07:37 ; assemble with: TASM /dLAHEY=0 XCODE,MXCODE for Microsoft ; or TASM /dLAHEY=1 XCODE,LXCODE for Lahey Fortran. Arg1 EQU 18 ; offsets of the arguments (MS) Arg2 EQU 14 Arg3 EQU 10 Arg4 EQU 6 .MODEL LARGE DGROUP GROUP DATA DATA segment byte public 'DATA' ans DB 27,"[6n$" ; ANSI string to get current position overwrt DB 8,8,8,8," $" ; Overwrite ANSI characters delete DB 8,8,8,"$" ; Delete ANSI characters Space DB ' $' ; strings used by Files CrLf DB 13, 10, ' $' Buffer DB 128 DUP (?) ; store the file spec here Intro DB 13,10,'Here is a list of files in $' Current DB 'this $' Directory DB 'directory$' OfType DB ' of type .$' NoFiles DB '<< No Files Found >>',13,10,'$' DATA ENDS assume DS:DGROUP ; based on Lahey example.asm .CODE PUBLIC Getkey, Ansi, Files Getkey PROC FAR push bp mov bp,sp mov ah,01h ; function 1 int 21h ; the byte returned is in AL cmp al,20h ; is it a control character? jge copy ; if not control character, it is OK mov al,20h ; replace control character by space copy: IF LAHEY lds bx,dword ptr [bp+6] ; point to character structure lds si,dword ptr [bx] ; point to character mov [si],al ; copy contents of AL to argument ELSE les bx,dword ptr [bp+6] ; point to character mov es:[bx],al ; copy contents of AL to argument ENDIF pop bp ret 4 ; 4-byte address on stack Getkey ENDP ; Procedure Ansi, from Microsoft code ; Purpose Check for presence of ANSI driver ; Input None ; Output 1 for yes or 0 for no -- returns Fortran LOGICAL value Ansi PROC FAR push bp mov bp,sp mov ax,dgroup ; DATA segment mov ds,ax mov dx, OFFSET ans ; Print ANSI string to get mov ah,9 ; cursor position int 21h mov ah,6 ; Check for key mov dl,0FFh ; in buffer int 21h jnz found ; Done if ANSI mov dx, OFFSET overwrt ; Overwrite ANSI string mov ah,9 int 21h sub ax,ax ; 0 if not ANSI jmp SHORT Checked found: mov ax,0C06h ; Clear returned ANSI keys mov dl,0FFh ; out of buffer int 21h mov dx, OFFSET delete ; Delete ANSI string mov ah,9 int 21h mov ax,1 ; Set 1 for true Checked: IF LAHEY les bx,dword ptr [bp+6] ; point to function's return value fwait mov es:[bx],al ; copy contents of AL to function ENDIF pop bp ret Ansi ENDP Files PROC FAR push bp mov bp,sp IF LAHEY ; nothing implemented for Lahey compiler yet ELSE mov ax,@data ; DS contains the Data Segment mov ds,ax mov di, OFFSET Buffer ; index to the Buffer mov dx, OFFSET Intro ; start printing initial line mov ah,09h int 21h ; IF LAHEY ;; lds bx,dword ptr [bp+6] ; point to character structure ;; lds si,dword ptr [bx] ; point to character ;; mov [si],al ; copy contents of AL to argument ; ELSE les bx,dword ptr [bp+Arg2] ; point to length of path mov cx,es:[bx] ; copy path length to CX mov ax,cx or ax,cx ; make sure that the length is not 0 jz NoPath mov dx, OFFSET Directory mov ah,09h int 21h mov ah,02h mov dl,32 ; append a blank to display line int 21h push ds lds bx,dword ptr [bp+Arg1] ; point to path mov si,bx mov ah,02h Next1: mov dl,[si] ; display path int 21h movsb ; copy path to Buffer loop Next1 pop ds jmp End1 NoPath: mov dx, OFFSET Current mov ah,09h int 21h mov dx, OFFSET Directory mov ah,09h int 21h End1: mov al,'*' mov [di],al inc di mov al,'.' mov [di],al inc di les bx,dword ptr [bp+Arg4] ; point to length of suffix mov cx,es:[bx] ; copy suffix length to CX mov ax,cx or ax,cx jz End2 mov dx, OFFSET OfType mov ah,09h int 21h push ds lds bx,dword ptr [bp+Arg3] mov si,bx mov ah,02h Next2: mov dl,[si] ; display suffix int 21h movsb ; copy suffix to Buffer loop Next2 pop ds End2: ; ENDIF mov dl,':' ; add a colon mov ah,02h int 21h mov dx, OFFSET CrLf ; start with CrLf and indent mov ah,09h int 21h mov dx, OFFSET Buffer mov al,0 ; terminate string mov [di],al mov cx,0 ; set attribute for search mov bx,0 ; counter for file names mov ah,4eh ; FindFirst jmp Show ; jump into loop Next: mov ah,4fh ; FindNext Show: int 21h jc NoMore cld ; clear direction flag push ds ; save Data Segment push bx mov ah,2Fh ; get DTA address int 21h mov si,bx add si,30 push es ; copy ES to DS pop ds pop bx mov cx,14 ; space for filename Char: lodsb ; display the filename or al,al je Finish mov ah,2 ; display one character on screen mov dl,al int 21h dec cx jmp Char Finish: pop ds ; get back the Data Segment mov ah,2 ; display one character on screen mov dl,32 ; blank Fill: int 21h loop Fill inc bx mov ax,bx and ax,3 ; work out bx MOD 4 jz Line mov dx, OFFSET Space jmp OK Line: mov dx, OFFSET CrLf OK: mov ah,9 ; print a space or a newline int 21h jmp Next NoMore: or bx,bx ; file count jnz Done mov dx, OFFSET NoFiles mov ah,9 int 21h Done: ENDIF pop bp ret 16 ; 4 4-byte addresses on stack Files ENDP END SHAR_EOF else echo shar: did not overwrite existing file xcode.asm fi if test -f 'lxcode.uue' then echo shar: "existing file 'lxcode.uue' is unchanged" else echo shar: "extracting file 'lxcode.uue'" cat << \SHAR_EOF > 'lxcode.uue' table !"#$%&'()*+,-./0123456789:;<=>? @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ begin 644 lxcode.obj M@ L "5A#3T1%+D%33>J('P %1U<F)O($%S<V5M8FQE<B @5F5R<VEO;B Qz M+C"ZB!$ 0.D7<(<2"5A#3T1%+D%339.( P! Z4R6 @ :)81 I80T]$15]4y M15A4!$-/1$49F < 2%0 @,!OY8, 5?1$%4001$051!PI@' $@ 0% 0^6x M"P $1$%4001$051!(Y@' "@2 8' 1F6" &1$=23U50BYH& C_ _\"59 -w M !!D=%5$M%60 ).0"P 01!3E-)& '8@$ $"B 9&@6 ! !5B^RTv M <TA/"!] K @Q5X&Q3>(!%W*! !5B^RX ".V+H +0)S2&T!K+_S2%U"[H%u M +0)S2$KP.L1N 8,LO_-(;H. +0)S2&X 0#$7@:;)H@'7<MCG!0 R!Q5 <0At L% $#Q# 4 0/$0A0! ^^@%@ # ;6S9N) @(" @@(" @) @(""0)B@( '0As r end SHAR_EOF else echo shar: did not overwrite existing file lxcode.uue fi if test -f 'mxcode.uue' then echo shar: "existing file 'mxcode.uue' is unchanged" else echo shar: "extracting file 'mxcode.uue'" cat << \SHAR_EOF > 'mxcode.uue' table !"#$%&'()*+,-./0123456789:;<=>? @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_ begin 644 mxcode.obj M@ L "5A#3T1%+D%33>J(( %1U<F)O($%S<V5M8FQE<B @5F5R<VEO;B Qz M+C QB(@1 $#ISWI9$PE80T]$12Y!4TW^B , 0.E,E@( &B6$0 *6$-/1$5?y M5$585 1#3T1%&9@' $@Y 0(# =F6# %7T1!5$$$1$%40<*8!P!( $!0$/x ME@L !$1!5$$$1$%402.8!P H[P &!P$\E@@ !D1'4D]54(N:!@ (_P/_ E60w M#0 09'151+15D "3D L $$04Y321< !Z0# 05&24Q%4TP )^(v M! ! H@&1H#T! 0 58OLM '-(3P@?0*P(,1>!B:(!UW*! !5B^RX ".V+H u M +0)S2&T!K+_S2%U"[H% +0)S2$KP.L1N 8,LO_-(;H. +0)S2&X 0!=RU6+t M[+@ ([8OQ\ NI\ M G-(<1>#B:+#XO!"\%T(+K# +0)S2&T K(@S2$>Q5X2s MB_.T HH4S2&DXOD?ZP^0NKT M G-(;K# +0)S2&P*H@%1[ NB 5'Q%X&)HL/r MB\$+P707NLT M G-(1[%7@J+\[0"BA3-(:3B^1^R.K0"S2&Z%P"T"<TANA\ q ML "(!;D +L +1.ZP.0M$_-(7) _!Y3M"_-(8OS@\8>!A];N0X K K = FTp M HK0S2%)Z_(?M *R(,TAXOQ#B\,E P!T!KH2 .L$D+H7 +0)S2'KN@O;=0>Zo MV "T"<TA7<H0 %:<3P#(&U4!Q" 4 0/$+Q0! \1!% $#R%!5 <15% $#Q%@4n M 0/$:Q0! \2+% $#Q)(4 0/$KQ0! \3,% $#Q-,4 0/%'!0! \4B% $#Q2\4m M 0/CH", P &ULV;B0(" @((" @("0(" @D(" @("0-"B @(" @)'V@5 #l MGP -"DAE<F4@:7,@82!L:7-T(&]F(&9I;&5S(&EN("1T:&ES("1D:7)E8W1Ok K<GDD(&]F('1Y<&4@+B0\/"!.;R!&:6QE<R!&;W5N9" ^/@T*)'J* @ ='1Oj i end SHAR_EOF else echo shar: did not overwrite existing file mxcode.uue fi exit 0 # End of shell archive -- Bill Silvert, Habitat Ecology Division. Bedford Institute of Oceanography, Dartmouth, NS, Canada B2Y 4A2 UUCP: ...!{uunet,watmath}!dalcs!biomel!bill Internet: bill%biomel@cs.dal.CA BITNET: bill%biomel%dalcs@dalac