MAXI-NOMBRES

' ******************************************************************************
'            MAXI-NOMBRES.BAS
'              PAR PAPYDALL
' ******************************************************************************
label fin
width 0,1200 : height 0,200
caption 0,"ARITHMETIQUE ELEMENTAIRE SUR LES MAXI-NOMBRES par Papydall"
button 1 : top 1,100  : left 1,200 : caption 1,"OK" : on_click 1,fin : inactive 1
Declaration_Variables()
' Affectation de 2 chaines pour contenir les 2 maxi-nombres
 n1$ = "98765432123456789123456789123456789987654321" : n2$ = "12345678987654321"
' n1$ = "000123" : n2$ = "0000001234" : ' Chaînes valides ; les zéros non significatifs sont éliminés
' n1$ = "0000" : n2$ = "00" : ' Chaînes valides ; les zéros non significatifs sont éliminés
' n1$ = "123.456" : n2$ = ""  : ' <--- Chaînes non valides : detectées par le programme
' n1$ = "+123" : n2$ = "-123" : ' <--- Chaînes non valides : detectées par le programme

' ==============================================================================
' REMARQUE :
' L'appel de la procédure Verif() c'est pour un éventuel utilisateur qui cherche
' à tout prix à coïncer le programme en fournissant des chaines de caractères
' contenant les nombres à traiter dont le contenu est fantaisiste !
' Pour tout utilisateur rationnel et responsable de ce qu'il fait, la ligne
' suivante peut être omise, sans regret
' ==============================================================================
Verif(n1$) : n1$ = result$ : Verif(n2$) : n2$ = result$
' ------------------------------------------------------------------------------
print : print
' Appels pour les différentes procédures de calcul
Addition(n1$,n2$)      : print n1$;" + ";n2$;" = ";result$
Soustraction(n1$,n2$)  : print n1$;" - ";n2$;" = ";result$
Multiplication(n1$,n2$) : print n1$;" * ";n2$;" = ";result$
Division(n1$,n2$)      : print n1$;" / ";n2$;" = ";quotient$;" Reste = ";reste$
active 1
end
' ******************************************************************************
fin:
terminate
return
' ******************************************************************************
' Déclaration des variables globales utilisées dans les procédures SUB
SUB Declaration_Variables()
    dim n% : n% = 99 : ' Nombre des chiffres des maxi-nombres (vous pouvez modifier cette valeur)
    dim a%(n%),b%(n%),c%(n%),c1%(n%),d%(n%),r%(n%)
    dim n1$,n2$,result$,quotient$,reste$
    dim flag% : flag% = 1
END_SUB
' ******************************************************************************

SUB Verif(a$)
    dim_local i% : result$ = "0"
' Vérifier que la chaîne n'est pas vide, sinon message et sortie
    if len(a$) < 1
      if message_error_ok ("!!! ERREUR ! Une chaîne vide!!!"+chr$(13)+"Vous vous foutez de ma gueule ou quoi ?")=1 then terminate
    end_if
' Vérifier que la chaîne ne contient que des chiffres, sinon message et sortie
    for i% = 1 to len(a$)
      if (numeric(mid$(a$,len(a$)+1-i%,1)) = 0) or  (mid$(a$,len(a$)+1-i%,1) = ".")
          if message_error_ok ("!!! ERREUR ! Verifiez vos nombres !!!"+chr$(13)+"!!! Seuls les chiffres sont acceptés !!!")=1 then terminate
      end_if
    next i%
' Spprimer les éventuels zéros non significatifs à gauche de la chaîne
    i% = 1
    while  mid$(a$,i%,1) = "0" : i% = i% + 1 : end_while
    if i% <= len(a$) then result$ = mid$(a$,i%,len(a$)-i%+1)

 END_SUB
' ******************************************************************************
SUB Init_tabl(a$)
    dim_local i%
' Remise à zéro de a%()
    for i% = 1 to n% : a%(i%) = 0 : next i%
' Initialisation de a%()
    for i% = 1 to len(a$) : a%(i%) = val(mid$(a$,len(a$)+1-i%,1)) : next i%
END_SUB
' ******************************************************************************
' Paramètres d'entrée les 2 maxi-nombres sous formes de string dans A$ et B$
' Résultat de retour de l'addition sous forme de string dans RESULT$
SUB Addition(a$,b$)
    dim_local i%
    Init_tabl(a$)
    for i% = 1 to n% : c%(i%) = a%(i%) : next i%
    Init_tabl(b$)
    for i% = 1 to n% : c1%(i%) = a%(i%) : next i%
    Add()
    for i% = 1 to n% : a%(i%) = c%(i%) : next i%
    Transcode()
END_SUB
' ******************************************************************************
' Paramètres d'entrée les 2 maxi-nombres sous formes de string dans A$ et B$
' Résultat de retour de la soustraction sous forme de string dans RESULT$
SUB Soustraction(a$,b$)
    dim_local i%
' Vérifier si la soustraction donnerait un résultat négatif ( cas où b$ > a$)
    if len(a$) > len(b$)
      flag% = 1
    else
      if len(a$) < len(b$)
          flag% = -1
      else
          flag% = 1
          for i% = 1 to len(a$)
              if asc(mid$(a$,i%,1)) < asc(mid$(b$,i%,1)) then flag% = -1 : exit_for
          next i%
      end_if
    end_if
' -----------------------
    Init_tabl(a$)
    for i% = 1 to n% : r%(i%) = a%(i%) : next i%
    Init_tabl(b$)
    for i% = 1 to n% : c%(i%) = a%(i%) : next i%
    Sous(flag%)
    for i% = 1 to n% : a%(i%) = r%(i%) : next i%
    Transcode() : flag% = 1
END_SUB
' ******************************************************************************
' Paramètres d'entrée les 2 maxi-nombres sous formes de string dans A$ et B$
' Résultat de retour de la multiplication sous forme de string dans RESULT$
SUB Multiplication(a$,b$)
    dim_local i%
    Init_tabl(a$) : for i% = 1 to n% : b%(i%) = a%(i%) : next i%
    Init_tabl(b$) : Mult() : for i% = 1 to n% : a%(i%) = c%(i%) : next i%
    Transcode()
END_SUB
' ******************************************************************************
' Paramètres d'entrée les 2 maxi-nombres sous formes de string dans A$ et B$
' Résultats de retour de la division entière sous forme de string :
' Quotient dans RESULT$, Reste dans RESTE$
SUB Division(a$,b$)
    dim_local i%,valid% : valid% = 0
    for i% = 1 to len(b$)
        if mid$(b$,i%,1) <> "0" then valid% = 1 : exit_for
    next i%
' tester si division par zéro
    if valid% = 0
      quotient$ = "La division par zéro est non définie !!"
      reste$ = "???"
      exit_sub
    end_if
' ---------------------
    Init_tabl(a$) : for i% = 1 to n% : c%(i%) = a%(i%) : next i%
    Init_tabl(b$) :for i% = 1 to n% : b%(i%) = a%(i%) : next i%
    for i% = 1 to n% : a%(i%) = c%(i%) : next i%
    Div() : for i% = 1 to n% : a%(i%) = d%(i%) : next i%
    Transcode() : quotient$ = result$
    for i% = 1 to n% : a%(i%) = r%(i%) : next i%
    Transcode() : reste$ = result$
END_SUB

' ******************************************************************************
' Procédure d'addition : ajoute à c%() le contenu  de c1%()
SUB Add()
    dim_local i%,m%,r%
    r% = 0
    for i% = 1 to n%
        m% = c1%(i%) + c%(i%) + r% : r% = int(m% / 10) : c%(i%) = m% - 10 * r%
    next i%
END_SUB
' ******************************************************************************
' Procédure de soustraction : Retranche à r%() le contenu de c%()
SUB Sous()
    dim_local i%,m,r
    r = 0
    for i% = 1 to n%
        m = flag%*(r%(i%) - (c%(i%) + r)) : r = 0
        while m < 0 : m = m + 10 : r = r + 1*flag% : end_while
        r%(i%) = m
    next i%
END_SUB

' ******************************************************************************
' Procédure de multiplication : multiplie a%() par b%(), résultat dans c%()
SUB Mult()
    dim_local i%,i1%,j1%,im%,m%,r%
    for i% = 1 to n% :c%(i%) = 0 : next i%
    i% = n%
    while a%(i%) = 0
      if i% > 1 then i% = i% - 1 : else : exit_while
    end_while
    im% = i%
    for i1% = 1 to n%
        if b%(i1%) <> 0
          for i% = 1 to n% : c1%(i%) = 0 : next i%
          if im% > n%-i1% then im% = n% - i1%
          r% = 0
          for j1% = 1 to im%+1
              m% = a%(j1%) * b%(i1%) + r% : r% = int(m%/10)
              c1%(j1%+i1%-1) = m% - r% * 10
          next j1%
          Add()
        end_if
    next i1%
END_SUB
' *****************************************************************************
' Procédure de division entière : Divise a%() par b%()
' Quotient dans d%(), reste dans r%() : utilise c%() et c1%()
SUB Div()
    dim_local i%,im%,ia%,ib%,a,b,m,md,r,j1%
    for i% = 1 to n% : d%(i%) = 0 : r%(i%) = a%(i%) : next i%
    i% = n%
    while b%(i%) = 0
      if i% > 1 then i% = i% - 1 : else : exit_while
    end_while
    im% = i%
' Boucle sans fin pour éviter l'utilisation de GOTO
' La sortie de cette boucle est assurée par un test
    repeat
        i% = n%
        while b%(i%) = r%(i%)
          if i% > 1 then i% = i% - 1 : else : exit_while
        end_while
        if b%(i%) > r%(i%) then exit_sub : ' on sort de la boucle sans fin !
        ia% = n%
        while r%(ia%) = 0 and ia% > 1 : ia% = ia% - 1 : end_while
        ib% = n%
        while b%(ib%) = 0 and ib% > 1 : ib% = ib% - 1 : end_while
        a = r%(ia%) : b = b%(ib%)
        if b = 0 then exit_sub : ' on sort de la boucle sans fin !
        md = a/b
        repeat
            if md < 1 then a = a * 10 + r%(ia% - 1) : md = a/b : ia% = ia% - 1
            for i% = 1 to n% : c%(i%) = 0 : next i%
            r = 0
            for j1% = 1 to im% + 1
                m = int(md) * b%(j1%) + r : r = int(m/10) : c%(j1% + ia% -ib%) = m-r*10
            next j1%
            i% = n%
            while  c%(i%) = r%(i%)
              if i% > 1 then i% = i% - 1 : else : exit_while
            end_while
            if c%(i%) > r%(i%) then md = md - 1
        until c%(i%) <= r%(i%)
        Sous()
        ia% = ia% - ib% + 1
        for i% = 1 to n% : c%(i%) = d%(i%) : c1%(i%) = 0 : next i%
        c1%(ia%) = md : Add()
        for i% = 1 to n% : d%(i%) = c%(i%) : next i%
    until 1 = 2  : ' pour éviter le GOTO
END_SUB
   
' *****************************************************************************
' Procédure de transcodage de l'entier long contenu dans a%(), en la chaîne
' de caractères result$
SUB Transcode()
    dim_local i%,a$
    a$ = ""
    for i% = 1 to n% : a$ = str$(a%(i%)) + a$ : next i%
    i% = 0
    while mid$(a$,i%+1,1) = "0" : i% = i% + 1 : end_while
    a$ = right$(a$,len(a$) - i%) : if a$ = "" then a$ = "0"
    if flag% = -1 then result$ = "-" + a$ : else : result$ = a$
END_SUB
' ******************************************************************************