S=2510; /***************************************************************** DEMO D0: 23.06.1988 ; 12:00 M. Kendi -----------------------------------------------------------------*/ /* Dieses Programm ist eine um 90% abgespeckte und aus anderen Blöcken zusammengeschusterte Version eines Moduls, das in dieser Form nur dazu dient, Ihnen einen Teil der Möglichkeiten zu zeigen, die Ihnen die Programme BIBL1 und CAMAS bieten. Bevor Sie das Prg. starten, sollten Sie das Datum und die Zeit richtig stellen. Starten Sie das Programm mit: LOAD F0:demo+F0:camas+F0:bibl1--DEM0 *****************************************************************/ MODULE DEMO; ;/*-L*/ SYSTEM ; TERM : A1 (NE); TAST : C1(TFU=1,AI=$3E00); /* nur rasch nachschauen */ COMM : XC; MAUS : EV(80000000); /* Mausinterrrupt */ PROBLEM; /*------------------------------------------------------ Stukturen --*/ TYPE DUTY STRUCT (/ NAME CHAR(16),(GRAD,FIX_FERIEN,GUT_FERIEN,RUHE, KRANK,UNFALL,NACHT,SONNTAG,SPAZIER,NIX) FIXED /); /*--------------------------------------------------- Dation-SPC --*/ SPC MAUS IRPT ; SPC TERM DATION INOUT ALPHIC CONTROL(ALL); SPC TAST DATION IN ALPHIC CONTROL(ALL); SPC COMM DATION OUT ALPHIC CONTROL(ALL); /*--------------------------------------------------- Daten-SPC --*/ SPC MOUSE TASK GLOBAL; /*----------------------------------------------- Synchronisation ----*/ DCL CURSEM SEMA GLOBAL PRESET(1); /* FÜR CURSOR */ DCL LEISTSEM SEMA GLOBAL PRESET(1); /* FÜR DATENLEISTE */ /*---------------------------------------------- Prozedur-SPC --*/ SPC (GRAUBILD,ESCBOX,CLS,CURS,GONG) ENTRY GLOBAL; SPC (SPRITS,SPRITL,TEXT,CURPOS) ENTRY GLOBAL; SPC (HIDEM,SHOWM,COFF,CON) ENTRY GLOBAL; SPC (BOX,DRAW,FULL,PFEILR,PFEILL) ENTRY GLOBAL; SPC COMM_BOX ENTRY GLOBAL; /*------------------------------------------------- vorwärts SPC --*/ SPC DPLAN_FIX ENTRY; SPC (FIX_EINAUS,FIX_CHANGE) ENTRY; SPC (FIX_EINAUS_BILD, FIX_EINAUS_EDIT) ENTRY; SPC (FIX_CHANGE_EDIT, FIX_CHANGE_BILD) ENTRY; SPC (FIX_CHANGE_DOIT,LOESCHE) ENTRY; SPC EDIT_DIENSTPLAN ENTRY; SPC DUMMY_EINTRAG ENTRY; /*---------------------------------------------- Prozedur-SPC --*/ SPC SYSDATE ENTRY RETURNS(FIXED(31)) GLOBAL; SPC SYSTIME ENTRY RETURNS(FIXED) GLOBAL; SPC DATOSTR ENTRY RETURNS(CHAR(10)) GLOBAL; SPC STRTODAT ENTRY RETURNS(FIXED(31)) GLOBAL; SPC DAT_DIFF ENTRY RETURNS(FIXED) GLOBAL; SPC SCHALTJ ENTRY RETURNS(BIT(1)) GLOBAL; SPC TIMETOSTR ENTRY RETURNS(CHAR(5)) GLOBAL; SPC STRTOTIME ENTRY RETURNS(FIXED) GLOBAL; SPC VAL ENTRY RETURNS(FIXED) GLOBAL; SPC STRI ENTRY RETURNS(CHAR(5)) GLOBAL; SPC (CMP_TAG,CMP_MON,CMP_JAR) ENTRY RETURNS(FIXED) GLOBAL; SPC WOTAG ENTRY RETURNS(CHAR(2)) GLOBAL; SPC DATCTRL ENTRY RETURNS(BIT(1)) GLOBAL; SPC TIMECTRL ENTRY RETURNS(BIT(1)) GLOBAL; SPC ESC_CTRL ENTRY RETURNS(BIT(1)) GLOBAL; SPC ALERT ENTRY RETURNS(FIXED) GLOBAL; SPC FORM ENTRY RETURNS(CHAR(20)) GLOBAL; SPC STRINGINPUT ENTRY RETURNS(CHAR(80)) GLOBAL; /*------------------------------------------------- vorwärts SPC --*/ SPC HOLE_STRING ENTRY RETURNS(CHAR(16)); /*-------------------------------------- modul-globale Variable --*/ DCL D_PLAN(16) DUTY; /* max. 16 Angestellte */ DCL OKAY INV BIT(1) GLOBAL INIT('1'B); DCL TRUE INV BIT(1) GLOBAL INIT('1'B); DCL FALSE INV BIT(1) GLOBAL INIT('0'B); DCL INVERS BIT(1) GLOBAL INIT('0'B); /* Bildschirm */ DCL ESC CHAR(1) GLOBAL; DCL JAHRYE(12) FIXED GLOBAL; /* MOD1000; NUMTAG */ DCL JAHRNO(12) FIXED GLOBAL; /* MOD1000; NUMTAG */ DCL (MX,MY) FIXED GLOBAL; /* MAUS-POSITION */ DCL MOUST FIXED GLOBAL INIT (0); /* MAUS-STATUS */ DCL (RBTN,LBTN) BIT(1) GLOBAL; /* MAUS-BUTTONS */ DCL (XCURS,YCURS) FIXED; DCL VOID FIXED; DCL VERAENDERT BIT(1); /******************************************************************* DIENST-PLAN ******************************************************************/ DIENSTPLAN: PROC GLOBAL; DCL WAHL FIXED; VERAENDERT = FALSE; LBTN = FALSE; WAHL = 0; CALL DUMMY_EINTRAG; WHILE WAHL /= 3 REPEAT CALL GRAUBILD('Dienst-Plan'); WAHL= ALERT('Bitte treffen Sie Ihre Wahl:',' ',' ',' ', 'Editieren','Fixwerte','ESC',' '); IF WAHL == 1 THEN CALL EDIT_DIENSTPLAN; ELSE IF WAHL == 2 THEN CALL DPLAN_FIX; FIN; FIN; END; END; /******************************************************************* OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO *******************************************************************/ EDIT_DIENSTPLAN: PROC; VOID= ALERT('In dieser Version ist dieses Segment', 'nicht implementiert. Bitte wählen Sie', ' "Fixwerte".',' ', 'OKAY',' ',' ',' '); END; /******************************************************************* OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO *******************************************************************/ /******************************************************************* DPLAN_FIX ******************************************************************/ DPLAN_FIX: PROC; REQUEST LEISTSEM; CALL CURS(30,0); PUT 'Dienst-Plan/ Fixwerte' TO TERM BY A; RELEASE LEISTSEM; VOID = ALERT('Bitte treffen Sie Ihre Wahl:',' ',' ',' ', 'EinAustrit','Änderungen','ESC',' '); IF VOID == 1 THEN CALL FIX_EINAUS; ELSE IF VOID == 2 THEN CALL FIX_CHANGE; FIN; FIN; END; /******************************************************************* FIX_EINAUS (EinAustritt) ******************************************************************/ FIX_EINAUS: PROC; CALL HIDEM; CALL FIX_EINAUS_BILD; CALL FIX_EINAUS_EDIT; END; /******/ FIX_EINAUS_EDIT: PROC; DCL FERTIG BIT(1) INIT('0'B); DCL C CHAR(1); CALL CON; XCURS =34; YCURS = 5; CALL CURS(50,YCURS); WHILE NOT FERTIG REPEAT AFTER 0.1 SEC RESUME; GET C FROM TAST BY SKIP,A(1); IF TOFIXED(C) /= 0 THEN IF TOFIXED(C)==11 AND YCURS /= 5 THEN YCURS = YCURS -1; CALL CURS(50,YCURS); ELSE IF TOFIXED(C)==10 AND YCURS /= 20 THEN YCURS = YCURS +1; CALL CURS(50,YCURS); ELSE IF TOFIXED(C)==13 THEN VERAENDERT = TRUE; D_PLAN(YCURS-4).NAME= HOLE_STRING(D_PLAN(YCURS-4).NAME,16); IF YCURS /= 20 THEN YCURS = YCURS +1; FIN; CALL CURS(50,YCURS); ELSE IF TOFIXED(C)==27 THEN FERTIG = TRUE; FIN; FIN; FIN; FIN; FIN; END; END; /******/ FIX_EINAUS_BILD: PROC; CALL BOX(264,40,144,32,0,2); CALL CURS(34,3); PUT 'Name d. Beamten:' TO TERM BY A; CALL BOX(232,72,176,272,0,2); CALL ESCBOX(496,292); FOR N TO 16 REPEAT CALL CURS(30,N+4); PUT N,D_PLAN(N).NAME TO TERM BY F(2),X(2),A; END; CALL DRAW(264,80,256,4,1); END; /********************************************************************* FIX_CHANGE (Änderungen) ********************************************************************/ FIX_CHANGE: PROC; DCL FERTIG BIT(1) INIT('0'B); DCL Y FIXED; WHILE NOT FERTIG REPEAT CALL GRAUBILD('Dienst-Plan/ Fixwerte ändern'); CALL FIX_EINAUS_BILD; VOID = ALERT('Betr. Beamten mit der Maus anklicken.',' ',' ',' ', 'Okay',' ',' ',' '); CALL SHOWM; LBTN = FALSE; WHILE NOT LBTN REPEAT WHEN MAUS RESUME; END; IF MX > 232 AND MX < 408 THEN Y = MY // 16 -4 ; IF Y > 0 AND Y < 17 THEN CALL FIX_CHANGE_EDIT(Y); LBTN = FALSE; FIN; ELSE IF MX >496 AND MX< 552 AND MY >292 AND MY< 340 THEN /* ESC */ FERTIG = TRUE; FIN; FIN; END; END; /****/ FIX_CHANGE_EDIT: PROC (NR FIXED); /* NR = Beamten-Nr. */ DCL NAME CHAR(16), Y FIXED, FERTIG BIT(1) INIT('0'B); CALL GRAUBILD(D_PLAN(NR).NAME); CALL FIX_CHANGE_BILD(NR); CALL SHOWM; LBTN = FALSE; WHILE NOT FERTIG REPEAT WHEN MAUS RESUME; IF LBTN THEN IF MX >528 AND MX< 592 THEN /* die Kommando-Box ? */ Y = MY // 16; IF Y == 13 THEN CALL LOESCHE(NR); ELSE IF Y== 16 THEN FERTIG = TRUE; /* ESC */ FIN; FIN; ELSE CALL FIX_CHANGE_DOIT(NR); FIN; FIN; END; END; /****/ LOESCHE: PROC(NR FIXED); VOID=ALERT('Der Beamte hat seine Zulagen', 'ausbezahlt bekommen. Seine', 'Guthaben werden gelöscht.',' ', 'Richtig','Falsch',' ',' '); IF VOID == 1 THEN D_PLAN(NR).SONNTAG = 0 ; CALL CURS(53,14); PUT D_PLAN(NR).SONNTAG TO TERM BY F(5,1,-1); D_PLAN(NR).SPAZIER = 0; CALL CURS(53,15); PUT D_PLAN(NR).SPAZIER TO TERM BY F(3); D_PLAN(NR).NACHT = 0; CALL CURS(53,16); PUT D_PLAN(NR).NACHT TO TERM BY F(3); FIN; END; /****/ FIX_CHANGE_DOIT: PROC (NR FIXED); DCL (NEG,PLUS) BIT(1) INIT('0'B,'0'B); DCL Y FIXED; IF MX > 400 AND MX < 488 THEN IF MX < 416 THEN PLUS = TRUE; FIN; IF MX > 472 THEN NEG = TRUE; FIN; Y = MY // 16 - 7; IF (PLUS OR NEG) AND Y > 0 THEN VERAENDERT = TRUE; CALL HIDEM; CALL CURS(53,Y+7); CASE Y /* 8*/ ALT IF NEG AND D_PLAN(NR).GRAD /= 1 THEN D_PLAN(NR).GRAD = D_PLAN(NR).GRAD - 1; ELSE IF PLUS AND D_PLAN(NR).GRAD /= 100 THEN D_PLAN(NR).GRAD = D_PLAN(NR).GRAD + 1; FIN; FIN; PUT D_PLAN(NR).GRAD TO TERM BY F(3); /* 9*/ ALT IF NEG AND D_PLAN(NR).FIX_FERIEN /= -99 THEN D_PLAN(NR).FIX_FERIEN =D_PLAN(NR).FIX_FERIEN -1; ELSE IF PLUS AND D_PLAN(NR).FIX_FERIEN /= 99 THEN D_PLAN(NR).FIX_FERIEN =D_PLAN(NR).FIX_FERIEN +1; FIN; FIN; PUT D_PLAN(NR).FIX_FERIEN TO TERM BY F(3); /*10*/ ALT IF NEG AND D_PLAN(NR).GUT_FERIEN /= -99 THEN D_PLAN(NR).GUT_FERIEN =D_PLAN(NR).GUT_FERIEN -1; ELSE IF PLUS AND D_PLAN(NR).GUT_FERIEN /= 99 THEN D_PLAN(NR).GUT_FERIEN =D_PLAN(NR).GUT_FERIEN +1; FIN; FIN; PUT D_PLAN(NR).GUT_FERIEN TO TERM BY F(3); /*11*/ ALT IF NEG AND D_PLAN(NR).RUHE /= -999 THEN D_PLAN(NR).RUHE =D_PLAN(NR).RUHE -1; ELSE IF PLUS AND D_PLAN(NR).RUHE /= 999 THEN D_PLAN(NR).RUHE =D_PLAN(NR).RUHE +1; FIN; FIN; PUT D_PLAN(NR).RUHE TO TERM BY F(5,1,-1); /*12*/ ALT IF NEG AND D_PLAN(NR).KRANK /= 0 THEN D_PLAN(NR).KRANK =D_PLAN(NR).KRANK -1; ELSE IF PLUS AND D_PLAN(NR).KRANK /= 999 THEN D_PLAN(NR).KRANK =D_PLAN(NR).KRANK +1; FIN; FIN; PUT D_PLAN(NR).KRANK TO TERM BY F(5,1,-1); /*13*/ ALT IF NEG AND D_PLAN(NR).UNFALL /= 0 THEN D_PLAN(NR).UNFALL =D_PLAN(NR).UNFALL -1; ELSE IF PLUS AND D_PLAN(NR).UNFALL /= 999 THEN D_PLAN(NR).UNFALL =D_PLAN(NR).UNFALL +1; FIN; FIN; PUT D_PLAN(NR).UNFALL TO TERM BY F(5,1,-1); /*14*/ ALT IF NEG AND D_PLAN(NR).SONNTAG /= 0 THEN D_PLAN(NR).SONNTAG =D_PLAN(NR).SONNTAG -1; ELSE IF PLUS AND D_PLAN(NR).SONNTAG /= 999 THEN D_PLAN(NR).SONNTAG =D_PLAN(NR).SONNTAG +1; FIN; FIN; PUT D_PLAN(NR).SONNTAG TO TERM BY F(5,1,-1); /*15*/ ALT IF NEG AND D_PLAN(NR).SPAZIER /= 0 THEN D_PLAN(NR).SPAZIER =D_PLAN(NR).SPAZIER -1; ELSE IF PLUS AND D_PLAN(NR).SPAZIER /= 999 THEN D_PLAN(NR).SPAZIER =D_PLAN(NR).SPAZIER +1; FIN; FIN; PUT D_PLAN(NR).SPAZIER TO TERM BY F(3); /*16*/ ALT IF NEG AND D_PLAN(NR).NACHT /= 0 THEN D_PLAN(NR).NACHT =D_PLAN(NR).NACHT -1; ELSE IF PLUS AND D_PLAN(NR).NACHT /= 999 THEN D_PLAN(NR).NACHT =D_PLAN(NR).NACHT +1; FIN; FIN; PUT D_PLAN(NR).NACHT TO TERM BY F(3); OUT; FIN; /* CASE */ CALL SHOWM; FIN; /* PLUS OR NEG */ FIN; END; /****/ FIX_CHANGE_BILD: PROC (NR FIXED); CALL BOX(136,120,360,160,0,2); CALL DRAW(392,128,144,4,1); CALL CURS(18, 8); PUT 'Beschäftigungs-Grad (1...100%)' TO TERM BY A; CALL CURS(18, 9); PUT 'gesetzl. Ferienanspruch (Tage)' TO TERM BY A; CALL CURS(18,10); PUT 'Guthaben Ferien (Tage) .......' TO TERM BY A; CALL CURS(18,11); PUT 'Guthaben Ruhetage ............' TO TERM BY A; CALL CURS(18,12); PUT 'Kranheits-Tage ...............' TO TERM BY A; CALL CURS(18,13); PUT 'Unfall-Tage ..................' TO TERM BY A; CALL CURS(18,14); PUT 'Sonn- & Feiertagszulage ......' TO TERM BY A; CALL CURS(18,15); PUT 'Spazierzulage ................' TO TERM BY A; CALL CURS(18,16); PUT 'Nachtzulage ..................' TO TERM BY A; FOR N FROM 8 TO 16 REPEAT CALL PFEILL(50,N); CALL PFEILR(59,N); END; CALL CURS(53, 8); PUT D_PLAN(NR).GRAD TO TERM BY F(3); CALL CURS(53, 9); PUT D_PLAN(NR).FIX_FERIEN TO TERM BY F(3); CALL CURS(53,10); PUT D_PLAN(NR).GUT_FERIEN TO TERM BY F(3); CALL CURS(53,11); PUT D_PLAN(NR).RUHE TO TERM BY F(5,1,-1); CALL CURS(53,12); PUT D_PLAN(NR).KRANK TO TERM BY F(5,1,-1); CALL CURS(53,13); PUT D_PLAN(NR).UNFALL TO TERM BY F(5,1,-1); CALL CURS(53,14); PUT D_PLAN(NR).SONNTAG TO TERM BY F(5,1,-1); CALL CURS(53,15); PUT D_PLAN(NR).SPAZIER TO TERM BY F(3); CALL CURS(53,16); PUT D_PLAN(NR).NACHT TO TERM BY F(3); CALL COMM_BOX(66,11,'Kommando','Löschen','--------','--------', '* ESC *'); END; /******************************************************************* OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO *******************************************************************/ /********************************************************************* HOLE_STRING in diesem Fall ist die Länge auf CHAR(16) beschränkt *********************************************************************/ HOLE_STRING: PROC (STRG CHAR(16),MAX FIXED) RETURNS(CHAR(16)); DCL C CHAR(16); VERAENDERT = TRUE; CALL BOX(XCURS*8,YCURS*16,MAX*8,16,5,2); /* invers */ PUT ESC,'G4' TO TERM BY (2)A; INVERS = TRUE; C = STRINGINPUT(XCURS,YCURS,STRG,MAX); PUT ESC,'G0' TO TERM BY (2)A; INVERS = FALSE; CALL BOX(XCURS*8,YCURS*16,MAX*8,16,5,2); /* invers */ RETURN(C); END; /********************************************************************* DUMMY_EINTRAG *********************************************************************/ DUMMY_EINTRAG: PROC; /* Init D_PLAN() */ FOR N TO 16 REPEAT D_PLAN(N).NAME = ' '; D_PLAN(N).GRAD = 100; /* Beschäftigungs-Grad */ D_PLAN(N).FIX_FERIEN = 28; D_PLAN(N).GUT_FERIEN = 0; D_PLAN(N).RUHE = 0; D_PLAN(N).KRANK = 0; D_PLAN(N).UNFALL = 0; D_PLAN(N).NACHT = 0; D_PLAN(N).SONNTAG = 0; D_PLAN(N).SPAZIER = 0; D_PLAN(N).NIX = 0; END; D_PLAN(1).NAME = 'E. Holliger'; D_PLAN(2).NAME = 'R. Sohlinger'; D_PLAN(3).NAME = 'O. Williger'; END; /****************************************************************** DATLEISTE Datum- und Zeit-Anzeige an der Datums-Leiste *****************************************************************/ DATLEISTE: TASK; DCL (X,Y) CHAR(1); /* MOMENTANE CURS.-POS. */ DCL DATUM CHAR(10); DCL ZEIT CHAR( 5); DCL MS BIT(1) INIT('1'B); IF MOUST == 0 THEN MS = FALSE; FIN; IF INVERS THEN PUT TOCHAR(27),'G0' TO TERM BY (2)A; FIN; DATUM = DATOSTR(SYSDATE); ZEIT = TIMETOSTR(SYSTIME); REQUEST LEISTSEM; CALL HIDEM; CALL CURPOS(X,Y); /* STORE CURSOR */ CALL CURS(1,0); PUT DATUM TO TERM BY A; CALL CURS(74,0); PUT ZEIT TO TERM BY A; PUT TOCHAR(27),'=',X,Y TO TERM BY (4)A; /* RESTORE CURSOR */ RELEASE LEISTSEM ; IF MS THEN CALL SHOWM; FIN; IF INVERS THEN PUT TOCHAR(27),'G4' TO TERM BY (2)A; FIN; END; /****************************************************************** Initialisierung von DEMO *****************************************************************/ DEMO: TASK; ESC = TOCHAR(27); /*-- Die möglichen Anzahl Tage eines Monats --*/ JAHRYE( 1)=31; JAHRYE( 2)=29; JAHRYE( 3)=31; JAHRYE( 4)=30; JAHRYE( 5)=31; JAHRYE( 6)=30; JAHRYE( 7)=31; JAHRYE( 8)=31; JAHRYE( 9)=30; JAHRYE(10)=31; JAHRYE(11)=30; JAHRYE(12)=31; FOR N TO 12 REPEAT JAHRNO(N) = JAHRYE(N); END; JAHRNO(2)=28; /* weil's kein Schaltjahr ist */ /*---*/ CALL CLS; PUT TOCHAR(27),'E' TO TERM BY (2) A; /* deutsch */ /*-- Mouse-Init --*/ MX = 320 ; MY = 240; MOUST = 0; CALL SHOWM; WHEN MAUS ACTIVATE MOUSE PRIO 5; /*---*/ ALL 60 SEC ACTIVATE DATLEISTE PRIO 50; /*---*/ CALL DIENSTPLAN; CALL CLS; PUT 'CON' TO COMM BY A,SKIP; PUT 'UNLOAD CAMAS*--UNLOAD BIBL1*--UNLOAD DEMO*' TO COMM BY A,SKIP; END; /* OF TASK */ MODEND;