Retro1.org codex

*DECK KAPPMOD 
USETEXT NIPDEF
USETEXT SUPMSG
USETEXT KDIS
USETEXT DISTAIL 
USETEXT AHEADER 
USETEXT PARAMS
USETEXT PT
USETEXT AT
PRGM KAPPMOD ; # HANDLES K-DISPLAY APPLICATION-MODE TYPE-INS #
STARTIMS ;
 #
*1DC  KAPPMOD 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        KAPPMOD             A. BEN-ARTZI        82/03/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        HANDLES K-DISPLAY APPLICATION MODE TYPE-INS. 
* 
*     3. METHOD USED
*        VERIFY IF INPUT ALLOWED TO APPLICATION 
*        CHECK TYPE OF INPUT
*          IF FIRST CHARACTER IS "+" OR "-" THEN FORMAT HOP/PAGE
*          ELSE FORMAT HOP/CMD AND SEND MESSAGE TO APPLICATION. 
* 
*     4. ENTRY PARAMETERS 
*        PARAMS1 - NUMBER OF CHARACTERS ON INPUT
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     SUPMSG     KDIS 
*        DISTAIL     AHEADER     PARAMS 
*        PT     AT
* 
*     7. ROUTINES AND OVERLAYS CALLED 
*        BLINK - LINK MESSAGE INTO DATA RING
*        MGETS - ALLOCATE BUFFER
*        OSCHAPP - SCHEDULE APPLICATION 
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS IS A SECONDARY OVERLAY CALLED BY KPTYPIN. 
*        W A R N I N G - THIS OVERLAY CANNOT EXCEED THE SECONDARY 
*CALL OSSIZE
 #
STOPIMS  ;
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN 
        PROC XTRACE ; 
        PROC MGETS  ; 
        PROC BLINK  ; 
        PROC OSCHAPP; 
        LABEL RJMAIN ;
        END 
# 
      INTERNAL VARIABLES
# 
      ITEM FIRST  C(1) ;
      ITEM KAPNO       ;
      ITEM KCHAR       ;
      ITEM BUFADDR     ;
 
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("KAPPM") ; 
      CONTROL FI           ;
 
      KCHAR = PARAMS1 ; 
      FIRST = C<0>KBUF1[0] ;
 
       BEGIN
       KAPNO = KDAN[0] ;
        IF  FIRST NQ "/" AND  #   TO THE APPLICATION                   #
            FIRST NQ "-" AND  #                                        #
            FIRST NQ "+"
              AND FIRST NQ "("
                 AND FIRST NQ ")" 
         THEN 
           BEGIN
             IF KDNI[0]       # MAYBE INPUT TO APPLICATION NOT ALLOWED #
             THEN 
               BEGIN
               KREPEAT[0] = "REPEAT..";  # SIGNAL OPERATOR OF ERROR  #
               GOTO KEXIT ; 
               END
             ELSE       # APP. MODE AND INPUT ALLOWED                  #
               BEGIN
# 
               SEND THE MSG TO THE APPLICATION WITH HOP/CMD 
# 
               KGET (HOPCMD,(KCHAR+21)/10,BUFADDR) ;
               HOPDTL[0]= KCHAR ; 
               C<0,KCHAR>HOPMSG[0]=C<0,KCHAR>KBUF[0] ;
# 
               AND NO INPUT ANY MORE TILL APPLICATION ALLOWES 
# 
               KDNI[0] = TRUE ; 
# 
               AND SEND IT TO APPLICATION 
# 
               GOTO SEND ;
               END
           END
         ELSE    # APP. MODE. ONE OF FUNC (*,-,/,+) RECEIVED           #
           BEGIN
           IF FIRST EQ "+" OR FIRST EQ "-"
                OR FIRST EQ "(" 
                    OR FIRST EQ ")" 
           THEN 
               BEGIN
# 
               BUILD THE HOP/PAGE BLOCK 
# 
               KGET(HOPPAGE,LHOPAGE,BUFADDR) ;
               HOPPC[0] = FIRST ; 
# 
               AND SEND IT TO APPLICATION 
# 
               GOTO SEND ;
               END
             ELSE    # NO OTHER CHOICE. JUST "/"                       #
               BEGIN
                  IF  KDBK[0] 
                  THEN
                    BEGIN 
                    KREPEAT[0] = "REPEAT.."; # SIGNAL ERROR            #
                    GOTO KEXIT; 
                    END 
                  ELSE
                    BEGIN 
                    KDBK[0] = TRUE; 
                    KGET(HOPBRK,LHOPBRK,BUFADDR); 
                    GOTO SEND;
                    END 
               END
           END
       END
SEND:  BEGIN
       BLINK(BUFADDR,ATACBA[KAPNO]) ; 
       OSCHAPP(ATACBA[KAPNO])       ; 
       END
KEXIT: KBUF1[0] = 0 ; 
       GOTO RJMAIN  ; 
# 
   -------------------- 
# 
 PROC KGET(KCODE,KL,BUF); 
      ITEM KCODE U; 
      ITEM KL    U; 
      ITEM BUF   U; 
 BEGIN
     MGETS(KL+BLKHSIZE+ABHSIZE,BUF,TRUE); 
     P<SUPMSG>=BUF+BLKHSIZE+ABHSIZE;
     P<AHEADER> = BUF+BLKHSIZE;# BASE APPLICATION HEADER #
     PFCSFC[0] = KCODE ; # SET FUNCTION CODE #
#                                                                      #
    ABHTLC[0]=KL; # LENGTH OF MESSAGE # 
    ABHABT[0]=APPCMD;             # THIS IS A COMMAND BLOCK # 
    ABHACT[0]=CT60TRANS;          #CHARACTER TYPE           # 
    ABHABN[0]=0;
    ABHADR[0]=0;
    RETURN; 
 END
      END   # MAIN #
TERM