shortgs.qsrc 26 KB

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