' Numerus.ibas
{CREATORID "LDNU"}
{VERSION "2.2"}
{RESOURCEFILE "Numerus.rsrc"} 

DIM A(33)
DIM A$(33)

CONST A(27)=1
CONST A(28)=5
CONST A(29)=10
CONST A(30)=50
CONST A(31)=100
CONST A(32)=500
CONST A(33)=1000
CONST A$(27)="I"
CONST A$(28)="V"
CONST A$(29)="X"
CONST A$(30)="L"
CONST A$(31)="C"
CONST A$(32)="D"
CONST A$(33)="M"

BEGIN
GOSUB _LaunchNumerus
GOSUB _DrawNum
REPEAT
   E=DOEVENTS
   IF E>=1 IF E<=7 GOSUB _AddNum
   IF E>=11 IF E<=15 GOSUB _Calculate
   IF E=21 GOSUB _MClear
   IF E=22 GOSUB _MRelease
   IF E=23 GOSUB _MAdd
   IF E=24 GOSUB _CEReset
   IF E=25 GOSUB _CReset
   IF E=31 LET E=NOTICEBOX(2)
   IF E=32 LET E=NOTICEBOX(1) : IF E=2 LET E=NOTICEBOX(2)
   IF E=33 THEN
      E=NOTICEBOX(6)+2
      IF E<>6 LET E=NOTICEBOX(E)
   ENDIF
   IF E=34 THEN
      E=NOTICEBOX(7)
      IF E=1 CLIPBOARDPUT N$
      IF E=2 GOSUB _MClear : GOSUB _CReset
      IF E=3 LET F=10+F : F=NOTICEBOX(F)
      IF E=4 LET H=20+H : H=NOTICEBOX(H)
      IF E=5 GOSUB _SetLayout
   ENDIF
   IF E=-2 GOSUB _DrawNum
UNTIL E=-1
GOSUB _SavePrefs
END

_SetLayout:
   G=NOTICEBOX(31)
   IF G=1 THEN
      UPDATEPOS #2,26,90
      UPDATEPOS #6,98,90
      UPDATEPOS #5,62,54
      UPDATEPOS #7,98,54
      UPDATEPOS #3,26,54
      UPDATEPOS #4,62,90
      UPDATEPOS #2,26,90
   ELSE
      UPDATEPOS #2,98,90
      UPDATEPOS #4,26,90
      UPDATEPOS #3,62,90
      UPDATEPOS #7,26,54
      UPDATEPOS #5,98,54
      UPDATEPOS #6,62,54
      UPDATEPOS #2,98,90
   ENDIF
RETURN

_DrawForm:
   Z=SCREENMODES
   IF Z<3 THEN SCREEN 0
   ELSE SCREEN 3
   ENDIF
   Z=COLOR(0)
   W=COLOR(1)
   SETFONT 7
   BUTTON #1,"I",26,126,32,32
   IF G=1 THEN
      BUTTON #2,"V",26,90,32,32
      BUTTON #3,"X",26,54,32,32
      BUTTON #4,"L",62,90,32,32
      BUTTON #5,"C",62,54,32,32
      BUTTON #6,"D",98,90,32,32
      BUTTON #7,"M",98,54,32,32
   ELSE
      BUTTON #2,"V",98,90,32,32
      BUTTON #3,"X",62,90,32,32
      BUTTON #4,"L",26,90,32,32
      BUTTON #5,"C",98,54,32,32
      BUTTON #6,"D",62,54,32,32
      BUTTON #7,"M",26,54,32,32
   ENDIF
   SETFONT 2
   BUTTON #11,"+",134,135,24,23
   BUTTON #12,"–",134,108,24,23
   BUTTON #13,"×",134,81,24,23
   BUTTON #14,"/",134,54,24,23
   BUTTON #15,"=",62,126,68,32
   SETFONT 0
   BUTTON #21,"MC",2,54,20,17
   BUTTON #22,"MR",2,75,20,17
   BUTTON #23,"M+",2,96,20,17
   BUTTON #24,"CE",2,118,20,18
   BUTTON #25,"C",2,140,20,18
   BUTTON #31,"$",149,1,10,10
   SETFONT 1
   BUTTON #32,"i",136,1,10,10
   SETFONT 0
   BUTTON #33,"Help",107,1,26,10
   BUTTON #34,"Options",66,1,38,10
   LABEL #41,"",6,19
   SETFONT 1
   LABEL #42,"0",65,20
   LABEL #43,"",6,34
   COLOR W
   BOX 1,17 TO 159,51
   BOX 2,18 TO 158,50
   LINE 3,32  TO 157,32
   LINE 3,33  TO 157,33
RETURN

_LoadPrefs:
   K=LOADPREF(#1)
   L=LOADPREF(#2)
   M=LOADPREF(#3)
   Q=LOADPREF(#4)
   O=LOADPREF(#5)
   F=LOADPREF(#6)
   G=LOADPREF(#7)
   H=LOADPREF(#8)
   F=MAX(F,1)
   G=MAX(G,1)
   H=MAX(H,1)
   IF K=3 IF M=-1 LET M=0
RETURN

_LaunchNumerus:
   GOSUB _LoadPrefs
   GOSUB _DrawForm
   IF O=0 LET F=1 : K=1 : M=-1 : O=15 
RETURN

_ReverseNum:
   V=0
   FOR A=27 TO 33
      U$=A$(A)
      IF U$=V$ LET V=A(A)
   NEXT
RETURN

_CheckSubRule:
   V=0
   IF V$="IV" LET V=1
   IF V$="IX" LET V=1
   IF V$="XL" LET V=1
   IF V$="XC" LET V=1
   IF V$="CD" LET V=1
   IF V$="CM" LET V=1
RETURN

_CheckTriplet:
   V=0
   A=T MOD 10
   IF A=0 THEN
      IF R>=T LET V=1
   ELSE
      IF R>T LET V=1
   ENDIF
RETURN

_Concat2:
   V$=R$+S$
   GOSUB _CheckSubRule
   IF V=0 THEN
      V$=S$+T$
      GOSUB _CheckSubRule
      IF V=0 THEN
         IF S>=T LET U=T
      ELSE
         GOSUB _CheckTriplet
         IF V=1 LET U=-2*S+T
      ENDIF
   ELSE
      IF R>T LET U=T
   ENDIF
RETURN

_Concat1:
   V$=S$+T$
   GOSUB _CheckSubRule
   IF V=0 THEN
      IF S>=T LET U=T
   ELSE
      U=-2*S+T
ENDIF
RETURN

_ConcatMethod:
   R$=" " : S$=" " : U=LEN(N$)
   IF U>1 LET V=U-1 : R$=CHAR$(N$,V) : V$=R$ : GOSUB _ReverseNum : R=V
   IF U>0 LET S$=CHAR$(N$,U) : V$=S$ : GOSUB _ReverseNum : S=V
   T$=A$(E) : T=A(E)
   U=0
   IF R$=" " IF S$=" " LET U=T
   IF R$=" " IF S$<>" " GOSUB _Concat1
   IF R$<>" " GOSUB _Concat2
   IF U=0 THEN
      IF H=1 THEN V=NOTICEBOX(23)
      ELSE BEEP 1,2
      ENDIF
   ENDIF
RETURN

_AddNum:
   IF M=-1 LET M=0 : N$=""
   E=E+26
   IF F=1 THEN
      U=A(E)
   ELSE GOSUB _ConcatMethod
   ENDIF
   M=M+U
   IF M>99999 LET M=-1
   K=2 : E=-2
RETURN

_CalculateIt:
   IF O=11 LET L=L+M
   IF O=12 LET L=L-M
   IF O=13 LET L=L*M : IF L>99999 LET L=-1
   IF O=14 IF M=0 LET L=-1
   IF O=14 IF M<>0 LET L=L\M
   IF O=15 IF M>0 LET L=M
   O=E : M=-1
   K=1 : E=-2
RETURN

_Calculate:
   IF M=-1 IF O<>15 IF E=15 LET M=L : GOSUB _CalculateIt
   IF E>0 IF M=-1 IF O<>15 IF E<>15 LET O=E : E=0
   IF E>0 GOSUB _CalculateIt
RETURN

_SavePrefs:
   SAVEPREF #1,K
   SAVEPREF #2,L
   SAVEPREF #3,M
   SAVEPREF #4,Q
   SAVEPREF #5,O
   SAVEPREF #6,F
   SAVEPREF #7,G
   SAVEPREF #8,H
RETURN

_Convert1Num:
   A=P MOD 10
   IF A=1 LET N$="I"+N$
   IF A=2 LET N$="II"+N$
   IF A=3 LET N$="III"+N$
   IF A=4 LET N$="IV"+N$
   IF A=5 LET N$="V"+N$
   IF A=6 LET N$="VI"+N$
   IF A=7 LET N$="VII"+N$
   IF A=8 LET N$="VIII"+N$
   IF A=9 LET N$="IX"+N$
   B=P MOD 100 -A
   IF B=10 LET N$="X"+N$
   IF B=20 LET N$="XX"+N$
   IF B=30 LET N$="XXX"+N$
   IF B=40 LET N$="XL"+N$
   IF B=50 LET N$="L"+N$
   IF B=60 LET N$="LX"+N$
   IF B=70 LET N$="LXX"+N$
   IF B=80 LET N$="LXXX"+N$
   IF B=90 LET N$="XC"+N$
   C=P MOD 1000 -B -A
   IF C=100 LET N$="C"+N$
   IF C=200 LET N$="CC"+N$
   IF C=300 LET N$="CCC"+N$
   IF C=400 LET N$="CD"+N$
   IF C=500 LET N$="D"+N$
   IF C=600 LET N$="DC"+N$
   IF C=700 LET N$="DCC"+N$
   IF C=800 LET N$="DCCC"+N$
   IF C=900 LET N$="CM"+N$
   D=P MOD 10000 -C -B -A
   IF D=1000 LET N$="M"+N$
   IF D=2000 LET N$="MM"+N$
   IF D=3000 LET N$="MMM"+N$
   IF D=4000 LET N$="MMMM"+N$
RETURN

_Convert2Nums:
   P=N MOD 1000
   GOSUB _Convert1Num
   N$=".M "+N$
   P=N\1000
   GOSUB _Convert1Num
RETURN

_ConvertToRoman:
   IF N<=4999 THEN
      P=N
      GOSUB _Convert1Num
   ELSE GOSUB _Convert2Nums
   ENDIF
RETURN

_DrawNum:
   IF K=1 LET N=L
   IF K=2 LET N=M
   IF K=3 LET N=M : M=-1
   N$=""
   IF N>0 GOSUB _ConvertToRoman
   O$="" : M$=STR$(N,0)
   IF Q>0 LET O$="m"
   IF N<0 LET M$="error"
   COLOR Z
   BOXFILLED 3,19 TO 157,31
   BOXFILLED 3,34 TO 157,49
   UPDATELABEL #41,O$
   UPDATELABEL #42,M$
   UPDATELABEL #43,N$
RETURN

_CEReset:
   M=0
   K=3
   E=-2
RETURN

_CReset:
   L=0 : M=-1 : O=15
   K=1
   E=-2
RETURN

_MAdd:
   IF M<=0 THEN Q=Q+L
   ELSE Q=Q+M : L=M : M=-1
   ENDIF
   Q=MIN(Q,99999)
   K=1
   E=-2
RETURN

_MClear:
   Q=0
   IF M<=0 THEN K=1
   ELSE K=2
   ENDIF
   E=-2
RETURN

_MRelease:
   IF O=15 THEN L=Q : M=-1 : K=1
   ELSE M=Q : K=2
   ENDIF
   E=-2
RETURN
