[added] payment by Hooded Silence

locations/journal.qsrc

@@ -125,7 +125,6 @@ if $ARGS[0] = 'housingtab':
 ! housing
 end
 
-end
 
 if $ARGS[0] = 'relationstab':
     $jumploc = 'relationstab'

locations/shortgs.qsrc

@@ -1,12 +1,12 @@
 # shortgs
 
-!! following function counts the number of guys which PC slept with. 
+!! following function counts the number of guys which PC slept with.
 !! use func('shortgs','guy') or func('shortgs','guy',X) for subset (X can be 'A','B','C','AB','AC','BC')
 if $ARGS[0] = 'guy':
 	r_sht=0
 	if $ARGS[1] = '': $temptask = 'ABC' else $temptask = $ARGS[1]
 	:loop_shtty
-	$temptaskchar = mid($temptask,1,1) 
+	$temptaskchar = mid($temptask,1,1)
 	$temptask = mid($temptask,2,len($temptask)-1)
 	s_sht=0
 	:loop_shya
@@ -29,7 +29,7 @@ if $ARGS[0] = 'girl':
 	r_sht=0
 	if $ARGS[1] = '': $temptask = 'ABC' else $temptask = $ARGS[1]
 	:loop_shttl
-	$temptaskchar = mid($temptask,1,1) 
+	$temptaskchar = mid($temptask,1,1)
 	$temptask = mid($temptask,2,len($temptask)-1)
 	s_sht=0
 	:loop_shl
@@ -46,21 +46,21 @@ if $ARGS[0] = 'girl':
 	killvar 's_sht'
 end &! --- girl ---
 
-!! following procedure should be used when PC gets naked, but it should be paired with the reverse procedure 
+!! following procedure should be used when PC gets naked, but it should be paired with the reverse procedure
 !! use gs 'shortgs','undress'
 if $ARGS[0] = 'undress':
 	gs 'underwear', 'remove'
 	gs 'clothing','strip'
 end &! --- undress ---
 
-!! reverse procedure, it can be modified for lose or stolen panties later. 
+!! reverse procedure, it can be modified for lose or stolen panties later.
 !! use gs 'shortgs','dress'
 if $ARGS[0] = 'dress':
 	gs 'clothing','wear_last_worn'
 	gs 'underwear', 'wear'
 end &! --- dress ---
 
-!! procedure, which prevents PC to leave a room naked.  
+!! procedure, which prevents PC to leave a room naked.
 !! use gs 'shortgs','checkdress',' <<$loc>>,<<$loc_arg>> '  or equivalent
 if $ARGS[0] = 'checkdress':
 	if $clothingworntype = 'nude':
@@ -82,7 +82,7 @@ if $ARGS[0] = 'sqrt':
 		sqrtn1 = (sqrtn + sqrtnum / sqrtn) / 2
 		jump 'sqrtloop'
 	end
-	result = sqrtn  
+	result = sqrtn
 end
 
 !! this function calculates modul of given arguments as it was coordinates in cartezian systeme
@@ -111,7 +111,7 @@ if $ARGS[0] = 'dow':
 	result = dummy
 end
 !! day of year
-!! use xdoy = func('shortgs','doy',year,month,day) 
+!! use xdoy = func('shortgs','doy',year,month,day)
 if $ARGS[0] = 'doy':
 	doy_N1 = 275 * ARGS[2] / 9
 	doy_N2 = (ARGS[2] + 9) / 12
@@ -142,8 +142,8 @@ if $ARGS[0] = 'mk1':
 :tabmcl1
 	if empty1 > 0: empty1 -=1 & $tabmc +='<td>&nbsp</td>' & jump 'tabmcl1'
 :tabmcl2
-	if full1 > 0: 
-		full1 -=1 
+	if full1 > 0:
+		full1 -=1
 		if $MenCal[count]='0': $tabmc +='<td bgcolor="red"><<$mk_subst[$MenCal[count]]>></td>' else $tabmc +='<td><<$mk_subst[$MenCal[count]]>></td>'
 		count +=1
 		jump 'tabmcl1'
@@ -257,8 +257,8 @@ if $ARGS[0] = 'mk':
 	$mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc21'
 	i = 0
 :tabmc21a
-	$mk1_mdays[i+first_month_first_day_week-1] = $str(i+1) 
-	i += 1 
+	$mk1_mdays[i+first_month_first_day_week-1] = $str(i+1)
+	i += 1
 	if i < prev_month_length: jump 'tabmc21a'
 
 	$prev_month_name = $mid($monthName[prev_month],1,1) + '<br>' + $mid($monthName[prev_month],2,1) + '<br>' + $mid($monthName[prev_month],3,1)
@@ -274,8 +274,8 @@ if $ARGS[0] = 'mk':
 	j = 7
 	if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$prev_month_name>></td>'
 :tabmc23
-	if j > 0: 
-		j -=1 
+	if j > 0:
+		j -=1
 		if $mk1_mdays[k]='&nbsp':
 			$tabmc +='<td><<$mk1_mdays[k]>></td>'
 		else
@@ -283,7 +283,7 @@ if $ARGS[0] = 'mk':
 			r +=1
 		end
 		k +=1
-		jump 'tabmc23' & !<<$MenCalCopy[r]>> 
+		jump 'tabmc23' & !<<$MenCalCopy[r]>>
 	end
 	if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc22'
 	killvar '$mk1_mdays'
@@ -300,15 +300,15 @@ if $ARGS[0] = 'mk':
 	end
 	second_month_first_day_week = week - (dif_days mod 7)
 	second_month_first_day_index = length_of_month_field -1 - dif_days
-	
+
 	if second_month_first_day_week < 1: second_month_first_day_week += 7
 	i = 42
 	:tabmc31
 	$mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc31'
 	i = 0
 :tabmc31a
-	$mk1_mdays[i+second_month_first_day_week-1] = $str(i+1) 
-	i += 1 
+	$mk1_mdays[i+second_month_first_day_week-1] = $str(i+1)
+	i += 1
 	if i < cur_month_length: jump 'tabmc31a'
 
 	$cur_month_name = $mid($monthName[month],1,1) + '<br>' + $mid($monthName[month],2,1) + '<br>' + $mid($monthName[month],3,1)
@@ -321,7 +321,7 @@ if $ARGS[0] = 'mk':
 	j = 7
 	if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$cur_month_name>></td>'
 :tabmc33
-	if j > 0: 
+	if j > 0:
 		j -=1
 		if $mk1_mdays[k]='&nbsp':
 			$tabmc +='<td><<$mk1_mdays[k]>></td>'
@@ -329,13 +329,13 @@ if $ARGS[0] = 'mk':
 			if day + second_month_first_day_week - 2 = k: $tabmc +='<td<<$MenCalCopy[r]>> ><u><b><<$mk1_mdays[k]>></b></u></td>' else $tabmc +='<td<<$MenCalCopy[r]>> ><<$mk1_mdays[k]>></td>'
 			r +=1
 		end
-		k +=1 
+		k +=1
 		jump 'tabmc33'
 	end
 	if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc32'
 	killvar '$mk1_mdays'
 	killvar '$mk1_mdays_color'
-	
+
 !! next month
 	if month = 12:
 		dif_days = 31 - day + 1
@@ -352,16 +352,16 @@ if $ARGS[0] = 'mk':
 	end
 	next_month_first_day_week = week + (dif_days mod 7)
 	next_month_first_day_index = length_of_month_field -1 - dif_days
-	
+
 	if next_month_first_day_week < 1: next_month_first_day_week += 7
 	i = 35
 :tabmc41
 	$mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc41'
 	i = 0
 :tabmc41a
-	$mk1_mdays[i+next_month_first_day_week-1] = $str(i+1) 
+	$mk1_mdays[i+next_month_first_day_week-1] = $str(i+1)
 !!	if next_month_first_day_index + i >= 0: $mk1_mdays[i+next_month_first_day_week-1] += $mk_subst[$MenCal[second_month_first_day_index + i]]
-	i += 1 
+	i += 1
 	if i < next_month_length: jump 'tabmc41a'
 
 	$next_month_name = $mid($monthName[next_month],1,1) + '<br>' + $mid($monthName[next_month],2,1) + '<br>' + $mid($monthName[next_month],3,1)
@@ -374,7 +374,7 @@ if $ARGS[0] = 'mk':
 	j = 7
 	if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$next_month_name>></td>'
 :tabmc43
-	if j > 0: 
+	if j > 0:
 		j -=1
 		if $mk1_mdays[k]='&nbsp':
 			$tabmc +='<td><<$mk1_mdays[k]>></td>'
@@ -388,7 +388,7 @@ if $ARGS[0] = 'mk':
 	if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc42'
 	killvar '$mk1_mdays'
 
-	
+
 	$tabmc += '</tr><table></font></center>'
 	$tabmc
 	act 'Back': gt 'restoreposition'
@@ -396,7 +396,7 @@ end
 
 !! gs 'shortgs','fonts'
 if $ARGS[0] = 'fonts':
-	if $ARGS[1] = 'refresh': 
+	if $ARGS[1] = 'refresh':
 		jump 'fontsloop'
 	else
 		$dynamicreturn = $ARGS[1]
@@ -405,7 +405,7 @@ if $ARGS[0] = 'fonts':
 	end
 	gs 'saveposition'
 	$fontlist[] = 'Lucida' & $fontlist[] = 'Ariel' & $fontlist[] = 'Tahoma' & $fontlist[] = 'Verdana' & $fontlist[] = 'Courier New' & $fontlist[] = 'Courier' & $fontlist[] = 'Georgia' & $fontlist[] = 'Times New Roman' & $fontlist[] = 'Garamond' & $fontlist[] = 'Bookman' & $fontlist[] = 'Times New Roman' & $fontlist[] = 'Times' & $fontlist[] = 'Comic Sans MS' & $fontlist[] = 'Trebuchet MS' & $fontlist[] = 'Impact' & $fontlist[] = 'BankGothic'
-	$fontcolor[] = 'aqua' & $fontcolor[] = 'black' & $fontcolor[] = 'blue' & $fontcolor[] = 'magenta' & $fontcolor[] = 'green' & $fontcolor[] = 'gray' & $fontcolor[] = 'lime' & $fontcolor[] = 'maroon' & $fontcolor[] = 'navy' & $fontcolor[] = 'olive' & $fontcolor[] = 'purple' & $fontcolor[] = 'red' & $fontcolor[] = 'silver' & $fontcolor[] = 'teal' & $fontcolor[] = 'white' & $fontcolor[] = 'yellow' 
+	$fontcolor[] = 'aqua' & $fontcolor[] = 'black' & $fontcolor[] = 'blue' & $fontcolor[] = 'magenta' & $fontcolor[] = 'green' & $fontcolor[] = 'gray' & $fontcolor[] = 'lime' & $fontcolor[] = 'maroon' & $fontcolor[] = 'navy' & $fontcolor[] = 'olive' & $fontcolor[] = 'purple' & $fontcolor[] = 'red' & $fontcolor[] = 'silver' & $fontcolor[] = 'teal' & $fontcolor[] = 'white' & $fontcolor[] = 'yellow'
 	i = 15
 :fontsloop0
 	if $CurFont = $fontlist[i]: curfont = i
@@ -425,7 +425,7 @@ if $ARGS[0] = 'fonts':
 	'<a href="exec:$CurItalic = iif($CurItalic ! ''<i>'',''<i>'','' '') & $CurItalicBack = iif($CurItalic = ''<i>'',''</i>'','' '') & gs ''shortgs'',''fonts'',''refresh'' ">Change the ItalicState</a>'
 	'<a href="exec:CurfontSize -= 1 & gs ''shortgs'',''fonts'',''refresh'' ">Decrease the Font</a>&nbsp&nbsp&nbsp<a href="exec:CurfontSize += 1 & gs ''shortgs'',''fonts'',''refresh'' ">Increase the font</a>'
 
-	act 'Back': 
+	act 'Back':
 		killvar '$fontlist'
 		killvar '$fontcolor'
 		dynamic '<<$OpenPhraseSave>> = $OpenPhrase'
@@ -534,21 +534,21 @@ if $ARGS[0] = 'testsize':
 	'npc_sex = ' + arrsize('npc_sex')
 	'npc_sexskill = ' + arrsize('npc_sexskill')
 	'npc_spermpot = ' + arrsize('npc_spermpot')
-	
+
 	'npc_herpes = ' + arrsize('npc_herpes')
 	'npc_syth = ' + arrsize('npc_syth')
 	'npc_gon = ' + arrsize('npc_gon')
 	'npc_thrush = ' + arrsize('npc_thrush')
-	
-	
+
+
 	'npc_apt_type = ' + arrsize('npc_apt_type')
 	'npc_apt_number = ' + arrsize('npc_apt_number')
-	
+
 	'$npc_apt_bedroom = ' + arrsize('$npc_apt_bedroom')
 	'$npc_apt_kitchen = ' + arrsize('$npc_apt_kitchen')
 	'$npc_apt_livingroom = ' + arrsize('$npc_apt_livingroom')
 	'$npc_apt_bathroom = ' + arrsize('$npc_apt_bathroom')
-	
+
 	'npc_perv = ' + arrsize('npc_perv')
 	'npc_finance = ' + arrsize('npc_finance')
 	'npc_humor = ' + arrsize('npc_humor')
@@ -754,5 +754,91 @@ if $ARGS[0] = 'clothing_state':
 	end
 end
 
+! Author - Hooded Silence
+! Date created - 26 Aug 22
+! Payment system - Used to pay for items in various game locations
+!
+! command syntax: gs 'shortgs', 'payments', value, 'method', 'item variable', item quantity, 'item description', 'return location', 'act'
+!
+! $ARGS[1] - Value = cost of goods
+! $ARGS[2] - Method = how it''s to be paid cash or card. leave blank for both.
+! $ARGS[3] - Item Variable = item variable to be purchase to add to players inventory - Optional.
+! $ARGS[4] - Item Quantity = How many items to be added. Defaults to one - Optional.
+! $ARGS[5] - Item Description - What's been bought
+! $ARGS[6] - Return Location - Where do you want the character to go to
+! $ARGS[7] - Act - If there's a specific act to go to.
+
+!Use stock image for the purchase screen?
+if $ARGS[0] = 'payments':
+
+	if $ARGS[1] = '':
+		'Error, Cash Value not set'
+	end
+	if $ARGS[5] = '':
+		'Error, Item Description not set'
+	end
+
+	pay_value = $ARGS[1]
+	$pay_method = $ARGS[2]
+	$pay_variable = $ARGS[3]
+	pay_quantity = $ARGS[4]
+	$pay_desc = $ARGS[5]
+	$pay_section = $ARGS[6]
+	$pay_act = $ARGS[7]
+
+	! Construct payment call
+
+! Construct payment call
+
+	if $pay_variable ! '':
+		$construct_cash = 'exec: gs ''shortgs'', ''paymentcomplete'', ''<<$pay_section>>'', ''<<$pay_act>>'', ''<<pay_value>>'', ''<<$pay_desc>>'', ''cash'' & money -= <<pay_value>> & <<$pay_variable>> += <<pay_quantity>>'
+		$construct_card = 'exec: gs ''shortgs'', ''paymentcomplete'', ''<<$pay_section>>'', ''<<$pay_act>>'', ''<<pay_value>>'', ''<<$pay_desc>>'', ''card'' & karta -= <<pay_value>> & <<$pay_variable>> += <<pay_quantity>>'
+	else
+		$construct_cash = 'exec: gs ''shortgs'', ''paymentcomplete'', ''<<$pay_section>>'', ''<<$pay_act>>'', ''<<pay_value>>'', ''<<$pay_desc>>'', ''cash'' & money -= <<pay_value>>'
+		$construct_card = 'exec: gs ''shortgs'', ''paymentcomplete'', ''<<$pay_section>>'', ''<<$pay_act>>'', ''<<pay_value>>'', ''<<$pay_desc>>'', ''card'' & karta -= <<pay_value>>'
+	end
+
+
+
+	$pay_cash = '<a href="<<$construct_cash>>">Cash</a>'
+	$pay_card = '<a href="<<$construct_card>>">Card</a>'
+
+	!Use stock image for the purchase screen?
+
+	if ($pay_method ! 'cash' or $pay_method ! 'card') and pay_value <= money and pay_value <= karta:
+		'How do you want to pay for the services or item? <<$pay_cash>> or <<$pay_card>>'
+	elseif ($pay_method = 'cash' or $paymethod = '') and pay_value <= money:
+		'Pay for the services or item with <<$pay_cash>>?'
+	elseif  ($pay_method = 'card' or $pay_method = '') and pay_value <= karta:
+		'Pay for the services or item with your <<$pay_card>>?'
+	else
+		'You don''t have enough money in your purse or bank account for this item.'
+	end
+
+end
+
+!payment complete
+if $ARGS[0] = 'paymentcomplete':
+	cla & *clr
+	gs 'stat'
+	'Thank you for your custom. Please come again!'
+	*nl
+
+	if $ARGS[5] = 'cash':
+		$pay_type = 'You paid <<$ARGS[3]>> <b>₽</b> in cash'
+	else
+		$pay_type = 'You paid <<$ARGS[3]>> <b>₽</b> with your bank card'
+	end
+
+	'<<$pay_type>> for your <<$ARGS[4]>>'
+
+	gs 'stat'
+
+	if $ARGS[1] ! '': $loc = $ARGS[1]
+    if $ARGS[2] ! '': $loc_arg = $ARGS[2]
+	if $ARGS[1] ! '' : act 'Finish payment' : gt $loc, $loc_arg
+
+end
+
 --- shortgs ---------------------------------