shortgs.qsrc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763
  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_dance')
  508. arrsize('npc_danceero')
  509. arrsize('npc_def')
  510. arrsize('npc_dick')
  511. arrsize('npc_dnc')
  512. arrsize('npc_dob')
  513. arrsize('npc_dom')
  514. arrsize('npc_drunk')
  515. arrsize('npc_dye')
  516. arrsize('npc_erodnc')
  517. arrsize('npc_eyecol')
  518. arrsize('npc_eyesize')
  519. arrsize('npc_fat')
  520. arrsize('npc_fert')
  521. arrsize('npc_gender')
  522. arrsize('npc_genwart')
  523. arrsize('npc_glasses')
  524. arrsize('npc_Godrep')
  525. arrsize('npc_gon')
  526. arrsize('npc_grades')
  527. arrsize('npc_hairbsh')
  528. arrsize('npc_haircol')
  529. arrsize('npc_haircurl')
  530. arrsize('npc_hairlng')
  531. arrsize('npc_herpes')
  532. arrsize('npc_hgt')
  533. arrsize('npc_hipcurv')
  534. arrsize('npc_Hiv')
  535. arrsize('npc_horny')
  536. arrsize('npc_hymen')
  537. arrsize('npc_chem')
  538. arrsize('npc_chess')
  539. arrsize('npc_chlam')
  540. arrsize('npc_intel')
  541. arrsize('npc_jab')
  542. arrsize('npc_job')
  543. arrsize('npc_kick')
  544. arrsize('npc_lashes')
  545. arrsize('npc_lip')
  546. arrsize('npc_lipbalm')
  547. arrsize('npc_love')
  548. arrsize('npc_magik')
  549. arrsize('npc_makeup')
  550. arrsize('npc_malen')
  551. arrsize('npc_nerd')
  552. arrsize('npc_nips')
  553. arrsize('npc_pantys')
  554. arrsize('npc_Pavrep')
  555. arrsize('npc_pubes')
  556. arrsize('npc_punch')
  557. arrsize('npc_QW')
  558. arrsize('npc_rel')
  559. arrsize('npc_run')
  560. arrsize('npc_serving')
  561. arrsize('npc_sewing')
  562. arrsize('npc_sex')
  563. arrsize('npc_sexskill')
  564. arrsize('npc_shoot')
  565. arrsize('npc_skin')
  566. arrsize('npc_spermpot')
  567. arrsize('npc_sprt')
  568. arrsize('npc_stren')
  569. arrsize('npc_sub')
  570. arrsize('npc_sweat')
  571. arrsize('npc_syth')
  572. arrsize('npc_tan')
  573. arrsize('npc_teach')
  574. arrsize('npc_thrush')
  575. arrsize('npc_vag')
  576. arrsize('npc_vball')
  577. arrsize('npc_vital')
  578. arrsize('npc_vokal')
  579. end
  580. if $ARGS[0] = 'replace header':
  581. wait(ARGS[1])
  582. RH_Count = ARGS[2]
  583. $RH_temp = $MAINTXT
  584. :RH_label
  585. RH_temp_lenght = LEN($RH_temp)
  586. RH_temp_LFpos = STRPOS($RH_temp,'\n')
  587. $RH_temp = $MID($RH_temp, RH_temp_LFpos+1, RH_temp_lenght - RH_temp_LFpos)
  588. RH_Count -=1
  589. if RH_Count > 0: jump 'RH_label'
  590. *clr
  591. $ARGS[3] & $ARGS[4] & $ARGS[5] & $ARGS[6] & $ARGS[7]
  592. $RH_temp
  593. killvar '$RH_temp'
  594. killvar 'RH_Count'
  595. killvar 'RH_temp_lenght'
  596. killvar 'RH_temp_LFpos'
  597. end
  598. if $ARGS[0]='img msg':
  599. $shortgstemp = '<center><img height=280 src="<<$ARGS[1]>>"></center>'
  600. msg $shortgstemp
  601. killvar '$shortgstemp'
  602. end
  603. !! Used for dividing with accurate rounding up/down
  604. if $ARGS[0] = 'round_divide':
  605. !! ARGS[1] = value you want divided
  606. !! ARGS[2] = divider
  607. !! func('shortgs','round_divide', number, divider)
  608. !! func('shortgs','round_divide', 12345, 7)
  609. if ARGS[2] ! 0:
  610. temp_number = ARGS[1]/ARGS[2]
  611. 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
  612. result = temp_number
  613. killvar 'temp_number'
  614. else
  615. msg '<b>Error: No dividing by 0! You trying to make the universe disappear?</b>'
  616. end
  617. end
  618. !! Used for rounding numbers to the nearest multiple of ARGS[2]
  619. if $ARGS[0] = 'round_tool':
  620. !! ARGS[1] = value you want rounded
  621. !! ARGS[2] = nearest multiple to round to
  622. !! func('shortgs','round_tool', number, multiple)
  623. !! func('shortgs','round_tool', 12345, 10)
  624. if ARGS[2] ! 0:
  625. temp_multiple = ARGS[2]
  626. result = func('shortgs','round_divide', ARGS[1], ARGS[2]) * temp_multiple
  627. killvar 'temp_multiple'
  628. else
  629. msg '<b>Error: Can''t round to 0!</b>'
  630. end
  631. end
  632. !! Randomly picks one of the items plugged in
  633. !!
  634. !! Option 1: (has 6 input limit)
  635. !! $ARGS[1] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  636. !! $ARGS[2-7] = strings or numbers to pick from, limited to 6
  637. !! Example 1: func('shortgs', 'rand_pick', 'string', 'alpha', 'beta', 'gamma', 'delta', 'epsilon', 'zeta')
  638. !! Example 2: func('shortgs', 'rand_pick', '', 2, 3, 5, 7, 11, 13)
  639. !!
  640. !! Option 2: (no limitations, has to be delimited)
  641. !! $ARGS[1] = 'delimit' - used for larger numbers of items to pick from
  642. !! $ARGS[2] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  643. !! $ARGS[3] = Delimited string to parse
  644. !! $ARGS[4] = Delimiter used (Default = '|' pipe)
  645. !! Example 1: func('shortgs', 'rand_pick', 'delimit', 'string', 'alpha|beta|gamma|delta|epsilon|zeta')
  646. !! Example 2: func('shortgs', 'rand_pick', 'delimit', 'number', '1-12-123-1234-12345-123456', '-')
  647. !! Example 3: func('shortgs', 'rand_pick', 'delimit', '', '0.1.2.3.5.7.11', '.')
  648. if $ARGS[0] = 'rand_pick':
  649. if $ARGS[1] = 'delimit':
  650. if $ARGS[2] = 'string':
  651. gs 'shortgs', 'parse_string', '$rand_pick_temp', $ARGS[3], $ARGS[4]
  652. $result = $rand_pick_temp[rand(0, arrsize('$rand_pick_temp')-1)]
  653. killvar '$rand_pick_temp'
  654. else
  655. gs 'shortgs', 'parse_string', 'rand_pick_temp', $ARGS[3], $ARGS[4]
  656. result = rand_pick_temp[rand(0, arrsize('rand_pick_temp')-1)]
  657. killvar 'rand_pick_temp'
  658. end
  659. else
  660. if arrsize('ARGS') > 2:
  661. if $ARGS[1] = 'string':
  662. $result = $ARGS[rand(2, arrsize('$ARGS')-1)]
  663. else
  664. result = ARGS[rand(2, arrsize('ARGS')-1)]
  665. end
  666. else
  667. msg '<b>Error: ''rand_pick'' is missing ARGS</b>'
  668. end
  669. end
  670. end
  671. !! Parse delimited string into an array
  672. !! $ARGS[1] = ArrayName (has to include $ for string values)
  673. !! $ARGS[2] = Delimited string to parse
  674. !! $ARGS[3] = Delimiter used (Default = '|' pipe)
  675. !! Example 1: gs 'shortgs', 'parse_string', '$my_array', 'alpha|beta|gamma|delta|epsilon|zeta'
  676. !! Example 2: gs 'shortgs', 'parse_string', 'my_array', '1-12-123-1234-12345-123456', '-'
  677. if $ARGS[0] = 'parse_string':
  678. !! Some failsafes (blank array name, blank string or no delimiters in string)
  679. if $ARGS[1] ! '':
  680. if $ARGS[2] ! '' and instr($ARGS[2],iif($ARGS[3] = '', '|', $ARGS[3])) > 0:
  681. !! Set delimiter with default if needed
  682. if $ARGS[3] = '':
  683. $ParserTmpDelim = '|'
  684. else
  685. $ParserTmpDelim = $ARGS[3]
  686. end
  687. !! Clear temp array if needed
  688. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  689. $ParserTmpStr = $ARGS[2]
  690. !! Loop through string until no more delimiters found
  691. :StringParser01
  692. ParserTmpIdx = instr($ParserTmpStr, $ParserTmpDelim)
  693. if ParserTmpIdx > 0:
  694. if mid($ARGS[1],1,1) = '$':
  695. $ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  696. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  697. else
  698. ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  699. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  700. end
  701. jump 'StringParser01'
  702. !! Get last part since no more delimiters were found and copy to the final array
  703. elseif mid($ARGS[1],1,1) = '$':
  704. $ParserTmpArr[] = $ParserTmpStr
  705. copyarr $ARGS[1], '$ParserTmpArr'
  706. else
  707. ParserTmpArr[] = $ParserTmpStr
  708. copyarr $ARGS[1], 'ParserTmpArr'
  709. end
  710. killvar '$ParserTmpDelim'
  711. killvar '$ParserTmpStr'
  712. killvar 'ParserTmpIdx'
  713. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  714. else
  715. msg '<b>Error: No delimited string found!</b>'
  716. end
  717. else
  718. msg '<b>Error: No array name found!</b>'
  719. end
  720. end
  721. --- shortgs ---------------------------------