Hi there!
Have you ever wondered about those Roman numerals in the copyright year shown at the end of British TV programmes, or in most film's credits, or any other where for that matter?
Well wonder no more. This short programme will produce the Arabic equivalent of any valid Roman numeral combination but remember, if you enter an invalid Roman numeral combination, you will get an incorrect answer.
I have posted the code here but it and the necessary media are in the attached .zip file.
[pbcode]
rem Tell PB to include the input support library
#include "Input"
rem Make variable visible from not only within the main program, but from within functions/sub's also
global c$
rem Load required media
backdropimage=loadnewimage("romanbackdrop.png")
rem Load required fonts
rem "Arial" font as font 2, of size 20, in bold style
rem "Arial" font as font 3, of size 40, in bold style
loadfont "Arial",2,20,1
loadfont "Arial",3,40,1
rem Set font
setfont 2
rem Determine the font height
fontheight=getfontheight(2)
rem Set ink colour
ink rgb(255,217,128)
rem Display an image
drawimage backdropimage,0,0,false
rem Write text to screen
text 250,fontheight*7,"Have you ever wondered about those Roman Numerals in the"
text 250,fontheight*8,"copyright year shown at the end of British TV programmes"
text 250,fontheight*9,"or in most film's credits or any other where for that matter? "
text 250,fontheight*10,"Well wonder no more. This short programme will produce"
text 250,fontheight*11,"the Arabic equivalent of any valid Roman Numeral combination."
rem Display screen
sync
rem A short wait before proceeding
wait 1000
rem Set down coordinate
down=270
rem Read in data statements
for a=1 to 13
across=20:down=down+fontheight*1
text across,down,readdata$()
next a
rem Write text to screen
centertext 400,560,"Click mouse to continue"
rem Display screen
sync
rem Wait for mouse click
Waitmouse false, (1+2)
mb=mousebutton()
rem Wait until the mouse button is released
WaitNoInput
rem Draw a box to hide previous text at location
boxc 0,290,798,590,1,rgb(255,0,0)
rem Restore data statements
restore restarthere
rem Set down coordinate
down=280
rem Read in remaining data statements
for a=14 to 25
across=20:down=down+fontheight*1
text across,down,readdata$()
next a
rem Write text to screen
centertext 400,560,"Click mouse to continue"
rem Display screen
sync
rem Wait for mouse click
Waitmouse false, (1+2)
mb=mousebutton()
rem Wait until the mouse button is released
WaitNoInput
rem Draw a box to hide previous text at location
boxc 0,290,798,590,1,rgb(255,0,0)
rem Restore data statements
restore thenhere
rem Set down coordinate
down=350
rem Read in remaining data statements
for a=26 to 26
across=20:down=down+fontheight*1
text across,down,readdata$()
next a
rem Write text to screen
centertext 400,560,"Click mouse to continue"
rem Display screen
sync
rem Wait for mouse click
Waitmouse false, (1+2)
mb=mousebutton()
rem Wait until the mouse button is released
WaitNoInput
rem Draw a box to hide previous text at location
boxc 0,290,798,590,1,rgb(255,0,0)
rem Programme main loop
do
rem Set variable 'an' (Arabic number) to zero
an=0
rem Set cursor position
setcursor 400-_
gettextwidth(" Key in a valid Roman Numeral combination (lower or upper case) > ")/2,340
rem Enter a valid Roman Numeral combination
romnum$=upper$(staticinput("Key in a valid Roman Numeral combination (lower or upper case) > "))
rem Determine length of the Roman Numeral
l=len(romnum$)
rem Declare array/s
dim an$(l+1)
rem Select each letter in the Roman Numeral and assign a value to the variables
for p=1 to l
select (mid$(romnum$,p,1))
case "M"
an$(p)="1000"
an=an+1000
case "D"
an$(p)="500"
an=an+500
case "C"
an$(p)="100"
an=an+100
case "L"
an$(p)="50"
an=an+50
case "X"
an$(p)="10"
an=an+10
case "V"
an$(p)="5"
an=an+5
case "I"
an$(p)="1"
an=an+1
endselect
next p
rem Determine if the letter following is greater than the current letter and
rem if so decrease the value of the variable 'an' (Arabic number)
for k=1 to l
if val(an$(k+1))>val(an$(k))
an=an-2*val(an$(k))
endif
next
rem Display the Arabic number equivalent
centertext 400,206+fontheight*10,"The Arabic number equivalent is "+str$(an)
rem Display screen
sync
rem A short wait before proceeding
wait 1000
rem Go to subroutine to check if Roman Numeral combination is valid
gosub validate
rem Draw a box to hide previous text at location
boxc 2,560,798,580,1,rgb(255,0,0)
rem Until the answer is Yes or No
repeat
rem Draw a box to hide previous text at location
boxc 2,206+fontheight*13,798,206+fontheight*15+fontheight,1,rgb(255,0,0)
rem Write text to screen
centertext 400,206+fontheight*13,"Try another?"
centertext 400,206+fontheight*16,"Left click mouse for Yes ... Right click mouse for No"
rem Display screen
sync
rem Wait for mouse click
Waitmouse false, (1+2)
mb=mousebutton()
rem Wait until the mouse button is released
WaitNoInput
select mb
case 1
answer$="Y"
case 2
answer$="N"
endselect
until answer$="Y" or answer$="N"
rem If answer is NO then exit loop
if answer$="N" then exitdo
rem *****************************************************************
rem If answer is YES then continue
rem *****************************************************************
rem Draw a box to hide previous text at location
boxc 0,340,798,590,1,rgb(255,0,0)
rem Display screen
sync
rem A short wait before proceeding
wait 1000
rem End programme main loop
loop
rem *****************************************************************
rem If answer is NO then end programme
rem *****************************************************************
rem Draw a box to hide previous text at location
boxc 0,340,798,590,1,rgb(255,0,0)
rem Set font
setfont 3
rem Write text to screen
centertext 400,360,"THANKS FOR PLAYING ... BYE!"
rem Display screen
sync
rem A short wait before proceeding
for times=1 to 4
wait 300
next times
rem End programme
end
rem *****************************************************************
rem Subroutine to check if Roman Numeral combination is valid
rem *****************************************************************
validate:
rem Convert a string of characters to a value.
x=val(str$(an))
arabic$=str$(x)
rem Go to subroutine to build Roman Numeral combination
gosub buildromnum
rem If validation is positive, set string variable to null and exit subroutine
if romnum$=num$ then num$="":return
rem If validation is negative
centertext 400,206+fontheight*13,"You entered an invalid Roman Numeral combination"
if val(arabic$)>3999
centertext 400,206+fontheight*15,"The Roman Numeral combination for "+arabic$+" is outside the scope"
else
centertext 400,206+fontheight*15,"The Roman Numeral combination for "+arabic$+" is "+num$
endif
rem Set string variables to null
arabic$=""
num$=""
rem Write text to screen
centertext 400,560,"Click mouse to continue"
rem Display screen
sync
rem Wait for mouse click
Waitmouse false, (1+2)
mb=mousebutton()
rem Wait until the mouse button is released
WaitNoInput
return
rem *****************************************************************
rem Subroutine to build Roman Numeral combination
rem *****************************************************************
buildromnum:
select len(arabic$)
case 1
n=VAL(MID$(arabic$,1,1))
roman4(n)
num$=num$+c$
case 2
n=VAL(MID$(arabic$,1,1))
roman3(n)
num$=num$+c$
n=VAL(MID$(arabic$,2,1))
roman4(n)
num$=num$+c$
case 3
n=VAL(MID$(arabic$,1,1))
roman2(n)
num$=num$+c$
n=VAL(MID$(arabic$,2,1))
roman3(n)
num$=num$+c$
n=VAL(MID$(arabic$,3,1))
roman4(n)
num$=num$+c$
case 4
n=VAL(MID$(arabic$,1,1))
roman1(n)
num$=num$+c$
n=VAL(MID$(arabic$,2,1))
roman2(n)
num$=num$+c$
n=VAL(MID$(arabic$,3,1))
roman3(n)
num$=num$+c$
n=VAL(MID$(arabic$,4,1))
roman4(n)
num$=num$+c$
endselect
return
rem *****************************************************************
rem Functions
rem *****************************************************************
function roman1(n)
rem Set string variable to null
c$=""
select n
case 1
c$="M"
case 2
c$="MM"
case 3
c$="MMM"
endselect
endfunction c$
function roman2(n)
rem Set string variable to null
c$=""
select n
case 1
c$="C"
case 2
c$="CC"
case 3
c$="CCC"
case 4
c$="CD"
case 5
c$="D"
case 6
c$="DC"
case 7
c$="DCC"
case 8
c$="DCCC"
case 9
c$="CM"
endselect
endfunction c$
function roman3(n)
rem Set string variable to null
c$=""
select n
case 1
c$="X"
case 2
c$="XX"
case 3
c$="XXX"
case 4
c$="XL"
case 5
c$="L"
case 6
c$="LX"
case 7
c$="LXX"
case 8
c$="LXXX"
case 9
c$="XC"
endselect
endfunction c$
function roman4(n)
rem Set string variable to null
c$=""
select n
case 1
c$="I"
case 2
c$="II"
case 3
c$="III"
case 4
c$="IV"
case 5
c$="V"
case 6
c$="VI"
case 7
c$="VII"
case 8
c$="VIII"
case 9
c$="IX"
endselect
endfunction c$
rem *****************************************************************
rem Data statements
rem *****************************************************************
data "What is a valid Roman Numeral combination?",""
data "The Simple Principle"
data "Roman Numerals are mathematically converted to Arabic numerals simply through the"
data "assignment of an Arabic numerical value to each letter and calculating a total.",""
data "For example: M=1000 | D=500 | C=100 | L=50 | X=10 | V=5 | I=1"
data "The letters (Roman Numerals) are arranged from left to right with each letter decreasing in value"
data "as you go 'down the line.' The totals are derived through adding the numerical equivalent of all"
data "the letters.",""
data "Therefore . . . MDCLXVI = 1000 + 500 + 100 + 50 + 10 + 5 + 1 = 1666."
data "The above example, however, does not give a full representation of present day convention."
restarthere:
data "The current rules regarding the use of Roman Numerals have been employed only in relatively"
data "recent times. It appears that the principle of 'subtraction' has always been used, but in earlier"
data "periods of history, the use of subtraction was an alternative to the more simplistic use addition."
data "","Today, the convention is to use the largest possible numeral within a sequence. Therefore, 15"
data "is XV and not VVV or XIIIII. Although Roman Numerals generally read from left to right in"
data "descending order, this leads to some extremely long sequences. (99 would be LXXXXVIIII.)",""
data "Be aware . . . only I, X, and C can be used this way. V, L, and D cannot. And, M cannot because"
data "it is the largest Roman Numeral available. Also, only a single smaller number can be placed to"
data "the left of a larger number. 18 cannot be written XIIX as it would be ambiguous and could be"
data "interpreted as 11 + 9 = 20 instead of 10 - 2 + 10 = 18."
thenhere:
data "Remember, if you enter an invalid Roman Numeral combination, you will get an incorrect answer."
[/pbcode]
:)
Enjoy
geecee
Hi there!
The above post has been updated ...... The programme now contains an in-built Roman Numerals checker and advises when an invalid entry has been made.
:)
Enjoy
geecee