Fórum Root.cz
Hlavní témata => Vývoj => Téma založeno: EC1045.01 21. 07. 2024, 08:04:06
-
Dopracoval jsem se do stavu, že by bylo záhodno převést některé programy, co používám na evidenci součástek z MS FORTRAN 77 (16 bit) do něčeho modernějšího. Konkrétně jsem zakotvil u Gfortranu (32bit) (https://gcc.gnu.org/wiki/GFortran). Jeden program se poved převést ale u druhého mám problém, že používá doplněnou funkci na test klávesnice a zatím se mi nepovedlo najít adekvátní náhradu.
Konkrétně jde o funkci IFBRK() která provede test klávesnice, když není stisknutá žádná klávesa tak funkce vrátí nulu, jinak vrátí číselný ASCII kód stisknuté klávesy viz úryvek kódu. V dokumentaci k Gfortranu (https://gcc.gnu.org/onlinedocs/gcc-14.1.0/gfortran.pdf) jsem narazil na podprogram/funkci SIGNAL (strana 269) co by se asi dala použít. V dokumentaci je ukázkový program a udělá to, že čte klávesnici do stisku CTRL C. Po stisku CTRL C se program ukončí a zadané znaky se objeví v příkazovém řádku.
S angličtinou nejsem kamarád a vůbec nemám ponětí jek se dopracovat ke kýženému výsledku. Najde se nějaká dobrá duše co mi pomůže
C *************************** Volba rezimu *****************************
i=0
do while (i.eq.0)
i=ifbrk()
end do
write(*,'(1x,a1,a)')27,'[2J'
write(*,'(1x,a)')ver
write(*,'(1x,2(a1,a),a,a1,a)')
# 27,'[3;36H',27,'[1;37m','PROGRAM E',27,'[0m'
if (i.eq.86.or.i.eq.118) then
co=' Vkladat'
else if (i.eq.80.or.i.eq.112) then
co='Prohlizet'
else if (i.eq.79.or.i.eq.111) then
co=' Opravit'
else if (i.eq.84.or.i.eq.116) then
co=' Tisk'
else if (i.eq.72.or.i.eq.104) then
co=' Hledat'
else if (i.eq.83.or.i.eq.115) then
co=' Spoj'
else if (i.eq.75.or.i.eq.107) then
CLOSE(unit=2)
CLOSE(unit=1)
write(*,'(1x,a1,a)')27,'[0m'
stop'KONEC programu E'
else if (i.eq.90.or.i.eq.122) then
call znaceni
goto 5
else
goto 5
end if
-
klidne bych tu obludnost zahodil a jen nacetl parametr najednou pomoci read.
-
U toho ukázkového kódu to jde (zvolen pro přehlednost), ale problém je v tom, že o kus dále je výběr řešen pomocí „roletky“, aneb je zobrazeno pouze 11 řádků z X (pět nad vybranou položkou, vybraná položka, pět pod vybranou položkou kdy mezi bloky je volný řádek). Pohyb v „roletce“ je řešen pomocí „kurzorových“ šipek (nahoru a dolů). Takže tam to předělat na klasický READ znamená překopat celou filozofii výběru a tím přijít o eleganci výběru, stejná konstrukce výběru (roletka) je pak ještě u oprav dat. Posun v roletce je pouze o tom že se stiskne jen šipka.
V odkazu na dokumentaci je ukázkový program co dokáže odchytit klávesnici … otázka je jak to udělat aby odchycený znak skončil v proměnné a dal se zpracovat v programu.
-
A co ti brání do tý ifbrk nacpat ten read a fungovat jak předtím?
-
Při vstupu z klávesnice při READ je potřeba vstup potvrdit ENTREM, a daný znak se vypíše na obrazovku což celou věc dělá nepoužitelné.
-
Napiš si tu fci v Cčku, to jde z Fortranu volat.
-
Kdybych si to uměl napsat v Céčku tak se na to neptám, druhá věc by pak byla jak to spáchat aby se ta Céčková funkce automaticky vložila/vkládal při překladu … z Céčkem nejsem kamarád …
-
Ta funkce signal nastavuje obsluhu signálu a nemá nic společného se čtením standardního vstupu. Nevidím důvod používat Fortran, když ho znáš tak málo, že na tom příkladu nevidíš, že tam není žádné I/O.
Implementace náhrady ifbrk (nevím, jak přesně má fungovat) v Céčku může vypadat třeba takhle:
== keys.c
#include <unistd.h>
#include <termios.h>
static char readchar(int block)
{
char c;
struct termios oldtios, newtios;
if (tcgetattr(STDIN_FILENO, &oldtios) < 0) return 0;
newtios = oldtios;
cfmakeraw(&newtios);
newtios.c_cc[VTIME] = 0;
newtios.c_cc[VMIN] = block ? 1 : 0;
if (tcsetattr(STDIN_FILENO, TCSANOW, &newtios) < 0) return 0;
if (read(STDIN_FILENO, &c, 1) != 1) c = 0;
if (tcsetattr(STDIN_FILENO, TCSANOW, &oldtios) < 0) return 0;
return c;
}
int getkey()
{
return readchar(0);
}
int waitkey()
{
return readchar(1);
}== main.f
program main
integer :: i
interface
integer(c_int) function ifbrk() bind(C, name="getkey")
use, intrinsic :: iso_c_binding, only : c_int
end function
end interface
i=0
do while (i.eq.0)
i=ifbrk()
end do
if (i.eq.86.or.i.eq.118) then
write(*,*)'Vkladat'
else if (i.eq.80.or.i.eq.112) then
write(*,*)'Prohlizet'
end if
end
Pokud máš i GCC, tak ten céčkový soubor jen přihodíš do kompilace
gfortran main.f keys.c -o test
Je to samozřejmě pro Linux, pro jiný systém to třeba přepíše někdo jiný. A nemá smysl, aby to čekání na klávesu valilo v cyklu a místo "getkey" v tomhle případě můžeš použít čekající "waitkey".
-
MS FORTRAN 77 je můj první programovací jazyk a více méně se v něm orientuji a mám v něm napsáno spoustu programů jenže je to 16bit a na 64bit systémech jaksi 16bit nejede a vyrtualizace není úplně to pravé ořechové (překladač MS FORTRAN 77 jede jen do WXP). Gfortran podporuje skoro celou syntaxi FORTRAN 77 takž úprava do Gfortranu byla poměrně snadná. Jak se zabrousí do volání systémových služeb tak tam plavu hlavně v tom moderním Gfortranu.
Pokud jde o programovací jazyky tak nějak umím FORTRAN 77, BASIC, ASM 8080A a HTML. Takže přepis do něčeho jiného je trochu problém teda pud jde o PC.
Doinstaloval jsem GCC
Díky ale na widlích to samozřejmě nefungovalo (nešlo přeložit) aneb to nenašlo knihovnu „TERMIOS.H“
Konkrétně ta funkce IFBRK je psaná v asembleru a volá systémovou službu DOSu a je přidaná do knihovny. To že to běží v cyklu je proto, že se čeká na stisk klávesy, aneb po zavolání funkce se provede jeden test klávesnice (úplně stejně to funguje i pod CP/M ze kterého MS DOS vychází). Pokud není stisknutá klávesa tak se vrátí nula jinak ASCII kód klávesy. … on ten jeden test klávesnice má i výhodu v tom že se dá během chodu programu do něj „zasahovat“ např. pozastavit, …
Našel by se někdo kdo by tu náhradu za IFBRK() napsal pro widle.
Analogie IFBRK() ale v ASM 8080A po CP/M
CTIZ: MVI C,6
MVI E,0FFH ;CHCEME ZNAK
CALL BDOS
ANA A
JZ CTIZ ;ZADNY NENI
RET
-
Myslim, ze namiesto povodnej funkcie ifbrk() bude stacit aj C-funkcia getch().
Je s nou sice problem, lebo je v conio.h a nie je standardne v C k dispozicii - t.j. nie je v gcc na Linuxe, ale zhodou okolnosti vo Windowse v MinGW gcc je a aj funguje.
Takze takto mi to funguje vo windows:
getch_example_windows.f95
program test
use iso_c_binding
implicit none
interface
function c_getch() bind (c, name='getch') result (c)
import :: c_int
integer(kind=c_int) :: c
end function c_getch
end interface
integer :: i
i = 0
do while (i.eq.0)
i = c_getch()
end do
if (i.eq.86 .or. i.eq.118) then
write(*,*)'Vkladat'
else if (i.eq.80 .or. i.eq.112) then
write(*,*)'Prohlizet'
end if
end program test
Kompilacia
gfortran getch_example_windows.f95 -o getch_example_windows
-
Díky moc za pomoc, funguje i pod W7 32bit.