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 ( dst_sezione_fld dst_valore_fld src_sezione src_valore -- )
DUP  \ dup src_valore
EMPTY= IF  \ se l'importo sorgente <20> nullo butta tutto e finisce qui
  DROP
  DROP
  DROP
  DROP
ELSE
  3 PICK >R  \ prende dst_sezione_fld
  2 PICK >R  \ prende dst_valore_fld
  >R         \ store di src_valore
  >R         \ store di src_sezione
  SWAP       \ porta in cima allo stack la dst_sezione_fld
  DUP        \ la duplica perch<63> la perde la riga dopo
  @          \ prende il valore di dst_sezione_fld

  EMPTY= IF  \ se la dst_sezione_fld <20> vuota
    R>       \ recupera la src_sezione
    SWAP     \ gira i due termini
    !        \ assegna il contenuto della src_sezione al campo dst_sezione_fld
    R>       \ prende src_valore
    SWAP     \ gira i campi src_valore e dst_valore_fld
    !        \ assegna src_valore al campo dst_valore_fld
  ELSE
    @
    R>       \ legge src_sezione
    = IF
      R>     \ prende src_valore
    ELSE
      R>     \ prende src_valore
      -1 *   \ inverte il segno di src_valore
    THEN
    SWAP     \ gira i campi sullo stack src_valore dst_valore_fld
    +!       \ somma src_valore con segno rovesciato al campo dst_valore_fld
  THEN
\ normalizzazione della destinazione
  MON
  R@         \ recupera dst_valore_fld
  @          \ legge il valore di dst_valore_fld
  DUP        \ lo duplica per possibile cambio di segno
  0 < IF     \ se il valore <20> negativo
    -1 *     \ gli cambia segno
    R>       \ recupera ancora dst_valore_fld
    !        \ salva il valore positivo nel campo dst_valore_fld
    R@       \ recupera dst_sezione_fld
    @        \ legge il valore di dst_sezione_fld
    "A" = IF \ lo inverte
      "D"
    ELSE
      "A"
    THEN
    R>       \ recupera ancora dst_sezione_fld
    !        \ salva il valore cambiato della sezione in dst_sezione_fld
  ELSE
    DROP     \ se non deve invertire nulla svuota gli stack
    R>
    R>
  THEN

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
;