bokpass.tcl 86 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212
  1. #!/bin/sh
  2. #\
  3. for x in 8.7 8.6 8.5 ""; do \
  4. command -v "tclsh$x" >/dev/null && exec "tclsh$x" "$0" "$@"; \
  5. command -v "wish$x" >/dev/null && exec "wish$x" "$0" -- "$@"; \
  6. done
  7. # Permission to use, copy, modify, and/or distribute this software for
  8. # any purpose with or without fee is hereby granted.
  9. #
  10. # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  11. # WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES
  12. # OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE
  13. # FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY
  14. # DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
  15. # AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
  16. # OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  17. # NAME
  18. # bokpass - decode/encode passwords from/for boktai games
  19. #
  20. # SYNOPSIS
  21. # bokpass [-gui] [-kbd] [-invalid] [-columns columns] [-fontsize size]
  22. # bokpass [-cli] [-verbose] -game game password ...
  23. #
  24. # DESCRIPTION
  25. # bokpass is a tool to decode and encode passwords from/for the Boktai
  26. # series of games, including Lunar Knights.
  27. #
  28. # OPTIONS
  29. # -gui Open the GUI, this is the default when there are no
  30. # arguments provided.
  31. #
  32. # -columns columns
  33. # Arrange the gui in specified number of columns,
  34. # the default is 2.
  35. #
  36. # -fontsize size
  37. # Set the default font size to `size', the password entry and
  38. # virtual keyboard font sizes are an additional 20% bigger.
  39. # The default is 10.
  40. #
  41. # -cli Decode the provided passwords, this is the default when
  42. # arguments are provided.
  43. #
  44. # -verbose
  45. # If a value has a single string representation, print that
  46. # next to its numerical representation.
  47. #
  48. # -invalid
  49. # Do not validate the data fields.
  50. #
  51. # -game game
  52. # The game that the provided password(s) are for, `game' can
  53. # be a number (1-4), the title of the game, or the short-name
  54. # for the game (zoktai/shinbok).
  55. # This option is required for decoding passwords.
  56. #
  57. # GUI
  58. # The tabs at the top select the game.
  59. #
  60. # Under that is the encode button "↱", the password text box, the
  61. # cycle button "↻", and the decode button "↴".
  62. #
  63. # The cycle button "↻" edits the password to change the `offset'
  64. # field and change how it would be decoded. For if one of the first
  65. # letters was a typo. Though note that the `offset' is not included in
  66. # Boktai 1's checksum.
  67. #
  68. # Then columns (changed by the `-columns' option) of labeled dropdown
  69. # menus, number-boxes, checkboxes, and text fields that correspond to
  70. # the various fields of the selected game's password.
  71. #
  72. # Then there is an error line, usually containing "✓", that will show
  73. # an error preceded by "⚠" if there was an encoding error, a decoding
  74. # error, or if the password may be considered invalid. For example,
  75. # Boktai 2 (US) will not accept Boktai 1 passwords that have 0 playtime
  76. # or clears, and will not accept Japanese characters in the player's
  77. # name.
  78. #
  79. # If the `-kbd' flag is given then at the bottom there are tabs
  80. # containing grids of buttons that function as a virtual keyboard.
  81. # When clicking a text-entry field it will automatically switch to
  82. # the appropriate keyboard tab, and lock it out of any invalid tabs.
  83. #
  84. # BOKTAI PASSWORD
  85. # JP EN
  86. # u3 u3 region
  87. # u16 u16 checksum
  88. # u2 u2 offset [0x0203C800, ([0x03004620]+1 & 0x3FF)*2] & 3
  89. # u9 u9 sol/4 [0x0203D8BC] >> 12
  90. # u6 u7 timezone [0x0203D82C]
  91. # u6 u6 hours [0x0203D8FC] / 60 / 60 / 60
  92. # u6 u6 minutes [0x0203D8FC] / 60 / 60 % 60
  93. # u3 u3 difficulty [0x0203D838]
  94. # u5 u5 dungeons [0x0203D8A6]h
  95. # u3 u3 clears [0x0203D8B6]h
  96. # u4 u4 continues [0x0203D902]h
  97. # u5 u5 caught [0x0203DB0C]h
  98. # u7 u7 kills [0x0203D8B0]h
  99. # u4 u4 rank [0x0203D8C6]h
  100. # u5 u5 title [0x0203D828]h
  101. # u8[5] u8[9] name [0x0203D830]...
  102. # u6 u6 link-battles [0x0203DD2E]
  103. # u6 u6 link-trades [0x0203DD32]
  104. # u8 u8 loan [0x0203D878]
  105. # u0 u15 padding 0
  106. #
  107. # The checksum offset is 24-bits and uses the constant 0x1021.
  108. # The encoding offset is 24-bits and uses the initializer 0x8C159.
  109. #
  110. # BOKTAI 2 PASSWORD
  111. # JP EN
  112. # u16 u16 checksum
  113. # u2 u2 padding 0
  114. # u3 u3 region
  115. # u3 u3 offset [0x0203B400, ([0x030046B8]+1 & 0x3FF)*2] & 7
  116. # u6 u7 timezone [[0x030047A8], 0x20]
  117. # u3 u3 side [[0x030046A0], 0x2F8]h
  118. # u4 u4 style [[0x030046A0], 0x2FA]h
  119. # s8 s8 kills/8 [[0x030046A0], 0x1F0]h / 8
  120. # u7 u7 forge [[0x030046A0], 0x2FC]h
  121. # u6 u6 link-battles [[0x030046A0], 0x914]h
  122. # u6 u6 link-shops [[0x030046A0], 0x918]h + [[0x030047A8], 0x91A]h
  123. # s10 s10 sol/4096 [[0x030046A0], 0x1D8] / 4096
  124. # s8 s8 loan/256 [[0x030046A0], 0x1D4] / 256
  125. # u6 u6 hours [[0x030046A0], 0x2B4] / 60 / 60 / 60
  126. # u16 u16 titles [[0x030046A0], 0x1EE]h
  127. # u8[5] u8[9] name [[0x030046A0], 0x3C0]b...
  128. # u0 u15 padding 0
  129. # [0x030046A0] is heap allocated, typically 0x0203C400.
  130. #
  131. # The checksum offset is 18-bits and uses the constant 0x1021.
  132. # The encoding offset is 24-bits and uses the initializer 0xB8E6E.
  133. #
  134. # BOKTAI 3 PASSWORD
  135. # u16 checksum
  136. # u2 padding 0
  137. # u3 region
  138. # u3 offset [0x203B400, ([0x03005308] + 1 & 0x3FF) * 2] / 256 & 7
  139. # u6 timezone [[0x30053F8], 0x18]
  140. # u8 kills/8 [[0x2000710], 0x538]h / 8
  141. # u7 forges [[0x2000710], 0x664]h
  142. # u9 races [[0x2000710], 0x75A]h
  143. # u7 link-races [[0x2000710], 0x7B4]h
  144. # u1 cross-linked [[0x2000710], 0x75F]b
  145. # u6 endings [[0x2000710], 0x75E]b
  146. # u10 sol/4096 [[0x2000710], 0x520]
  147. # u8 loan/256 [[0x2000710], 0x51C]
  148. # u6 hours [[0x2000710], 0x614] / 60 / 60 / 60
  149. # u12 titles [[0x2000710], 0x536]h
  150. # u8[5] name [[0x2000710], 0x781]b...
  151. # u0 padding 0
  152. # [0x02000710] is heap allocated, typically 0x0203C400.
  153. #
  154. # The checksum offset is 18-bits and uses the constant 0x8005.
  155. # The encoding offset is 24-bits and uses the initializer 0x8C159.
  156. #
  157. # CAVEATS
  158. # I was unable to find a Shinbok password with what I labeled as the
  159. # "Cross-Linked" flag set. I labeled it that way because it seems to
  160. # only be modified in bytecode function 1657 at file offset 0xDF2D81
  161. # which references a string 9797 that translates as a wireless-adapter
  162. # communication error, and it seems as though the wireless-adapter is
  163. # only used for the crossover battles.
  164. #
  165. # DISASSEMBLY NOTES
  166. # Password generation functions:
  167. # Boktai 1 JP put 1: 0x12D2E4
  168. # Boktai 1 NA put 1: 0x12E7D4
  169. # Boktai 1 EU put 1: 0x12B244
  170. # Boktai 2 JP put 2: 0x12DC0
  171. # Boktai 2 NA put 2: 0x12C14
  172. # Boktai 2 EU put 2: 0x12ABC
  173. # Boktai 3 JP put 3: 0x44E6C
  174. # Boktai 3 JP put 2: 0x451BC
  175. # Password reading functions:
  176. # Boktai 2 JP get 1: 0x112B4
  177. # Boktai 2 NA get 1: 0x111E0
  178. # Boktai 2 EU get 1: 0x10FC8
  179. # Boktai 3 JP get 3: 0x450D8
  180. # Boktai 3 JP get 2: 0x453DC
  181. #
  182. # Boktai 1's titles are checked in bytecode function 37607 in this order:
  183. # 0 Trigger of Sol S Rank and all 42 parts
  184. # 1 Gun Master Level 3 lenses and all 42 parts
  185. # 6 Death 100 or more Continues
  186. # 5 Berserker Caught 400 or more times
  187. # 3 Bishop 500 or more Kills
  188. # 4 Queen 100 or less Kills
  189. # 2 Gladiator A win rate of 70% or more with at least 50 Link Battles
  190. # 10 Running Boy Punished 8 or more times
  191. # 9 Solar Menchant 50 or more Link Trades
  192. # 7 Solar Boy 600 or more Sol
  193. # 8 Dark Boy 100 or less Sol
  194. # 11 King S Rank
  195. # 12 Rook A-/A/A+ Rank
  196. # 13 Knight B-/B/B+ Rank
  197. # 14 Pawn C-/C/C+ Rank
  198. # 14 Pawn Default
  199. #
  200. # Boktai 2's "side" is calculated as follows:
  201. # 128*r/max(r+b, 1) > 70 ? 0 : 128*r/max(r+b, 1) > 58 ? 2 : 1
  202. # Where `r' is the number of frames of "red" Django action and `b' is
  203. # the number of frames of "black" Django action.
  204. #
  205. # Boktai 2's "style" is based on which weapon had the highest number of
  206. # frames in use rounded down to the nearest 15 minutes, or "No Style"
  207. # if there was a tie.
  208. #
  209. # Boktai 3's endings should be:
  210. # 1 Otenko lives.
  211. # 2 Both Otenko and Sabata live.
  212. # 4 Neither Otenko or Sabata live.
  213. # 8 Sabata lives.
  214. #
  215. # The checksums are CRC-16s initialized to 0xFFFF and with the result
  216. # inverted. The polynomial 0x1021 is used in the first two games, 0x8005
  217. # is used in the third, and 0x180D is used in the fourth game.
  218. #
  219. # The encoding algorithm is to initialize a value depending on the game,
  220. # and initialize the an accumulator variable to 0xFFFF. For each iteration
  221. # the current value by 0x6262C05D and increment it by 1, then xor the result
  222. # into the xor accumulator. This iteration in run a number of times
  223. # depending on the offset and 4 additional times, then before each iteration
  224. # starting at offset 4 until the end of the list the last 6-bits of the xor
  225. # accumulator are xored with the current 6-bit value.
  226. # Because of this truncation only the last 6 bits of any constant matters.
  227. # The initialization constants are 0x8C159 for games 1 and 3, 0xB8E6E for
  228. # game 2, and 0x5BB15 for game 4.
  229. #
  230. # BYTECODE NOTES
  231. # In Boktai 3 most things about the bytecode are the same as described
  232. # in github.com/Prof9/SolDec, though there are more 16-bit (control)
  233. # operators. The Boktai 3 function that executes them is at 0x21AC6C.
  234. #
  235. # The following are tables some useful addresses and where they are
  236. # found in RAM.
  237. #
  238. # note: Addresses starting with 0x08 indicate a location in the ROM.
  239. # RAM-Address Func-Table Func-Count BC-Offset BC-Start
  240. # JP1 0x03000648 0x08E1D738 0x13F6 0x08E52328 0x08EE9F17
  241. # NA1 0x03000648 0x08E0DA88 0x140A 0x08E41D4C 0x08EDA36F
  242. # EU1 0x03000650 0x08DE2FBC 0x140F 0x08EC1350 0x08F5D001
  243. # JP2 0x03000748 0x08CBF1A0 0x2D13 0x08D1337C 0x08DA9DB4
  244. # NA2 0x03000748 0x08C8B56C 0x390A 0x08CE4B9C 0x08D7BBF5
  245. # EU2 0x03000748 0x08CA1E8C 0x3F48 0x08E2F0EC 0x08ECC13C
  246. # JP3 0x02000438 0x08D5A860 0x4260 0x08DD6BA0 0x08E5F048
  247. #
  248. # In Boktai 1 the Func-Table is indexed like:
  249. # for (i = 0; i < Func-Count; i++)
  250. # if (Func-Table[i*2] == index)
  251. # return BC-Offset + (Func-Table[i*2+1] & 0x00FFFFFF)
  252. #
  253. # In others the Func-Table is indexed like:
  254. # BC-Offset + (Func-Table[(index & 0x7FFFFFFF) - 1] & 0x00FFFFFF)
  255. #
  256. # RAM-Address ??? String-Table String-Data
  257. # JP1 0x03000658 0x08E276F0 0x08E27700 0x08E2B72C
  258. # NA1 0x03000658 0x08E17AE0 0x08E17AF0 0x08E1BE1C
  259. # EU1 0x03000660 0x08DED03C 0x08DED04C 0x08E00E64
  260. # JP2 0x03000758 0x08CCA5F0 0x08CCA600 0x08CD1594
  261. # NA2 0x03000758 0x08C99998 0x08C999A8 0x08CA0A80
  262. # EU2 0x03000758 0x08CB1BB0 0x08CB1BC0 0x08CD3A58
  263. # JP3 0x02000448 0x08D6B1E4 0x08D6B1F8 0x08D74DDC
  264. #
  265. # The String-Table is indexed like:
  266. # String-Data + (String-Table[index] & 0x7FFFFFFF)
  267. # The strings are nul-terminated.
  268. #
  269. # ACKNOWLEDGMENTS
  270. # Most of the Lunar Knight / Boktai DS information, and the character
  271. # tables were copied from github.com/Prof9/LKPassDecode.
  272. #
  273. # github.com/Prof9/SolDec was very useful in understanding bytecode.
  274. #
  275. # The Boktai 3 translations and Japanese timezone names are from
  276. # github.com/moozilla/boktai3trans.
  277. # lmap shim for Tcl 8.5
  278. if {[info commands lmap] == ""} {
  279. proc lmap {args} {
  280. if {[llength $args] < 3 || [llength $args] % 2 != 1} {
  281. return -code error \
  282. {wrong # args: should be "lmap vars list ?vars list ...? body"}
  283. }
  284. set i 0
  285. for {set i 0} {$i < [llength $args] - 1} {incr i 2} {
  286. for {set j 0; set l {}} {$j < [llength [lindex $args $i]]} {incr j} {
  287. upvar [lindex $args $i $j] var$i,$j
  288. lappend l var$i,$j
  289. }
  290. lset args $i $l
  291. }
  292. set r {}
  293. foreach {*}[lrange $args 0 end-1] {
  294. lappend r [uplevel 1 [lindex $args end]]
  295. }
  296. return $r
  297. }
  298. }
  299. # dict map shim for Tcl 8.5
  300. if {[namespace which -command ::tcl::dict::map] == ""} {
  301. proc ::tcl::dict::map {vars dict body} {
  302. if {[llength $vars] != 2} {
  303. return -code error {must have exactly two variable names}
  304. }
  305. upvar 1 [lindex $vars 0] key [lindex $vars 1] value
  306. ::set r {}
  307. dict for {key value} $dict {
  308. ::set value [uplevel 1 $body]
  309. set r $key $value
  310. }
  311. return $r
  312. }
  313. namespace ensemble configure ::dict -map [dict replace \
  314. [namespace ensemble configure ::dict -map] map ::tcl::dict::map]
  315. }
  316. namespace eval bok {namespace export *}
  317. set bok::strings {en {
  318. games {
  319. jp1 {Bokura no Taiyō}
  320. jp2 {Zoku Bokura no Taiyō: Taiyō Shōnen Jango}
  321. jp3 {Shin Bokura no Taiyō: Gyakushū no Sabata}
  322. jp4 {Bokura no Taiyō: Django & Sabata}
  323. en1 {Boktai: The Sun Is in Your Hand}
  324. en2 {Boktai 2: Solar Boy Django}
  325. en3 {Boktai 3: Sabata's Counterattack}
  326. en4 {Lunar Knights}
  327. }
  328. labels {
  329. game-tabs {
  330. 1 Boktai 2 {Boktai 2 / Zoktai}
  331. 3 {Boktai 3 / Shinbok} 4 {Lunar Knights / Boktai DS}
  332. }
  333. keyboard-tabs {
  334. en64 Base64 lk64 {Base64 LK} jp64 {Base64 JP}
  335. en English ext {Latin Ext.}
  336. hiri Hirigana kata Katakana
  337. }
  338. padding Padding header-padding Padding
  339. region Region region-name Region
  340. checksum Checksum offset Offset
  341. sol Sol sol/4 Sol sol/4096 Sol
  342. loan Loan loan/256 Loan
  343. timezone Timezone timezone-name Timezone
  344. hours Hours minutes Minutes
  345. difficulty Difficulty difficulty-name Difficulty
  346. dungeons Dungeons clears Clears
  347. continues Continues caught Caught
  348. kills Kills kills/8 Kills
  349. rank Rank rank-name Rank
  350. forges Forges races Races
  351. link-battles Link-Battles link-trades Link-Trades
  352. link-shopping Link-Shopping
  353. link-races Link-Races cross-linked Cross-Linked
  354. title Title title-name Title
  355. titles Titles title-list Titles
  356. side Side side-name Side
  357. style Style style-name Style
  358. sword Sword sword-name Sword
  359. gun Gun gun-name Gun
  360. terrennial Terrennial terrennial-name Terrennial
  361. climate Climate climate-name Climate
  362. endings Endings ending-list Survivors
  363. name-dark Name(dark) name-solar Name(sol) name Name
  364. }
  365. regions {{Unknown Region #0} Japan {North America} Europe}
  366. timezones {jp {
  367. {Unknown Timezone #0}
  368. Ibaraki Tochigi Gunma Saitama
  369. Chiba Tokyo Kanagawa Ogasawara
  370. Niigata Toyama Ishikawa Fukui
  371. Yamanashi Nagano Gifu Shizuoka
  372. Aichi Mie Shiga Kyoto
  373. Osaka Hyougo Nara Wakayama
  374. Tottori Shimane Okayama Hiroshima
  375. Yamaguchi Tokushima Kagawa Ehime
  376. Kouchi Fukuoka Saga Nagasaki
  377. Kumamoto Ooita Miyazaki Kagoshima
  378. Okinawa Ishigakijima Sapporo Hakodate
  379. Asahikawa Kushiro Obihiro Aomori
  380. Iwate Miyagi Akita Yamagata
  381. Fukushima
  382. } na {
  383. {Unknown Timezone #0}
  384. {St. John's} {Labrador City} Halifax Quebec
  385. Montreal Ottawa Toronto Timmins
  386. Boston Albany Syracuse {New York}
  387. Philadelphia Pittsburgh {Washington D.C.} Norfolk
  388. Raleigh Charlotte Atlanta Jacksonville
  389. Tampa Miami Detroit Cleveland
  390. Columbus Lexington {Thunder Bay} Winnipeg
  391. Regina Thompson Indianapolis Chicago
  392. Milwaukee Minneapolis Bismark {St. Louis}
  393. Nashville Memphis Montgomery Jackson
  394. {New Orleans} {Des Moines} Lincoln {Kansas City}
  395. Topeka Springfield {Little Rock} {Oklahoma City}
  396. Dallas Houston Edmonton Calgary
  397. Yellowknife Denver Albuquerque Phoenix
  398. Boise {Salt Lake City} Vancouver Whitehorse
  399. Spokane Seattle Salem Reno
  400. {Las Vegas} {Los Angeles} {San Diego} {San Francisco}
  401. Anchorage Fairbanks Ketchikan Honolulu
  402. } eu {
  403. {Unknown Timezone #0}
  404. Reykjavik Dublin Cork London
  405. Cardiff Edinburgh Belfast Liverpool
  406. Lisbon Porto Valletta Madrid
  407. Barcelona Valencia {La Coruna} Seville
  408. Paris Brest Lyons Bordeaux
  409. Marseilles Brussels Bastogne Amsterdam
  410. Rotterdam Luxembourg Berlin Hamburg
  411. Essen Frankfurt Munich Bern
  412. Geneve Vaduz Wien Innsbruck
  413. Rome Genova Venezia Palermo
  414. Sassari Oslo Bergen Trondheim
  415. Copenhagen Odense Stockholm Gothenburg
  416. Helsinki Turku Mikkeli Warszawa
  417. Gdansk Poznan Wroclaw Krakow
  418. Praha Bratislava Kosice Budapest
  419. Bucuresti Ljubljana Zagreb Sarajevo
  420. Beograd Skopje Tirane Sofiya
  421. Athinai Thessaloniki Iraklion Ankara
  422. Istanbul Izmir Konya Adana
  423. Jerusalem Pretoria {Cape Town} Durban
  424. Wellington Auckland Dunedin Sydney
  425. Melbourne Adelaide Perth Brisbane
  426. }}
  427. ranks {S A+ A A- B+ B B- C+ C C- D+ D D- F+ F F-}
  428. difficulties {
  429. 1 {Easy {Normal 1} {Normal 2} Hard}
  430. 2 {}
  431. 3 {}
  432. 4 {Normal Hard Nightmare}
  433. }
  434. titles {1 {
  435. {Trigger of Sol} {Gun Master} Gladiator Bishop
  436. Queen Berserker Death {Solar Boy}
  437. {Dark Boy} {Solar Menchant} {Running Boy} King
  438. Rook Knight Pawn
  439. } 2 {
  440. {Sword Master} {Spear Master} {Hammer Master} {Fist Master}
  441. {Gun Master} Adept {Day Walker} {Adventurer}
  442. Agent Collector {Dark Hunter} {Grand Master}
  443. } 3 {
  444. Adept Gladiator {SP Agent} Champion
  445. {Dark Hunter} Alchemist Collector {Doll Master}
  446. Storyteller Grandmaster
  447. } 4 {
  448. {Dark Knight} {Sol Gunner} {Sword Master} {Gun Master}
  449. Guardian {Treasure Hunter} Collector Huntmaster
  450. {Shooting Star} Gladiator {Special Agent} Wanderer
  451. Adventurer {Grand Master}
  452. }}
  453. sides {Red Black Grey}
  454. styles {Sword Spear Hammer Gun Fists {No Style}}
  455. endings {Otenko Everybody Nobody Sabata}
  456. swords {Vanargand Jormungandr Hel}
  457. guns {Knight Dragoon Bomber Witch Ninja}
  458. terrennials {Toasty Nero Ursula Ezra Alexander Tove {War Rock}}
  459. climates {
  460. {Balmy Sub-Tropical} {Arid Desert} {Tropical Rainforest}
  461. {Humind-Continental} {Frigid Arctic}
  462. }
  463. }}
  464. # bok::@ is a shortcut to lookup a string in bok::strings. Arguments starting
  465. # with "#" are used as list indices, other arguments are used as dict keys.
  466. proc bok::@ {locale args} {
  467. variable strings
  468. set current [dict get $strings $locale]
  469. foreach arg $args {
  470. set current [expr {[string index $arg 0] == "#" ?
  471. [lindex $current [string range $arg 1 end]] : [dict get $current $arg]
  472. }]
  473. }
  474. return $current
  475. }
  476. # The character table is stored as a dictionary of lists indexed by the table's
  477. # number formatted as "0x%X". {0x0 0x1F 0x80 0x81 0x81}
  478. set bok::ctable {0x0 {
  479. � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � � �
  480. { } ! \" # ÷ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
  481. @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ × ] ^ _
  482. ` a b c d e f g h i j k l m n o p q r s t u v w x y z \{ | \} ¯ ⋅
  483. } 0x1F {
  484. � Ä � Ç É Ñ Ö Ü á à â ä � å ç é è ê ë í ì î ï ñ ó ò ô ö � ú ù û
  485. ü � ° � � � � � ß � � � � � � � � � � � � � � � � � � � � � � �
  486. � ¿ ¡ � � � � � « » � � À � � Œ œ � � � � � � � ý ÿ Ý � � � � �
  487. � � � � � � Â Ê Á Ë È Í Î Ï Ì Ó Ô � Ò Ú Û Ù � � � � � � � � � �
  488. } 0x80 {
  489. � あ い う え お か き く け こ さ し す せ そ
  490. よ た ち つ て と な に ぬ ね の は ひ ふ へ ほ
  491. 下 ま み む め も や ゆ よ ら り る れ ろ わ を
  492. 左 ん ぁ ぃ ぅ ぇ ぉ っ ゃ ゅ ょ が ぎ ぐ げ ご
  493. 右 ざ じ ず ぜ ぞ だ ぢ づ で ど ば び ぶ べ ぼ
  494. 東 ぱ ぴ ぷ ぺ ぽ 。 、 ~ ー … � � � � �
  495. 西 ア イ ウ エ オ カ キ ク ケ コ サ シ ス セ ソ
  496. 南 タ チ ツ テ ト ナ ニ ヌ ネ ノ ハ ヒ フ ヘ ホ
  497. 北 マ ミ ム メ モ ラ リ ル レ ロ ヤ ユ ヨ ワ ヲ
  498. 大 ン ァ ィ ゥ ェ ォ ッ ャ ュ ョ ガ ギ グ ゲ ゴ
  499. 中 ザ ジ ズ ゼ ゾ ダ ヂ ヅ デ ド バ ビ ブ ベ ボ
  500. 小 パ ピ プ ペ ポ ・ : ; 「 」 + × ℃ ℉ �
  501. � ↑ ↓ → ← ★ ♥ ♪ ヴ Ⅰ Ⅱ Ⅲ � � � �
  502. 風 白 黒 赤 青 黄 緑 金 銀 紫 � 火 炎 災 水 氷
  503. 永 太 陽 年 月 日 時 分 秒 春 夏 秋 冬 之 ヶ 々
  504. = 丈 片 己 凶 歯 � � � � � � � � � �
  505. } 0x81 {
  506. � 地 均 坂 塔 境 塊 填 場 増 堀 堤 壊 塚 域 城
  507. � 現 理 球 環 � � � � 切 � 功 攻 項 崎 靖
  508. 端 化 代 付 何 仕 任 仗 仲 伯 件 作 伝 休 体 仮
  509. 住 佐 他 使 便 信 倍 借 価 値 低 侮 個 保 係 供
  510. 侵 依 偉 備 偽 似 俊 傷 像 優 候 修 例 側 倒 働
  511. 健 併 佳 倫 停 傲 儀 � � � � � � � � �
  512. 衝 行 往 彼 役 徐 復 後 待 得 徳 術 街 御 徴 徹
  513. 衛 打 払 押 択 技 抜 投 抗 持 担 指 捨 排 抵 挑
  514. 推 提 携 授 接 掘 操 揮 捕 探 換 振 掛 援 拠 損
  515. 拡 把 握 掃 撤 � � � � � � � � � � �
  516. 状 牧 物 特 犠 牲 独 狙 猛 狂 狩 猫 狐 狼 獲 猟
  517. 獄 性 快 悦 怪 悟 怖 情 慎 慢 燐 憶 � � � �
  518. � 粒 料 粗 精 � � � � 灯 灼 焼 煙 燥 燃 爆
  519. 燼 札 材 林 杯 村 析 相 枚 板 松 根 格 槍 横 株
  520. 様 棺 桶 桿 植 橋 構 機 械 � 欄 樹 樋 椛 椿 模
  521. 根 標 � � � 和 利 科 称 程 種 移 秘 積 稼 稲
  522. } 0x82 {
  523. � 礼 祈 社 祝 神 視 福 � � � � 初 裕 複 被
  524. 捕 紅 紀 約 紋 紙 細 組 統 終 純 練 級 緒 経 絵
  525. 給 絃 納 紹 絡 結 続 継 絶 編 縁 博 織 総 縦 綾
  526. 締 績 網 縮 絆 幻 郷 � � 次 冷 凍 � � 議 論
  527. 訳 計 討 記 許 訓 詳 説 話 証 読 設 語 談 試 調
  528. 誤 課 誠 誘 護 認 謙 誕 識 謝 泡 汚 浪 液 涙 汰
  529. 沙 江 況 沢 泊 河 注 洋 泣 治 活 浴 浩 池 波 洗
  530. 流 法 決 油 消 温 浮 海 � � � � � � � �
  531. }}
  532. # bok::decstr converts a list of 8-bit integers to a string, mapping to
  533. # bok::ctable. If $tab is specified then the decoding only uses table $tab,
  534. # essentially assuming that each 8-bit integer is preceded by $tab.
  535. proc bok::decstr {src {tab ""}} {
  536. variable ctable
  537. if {$tab != ""} {
  538. set tab [format 0x%X $tab]
  539. if {![dict exists $ctable $tab]} {
  540. return -code error "invalid table 0x$tab"
  541. }
  542. }
  543. while {[lindex $src end] == 0} {
  544. set src [lreplace $src end end]
  545. }
  546. set r ""
  547. set state ""
  548. foreach c $src {
  549. if {$state == ""} {
  550. if {$tab == ""} {
  551. set state [format 0x%X $c]
  552. if {[dict exists $ctable $state]} {continue}
  553. set state [format 0x%X [expr {$c >> 8}]]
  554. } else {
  555. set state $tab
  556. }
  557. }
  558. if {[dict exists $ctable $state]} {
  559. append r [lindex [dict get $ctable $state] [expr {$c & 0xFF}]]
  560. } else {
  561. append r �
  562. }
  563. set state ""
  564. }
  565. return $r
  566. }
  567. # bok::encstr converts a string to a list of 8-bit integers, mapping from
  568. # bok::ctable. If $tab is specified the encoder only uses the $tab table,
  569. # essentially omitting the table-change characters.
  570. proc bok::encstr {src {tab ""}} {
  571. variable ctable
  572. if {$tab != ""} {
  573. set tab [format 0x%X $tab]
  574. if {![dict exists $ctable $tab]} {
  575. return -code error "invalid table 0x$tab"
  576. }
  577. }
  578. set k 0
  579. set r {}
  580. foreach c [split $src {}] {
  581. if {$c == "�"} {break}
  582. if {$tab != ""} {
  583. set k 0
  584. set t [lsearch -exact [dict get $ctable $tab] $c]
  585. } else {
  586. foreach {k s} $ctable {
  587. if {[set t [lsearch -exact $s $c]] >= 0} {break}
  588. }
  589. }
  590. if {$t < 0} {break}
  591. if {$k != "0"} {lappend r $k}
  592. lappend r $t
  593. }
  594. return $r
  595. }
  596. set bok::b64table {jp {
  597. あ い う え お か き く け こ さ し す せ そ た
  598. ち つ て と な に ぬ ね の は ひ ふ へ ほ ま み
  599. む め も や ゆ よ ら り る れ ろ わ を が ぎ ぐ
  600. げ ご ざ じ ず ぜ ぞ だ ぢ づ で ど ば び ぶ べ ぼ
  601. } en {
  602. B C D F G H J K L M N P Q R S T V W X Y Z
  603. b c d f g h j k l m n p q r s t v w x y z
  604. 0 1 2 3 4 5 6 7 8 9 ? ! @ # = ^ > / - _ + : .
  605. } lk {
  606. A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
  607. a b c d e f g h i j k l m n o p q r s t u v w x y z
  608. 1 2 3 4 5 6 7 8 9 0 ? = .
  609. }}
  610. # bok::decb64 decodes the base64 string $pass using the above tables into a list
  611. # of 6-bit integers, ignoring any [:space:] characters. If the $game is 4 the
  612. # "jp" & "lk" tables are used, otherwise the "jp" & "en" tables are used.
  613. proc bok::decb64 {pass {game 1} {lang ""}} {
  614. variable b64table
  615. set tables [list [dict get $b64table jp] \
  616. [dict get $b64table [expr {$game < 4 ? "en" : "lk"}]]]
  617. return [lmap c [split $pass {}] {
  618. foreach table $tables {
  619. if {[set j [lsearch -exact $table $c]] >= 0} {break}
  620. }
  621. if {[string is space $c] || $j >= 64} {continue}
  622. if {$j < 0} {return -code error "Invalid character: $c"}
  623. set j
  624. }]
  625. }
  626. # bok::encb64 encodes a base64 string from list, which is list of 6-bit integers
  627. # using the appropriate alphabet for the $game / $lang pair. $lang is set based
  628. # on the region if it is set to an empty string.
  629. proc bok::encb64 {list {game 1} {lang ""}} {
  630. variable b64table
  631. if {$lang == ""} {
  632. set lang [getlang $list $game 6]
  633. }
  634. set table [dict get $b64table [expr {
  635. $lang == "jp" ? "jp" : $game < 3 ? "en" : "lk"}]]
  636. return [join [lmap c $list {lindex $table $c}] {}]
  637. }
  638. # bok::spaceout inserts spaces every few characters for readability. It uses
  639. # the common amount for a particular $game and $lang combination. 5 if $game
  640. # is 4, 6 if $lang is "jp", and finally 8 if $lang is "en". Otherwise the
  641. # number guessed based on the length of $str.
  642. proc bok::spaceout {str {game ""} {lang ""}} {
  643. if {$game == "" && $lang == ""} {
  644. variable passwordlengths
  645. set k [lindex [dict keys [dict filter $passwordlengths value \
  646. [string length $str]]] 0]
  647. } else {
  648. set k $lang$game
  649. }
  650. switch -exact -- $k {
  651. 4 - en4 - jp4 {set n 5}
  652. jp - jp1 - jp2 - jp3 {set n 6}
  653. en - en1 - en2 - en3 {set n 8}
  654. default {return $str}
  655. }
  656. for {set i $n} {$i < [string length $str]} {incr i; incr i $n} {
  657. set str "[string range $str 0 $i-1] [string range $str $i end]"
  658. }
  659. return $str
  660. }
  661. # bok::getint gets an integer of width $count at bit-offset $offset from the
  662. # list $list of $width wide integers, interpreting it as a two's complement
  663. # signed integer if $sign is true. The bits are read and written LSb first.
  664. proc bok::getint {list offset count {sign 0} {width 6}} {
  665. set count [expr {min($count, [llength $list] * $width - $offset)}]
  666. for {set v 0; set i 0} {$i < $count} {incr i; incr offset} {
  667. set j [expr {$offset / $width}]
  668. set k [expr {$offset % $width}]
  669. set v [expr {$v | ([lindex $list $j] >> $k & 1) << $i}]
  670. }
  671. if {$sign && $count > 0 && ($v >> $count - 1 & 1)} {
  672. set v [expr {-(~$v + 1 & (1 << $count) - 1)}]
  673. }
  674. return $v
  675. }
  676. # bok::putint puts the integer $v of width $count into list $listvar at
  677. # bit-offset $offset. $listvar is a list of $width wide integers. Zeros are
  678. # added to the list as needed. $v is clamped to [0,2^$count) for unsigned
  679. # integers ($sign is false), and [-2^($count-1),2^($count-1)) for signed
  680. # integers ($sign is true). Signed numbers are converted to two's-complement
  681. # formatted $width wide unsigned integers before writing. The bits are written
  682. # and read LSb first.
  683. proc bok::putint {listvar v offset count {sign 0} {width 6}} {
  684. if {$listvar != ""} {upvar $listvar list} {set list {}}
  685. set m [expr {(1 << $count - ($sign && $count > 0 ? 1 : 0)) - 1}]
  686. set v [expr {$sign ? min(max($v, -($m + 1)), $m) + $m + 1 ^ $m + 1 :
  687. min(max($v, 0), $m)}]
  688. for {set i 0} {$i < $count} {incr i; incr offset} {
  689. set j [expr {$offset / $width}]
  690. set k [expr {$offset % $width}]
  691. while {[llength $list] <= $j} {lappend list 0}
  692. lset list $j [expr {
  693. [lindex $list $j] & ~(1 << $k) | ($v >> $i & 1) << $k}]
  694. }
  695. return $list
  696. }
  697. # bok::getstr gets the string converted from $count octets from the $list of
  698. # $width wide integers starting at bit-offset $offset. $table is passed to
  699. # bok::decstr along with the octets.
  700. proc bok::getstr {list offset count {table ""} {width 6}} {
  701. if {$table == "-"} {set table ""}
  702. if {$offset + $count * 8 > [llength $list] * $width} {
  703. set count [expr {[llength $list] * $width - $offset >> 3}]
  704. }
  705. for {set r {}; set i 0} {$i < $count} {incr i} {
  706. lappend r [getint $list [expr {$offset + $i * 8}] 8 0 $width]
  707. }
  708. return [decstr $r $table]
  709. }
  710. # bok::putstr puts $count octets from the encoded $str into $listvar at
  711. # bit-offset $offset. $listvar is a list of $width wide integers and $table
  712. # is passed to bok::encstr along with $str.
  713. proc bok::putstr {listvar str offset count {table ""} {width 6}} {
  714. if {$listvar != ""} {upvar $listvar list} {set list {}}
  715. if {$table == "-"} {set table ""}
  716. set l [encstr $str $table]
  717. for {set i 0} {$i < $count} {incr i} {
  718. set c [expr {$i < [llength $l] ? [lindex $l $i] : 0}]
  719. putint list $c [expr {$offset + $i * 8}] 8 0 $width
  720. }
  721. return $list
  722. }
  723. # bok::bitmaps is a dictionary of bitmaps with the keys being the password
  724. # language and the game number: {jp1 jp2 jp3 jp4 en1 en2 en3 en4}
  725. # each bitmap is a dictionary with list values: {type offset count modifier}
  726. # The type is either "int" or "str". The offset is the bit that the value
  727. # starts at. The count how long the value is in either bits (for type "int")
  728. # or octets (for type "str"). The modifier for type "int" is a boolean meaning
  729. # unsigned for false values or signed for true values; for type "str" it is the
  730. # character table to use with "-" indicating the default (""). The list items
  731. # after the type can be used directly as arguments to bok::getint/bok::putint
  732. # for type "int", or bok::getstr/bok::putstr for type "str".
  733. set bok::bitmaps {
  734. jp1 {
  735. region {int 0 3 0} checksum {int 3 16 0}
  736. offset {int 19 2 0} sol/4 {int 21 9 0}
  737. timezone {int 30 6 0} hours {int 36 6 0}
  738. minutes {int 42 6 0} difficulty {int 48 3 0}
  739. dungeons {int 51 5 0} clears {int 56 3 0}
  740. continues {int 59 4 0} caught {int 63 5 0}
  741. kills {int 68 7 0} rank {int 75 4 0}
  742. title {int 79 5 0} name {str 84 5 0x80}
  743. link-battles {int 124 6 0} link-trades {int 130 6 0}
  744. loan {int 136 8 0} padding {int 144 0 0}
  745. } jp2 {
  746. checksum {int 0 16 0} header-padding {int 16 2 0}
  747. region {int 18 3 0} offset {int 21 3 0}
  748. timezone {int 24 6 0} side {int 30 3 0}
  749. style {int 33 4 0} kills/8 {int 37 8 0}
  750. forges {int 45 7 0} link-battles {int 52 6 0}
  751. link-shopping {int 58 6 0} sol/4096 {int 64 10 1}
  752. loan/256 {int 74 8 1} hours {int 82 6 0}
  753. titles {int 88 16 0} name {str 104 5 0x80}
  754. padding {int 144 0 0}
  755. } jp3 {
  756. checksum {int 0 16 0} header-padding {int 16 2 0}
  757. region {int 18 3 0} offset {int 21 3 0}
  758. timezone {int 24 6 0} kills/8 {int 30 8 0}
  759. forges {int 38 7 0} races {int 45 9 0}
  760. link-races {int 54 7 0} cross-linked {int 61 1 0}
  761. endings {int 62 6 0} sol/4096 {int 68 10 0}
  762. loan/256 {int 78 8 0} hours {int 86 6 0}
  763. titles {int 92 12 0} name {str 104 5 0x80}
  764. padding {int 144 0 0}
  765. } jp4 {
  766. checksum {int 0 16 0} header-padding {int 16 2 0}
  767. region {int 18 3 0} offset {int 21 3 0}
  768. titles {int 24 14 0} difficulty {int 38 2 0}
  769. hours {int 40 7 0} sol/4096 {int 47 15 0}
  770. sword {int 62 3 0} gun {int 65 3 0}
  771. terrennial {int 68 3 0} climate {int 71 3 0}
  772. name-dark {str 74 10 -} name-solar {str 154 10 -}
  773. padding {int 234 6 0}
  774. } en1 {
  775. region {int 0 3 0} checksum {int 3 16 0}
  776. offset {int 19 2 0} sol/4 {int 21 9 0}
  777. timezone {int 30 7 0} hours {int 37 6 0}
  778. minutes {int 43 6 0} difficulty {int 49 3 0}
  779. dungeons {int 52 5 0} clears {int 57 3 0}
  780. continues {int 60 4 0} caught {int 64 5 0}
  781. kills {int 69 7 0} rank {int 76 4 0}
  782. title {int 80 5 0} name {str 85 9 0}
  783. link-battles {int 157 6 0} link-trades {int 163 6 0}
  784. loan {int 169 8 0} padding {int 177 15 0}
  785. } en2 {
  786. checksum {int 0 16 0} header-padding {int 16 2 0}
  787. region {int 18 3 0} offset {int 21 3 0}
  788. timezone {int 24 7 0} side {int 31 3 0}
  789. style {int 34 4 0} kills/8 {int 38 8 0}
  790. forges {int 46 7 0} link-battles {int 53 6 0}
  791. link-shopping {int 59 6 0} sol/4096 {int 65 10 1}
  792. loan/256 {int 75 8 1} hours {int 83 6 0}
  793. titles {int 89 16 0} name {str 105 9 0}
  794. padding {int 177 15 0}
  795. } en3 {
  796. checksum {int 0 16 0} header-padding {int 16 2 0}
  797. region {int 18 3 0} offset {int 21 3 0}
  798. timezone {int 24 7 0} kills/8 {int 31 8 0}
  799. forges {int 39 7 0} races {int 46 9 0}
  800. link-races {int 55 7 0} cross-linked {int 62 1 0}
  801. endings {int 63 6 0} sol/4096 {int 69 10 0}
  802. loan/256 {int 79 8 0} hours {int 87 6 0}
  803. titles {int 93 12 0} name {str 105 9 0}
  804. padding {int 177 15 0}
  805. } en4 {
  806. checksum {int 0 16 0} header-padding {int 16 2 0}
  807. region {int 18 3 0} offset {int 21 3 0}
  808. titles {int 24 14 0} difficulty {int 38 2 0}
  809. hours {int 40 7 0} sol/4096 {int 47 15 0}
  810. sword {int 62 3 0} gun {int 65 3 0}
  811. terrennial {int 68 3 0} climate {int 71 3 0}
  812. name-dark {str 74 10 -} name-solar {str 154 10 -}
  813. padding {int 234 6 0}
  814. }
  815. }
  816. # bok::getdict returns a dictionary created by reading values from the $list of
  817. # $width wide integers for each key in $args, or every key if $args is empty,
  818. # as specified in bok::bitmaps for the $game / $lang pair.
  819. proc bok::getdict {list game lang width args} {
  820. variable bitmaps
  821. if {[llength $args] == 0} {
  822. set args [dict keys [dict get $bitmaps $lang$game]]
  823. }
  824. set dict {}
  825. foreach key $args {
  826. if {![dict exists $bitmaps $lang$game $key]} {continue}
  827. lassign [dict get $bitmaps $lang$game $key] type offset count mod
  828. switch -exact -- $type str {
  829. dict set dict $key [getstr $list $offset $count $mod $width]
  830. } int {
  831. dict set dict $key [getint $list $offset $count $mod $width]
  832. }
  833. }
  834. return $dict
  835. }
  836. # bok::getkeys returns the list of values from calling bok::getdict.
  837. proc bok::getkeys {list game lang width args} {
  838. return [dict values [getdict $list $game $lang $width {*}$args]]
  839. }
  840. # bok::getkey returns only the value from calling bok::getdict with $key.
  841. proc bok::getkey {list game lang width key} {
  842. return [lindex [getkeys $list $game $lang $width $key] 0]
  843. }
  844. # bok::putdict inserts the values from each key/value pair into the $listvar of
  845. # $width wide integers as specified with the corresponding key in bok::bitmaps
  846. # for the $game / $lang pair.
  847. proc bok::putdict {listvar game lang width args} {
  848. variable bitmaps
  849. if {$listvar != ""} {upvar $listvar list} {set list {}}
  850. if {[llength $args] == 1} {set args [concat {*}$args]}
  851. if {[llength $args] % 2 != 0} {
  852. set usage {putdict listvar game lang width ?dict | key value ...?}
  853. return -code error "wrong # args: should be \"$usage\""
  854. }
  855. foreach {key value} $args {
  856. if {![dict exists $bitmaps $lang$game $key]} {continue}
  857. lassign [dict get $bitmaps $lang$game $key] type offset count mod
  858. switch -exact -- $type str {
  859. putstr list $value $offset $count $mod $width
  860. } int {
  861. putint list $value $offset $count $mod $width
  862. }
  863. }
  864. return $list
  865. }
  866. # bok::modkeys executes the last argument for each key given in $args, with
  867. # the key, value, and count values set to variables specified in $varnames.
  868. # If $varnames only contains one member then it is used for the storing the
  869. # value. The key and count values are from the bitmap specified in bok::bitmaps
  870. # for the $game / $lang pair, and the value itself is extracted from the list of
  871. # $width wide integers in $listvar. The result of the executed body is then
  872. # put back into $listvar in place of what was extracted. Non-existent or out
  873. # of range keys are ignored, continues skip overwriting the value, and breaks
  874. # exit early. This proc returns the final value of $listvar.
  875. proc bok::modkeys {listvar game lang width varnames args} {
  876. if {$listvar == "" || $varnames == "" || [llength $args] < 1} {
  877. set usage {modify listvar game lang width varnames ?key ...? body}
  878. return -code error "wrong # args: should be \"$usage\""
  879. }
  880. variable bitmaps
  881. upvar $listvar list
  882. if {[llength $varnames] > 1} {
  883. lassign $varnames keyname varname countvar
  884. if {$keyname != ""} {upvar $keyname key}
  885. if {$varname != ""} {upvar $varname var}
  886. if {$countvar != ""} {upvar $countvar count}
  887. } elseif {$varnames != ""} {
  888. upvar $varnames var
  889. }
  890. set body [lindex $args end]
  891. if {[llength $args] == 1} {
  892. set args [dict keys [dict get $bitmaps $lang$game]]
  893. } else {
  894. set args [lrange $args 0 end-1]
  895. }
  896. set max [expr {[llength $list] * $width}]
  897. foreach key $args {
  898. if {![dict exists $bitmaps $lang$game $key]} {continue}
  899. lassign [dict get $bitmaps $lang$game $key] type offset count mod
  900. if {$offset >= $max} {continue}
  901. switch -exact -- $type int {
  902. set var [getint $list $offset $count $mod $width]
  903. putint list [uplevel 1 $body] $offset $count $mod $width
  904. } str {
  905. set var [getstr $list $offset $count $mod $width]
  906. putstr list [uplevel 1 $body] $offset $count $mod $width
  907. }
  908. }
  909. return $list
  910. }
  911. # bok::getregion reads the region bits from the $list of $width wide integers
  912. # and returns a short region code, or an error.
  913. proc bok::getregion {list {game 1} {width 6}} {
  914. switch -exact -- [set t [getkey $list $game jp $width region]] {
  915. 1 {return jp} 2 {return na} 3 {return eu}
  916. }
  917. return -code error "Invalid region #$t"
  918. }
  919. # bok::getlang reads the region bits from the $list of $width wide integers and
  920. # returns a short language code or an error.
  921. proc bok::getlang {list {game 1} {width 6}} {
  922. switch -exact -- [set t [getkey $list $game jp $width region]] {
  923. 1 {return jp} 2 - 3 {return en}
  924. }
  925. return -code error "Invalid region #$t"
  926. }
  927. # bok::whichgame searches $dict for keys specific to a particular game, and
  928. # returns the game number of the first one found.
  929. proc bok::whichgame {dict} {
  930. foreach {key game} {
  931. dungeons 1 clears 1 caught 1 rank 1 title 1 link-trades 1
  932. rank-name 1 title-name 1
  933. side 2 style 2 link-shopping 2
  934. side-name 2 style-name 2
  935. races 3 link-races 3 cross-linked 3 endings 3
  936. sword 4 gun 4 terrennial 4 climate 4 name-dark 4 name-solar 4
  937. sword-name 4 gun-name 4 terrennial-name 4 climate-name 4
  938. } {
  939. if {[dict exists $dict $key]} {return $game}
  940. }
  941. return -code error "Unknown game"
  942. }
  943. # bok::checksum calculates the CRC-16 for the $list of 6-bit integers with an
  944. # initializer of 0xFFFF, the $game appropriate polynomial from bok::sumconsts,
  945. # and the output inverted, and starting at the offset from bok::sumoffsets.
  946. set bok::sumoffsets {4 3 3 3}
  947. set bok::sumconsts {0x1021 0x1021 0x8005 0x180D}
  948. proc bok::checksum {list {game 1}} {
  949. variable sumoffsets
  950. variable sumconsts
  951. for {
  952. set c [lindex $sumconsts $game-1]
  953. set v 0xFFFF
  954. set i [lindex $sumoffsets $game-1]
  955. } {$i < [llength $list]} {incr i} {
  956. set v [expr {$v ^ [lindex $list $i] << 8}]
  957. for {set j 0} {$j < 8} {incr j} {
  958. set v [expr {($v << 1 ^ (($v & 0x8000) ? $c : 0)) & 0xFFFF}]
  959. }
  960. }
  961. return [expr {~$v & 0xFFFF}]
  962. }
  963. # bok::xor encodes/decodes the password bits from the $list of 6-bit integers
  964. # using bok::xorconst and the $game appropriate initalizer from bok::xorconsts. # $m is the initialized value, $t is initialized to ~0, and the offset is
  965. # read from the $list. For each iteration $m is multiplied by bok::xorconst
  966. # then incremented by 1, and $t is xored by the result. After $offset plus 4
  967. # iterations, starting at index 4 until the end of the $list, each $list item
  968. # is xored by the last 6 bits of $t before the next iteration.
  969. # The encoded list is returned.
  970. # Using the full sized constants can casue unnecessary integer promotion,
  971. # and only the last 6 bits are used, so smaller constants are used here.
  972. #set bok::xorconsts {0x8C159 0xB8E6E 0x8C159 0x5BB15}
  973. set bok::xorconsts {0x19 0x2E 0x19 0x15}
  974. #set bok::xorconst 0x6262C05D
  975. set bok::xorconst 0x1D
  976. proc bok::xor {list {game 1}} {
  977. variable xorconsts
  978. variable xorconst
  979. for {
  980. set m [lindex $xorconsts $game-1]
  981. set t 0x3F
  982. set i -[getkey $list $game jp 6 offset]
  983. } {$i < [llength $list]} {incr i} {
  984. if {$i >= 4} {
  985. lset list $i [expr {[lindex $list $i] ^ $t}]
  986. }
  987. set m [expr {$xorconst * $m + 1 & 0x3F}]
  988. set t [expr {$t ^ $m}]
  989. }
  990. return $list
  991. }
  992. set bok::passwordlengths {
  993. jp1 24 jp2 24 jp3 24 jp4 40 en1 32 en2 32 en3 32 en4 40
  994. }
  995. # bok::decpass decodes the base64 string $password into a dictionary.
  996. proc bok::decpass {password {game 1} {lang ""}} {
  997. variable passwordlengths
  998. set l [decb64 $password $game]
  999. if {$lang == ""} {
  1000. set lang [getlang $l $game]
  1001. }
  1002. set passlen [dict get $passwordlengths $lang$game]
  1003. if {[llength $l] != $passlen} {
  1004. return -code error "Invalid length: [llength $l] != $passlen"
  1005. }
  1006. set sum [checksum $l $game]
  1007. set l [xor $l $game]
  1008. set dict [getdict $l $game $lang 6]
  1009. if {[dict get $dict checksum] != $sum} {
  1010. dict append dict checksum "!=$sum"
  1011. }
  1012. return $dict
  1013. }
  1014. # bok::encpass encodes $dict into a base64 password.
  1015. proc bok::encpass {dict {lang ""}} {
  1016. if {$lang == ""} {
  1017. set lang [lindex {jp jp en en} [dict get $dict region]]
  1018. }
  1019. set game [whichgame $dict]
  1020. set l [xor [putdict {} $game $lang 6 $dict] $game]
  1021. putdict l $game $lang 6 checksum [checksum $l $game]
  1022. return [encb64 $l $game $lang]
  1023. }
  1024. # bok::normalizelist sets {*}$skey in $dictvar based on the value of {*}$vkey
  1025. # based on the strings in $list, or vice versa. $name is used for error
  1026. # messages, and defaults to the last element of $vkey. If $robust is set then
  1027. # no errors are returned for invalid values, or known invalid strings.
  1028. proc bok::normalizelist {dictvar list vkey skey {name ""} {robust 0}} {
  1029. upvar $dictvar dict
  1030. if {$name == ""} {
  1031. set name [lindex $vkey end]
  1032. }
  1033. set inval "Invalid $name #"
  1034. set unknown "Unknown $name #"
  1035. if {[dict exists $dict {*}$vkey]} {
  1036. set v [dict get $dict {*}$vkey]
  1037. set s "$unknown$v"
  1038. if {$v >= 0 && $v < [llength $list]} {
  1039. set s [lindex $list $v]
  1040. }
  1041. if {!$robust && $s == "$unknown$v"} {
  1042. return -code error $s
  1043. }
  1044. dict set dict {*}$skey $s
  1045. } elseif {[dict exists $dict {*}$skey]} {
  1046. set s [dict get $dict {*}$skey]
  1047. set v [lsearch -exact -nocase $list $s]
  1048. if {$v < 0 && [string first $inval $s] == 0} {
  1049. set v [string range $s [string length $inval] end]
  1050. if {![string is integer $v]} {set v -1}
  1051. if {!$robust} {
  1052. return -code error $s
  1053. }
  1054. } elseif {$v < 0 && [string first $unknown $s] == 0} {
  1055. set v [string range $s [string length $unknown] end]
  1056. if {![string is integer $v]} {set v -1}
  1057. if {!$robust} {
  1058. return -code error $s
  1059. }
  1060. }
  1061. if {$v < 0} {
  1062. return -code error "Invalid [lindex $skey end]: $s"
  1063. }
  1064. dict set dict {*}$vkey $v
  1065. }
  1066. }
  1067. # bok::normalizebits sets {*}$lkey in $dictvar based on the value of {*}$vkey
  1068. # based on the strings in $list, or vice versa. $name is used for error
  1069. # messages, and defaults to the last element of $vkey. If $robust is set then
  1070. # invalid values and items are ignored.
  1071. proc bok::normalizebits {dictvar list vkey lkey {name ""} {robust 0}} {
  1072. upvar $dictvar dict
  1073. if {$name == ""} {
  1074. set name [lindex $vkey end]
  1075. }
  1076. if {[dict exists $dict {*}$vkey]} {
  1077. dict set dict {*}$vkey [format 0x%0[expr {
  1078. [llength $list] + 3 >> 2
  1079. }]X [dict get $dict {*}$vkey]]
  1080. set v [dict get $dict {*}$vkey]
  1081. for {set i 0; set l {}} {$i < [llength $list]} {incr i} {
  1082. if {$v & 1 << $i} {
  1083. set v [expr {$v ^ 1 << $i}]
  1084. lappend l [lindex $list $i]
  1085. }
  1086. }
  1087. if {!$robust && $v != 0} {
  1088. for {} {!($v & 1 << $i)} {incr i} {}
  1089. return -code error "Unknown $name #$i"
  1090. }
  1091. dict set dict {*}$lkey $l
  1092. } elseif {[dict exists $dict {*}$lkey]} {
  1093. set v 0
  1094. foreach item [dict get $dict {*}$lkey] {
  1095. set i [lsearch -exact -nocase $list $item]
  1096. if {!$robust && $i < 0} {
  1097. return -code error "Unknown $name: $item"
  1098. }
  1099. set v [expr {$v | ($i >= 0 ? 1 << $i : 0)}]
  1100. }
  1101. dict set dict {*}$vkey $v
  1102. }
  1103. }
  1104. # bok::normalize normalizes the provided dictionary using $locale strings
  1105. # such that if "sol/4096" or "timezone-name" exists then "sol" and "timezone"
  1106. # will contain the equivalent value in the result. If $robust is set then no
  1107. # ignorable errors are returned.
  1108. proc bok::normalize {dict {locale en} {robust 0}} {
  1109. # Identify game, language, and region
  1110. set game [whichgame $dict]
  1111. normalizelist dict [@ $locale regions] region region-name \
  1112. [@ $locale labels region] $robust
  1113. set region [expr {[dict exists $dict region] ? [dict get $dict region] : -1}]
  1114. if {!$robust && ($region < 1 || $region > 3)} {
  1115. return -code error "Unknown region"
  1116. }
  1117. set lang [lindex {?? jp en en ?? ?? ?? ??} $region]
  1118. set region [lindex {?? jp na eu ?? ?? ?? ??} $region]
  1119. # Normalize
  1120. dict set dict game $game
  1121. dict set dict game-name [@ $locale games $lang$game]
  1122. if {![dict exists $dict header-padding]} {dict set dict header-padding 0}
  1123. if {![dict exists $dict padding]} {dict set dict padding 0}
  1124. if {![dict exists $dict offset]} {dict set dict offset 0}
  1125. # Sol
  1126. if {[dict exists $dict sol]} {
  1127. dict set dict sol/4 [expr {int([dict get $dict sol] / 4)}]
  1128. dict set dict sol/4096 [expr {int([dict get $dict sol] / 4096)}]
  1129. } elseif {[dict exists $dict sol/4]} {
  1130. dict set dict sol [expr {[dict get $dict sol/4] * 4}]
  1131. dict set dict sol/4096 [expr {int([dict get $dict sol/4] / 1024)}]
  1132. } elseif {[dict exists $dict sol/4096]} {
  1133. dict set dict sol [expr {[dict get $dict sol/4096] * 4096}]
  1134. dict set dict sol/4 [expr {[dict get $dict sol/4096] * 1024}]
  1135. }
  1136. # Kills
  1137. if {[dict exists $dict kills]} {
  1138. dict set dict kills/8 [expr {int([dict get $dict kills] / 8)}]
  1139. } elseif {[dict exists $dict kills/8]} {
  1140. dict set dict kills [expr {[dict get $dict kills/8] * 8}]
  1141. }
  1142. # Loan
  1143. if {[dict exists $dict loan]} {
  1144. dict set dict loan/256 [expr {int([dict get $dict loan] / 256)}]
  1145. } elseif {[dict exists $dict loan/256]} {
  1146. dict set dict loan [expr {[dict get $dict loan/256] * 256}]
  1147. }
  1148. # Timezone
  1149. set l [@ $locale timezones]
  1150. if {[dict exists $l $region]} {
  1151. normalizelist dict [dict get $l $region] timezone timezone-name \
  1152. [@ $locale labels timezone] $robust
  1153. }
  1154. # Boktai 1
  1155. normalizelist dict [@ $locale ranks] rank rank-name [@ $locale labels rank] \
  1156. $robust
  1157. normalizelist dict [@ $locale titles 1] title title-name \
  1158. [@ $locale labels title] $robust
  1159. normalizelist dict [@ $locale difficulties $game] difficulty difficulty-name \
  1160. [@ $locale labels difficulty] $robust
  1161. # Boktai 2
  1162. normalizelist dict [@ $locale sides] side side-name [@ $locale labels side] \
  1163. $robust
  1164. normalizelist dict [@ $locale styles] style style-name \
  1165. [@ $locale labels style] $robust
  1166. # Boktai 2, Boktai 3, and Lunar Knight's Titles
  1167. normalizebits dict [@ $locale titles $game] titles title-list \
  1168. [@ $locale labels titles] $robust
  1169. # Boktai 3's Endings
  1170. normalizebits dict [@ $locale endings] endings ending-list \
  1171. [@ $locale labels endings] $robust
  1172. # Lunar Knights favorites
  1173. normalizelist dict [@ $locale swords] sword sword-name \
  1174. [@ $locale labels sword] $robust
  1175. normalizelist dict [@ $locale guns] gun gun-name [@ $locale labels gun] \
  1176. $robust
  1177. normalizelist dict [@ $locale terrennials] terrennial terrennial-name \
  1178. [@ $locale labels terrennial] $robust
  1179. normalizelist dict [@ $locale climates] climate climate-name \
  1180. [@ $locale labels climate] $robust
  1181. return $dict
  1182. }
  1183. namespace eval bok::ui {
  1184. namespace export *
  1185. namespace import [namespace parent]::*
  1186. }
  1187. # bok::ui::info returns a list of ui element types, values, and defaults
  1188. # depending on the values of $game, $region, and $locale. Most values and
  1189. # defaults can be dictionaries keyed by region. A key of "-" makes the next
  1190. # widget always start on a new row.
  1191. # key {int {min ?max?} ?defaults? ?step?}
  1192. # key {string {max ?maxbytes?} ?defaults? ?restrict?}
  1193. # key {list ?values? ?defaults?}
  1194. # key {boolean ?default?}
  1195. # key {bits values ?default?}
  1196. # - {}
  1197. proc bok::ui::info {game {region na} {locale en}} {
  1198. set region [expr {max([region $region $locale num] - 1, 0)}]
  1199. set timezone [expr {
  1200. $region == 0 ? 5 : $region == 2 ? 21 : $region == 1 ? 14 : 0
  1201. }]
  1202. set timezonelists [dict map {key value} [@ $locale timezones] {
  1203. lrange $value 1 end
  1204. }]
  1205. set regions [lrange [@ $locale regions] 1 end]
  1206. switch -exact -- $game 1 {
  1207. return [dict create \
  1208. region-name [list list $regions $region] \
  1209. offset {int {0 3}} \
  1210. sol {int {0 0x7FC 4}} \
  1211. timezone-name [list regionlist $timezonelists {jp 5 na 14 eu 21}] \
  1212. - {} hours {int {0 63}} minutes {int {0 59} 1} \
  1213. difficulty-name [list list [@ $locale difficulties 1] 2] \
  1214. dungeons {int {0 29}} \
  1215. clears {int {1 7}} continues {int {0 15}} \
  1216. caught {int {0 31}} kills {int {0 127}} \
  1217. rank-name [list list [@ $locale ranks]] \
  1218. title-name [list list [@ $locale titles 1]] \
  1219. name {string {jp 5 na 9 eu 9} {jp ジャンゴ na Django eu Django} 1} \
  1220. link-battles {int {0 63}} link-trades {int {0 63}} \
  1221. loan {int {0 255}} \
  1222. ]
  1223. } 2 {
  1224. return [dict create \
  1225. region-name [list list $regions $region] \
  1226. offset {int {0 7}} \
  1227. timezone-name [list regionlist $timezonelists {jp 5 na 14 eu 21}] \
  1228. side-name [list list [@ $locale sides]] \
  1229. style-name [list list [@ $locale styles]] \
  1230. kills {int {0 0x7F8 8}} \
  1231. forges {int {0 127}} \
  1232. link-battles {int {0 63}} link-shopping {int {0 63}} \
  1233. sol {int {0 0x1FF000 0x1000}} loan {int {0 0x7F00 0x100}} \
  1234. hours {int {0 63}} \
  1235. name {string {jp 5 na 9 eu 9} {jp ジャンゴ na Django eu Django} 1} \
  1236. title-list [list bits [@ $locale titles 2] 0x40] \
  1237. ]
  1238. } 3 {
  1239. return [dict create \
  1240. region-name [list list [lindex $regions 0] 0] \
  1241. offset {int {0 7}} \
  1242. timezone-name [list regionlist $timezonelists {jp 5 na 14 eu 21}] \
  1243. kills {int {0 0x7F8 8}} forges {int {0 127}} races {int {0 511}} \
  1244. link-races {int {0 127}} cross-linked {boolean} \
  1245. sol {int {0 0x3FF000 0x1000}} loan {int {0 0xFF00 0x100}} \
  1246. hours {int {0 63}} \
  1247. name {string {jp 5 na 9 eu 9} {jp ジャンゴ na Django eu Django} 1} \
  1248. ending-list [list bits [@ $locale endings] 1] \
  1249. title-list [list bits [@ $locale titles 3]] \
  1250. ]
  1251. } 4 {
  1252. return [dict create \
  1253. region-name [list list $regions $region] \
  1254. offset {int {0 7}} \
  1255. difficulty-name [list list [@ $locale difficulties 4]] \
  1256. hours {int {0 127}} sol {int {0 0x7FFF000 0x1000}} \
  1257. - {} \
  1258. sword-name [list list [@ $locale swords]] \
  1259. gun-name [list list [@ $locale guns]] \
  1260. terrennial-name [list list [@ $locale terrennials]] \
  1261. climate-name [list list [@ $locale climates]] \
  1262. - {} \
  1263. name-dark {string {jp {5 10} na 10 eu 10}
  1264. {jp サバタ na Lucian eu Lucian}} \
  1265. name-solar {string {jp {5 10} na 10 eu 10}
  1266. {jp ジャンゴ na Aaron eu Aaron}} \
  1267. title-list [list bits [@ $locale titles 4]] \
  1268. ]
  1269. }
  1270. }
  1271. # bok::ui::region translates the $str to the region "number", two-letter "code",
  1272. # "name", or a list of all three depending on $type. $locale selects which
  1273. # region list from bok::strings to use.
  1274. proc bok::ui::region {str {locale en} {type code}} {
  1275. set dict {}
  1276. switch -glob -nocase -- $str {
  1277. jp - japan - japanese {dict set dict region 1}
  1278. na - north?america - northamerica - america {dict set dict region 2}
  1279. us - usa - united?states - unitedstates {dict set dict region 2}
  1280. en - english {dict set dict region 2}
  1281. eu - europe {dict set dict region 3}
  1282. default {dict set dict region-name $str}
  1283. }
  1284. normalizelist dict [@ $locale regions] region region-name \
  1285. [@ $locale labels region] 1
  1286. set region [dict get $dict region]
  1287. set str [dict get $dict region-name]
  1288. set code [lindex {?? jp na eu ?? ?? ?? ??} $region]
  1289. switch -exact -- $type {
  1290. short - code {
  1291. return $code
  1292. } string - str - name {
  1293. return $str
  1294. } number - num {
  1295. return $region
  1296. } default {
  1297. return [list $region $code $str]
  1298. }}
  1299. }
  1300. # bok::ui::init initializes a grid of widgets in frame $window based on the
  1301. # values from bok::ui::info for region $region. Valid options are -locale to
  1302. # set the locale to use, -columns for the number of columns of label/entry pairs
  1303. # to use, -bind for a list of bindings for matching elements, -style for a list
  1304. # of styles for matching elements, -fontsize for the base font size, and
  1305. # -validate to pass when creating widgets.
  1306. # -bind and -style keys can match either the widget type, the widget subtype,
  1307. # the widget path, or "all". For example button $widget.password.cycleoffset
  1308. # matches the widget path, button, password.button, or "all".
  1309. proc bok::ui::init {window region game args} {
  1310. set usage {init path {jp|na|eu} {1|2|3|4} ?-option value ...?}
  1311. if {[llength $args] % 2 != 0} {
  1312. return -code error "wrong # args: should be \"$usage\""
  1313. }
  1314. set options [dict create \
  1315. -locale en -columns 2 -bind {} -style {} -fontsize 10 -validate all]
  1316. foreach {opt arg} $args {
  1317. switch -exact -- $opt -locale - -columns - -fontsize - -validate {
  1318. dict set options $opt $arg
  1319. } -bind - -style {
  1320. dict lappend options $opt {*}$arg
  1321. } default {
  1322. return -code error "bad option: $opt"
  1323. }
  1324. }
  1325. set columns [expr {[dict get $options -columns] * 2}]
  1326. set locale [dict get $options -locale]
  1327. set region [region $region $locale]
  1328. if {$region == "??" || $game < 1 || $game > 4} {
  1329. return -code error "wrong args: should be \"$usage\""
  1330. }
  1331. if {![winfo exists $window]} {
  1332. ttk::frame $window
  1333. }
  1334. set row 0
  1335. set col $columns
  1336. grid [ttk::frame $window.password] \
  1337. -row $row -column 0 -columnspan $columns -sticky nsew
  1338. pack [ttk::button $window.password.encode -text ↱ -width 2 -takefocus 0 \
  1339. -command [list [namespace current]::encode $window $game $locale]
  1340. ] -padx 2p -side left
  1341. pack [ttk::entry $window.password.entry \
  1342. -font "mono [expr {int([dict get $options -fontsize]*1.2)}]"] \
  1343. -expand 1 -side left -fill x
  1344. pack [ttk::button $window.password.cycleoffset -text ↻ -width 2 -takefocus 0 \
  1345. -command [list [namespace current]::cycleoffset $window $game]
  1346. ] -padx 2p -side left
  1347. pack [ttk::button $window.password.decode -text ↴ -width 2 -takefocus 0 \
  1348. -command [list [namespace current]::decode $window $game $locale]
  1349. ] -padx 2p -side left
  1350. set elements [list \
  1351. frame password $window.password \
  1352. button password.button $window.password.encode \
  1353. entry password.entry $window.password.entry \
  1354. button password.button $window.password.cycleoffset \
  1355. button password.button $window.password.decode
  1356. ]
  1357. set sublabellengths {}
  1358. foreach {key list} [info $game $locale] {
  1359. if {$list == ""} {
  1360. set col $columns
  1361. continue
  1362. }
  1363. if {[lindex $list 0] == "bits"} {
  1364. set col $columns
  1365. }
  1366. if {[incr col] >= $columns} {
  1367. set col 0
  1368. incr row
  1369. }
  1370. grid [ttk::label $window.$key\-label -anchor e \
  1371. -text [@ $locale labels $key]:
  1372. ] -row $row -column $col -sticky new
  1373. if {[lindex $list 0] != "bits"} {
  1374. bind $window.$key\-label <ButtonPress> [list focus $window.$key]
  1375. }
  1376. incr col
  1377. lappend elements label $key.label $window.$key\-label
  1378. switch -exact -- [lindex $list 0] string {
  1379. lassign [lrange $list 1 end] l default type
  1380. grid [ttk::entry $window.$key -validate [dict get $options -validate] \
  1381. -validatecommand [list [namespace current]::validatestring \
  1382. $window %W %V %s %P $l $default $locale $type] \
  1383. -font "sans [dict get $options -fontsize]"
  1384. ] -row $row -column $col -sticky new
  1385. if {[llength $default] > 1} {
  1386. set default [dict get $default $region]
  1387. }
  1388. $window.$key insert 0 $default
  1389. lappend elements entry string $window.$key
  1390. } int {
  1391. lassign [lrange $list 1 end] l default
  1392. if {$default == ""} {set default [lindex $l 0]}
  1393. if {[llength $l] == 1} {lappend l $l}
  1394. lappend l 1
  1395. grid [ttk::spinbox $window.$key \
  1396. -font "sans [dict get $options -fontsize]" \
  1397. -from [lindex $l 0] -to [lindex $l 1] -increment [lindex $l 2] \
  1398. -validate [dict get $options -validate] \
  1399. -validatecommand [list \
  1400. [namespace current]::validateint $window %W %V %s %P $default]
  1401. ] -row $row -column $col -sticky new
  1402. if {[llength $default] > 1} {set default [dict get $default $region]}
  1403. $window.$key set $default
  1404. lappend elements spinbox int $window.$key
  1405. } boolean {
  1406. set default [lindex $list 1]
  1407. grid [ttk::checkbutton $window.$key] -row $row -column $col -sticky new
  1408. $window.$key state !alternate
  1409. if {[llength $default] > 1} {set default [dict get $default $region]}
  1410. if {$default != "" && !!$default} {
  1411. $window.$key state selected
  1412. }
  1413. bind $window.$key\-label <ButtonPress> [list $window.$key invoke]
  1414. lappend elements checkbutton boolean $window.$key
  1415. } regionlist - list {
  1416. lassign [lrange $list 1 end] l default
  1417. if {[lindex $list 0] == "regionlist"} {set l [dict get $l $region]}
  1418. grid [ttk::combobox $window.$key -state readonly -values $l \
  1419. -font "sans [dict get $options -fontsize]" \
  1420. ] -row $row -column $col -sticky new
  1421. if {[llength $default] > 1} {set default [dict get $default $region]}
  1422. $window.$key current [expr {$default == "" ? 0 : $default}]
  1423. lappend elements combobox [lindex $list 0] $window.$key
  1424. } bits {
  1425. lassign [lrange $list 1 end] l default
  1426. if {[llength $default] > 1} {set default [dict get $default $region]}
  1427. grid [ttk::frame $window.$key -borderwidth 1] \
  1428. -column $col -row $row -columnspan [expr {$columns - $col}] -sticky new
  1429. set i 0
  1430. set x 0
  1431. set y 0
  1432. foreach k $l {
  1433. lappend elements label bits.label $window.$key.l$i
  1434. grid [ttk::label $window.$key.l$i -text $k: -anchor e \
  1435. -font "sans [dict get $options -fontsize]"] \
  1436. -column $x -row $y -sticky new
  1437. bind $window.$key.l$i <ButtonPress> [list $window.$key.$i invoke]
  1438. if {![dict exists $sublabellengths $x] ||
  1439. [dict get $sublabellengths $x] < [string length $k:]} {
  1440. dict set sublabellengths $x [string length $k:]
  1441. }
  1442. incr x
  1443. grid [ttk::checkbutton $window.$key.$i] \
  1444. -column $x -row $y -sticky new
  1445. $window.$key.$i state !alternate
  1446. if {$default != "" && ($default & 1 << $i) != 0} {
  1447. $window.$key.$i state selected
  1448. }
  1449. if {[incr x] >= $columns * 2} {
  1450. set x 0
  1451. incr y
  1452. }
  1453. lappend elements checkbutton bits.checkbutton $window.$key.$i
  1454. incr i
  1455. }
  1456. if {$x > 0} {
  1457. set x 0
  1458. incr y
  1459. }
  1460. grid $window.$key -rowspan $y
  1461. set col $columns
  1462. incr row [expr {$y - 1}]
  1463. lappend elements frame bits $window.$key
  1464. }
  1465. }
  1466. if {$col > 0} {
  1467. incr row
  1468. }
  1469. grid [ttk::label $window.error -text ✓] -column 0 -row $row -sticky sew \
  1470. -columnspan $columns
  1471. for {set col 1} {$col < $columns} {incr col 2} {
  1472. grid columnconfigure $window $col -weight 1
  1473. }
  1474. for {set col 0} {$col < $columns} {incr col} {
  1475. grid columnconfigure $window $col -pad 4p
  1476. }
  1477. for {set y 0} {$y < $row} {incr y} {
  1478. grid rowconfigure $window $y -pad 2p
  1479. }
  1480. bind $window.region-name <<ComboboxSelected>> \
  1481. [list [namespace current]::updateregion $window $game $locale]
  1482. foreach {type key w} $elements {
  1483. switch -exact -- $key bits {
  1484. dict for {col width} $sublabellengths {
  1485. foreach label [grid slaves $w -column $col] {
  1486. $label configure -width $width
  1487. }
  1488. }
  1489. }
  1490. foreach {k binding} [dict get $options -bind] {
  1491. if {[string equal -nocase $k all] ||
  1492. [string equal -nocase $k $type] ||
  1493. [string equal -nocase $k $key]} {
  1494. foreach {pat body} $binding {
  1495. bind $w $pat $body
  1496. }
  1497. }
  1498. }
  1499. foreach {k style} [dict get $options -style] {
  1500. if {[string equal -nocase $k all] ||
  1501. [string equal -nocase $k $type] ||
  1502. [string equal -nocase $k $key]} {
  1503. $w configure -style $style
  1504. }
  1505. }
  1506. }
  1507. return $window
  1508. }
  1509. # bok::ui::updateregion updates any region dependant entries/lists in $window
  1510. # based on the value of $window.region-name and $locale.
  1511. proc bok::ui::updateregion {window game {locale en}} {
  1512. set region [region [$window.region-name get] $locale]
  1513. if {$region == "??"} {
  1514. $window.timezone-name set [@ $locale timezones \#0]
  1515. $window.timezone-name configure state disabled
  1516. return
  1517. }
  1518. set lang [expr {$region == "jp" ? "jp" : "en"}]
  1519. set pass [decb64 [$window.password.entry get] $game]
  1520. modkeys pass $game $lang 6 {k v} region {
  1521. expr {$region == "jp" ? 1 : $region == "na" ? 2 : 3}
  1522. }
  1523. foreach {key list} [info $game $region $locale] {
  1524. switch -exact -- [lindex $list 0] regionlist {
  1525. $window.$key configure -values [dict get [lindex $list 1] $region]
  1526. if {[llength [lindex $list 2]] > 1} {
  1527. $window.$key current [dict get [lindex $list 2] $region]
  1528. } elseif {[lindex $list 2] != ""} {
  1529. $window.$key current [lindex $list 2]
  1530. } else {
  1531. $window.$key current 0
  1532. }
  1533. } string {
  1534. $window.$key validate
  1535. }
  1536. }
  1537. if {[llength $pass] > 0} {
  1538. $window.password.entry delete 0 end
  1539. $window.password.entry insert 0 [spaceout [
  1540. encb64 $pass $game $lang] $game $lang]
  1541. }
  1542. }
  1543. # bok::ui::validatestring validates the string in entry $window.
  1544. # $root is the frame initialized by bok::ui::init, $window is the entry, $type
  1545. # is the event type, $old is the old value, $new is the new value, $max is
  1546. # {max ?maxbytes?} which limits the length of the string, default is either a
  1547. # default string or a dictionary of default strings where the region in $root
  1548. # is used as the key, $locale is the locale to use for the region name, and
  1549. # $restrict if true restricts the character table to either 0x80 if the region
  1550. # is Japan, or 0 otherwise.
  1551. proc bok::ui::validatestring {root window type old {new {}} {max 0} {default {}}
  1552. {locale en} {restrict 0}} {
  1553. set region [region [$root.region-name get] $locale]
  1554. set tab [expr {
  1555. $restrict == "" || !$restrict ? "" : $region == "jp" ? 0x80 : 0
  1556. }]
  1557. if {[llength $max] > 2} {set max [dict get $max $region]}
  1558. if {[llength $max] == 1} {lappend max $max}
  1559. lassign $max max bytemax
  1560. switch -exact -- $type key {
  1561. set list [encstr $new $tab]
  1562. return [expr {
  1563. ($max <= 0 || [string length $new] <= $max) &&
  1564. ($bytemax <= 0 || [llength $list] <= $bytemax) &&
  1565. [decstr $list $tab] == $new
  1566. }]
  1567. } default {
  1568. if {$old != ""} {
  1569. set list [encstr $new $tab]
  1570. if {$bytemax > 0 && [llength $list] > $bytemax} {
  1571. set list [lrange $list 0 $bytemax-1]
  1572. }
  1573. set new [decstr $list $tab]
  1574. if {$max > 0 && [string length $new] > $max} {
  1575. set new [string range $new 0 $max-1]
  1576. }
  1577. if {$new == $old} {return 1}
  1578. $window delete 0 end
  1579. if {$new != ""} {
  1580. $window insert 0 $new
  1581. return 0
  1582. }
  1583. }
  1584. if {$default != ""} {
  1585. if {[llength $default] > 1} {set default [dict get $default $region]}
  1586. $window insert 0 $default
  1587. }
  1588. return 0
  1589. }
  1590. }
  1591. # bok::ui::validateint validates the value of spinbox $window is an integer.
  1592. # $root is the frame initialized by bok::ui::init $window is the spinbox, $type
  1593. # is the event type, $old is the old value, $new is the new value, and $default
  1594. # is the default value.
  1595. proc bok::ui::validateint {root window type old {new {}} {default {}}} {
  1596. switch -exact -- $type key {
  1597. if {![string is integer $new]} {
  1598. return 0
  1599. } elseif {$new != "" && $new < [$window cget -from]} {
  1600. $window set [expr {int([$window cget -from])}]
  1601. return 0
  1602. } elseif {$new != "" && $new > [$window cget -to]} {
  1603. $window set [expr {int([$window cget -to])}]
  1604. return 0
  1605. }
  1606. return 1
  1607. } default {
  1608. if {$old == "" || ![string is integer $old]} {
  1609. if {![string equal $old $default]} {
  1610. $window set $default
  1611. }
  1612. return 0
  1613. }
  1614. return 1
  1615. }
  1616. }
  1617. # bok::ui::encode encodes the widget values into the password entry.
  1618. # $window is the window initialized with bok::ui::init, $game is the game that
  1619. # $window is for, and $locale is the locale of bok::strings to use.
  1620. proc bok::ui::encode {window game {locale en}} {
  1621. if {$game < 1 || $game > 4} {
  1622. return -code error \
  1623. {wrong args: should be "encode path game ?locale?"}
  1624. }
  1625. set region [region [$window.region-name get] $locale]
  1626. set info [info $game $region $locale]
  1627. set dict {}
  1628. foreach {key list} $info {
  1629. switch -exact -- [lindex $list 0] {
  1630. {} {continue}
  1631. string - int - regionlist - list {
  1632. dict set dict $key [$window.$key get]
  1633. } boolean {
  1634. dict set dict $key [expr {"selected" in [$window.$key state]}]
  1635. } bits {
  1636. dict set dict $key {}
  1637. for {set i 0} {$i < [llength [lindex $list 1]]} {incr i} {
  1638. if {"selected" in [$window.$key.$i state]} {
  1639. dict lappend dict $key [lindex $list 1 $i]
  1640. }
  1641. }
  1642. }}
  1643. }
  1644. $window.error configure -text ✓
  1645. if {[catch {normalize $dict $locale} error]} {
  1646. $window.error configure -text "⚠ $error"
  1647. }
  1648. set dict [normalize $dict $locale 1]
  1649. set pass [encpass $dict]
  1650. if {[catch {set pass [encpass $dict]} error]} {
  1651. $window.error configure -text "⚠ $error"
  1652. return
  1653. }
  1654. switch -exact -- [dict get $dict game] 1 {
  1655. if {[dict get $dict minutes] == 0 && [dict get $dict hours] == 0} {
  1656. $window.error configure \
  1657. -text "⚠ [@ $locale labels hours] or [
  1658. @ $locale labels minutes] should be set"
  1659. } elseif {[dict get $dict minutes] >= 60} {
  1660. $window.error configure \
  1661. -text "⚠ [@ $locale labels minutes] should be less than 60"
  1662. } elseif {[dict get $dict clears] == 0} {
  1663. $window.error configure \
  1664. -text "⚠ [@ $locale labels clears] should be greater than 0"
  1665. }
  1666. } 2 {
  1667. if {([dict get $dict titles] & (1 << 6)) == 0} {
  1668. $window.error configure \
  1669. -text "⚠ [@ $locale titles 2 \#6] should be set"
  1670. }
  1671. } 3 {
  1672. if {[dict get $dict endings] == 0} {
  1673. $window.error configure \
  1674. -text "⚠ [@ $locale labels ending-list] should be set"
  1675. }
  1676. } 4 {
  1677. if {[dict get $dict name-solar] == ""} {
  1678. $window.error configure \
  1679. -text "⚠ [@ $locale labels name-solar] should be set"
  1680. } elseif {[dict get $dict name-dark] == ""} {
  1681. $window.error configure \
  1682. -text "⚠ [@ $locale labels name-dark] should be set"
  1683. }
  1684. }
  1685. if {[dict exists $dict name] && [dict get $dict name] == ""} {
  1686. $window.error configure -text "⚠ [@ $locale labels name] should be set"
  1687. }
  1688. $window.password.entry delete 0 end
  1689. $window.password.entry insert 0 [spaceout $pass]
  1690. }
  1691. # bok::ui::decode decodes the current password into the appropriate widgets.
  1692. # $window is the window initialized with bok::ui::init, $game is the game that
  1693. # $window is for, and $locale is the locale of bok::strings to use.
  1694. proc bok::ui::decode {window game {locale en}} {
  1695. set region [region [$window.region-name get] $locale]
  1696. set lang [expr {$region == "jp" ? "jp" : "en"}]
  1697. if {[catch {
  1698. set dict [decpass [$window.password.entry get] $game $lang]
  1699. } error]} {
  1700. $window.error configure -text "⚠ $error"
  1701. return
  1702. }
  1703. if {[string match *!=* [dict get $dict checksum]]} {
  1704. $window.error configure -text "⚠ checksum [dict get $dict checksum]"
  1705. } elseif {[catch {normalize $dict $locale} error]} {
  1706. $window.error configure -text "⚠ $error"
  1707. } else {
  1708. $window.error configure -text ✓
  1709. }
  1710. set dict [normalize $dict $locale 1]
  1711. foreach {key list} [info $game $region $locale] {
  1712. switch -exact -- [lindex $list 0] {} {continue} string {
  1713. $window.$key delete 0 end
  1714. $window.$key insert 0 [dict get $dict $key]
  1715. } int - regionlist - list {
  1716. $window.$key set [dict get $dict $key]
  1717. } boolean {
  1718. $window.$key state "[expr {[dict get $dict $key] ? "" : "!"}]selected"
  1719. } bits {
  1720. for {set i 0} {$i < [llength [lindex $list 1]]} {incr i} {
  1721. $window.$key.$i state "[expr {
  1722. [lindex $list 1 $i] in [dict get $dict $key] ? "" : "!"
  1723. }]selected"
  1724. }
  1725. }
  1726. }
  1727. }
  1728. # bok::ui::cycleoffset increments the offset bit in the current password by
  1729. # $count, if it is present. $window is the window initialized with
  1730. # bok::ui::init and $game is the game that $window is for.
  1731. proc bok::ui::cycleoffset {window game {count 1}} {
  1732. set list [decb64 [$window.password.entry get] $game]
  1733. set ok 0
  1734. modkeys list $game jp 6 {k v n} offset region {
  1735. if {$k == "region"} {set ok 1; return}
  1736. expr {$v + $count & (1 << $n) - 1}
  1737. }
  1738. if {!$ok} {return}
  1739. $window.password.entry delete 0 end
  1740. $window.password.entry insert 0 [spaceout [encb64 $list $game]]
  1741. }
  1742. # bok::ui::keyboards is a dictionary of lists. The lists contain lists of rows
  1743. # of keys, with the keys being in the form {display ?value? ?expand? ?width?}.
  1744. # The value defaults to the same as the display value, if the display is empty
  1745. # then that button is skipped, if "expand" is present then that key is expanded
  1746. # to take up horizontal space, and if "expand" has a width then that key is
  1747. # expanded to the specified width.
  1748. set bok::ui::keyboards {en64 {
  1749. {B C D F G H J @ # ^ {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1750. {K L M N P Q R 0 1 2 3 4}
  1751. {S T V W X Y Z 5 6 7 8 9}
  1752. {b c d f g h j + - / .}
  1753. {k l m n p q r = _ ? {← <<PrevChar>>} {→ <<NextChar>>}}
  1754. {s t v w x y z : > ! {␣ { } expand}}
  1755. } lk64 {
  1756. {1 2 3 4 5 6 7 8 9 0 . {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1757. {A B C D E F G H I J K L M}
  1758. {N O P Q R S T U V W X Y Z}
  1759. {a b c d e f g h i j k l m}
  1760. {n o p q r s t u v w x y z}
  1761. {? = {␣ { } expand} {← <<PrevChar>>} {→ <<NextChar>>}}
  1762. } jp64 {
  1763. {あ い う え お ま み む め も {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1764. {か き く け こ や ゆ よ わ を ば び}
  1765. {さ し す せ そ ら り る れ ろ ぶ べ}
  1766. {た ち つ て と が ぎ ぐ げ ご ぼ}
  1767. {な に ぬ ね の ざ じ ず ぜ ぞ {← <<PrevChar>>} {→ <<NextChar>>}}
  1768. {は ひ ふ へ ほ だ ぢ づ で ど {␣ { } expand}}
  1769. } en {
  1770. {A B C D E F G H I {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1771. {J K L M N O P Q R . ,}
  1772. {S T U V W X Y Z {} ' -}
  1773. {a b c d e f g h i /}
  1774. {j k l m n o p q r {← <<PrevChar>>} {→ <<NextChar>>}}
  1775. {s t u v w x y z {} {␣ { } expand}}
  1776. } ext {
  1777. {& * ; + - × ÷ = {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar}}
  1778. {à á â ä è é ê ë ( )}
  1779. {ì í î ï ò ó ô ö [ ]}
  1780. {ù ú û ü ç ñ œ ß ! ?}
  1781. {À Á Â Ä È É Ê Ë ¡ ¿}
  1782. {Ì Í Î Ï Ò Ó Ô Ö {← <<PrevChar>>} {→ <<NextChar>>}}
  1783. {Ù Ú Û Ü Ç Ñ Œ {⋅ ⋅} {␣ { } expand}}
  1784. } hiri {
  1785. {あ い う え お ら り る れ ろ {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1786. {か き く け こ が ぎ ぐ げ ご ん ・}
  1787. {さ し す せ そ ざ じ ず ぜ ぞ ー ~}
  1788. {た ち つ て と だ ぢ づ で ど}
  1789. {な に ぬ ね の ば び ぶ べ ぼ}
  1790. {は ひ ふ へ ほ ぱ ぴ ぷ ぺ ぽ}
  1791. {ま み む め も ぁ ぃ ぅ ぇ ぉ {← <<PrevChar>>} {→ <<NextChar>>}}
  1792. {や ゆ よ わ を っ ゃ ゅ ょ {} {␣ { } expand}}
  1793. } kata {
  1794. {ア イ ウ エ オ ラ リ ル レ ロ {⌫ <<DeletePrevChar>>} {⌦ <<DeleteNextChar>>}}
  1795. {カ キ ク ケ コ ガ ギ グ ゲ ゴ ン ・}
  1796. {サ シ ス セ ソ ザ ジ ズ ゼ ゾ ー ~}
  1797. {タ チ ツ テ ト ダ ヂ ヅ デ ド}
  1798. {ナ ニ ヌ ネ ノ バ ビ ブ ベ ボ}
  1799. {ハ ヒ フ ヘ ホ パ ピ プ ペ ポ}
  1800. {マ ミ ム メ モ ァ ィ ゥ ェ ォ {← <<PrevChar>>} {→ <<NextChar>>}}
  1801. {ヤ ユ ヨ ワ ヲ ッ ャ ュ ョ ヴ {␣ { } expand}}
  1802. }}
  1803. # bok::ui::keyboardinit initializes a grid of buttons that send
  1804. # <<VirtualKeyPress>> events to the frame $window with %d set to the value.
  1805. # The default binding is to call bok::ui::keypress with %d. Supported options
  1806. # are -style and -command. -style sets the style to use for the buttons, and
  1807. # -command replaces the default binding for <<VirtualKeyPress>>.
  1808. proc bok::ui::keyboardinit {window keyboard args} {
  1809. variable keyboards
  1810. set usage {keyboardinit path keyboard ?option value ...?}
  1811. set options [dict create -style {} \
  1812. -command [list [namespace current]::keypress %W %d]
  1813. ]
  1814. if {[llength $args] % 2 != 0} {
  1815. return -code error "wrong # args: should be \"$usage\""
  1816. }
  1817. if {![winfo exists $window]} {
  1818. ttk::frame $window
  1819. } elseif {[winfo exists $window.0]} {
  1820. return
  1821. }
  1822. foreach {opt arg} $args {
  1823. switch -exact -- $opt -keys - -command {
  1824. dict set options $opt $arg
  1825. } -style {
  1826. dict lappend options $opt {*}$arg
  1827. } default {
  1828. return -code error "Invalid option: $opt"
  1829. }
  1830. }
  1831. if {[dict exists $keyboards $keyboard]} {
  1832. set keyboard [dict get $keyboards $keyboard]
  1833. }
  1834. bind $window <<VirtualKeyPress>> [dict get $options -command]
  1835. set einfo {}
  1836. set winfo {}
  1837. foreach list $keyboard {
  1838. set e 0
  1839. set j 0
  1840. foreach key $list {
  1841. set width 1
  1842. foreach opt [lrange $key 2 end] {
  1843. if {[lindex $opt 0] != "expand"} {continue}
  1844. set width [lindex $opt 1]
  1845. }
  1846. if {$width == ""} {
  1847. set width 1
  1848. incr e
  1849. }
  1850. incr j $width
  1851. }
  1852. lappend einfo $e
  1853. lappend winfo $j
  1854. }
  1855. set max [::tcl::mathfunc::max {*}$winfo]
  1856. set button 0
  1857. for {set row 0} {$row < [llength $keyboard]} {incr row} {
  1858. set list [lindex $keyboard $row]
  1859. set n [lindex $einfo $row]
  1860. set e [expr {max($max - [lindex $winfo $row] + $n - 1, 0)}]
  1861. set elist {}
  1862. if {$n > 0} {
  1863. for {set i 0; set j [expr {int(($n - $e % $n) / 2)}]} {$i < $n} {incr i} {
  1864. lappend elist [expr {
  1865. int($e / $n) + ($i >= $j && $i < $n - $j ? 1 : 0)
  1866. }]
  1867. }
  1868. }
  1869. for {set e 0; set i 0; set col 0} {$i < [llength $list]} {incr i} {
  1870. set key [lindex $list $i]
  1871. if {$key == ""} {
  1872. incr col
  1873. continue
  1874. }
  1875. if {[llength $key] < 2} {
  1876. set text $key
  1877. set value $key
  1878. } else {
  1879. lassign $key text value
  1880. }
  1881. set width 1
  1882. foreach opt [lrange $key 2 end] {
  1883. switch -nocase -exact -- [lindex $opt 0] expand {
  1884. set width [lindex $opt 1]
  1885. }
  1886. }
  1887. if {$width == ""} {
  1888. set width [lindex $elist $e]
  1889. incr e
  1890. }
  1891. grid [ttk::button $window.$button -text $text -command \
  1892. [list event generate $window <<VirtualKeyPress>> -data $value \
  1893. -root [winfo toplevel $window] -subwindow $window.$button] \
  1894. -style [dict get $options -style] -width 2 -takefocus 0
  1895. ] -ipadx 0 -row $row -column $col -columnspan $width -sticky nsew
  1896. incr button
  1897. incr col $width
  1898. }
  1899. }
  1900. for {set row 0} {$row < [llength $keyboard]} {incr row} {
  1901. grid rowconfigure $window $row -weight 1
  1902. }
  1903. for {set col 0} {$col < $max} {incr col} {
  1904. grid columnconfigure $window $col -weight 1
  1905. }
  1906. return $window
  1907. }
  1908. # bok::ui::keypress inserts $value into Entry/TEntry currently in focus for the
  1909. # toplevel window for $window. If value is a virtual event then that action is
  1910. # performed instead. Supported virtual events are PrevChar, NextChar,
  1911. # DeletePrevChar, and DeleteNextChar.
  1912. proc bok::ui::keypress {window value} {
  1913. set window [focus -lastfor [winfo toplevel $window]]
  1914. switch -glob -nocase -- [winfo class $window] *Entry {
  1915. switch -glob -nocase -- $value {
  1916. <<PrevChar>> {$window icursor [expr {[$window index i] - 1}]}
  1917. <<NextChar>> {$window icursor [expr {[$window index i] + 1}]}
  1918. <<DeletePrevChar>> {$window delete [expr {[$window index i] - 1}]}
  1919. <<DeleteNextChar>> {$window delete i}
  1920. <<*>> {return -code error "Unsupported event: $value"}
  1921. default {
  1922. $window insert i $value
  1923. }}
  1924. }
  1925. }
  1926. # bok::ui::keyboardallow disables/enables all keyboards in $window depending on
  1927. # if they are in $keyboards. The tab is set to the default (or first valid
  1928. # keyboard) if the current keyboard is not in $keyboards.
  1929. proc bok::ui::keyboardallow {window keyboards {default ""}} {
  1930. if {$default == "" || $default ni $keyboards} {
  1931. set default [lindex $keyboards 0]
  1932. }
  1933. set current [winfo name [$window select]]
  1934. foreach keyboard [$window tabs] {
  1935. set name [winfo name $keyboard]
  1936. $window tab $keyboard \
  1937. -state [expr {$name in $keyboards ? "normal" : "disabled"}]
  1938. if {$name == $default && $current ni $keyboards} {
  1939. $window select $keyboard
  1940. }
  1941. }
  1942. }
  1943. proc usage {} {
  1944. puts stderr [join {
  1945. {usage: bokpass [-gui] [-kbd] [-invalid] [-columns columns]}
  1946. { [-fontsize size]}
  1947. { bokpass [-cli] [-verbose] -game game password ...}
  1948. } "\n"]
  1949. exit 1
  1950. }
  1951. set options {
  1952. -locale en
  1953. -mode cli -verbose 0
  1954. -columns 2 -fontsize 10 -kbd 0 -validate all
  1955. }
  1956. for {set optind 0} {$optind < [llength $argv]} {incr optind} {
  1957. switch -glob -- [lindex $argv $optind] -game - -columns - -fontsize {
  1958. if {$optind + 1 >= [llength $argv]} {usage}
  1959. dict set options {*}[lrange $argv $optind $optind+1]
  1960. incr optind
  1961. } -cli - -gui {
  1962. dict set options -mode [string range [lindex $argv $optind] 1 end]
  1963. } -verbose - -kbd {
  1964. dict set options [lindex $argv $optind] 1
  1965. } -invalid {
  1966. dict set options -validate none
  1967. } -- {
  1968. incr optind
  1969. break
  1970. } -?* {
  1971. usage
  1972. } default {
  1973. break
  1974. }
  1975. }
  1976. if {$optind == [llength $argv]} {
  1977. dict set options -mode gui
  1978. }
  1979. if {[dict get $options -mode] == "cli" && ![dict exists $options -game]} {
  1980. usage
  1981. }
  1982. switch -exact -- [dict get $options -mode] gui {
  1983. package require Tk
  1984. wm title . bokpass
  1985. ttk::style configure Keyboard.TButton \
  1986. -font "mono [expr {int([dict get $options -fontsize] * 1.2)}]"
  1987. ttk::style configure TLabel \
  1988. -font "sans [dict get $options -fontsize]"
  1989. ttk::style configure TNotebook.Tab \
  1990. -font "sans [dict get $options -fontsize]"
  1991. ttk::style configure TSpinBox -font "sans [dict get $options -fontsize]"
  1992. ttk::style configure TComboBox -font "sans [dict get $options -fontsize]"
  1993. option add *TCombobox*Listbox.font "sans [dict get $options -fontsize]"
  1994. # Adds ^W and ^U functionality to Entry and TEntry widgets.
  1995. proc betterediting {args} {
  1996. foreach arg $args {
  1997. bind $arg <Control-KeyPress-w> {
  1998. apply {old {
  1999. event generate %W <<PrevWord>>
  2000. %W delete [%W index i] $old
  2001. }} [%W index i]
  2002. }
  2003. bind $arg <Control-KeyPress-u> {
  2004. %W delete 0 end
  2005. }
  2006. bind $arg <KeyPress-Up> {%W icursor 0}
  2007. bind $arg <KeyPress-Down> {%W icursor e}
  2008. }
  2009. }
  2010. betterediting Entry TEntry
  2011. # Lazily initializes game tabs.
  2012. proc loadgametab {window} {
  2013. if {[dict get $::options -kbd]} {
  2014. foreach keyboard [.keyboard tabs] {
  2015. .keyboard tab $keyboard -state normal
  2016. }
  2017. }
  2018. if {[winfo exists $window.password]} {return}
  2019. if {![string match {*.*[1234]} $window]} {return}
  2020. set game [string index $window end]
  2021. set bindings {}
  2022. if {[dict get $::options -kbd]} {
  2023. lappend bindings password.entry {<FocusIn> {+
  2024. if {[bok::ui::region \
  2025. [[winfo parent [winfo parent %W]].region-name get] \
  2026. [dict get $::options -locale]] == "jp"} {
  2027. bok::ui::keyboardallow .keyboard jp64
  2028. } elseif {[string index [.games select] end] == "4"} {
  2029. bok::ui::keyboardallow .keyboard lk64
  2030. } else {
  2031. bok::ui::keyboardallow .keyboard en64
  2032. }
  2033. }} string {<FocusIn> {+
  2034. switch -glob -- "[bok::ui::region [[winfo parent %W].region-name get] \
  2035. [dict get $::options -locale]][string index [.games select] end]" {
  2036. jp[123] {
  2037. bok::ui::keyboardallow .keyboard {hiri kata} hiri
  2038. } jp4 {
  2039. bok::ui::keyboardallow .keyboard {en ext hiri kata} hiri
  2040. } na[123] - eu[123] {
  2041. bok::ui::keyboardallow .keyboard {en}
  2042. } na4 - eu4 {
  2043. bok::ui::keyboardallow .keyboard {en ext hiri kata} en
  2044. }}
  2045. }} entry {<FocusOut> {
  2046. bok::ui::keyboardallow .keyboard {en64 lk64 jp64 en ext kata hiri}
  2047. }}
  2048. }
  2049. if {$game != 3} {
  2050. switch -exact -- [dict get $::options -locale] {
  2051. en {set region na}
  2052. jp {set region jp}
  2053. default {set region eu}
  2054. }
  2055. } else {
  2056. set region jp
  2057. }
  2058. set options [dict map {key value} $::options {
  2059. if {$key ni {-fontsize -columns -validate}} {continue}
  2060. set value
  2061. }]
  2062. bok::ui::init $window $region $game -bind $bindings {*}$options
  2063. }
  2064. pack [ttk::notebook .games] -expand 1 -fill both
  2065. bind .games <<NotebookTabChanged>> {loadgametab [%W select]}
  2066. foreach {tab name} [bok::@ [dict get $options -locale] labels game-tabs] {
  2067. .games add [ttk::frame .games.$tab] -text $name
  2068. }
  2069. if {[dict get $options -kbd]} {
  2070. # Lazily initializes keyboard tabs.
  2071. pack [ttk::notebook .keyboard -takefocus 0] -fill both
  2072. bind .keyboard <<NotebookTabChanged>> {
  2073. if {![winfo exists [%W select].0]} {
  2074. bok::ui::keyboardinit [%W select] [winfo name [%W select]] \
  2075. -style Keyboard.TButton
  2076. }
  2077. }
  2078. bind Entry <FocusIn> {+ set ::currententry %W}
  2079. bind TEntry <FocusIn> {+ set ::currententry %W}
  2080. bind .games <<NotebookTabChanged>> {+ set ::currententry {}}
  2081. bind .keyboard <<NotebookTabChanged>> {+
  2082. if {[winfo exists $::currententry]} {focus $::currententry}
  2083. }
  2084. foreach {tab name} \
  2085. [bok::@ [dict get $options -locale] labels keyboard-tabs] {
  2086. .keyboard add [ttk::frame .keyboard.$tab] -text $name
  2087. }
  2088. }
  2089. } cli {
  2090. # Forgivingly match -game.
  2091. switch -exact -nocase -- [regsub {[^[:alnum:]]+} \
  2092. [dict get $options -game] {}] {
  2093. boktai - tsiiyh - boktai1 - boktaitsiiyh - boktaithesunisinyourhand -
  2094. bokura - bokura1 - bokuranotaiyou - bokuranotaiyou1 -
  2095. jp1 - en1 - na1 - eu1 - us1 - 1 {
  2096. dict set options -game 1
  2097. }
  2098. zoktai - boktai2 - boktai2solarboydjango - solarboydjango -
  2099. zokubokura - zokubokuranotaiyou - bokura2 - bokuranotaiyou2 -
  2100. jp2 - en2 - na2 - eu2 - us2 - 2 {
  2101. dict set options -game 2
  2102. }
  2103. shinbok - boktai3 - boktai3sabatascounterattack - sabatascounterattack -
  2104. shinbokura - shinbokuranotaiyou - bokura3 - bokuranotaiyou3 -
  2105. jp3 - en3 - na3 - eu3 - us3 - 3 {
  2106. dict set options -game 3
  2107. }
  2108. lk - lunarknigths - boktai4 - boktaids - bokura4 - bokurads -
  2109. bokuranotaiyouds - bokuranotaiyou4 - boktaidjangosabata - bokuradjangosabata -
  2110. bokuranotaiyoudjangosabata - djangosabata - ds -
  2111. jp4 - en4 - na4 - eu4 - us4 - 4 {
  2112. dict set options -game 4
  2113. } default {
  2114. puts stderr "Unknown game: [dict get $options -game]"
  2115. exit 1
  2116. }}
  2117. # Decodes passwords for -game and print them in columns.
  2118. set dict [dict create]
  2119. for {} {$optind < [llength $argv]} {incr optind} {
  2120. if {[catch {
  2121. set width [::tcl::mathfunc::max 0 {*}[lmap value [dict values $dict] {
  2122. string length $value
  2123. }]]
  2124. set tdict [bok::decpass [lindex $argv $optind] \
  2125. [dict get $options -game]]
  2126. set vdict {}
  2127. catch {set vdict [bok::normalize $tdict [dict get $options -locale] 1]}
  2128. dict for {key value} $tdict {
  2129. set pad {}
  2130. if {[dict exists $dict $key]} {
  2131. set pad [string repeat { } [expr {
  2132. $width - [string length [dict get $dict $key]]
  2133. }]]
  2134. }
  2135. if {[dict exists $vdict $key]} {
  2136. set value [dict get $vdict $key]
  2137. }
  2138. if {[dict get $options -verbose] && [dict exists $vdict $key\-name]} {
  2139. append value " \"[dict get $vdict $key\-name]\""
  2140. }
  2141. dict append dict $key " $pad$value"
  2142. }
  2143. } error]} {
  2144. puts stderr "bokpass: $error"
  2145. }
  2146. }
  2147. set width [::tcl::mathfunc::max 0 {*}[lmap key [dict keys $dict] {
  2148. string length $key
  2149. }]]
  2150. dict for {key value} $dict {
  2151. set pad [string repeat { } [expr {$width - [string length $key]}]]
  2152. puts $pad$key:$value
  2153. }
  2154. }