ROMNUM - Converts Roman numeral combinations to Arabic numbers

[geecee]

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.

PlayBASIC Code: [Select]

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"

Login required to view complete source code

:)
Enjoy
geecee

[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