campo-sirio/include/report.alx

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Funzioni di aiuto per implementazione messaggi
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

: REP_GET_POS.X ( f1 -- n1 ) 
  GET_POS DROP 
;

: REP_GET_POS.Y ( f1 -- n1 ) 
  GET_POS NIP 
;

: REP_GET_SIZE.X ( f1 -- n1 ) 
  GET_SIZE DROP 
;

: REP_GET_SIZE.Y ( f1 -- n1 ) 
  GET_SIZE NIP 
;

: REP_GET_BOTTOM ( f1 -- n1 )
  DUP 
  REP_GET_POS.Y
  SWAP 
  REP_GET_SIZE.Y
  +
;

: REP_OFFSET_FIELD_POS.X ( n1 -- ) 
  #THIS REP_GET_POS.X     \ Legge posizione x
  +                       \ La incrementa di n1
  #THIS REP_GET_POS.Y     \ Legge posizione y
  #THIS SET_POS           \ Aggiorna posizione
;

: REP_OFFSET_FIELD_POS.Y ( n1 -- ) 
  #THIS REP_GET_POS.Y     \ Legge posizione y
  +                       \ La incrementa di n1
  #THIS REP_GET_POS.X     \ Legge posizione x
  SWAP                    \ Scambia le coordinate
  #THIS SET_POS           \ Aggiorna posizione
;

: REP_MESSAGE_ALIGN_BOTTOM ( f1 -- )
  REP_GET_BOTTOM          \ Calcola fondo di f1
  #THIS REP_GET_BOTTOM    \ Calcola fondo del campo corrente
  -                       \ Calcola offset come differenza dei due
  REP_OFFSET_FIELD_POS.Y  \ Incrementa posizione y del campo corrente
;

: REP_MESSAGE_ALIGN_TOP ( f1 -- )
  REP_GET_POS.Y           \ Legge posizione y del capo f1
  #THIS REP_GET_POS.X     \ Legge posizione x del campo corrente
  SWAP                    \ Scambia le coordinate
  #THIS SET_POS           \ Aggiorna posizione del campo corrente
;

: REP_MESSAGE_ALIGN_CENTER ( f1 -- )
  REP_GET_BOTTOM          \ Calcola fondo del campo f1
  #THIS REP_GET_BOTTOM    \ Calcola fondo del campo corrente
  - 2 /                   \ Calcola offset verticale
  REP_OFFSET_FIELD_POS.Y  \ Aggiorna posizione del campo corrente
;

: REP_MESSAGE_ALIGN_UNDER ( f1 -- )
  REP_GET_BOTTOM          \ Calcola fondo di f1
  #THIS REP_GET_POS.Y     \ Calcola inizio del campo corrente
  -                       \ Calcola offset come differenza dei due
  REP_OFFSET_FIELD_POS.Y  \ Incrementa posizione y del campo corrente
;

: REP_COPY_HEIGHT ( f1 -- )
  REP_GET_SIZE.Y          \ Altezza campo origine
  #THIS REP_GET_SIZE.X    \ Larghezza campo destinazione
  SWAP                    \ Scambia parametri per set_size
  #THIS SET_SIZE          \ Aggiorna dimensioni
;

: REP_FIELD_NOT_NULL ( f1 -- f1 b1 )
  SP 
;

: REP_ADD_IMPORTO ( f1 -- )
#THIS @                  \ leggo l'importo da sommare
EMPTY= IF                \ se <20> nullo 
  DROP                   \ butta tutto e finisce qui
ELSE
  DUP                    \ duplica l'identificatore della destinazione
  >R                     \ memorizza l'identificare della destinazione nel return stack
  @                      \ valore della destinazione
  EMPTY= IF              \ se <20> nullo
    #THIS GET_ID_NEXT @  \ recupera la sezione sorgente
	R@ GET_ID_NEXT    !  \ imposta la sezione destinazione
    #THIS @              \ recupera il valore sorgente
	R@ !                 \ imposta il valore destinazione
  ELSE
    #THIS @              \ leggo l'importo da sommare
    #THIS GET_ID_NEXT @  \ leggo la sezione sorgente
    R@ GET_ID_NEXT @     \ leggo la sezione destinazione
    <> IF                \ se sono diverse
      -1 *               \ inverte valore
    THEN
    R@  +!               \ incrementa la destinazione
  THEN
  R@ @                   \ recupera valore destinazione da normalizzare
  0 < IF                 \ se il valore <20> negativo
    R@ @ -1 *            \ gli cambia segno
    R@ !                 \ lo risalva positivo
    R@ GET_ID_NEXT @     \ recupera sezione di destinazione
    "A" = IF             \ la inverte
      "D"
    ELSE
      "A"
    THEN
    R@ GET_ID_NEXT !     \ salva nuova sezione
  THEN
  R>                     \ ripristina il return stack
THEN
;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Implementazione dei vari messaggi standard
\ f1 campo o sezione del report
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

: MESSAGE_ADD ( f1 -- )
  #THIS @                      \ Leggo il valore del campo corrente
  SWAP +!                      \ Incrementa f1 col contenuto del campo corrente
;

: MESSAGE_ALIGN ( s1 f1 -- )
  SWAP                         \ Porta su il tipo di allineamento (BOTTOM)
  "REP_MESSAGE_ALIGN_" SWAP +  \ Si crea il nome della funzione da chiamare
  PERFORM                      \ Chiama ad esempio DO_MESSAGE_ALIGN_BOTTOM, ecc... 
;

: MESSAGE_APPEND ( f1 -- )
  #THIS @                      \ Leggo il valore del campo corrente
  DUP EMPTY=                   \ Controlla se e' vuoto
  IF
    DROP                       \ Scarta il valore nullo 
	DROP                       \ Scarta f1
  ELSE
    OVER @                     \ Leggo il valore di f1
	EMPTY= NEGATE
	IF 
      " " SWAP +               \ Sommo uno spazio all'inizio della stringa
    THEN  
	SWAP                       \ Riporto in primo piano f1
    +!                         \ Incrementa f1 col contenuto della stringa
  THEN
;

: MESSAGE_APPEND_CR ( f1 -- )
  #THIS @                      \ Leggo il valore del campo corrente
  DUP EMPTY=                   \ Controlla se e' vuoto
  IF
    DROP                       \ Scarta il valore nullo 
	DROP                       \ Scarta f1
  ELSE	 
    CR                         \ Inserisco un "a capo"
	SWAP
    +                          \ Sommo un "a capo" all'inizio della stringa
    SWAP                       \ Riporto in primo piano f1
    +!                         \ Incrementa f1 col contenuto della stringa
  THEN
;


: MESSAGE_COPY ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
    #THIS @ SWAP !             \ Copia il campo corrente
  REPEAT
;

: MESSAGE_DEBUG ( NULL -- )
  MON                          \ Attiva il fantastico debugger
;

: MESSAGE_DISABLE ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
	DISABLE                    \ Report defined word
  REPEAT
;

: MESSAGE_ENABLE ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui parametri 
    REP_FIELD_NOT_NULL
  WHILE              
	ENABLE                     \ Report defined word
  REPEAT
;

: MESSAGE_HIDE ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
	HIDE                       \ Report defined word
  REPEAT
;

: MESSAGE_INCR ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
	INCR                       \ Native word
  REPEAT
;

: MESSAGE_ISAMREAD ( s1 s2 n1 -- )
  ISAM_READ
;

: MESSAGE_PAGENO ( -- )        \ Numero di pagina corrente
  #REPORT.PAGE @               \ Leggo il numero di pagina
  #THIS !                      \ Setto il campo corrente col numero 
;

: MESSAGE_RESET ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
    NULL SWAP !                \ Azzera campo
  REPEAT
;

: MESSAGE_SHOW ( f1 ... fn -- )
  BEGIN                        \ Ciclo sui prametri 
    REP_FIELD_NOT_NULL
  WHILE              
	SHOW                       \ Report defined word
  REPEAT
;

: MESSAGE_SUB ( f1 -- )
  #THIS @                      \ Leggo il campo corrente
  -1 *                         \ Lo cambio di segno
  SWAP +!                      \ Decrementa f1 col contenuto del campo corrente
;

: MESSAGE_TABLEREAD ( s1 s2 s3 -- )
  TABLE_READ
;

: MESSAGE_TODAY ( -- )         \ Data odierna
  #SYSTEM.DATE @               \ Leggo la data
  #THIS !                      \ Setto il campo corrente con la data
;

: MESSAGE_DITTA ( s1 -- )
  GET_FIRM_DATA                \ Campi della ditta corrente
;

: MESSAGE_ADD_IMPORTO ( f1 -- )
  REP_ADD_IMPORTO              \ Incrementa un importo presumendo sia seguito dalla sua sezione
;