'OHRRPGCE GAME - In-App Purchases/Donations menu '(C) Copyright 1997-2013 James Paige and Hamster Republic Productions 'Please read LICENSE.txt for GPL License details and disclaimer of liability 'See README.txt for code docs and apologies for crappyness of this code ;) #include "config.bi" #include "allmodex.bi" #include "common.bi" #include "loading.bi" #include "gglobals.bi" #include "const.bi" #include "uiconst.bi" #include "game_udts.bi" #include "yetmore2.bi" #include "game.bi" #include "moresubs.bi" #include "purchase.bi" '=================================================================================================== DECLARE FUNCTION purchase_menu_create_product_slice(byval prod as NodePtr, byval parent as Slice Ptr) as bool DECLARE SUB purchase_menu_update_cursor(st as MenuState, byval parent as Slice Ptr) DECLARE SUB attempt_purchase (byval prod as NodePtr) DECLARE SUB attempt_purchase_paypal(byval prod as NodePtr) DECLARE SUB attempt_purchase_ouya(byval prod as NodePtr) DECLARE SUB increment_purchase_count(byval prod as NodePtr) DECLARE FUNCTION get_purchase_count_node(byval prod as NodePtr) as NodePtr DECLARE FUNCTION get_purchase_count(byval prod as NodePtr) as integer DECLARE SUB refresh_purchases_from_cache() DECLARE SUB refresh_purchases_ouya() DECLARE FUNCTION get_ouya_developer_id() as string DECLARE FUNCTION get_ouya_key_der() as string '=================================================================================================== CONST OUYA_STORE_TIMEOUT as double = 5.0 'seconds '=================================================================================================== SUB purchases_menu () DIM root as Slice Ptr root = NewSliceOfType(slSpecial) WITH *root .Fill = YES END WITH DrawSlice root, vpage DIM scroller as Slice Ptr scroller = NewSliceOfType(slContainer, root) scroller->Width = root->Width DIM st as MenuState st.active = YES st.need_update = YES DIM holdscreen as integer holdscreen = allocatepage copypage vpage, holdscreen DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM ouya_node as NodePtr = GetOrCreateChild(purchase_root, "ouya") DIM products as NodePtr = GetOrCreateChild(purchase_root, "products") DIM cur_node as NodePtr DIM prod_i as integer REDIM prod_nodes(0) as NodePtr REDIM prod_allowed(0) as bool show_virtual_gamepad() setkeys YES DO setwait 55 setkeys YES IF st.need_update THEN st.need_update = NO DeleteSliceChildren scroller prod_i = 0 READNODE products WITHNODE products."prod" as prod IF product_enabled_for_current_store(prod) THEN REDIM PRESERVE prod_nodes(prod_i) as NodePtr REDIM PRESERVE prod_allowed(prod_i) as bool prod_allowed(prod_i) = purchase_menu_create_product_slice(prod, scroller) prod_nodes(prod_i) = prod prod_i += 1 END IF END WITHNODE END READNODE IF prod_i = 0 THEN menusound gen(genCancelSFX) pop_warning "No enabled products were found" EXIT DO END IF scroller->Y = large(0, CINT(root->Height / 2 - scroller->Height / 2)) WITH st .first = 0 .last = scroller->NumChildren - 1 .pt = bound(.pt, .first, .last) '.first <= .last END WITH purchase_menu_update_cursor st, scroller END IF '--done updating menu control IF carray(ccMenu) > 1 THEN menusound gen(genCancelSFX) EXIT DO END IF IF game_usemenu(st) THEN menusound gen(genCursorSFX) END IF IF carray(ccUse) > 1 THEN IF prod_allowed(st.pt) THEN cur_node = prod_nodes(st.pt) attempt_purchase cur_node st.need_update = YES menusound gen(genAcceptSFX) ELSE menusound gen(genCancelSFX) END IF END IF st.tog = st.tog XOR 1 'No draw_menu happens, so do this manually purchase_menu_update_cursor st, scroller copypage holdscreen, vpage DrawSlice root, vpage setvispage vpage dowait LOOP ' Clear keypresses setkeys flusharray carray(), 7, 0 freepage holdscreen DeleteSlice @root tag_updates END SUB FUNCTION purchase_menu_create_product_slice(byval prod as NodePtr, byval parent as Slice Ptr) as bool 'Return YES if the product is allowed to be purchased DIM box as Slice Ptr box = NewSliceOfType(slRectangle, parent) WITH *box .width = 300 .height = 16 .PaddingTop = 4 .PaddingLeft = 4 .PaddingBottom = 4 .PaddingRight = 4 .AnchorHoriz = 1 .AlignHoriz = 1 END WITH ChangeRectangleSlice box, 14 ' For now, use the same box styles as the Load menu DIM prev as Slice Ptr prev = box->PrevSibling IF prev THEN box->Y = prev->Y + prev->Height + 4 END IF DIM count as integer = get_purchase_count(prod) DIM repeatable as bool = prod."repeatable".exists DIM allowed as bool = (repeatable ORELSE count = 0) DIM name_sl as Slice Ptr name_sl = NewSliceOfType(slText, box) ChangeTextSlice name_sl, prod."displayname".string, uilook(uiText), YES DIM desc_sl as Slice Ptr desc_sl = NewSliceOfType(slText, box) desc_sl->Y = 10 desc_sl->Width = box->Width - (box->PaddingLeft + box->PaddingRight) ChangeTextSlice desc_sl, prod."description".string, uilook(IIF(allowed, uiMenuItem, uiDisabledItem)), YES, YES IF count > 0 THEN DIM already_sl as Slice Ptr already_sl = NewSliceOfType(slText, box) already_sl->Y = 10 already_sl->Width = box->Width - (box->PaddingLeft + box->PaddingRight) DIM already_str as string = prod."already".string replacestr already_str, "${COUNT}", STR(count) ChangeTextSlice already_sl, already_str, uilook(uiSelectedDisabled), YES, YES '--move description down to make room desc_sl->Y += already_sl->Height END IF box->Height = box->PaddingTop + desc_sl->Y + desc_sl->Height + box->PaddingBottom parent->height = box->Y + box->Height RETURN allowed END FUNCTION SUB purchase_menu_update_cursor(st as MenuState, byval parent as Slice Ptr) DIM i as integer = 0 DIM box as Slice Ptr DIM name_sl as Slice Ptr DIM desc_sl as Slice Ptr box = parent->FirstChild DO WHILE box name_sl = box->FirstChild desc_sl = name_sl->NextSibling ChangeRectangleSlice box, IIF(st.pt = i, 1, 14) ChangeTextSlice name_sl, , IIF(st.pt = i, uilook(uiSelectedItem + st.tog), uilook(uiText)) 'ChangeTextSlice desc_sl, , IIF(st.pt = i, uilook(uiMenuItem), uilook(uiMenuItem)) IF st.pt = i THEN DIM dif as integer dif = (box->ScreenY + box->Height) - 200 IF dif > 0 THEN parent->Y -= small(ABS(dif), large(10, dif \ 2)) END IF dif = box->ScreenY - 0 IF dif < 0 THEN parent->Y += small(ABS(dif), large(10, dif \ 2)) END IF END IF box = box->NextSibling i += 1 LOOP END SUB FUNCTION get_enabled_store_name () as string 'Return a string indicating the enabled In-App purchase store 'for the currently running platform or "disabled" DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM stores as NodePtr = GetOrCreateChild(purchase_root, "stores_by_platform") IF running_on_ouya() THEN IF stores."ouya".exists THEN RETURN sanity_check_store_name(stores."ouya".string) END IF ELSEIF running_on_console() THEN 'We don't yet have any support for any Non-OUYA console payment backends 'And launching a browser for Paypal on Android doesn't work yet 'This will change if we ever have payment backends for GameStick or FireTV RETURN "disabled" ELSEIF running_on_mobile() THEN 'We don't yet have any support for any Android payment backends except the OUYA one 'And launching a browser for Paypal on Android doesn't work yet RETURN "disabled" ELSE IF stores."default".exists THEN RETURN sanity_check_store_name(stores."default".string) END IF END IF RETURN "disabled" END FUNCTION FUNCTION sanity_check_store_name(storename as string) as string SELECT CASE storename CASE "ouya": IF running_on_ouya() THEN RETURN storename CASE "paypal": IF NOT running_on_ouya() THEN RETURN storename END SELECT IF storename <> "" THEN debuginfo "Unknown store name: """ & storename & """" END IF RETURN "disabled" END FUNCTION FUNCTION product_enabled_for_current_store(byval prod as NodePtr) as bool 'Returns YES if there is enough information to *attempt* to buy this product 'from the current store. Can't guarantee that the information is correct. DIM storename as string = get_enabled_store_name() IF storename = "disabled" THEN RETURN NO SELECT CASE storename CASE "paypal": IF prod."paypal".exists THEN DIM paypal as NodePtr = prod."paypal".ptr IF paypal."button_id".exists THEN IF LEN(paypal."button_id".string) > 1 THEN RETURN YES END IF END IF END IF CASE "ouya": IF prod."ouya".exists THEN DIM ouya as NodePtr = prod."ouya".ptr IF ouya."identifier".exists THEN IF LEN(ouya."identifier".string) > 1 THEN RETURN YES END IF END IF END IF END SELECT RETURN NO END FUNCTION SUB attempt_purchase (byval prod as NodePtr) IF prod = 0 THEN debug "attempt_purchase: null prod node" RETURN END IF DIM storename as string = get_enabled_store_name() SELECT CASE storename CASE "disabled": debug "Attempted to purchase """ & prod."displayname".string & """ but no store is enabled for this platform" CASE "paypal": attempt_purchase_paypal prod CASE "ouya": attempt_purchase_ouya prod CASE ELSE debug "Store """ & storename & """ is unknown" END SELECT END SUB SUB attempt_purchase_paypal(byval prod as NodePtr) IF NOT prod."paypal".exists THEN pop_warning "Paypal data node is missing" EXIT SUB END IF DIM paypal_node as NodePtr paypal_node = prod."paypal".ptr IF NOT paypal_node."button_id".exists THEN pop_warning "Paypal button_id node is missing" EXIT SUB END IF DIM url as string url = "https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=" url &= paypal_node."button_id".string IF NOT open_url(url) THEN EXIT SUB ' browser open failed DIM choices(1) as string = {"Yes, payment complete", "No, payment cancelled"} DIM num as integer DIM t as double = TIMER DO num = multichoice("A browser window was opened to Paypal. When you have completed the payment, return to this window to continue.", choices(), 0, -1) LOOP WHILE num < 0 IF num = 1 THEN EXIT SUB ' purchase cancelled IF TIMER - t < 10 THEN IF NOT yesno("Really? That was awfully fast. This payment system works on the honor system, but logging into paypal and completing a payment in less than 10 seconds is a little hard to swallow. Did you really do it?", YES, YES) THEN EXIT SUB END IF END IF increment_purchase_count prod do_purchase_action prod END SUB SUB attempt_purchase_ouya(byval prod as NodePtr) IF NOT running_on_ouya() THEN pop_warning "Cannot use OUYA store when not running on OUYA platform" EXIT SUB END IF IF NOT prod."ouya".exists THEN pop_warning "OUYA Store data node is missing" EXIT SUB END IF DIM ouya_node as NodePtr ouya_node = prod."ouya".ptr IF NOT ouya_node."identifier".exists THEN pop_warning "OUYA product identifier node is missing" EXIT SUB END IF DIM dev_id as string = get_ouya_developer_id() IF dev_id = "" THEN pop_warning "OUYA developer ID is missing" EXIT SUB END IF DIM identifier as string = ouya_node."identifier".string IF identifier = "" THEN pop_warning "OUYA product identifier is missing" EXIT SUB END IF DIM key_der as string = get_ouya_key_der() IF key_der = "" THEN pop_warning "OUYA key.der is missing" EXIT SUB END IF ouya_purchase_request dev_id, identifier, key_der progress_spinner @ouya_purchase_is_ready, "Talking to OUYA Discover Store...", OUYA_STORE_TIMEOUT IF NOT ouya_purchase_is_ready() THEN pop_warning "OUYA Purchase request for """ & identifier & """ timed out. Unable to communicate with the OUYA store." EXIT SUB END IF IF ouya_purchase_succeeded() THEN increment_purchase_count prod do_purchase_action prod ELSE 'purchase was canceled by the user (no need to alert) END IF END SUB FUNCTION get_ouya_key_der() as string DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM ouya_node as NodePtr = GetOrCreateChild(purchase_root, "ouya") RETURN ouya_node."key.der".string END FUNCTION FUNCTION get_ouya_developer_id() as string DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM ouya_node as NodePtr = GetOrCreateChild(purchase_root, "ouya") RETURN ouya_node."developer_id".string END FUNCTION 'Applies the benefit of a purchase; once purchased, this is called every newgame/loadgame SUB do_purchase_action (byval prod as NodePtr, byval new_purch as bool=YES) DIM buy_action as NodePtr = prod."buy_action".ptr IF buy_action = 0 THEN pop_warning "No buy_action node" EXIT SUB END IF IF new_purch THEN DIM thanks as string thanks = buy_action."thanks".string IF thanks = "" THEN thanks = "Thank you!" END IF pop_warning thanks END IF DIM tagnum as integer tagnum = buy_action."tag".integer IF tagnum > 0 THEN IF tagnum = 1 THEN pop_warning "Can't change tag number 1!" settag tagnum, YES END IF DIM g as integer g = buy_action."global".integer IF g > 0 THEN IF g > UBOUND(global) THEN pop_warning "Global " & g & " is out of range." ELSE global(g) = get_purchase_count(prod) END IF END IF END SUB SUB increment_purchase_count(byval prod as NodePtr) IF prod = 0 THEN debug "increment_purchase_count: null prod ptr" EXIT SUB END IF DIM count_node as NodePtr = get_purchase_count_node(prod) IF count_node = 0 THEN debug "increment_purchase_count: Something went wrong while trying to get count node" EXIT SUB END IF SetContent(count_node, GetInteger(count_node) + 1) write_persist_reld() END SUB FUNCTION get_purchase_count(byval prod as NodePtr) as integer IF prod = 0 THEN debug "get_purchase_count: null prod ptr" RETURN 0 END IF DIM count_node as NodePtr = get_purchase_count_node(prod) IF count_node = 0 THEN debug "get_purchase_count: Something went wrong while trying to get count node" RETURN 0 END IF RETURN GetInteger(count_node) END FUNCTION FUNCTION get_purchase_count_node(byval prod as NodePtr) as NodePtr IF prod = 0 THEN debug "get_purchase_count_node: null prod ptr" RETURN 0 END IF DIM id as string DIM storename as string = get_enabled_store_name() SELECT CASE storename CASE "disabled": debug "get_purchase_count_node: for """ & prod."displayname".string & """ but no store is enabled for this platform" RETURN 0 CASE "paypal": id = "button_id" CASE "ouya": id = "identifier" CASE ELSE debug "Store """ & storename & """ is unknown" RETURN 0 END SELECT IF NOT GetChildNodeExists(prod, storename) THEN debug "get_purchase_count_node: """ & prod."displayname".string & """ has no store node for " & storename RETURN 0 END IF DIM prod_store_node as NodePtr = GetOrCreateChild(prod, storename) IF NOT GetChildNodeExists(prod_store_node, id) THEN debug "get_purchase_count_node: """ & prod."displayname".string & """ has no " & storename & " " & id & " node" RETURN 0 END IF DIM prod_id_node as NodePtr = GetOrCreateChild(prod_store_node, id) IF GetString(prod_id_node) = "" THEN debug "get_purchase_count_node: """ & prod."displayname".string & """ has blank " & storename & " " & id & " node" RETURN 0 END IF DIM persist as NodePtr = get_persist_reld() DIM purchase_cache as NodePtr = GetOrCreateChild(persist, "purchase_cache") DIM store_node as NodePtr = GetOrCreateChild(purchase_cache, storename) DIM id_node as NodePtr = GetOrCreateChild(store_node, GetString(prod_id_node)) DIM count_node as NodePtr = GetOrCreateChild(id_node, "count") RETURN count_node END FUNCTION FUNCTION get_persist_reld() as NodePtr 'Returns the root node of the persist.reld lump. 'Opens it up if it is not already open. IF persist_reld_doc = 0 THEN 'First run, we must open the doc DIM filename as string = prefsdir & SLASH & "persist.reld" IF isfile(filename) THEN persist_reld_doc = LoadDocument(filename, optNoDelay) IF persist_reld_doc = 0 THEN debuginfo "persist.reld not present, creating" persist_reld_doc = CreateDocument() END IF END IF DIM root_node as NodePtr root_node = DocumentRoot(persist_reld_doc) IF root_node = 0 THEN root_node = CreateNode(persist_reld_doc, "persist") SetRootNode(persist_reld_doc, root_node) END IF write_persist_reld() return root_node END FUNCTION SUB write_persist_reld() 'Writes changes to the persist.reld file IF persist_reld_doc THEN DIM filename as string = prefsdir & SLASH & "persist.reld" SerializeBin filename, persist_reld_doc END IF END SUB SUB close_persist_reld() 'There should be no need to call write_persist_reld() here, because all changes ought to be saved immediately '(otherwise a crash could erase a purchase). write_persist_reld() IF persist_reld_doc THEN FreeDocument persist_reld_doc persist_reld_doc = 0 END IF END SUB FUNCTION supports_in_app_purchases () as bool DIM storename as string = get_enabled_store_name() RETURN storename <> "disabled" END FUNCTION SUB refresh_purchases() 'This should be run whenever a save game is loaded or when a new game is started. DIM storename as string = get_enabled_store_name() SELECT CASE storename CASE "disabled": EXIT SUB CASE "paypal": refresh_purchases_from_cache() CASE "ouya": refresh_purchases_ouya() refresh_purchases_from_cache() CASE ELSE debug "refresh_purchases: unknown store name """ & storename & """" EXIT SUB END SELECT END SUB SUB refresh_purchases_from_cache() DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM products as NodePtr = GetOrCreateChild(purchase_root, "products") DIM count as integer READNODE products WITHNODE products."prod" as prod IF product_enabled_for_current_store(prod) THEN count = get_purchase_count(prod) debuginfo " Product: " & prod."displayname".string & " " & count IF count >= 1 THEN do_purchase_action(prod, NO) END IF END IF END WITHNODE END READNODE END SUB SUB refresh_purchases_ouya() IF fadestate = NO THEN setpal master() END IF IF NOT running_on_ouya() THEN pop_warning "Cannot use OUYA store when not running on OUYA platform" EXIT SUB END IF DIM dev_id as string = get_ouya_developer_id() IF dev_id = "" THEN pop_warning "OUYA developer ID is missing" EXIT SUB END IF DIM key_der as string = get_ouya_key_der() IF key_der = "" THEN pop_warning "OUYA key.der is missing" EXIT SUB END IF ouya_receipts_request(dev_id, key_der) progress_spinner @ouya_receipts_are_ready, "Talking to OUYA Discover Store...", OUYA_STORE_TIMEOUT DIM results as string results = ouya_receipts_result() REDIM lines(0) as string split results, lines() DIM gen_root as NodePtr = get_general_reld() DIM purchase_root as NodePtr = GetOrCreateChild(gen_root, "purchase_root") DIM products as NodePtr = GetOrCreateChild(purchase_root, "products") DIM count_node as NodePtr READNODE products WITHNODE products."prod" as prod IF product_enabled_for_current_store(prod) THEN WITHNODE prod."ouya" as ouya FOR i as integer = 0 TO UBOUND(lines) IF lines(i) = ouya."identifier".string THEN 'A receipt was found for this product debuginfo "An OUYA recept was found for """ & prod."displayname".string & """" count_node = get_purchase_count_node(prod) IF GetInteger(count_node) < 1 THEN SetContent(count_node, 1) END IF NEXT i END WITHNODE END IF END WITHNODE END READNODE END SUB