/* dzienniczek */ CALL OPEN okno,'CON:100/50/380/120/Dzienniczek Ucznia/cds' nowasrednia=0 NUMERIC DIGITS 10 CALL Pisz ' DZIENNICZEK UCZNIA V1.0 ' IF ~EXISTS('S:dziennik.config') THEN DO CALL OPEN config,'S:dziennik.config',WRITE CALL Config END ELSE CALL OPEN config,'S:dziennik.config',READ CALL SprawdzConfig CALL CLOSE config IF plik=='?' THEN DO CALL Pisz 'Podaj nazwe pliku z ocenami:' plik=Czytaj() END IF EXISTS(plik) THEN DO CALL OPEN in,plik,ADD SEEK(in,0,'B') naglowek=READLN(in) IF WORD(naglowek,1)~=='DZIENNIK' THEN DO CALL Pisz 'Plik' plik 'nie jest plikiem z danymi !' EXIT 10 END ELSE aktsrednia=WORD(naglowek,2) END ELSE DO CALL Pisz 'Nie ma pliku' plik '!!!' CALL Pisz 'Czy chcesz stworzyc nowy plik z ocenami ?' odpowiedz=Odpowiedz() IF odpowiedz=='T' THEN CALL Tworzdziennik ELSE EXIT 20 END pierwszyraz=1 zmiany=0 DO FOREVER IF aktsrednia>0 THEN CALL Pisz 'Ostatnio sprawdzana srednia ocen:' aktsrednia CALL Pisz CALL Pisz 'Do uslug...' CALL Pisz '1. Wyswietl oceny...' CALL Pisz '2. Dopisz oceny...' CALL Pisz '3. Dodaj przedmiot...' CALL Pisz '4 Srednia ocen...' CALL Pisz '5. Konfiguracja...' CALL Pisz '6. Wyjscie !' CALL Pisz 'Wybor nalezy do Ciebie...' wybor=READLN(okno) SELECT WHEN wybor=1 THEN CALL WyswietlOceny WHEN wybor=2 THEN CALL DopiszOceny WHEN wybor=3 THEN CALL DodajPrzedmiot WHEN wybor=4 THEN CALL SredniaOgolem WHEN wybor=5 THEN DO CALL OPEN config,'S:dziennik.config',WRITE CALL Config CALL CLOSE config END WHEN wybor=6 | wybor='' THEN LEAVE OTHERWISE CALL Pisz 'Nie wiem, o co Ci chodzi !' END END IF nowasrednia THEN DO CALL Pisz 'Wpisano nowe oceny !' CALL Pisz 'Obliczam aktualna srednia...' CALL SredniaOgolem END CALL Pisz 'Zegnam...' CALL CLOSE in CALL CLOSE config EXIT 0 WyswietlOceny: CALL Pisz 'Wyswietl oceny...' CALL Pisz '-------------------' CALL Pisz IF zmiany | pierwszyraz THEN CALL Lista IF ~licznik THEN DO CALL NieMa RETURN END ELSE DO DO FOREVER CALL WyswietlPrzedmioty IF wybor=='' THEN RETURN wybor=wybor-1 CALL Pisz wybor przedmioty.nazwa.wybor przedmioty.offset.wybor IF brakocen.wybor==1 THEN CALL Pisz 'Brak ocen z tego przedmiotu !' ELSE DO SEEK(in,przedmioty.offset.wybor,'B') CALL Oceny CALL Pisz 'Twoje oceny z tego przedmiotu to:' oceny srednia=suma/liczbaocen CALL Pisz 'Srednia ocen wynosi' srednia DO x=1 TO 6 IF ilosc.x>0 THEN CALL Pisz 'Ilosc ocen' x || ':' ilosc.x END CALL Pisz 'Ogolem ocen:' liczbaocen END CALL Return END END RETURN Oceny: suma=0 liczbaocen=0 DO p=1 TO 6 ilosc.p=0 END powrot=SEEK(in,1) linia=READLN(in) dlugosc=LENGTH(linia) SEEK(in,powrot,'B') DO p=1 TO dlugosc BY 3 ocena=READCH(in) symbol=READCH(in) spojnik=READCH(in) suma=suma+ocena liczbaocen=liczbaocen+1 ilosc.ocena=ilosc.ocena+1 IF spojnik==')' THEN BREAK END oceny=LEFT(linia,dlugosc-1) oceny=COMPRESS(oceny) RETURN SredniaOgolem: CALL Lista IF ~licznik THEN DO CALL NieMa RETURN END ELSE DO sumaog=0 liczbaocenog=0 DO x=1 TO 6 Iloscog.x=0 END DO x=0 TO licznik-1 IF ~brakocen.x THEN DO SEEK(in,przedmioty.offset.x,'B') CALL Oceny SumaOg=SumaOg+Suma Liczbaocenog=Liczbaocenog+liczbaocen DO p=1 TO 6 iloscog.p=iloscog.p+ilosc.p END END END IF liczbaocenog>0 THEN DO SredniaOg=SumaOg/Liczbaocenog CALL Pisz 'Ogolna srednia ocen wynosi' SredniaOg IF aktsrednia>0 THEN DO IF aktsrednia~=sredniaog THEN DO SELECT WHEN aktsredniasredniaog THEN DO jaka='mniejsza' ile=aktsrednia-sredniaog END OTHERWISE NOP END CALL Pisz 'i jest' jaka 'od poprzedniej o' ile SEEK(in,0,'B') WRITELN(in,'DZIENNIK' LEFT(sredniaog,11,' ')) IF ~EXISTS(stat) THEN CALL OPEN stpl,stat,WRITE ELSE CALL OPEN stpl,stat,ADD SEEK(stpl,0,'E') WRITELN(stpl,sredniaog) CALL CLOSE stpl END END ELSE DO SEEK(in,0,'B') WRITELN(in,'DZIENNIK' LEFT(sredniaog,11,' ')) END aktsrednia=sredniaog DO x=1 TO 6 IF iloscog.x>0 THEN CALL Pisz 'Ilosc ocen' x || ':' iloscog.x END CALL Pisz 'Ogolem ocen:' liczbaocenog END ELSE CALL Pisz 'Brak ocen z jakiegokolwiek przedmiotu !' CALL Return END RETURN WyswietlPrzedmioty: DO p=0 TO licznik-1 CALL Pisz p+1 || '.' przedmioty.nazwa.p END CALL Pisz CALL Pisz 'Wybierz numer przedmiotu:' wybor=Czytaj() RETURN DopiszOceny: DO FOREVER IF zmiany | pierwszyraz THEN CALL Lista IF ~licznik THEN DO CALL NieMa RETURN END ELSE DO CALL WyswietlPrzedmioty IF wybor=='' THEN RETURN wybor=wybor-1 CALL Pisz wybor przedmioty.nazwa.wybor przedmioty.offset.wybor CALL Pisz 'Podaj oceny do zapisu /oddziel je przecinkami lub spacjami/:' ocenydozapisu=Czytaj() SEEK(in,przedmioty.offset.wybor,'B') IF ~brakocen.wybor THEN DO stareoceny=READLN(in) dlugosc=LENGTH(stareoceny)-1 stareoceny=LEFT(stareoceny,dlugosc) stareoceny=stareoceny || ',' END CALL RozdzielOceny CALL StworzLancuch CALL ZapisOcen zmiany=1 END END RETURN RozdzielOceny: ktora=0 DO x=1 TO LENGTH(ocenydozapisu) CALL Pisz x symbol=SUBSTR(ocenydozapisu,x,1) SELECT WHEN symbol=='+' | symbol=='-' | symbol=='='THEN ocena.dodatek.ktora=symbol WHEN DATATYPE(symbol,NUM) & symbol<7 & symbol>0 THEN ocena.wartosc.ktora=symbol WHEN symbol==',' | symbol==' ' THEN DO ktora=ktora+1 END OTHERWISE CALL Pisz 'Blad w podanych ocenach' END END DO x=0 TO ktora IF ocena.dodatek.x~=='+' & ocena.dodatek.x~=='-' & ocena.dodatek.x~=='=' THEN ocena.dodatek.x=' ' END StworzLancuch: IF brakocen.wybor THEN ocenydozapisu='(' ELSE ocenydozapisu=stareoceny DO x=0 TO ktora ocenydozapisu=ocenydozapisu || ocena.wartosc.x ocenydozapisu=ocenydozapisu || ocena.dodatek.x ocenydozapisu=ocenydozapisu || ',' END dlugosc=LENGTH(ocenydozapisu) ocenydozapisu=LEFT(ocenydozapisu,dlugosc-1) ocenydozapisu=ocenydozapisu || ')' RETURN ZapisOcen: x=0 powrot=SEEK(in,0) CALL Pisz SEEK(in,0) DO UNTIL EOF(in) line=READLN(in) linia.x=line x=x+1 END IF ~brakocen.wybor THEN SEEK(in,przedmioty.offset.wybor,'B') ELSE SEEK(in,powrot,'B') WRITELN(in,ocenydozapisu) DO p=0 TO x-1 WRITELN(in,linia.p) END nowasrednia=1 RETURN DodajPrzedmiot: CALL Pisz 'Podaj nazwe przedmiotu do dopisania:' przedmiot=Czytaj() UPPER przedmiot CALL lista DO p=0 TO licznik-1 CALL Pisz przedmiot przedmioty.nazwa.p IF przedmiot==przedmioty.nazwa.p THEN DO CALL Pisz 'Juz jest taki przedmiot !' RETURN END END IF przedmiot~=='' THEN DO SEEK(in,0,'E') WRITECH(in,'#') WRITELN(in,przedmiot) CALL Pisz 'Przedmiot dopisany...' zmiany=1 END ELSE CALL Pisz 'Nie podales nazwy przedmiotu !' RETURN Tworzdziennik: CALL Pisz 'Podaj nazwe pliku:' plik=Czytaj() CALL OPEN in,plik,WRITE WRITELN(in,'DZIENNIK ') RETURN Lista: zmiany=0 pierwszyraz=0 licznik=0 SEEK(in,0,'B') DO UNTIL EOF(in) linia=READLN(in) znak=LEFT(linia,1) SELECT WHEN znak='#' THEN DO dlugosc=LENGTH(linia) przedmioty.nazwa.licznik=RIGHT(linia,dlugosc-1) miejsce=SEEK(in,0) przedmioty.offset.licznik=miejsce brakocen.licznik=1 licznik=licznik+1 END WHEN znak='(' THEN DO numer=licznik-1 przedmioty.offset.numer=miejsce brakocen.numer=0 END OTHERWISE NOP END END RETURN Config: SEEK(config,0,'B') CALL Pisz 'Konfiguracja DZIENNICZKA' CALL Pisz CALL Pisz 'Czy podajesz stala nazwe pliku z danymi ?' IF Odpowiedz()='T' THEN DO CALL Pisz 'Podaj sciezke dostepu do tego pliku:' sciezka=Czytaj() WRITELN(config,'NAME' sciezka) END ELSE WRITELN(config,'NAME ASK') CALL Pisz 'Czy chcesz prowadzic statystyke?' IF Odpowiedz()='T' THEN DO CALL Pisz 'Podaj nazwe pliku:' stat=Czytaj() WRITELN(config,'STAT' stat) END zmiany=1 RETURN Odpowiedz: DO UNTIL char=='T' | char=='N' char=Czytaj() UPPER char END RETURN char Return: CALL Pisz 'Nacisnij ENTER...' czekaj=Czytaj() RETURN Pisz: ARG co WRITELN(okno,co) RETURN Czytaj: cos=READLN(okno) RETURN cos SprawdzConfig: SEEK(config,0,'B') nazwa=READLN(config) SAY WORD(nazwa,1) WORD(nazwa,2) IF WORD(nazwa,1)=='NAME' & WORD(nazwa,2)~=='ASK' THEN plik=WORD(nazwa,2) ELSE plik='?' nazwa=READLN(config) IF WORD(nazwa,1)=='STAT' & WORD(nazwa,2)~=='' THEN stat=WORD(nazwa,2) RETURN NieMa: CALL Pisz 'Brak przedmiotow! Skorzystaj z funkcji "Dodaj przedmiot..."!' CALL Return RETURN