' ****************************************************
' * B A S E   C O N V E R T E R                      *
' * Calculatrice tout azimut - 1.060 Mai 1992        *
' *                                                  *
' * CODE GFA 3.52F    Pierre Philippe Launay         *
' * RECHERCHE         Cathy Lardy                    *
' * Résidence les cottages, 83 Rue André Theuriet    *
' * F63000 CLERMONT-FERRAND                          *
' ****************************************************
main
PROCEDURE main
  gris%=0
  marron%=1
  blanc%=2
  outremer%=3
  REPEAT
    iconise&=FALSE
    conversion
    DO
      IF iconise&=TRUE
        IF WINDOW(2)=0
          SETWPEN marron%,outremer%
          OPENW #2,546,1,40,10,&H8,&H2
          TITLEW #2,"ABC ",titres$
        ELSE
          ~ModifyIDCMP(WINDOW(2),&H2)
        ENDIF
        REPEAT
        UNTIL MOUSEK=1
        WHILE MOUSEK=1
        WEND
        temps%=TIMER
        ON MENU
        REPEAT
          EXIT IF SUB(TIMER,temps%)>50
        UNTIL MOUSEK AND MOUSEX>0 AND MOUSEX<30 AND MOUSEY>0 AND MOUSEY<10
        IF SUB(TIMER,temps%)<50
          CLOSEW #2
        ENDIF
      ENDIF
    LOOP UNTIL WINDOW(2)=0
  UNTIL iconise&=FALSE
RETURN
PROCEDURE conversion ! Entre différentes bases
  OPENS 0       ! Ecran WorkBench
  IF RasSize(430-10,50-11)*2>AvailMem(&H2)
    END         ! Oh no
  ENDIF
  OPENW #2,10,50,450,111,&H0,&H1002
  window%=WINDOW(2)
  detailpen%=ADD(window%,98)
  rastport%={ADD(window%,50)}
  WORD{detailpen%}=BYTE(gris%)*&H100+BYTE(marron%) ! My God
  ~ActivateWindow(window%)
  ~SetRast(rastport%,outremer%)
  ~RefreshWindowFrame(window%)
  titrew$="ARTIODACTYL BASE CONVERTER"
  titres$="ANT 05 1992 -GFA 3.52F- © Pierre Philippe Launay"
  TITLEW #2,titrew$,titres$
  DEFFILL outremer%,2,5         ! Base
  PBOX 7,12,100,65
  relache.bouton(7,12,100,65)
  COLOR marron%,outremer%
  TEXT 10,20,"Binaire"
  TEXT 10,30,"Octal"
  TEXT 10,40,"Décimal"
  TEXT 10,50,"HexaDécimal"
  COLOR gris%                   ! Spécial Ascii
  TEXT 10,60,"Ascii"
  DEFFILL outremer%,2,8
  RESTORE operateur
  COLOR blanc%,gris%
  FOR posy%=20 TO 70 STEP 10
    READ operateur$
    texte.relache(420,posy%,operateur$)
  NEXT posy%
  RESTORE fonction
  posx%=10
  posy%=95
  vide$=SPACE$(4)
  REPEAT
    READ fonction$
    IF fonction$="~"
      posx%=10
      ADD posy%,10
    ELSE
      IF fonction$<>""
        RSET vide$=fonction$
        texte.relache(posx%,posy%,vide$)
        ADD posx%,35
      ELSE
        ADD posx%,5
      ENDIF
    ENDIF
  UNTIL fonction$="Comb"
  fonction$=""
  operateur:
  DATA  / , * , - , + ,<<<,---
  fonction:
  DATA Log,Ln,Exp,Sqr,,SinQ,CosQ,Atan,,Deg,Swap,,Fact,Inv,~,Rol,Ror,Shl,Shr,,Sin,Cos,Tan,,Rad,Not,,Vari,Comb
  '
  texte.relache(420,95,"FIN")
  texte.relache(420,105,">|<")
  CLR oper1$,oper1%,oper2$,oper2%,oper3$,oper4$,oper4%
  FRONTW #2
  COLOR outremer%,outremer%
  REPEAT
    REPEAT
      MOUSE sourisx%,sourisy%,sourisk%
      clavier$=INKEY$
    UNTIL sourisk% OR clavier$=CHR$(27) OR clavier$="*" OR clavier$="-" OR clavier$="+" OR clavier$="/"
    EXIT IF clavier$=CHR$(27)
    IF clavier$<>""
      sourisk%=1
      sourisx%=420
      SELECT clavier$
      CASE "/"
        sourisy%=14
      CASE "*"
        sourisy%=24
      CASE "-"
        sourisy%=34
      CASE "+"
        sourisy%=44
      ENDSELECT
    ENDIF
    IF sourisk%=1
      SELECT sourisx%
      CASE 10 TO 99
        SELECT sourisy%
        CASE 88 TO 96
          curseury%=non%
          SELECT sourisx%
          CASE 10 TO 44
            IF mot4%>0
              fonction$="LOG("
              fonction=LOG10(mot4%)
            ENDIF
          CASE 45 TO 79
            IF mot4%>0
              fonction$="LN("
              fonction=LOG(mot4%)
            ENDIF
          CASE 80 TO 99
            IF mot4%<4969
              fonction$="EXP("
              fonction=EXP(mot4%)
            ENDIF
          ENDSELECT
          TEXT 10,85,SPACE$(50)
        CASE 98 TO 106
          curseury%=non%
          SELECT sourisx%
          CASE 10 TO 44 ! ROL& ROL|
            IF oper2%>0 AND oper2%<32
              fonction$="ROL("+STR$(oper1%)+","
              fonction=ROL(oper1%,oper2%)
            ENDIF
          CASE 45 TO 79 ! ROR& ROR|
            IF oper2%>0 AND oper2%<32
              fonction$="ROR("+STR$(oper1%)+","
              fonction=ROR(oper1%,oper2%)
            ENDIF
          CASE 80 TO 99 ! SHL& SHL|
            IF oper2%>0 AND oper2%<32
              fonction$="SHL("+STR$(oper1%)+","
              fonction=SHL(oper1%,oper2%)
            ENDIF
          ENDSELECT
          TEXT 10,85,SPACE$(50)
        ENDSELECT
      CASE 100 TO 409
        SELECT sourisy%
        CASE 14 TO 22             ! Binaire
          curseury%=20
          longmot%=32
          base$="&X"
        CASE 24 TO 32             ! Octal
          curseury%=30
          longmot%=10
          base$="&O"
        CASE 34 TO 42             ! Décimal
          curseury%=40
          longmot%=9
          base$=""
        CASE 44 TO 52             ! Hexadécimal
          curseury%=50
          longmot%=8
          base$="&H"
        CASE 54 TO 62             ! Ascii
          curseury%=60
          longmot%=4
          base$="$"
        CASE 88 TO 96
          curseury%=non%
          SELECT sourisx%
          CASE 100 TO 114
            IF mot4%<4969
              fonction$="EXP("
              fonction=EXP(mot4%)
            ENDIF
          CASE 115 TO 149
            IF mot4%>-1
              fonction$="SQR("
              fonction=SQR(mot4%)
            ENDIF
          CASE 155 TO 189
            IF ABS(mot4%)<67108863
              fonction$="SINQ("
              fonction=SINQ(mot4%)
            ENDIF
          CASE 190 TO 224
            IF ABS(mot4%)<67108863
              fonction$="COSQ("
              fonction=COSQ(mot4%)
            ENDIF
          CASE 225 TO 259
            IF ABS(mot4%)<2147483647
              fonction$="ATAN("
              fonction=ATN(mot4%)
            ENDIF
          CASE 265 TO 299
            IF ABS(mot4%)<2147483647
              fonction$="DEG("
              fonction=DEG(mot4%)
            ENDIF
          CASE 300 TO 334
            fonction$="SWAP("
            fonction=SWAP(mot4%)
          CASE 340 TO 374
            IF mot4%>-1 AND mot4%<422
              fonction$="FACT("
              fonction=FACT(mot4%)
            ENDIF
          CASE 375 TO 409
            IF mot4%<>0
              fonction$="1/("
              fonction=1/mot4%
            ENDIF
          ENDSELECT
          TEXT 10,85,SPACE$(50)
        CASE 98 TO 106
          curseury%=non%
          SELECT sourisx%
          CASE 100 TO 114
            IF oper2%>0 AND oper2%<32
              fonction$="SHL("+STR$(oper1%)+","
              fonction=SHL(oper1%,oper2%)
            ENDIF
          CASE 115 TO 149
            IF oper2%>0 AND oper2%<32
              fonction$="SHR("+STR$(oper1%)+","
              fonction=SHR(oper1%,oper2%)
            ENDIF
          CASE 155 TO 189
            IF ABS(mot4%)<2147483647
              fonction$="SIN("
              fonction=SIN(mot4%)
            ENDIF
          CASE 190 TO 224
            IF ABS(mot4%)<2147483647
              fonction$="COS("
              fonction=COS(mot4%)
            ENDIF
          CASE 225 TO 259
            IF ABS(mot4%)<2147483647
              fonction$="TAN("
              fonction=TAN(mot4%)
            ENDIF
          CASE 265 TO 299
            fonction$="RAD("
            fonction=RAD(mot4%)
          CASE 300 TO 334
            fonction$="NOT("
            fonction=NOT (mot4%)
          CASE 340 TO 374
            IF oper1%>=oper2% AND oper2%>0 AND oper1%<422
              fonction$="VARIAT("+STR$(oper1%)+","
              fonction=VARIAT(oper1%,oper2%)
            ENDIF
          CASE 375 TO 409
            IF oper1%>oper2% AND oper2%>-1 AND oper1%<422
              fonction$="COMBIN("+STR$(oper1%)+","
              fonction=COMBIN(oper1%,oper2%)
            ENDIF
          ENDSELECT
          TEXT 10,85,SPACE$(50)
        ENDSELECT
      CASE 420 TO 444
        curseury%=non%
        IF oper1$<>""
          SELECT sourisy%
          CASE 14 TO 22
            operateur(20,"/")
          CASE 24 TO 32
            operateur(30,"*")
          CASE 34 TO 42
            operateur(40,"-")
          CASE 44 TO 52
            operateur(50,"+")
          CASE 54 TO 62             ! <<<
            IF oper4$<>""
              oper5$=oper3$
              operateur(60,"<<<")
              operateur(60,"<<<")
              SWAP oper3$,oper5$
              oper1%=oper2%
              nombre%=oper4%
              oper1$=oper2$
              COLOR gris%,outremer%
              TEXT 10,75,SPACE$(50)
              TEXT 10,75,oper1$
              resultat
            ENDIF
            ' ENDSELECT ! fin provisoire
            ' ENDIF
            ' ENDSELECT
            ' ENDIF
            ' UNTIL fin
            ' - F I N   D E   L A  P R E M I E R E   P A R T I E ---------------
          CASE 64 TO 72             ! ---
            operateur(70,"---")
            operateur(70,"---")
            CLR oper1%,oper2%,oper4%,oper1$,oper2$,oper3$
            COLOR gris%,outremer%
            TEXT 10,75,SPACE$(50)
          CASE 88 TO 96
            clavier$=CHR$(27)
          CASE 97 TO 106
            iconise&=TRUE
            clavier$=CHR$(27)
          ENDSELECT
        ELSE
          SELECT sourisy%
          CASE 88 TO 96
            clavier$=CHR$(27)
          CASE 97 TO 106
            clavier$=CHR$(27)
            iconise&=TRUE
          ENDSELECT
        ENDIF
      ENDSELECT
      IF fonction$<>""
        TEXT 10,85,fonction$+STR$(mot4%)+") = "+STR$(fonction,19)
        WHILE MOUSEK
        WEND
      ENDIF
      IF curseury%
        saisie(110,curseury%,marron%,blanc%,longmot%,nombre$)
        CLR curseury%
        COLOR outremer%
        PBOX 110,13,382,62
        COLOR marron%,outremer%
        TEXT 110,20,BIN$(nombre%,32)
        TEXT 110,30,OCT$(nombre%,11)
        TEXT 110,40,STR$(nombre%,10)
        TEXT 110,50,HEX$(nombre%,8)
        TEXT 110,60,MKL$(nombre%)
        COLOR blanc%,outremer%
        IF oper1$="" OR (oper2$="" AND oper3$="")
          IF nombre%=0
            oper1$=""
            TEXT 10,75,SPACE$(50)
          ELSE
            oper1%=nombre%
            oper1$=STR$(oper1%,10)
            TEXT 10,75,oper1$+SPACE$(5)
          ENDIF
        ELSE
          resultat
        ENDIF
      ENDIF
    ENDIF
    IF nombre%<>0
      mot4%=nombre%
      nombre%=0
    ENDIF
  UNTIL clavier$=CHR$(27)
  CLOSEW #2
  clavier$=""
RETURN
PROCEDURE resultat
  IF oper3$<>""
    oper2%=nombre%
    oper2$=STR$(oper2%,9)
    SELECT oper3$
    CASE "+"
      oper4%=ADD(oper1%,oper2%)
    CASE "-"
      oper4%=SUB(oper1%,oper2%)
    CASE "/"
      IF oper2%=0
        oper4%=0
      ELSE
        oper4%=DIV(oper1%,oper2%)
      ENDIF
    CASE "*"
      oper4%=MUL(oper1%,oper2%)
    ENDSELECT
  ENDIF
  oper4$=STR$(oper4%,18)
  TEXT 100,75,oper3$
  TEXT 120,75,oper2$
  TEXT 200,75,"="
  TEXT 215,75,oper4$
RETURN
PROCEDURE operateur(ypos%,operateur$)
  COLOR blanc%,gris%
  SELECT oper3$
  CASE "/"
    texte.relache(420,20," / ")
  CASE "*"
    texte.relache(420,30," * ")
  CASE "-"
    texte.relache(420,40," - ")
  CASE "+"
    texte.relache(420,50," + ")
  CASE " "
    texte.relache(420,60,"<<<")
  CASE "  "
    texte.relache(420,70,"---")
  ENDSELECT
  IF LEN(operateur$)=1
    texte.enfonce(420,ypos%," "+operateur$+" ")
  ELSE
    texte.enfonce(420,ypos%,operateur$)
  ENDIF
  oper3$=operateur$
  COLOR marron%,outremer%
  WHILE MOUSEK
  WEND
RETURN
PROCEDURE saisie(xpos%,ypos%,lettre%,fond%,lencible%,VAR nombre$)
  posmot%=0             ! Curseur
  poslen%=1             ! Mot
  signe$=" "
  signe%=1
  nombre$=SPACE$(lencible%)
  COLOR outremer%
  DEC xpos%
  LINE xpos%,13,xpos%,62
  INC xpos%
  COLOR lettre%,fond%
  texte.relache(xpos%,ypos%,"_"+SPACE$(lencible%))
  $S%
  REPEAT                ! Saisie
    clavier$=""
    REPEAT
      clavier$=INKEY$
    UNTIL clavier$<>""
    SELECT clavier$     ! Lettre
    CASE 8              ! <­
      IF poslen%>1
        DEC poslen%
        SUB posmot%,8
        nombre$=LEFT$(nombre$,PRED(poslen%))+RIGHT$(nombre$,SUB(lencible%,poslen%))+SPACE$(1)
      ENDIF
    CASE 13
    CASE 32
      nombre$=SPACE$(lencible%)
      poslen%=1
      posmot%=0
    CASE 38             ! &
      IF poslen%=1
        nombre$="&   "
        poslen%=2
        posmot%=8
      ENDIF
    CASE 43             ! +
      IF poslen%=1
        signe$="+"
        signe%=1
      ENDIF
    CASE 45             ! -
      IF poslen%=1
        signe$="-"
        signe%=-1
      ENDIF
    CASE 48,49          ! 0,1
      nombre$=LEFT$(nombre$,PRED(poslen%))+clavier$+RIGHT$(nombre$,SUB(lencible%,poslen%))
      IF poslen%<lencible%
        INC poslen%
        ADD posmot%,8
      ENDIF
    CASE 50 TO 55       ! 2 à 7
      nombre$=LEFT$(nombre$,PRED(poslen%))+clavier$+RIGHT$(nombre$,SUB(lencible%,poslen%))
      IF AND(poslen%<lencible%,curseury%>20)
        INC poslen%
        ADD posmot%,8
      ENDIF
    CASE 56,57          ! 8,9
      nombre$=LEFT$(nombre$,PRED(poslen%))+clavier$+RIGHT$(nombre$,SUB(lencible%,poslen%))
      IF AND(poslen%<lencible%,curseury%>30)
        INC poslen%
        ADD posmot%,8
      ENDIF
    CASE 65 TO 70,97 TO 102 ! A à Z,a à z
      IF curseury%>40
        clavier$=UPPER$(clavier$)
        nombre$=LEFT$(nombre$,PRED(poslen%))+clavier$+RIGHT$(nombre$,SUB(lencible%,poslen%))
        IF poslen%<lencible%
          INC poslen%
          ADD posmot%,8
        ENDIF
      ENDIF
    CASE 127            ! Del
      SELECT poslen%
      CASE 1
        poslen%=1
        posmot%=0
        nombre$=SPACE$(lencible%)
      DEFAULT
        DEC poslen%
        SUB posmot%,8
        nombre$=LEFT$(nombre$,poslen%)+RIGHT$(nombre$,PRED(SUB(lencible%,poslen%)))+SPACE$(1)
      ENDSELECT
    CASE &H9B43         ! Flêche droite
      IF AND(poslen%<lencible%,MID$(nombre$,poslen%,1)<>SPACE$(1))
        INC poslen%
        ADD posmot%,8
      ENDIF
    CASE &H9B44         ! Flêche gauche
      IF poslen%>1
        DEC poslen%
        SUB posmot%,8
      ENDIF
    CASE &H9B2040       ! Shift Flêche droite
      poslen%=INSTR(1,nombre$,SPACE$(1))
      IF poslen%=0
        poslen%=lencible%
      ENDIF
      posmot%=SHL(PRED(poslen%),3)
    CASE &H9B2041       ! Shift Flêche gauche
      poslen%=1
      posmot%=0
    DEFAULT
      IF curseury%>50
        clavier$=UPPER$(clavier$)
        nombre$=LEFT$(nombre$,PRED(poslen%))+clavier$+RIGHT$(nombre$,SUB(lencible%,poslen%))
        IF poslen%<lencible%
          INC poslen%
          ADD posmot%,8
        ENDIF
      ENDIF
    ENDSELECT
    COLOR lettre%,fond%
    TEXT xpos%,ypos%,signe$+nombre$
    IF clavier$<>CHR$(13)        ! RETURN
      COLOR fond%,lettre% !outremer%
      TEXT ADD(xpos%,posmot%)+8,ypos%,MID$(nombre$,poslen%,1)
    ENDIF
  UNTIL clavier$=CHR$(13)
  $S%
  clavier$=""
  IF base$="$"
    nombre%=CVL(nombre$)
  ELSE
    nombre%=signe%*VAL(base$+nombre$)
  ENDIF
RETURN
PROCEDURE texte.enfonce(x1%,y1%,mot$)   ! Texte sur un bouton
  x1x2y1y2
  GRAPHMODE 2
  PBOX x1%,y1%,x2%,y2%
  GRAPHMODE 1
RETURN
PROCEDURE x1x2y1y2
  x2%=SHL&(LEN(mot$),3)
  ADD x2%,x1%
  y2%=ADD(y1%,2)
  DEC x1%
  SUB y1%,7
RETURN
PROCEDURE texte.relache(x1%,y1%,mot$)   ! Texte sur un bouton
  TEXT x1%,y1%,mot$
  x1x2y1y2
  relache.bouton(x1%,y1%,x2%,y2%)
RETURN
PROCEDURE relache.bouton(x1%,y1%,x2%,y2%)       ! Dessin de bouton relaché
  COLOR marron%         ! Ombre
  DRAW x1%,y2% TO x2%,y2% TO x2%,y1%
  COLOR blanc%          ! Brillant
  DRAW x1%,y2% TO x1%,y1% TO x2%,y1%
RETURN
'