shortgs.qsrc 25 KB

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