Superdecade Games: October 2014

Source Code for the Reverse Polish Notation Calculator for any interested parties, or students of computing. You will need the full version of BB4Win and copies of the library files indicated below. Full downloads can be found on the downloads page.
Find the downloads page here - follow this link.
REM RPN Calculator
REM calculates expressions entered in Reverse Polish Notation
REM by T Street
REM!Resource @dir$+"rpn7.res"

(_Version_Info_)
GAME_NAME$ = "RPN Calculator"
VERSION$ = "1.07"
HELPFILE$ = "RPNhelp7.html"
REM 2013-12-03
REM 2013-12-13 version 1.02
REM COPY command added. Copies accumulator to the clipboard
REM Bug fixed with NOT function. Now multiplies by -1
REM 2013-12-13 version 1.03
REM Number bases supported 16, 8, 10, 2
REM accumulate on/off (ACC ON/ACC OFF)
REM last keyword : last value of the accumulator as a variable 'last'
REM 2014-02-26 version 1.04
REM Octadecimal changed to Octal (base 8)
REM := assignment operator becomes =
REM = operator becomes ==
REM 2014-10-03 version 1.05
REM Windows OS commands added
REM 2014-10-08 version 1.06
REM new colour scheme
REM 2014-10-08 version 1.07
REM cmd commands added

*float 64
PROMPT$ = "Enter RPN expression, command or URL (or type 'HELP') : "
WELCOME$ = "Welcome to the RPN Calculator."
ON ERROR SYS "MessageBox", @hwnd%, REPORT$ + " at line " + STR$ERL, "Fatal Error", 48:QUIT

REM - Talk to me if you are having problems with these three files...
INSTALL @lib$+"utilities6"
INSTALL @lib$+"stringlib"
INSTALL @lib$+"readline"

VDU 23,22,900;400;13,13,16,0 : REM screen MODE
OFF
PROC_setWindowTitle(GAME_NAME$+" "+VERSION$+" by T Street")
PROC_preventResize
*font Courier New, 13
PROC_colours

SW% = 58 : REM Screen Width
ALPHABET% = 26 : REM number of letters in alphabet
REM setup the stack
SIZE_OF_STACK% = 100 : REM why not? NB we have 101 items here, much more than we need
REM a stack object has:
REM a stack (of strings)
REM a size of the stack
REM TOS pointer%
REM a message
REM an accumulator
DIM stack{ array$( SIZE_OF_STACK% ), var$(ALPHABET%-1), SIZE_OF_STACK%, pointer%, message$, acc, base%, accumulate% }
stack.base% = 10 : REM start in base 10
PROC_main( stack{} )
STOP

DEFPROC_main( stack{} )
REM main loop
LOCAL user$ : REM user input
LOCAL leave%: REM controls whether can leave the main loop
stack.message$ = WELCOME$
PROC_clearMemory( stack{} )
REPEAT
REM show output
PROC_pageSetup( stack{} )
PROC_reset( stack{} ) : REM reset the stack
user$ = FN_getUserInput : REM get user input
REM process user input
CASE TRUE OF
WHEN FN_upper(user$) = "HELP"
IF FN_fileExists(HELPFILE$) THEN
stack.message$ = "Help file loaded in your browser. Also, please see www.tinyurl.com/superdecade "
PROC_openDocument(HELPFILE$)
ELSE
stack.message$ = "Help file not found. Try www.tinyurl.com/superdecade "
ENDIF

WHEN FN_upper(user$) = "HEX"
stack.base% = 16
stack.message$ = "Switched to HEXADECIMAL mode"

WHEN FN_upper(user$) = "OCT"
stack.base% = 8
stack.message$ = "Switched to OCTAL mode"

WHEN FN_upper(user$) = "BIN"
stack.base% = 2
stack.message$ = "Switched to BINARY mode"

WHEN FN_upper(user$) = "DEN"
stack.base% = 10
stack.message$ = "Switched to DENARY mode"

WHEN FN_upper(user$) = "ACC OFF"
stack.accumulate% = FALSE
stack.message$ = "Accumulator off"

WHEN FN_upper(user$) = "ACC ON"
stack.accumulate% = TRUE
stack.message$ = "Accumulator on"

WHEN FN_upper(user$) = "CLEAR"
stack.acc = 0
stack.message$ = "Memory cleared."
PROC_clearMemory( stack{} )

WHEN FN_upper(user$) = "QUIT"
QUIT

WHEN FN_upper(user$) = "COPY"
stack.message$ = "Copied to clipboard."
REM ficed in version 1.5 - copies in correct base
IF stack.base%<>10 THEN
PROC_toClipboard(FN_tobase( stack.acc, stack.base%, 16 DIV stack.base%))
ELSE
PROC_toClipboard(STR$(stack.acc))
ENDIF

REM new in version 1.5
WHEN FN_upper(user$) = "SET TIME" : OSCLI ("time")
stack.message$ = "Set time dialogue invoked."

WHEN FN_upper(user$) = "SET DATE" : OSCLI ("date")
stack.message$ = "Set date dialogue invoked."

WHEN FN_upper(user$) = "PROGRAMS" : OSCLI ("appwiz.cpl")
stack.message$ = "Add/remove programs dialogue invoked."

WHEN FN_upper(user$) = "ADMIN" : OSCLI ("control admintools")
stack.message$ = "Admin tools dialogue invoked."

WHEN FN_upper(user$) = "SOUND" : OSCLI("mmsys.cpl")
stack.message$ = "Sound dialogue invoked."

WHEN FN_upper(user$) = "VERSION"
stack.message$ = GAME_NAME$+" version "+VERSION$ + " " + FN_getWindowsVersion

WHEN FN_upper(user$) = "FILES" : OSCLI("explorer")
stack.message$ = "Windows explorer invoked."

WHEN FN_upper(user$) = "POWER"
stack.message$ = FN_powerStatus

WHEN FN_upper(user$) = "CP" : OSCLI ("control panel")
stack.message$ = "Control panel invoked."

WHEN LEFT$(FN_upper(user$), 6) = "GOOGLE" PROC_google(FN_trim(RIGHT$(FN_upper(user$),LEN(FN_upper(user$))-7)))
stack.message$ = "I sent your search query to Google."

WHEN LEFT$(FN_upper(user$), 4) = "BING" PROC_bing(FN_trim(RIGHT$(FN_upper(user$),LEN(FN_upper(user$))-4)))
stack.message$ = "I sent your search query to Bing."

WHEN LEFT$(FN_upper(user$),4) = "WWW." PROC_openDocument( user$ )
stack.message$ = "Attempted to open a web resource."

WHEN LEFT$(FN_upper(user$),4) = "HTTP" PROC_openDocument( user$ )
stack.message$ = "Attempted to open a web resource."

WHEN LEFT$(FN_upper(user$),10 )= "FREE SPACE" PROC_freeSpace( RIGHT$(FN_upper(user$),1), stack.message$):

WHEN FN_upper(user$) = "MAGNIFIER" : OSCLI("magnify")
stack.message$ = "Magnifier invoked."

WHEN FN_upper(user$) = "NOTEPAD" OR FN_upper(user$) = "WORDPAD" : OSCLI("write")
stack.message$ = "Wordpad invoked."

WHEN FN_upper(user$) = "HELLO"
stack.message$ = "Hello, human."

WHEN FN_upper(user$) = "TASKS"
OSCLI("control schedtasks")

stack.message$ = "Windows task scheduler launched."

WHEN LEFT$(FN_upper(user$), 4) = "PING" PROC_ping(FN_trim(RIGHT$(FN_upper(user$),LEN(FN_upper(user$))-4)))
stack.message$ = "Ping sent."

WHEN LEFT$(FN_upper(user$),3) = "CMD" stack.message$ = FN_winCmd( FN_trim( RIGHT$( FN_upper(user$), LEN(FN_upper(user$))-3 ) ) )

OTHERWISE
IF stack.accumulate% THEN
stack.acc += FN_evaluate( user$, stack{}, success% )
ELSE
stack.acc = FN_evaluate( user$, stack{}, success% )
ENDIF
stack.message$ = RED$+stack.message$+" " +BLACK$+"'"+user$+"'"
ENDCASE
UNTIL leave%
ENDPROC

DEF FN_winCmd(cli$)
LOCAL ch%,eErr$,tmp$,tempStr$:tmp$=FN_specialFolder(5)+"\"+STR$TIME+".tmp"
OSCLI "cmd /c "+cli$+" 2>"+tmp$
ch%=OPENIN(tmp$):IF ch%=0:="Could not complete request."
WHILE NOTEOF#ch%
INPUT#ch%, tempStr$
eErr$ += (tempStr$+" ")
ENDWHILE
eErr$ = FN_removeCRLF( eErr$)
CLOSE#ch%:OSCLI"Delete "+tmp$
REMproc_OK(eErr$)
=eErr$

DEFFN_evaluate( this$, stack{}, RETURN success% )
REM takes a string from the user and evaluates it as an RPN expression
ON ERROR LOCAL stack.message$ = REPORT$ : success% = FALSE : = 0
LOCAL term$() : DIM term$(1)
LOCAL parts%
LOCAL item$ : REM operand
LOCAL n% , leave%
parts% = FN_split( this$, " ", term$() )
WHILE n% < parts% AND NOTleave%
IF (FN_toDenary(term$(n%), stack.base%)=0 AND LEFT$(term$(n%),1)<>"0" AND stack.base%<>10) OR(stack.base% = 10 AND VAL(term$(n%))=0 AND LEFT$(term$(n%),1)<>"0") THEN
REM operator
CASE FN_lower(term$(n%)) OF
WHEN "pi"
IF NOTFN_push( STR$(PI), stack{} ) THEN
leave% = TRUE
ENDIF

WHEN "time"
IF NOTFN_push( STR$(TIME), stack{} ) THEN
leave% = TRUE
ENDIF

WHEN "last"
IF NOTFN_push( STR$(stack.acc), stack{} ) THEN
leave% = TRUE
ENDIF

WHEN"a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"

IF NOTFN_push( stack.var$(ASC(FN_upper(term$(n%)))-65), stack{} ) THEN
leave% = TRUE
ENDIF

WHEN "="
IF n% = parts%-1 THEN
leave% = TRUE
ELSE
IF FN_pop(item$, stack{} ) THEN
stack.var$( ASC(FN_upper(term$(n%+1)))-65 ) = item$
ELSE
leave% = TRUE
ENDIF
ENDIF

WHEN "+","-","/","*","^","div","mod","and","eor","or","=="
IF NOTFN_findValue( stack{}, " "+FN_upper(term$(n%))+" " ) THEN
leave% = TRUE
ENDIF

WHEN"abs","acs","asn","atn","cos","deg","exp","inv","int","ln","log","not","rad","rnd","sgn","sin","sqr","tan","round"
IF NOTFN_findFunction( stack{}, FN_upper(term$(n%))) THEN
leave% = TRUE
ENDIF

OTHERWISE
leave% = FALSE
stack.message$ = "Unknown operator. "
ENDCASE
ELSE
REM operand
IF stack.base%<>10 THEN
IF NOTFN_push( STR$FN_toDenary(term$(n%), stack.base%), stack{} ) THEN
leave% = TRUE
ENDIF
ELSE
IF NOTFN_push( term$(n%), stack{} ) THEN
leave% = TRUE
ENDIF

ENDIF
ENDIF
n% += 1
ENDWHILE
IF NOTleave% THEN
REM the stack should just contain the answer
IF stack.pointer% = 1 THEN
success% = TRUE
= VAL( stack.array$(0) )
ELSE
success% = FALSE
stack.message$ += "Insufficient Operators."
= 0
ENDIF
ELSE
REM failed to find answer
success% = FALSE
= 0
ENDIF

DEFFN_findValue( stack{}, operator$ )
REM evalutes the operation passed in operator$
REM by popping the two values from the stack
REM and performing the infix operation upon them
ON ERROR LOCAL stack.message$ = "Fatal error with operation : "+operator$+". "+REPORT$: = FALSE
LOCAL a$, b$
IF FN_pop( b$, stack{}) THEN
IF FN_pop(a$, stack{} ) THEN
REM might need to change the values based on the current mode
REM have operands, now find operator
CASE operator$ OF
WHEN "="
IF VAL(a$) = VAL(b$) THEN
IF FN_push( "-1", stack{}) THEN
= TRUE
ENDIF
ELSE
IF FN_push( "0", stack{} ) THEN
= TRUE
ENDIF
ENDIF

OTHERWISE
IF FN_push( STR$EVAL(a$+operator$+b$), stack{} ) THEN
= TRUE
ENDIF
ENDCASE
ENDIF
ENDIF
stack.message$ += (" Error with operation : "+operator$+".")
= FALSE

DEFFN_findFunction( stack{}, operator$ )
ON ERROR LOCAL stack.message$ = "Fatal error with function : "+operator$+". "+REPORT$: = FALSE
REM evalutes the operation passed in operator$
REM by popping the first value from the stack
REM and performing the infix operation upon them
LOCAL e$,f, a$
IF FN_pop(a$, stack{} ) THEN
CASE operator$ OF
WHEN "ROUND"
IF FN_push( STR$(FN_round(VAL(a$))), stack{} ) THEN
= TRUE
ENDIF
WHEN "NOT"  : REM overides NOT
IF VAL(a$)= 0 THEN
IF FN_push( "-1", stack{} ) THEN
= TRUE
ENDIF
ELSE
IF FN_push( "0", stack{} ) THEN
= TRUE
ENDIF
ENDIF
WHEN "INV"
IF FN_push( STR$(1/(VAL(a$))), stack{} ) THEN
= TRUE
ENDIF

OTHERWISE
e$ = operator$+"("+a$+")"
f = EVAL(e$)
IF FN_push( STR$(f), stack{} ) THEN
= TRUE
ENDIF
ENDCASE
ENDIF
stack.message$ += (" Error with "+operator$+" function.")
= FALSE

DEF PROC_clearMemory( stack{} )
REM sets the values of all the user-defined variables to zero
LOCAL n%
FOR n% = 0 TO ALPHABET% - 1
stack.var$(n%) = "0"
NEXT
REM and resets the internal clock
TIME = 0
ENDPROC

DEFFN_push( item$, stack{} )
ON ERROR LOCAL stack.message$ = "Fatal error stack.push : "+REPORT$: = FALSE
REM pushes the item onto the stack
REM returns true if the push was successful
REM returns false if the push was unsuccessful
IF stack.pointer% > SIZE_OF_STACK% THEN
REM unable to push to the stack, so return with a warning message
stack.message$ = "No room on stack. "
= FALSE
ENDIF
stack.array$( stack.pointer% ) = item$
stack.pointer% += 1
= TRUE

DEFFN_pop( RETURN item$, stack{} )
ON ERROR LOCAL stack.message$ = "Fatal error stack.pop : "+REPORT$: = FALSE
REM pops the item off the stack
REM returns the item popped.
IF stack.pointer% <= 0 THEN
REM unable to pop (nothing to pop)
stack.message$ = "Stack is empty. "
= FALSE
ENDIF
stack.pointer% -= 1
item$ = stack.array$( stack.pointer%)
= TRUE

DEFPROC_reset( stack{} )
REM reset the stack
stack.pointer% = 0
stack.message$ = ""
ENDPROC

DEF FN_getUserInput
ON ERROR LOCAL stack.message$ = "Fatal error with user input : "+REPORT$: = FALSE
REM gets player's input
LOCAL s$
COLOUR CYAN%:*font Courier New, 16b
REM input viewport coords
VDU 28,3,14,65,9
COLOUR BLUE%+128 : CLS
PRINT PROMPT$
PRINT"> ";:COLOURYELLOW%
PROC_soak
*font Courier New, 18b
s$ = FN_ReadLine
COLOURWHITE%
*font Courier New, 14
= FN_trim(s$)

DEFFN_toDenary( code$, base%)
LOCAL size%
size% = LEN(code$)
LOCAL n%: REM iterator
LOCAL v%: REM value of each digit in the hex string passed
LOCAL t : REM running total
FOR n% = size%-1 TO 0 STEP -1
v% = INSTR("0123456789ABCDEF",FN_upper(MID$(code$, size%-n%, 1))) - 1
IF v%>=0 AND v%<base% THEN
t += (v%*base%^n%)
ELSE
= 0 : REM breakout
ENDIF
NEXT
= t

DEFFN_myTime( t$ )
REM returns a formatted time from the string passed
REM pass a time$
LOCAL a$
CASE LEFT$(t$, 3) OF
WHEN "Mon" a$ = "Monday"
WHEN "Tue" a$ = "Tuesday"
WHEN "Wed" a$ = "Wednesday"
WHEN "Thu" a$ = "Thursday"
WHEN "Fri" a$ = "Friday"
WHEN "Sat" a$ = "Saturday"
WHEN "Sun" a$ = "Sunday"
ENDCASE
a$ = a$ + " "+ MID$(t$, 5, 11) + " > " +MID$(t$, 17, 5)
= a$

DEFPROC_pageSetup( stack{} )
ON ERROR LOCALPRINTTAB(0,4)BLACK$"---> ";:COLOUR RED%+128:PRINTWHITE$" ERROR '"+REPORT$+"'. ":ENDPROC

LOCAL out$
VDU 26
COLOUR BLACK%+128 : CLS : COLOUR WHITE%
REM output view port coords
*font Courier New, 16b

PRINT TAB(3,16)LIGHTGRAY$" superdecade.blogspot.com > "FN_myTime( TIME$ )
*font Courier New, 32b
PRINTTAB(0,0)WHITE$" RPN Calculator ";
CASE stack.base% OF
WHEN 16
PRINT"(HEXADECIMAL)";
WHEN 10
PRINT"(DENARY)";
WHEN 8
PRINT"(OCTAL)";
WHEN 2
PRINT"(BINARY)";
ENDCASE
IF stack.accumulate% THEN
PRINT"(ACC)"
ELSE
PRINT
ENDIF

*font Courier New, 16b

VDU 28,3,7,65,3

COLOUR CYAN%+128 : CLS

PROC_ww(BLACK$+LEFT$(">"+stack.message$, 2*SW%-8) , SW% )

IF stack.base%<>10 THEN
out$ = FN_tobase( stack.acc, stack.base%, 16 DIV stack.base%)
ELSE
out$ = STR$(stack.acc)
ENDIF

PRINTTAB(0,3)BLACK$"---> ";:COLOUR GREY%+128:PRINTWHITE$" "out$" "

ENDPROC

DEFPROC_colours
COLOUR 1, 220,20,0 : RED% = 1
COLOUR 2, 220,220,220 : WHITE% = 2
COLOUR 3, 200,200,0 : YELLOW% = 3
COLOUR 4, 10,200,20 : GREEN% = 4
COLOUR 5, 0,10,230 : BLUE% = 5
COLOUR 6, 1,1,1 : BLACK% = 6
COLOUR 8, 200,0,200 : MAGENTA% = 8
COLOUR 9, 40,40,40 : GRAY% = 9 : GREY% = GRAY%
COLOUR 10, 0,0,0 : BLACK% = 10
COLOUR 11, 0, 200,200 : CYAN% = 11
COLOUR 12, 150,150,150 : LIGHTGRAY% = 12
GREEN$=CHR$(17)+CHR$(GREEN%)
RED$=CHR$(17)+CHR$(RED%)
YELLOW$=CHR$(17)+CHR$(YELLOW%)
CYAN$=CHR$(17)+CHR$(CYAN%)
WHITE$=CHR$(17)+CHR$(WHITE%)
MAGENTA$ = CHR$(17)+CHR$(MAGENTA%)
BLUE$ = CHR$(17)+CHR$(BLUE%)
GREY$ = CHR$(17)+CHR$(GREY%)
BLACK$ = CHR$(17)+CHR$(BLACK%)
LIGHTGRAY$ = CHR$(17)+CHR$(LIGHTGRAY%)
ENDPROC

DEFFN_message(caption$,message$,symbol%,type%)
REM Displays a message box
REM Returns a value relating to user selection
REM params
REM caption$ - title for message box
REM message$ - the message
REM
REM symbol%
REM 16 Stop symbol
REM 32 Question mark
REM 48 Exclamation mark
REM 64 Information symbol
REM
REM type%
REM 0 OK
REM 1 OK and Cancel
REM 2 Abort, Retry and Ignore
REM 3 Yes, No and Cancel
REM 4 Yes and No
REM 5 Retry and Cancel
REM 6 Cancel, Try Again and Continue (Windows 2000 or later only)
REM
REM The return value of result% will be one of the following depending on user choice:
REM 1 OK
REM 2 Cancel
REM 3 Abort
REM 4 Retry
REM 5 Ignore
REM 6 Yes
REM 7 No
REM 10 Try Again
REM 11 Continue
LOCAL result%
SYS "MessageBox", @hwnd%, message$, caption$, (symbol%+type%) TO result%
=result%

DEFPROC_OK( t$ )
REM creates an OK message box
REM using the message stored in t$
IF FN_message( GAME_NAME$, t$, 64, 0 )
ENDPROC

DEFFN_powerStatus
REM returns a string containing the current power status
LOCAL sps{}
LOCAL message$
DIM sps{ACLineStatus&, BatteryFlag&, BatteryLifePercent&, Reserved1&, \
\ BatteryLifeTime%, BatteryFullLifeTime%}
SYS "GetSystemPowerStatus", sps{}
CASE sps.ACLineStatus& OF
WHEN 0: message$="Operating from batteries. "
WHEN 1: message$="Operating on mains. "
ENDCASE
CASE sps.BatteryFlag& OF
WHEN 1: message$+="Battery charge status is high. "
WHEN 2: message$+="Battery charge status is low. "
WHEN 4: message$+="Battery charge status is critical. "
WHEN 8: message$+="Battery is charging. "
WHEN 128: message$+="No battery fitted. "
ENDCASE
IF sps.BatteryLifeTime%<>-1 THEN
message$=message$ + "Approx remaining battery life is "+ \
\   STR$(sps.BatteryLifeTime% DIV 60 )+" mins."
ENDIF
IF sps.BatteryFullLifeTime%<>-1 THEN
message$=message$ +"Approx battery life when fully charged is "+ \
\   STR$(sps.BatteryFullLifeTime% DIV 60)+ " mins."
ENDIF
= message$

DEFPROC_google( t$ )
PROC_openDocument("https://www.google.co.uk/search?q="+t$)
ENDPROC

DEFPROC_bing( t$ )
PROC_openDocument("https://www.bing.com/search?q="+t$)
ENDPROC

DEFPROC_ping( t$)
OSCLI("ping "+t$)
ENDPROC

DEF FN_getWindowsVersion
LOCAL a$
LOCAL osci{}
DIM osci{Size%, \ Size of structure
\ Major%, \ Major version number
\ Minor%, \ Minor Version number
\ Build%, \ Build number
\ Platform%, \ Platform ID
\ SP&(127) \ Service Pack string
\ }
osci.Size% = 148
SYS "GetVersionEx", osci{}
CASE TRUE OF
WHEN osci.Major% = 4 AND osci.Minor% = 0
a$ = "95"
WHEN osci.Major% = 4 AND osci.Minor% = 10
a$ = "98"
WHEN osci.Major% = 4 AND osci.Minor% = 90
a$ = "Me"
WHEN osci.Major% = 4 AND osci.Minor% <>0 AND osci.Minor%<>10 AND osci.Minor%<>90
a$ = "NT4"
WHEN osci.Major% = 5 AND osci.Minor% = 0
a$ = "2000"
WHEN osci.Major% = 5 AND osci.Minor% = 1
a$ = "XP"
WHEN osci.Major% = 6 AND osci.Minor% = 0
a$ = "Vista"
WHEN osci.Major% = 6 AND osci.Minor% = 1
a$ = "7"
WHEN osci.Major% = 6 AND osci.Minor% = 2
a$ = "8"
WHEN osci.Major% = 6 AND osci.Minor% = 3
a$ = "8.1"
OTHERWISE a$ = "(unknown)"
ENDCASE
= "Windows "+a$+" (build "+STR$(osci.Build%)+")"

DEFPROC_freeSpace( mydrive$, RETURN message$ )
drive$ = mydrive$+":\"
SYS "GetDiskFreeSpace", drive$, ^SpC%, ^BpS%, ^Free%, ^Total%
gbytes_total = SpC% * BpS% * Total% / 2^30
gbytes_free = SpC% * BpS% * Free% / 2^30
message$ = "Total "+STR$INTgbytes_total+"GB, Available "+STR$INTgbytes_free+"GB, Used "+STR$INT(gbytes_total-gbytes_free)+"GB"
ENDPROC

Happy Helloween

Happy Halloween

ButtonBass

History of computing timeline

Computer Abuser

Colour meaning for logos and business cards

Source Code for Reverse Polish calculator

Label