shortgs.qsrc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735
  1. # shortgs
  2. !! following function counts the number of guys which PC slept with.
  3. !! use func('shortgs','guy') or func('shortgs','guy',X) for subset (X can be 'A','B','C','AB','AC','BC')
  4. if $ARGS[0] = 'guy':
  5. r_sht=0
  6. if $ARGS[1] = '': $temptask = 'ABC' else $temptask = $ARGS[1]
  7. :loop_shtty
  8. $temptaskchar = mid($temptask,1,1)
  9. $temptask = mid($temptask,2,len($temptask)-1)
  10. s_sht=0
  11. :loop_shya
  12. if s_sht<=dyneval("result = <<$temptaskchar>>arraynumber"):
  13. s_sht += 1
  14. if npc_sex['<<$temptaskchar>><<s_sht>>'] > 0: r_sht = r_sht + iif(npc_gender['<<$temptaskchar>><<s_sht>>'] = 0,1,0)
  15. jump 'loop_shya'
  16. end
  17. if len($temptask) > 0:jump 'loop_shtty'
  18. result = r_sht
  19. killvar 'r_sht'
  20. killvar '$temptask'
  21. killvar '$temptaskchar'
  22. killvar 's_sht'
  23. end &! --- guy ---
  24. !! following function counts the number of girls which PC slept with.
  25. !! use func('shortgs','girl') or func('shortgs','girl',X) for subset (X can be 'A','B','C','AB','AC','BC')
  26. if $ARGS[0] = 'girl':
  27. r_sht=0
  28. if $ARGS[1] = '': $temptask = 'ABC' else $temptask = $ARGS[1]
  29. :loop_shttl
  30. $temptaskchar = mid($temptask,1,1)
  31. $temptask = mid($temptask,2,len($temptask)-1)
  32. s_sht=0
  33. :loop_shl
  34. if s_sht<=dyneval("result = <<$temptaskchar>>arraynumber"):
  35. s_sht += 1
  36. if npc_sex['<<$temptaskchar>><<s_sht>>'] > 0: r_sht = r_sht + iif(npc_gender['<<$temptaskchar>><<s_sht>>'] = 1,1,0)
  37. jump 'loop_shl'
  38. end
  39. if len($temptask) > 0: jump 'loop_shttl'
  40. result = r_sht
  41. killvar 'r_sht'
  42. killvar '$temptask'
  43. killvar '$temptaskchar'
  44. killvar 's_sht'
  45. end &! --- girl ---
  46. !! following procedure should be used when PC gets naked, but it should be paired with the reverse procedure
  47. !! use gs 'shortgs','undress'
  48. if $ARGS[0] = 'undress':
  49. gs 'clothing','strip'
  50. gs 'underwear', 'remove'
  51. end &! --- undress ---
  52. !! reverse procedure, it can be modified for lose or stolen panties later.
  53. !! use gs 'shortgs','dress'
  54. if $ARGS[0] = 'dress':
  55. gs 'clothing','wear_last_worn'
  56. gs 'underwear', 'wear'
  57. end &! --- dress ---
  58. !! procedure, which prevents PC to leave a room naked.
  59. !! use gs 'shortgs','checkdress',' <<$loc>>,<<$loc_arg>> ' or equivalent
  60. if $ARGS[0] = 'checkdress':
  61. if $clothingworntype = 'nude':
  62. msg '<b><font color="red">You need to get dressed before going out.</font></b>'
  63. dynamic 'gt <<$ARGS[1]>>'
  64. end
  65. end &! --- checkdress ---
  66. !! this is an integer sqrt function
  67. !! call func('shortgs','sqrt', n)
  68. if $ARGS[0] = 'sqrt':
  69. sqrtnum = ARGS[1]
  70. if sqrtnum = 0: result = 0 & exit
  71. sqrtn = sqrtnum/2 + 1
  72. sqrtn1 = (sqrtn + sqrtnum / sqrtn) / 2
  73. :sqrtloop
  74. if sqrtn1 < sqrtn:
  75. sqrtn = sqrtn1
  76. sqrtn1 = (sqrtn + sqrtnum / sqrtn) / 2
  77. jump 'sqrtloop'
  78. end
  79. result = sqrtn
  80. end
  81. !! this function calculates modul of given arguments as it was coordinates in cartezian systeme
  82. !! use func('shortgs','modul',n1,n2,..n8)
  83. if $ARGS[0] = 'modul':
  84. modul_sum = ARGS[1]*ARGS[1]+ARGS[2]*ARGS[2]+ARGS[3]*ARGS[3]+ARGS[4]*ARGS[4]+ARGS[5]*ARGS[5]+ARGS[6]*ARGS[6]+ARGS[7]*ARGS[7]+ARGS[8]*ARGS[8]
  85. result = func('shortgs','sqrt',modul_sum)
  86. killvar 'modul_sum'
  87. end
  88. !! day of week 1 - Monday .. 7 - Sunday
  89. if $ARGS[0] = 'dow':
  90. if ARGS[1]=0:
  91. D_dow = day
  92. M_dow = month
  93. Y_dow = year
  94. else
  95. D_dow = ARGS[3]
  96. M_dow = ARGS[2]
  97. Y_dow = ARGS[1]
  98. end
  99. dow_a = (14 - M_dow) / 12
  100. dow_Y = Y_dow - dow_a
  101. dow_M = M_dow + 12*dow_a - 2
  102. dummy = (D_dow + dow_y + dow_y/4 - dow_y/100 + dow_y/400 + (31*dow_m)/12) mod 7
  103. if dummy = 0: dummy = 7
  104. result = dummy
  105. end
  106. !! day of year
  107. !! use xdoy = func('shortgs','doy',year,month,day)
  108. if $ARGS[0] = 'doy':
  109. doy_N1 = 275 * ARGS[2] / 9
  110. doy_N2 = (ARGS[2] + 9) / 12
  111. doy_N3 = 1 + (ARGS[1] - 4 * (ARGS[1] / 4) + 2) / 3
  112. result = doy_N1 - (doy_N2 * doy_N3) + ARGS[3] - 30
  113. end
  114. if $ARGS[0] = 'mk1':
  115. gs 'saveposition'
  116. *clr & cla
  117. $mk_subst['0'] = 'M' & $mk_subst['1'] = 'F' & $mk_subst['2'] = 'O' & $mk_subst['3'] = 'L' & $mk_subst['4'] = 'R' & $mk_subst['5'] = 'P'
  118. '<center><font face="courier" size=1>'
  119. '<table border = 1>'
  120. '<tr><th>Mon</th><th>Tue</th><th>Wen</th><th>Thu</th><th>Fri</th><th>Sat</th><th>Sun</th><th>Mon</th><th>Tue</th><th>Wen</th><th>Thu</th><th>Fri</th><th>Sat</th><th>Sun</th>
  121. <th>Mon</th><th>Tue</th><th>Wen</th><th>Thu</th><th>Fri</th><th>Sat</th><th>Sun</th><th>Mon</th><th>Tue</th><th>Wen</th><th>Thu</th><th>Fri</th><th>Sat</th><th>Sun</th></tr>'
  122. i = ArrSize('$MenCal')
  123. empty0 = week + 29 - i - 1
  124. empty1 = min(28,empty0)
  125. full1 = max(0,28 - empty0)
  126. empty2 = max(0,empty0-28)
  127. full2 = i - full1
  128. empty3 = 28 - empty2 - full2
  129. count=0
  130. $tabmc = '<tr>'
  131. :tabmcl1
  132. if empty1 > 0: empty1 -=1 & $tabmc +='<td>&nbsp</td>' & jump 'tabmcl1'
  133. :tabmcl2
  134. if full1 > 0:
  135. full1 -=1
  136. if $MenCal[count]='0': $tabmc +='<td bgcolor="red"><<$mk_subst[$MenCal[count]]>></td>' else $tabmc +='<td><<$mk_subst[$MenCal[count]]>></td>'
  137. count +=1
  138. jump 'tabmcl1'
  139. end
  140. $tabmc += '</tr><tr>'
  141. :tabmcl3
  142. if empty2 > 0: empty2 -=1 & $tabmc +='<td>&nbsp</td>' & jump 'tabmcl3'
  143. :tabmcl4
  144. if full2 > 0:
  145. full2 -=1
  146. if $MenCal[count]='0': $tabmc +='<td bgcolor="red"><<$mk_subst[$MenCal[count]]>></td>' else $tabmc +='<td><<$mk_subst[$MenCal[count]]>></td>'
  147. count +=1
  148. jump 'tabmcl4'
  149. end
  150. :tabmcl5
  151. if empty3 > 0: empty3 -=1 & $tabmc +='<td></td>' & jump 'tabmcl5'
  152. $tabmc += '</tr><table></font></center>'
  153. $tabmc
  154. act 'Back': gt 'restoreposition'
  155. end
  156. !! use gs 'shortgs','mk'
  157. if $ARGS[0] = 'mk':
  158. gs 'saveposition'
  159. *clr & cla
  160. copyarr '$MenCalCopy','$MenCal'
  161. length_of_month_field = arrsize('$MenCalCopy')
  162. if daystart - firstmens > 40:
  163. mensnotfound = 1
  164. i = 0
  165. :tabmcfm
  166. if $MenCalCopy[length_of_month_field-i] = '0' and $MenCalCopy[length_of_month_field-i-1] = '3': mensnotfound = 0
  167. i += 1
  168. if i < length_of_month_field and mensnotfound = 1: jump 'tabmcfm'
  169. if mensnotfound = 0:
  170. firstmens = daystart - i + 1
  171. end
  172. end
  173. i=1
  174. :tabmcc1
  175. if daystart - firstmens < 40:
  176. if (daystart - firstmens + i) = 28:
  177. $MenCalCopy[] = ' bgcolor="#df2020"'
  178. elseif (daystart - firstmens + i) = 29:
  179. $MenCalCopy[] = ' bgcolor="#df3030"'
  180. elseif (daystart - firstmens + i) = 30:
  181. $MenCalCopy[] = ' bgcolor="#df4040"'
  182. elseif (daystart - firstmens + i) = 12:
  183. $MenCalCopy[] = ' bgcolor="#d8ff00"'
  184. elseif (daystart - firstmens + i) = 13:
  185. $MenCalCopy[] = ' bgcolor="#d0ff00"'
  186. elseif (daystart - firstmens + i) = 14:
  187. $MenCalCopy[] = ' bgcolor="#c8ff00"'
  188. elseif (daystart - firstmens + i) = 15:
  189. $MenCalCopy[] = ' bgcolor="#c0ff00"'
  190. elseif (daystart - firstmens + i) = 16:
  191. $MenCalCopy[] = ' bgcolor="#d0ff00"'
  192. elseif (daystart - firstmens + i) = 12+28:
  193. $MenCalCopy[] = ' bgcolor="#d8ff00"'
  194. elseif (daystart - firstmens + i) = 13+28:
  195. $MenCalCopy[] = ' bgcolor="#d0ff00"'
  196. elseif (daystart - firstmens + i) = 14+28:
  197. $MenCalCopy[] = ' bgcolor="#c8ff00"'
  198. elseif (daystart - firstmens + i) = 15+28:
  199. $MenCalCopy[] = ' bgcolor="#c0ff00"'
  200. elseif (daystart - firstmens + i) = 16+28:
  201. $MenCalCopy[] = ' bgcolor="#d0ff00"'
  202. else
  203. $MenCalCopy[] = ''
  204. end
  205. i += 1
  206. if i < 40: jump 'tabmcc1'
  207. end
  208. i = length_of_month_field
  209. :tabmcc2
  210. if i > 0:
  211. if $MenCalCopy[i-1] = '2' and i = 1 : $MenCalCopy[i-1] = ' bgcolor="#c0ff00"'
  212. if $MenCalCopy[i-1] = '2' and $MenCalCopy[i-2] = '2': $MenCalCopy[i-1] = ' bgcolor="#c0ff00"'
  213. if $MenCalCopy[i-1] = '2' and $MenCalCopy[i-2] = '1': $MenCalCopy[i-1] = ' bgcolor="#80ff00"' & $MenCalCopy[i-2] = ' bgcolor="#90ff00"' & $MenCalCopy[i-3] = ' bgcolor="#a0ff00"' & $MenCalCopy[i-4] = ' bgcolor="#b0ff00"' & $MenCalCopy[i-5] = ' bgcolor="#c0ff00"'
  214. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) < 12: $MenCalCopy[i-1] =''
  215. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) = 12: $MenCalCopy[i-1] =' bgcolor="#b0ff00"'
  216. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) = 13: $MenCalCopy[i-1] =' bgcolor="#a0ff00"'
  217. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) = 14: $MenCalCopy[i-1] =' bgcolor="#90ff00"'
  218. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) = 15: $MenCalCopy[i-1] =' bgcolor="#80ff00"'
  219. if $MenCalCopy[i-1] = '1' and (daystart - firstmens - length_of_month_field + i) > 15: $MenCalCopy[i-1] =''
  220. if $MenCalCopy[i-1] = '0': $MenCalCopy[i-1] =' bgcolor="#df2020"'
  221. if $MenCalCopy[i-1] = '3': $MenCalCopy[i-1] =''
  222. if $MenCalCopy[i-1] = '4': $MenCalCopy[i-1] =''
  223. if $MenCalCopy[i-1] = '5': $MenCalCopy[i-1] =''
  224. if $MenCalCopy[i-1] = '6': $MenCalCopy[i-1] =''
  225. i -= 1
  226. jump 'tabmcc2'
  227. end
  228. cur_day_doy = func('shortgs','doy',year,month,day)
  229. if month = 1:
  230. dif_days = cur_day_doy + 30
  231. prev_month = 12
  232. prev_month_length = 31
  233. else
  234. prev_month = month - 1
  235. dif_days = cur_day_doy - func('shortgs','doy',year,prev_month,1)
  236. prev_month_length = func('shortgs','doy',year,month,1) - func('shortgs','doy',year,prev_month,1)
  237. end
  238. first_month_first_day_week = week - (dif_days mod 7)
  239. first_month_first_day_index = length_of_month_field -1 - dif_days
  240. r = first_month_first_day_index
  241. if first_month_first_day_week < 1: first_month_first_day_week += 7
  242. i = 42
  243. :tabmc21
  244. $mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc21'
  245. i = 0
  246. :tabmc21a
  247. $mk1_mdays[i+first_month_first_day_week-1] = $str(i+1)
  248. i += 1
  249. if i < prev_month_length: jump 'tabmc21a'
  250. $prev_month_name = $mid($monthName[prev_month],1,1) + '<br>' + $mid($monthName[prev_month],2,1) + '<br>' + $mid($monthName[prev_month],3,1)
  251. k = 0
  252. $tabmc ='<center><font face="courier" size=5>'
  253. $tabmc +='<table border = 1 cellspacing="0" cellpadding="5">'
  254. $tabmc +='<tr><th>Month</th><th>Mon</th><th>Tue</th><th>Wen</th><th>Thu</th><th>Fri</th><th>Sat</th><th>Sun</th></tr>'
  255. month_weeks = (first_month_first_day_week + prev_month_length + 5)/7 - 1
  256. i = month_weeks
  257. :tabmc22
  258. $tabmc +='<tr>'
  259. j = 7
  260. if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$prev_month_name>></td>'
  261. :tabmc23
  262. if j > 0:
  263. j -=1
  264. if $mk1_mdays[k]='&nbsp':
  265. $tabmc +='<td><<$mk1_mdays[k]>></td>'
  266. else
  267. $tabmc +='<td<<$MenCalCopy[r]>> ><<$mk1_mdays[k]>></td>'
  268. r +=1
  269. end
  270. k +=1
  271. jump 'tabmc23' & !<<$MenCalCopy[r]>>
  272. end
  273. if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc22'
  274. killvar '$mk1_mdays'
  275. killvar '$mk1_mdays_color'
  276. !! current month
  277. if month = 12:
  278. dif_days = day - 1
  279. cur_month = month
  280. cur_month_length = 31
  281. else
  282. dif_days = day - 1
  283. cur_month_length = func('shortgs','doy',year,month+1,1) - func('shortgs','doy',year,month,1)
  284. end
  285. second_month_first_day_week = week - (dif_days mod 7)
  286. second_month_first_day_index = length_of_month_field -1 - dif_days
  287. if second_month_first_day_week < 1: second_month_first_day_week += 7
  288. i = 42
  289. :tabmc31
  290. $mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc31'
  291. i = 0
  292. :tabmc31a
  293. $mk1_mdays[i+second_month_first_day_week-1] = $str(i+1)
  294. i += 1
  295. if i < cur_month_length: jump 'tabmc31a'
  296. $cur_month_name = $mid($monthName[month],1,1) + '<br>' + $mid($monthName[month],2,1) + '<br>' + $mid($monthName[month],3,1)
  297. k = 0
  298. month_weeks = (second_month_first_day_week + cur_month_length + 5)/7 - 1
  299. i = month_weeks
  300. :tabmc32
  301. $tabmc +='<tr>'
  302. j = 7
  303. if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$cur_month_name>></td>'
  304. :tabmc33
  305. if j > 0:
  306. j -=1
  307. if $mk1_mdays[k]='&nbsp':
  308. $tabmc +='<td><<$mk1_mdays[k]>></td>'
  309. else
  310. 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>'
  311. r +=1
  312. end
  313. k +=1
  314. jump 'tabmc33'
  315. end
  316. if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc32'
  317. killvar '$mk1_mdays'
  318. killvar '$mk1_mdays_color'
  319. !! next month
  320. if month = 12:
  321. dif_days = 31 - day + 1
  322. next_month = 1
  323. next_month_length = 31
  324. elseif month = 11:
  325. dif_days = 30 - day + 1
  326. next_month = 12
  327. next_month_length = 31
  328. else
  329. next_month = month + 1
  330. dif_days = cur_month_length - day + 1
  331. next_month_length = func('shortgs','doy',year,month+2,1) - func('shortgs','doy',year,month+1,1)
  332. end
  333. next_month_first_day_week = week + (dif_days mod 7)
  334. next_month_first_day_index = length_of_month_field -1 - dif_days
  335. if next_month_first_day_week < 1: next_month_first_day_week += 7
  336. i = 35
  337. :tabmc41
  338. $mk1_mdays[] = '&nbsp' & i -= 1 & if i > 0: jump 'tabmc41'
  339. i = 0
  340. :tabmc41a
  341. $mk1_mdays[i+next_month_first_day_week-1] = $str(i+1)
  342. !! 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]]
  343. i += 1
  344. if i < next_month_length: jump 'tabmc41a'
  345. $next_month_name = $mid($monthName[next_month],1,1) + '<br>' + $mid($monthName[next_month],2,1) + '<br>' + $mid($monthName[next_month],3,1)
  346. k = 0
  347. month_weeks = (next_month_first_day_week + next_month_length + 5)/7 - 1
  348. i = month_weeks
  349. :tabmc42
  350. $tabmc +='<tr>'
  351. j = 7
  352. if i = month_weeks:$tabmc +='<td rowspan="<<month_weeks+1>>" align = "center"><<$next_month_name>></td>'
  353. :tabmc43
  354. if j > 0:
  355. j -=1
  356. if $mk1_mdays[k]='&nbsp':
  357. $tabmc +='<td><<$mk1_mdays[k]>></td>'
  358. else
  359. $tabmc +='<td<<$MenCalCopy[r]>> ><<$mk1_mdays[k]>></td>'
  360. r +=1
  361. end
  362. k +=1
  363. jump 'tabmc43'
  364. end
  365. if i > 0: i -=1 & $tabmc +='</tr>' & jump 'tabmc42'
  366. killvar '$mk1_mdays'
  367. $tabmc += '</tr><table></font></center>'
  368. $tabmc
  369. act 'Back': gt 'restoreposition'
  370. end
  371. !! gs 'shortgs','fonts'
  372. if $ARGS[0] = 'fonts':
  373. if $ARGS[1] = 'refresh':
  374. jump 'fontsloop'
  375. else
  376. $dynamicreturn = $ARGS[1]
  377. $OpenPhraseSave = $ARGS[2]
  378. $ClosePhraseSave = $ARGS[3]
  379. end
  380. gs 'saveposition'
  381. $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'
  382. $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'
  383. i = 15
  384. :fontsloop0
  385. if $CurFont = $fontlist[i]: curfont = i
  386. if $CurColor = $fontcolor[i]: curcolor = i
  387. i -= 1
  388. if i > 0: jump 'fontsloop0'
  389. jump 'fontsloop1'
  390. :fontsloop
  391. $OpenPhrase = '<font size="<<CurFontSize>>" color="<<$CurColor>>" face="<<$CurFont>>" >'+$CurBold+$CurItalic
  392. $ClosePhrase = $CurItalicBack+$CurBoldBack+'</font>'
  393. :fontsloop1
  394. *clr & cla
  395. $OpenPhrase+'Current font is <<$CurFont>> Size <<CurFontSize>>, the color is <<$CurColor>>, the Bold is <<iif($CurBold = ''<b>'',''On'',''Off'')>> and Italic is <<iif($CurItalic = ''<i>'',''On'',''Off'')>>'+$ClosePhrase
  396. '<a href="exec: curfont = (curfont + 1) mod 16 & $CurFont = $fontlist[curfont] & gs ''shortgs'',''fonts'',''refresh'' ">Change the Font</a>'
  397. '<a href="exec: curcolor = (curcolor + 1) mod 16 & $CurColor = $fontcolor[curcolor] & gs ''shortgs'',''fonts'',''refresh'' ">Change the Color</a>'
  398. '<a href="exec:$CurBold = iif($CurBold ! ''<b>'',''<b>'','' '') & $CurBoldBack = iif($CurBold = ''<b>'',''</b>'','' '') & gs ''shortgs'',''fonts'',''refresh'' ">Change the BoldState</a>'
  399. '<a href="exec:$CurItalic = iif($CurItalic ! ''<i>'',''<i>'','' '') & $CurItalicBack = iif($CurItalic = ''<i>'',''</i>'','' '') & gs ''shortgs'',''fonts'',''refresh'' ">Change the ItalicState</a>'
  400. '<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>'
  401. act 'Back':
  402. killvar '$fontlist'
  403. killvar '$fontcolor'
  404. dynamic '<<$OpenPhraseSave>> = $OpenPhrase'
  405. dynamic '<<$ClosePhraseSave>> = $ClosePhrase'
  406. if $dynamicreturn ! '': dynamic 'dynamic <<$dynamicreturn>>'
  407. gt 'restoreposition'
  408. end
  409. end
  410. !! use gs 'shortgs','ncp_update'
  411. if $ARGS[0] = 'ncp_update':
  412. copyarr 'copy_npc_QW','npc_QW'
  413. copyarr 'copy_npc_rel','npc_rel'
  414. copyarr 'copy_npc_love','npc_love'
  415. copyarr '$copy_npc_usedname','$npc_usedname'
  416. gs 'npcstatic1'
  417. gs 'npcstatic2'
  418. gs 'npcstatic3'
  419. gs 'npcstatic4'
  420. gs 'npcstatic5'
  421. i = arrsize('copy_npc_QW')
  422. j = 1
  423. :loopnpcupdate
  424. $boy = 'A<<j>>'
  425. npc_QW[$boy] = copy_npc_QW[$boy]
  426. npc_rel[$boy] = copy_npc_rel[$boy]
  427. npc_love[$boy] = copy_npc_love[$boy]
  428. $npc_usedname[$boy] = $copy_npc_usedname[$boy]
  429. j += 1
  430. if j <= i: jump 'loopnpcupdate'
  431. killvar 'copy_npc_QW'
  432. killvar 'copy_npc_rel'
  433. killvar 'copy_npc_love'
  434. killvar '$copy_npc_usedname'
  435. end
  436. !! this function returns the numeric index of the array element which is indexed by string value.
  437. !! call func('shortgs', 'get_me_index', 'name of array','string index')
  438. !! the array can be both numeric or string: Be aware, for the search is used the value 'SearchTag' for string arrays and -2147483648 for numeric arrays.
  439. !! if the array consists such value, the fuction can mess the array content and return wrong value
  440. !! changed the value for detecting numeric element from -999 to -2147483648 (November 2020)
  441. if $ARGS[0] = 'get_me_index':
  442. $test = '<<$ARGS[1]>>[''<<$ARGS[2]>>'']'
  443. testas0 = arrsize('<<$ARGS[1]>>')
  444. if $mid($test,1,1)='$':
  445. $temp=dyneval('$result=<<$test>>')
  446. dynamic '<<$test>> = ''SearchTag'' '
  447. testas1 = arrsize('<<$ARGS[1]>>')
  448. if testas0 = testas1:
  449. if Enable_Android = 1:
  450. res = dyneval('result = arrpos(''<<$ARGS[1]>>'',''SearchTag'',0)')
  451. else
  452. res = dyneval('result = arrpos(0,''<<$ARGS[1]>>'',''SearchTag'')')
  453. end
  454. dynamic '<<$test>> = ''<<$temp>>'' '
  455. else
  456. res = -1
  457. killvar '<<$ARGS[1]>>',testas0
  458. end
  459. else
  460. temp=dyneval('result=<<$test>>')
  461. dynamic '<<$test>> = -2147483648'
  462. testas1 = arrsize('<<$ARGS[1]>>')
  463. if testas0 = testas1:
  464. if Enable_Android = 1:
  465. res = dyneval('result = arrpos(''<<$ARGS[1]>>'',-2147483648,0)')
  466. else
  467. res = dyneval('result = arrpos(0,''<<$ARGS[1]>>'',-2147483648)')
  468. end
  469. dynamic '<<$test>> = <<temp>>'
  470. else
  471. res = -1
  472. killvar '<<$ARGS[1]>>',testas0
  473. end
  474. end
  475. result = res
  476. end
  477. !! call gs 'shortgs', 'remove_array_element', 'name of array','string index'
  478. if $ARGS[0] = 'remove_array_element':
  479. i = func('shortgs', 'get_me_index', $ARGS[1],$ARGS[2])
  480. killvar '<<$ARGS[1]>>',i
  481. end
  482. if $ARGS[0] = 'testsize':
  483. arrsize('$npc_dad')
  484. arrsize('$npc_dna')
  485. arrsize('$npc_firstname')
  486. arrsize('$npc_firstpart')
  487. arrsize('$npc_kidpater')
  488. arrsize('$npc_lastname')
  489. arrsize('$npc_lastpart')
  490. arrsize('$npc_mom')
  491. arrsize('$npc_nickname')
  492. arrsize('$npc_notes')
  493. arrsize('$npc_PersType')
  494. arrsize('$npc_pic')
  495. arrsize('$npc_rel')
  496. arrsize('$npc_thdick')
  497. arrsize('$npc_usedname')
  498. arrsize('npc_agil')
  499. arrsize('npc_apprnc')
  500. arrsize('npc_ass')
  501. arrsize('npc_bodyhair')
  502. arrsize('npc_breath')
  503. arrsize('npc_bust')
  504. arrsize('npc_cloc')
  505. arrsize('npc_clothpref')
  506. arrsize('npc_cyc')
  507. arrsize('npc_dick')
  508. arrsize('npc_dnc')
  509. arrsize('npc_dob')
  510. arrsize('npc_dom')
  511. arrsize('npc_drunk')
  512. arrsize('npc_dye')
  513. arrsize('npc_erodnc')
  514. arrsize('npc_eyecol')
  515. arrsize('npc_eyesize')
  516. arrsize('npc_fat')
  517. arrsize('npc_fert')
  518. arrsize('npc_gender')
  519. arrsize('npc_Godrep')
  520. arrsize('npc_hairbsh')
  521. arrsize('npc_haircol')
  522. arrsize('npc_hgt')
  523. arrsize('npc_hipcurv')
  524. arrsize('npc_horny')
  525. arrsize('npc_hymen')
  526. arrsize('npc_chem')
  527. arrsize('npc_intel')
  528. arrsize('npc_job')
  529. arrsize('npc_lashes')
  530. arrsize('npc_lip')
  531. arrsize('npc_lipbalm')
  532. arrsize('npc_love')
  533. arrsize('npc_magik')
  534. arrsize('npc_makeup')
  535. arrsize('npc_nips')
  536. arrsize('npc_pantys')
  537. arrsize('npc_Pavrep')
  538. arrsize('npc_QW')
  539. arrsize('npc_rel')
  540. arrsize('npc_sex')
  541. arrsize('npc_sexskill')
  542. arrsize('npc_skin')
  543. arrsize('npc_spermpot')
  544. arrsize('npc_sprt')
  545. arrsize('npc_stren')
  546. arrsize('npc_sub')
  547. arrsize('npc_sweat')
  548. arrsize('npc_tan')
  549. arrsize('npc_vag')
  550. arrsize('npc_vital')
  551. end
  552. if $ARGS[0] = 'replace header':
  553. wait(ARGS[1])
  554. RH_Count = ARGS[2]
  555. $RH_temp = $MAINTXT
  556. :RH_label
  557. RH_temp_lenght = LEN($RH_temp)
  558. RH_temp_LFpos = STRPOS($RH_temp,'\n')
  559. $RH_temp = $MID($RH_temp, RH_temp_LFpos+1, RH_temp_lenght - RH_temp_LFpos)
  560. RH_Count -=1
  561. if RH_Count > 0: jump 'RH_label'
  562. *clr
  563. $ARGS[3] & $ARGS[4] & $ARGS[5] & $ARGS[6] & $ARGS[7]
  564. $RH_temp
  565. killvar '$RH_temp'
  566. killvar 'RH_Count'
  567. killvar 'RH_temp_lenght'
  568. killvar 'RH_temp_LFpos'
  569. end
  570. if $ARGS[0]='img msg':
  571. $shortgstemp = '<center><img height=280 src="<<$ARGS[1]>>"></center>'
  572. msg $shortgstemp
  573. killvar '$shortgstemp'
  574. end
  575. !! Used for dividing with accurate rounding up/down
  576. if $ARGS[0] = 'round_divide':
  577. !! ARGS[1] = value you want divided
  578. !! ARGS[2] = divider
  579. !! func('shortgs','round_divide', number, divider)
  580. !! func('shortgs','round_divide', 12345, 7)
  581. if ARGS[2] ! 0:
  582. temp_number = ARGS[1]/ARGS[2]
  583. if (ARGS[2] mod 2 ! 0 and ARGS[1] mod ARGS[2] > ARGS[2]/2) or (ARGS[2] mod 2 = 0 and ARGS[1] mod ARGS[2] >= ARGS[2]/2): temp_number += 1
  584. result = temp_number
  585. killvar 'temp_number'
  586. else
  587. msg '<b>Error: No dividing by 0! You trying to make the universe disappear?</b>'
  588. end
  589. end
  590. !! Used for rounding numbers to the nearest multiple of ARGS[2]
  591. if $ARGS[0] = 'round_tool':
  592. !! ARGS[1] = value you want rounded
  593. !! ARGS[2] = nearest multiple to round to
  594. !! func('shortgs','round_tool', number, multiple)
  595. !! func('shortgs','round_tool', 12345, 10)
  596. if ARGS[2] ! 0:
  597. temp_multiple = ARGS[2]
  598. result = func('shortgs','round_divide', ARGS[1], ARGS[2]) * temp_multiple
  599. killvar 'temp_multiple'
  600. else
  601. msg '<b>Error: Can''t round to 0!</b>'
  602. end
  603. end
  604. !! Randomly picks one of the items plugged in
  605. !!
  606. !! Option 1: (has 6 input limit)
  607. !! $ARGS[1] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  608. !! $ARGS[2-7] = strings or numbers to pick from, limited to 6
  609. !! Example 1: func('shortgs', 'rand_pick', 'string', 'alpha', 'beta', 'gamma', 'delta', 'epsilon', 'zeta')
  610. !! Example 2: func('shortgs', 'rand_pick', '', 2, 3, 5, 7, 11, 13)
  611. !!
  612. !! Option 2: (no limitations, has to be delimited)
  613. !! $ARGS[1] = 'delimit' - used for larger numbers of items to pick from
  614. !! $ARGS[2] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  615. !! $ARGS[3] = Delimited string to parse
  616. !! $ARGS[4] = Delimiter used (Default = '|' pipe)
  617. !! Example 1: func('shortgs', 'rand_pick', 'delimit', 'string', 'alpha|beta|gamma|delta|epsilon|zeta')
  618. !! Example 2: func('shortgs', 'rand_pick', 'delimit', 'number', '1-12-123-1234-12345-123456', '-')
  619. !! Example 3: func('shortgs', 'rand_pick', 'delimit', '', '0.1.2.3.5.7.11', '.')
  620. if $ARGS[0] = 'rand_pick':
  621. if $ARGS[1] = 'delimit':
  622. if $ARGS[2] = 'string':
  623. gs 'shortgs', 'parse_string', '$rand_pick_temp', $ARGS[3], $ARGS[4]
  624. $result = $rand_pick_temp[rand(0, arrsize('$rand_pick_temp')-1)]
  625. killvar '$rand_pick_temp'
  626. else
  627. gs 'shortgs', 'parse_string', 'rand_pick_temp', $ARGS[3], $ARGS[4]
  628. result = rand_pick_temp[rand(0, arrsize('rand_pick_temp')-1)]
  629. killvar 'rand_pick_temp'
  630. end
  631. else
  632. if arrsize('ARGS') > 2:
  633. if $ARGS[1] = 'string':
  634. $result = $ARGS[rand(2, arrsize('$ARGS')-1)]
  635. else
  636. result = ARGS[rand(2, arrsize('ARGS')-1)]
  637. end
  638. else
  639. msg '<b>Error: ''rand_pick'' is missing ARGS</b>'
  640. end
  641. end
  642. end
  643. !! Parse delimited string into an array
  644. !! $ARGS[1] = ArrayName (has to include $ for string values)
  645. !! $ARGS[2] = Delimited string to parse
  646. !! $ARGS[3] = Delimiter used (Default = '|' pipe)
  647. !! Example 1: gs 'shortgs', 'parse_string', '$my_array', 'alpha|beta|gamma|delta|epsilon|zeta'
  648. !! Example 2: gs 'shortgs', 'parse_string', 'my_array', '1-12-123-1234-12345-123456', '-'
  649. if $ARGS[0] = 'parse_string':
  650. !! Some failsafes (blank array name, blank string or no delimiters in string)
  651. if $ARGS[1] ! '':
  652. if $ARGS[2] ! '' and instr($ARGS[2],iif($ARGS[3] = '', '|', $ARGS[3])) > 0:
  653. !! Set delimiter with default if needed
  654. if $ARGS[3] = '':
  655. $ParserTmpDelim = '|'
  656. else
  657. $ParserTmpDelim = $ARGS[3]
  658. end
  659. !! Clear temp array if needed
  660. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  661. $ParserTmpStr = $ARGS[2]
  662. !! Loop through string until no more delimiters found
  663. :StringParser01
  664. ParserTmpIdx = instr($ParserTmpStr, $ParserTmpDelim)
  665. if ParserTmpIdx > 0:
  666. if mid($ARGS[1],1,1) = '$':
  667. $ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  668. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  669. else
  670. ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  671. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  672. end
  673. jump 'StringParser01'
  674. !! Get last part since no more delimiters were found and copy to the final array
  675. elseif mid($ARGS[1],1,1) = '$':
  676. $ParserTmpArr[] = $ParserTmpStr
  677. copyarr $ARGS[1], '$ParserTmpArr'
  678. else
  679. ParserTmpArr[] = $ParserTmpStr
  680. copyarr $ARGS[1], 'ParserTmpArr'
  681. end
  682. killvar '$ParserTmpDelim'
  683. killvar '$ParserTmpStr'
  684. killvar 'ParserTmpIdx'
  685. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  686. else
  687. msg '<b>Error: No delimited string found!</b>'
  688. end
  689. else
  690. msg '<b>Error: No array name found!</b>'
  691. end
  692. end
  693. --- shortgs ---------------------------------