RIGAL/rigsc.446/examples/rig_pnt.rig

#STANT
-- Program for printing object out
-- 1th parameter - =s - for printing to screen
--                 oth. for printing to any file
-- 2th parameter  p   - PRINT-operation 
--                g   - Graphical print operation
--                v   - Graphical, to file
-- 3rd parameter  Code file name
-- Next parameters    - Components
-- Last parameter - if "?" - then writes only this component
   
  $E:=#PARM(T);
  IF $E[1]='s' -> OPEN TT ' '
  ELSIF T      -> OPEN TT $E[1]
  FI;

  TT<<parameters ':';
  FORALL $EE IN $E DO TT<]'('$EE')  ' OD;
  #F($E);
  IF $E[1]='s' -> #CALL_PAS(1 'Press ENTER') FI;
  ##

#F  
   (. $GFILE
      ($F:=p!$F:=g!$F:=v)
      $AFILE 
      / LOAD $OBJ $AFILE ;
      
        $STR :=(. '"' $AFILE '"' .);
        IF NOT $OBJ -> TT<<$STR;
                       TT<<'  no such file !!! ';
                       #CALL_PAS(1 #IMPLODE('No such file="'
                                            $AFILE '" Press ENTER')) ;
                       RETURN NULL FI/

 
      (* 
       (  '?' /  TT<<$STR;
                 IF $GFILE<>'s'->
                    PRINT ' Use " ? " only if output to screen allowed !'
                 FI;
                 #ANAL($OBJ);RETURN NULL / !

          $NUM /  $STR!!:=(. '[' COPY($NUM) ']' .);
                 TT<< $STR;  $LEN:=#LEN($OBJ);
                 IF NOT #LIST($OBJ) -> TT<<'object is not list !';#TT()
                 ELSIF ( $NUM>$LEN ) OR
                        ( ( $NUM<0 )AND( -$NUM>$LEN ) ) ->
                 TT<<'object''s length-only ' $LEN ;#TT() FI;
                 $OBJ:=$OBJ[$NUM] / !
          $IDATOM / $STR !!:=(. '.' COPY($IDATOM) .) ;
                   TT<< $STR;                    
                   IF NOT #TREE($OBJ) ->
                       TT<<  'object is not tree !';#TT()
                   ELSIF NOT( $OBJ.$IDATOM ) ->
                       TT<< 'object has no such selector !';#TT()
                   FI;
                   $OBJ:=$OBJ.$IDATOM /!
          $XXX / TT<<' wrong element in parameters =' $XXX / ) *) .)
      / TT<<;TT<<;
        IF $F=g -> #CALL_PAS(13 $OBJ)
        ELSIF $F=v -> #CALL_PAS(12 $OBJ)
        ELSIF T -> PRINT $OBJ
        FI;TT<< / ##
#TT / TT<<;TT<< / ##
#ANAL NULL / TT << ' NULL ' / ;;
   $NAME::<* $SEL : $ZARS:=#MANAL 
    /  IF    NOT $NAME -> TT<< 'tree without name : ' ; $NAME:=0;
       ELSIF $NAME<>0 ->  TT<<'tree with name  : ' $NAME ;$NAME:=0;
       FI;
       TT<< $SEL ':' $ZARS / *> ;;
  $NAME ::(. (* $EL!.:=#MANAL
   /  IF    NOT $NAME -> TT<< ' list without name : ' ; $NAME:=0;
      ELSIF $NAME<>0 ->  TT<<'list with name : ' $NAME ;$NAME:=0;
      FI / *) .)
   /  TT<<list length #LEN($EL);
      TT<<list is $EL / ;;
  $K:= #MANAL
/ TT<<$K; RETURN $K / ##
#MANAL NULL        / RETURN ' NULL ' / ;;
       <. [X:X] .> / RETURN ' tree ' /;;        
       (. (* $E *) .) / RETURN ' list '/;;
       $F:=#FATOM   / RETURN (. 'F-ATOM=' $F .)/;;
       $N:=#NUMBER  / RETURN (. 'NUMBER-ATOM=' $N .)/;;
       V'(#_RULETOATM($$)) $S   / RETURN (. 'RULE-DESK=' $S .)/;;
       V'(#_VARNAME  ($$)) $S   / RETURN (. 'VAR-DESK=' $S .)/;;
       V'(#_KEYWORD  ($$)) $S   / RETURN (. 'KEYW-DESK=' $S .)/;;
       $I:=#IDENT   / RETURN (. 'ID-ATOM=' $I .)/;;
       $I:=#IDENT   / RETURN (. 'ID-ATOM=' $I .)/;;
       $O           / RETURN (. 'ATOM=' $O .)/##