shortgs.qsrc 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743
  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. $temp = $replace('<<$t>>','''','''''')
  455. dynamic '<<$test>> = ''<<$temp>>'' '
  456. else
  457. res = -1
  458. killvar '<<$ARGS[1]>>',testas0
  459. end
  460. else
  461. temp=dyneval('result=<<$test>>')
  462. dynamic '<<$test>> = -2147483648'
  463. testas1 = arrsize('<<$ARGS[1]>>')
  464. if testas0 = testas1:
  465. if Enable_Android = 1:
  466. res = dyneval('result = arrpos(''<<$ARGS[1]>>'',-2147483648,0)')
  467. else
  468. res = dyneval('result = arrpos(0,''<<$ARGS[1]>>'',-2147483648)')
  469. end
  470. dynamic '<<$test>> = <<temp>>'
  471. else
  472. res = -1
  473. killvar '<<$ARGS[1]>>',testas0
  474. end
  475. end
  476. result = res
  477. end
  478. !! call gs 'shortgs', 'remove_array_element', 'name of array','string index'
  479. if $ARGS[0] = 'remove_array_element':
  480. i = func('shortgs', 'get_me_index', $ARGS[1],$ARGS[2])
  481. killvar '<<$ARGS[1]>>',i
  482. end
  483. if $ARGS[0] = 'testsize':
  484. '$npc_dna = ' + arrsize('$npc_dna')
  485. 'npc_firstname = ' + arrsize('$npc_firstname')
  486. '$npc_lastname = ' + arrsize('$npc_lastname')
  487. 'npc_nickname = ' + arrsize('$npc_nickname')
  488. '$npc_notes = ' + arrsize('$npc_notes')
  489. '$npc_occupation = ' + arrsize('$npc_occupation')
  490. '$npc_perstype = ' + arrsize('$npc_perstype')
  491. '$npc_pic = ' + arrsize('$npc_pic')
  492. '$npc_thdick = ' + arrsize('$npc_thdick')
  493. '$npc_usedname = ' + arrsize('$npc_usedname')
  494. 'npc_apprnc = ' + arrsize('npc_apprnc')
  495. 'npc_bust = ' + arrsize('npc_bust')
  496. 'npc_outfit = ' + arrsize('npc_outfit')
  497. 'npc_style = ' + arrsize('npc_style')
  498. 'npc_dick = ' + arrsize('npc_dick')
  499. 'npc_dob = ' + arrsize('npc_dob')
  500. 'npc_drunk = ' + arrsize('npc_drunk')
  501. 'npc_gender = ' + arrsize('npc_gender')
  502. 'npc_haircol = ' + arrsize('npc_haircol')
  503. 'npc_height = ' + arrsize('npc_height')
  504. 'npc_horny = ' + arrsize('npc_horny')
  505. 'npc_intel = ' + arrsize('npc_intel')
  506. 'npc_love = ' + arrsize('npc_love')
  507. 'npc_QW = ' + arrsize('npc_QW')
  508. 'npc_rel = ' + arrsize('npc_rel')
  509. 'npc_sex = ' + arrsize('npc_sex')
  510. 'npc_sexskill = ' + arrsize('npc_sexskill')
  511. 'npc_spermpot = ' + arrsize('npc_spermpot')
  512. 'npc_herpes = ' + arrsize('npc_herpes')
  513. 'npc_syth = ' + arrsize('npc_syth')
  514. 'npc_gon = ' + arrsize('npc_gon')
  515. 'npc_thrush = ' + arrsize('npc_thrush')
  516. 'npc_apt_type = ' + arrsize('npc_apt_type')
  517. 'npc_apt_number = ' + arrsize('npc_apt_number')
  518. '$npc_apt_bedroom = ' + arrsize('$npc_apt_bedroom')
  519. '$npc_apt_kitchen = ' + arrsize('$npc_apt_kitchen')
  520. '$npc_apt_livingroom = ' + arrsize('$npc_apt_livingroom')
  521. '$npc_apt_bathroom = ' + arrsize('$npc_apt_bathroom')
  522. 'npc_perv = ' + arrsize('npc_perv')
  523. 'npc_finance = ' + arrsize('npc_finance')
  524. 'npc_humor = ' + arrsize('npc_humor')
  525. 'npc_fav_pos = ' + arrsize('npc_fav_pos')
  526. 'npc_tit_pref = ' + arrsize('npc_tit_pref')
  527. 'npc_addit = ' + arrsize('npc_addit')
  528. 'npc_doors = ' + arrsize('npc_doors')
  529. 'npc_goal = ' + arrsize('npc_goal')
  530. 'npc_fidelity = ' + arrsize('npc_fidelity')
  531. 'npc_lover_days = ' + arrsize('npc_lover_days')
  532. 'npc_lover_keys = ' + arrsize('npc_lover_keys')
  533. end
  534. if $ARGS[0] = 'npctest':
  535. ' --- init --- '
  536. gs 'shortgs', 'testsize'
  537. gs 'npcgeneratec', 0, 'stranger', rand(18,45),1
  538. $npc_notes[$npclastgenerated]
  539. $npclastgenerated
  540. ' --- gen npc C --- '
  541. gs 'shortgs', 'testsize'
  542. gs 'npcpreservec', $npclastgenerated
  543. $npc_notes[$npclastsaved]
  544. $npclastsaved
  545. ' --- sav npc C to npc B --- '
  546. gs 'shortgs', 'testsize'
  547. gs 'npccleanc',$npclastsaved
  548. ' --- delete npc B --- '
  549. gs 'shortgs', 'testsize'
  550. end
  551. if $ARGS[0] = 'replace header':
  552. wait(ARGS[1])
  553. RH_Count = ARGS[2]
  554. $RH_temp = $MAINTXT
  555. :RH_label
  556. RH_temp_lenght = LEN($RH_temp)
  557. RH_temp_LFpos = STRPOS($RH_temp,'\n')
  558. $RH_temp = $MID($RH_temp, RH_temp_LFpos+1, RH_temp_lenght - RH_temp_LFpos)
  559. RH_Count -=1
  560. if RH_Count > 0: jump 'RH_label'
  561. *clr
  562. $ARGS[3] & $ARGS[4] & $ARGS[5] & $ARGS[6] & $ARGS[7]
  563. $RH_temp
  564. killvar '$RH_temp'
  565. killvar 'RH_Count'
  566. killvar 'RH_temp_lenght'
  567. killvar 'RH_temp_LFpos'
  568. end
  569. if $ARGS[0]='img msg':
  570. $shortgstemp = '<center><img height=280 src="<<$ARGS[1]>>"></center>'
  571. msg $shortgstemp
  572. killvar '$shortgstemp'
  573. end
  574. !! Used for dividing with accurate rounding up/down
  575. if $ARGS[0] = 'round_divide':
  576. !! ARGS[1] = value you want divided
  577. !! ARGS[2] = divider
  578. !! func('shortgs','round_divide', number, divider)
  579. !! func('shortgs','round_divide', 12345, 7)
  580. if ARGS[2] ! 0:
  581. temp_number = ARGS[1]/ARGS[2]
  582. 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
  583. result = temp_number
  584. killvar 'temp_number'
  585. else
  586. msg '<b>Error: No dividing by 0! You trying to make the universe disappear?</b>'
  587. end
  588. end
  589. !! Used for rounding numbers to the nearest multiple of ARGS[2]
  590. if $ARGS[0] = 'round_tool':
  591. !! ARGS[1] = value you want rounded
  592. !! ARGS[2] = nearest multiple to round to
  593. !! func('shortgs','round_tool', number, multiple)
  594. !! func('shortgs','round_tool', 12345, 10)
  595. if ARGS[2] ! 0:
  596. temp_multiple = ARGS[2]
  597. result = func('shortgs','round_divide', ARGS[1], ARGS[2]) * temp_multiple
  598. killvar 'temp_multiple'
  599. else
  600. msg '<b>Error: Can''t round to 0!</b>'
  601. end
  602. end
  603. !! Randomly picks one of the items plugged in
  604. !!
  605. !! Option 1: (has 6 input limit)
  606. !! $ARGS[1] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  607. !! $ARGS[2-7] = strings or numbers to pick from, limited to 6
  608. !! Example 1: func('shortgs', 'rand_pick', 'string', 'alpha', 'beta', 'gamma', 'delta', 'epsilon', 'zeta')
  609. !! Example 2: func('shortgs', 'rand_pick', '', 2, 3, 5, 7, 11, 13)
  610. !!
  611. !! Option 2: (no limitations, has to be delimited)
  612. !! $ARGS[1] = 'delimit' - used for larger numbers of items to pick from
  613. !! $ARGS[2] = 'string' or 'number' to specify what youre plugging in (can also be blank for numbers)
  614. !! $ARGS[3] = Delimited string to parse
  615. !! $ARGS[4] = Delimiter used (Default = '|' pipe)
  616. !! Example 1: func('shortgs', 'rand_pick', 'delimit', 'string', 'alpha|beta|gamma|delta|epsilon|zeta')
  617. !! Example 2: func('shortgs', 'rand_pick', 'delimit', 'number', '1-12-123-1234-12345-123456', '-')
  618. !! Example 3: func('shortgs', 'rand_pick', 'delimit', '', '0.1.2.3.5.7.11', '.')
  619. if $ARGS[0] = 'rand_pick':
  620. if $ARGS[1] = 'delimit':
  621. if $ARGS[2] = 'string':
  622. gs 'shortgs', 'parse_string', '$rand_pick_temp', $ARGS[3], $ARGS[4]
  623. $result = $rand_pick_temp[rand(0, arrsize('$rand_pick_temp')-1)]
  624. killvar '$rand_pick_temp'
  625. else
  626. gs 'shortgs', 'parse_string', 'rand_pick_temp', $ARGS[3], $ARGS[4]
  627. result = rand_pick_temp[rand(0, arrsize('rand_pick_temp')-1)]
  628. killvar 'rand_pick_temp'
  629. end
  630. else
  631. if arrsize('ARGS') > 2:
  632. if $ARGS[1] = 'string':
  633. $result = $ARGS[rand(2, arrsize('$ARGS')-1)]
  634. else
  635. result = ARGS[rand(2, arrsize('ARGS')-1)]
  636. end
  637. else
  638. msg '<b>Error: ''rand_pick'' is missing ARGS</b>'
  639. end
  640. end
  641. end
  642. !! Parse delimited string into an array
  643. !! $ARGS[1] = ArrayName (has to include $ for string values)
  644. !! $ARGS[2] = Delimited string to parse
  645. !! $ARGS[3] = Delimiter used (Default = '|' pipe)
  646. !! Example 1: gs 'shortgs', 'parse_string', '$my_array', 'alpha|beta|gamma|delta|epsilon|zeta'
  647. !! Example 2: gs 'shortgs', 'parse_string', 'my_array', '1-12-123-1234-12345-123456', '-'
  648. if $ARGS[0] = 'parse_string':
  649. !! Some failsafes (blank array name, blank string or no delimiters in string)
  650. if $ARGS[1] ! '':
  651. if $ARGS[2] ! '' and instr($ARGS[2],iif($ARGS[3] = '', '|', $ARGS[3])) > 0:
  652. !! Set delimiter with default if needed
  653. if $ARGS[3] = '':
  654. $ParserTmpDelim = '|'
  655. else
  656. $ParserTmpDelim = $ARGS[3]
  657. end
  658. !! Clear temp array if needed
  659. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  660. $ParserTmpStr = $ARGS[2]
  661. !! Loop through string until no more delimiters found
  662. :StringParser01
  663. ParserTmpIdx = instr($ParserTmpStr, $ParserTmpDelim)
  664. if ParserTmpIdx > 0:
  665. if mid($ARGS[1],1,1) = '$':
  666. $ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  667. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  668. else
  669. ParserTmpArr[] = mid($ParserTmpStr, 1, ParserTmpIdx-1)
  670. $ParserTmpStr = mid($ParserTmpStr, ParserTmpIdx+1)
  671. end
  672. jump 'StringParser01'
  673. !! Get last part since no more delimiters were found and copy to the final array
  674. elseif mid($ARGS[1],1,1) = '$':
  675. $ParserTmpArr[] = $ParserTmpStr
  676. copyarr $ARGS[1], '$ParserTmpArr'
  677. else
  678. ParserTmpArr[] = $ParserTmpStr
  679. copyarr $ARGS[1], 'ParserTmpArr'
  680. end
  681. killvar '$ParserTmpDelim'
  682. killvar '$ParserTmpStr'
  683. killvar 'ParserTmpIdx'
  684. killvar 'ParserTmpArr' & killvar '$ParserTmpArr'
  685. else
  686. msg '<b>Error: No delimited string found!</b>'
  687. end
  688. else
  689. msg '<b>Error: No array name found!</b>'
  690. end
  691. end
  692. --- shortgs ---------------------------------