home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD 45 / SuperCD45.iso / talleres / rincon_prog / NEURAL.BAS < prev    next >
BASIC Source File  |  2000-07-10  |  69KB  |  2,921 lines
  1. '+-------------------------------------------------------------------+
  2. '▌                                                                   ▌
  3. '▌ NEURAL (this version needs ASCII8X8.OVL and BASICINT.OVL          ▌
  4. '▌                                                                   ▌
  5. '▌                                                                   ▌
  6. '+-------------------------------------------------------------------+
  7. '<->
  8. DEFINT A-Z
  9. DECLARE SUB ziDragging ()
  10. ' Return if mouse active and still dragging, or else exhausted
  11.  
  12. DECLARE SUB ziDrawBank (FromButton, ToButton)
  13. ' Draw a bank of buttons (using Bank array)
  14.  
  15. DECLARE SUB ziExhaust ()
  16. ' Return when no keystrokes and no mouse buttons
  17.  
  18. DECLARE SUB ziLoadFont (Font$)
  19. ' Load a specified font
  20.  
  21. DECLARE SUB ziLocateMCursor (XCoord, YCoord)
  22. ' Locate mouse cursor to a named point
  23.  
  24. DECLARE SUB ziMouseOnButton (FromButton, ToButton)
  25. ' Sets FoundButton
  26.  
  27. DECLARE SUB ziPublish (Printstring$, size, italic)
  28. ' Print a string at graphics cursor (advanced)
  29. '   Size   = magnitude (per 8 pixels)
  30. '   Italic = +1 to make italic
  31. '          = +2 to make overprint (no background)
  32.  
  33. DECLARE SUB ziPublishHere (row, col, Printstring$, size, italic)
  34. ' Print a string at the specified text position
  35.  
  36. DECLARE SUB ziRadio (Button, FromButton, ToButton)
  37. ' Set one button in a Bank, resetting the rest
  38.  
  39. DECLARE SUB ziReadField (Min, Max, Permitted$)
  40. ' Read a field at the current TCursor location
  41. '   Permitted$ contains:
  42. '     * - any characters
  43. '     . - allow one full-stop (as decimal)
  44. '     A - auto-enter (when filled)
  45. '     C - capitalise letters
  46. '     E - ESC allowed to finish (skip) field
  47. '     J - justify (especially for numeric)
  48. '     N - numerics
  49. '     P - password-type display
  50. '     S - space
  51. '     X - alphabetic
  52. '     Y - Y or N (upper or lower)
  53.  
  54. DECLARE SUB ziSetMCursorVis (Status)
  55. ' Set visibility of mouse cursor
  56. '   Status = 0 for OFF
  57. '            1 for ON
  58. '            2 for ENQUIRE (set MCursorVis)
  59. '           10 for TEMPORARILY OFF
  60. '           11 for RESTORED (set MCursorVis)
  61.  
  62. DECLARE SUB ziWander (Timeout!)
  63. ' Timeout  = in seconds (0 = none)
  64. ' Response =   0 = (0:00) timed out
  65. '              n = (0:n)  displacement into Allowed$
  66.  
  67. ' key           &h01xx  &h02xx  &h04xx  &h08xx  &h10xx  &h20xx  &h40xx
  68. '                plain   CTRL    shift   Mouse    Fn   CTRL-Fn  shift-Fn
  69.  
  70. ' Enter      0    *       *       -      double    -      -       -
  71. ' (left)     1    *       *       -      left     F1     ^F1     +F1
  72. ' (right)    2    *       *       -      right    F2     ^F2     +F2
  73. ' (up)       3    *       -       -      both     F3     ^F3     +F3
  74. ' (down)     4    *       -       -    leftdrag   F4     ^F4     +F4
  75.  
  76. ' Backspace  5    *       *       -    rightdrag  F5     ^F5     +F5
  77. ' Home       6    *       *       -    bothdrag   F6     ^F6     +F6
  78. ' End        7    *       *       -       -       F7     ^F7     +F7
  79.  
  80. ' PgUP       8    *       *       -       -       F8     ^F8     +F8
  81. ' PgDN       9    *       *       -       -       F9     ^F9     +F9
  82.  
  83. ' Tab       10    *       -       *       -       F10    ^F10    +F10
  84. ' Escape    11    *       -       -       -       F11    ^F11    +F11
  85. '           12    -       -       -       -       F12    ^F12    +F12
  86.  
  87. ' Allowed$  = other allowed strokes
  88. ' (Note:  DClick is a flag permitting Double-clicks of mouse - slower!)
  89.  
  90. DEFINT A-Z
  91. DECLARE SUB zsAlignGCursor ()
  92. ' Align graphic cursor to same as text cursor
  93. '  - sets Row, Col, GXloc, GYloc
  94.  
  95. DECLARE SUB zsAlignTCursor ()
  96. ' Align text cursor to same as graphic cursor
  97. '  - sets Row, Col, GXloc, GYloc
  98.  
  99. DECLARE SUB zsLocateGCursor (XCoord, YCoord)
  100. ' Locate graphic cursor to a named point
  101.  
  102. DECLARE SUB zsPastel (XCoord, YCoord, Wide, Deep, colour1, colour2)
  103. ' Colour the defined oblong with a pastel mix of two colours
  104. '  Deep = 0 or 1 - square
  105. '       = n      - Y-pixel depth
  106.  
  107. DECLARE SUB zsSetScrnMode (Mode, HiRows, HiCols)
  108. ' Mode = 9, 12 or 13
  109. ' HiRows = 1 to make high number of rows
  110. ' HiCols = 1 to make high number of cols (80)
  111. ' Set SCREEN parameters and blank the screen
  112. '  - sets ScrnMode, Xmax, Ymax, Rows, Cols, XYRatio!
  113. '  - uses FG and optionally BG (colours)
  114.  
  115. DECLARE SUB zsSubstitute (XCoord, YCoord, Wide, Deep, colour1, colour2)
  116. ' Substitute one colour with another within the defined oblong
  117. '  Deep = 0 or 1 - square
  118. '       = n      - Y-pixel depth
  119.  
  120. DECLARE SUB zzAlphaSort (Table$())
  121. ' Sort alphabetically the strings in the table; limited by " SortCount"
  122.  
  123. DECLARE SUB zzBasicInt (IntType)
  124. ' Execute interrupt (params in REGS.AX etc)
  125.  
  126. DECLARE SUB zzChangeDir (Directory$)
  127. ' Change to a particular directory
  128. '  -sets Directory$; eg "." will be changed to current directory
  129. ' if error occurs, Directory$ is returned as "?"
  130.  
  131. DECLARE SUB zzChangeDrive (Drive$)
  132. ' Change to a particular drive
  133. ' if Drive$ is empty on input, current drive is returned
  134. ' if error occurs, Drive$ is returned as "?"
  135.  
  136. DECLARE SUB zzCritOff ()
  137. ' turns off Critical Error Handling
  138.  
  139. DECLARE SUB zzCritOn ()
  140. ' restores normal Critical Error Handling
  141.  
  142. DECLARE SUB zzFileSelectBox (Pattern$)
  143. ' File Select Box function to choose an input file
  144.  
  145. DECLARE SUB zzInPath (Field$)
  146. ' Return full path to a file (in same string)
  147.  
  148. DECLARE SUB zzSearchD (Pattern$)
  149. ' Search for DIRECTORIES matching the pattern
  150. '  - sets Directories and Directories$()
  151.  
  152. DECLARE SUB zzSearchF (Pattern$)
  153. ' Search for FIILENAMES matching the pattern
  154. '  - sets FileNames and FileNames$()
  155.  
  156. DECLARE SUB zzValidate (Directory$)
  157. ' validate the named path and return its full
  158. '   (unqualified) name, including drive
  159. ' if error occcurs, Directory$ is returned as "?"
  160.  
  161. '================================================
  162. '/  UK copyright (c) 1998 by Future Publishing
  163. '/
  164. '/
  165. '/
  166. '/
  167. '================================================
  168. TYPE REGISTERS
  169.   AX AS INTEGER
  170.   BX AS INTEGER
  171.   CX AS INTEGER
  172.   DX AS INTEGER
  173.   DS AS INTEGER
  174.   SI AS INTEGER
  175.   ES AS INTEGER
  176.   DI AS INTEGER
  177.   FL AS INTEGER
  178. END TYPE
  179.  
  180. TYPE Buttons
  181.   Xloc AS INTEGER
  182.   Yloc AS INTEGER
  183.   Wide AS INTEGER
  184.   Deep AS INTEGER
  185. '  0 = checkbutton
  186. '  1 = square sculptured
  187. '  n = Y-pixels deep
  188.   State AS INTEGER
  189. '  0 = off
  190. '  1 = on
  191.   Active AS INTEGER
  192. '  0 = inactive
  193. '  1 = active
  194. END TYPE
  195.  
  196. CONST Pi! = 3.14159
  197. CONST Ex! = 2.71828
  198. CONST DegToRad! = .0174533
  199. CONST RadToDeg! = 57.2958
  200.  
  201. CONST ziNoShift = &H1
  202. CONST ziCTRL = &H2
  203. CONST ziShift = &H4
  204. CONST ziMouse = &H8
  205. CONST ziFn = &H10
  206. CONST ziCTRLFn = &H20
  207. CONST ziShiftFn = &H40
  208.  
  209. CONST ziL = 1
  210. CONST ziR = 2
  211. CONST ziUp = 3
  212. CONST ziDn = 4
  213. CONST ziBS = 5
  214. CONST ziHome = 6
  215. CONST ziEnd = 7
  216. CONST ziPgUp = 8
  217. CONST ziPgDn = 9
  218. CONST ziTab = 10
  219. CONST ziEsc = 11
  220.  
  221. CONST ziDbl = 0
  222. CONST ziBoth = 3
  223. CONST ziLDrag = 4
  224. CONST ziRDrag = 5
  225. CONST ziBothDrag = 6
  226.  
  227. DIM SHARED Regs AS REGISTERS
  228. DIM SHARED Bank(20) AS Buttons
  229. DIM SHARED Bad, Module$
  230. DIM SHARED Mouse, MCursorVis, MXloc, MYloc
  231. DIM SHARED DClick
  232. DIM SHARED ScrnMode, bg, fg, TCursor
  233. DIM SHARED Xmax, Ymax, GXloc, GYloc, XYratio!
  234. DIM SHARED Rows, Cols, row, col
  235. DIM SHARED Allowed$, Field$
  236. DIM SHARED FoundButton
  237. DIM SHARED Font(255, 7)
  238. DIM SHARED Response, HResponse, LResponse
  239. DIM SHARED SortCount
  240. REDIM SHARED Directories$(500)
  241. REDIM SHARED FileNames$(500)
  242. DIM SHARED Directories, FileNames
  243.  
  244. DIM SHARED IRET AS STRING * 3
  245. IRET = CHR$(&HB0) + CHR$(&H0) + CHR$(&HCF)
  246. DIM SHARED CritSeg, CritPtr, CritCount
  247.  
  248. '++++++++++++++++++++++++
  249. RANDOMIZE TIMER
  250. ON ERROR GOTO RESUMENEXT
  251. RESUMENEXT:
  252.   IF ERR = 255 THEN
  253.     CLS
  254.     BEEP
  255.     PRINT "Cannot find module "; Module$
  256.     SLEEP
  257.     SYSTEM
  258.   END IF
  259.   IF ERR THEN
  260.     Bad = ERR
  261.     RESUME NEXT
  262.   END IF
  263. Regs.AX = &H3524
  264. CALL zzBasicInt(&H21)
  265. CritSeg = Regs.ES
  266. CritPtr = Regs.BX
  267. '++++++++++++++++++++++++
  268. ' Test for presence of a mouse
  269. Mouse = 0
  270. Regs.AX = 0
  271. CALL zzBasicInt(&H33)
  272. IF Regs.AX THEN
  273.   Mouse = 1
  274.   CALL ziSetMCursorVis(0)
  275. END IF
  276. '++++++++++++++++++++++++
  277. ' Load the ASCII font
  278. CALL ziLoadFont("Ascii8x8")
  279. ' Create PAINT shades
  280. DIM Shades(7, 4) AS STRING * 8
  281. A$ = CHR$(&H55): B$ = CHR$(&HAA): C$ = CHR$(&HFF): D$ = CHR$(0)
  282. ' Blue
  283.  Shades(1, 0) = A$ + D$ + D$ + A$ + B$ + D$ + D$ + B$
  284.  Shades(1, 1) = A$ + D$ + D$ + C$ + B$ + D$ + D$ + C$
  285.  Shades(1, 2) = C$ + D$ + D$ + C$ + C$ + D$ + D$ + C$
  286.  Shades(1, 3) = C$ + B$ + D$ + A$ + C$ + A$ + D$ + B$
  287.  Shades(1, 4) = C$ + A$ + D$ + C$ + C$ + B$ + D$ + C$
  288. ' Green
  289.  Shades(2, 0) = D$ + A$ + D$ + D$ + D$ + B$ + D$ + D$
  290.  Shades(2, 1) = D$ + B$ + D$ + A$ + D$ + A$ + D$ + B$
  291.  Shades(2, 2) = D$ + A$ + D$ + C$ + D$ + B$ + D$ + C$
  292.  Shades(2, 3) = B$ + C$ + B$ + A$ + A$ + C$ + A$ + B$
  293.  Shades(2, 4) = A$ + C$ + A$ + C$ + B$ + C$ + B$ + C$
  294. ' Cyan
  295.  Shades(3, 0) = A$ + A$ + D$ + D$ + B$ + B$ + D$ + D$
  296.  Shades(3, 1) = B$ + B$ + D$ + A$ + A$ + A$ + D$ + B$
  297.  Shades(3, 2) = A$ + A$ + D$ + C$ + B$ + B$ + D$ + C$
  298.  Shades(3, 3) = C$ + C$ + B$ + A$ + C$ + C$ + A$ + B$
  299.  Shades(3, 4) = C$ + C$ + A$ + C$ + C$ + C$ + B$ + C$
  300. ' Red
  301.  Shades(4, 0) = D$ + D$ + A$ + D$ + D$ + D$ + B$ + D$
  302.  Shades(4, 1) = D$ + D$ + C$ + D$ + D$ + D$ + C$ + D$
  303.  Shades(4, 2) = D$ + D$ + C$ + A$ + D$ + D$ + C$ + B$
  304.  Shades(4, 3) = D$ + D$ + C$ + C$ + D$ + D$ + C$ + C$
  305.  Shades(4, 4) = A$ + A$ + C$ + C$ + B$ + B$ + C$ + C$
  306. ' Magenta
  307.  Shades(5, 0) = A$ + D$ + A$ + A$ + B$ + D$ + B$ + B$
  308.  Shades(5, 1) = A$ + D$ + A$ + C$ + B$ + D$ + B$ + C$
  309.  Shades(5, 2) = A$ + D$ + C$ + A$ + B$ + D$ + C$ + B$
  310.  Shades(5, 3) = C$ + D$ + C$ + C$ + C$ + D$ + C$ + C$
  311.  Shades(5, 4) = C$ + A$ + C$ + C$ + C$ + B$ + C$ + C$
  312. ' Yellow
  313.  Shades(6, 0) = D$ + B$ + A$ + D$ + D$ + A$ + B$ + D$
  314.  Shades(6, 1) = D$ + A$ + A$ + A$ + D$ + B$ + B$ + B$
  315.  Shades(6, 2) = D$ + B$ + A$ + C$ + D$ + A$ + B$ + C$
  316.  Shades(6, 3) = B$ + C$ + C$ + A$ + A$ + C$ + C$ + B$
  317.  Shades(6, 4) = A$ + C$ + C$ + C$ + B$ + C$ + C$ + C$
  318. ' White
  319.  Shades(7, 0) = D$ + D$ + D$ + C$ + D$ + D$ + D$ + C$
  320.  Shades(7, 1) = B$ + B$ + B$ + A$ + A$ + A$ + A$ + B$
  321.  Shades(7, 2) = A$ + A$ + A$ + C$ + B$ + B$ + B$ + C$
  322.  Shades(7, 3) = C$ + C$ + C$ + A$ + C$ + C$ + C$ + B$
  323.  Shades(7, 4) = C$ + C$ + C$ + C$ + C$ + C$ + C$ + C$
  324. '/==================================/'
  325. '/  End of Standard Piecrust code   /'
  326. '/==================================/'
  327. '<+>
  328.  
  329.  
  330.   fg = 0: bg = 14
  331.   zsSetScrnMode 12, 1, 1
  332.  
  333.   Curpos = 1
  334.  
  335.   DIM Best(25), Worst(25)
  336. Worst(25) = 99
  337.  
  338. ' table of expected results for neural net tests
  339.   DIM Result(15, 2)
  340.   Result(2, 2) = 1
  341.   Result(3, 2) = 1
  342.   Result(5, 2) = 1
  343.   Result(7, 2) = 1
  344.   Result(11, 2) = 1
  345.   Result(13, 2) = 1
  346.  
  347.  
  348.   DIM Nodes(11, 8)
  349. '          (xx, 1) = Xlocation
  350. '          (xx, 2) = Ylocation
  351. '          (xx, 3) = paint colour
  352. '          (xx, 4) = value of node
  353. '          (xx, 5) = input 1
  354. '          (xx, 6) = input 2
  355. '          (xx, 7) = input 3
  356. '          (xx, 8) = input 4
  357.  
  358. ' assign location of diagram of each node
  359. FOR i = 1 TO 4
  360.   Nodes(i, 1) = 120
  361.   Nodes(i, 2) = 60 * i + 100
  362.   Nodes(i, 3) = 14
  363. NEXT
  364. FOR i = 5 TO 7
  365.   Nodes(i, 1) = 240
  366.   Nodes(i, 2) = 75 * i - 200
  367.   Nodes(i, 3) = 11
  368. NEXT
  369. FOR i = 8 TO 10
  370.   Nodes(i, 1) = 360
  371.   Nodes(i, 2) = 75 * i - 425
  372.   Nodes(i, 3) = 11
  373. NEXT
  374. Nodes(11, 1) = 480
  375. Nodes(11, 2) = 250
  376. Nodes(11, 3) = 14
  377.  
  378.  
  379.   DIM Cnxns(24, 9)
  380. '          (xx, 1) = Xlocation
  381. '          (xx, 2) = Ylocation
  382. '          (xx, 3) = from
  383. '          (xx, 4) = to
  384. '          (xx, 5) = weight
  385. '          (xx, 6) = up
  386. '          (xx, 7) = down
  387. '          (xx, 8) = left
  388. '          (xx, 9) = right
  389.  
  390. ' calculate and assign parameters for each connection
  391.  
  392. FOR i = 1 TO 4
  393.   FOR j = 1 TO 3
  394.     k = i * 3 + j - 3
  395.     Cnxns(k, 1) = 72 * j - 65
  396.     Cnxns(k, 2) = Ymax - 88 + 16 * i
  397.     Cnxns(k, 3) = i
  398.     Cnxns(k, 4) = j + 4
  399.     l = Nodes(j + 4, 4)
  400.     Nodes(j + 4, 4) = l + 1
  401.     Nodes(j + 4, l + 5) = k
  402.   NEXT
  403. NEXT
  404. FOR i = 1 TO 3
  405.   FOR j = 1 TO 3
  406.     k = i * 3 + j + 9
  407.     Cnxns(k, 1) = 72 * j + 205
  408.     Cnxns(k, 2) = Ymax - 88 + 16 * i
  409.     Cnxns(k, 3) = i + 4
  410.     Cnxns(k, 4) = j + 7
  411.     l = Nodes(j + 7, 4)
  412.     Nodes(j + 7, 4) = l + 1
  413.     Nodes(j + 7, l + 5) = k
  414.   NEXT
  415. NEXT
  416. FOR i = 1 TO 3
  417.   k = i + 21
  418.   Cnxns(k, 1) = 547
  419.   Cnxns(k, 2) = Ymax - 88 + 16 * i
  420.   Cnxns(k, 3) = i + 7
  421.   Cnxns(k, 4) = 11
  422.   l = Nodes(11, 4)
  423.   Nodes(11, 4) = l + 1
  424.   Nodes(11, l + 5) = k
  425. NEXT
  426.  
  427. ' assign meanings to navigation keys
  428.  
  429. FOR i = 1 TO 21
  430.   Cnxns(i, 6) = i - 3
  431.   Cnxns(i, 7) = i + 3
  432.   Cnxns(i, 8) = i - 1
  433.   Cnxns(i, 9) = i + 1
  434. NEXT
  435. FOR i = 1 TO 3
  436.   Cnxns(i, 6) = 0
  437.   Cnxns(i + 12, 6) = 0
  438.   Cnxns(i + 9, 7) = 0
  439.   Cnxns(i + 18, 7) = 0
  440. NEXT
  441. Cnxns(23, 6) = 22
  442. Cnxns(24, 6) = 23
  443. Cnxns(22, 7) = 23
  444. Cnxns(23, 7) = 24
  445. Cnxns(1, 8) = 0
  446. Cnxns(4, 8) = 0
  447. Cnxns(7, 8) = 0
  448. Cnxns(10, 8) = 0
  449. Cnxns(13, 8) = 3
  450. Cnxns(16, 8) = 6
  451. Cnxns(19, 8) = 9
  452. Cnxns(22, 8) = 15
  453. Cnxns(23, 8) = 18
  454. Cnxns(24, 8) = 21
  455. Cnxns(3, 9) = 13
  456. Cnxns(6, 9) = 16
  457. Cnxns(9, 9) = 19
  458. Cnxns(12, 9) = 0
  459. Cnxns(15, 9) = 22
  460. Cnxns(18, 9) = 23
  461. Cnxns(21, 9) = 24
  462. FOR i = 1 TO 24
  463.   FOR j = 6 TO 9
  464.     IF Cnxns(i, j) = 0 THEN Cnxns(i, j) = i
  465.   NEXT
  466. NEXT
  467.  
  468. ' display weights on the bottom table
  469.  
  470.   FOR Connect = 1 TO 24
  471.     GOSUB PrintWeight
  472.   NEXT
  473.  
  474. ' display the net diagram on white background, with legend
  475.  
  476.   COLOR 0
  477.   LINE (10, 100)-(Xmax - 10, Ymax - 80), , B
  478.   PAINT (Xmax \ 2, Ymax \ 2), 15, 0
  479.   colour = 8
  480.   fg = 8: bg = 15
  481.   zsLocateGCursor 410, 110: ziPublish "B - retrieve BEST", 1, 0
  482.   zsLocateGCursor 410, 120: ziPublish "M - MUTATE random node", 1, 0
  483.   zsLocateGCursor 410, 130: ziPublish "R - RANDOMISE all weights", 1, 0
  484.   zsLocateGCursor 410, 140: ziPublish "W - retrieve WORST", 1, 0
  485.   zsLocateGCursor 410, 150: ziPublish "Z - ZEROISE all weights", 1, 0
  486.   zsLocateGCursor 410, 160: ziPublish "arrows to navigate weights", 1, 0
  487.   zsLocateGCursor 410, 170: ziPublish "+ or - to adjust weight", 1, 0
  488.   zsLocateGCursor 410, 180: ziPublish "ESC to exit program", 1, 0
  489.   bg = 14
  490.  
  491. ' draw in the connectors between nodes and the nodes themselves
  492.  
  493.   FOR connector = 1 TO 24
  494.     GOSUB Connect
  495.   NEXT
  496.   FOR Node = 1 TO 11
  497.     GOSUB DrawNode
  498.   NEXT
  499.  
  500.   GOSUB PrintResults    'print the current (default) results table
  501.  
  502. ' start the choice collar on the first connector - redraw it in red
  503. ' (redraw the nodes as well for neat appearance)
  504.  
  505.   Curpos = 1: connector = 1
  506.   colour = 8: GOSUB collar
  507.   colour = 12: GOSUB Connect
  508.   Node = Cnxns(connector, 3): GOSUB DrawNode
  509.   Node = Cnxns(connector, 4): GOSUB DrawNode
  510.  
  511. ' main program loop - waiting for keystroke
  512.  
  513.   DO
  514.     DO
  515.       key$ = INKEY$
  516.     LOOP UNTIL LEN(key$) > 0
  517.  
  518.     SELECT CASE LEN(key$)
  519.     CASE 1
  520.       SELECT CASE key$
  521.   ' zeroise
  522.       CASE "Z", "z"
  523.     FOR i = 1 TO 24
  524.       Cnxns(i, 5) = 0
  525.     NEXT
  526.   ' best case
  527.       CASE "B", "b"
  528.     FOR i = 1 TO 24
  529.       Cnxns(i, 5) = Best(i)
  530.     NEXT
  531.   ' worst case
  532.       CASE "W", "w"
  533.     FOR i = 1 TO 24
  534.       Cnxns(i, 5) = Worst(i)
  535.     NEXT
  536.   ' mutate around one node
  537.       CASE "M", "m"
  538.     i = INT(RND * 11) + 1     'first choose a node
  539.     FOR j = 5 TO 8
  540.       k = Nodes(i, j)
  541.       Cnxns(k, 5) = INT(RND * 21) - 10  'establish a new weight
  542.     NEXT
  543.   ' randomise weights for all connections
  544.       CASE "R", "r"
  545.     FOR i = 1 TO 24
  546.       Cnxns(i, 5) = INT(RND * 21) - 10
  547.     NEXT
  548.   ' escape (escapes main loop)
  549.       CASE CHR$(27)
  550.     ended = 1
  551.   ' plus or minus
  552.       CASE "+", "-"
  553.     z = Cnxns(Curpos, 5)
  554.      ' adjust weight upward
  555.     IF key$ = "+" THEN
  556.       IF z < 10 THEN
  557.         Cnxns(Curpos, 5) = z + 1
  558.       END IF
  559.     ELSE
  560.      'adjust weight downward
  561.       IF z > -10 THEN
  562.         Cnxns(Curpos, 5) = z - 1
  563.       END IF
  564.     END IF
  565.      'if there is a change, modify the results message
  566.     IF Cnxns(Curpos, 5) <> z THEN
  567.       FOR Connect = 1 TO 24
  568.         GOSUB PrintWeight
  569.       NEXT
  570.       GOSUB PrintResults
  571.     END IF
  572.       END SELECT
  573.       SELECT CASE key$
  574.       CASE "Z", "z", "B", "b", "W", "w", "M", "m", "R", "r"
  575.     FOR Connect = 1 TO 24
  576.       GOSUB PrintWeight
  577.     NEXT
  578.     GOSUB PrintResults
  579.       END SELECT
  580.  
  581.     CASE 2
  582.   'navigation keys (work as directed by table)
  583.       z = INSTR("HPKM", MID$(key$, 2))
  584.       IF z > 0 THEN
  585.     NewCurpos = Cnxns(Curpos, 5 + z)
  586.       END IF
  587.  
  588.      'when changing focus, remove collar around old connector
  589.  
  590.       connector = Curpos
  591.       colour = 14: GOSUB collar
  592.       colour = 8: GOSUB Connect
  593.  
  594.      'add collar around new connector
  595.  
  596.       Node = Cnxns(connector, 3): GOSUB DrawNode
  597.       Node = Cnxns(connector, 4): GOSUB DrawNode
  598.       Curpos = NewCurpos
  599.       connector = Curpos
  600.       colour = 0: GOSUB collar
  601.       colour = 12: GOSUB Connect
  602.       Node = Cnxns(connector, 3): GOSUB DrawNode
  603.       Node = Cnxns(connector, 4): GOSUB DrawNode
  604.     END SELECT
  605.  
  606.   LOOP UNTIL ended = 1
  607.  
  608.   SYSTEM
  609.  
  610. '+-------------------------------------------------------------------+
  611. '▌                         SUBROUTINES                               ▌
  612. '▌                         ===========                               ▌
  613. '+-------------------------------------------------------------------+
  614. '▌ Collar:     (uses Connector & colour)                             ▌
  615. '▌                                                                   ▌
  616. '▌   Draw a collar around a connection in colour                     ▌
  617. '▌                                                                   ▌
  618. '+-------------------------------------------------------------------+
  619. collar:
  620.  
  621.   x = Cnxns(connector, 1)
  622.   y = Cnxns(connector, 2)
  623.   LINE (x - 4, y - 4)-(x + 60, y + 12), colour, B
  624.   LINE (x - 3, y - 3)-(x + 61, y + 13), colour, B
  625.  
  626.   RETURN
  627.  
  628. '+-------------------------------------------------------------------+
  629. '▌ Connect:    (uses Connector)                                      ▌
  630. '▌                                                                   ▌
  631. '▌   Draw the connecting line (1 to 24) in colour                    ▌
  632. '▌                                                                   ▌
  633. '+-------------------------------------------------------------------+
  634. Connect:
  635.  
  636.   Node = Cnxns(connector, 3)
  637.   p = Nodes(Node, 1): q = Nodes(Node, 2)
  638.   Node = Cnxns(connector, 4)
  639.   x = Nodes(Node, 1): y = Nodes(Node, 2)
  640.   FOR n = 1 TO 4
  641.     LINE (p + 3 - n, q)-(x + 3 - n, y), colour
  642.     LINE (p, q + 3 - n)-(x, y + 3 - n), colour
  643.   NEXT
  644.   RETURN
  645.  
  646. '+-------------------------------------------------------------------+
  647. '▌ DrawNode:                                                         ▌
  648. '▌                                                                   ▌
  649. '▌   Draw an individual node                                         ▌
  650. '▌      input:   Node (1 to 11)                                      ▌
  651. '▌                                                                   ▌
  652. '+-------------------------------------------------------------------+
  653. DrawNode:
  654.  
  655.   x = Nodes(Node, 1): y = Nodes(Node, 2): enamel = Nodes(Node, 3)
  656.   CIRCLE (x, y), 20, 0
  657.   PAINT (x, y), enamel, 0
  658.   zsLocateGCursor x - 12, y - 12
  659.  
  660. ' add letter as label
  661.  
  662.   fg = 8: ziPublish CHR$(64 + Node), 3, 2
  663.   RETURN
  664.  
  665. '+-------------------------------------------------------------------+
  666. '▌ PrintResults:                                                     ▌
  667. '▌                                                                   ▌
  668. '▌   Print the results of the net (top of page)                      ▌
  669. '▌                                                                   ▌
  670. '+-------------------------------------------------------------------+
  671. PrintResults:
  672.  
  673.  
  674.   FOR i = 1 TO 15
  675.     Result(i, 1) = 0
  676.   NEXT
  677.   FOR i = 1 TO 15
  678.     FOR j = 1 TO 11
  679.       Nodes(j, 4) = 0
  680.     NEXT
  681.  
  682. ' convert decimal 1 to 15 into binary four switches
  683.  
  684.     IF i AND 8 THEN Nodes(1, 4) = 1
  685.     IF i AND 4 THEN Nodes(2, 4) = 1
  686.     IF i AND 2 THEN Nodes(3, 4) = 1
  687.     IF i AND 1 THEN Nodes(4, 4) = 1
  688.  
  689. ' calculate the value at each node
  690.  
  691.     FOR j = 5 TO 11
  692.       FOR k = 5 TO 8
  693.     l = Nodes(j, k)
  694.     IF l > 0 THEN
  695.       m = Cnxns(l, 3)
  696.       IF Nodes(m, 4) > 0 THEN
  697.         Nodes(j, 4) = Nodes(j, 4) + Cnxns(l, 5)
  698.       END IF
  699.     END IF
  700.       NEXT
  701.     NEXT
  702.     IF Nodes(11, 4) > 0 THEN
  703.       Result(i, 1) = 1
  704.     END IF
  705.   NEXT
  706.  
  707. ' print the results table (top of page)
  708.  
  709.   correct = 0
  710.   FOR i = 1 TO 3
  711.     FOR j = 1 TO 5
  712.       Xloc = 144 * i - 140
  713.       Yloc = 18 * j - 12
  714.       num = i * 5 + j - 5
  715.       fg = 1: zsLocateGCursor Xloc, Yloc
  716.       char$ = "0": IF num AND 8 THEN char$ = "1"
  717.       ziPublish char$, 1, 0
  718.       char$ = "0": IF num AND 4 THEN char$ = "1"
  719.       ziPublish char$, 1, 0
  720.       char$ = "0": IF num AND 2 THEN char$ = "1"
  721.       ziPublish char$, 1, 0
  722.       char$ = "0": IF num AND 1 THEN char$ = "1"
  723.       ziPublish char$ + " (" + MID$(STR$(100 + num) + ") ", 3), 1, 0
  724.       fg = 0: ziPublish STR$(Result(num, 1)), 1, 0
  725.       IF Result(num, 1) = Result(num, 2) THEN
  726.     fg = 8
  727.     char$ = " " + CHR$(251)
  728.     correct = correct + 1
  729.       ELSE
  730.     fg = 12
  731.     char$ = " x"
  732.       END IF
  733.       ziPublish char$, 2, 0
  734.     NEXT
  735.   NEXT
  736.  
  737. ' identify how many are correct
  738.  
  739.   fg = 0: zsLocateGCursor 432, 42
  740.   ziPublish STR$(correct) + " correct ", 2, 1
  741.   fg = 0: zsLocateGCursor 470, 70
  742.   ziPublish "               ", 1, 0
  743.  
  744. ' keep details if this is the most recent best
  745.  
  746.   IF correct >= Best(25) THEN
  747.     FOR i = 1 TO 24
  748.       Best(i) = Cnxns(i, 5)
  749.     NEXT
  750.     Best(25) = correct
  751.   END IF
  752.  
  753. ' keep details if this is the most recent worst
  754.  
  755.   IF correct <= Worst(25) THEN
  756.     FOR i = 1 TO 24
  757.       Worst(i) = Cnxns(i, 5)
  758.     NEXT
  759.     Worst(25) = correct
  760.   END IF
  761.  
  762.   RETURN
  763.  
  764. '+-------------------------------------------------------------------+
  765. '▌ PrintWeight:   (uses Connect)                                     ▌
  766. '▌                                                                   ▌
  767. '▌   Print the weight for a connection                               ▌
  768. '▌                                                                   ▌
  769. '+-------------------------------------------------------------------+
  770. PrintWeight:
  771.  
  772.   Xloc = Cnxns(Connect, 1)
  773.   Yloc = Cnxns(Connect, 2)
  774.   Char1$ = CHR$(64 + Cnxns(Connect, 3))
  775.   Char2$ = CHR$(64 + Cnxns(Connect, 4))
  776.   z = Cnxns(Connect, 5)
  777.   IF z < 1 THEN char3$ = " -" ELSE char3$ = " +"
  778.   IF ABS(z) = 10 THEN
  779.     char4$ = "1."
  780.     char5$ = "0"
  781.   ELSE
  782.     char4$ = "0."
  783.     char5$ = RIGHT$(STR$(z), 1)
  784.   END IF
  785.   zsLocateGCursor Xloc, Yloc
  786.   fg = 4: ziPublish Char1$ + Char2$, 1, 0
  787.   fg = 0: ziPublish char3$ + char4$ + char5$, 1, 0
  788.  
  789.   RETURN
  790.  
  791. '<->
  792. '<p>
  793. '++++++++++++++++++++++++
  794. SUB ziDragging
  795.  
  796.   IF Mouse AND MCursorVis THEN
  797.     SELECT CASE Response
  798.     CASE 2052 TO 2054
  799.       Regs.AX = 3
  800.       CALL zzBasicInt(&H33)
  801.       IF Regs.BX = Response - 2051 THEN
  802.     EXIT SUB
  803.       END IF
  804.     END SELECT
  805.   END IF
  806.   CALL ziExhaust
  807.  
  808. END SUB
  809.  
  810. '<p>
  811. '++++++++++++++++++++++++
  812. SUB ziDrawBank (FromButton, ToButton)
  813.  
  814.   CALL ziSetMCursorVis(10)
  815.  
  816.   FOR i = FromButton TO ToButton
  817.  
  818.     IF Bank(i).Active THEN
  819.  
  820.       IF Bank(i).State THEN
  821.     colour1 = 8
  822.       ELSE
  823.     colour1 = 15
  824.       END IF
  825.       colour2 = colour1 XOR 7
  826.  
  827.       XCoord = Bank(i).Xloc
  828.       YCoord = Bank(i).Yloc
  829.       XWidth = Bank(i).Wide
  830.       YDepth = Bank(i).Deep
  831.       X2Coord = XCoord + XWidth
  832.  
  833.       IF YDepth THEN
  834.     IF YDepth = 1 THEN
  835.       Y2Coord = YCoord + XWidth / XYratio!
  836.     ELSE
  837.       Y2Coord = YCoord + YDepth
  838.     END IF
  839.     LINE (XCoord, YCoord)-(X2Coord - 1, YCoord), colour1
  840.     LINE (XCoord, YCoord)-(XCoord, Y2Coord - 1), colour1
  841.     LINE (XCoord + 1, Y2Coord)-(X2Coord, Y2Coord), colour2
  842.     LINE (X2Coord, YCoord)-(X2Coord, Y2Coord), colour2
  843.       ELSE
  844.     A = XWidth \ 2
  845.     B = A / XYratio!
  846.     C = XCoord + A
  847.     D = YCoord + B
  848.  
  849.     LINE (XCoord, YCoord)-(C + A, D + B), 7, BF
  850.  
  851.     CIRCLE (C, D), A, 8
  852.     CIRCLE (C, D), A - 1, 8
  853.     PAINT (C, D), 7, 7
  854.     IF Bank(i).State THEN
  855.       CIRCLE (C, D), XWidth \ 3, 8
  856.       PAINT (C, D), 8, 8
  857.     END IF
  858.       END IF
  859.     END IF
  860.  
  861.   NEXT
  862.  
  863.   CALL ziSetMCursorVis(11)
  864.  
  865. END SUB
  866.  
  867. '<p>
  868. '++++++++++++++++++++++++
  869. SUB ziExhaust
  870.  
  871.   DO
  872.     x$ = INKEY$
  873.   LOOP WHILE LEN(x$)
  874.  
  875.   IF Mouse AND MCursorVis THEN
  876.     DO
  877.       Regs.AX = 3
  878.       CALL zzBasicInt(&H33)
  879.     LOOP WHILE (Regs.BX AND 3)
  880.   END IF
  881.   Response = 0
  882. END SUB
  883.  
  884. '<p>
  885. '++++++++++++++++++++++++
  886. SUB ziLoadFont (Font$)
  887.  
  888.   DEF SEG = VARSEG(Font(0, 0))
  889.  
  890.   Module$ = Font$ + ".OVL"
  891.   CALL zzInPath(Module$)
  892.   IF Module$ = "" THEN
  893.     Module$ = Font$ + ".OVL"
  894.     ERROR 255
  895.   ELSE
  896.     BLOAD Module$, VARPTR(Font(0, 0))
  897.   END IF
  898.  
  899.   DEF SEG
  900.  
  901. END SUB
  902.  
  903. '<p>
  904. '++++++++++++++++++++++++
  905. SUB ziLocateMCursor (XCoord, YCoord)
  906.  
  907.   IF Mouse THEN
  908.     MXloc = XCoord
  909.     MYloc = YCoord
  910.     Regs.AX = 4
  911.     Regs.CX = XCoord
  912.     Regs.DX = YCoord
  913.     CALL zzBasicInt(&H33)
  914.     CALL ziSetMCursorVis(1)
  915.   END IF
  916.  
  917. END SUB
  918.  
  919. '<p>
  920. '++++++++++++++++++++++++
  921. SUB ziMouseOnButton (FromButton, ToButton)
  922.  
  923.   FoundButton = 0
  924.   FOR i = FromButton TO ToButton
  925.     IF Bank(i).Active THEN
  926.       IF Bank(i).Deep < 2 THEN
  927.     j = Bank(i).Wide / XYratio!
  928.       ELSE
  929.     j = Bank(i).Deep
  930.       END IF
  931.       IF MXloc > Bank(i).Xloc THEN
  932.     IF MXloc < Bank(i).Xloc + Bank(i).Wide THEN
  933.       IF MYloc > Bank(i).Yloc THEN
  934.         IF MYloc < Bank(i).Yloc + j THEN
  935.           FoundButton = i
  936.           EXIT SUB
  937.         END IF
  938.       END IF
  939.     END IF
  940.       END IF
  941.     ELSE
  942.       EXIT SUB
  943.     END IF
  944.   NEXT
  945.  
  946. END SUB
  947.  
  948. '<p>
  949. '++++++++++++++++++++++++
  950. SUB ziPublish (Printstring$, size, italic)
  951.  
  952.   CALL ziSetMCursorVis(10)
  953.  
  954.   xx = POINT(0)
  955.   yy = POINT(1)
  956.   IF size THEN
  957.     Scale = size
  958.   ELSE
  959.     Scale = 1
  960.   END IF
  961.  
  962.   LenString = LEN(Printstring$)
  963.  
  964.   ExpScale = 8 * Scale
  965.   limxx = xx + ExpScale * LenString - 1
  966.   limyy = yy + ExpScale - 1
  967.  
  968.   IF italic AND 1 THEN
  969.     limxx = limxx + 4 * Scale
  970.   END IF
  971.  
  972.  
  973.   IF italic AND 2 THEN
  974.   ELSE
  975.     LINE (xx, yy)-(limxx, limyy), bg, BF
  976.   END IF
  977.  
  978.  
  979.   FOR A = 0 TO LenString - 1
  980.     x = ASC(MID$(Printstring$, A + 1, 1))
  981.     B = xx + ExpScale * A
  982.     FOR y = 0 TO 7
  983.       C = Font(x, y)
  984.       D = y * Scale
  985.       e = yy + D
  986.       IF italic AND 1 THEN
  987.     F = B + 4 * Scale - (D + Scale - 1) \ 2 - 1
  988.       ELSE
  989.     F = B
  990.       END IF
  991.       G = 128
  992.       DO
  993.     IF C AND G THEN
  994.       FOR h = 0 TO Scale - 1
  995.         FOR i = 0 TO Scale - 1
  996.           PSET (F + h, e + i), fg
  997.         NEXT
  998.       NEXT
  999.     END IF
  1000.     F = F + Scale
  1001.     G = G \ 2
  1002.       LOOP UNTIL G = 0
  1003.     NEXT
  1004.   NEXT
  1005.   CALL zsLocateGCursor(limxx + 1, yy)
  1006.  
  1007.   CALL ziSetMCursorVis(11)
  1008.  
  1009. END SUB
  1010.  
  1011. SUB ziPublishHere (row, col, Printstring$, size, italic)
  1012.  
  1013.  IF row + col > 0 THEN
  1014.   LOCATE row, col
  1015.  END IF
  1016.  CALL zsAlignGCursor
  1017.  CALL ziPublish(Printstring$, size, italic)
  1018.  CALL zsAlignTCursor
  1019.  
  1020. END SUB
  1021.  
  1022. '<p>
  1023. '++++++++++++++++++++++++
  1024. SUB ziRadio (Button, FromButton, ToButton)
  1025.  
  1026.   IF Button >= FromButton THEN
  1027.     IF Button <= ToButton THEN
  1028.       FOR A = FromButton TO ToButton
  1029.     Bank(A).State = 0
  1030.       NEXT
  1031.     END IF
  1032.   END IF
  1033.  
  1034.   Bank(Button).State = 1
  1035.   CALL ziDrawBank(FromButton, ToButton)
  1036.  
  1037. END SUB
  1038.  
  1039. '<p>
  1040. '++++++++++++++++++++++++
  1041. SUB ziReadField (Min, Max, Permitted$)
  1042.  
  1043.   CALL ziSetMCursorVis(10)
  1044.  
  1045.   atRow = CSRLIN
  1046.   atCol = POS(x)
  1047.   Field$ = ""
  1048.   PRINT CHR$(219); SPACE$(Max);
  1049.   Rules$ = UCASE$(Permitted$)
  1050.  
  1051.   brake = 1
  1052.   WHILE brake
  1053.     x$ = ""
  1054.     WHILE LEN(x$) = 0
  1055.       x$ = INKEY$
  1056.     WEND
  1057.     IF INSTR(Rules$, "C") THEN x$ = UCASE$(x$)
  1058.     oldLen = LEN(Field$)
  1059.     Good = 0
  1060.     IF INSTR(Rules$, ".") THEN
  1061.       IF x$ = "." THEN
  1062.     IF INSTR(Field$, ".") = 0 THEN
  1063.       Good = 1
  1064.     END IF
  1065.       END IF
  1066.     END IF
  1067.     IF INSTR(Rules$, "N") THEN
  1068.       IF INSTR("0123456789", x$) THEN
  1069.     Good = 1
  1070.       END IF
  1071.     END IF
  1072.     IF INSTR(Rules$, "S") THEN
  1073.       IF x$ = " " THEN
  1074.     Good = 1
  1075.       END IF
  1076.     END IF
  1077.     IF INSTR(Rules$, "X") THEN
  1078.       IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(x$)) THEN
  1079.     Good = 1
  1080.       END IF
  1081.     END IF
  1082.     IF INSTR(Rules$, "Y") THEN
  1083.       IF INSTR("YyNy", x$) THEN
  1084.     Good = 1
  1085.       END IF
  1086.     END IF
  1087.     IF Good THEN
  1088.       Field$ = Field$ + x$
  1089.       IF INSTR(Field$, ".") THEN
  1090.     NewMax = Max + 1
  1091.       ELSE
  1092.     NewMax = Max
  1093.       END IF
  1094.       Field$ = MID$(Field$, 1, NewMax)
  1095.     END IF
  1096.  
  1097.     ' handle Bkspace
  1098.     IF ASC(x$) = 8 AND LEN(Field$) THEN
  1099.       Field$ = MID$(Field$, 1, LEN(Field$) - 1)
  1100.     END IF
  1101.  
  1102.     Signif$ = Field$ + "X"
  1103.     WHILE INSTR(" 0", MID$(Signif$, 1, 1))
  1104.       Signif$ = MID$(Signif$, 2)
  1105.     WEND
  1106.     IF INSTR(Signif$, ".") THEN
  1107.       SignifLen = LEN(Signif$) - 2
  1108.     ELSE
  1109.       SignifLen = LEN(Signif$) - 1
  1110.     END IF
  1111.  
  1112.     ' handle Enter
  1113.     IF ASC(x$) = 13 AND SignifLen >= Min THEN
  1114.       oldLen = LEN(Field$) + 1
  1115.       brake = 0
  1116.     END IF
  1117.  
  1118.     ' handle Esc
  1119.     IF ASC(x$) = 27 THEN
  1120.       LOCATE atRow, atCol
  1121.       PRINT CHR$(219); SPACE$(Max);
  1122.       Field$ = ""
  1123.       IF INSTR(Rules$, "E") THEN
  1124.     EXIT SUB
  1125.       END IF
  1126.     END IF
  1127.  
  1128.     ' reprint if change, or beep if no change
  1129.     IF oldLen = LEN(Field$) THEN
  1130.       BEEP
  1131.     ELSE
  1132.       LOCATE atRow, atCol
  1133.       IF INSTR(Rules$, "P") THEN
  1134.     PRINT STRING$(LEN(Field$), 254); CHR$(219); " ";
  1135.       ELSE
  1136.     PRINT Field$; CHR$(219); " ";
  1137.       END IF
  1138.     END IF
  1139.  
  1140.     ' check for auto-Enter
  1141.     IF INSTR(Rules$, "A") THEN
  1142.       IF SignifLen = Max THEN
  1143.     brake = 0
  1144.       END IF
  1145.     END IF
  1146.   WEND
  1147.  
  1148.   ' justify if required
  1149.   IF INSTR(Rules$, "J") THEN
  1150.     WHILE MID$(Field$, 1, 1) = "0"
  1151.       Field$ = MID$(Field$, 2)
  1152.     WEND
  1153.     Field$ = RIGHT$(SPACE$(NewMax) + Field$, NewMax)
  1154.   END IF
  1155.  
  1156.   ' reprint, deleting the cursor
  1157.   LOCATE atRow, atCol
  1158.   IF INSTR(Rules$, "P") THEN
  1159.     PRINT STRING$(LEN(Field$), 254); " ";
  1160.   ELSE
  1161.     PRINT Field$; " ";
  1162.   END IF
  1163.  
  1164.   CALL ziSetMCursorVis(11)
  1165.  
  1166. END SUB
  1167.  
  1168. '<p>
  1169. '++++++++++++++++++++++++
  1170. SUB ziSetMCursorVis (Status) STATIC
  1171.  
  1172.   IF Mouse THEN
  1173.     SELECT CASE Status
  1174.     CASE 0
  1175.       IF MCursorVis THEN
  1176.        Regs.AX = 2
  1177.        CALL zzBasicInt(&H33)
  1178.       END IF
  1179.     CASE 1
  1180.       Regs.AX = 1
  1181.       CALL zzBasicInt(&H33)
  1182.     CASE 10
  1183.       Regs.AX = &H2A
  1184.       CALL zzBasicInt(&H33)
  1185.       IF Regs.AX = 0 THEN
  1186.     TempFlag = 1
  1187.     Regs.AX = 2
  1188.     CALL zzBasicInt(&H33)
  1189.       ELSE
  1190.     TempFlag = 0
  1191.       END IF
  1192.     CASE 11
  1193.       IF TempFlag THEN
  1194.     Regs.AX = 1
  1195.     CALL zzBasicInt(&H33)
  1196.       END IF
  1197.     END SELECT
  1198.     Regs.AX = &H2A
  1199.     CALL zzBasicInt(&H33)
  1200.     IF Regs.AX = 0 THEN
  1201.       MCursorVis = 1
  1202.     ELSE
  1203.       MCursorVis = 0
  1204.     END IF
  1205.   END IF
  1206. END SUB
  1207.  
  1208. '<p>
  1209. '++++++++++++++++++++++++
  1210. SUB ziWander (Timeout!)
  1211.  
  1212.   IF Timeout! = 0 THEN
  1213.     WatchFor! = TIMER + 3600
  1214.   ELSE
  1215.     WatchFor! = TIMER + Timeout!
  1216.   END IF
  1217.  
  1218.   Response = 0
  1219.  
  1220.   DO
  1221.     x$ = INKEY$
  1222.     IF LEN(x$) THEN
  1223.       SELECT CASE LEN(x$)
  1224.       CASE 1
  1225.     A = INSTR(Allowed$, x$)
  1226.     IF A THEN
  1227.       Response = A
  1228.       EXIT DO
  1229.     END IF
  1230.     SELECT CASE ASC(x$)
  1231.     CASE 8: Response = 261
  1232.     CASE 9: Response = 266
  1233.     CASE 10: Response = 512
  1234.     CASE 13: Response = 256
  1235.     CASE 27: Response = 267
  1236.     CASE 127: Response = 517
  1237.     END SELECT
  1238.     IF Response THEN
  1239.       EXIT DO
  1240.     END IF
  1241.       CASE 2
  1242.     Rightmost = ASC(RIGHT$(x$, 1))
  1243.     SELECT CASE Rightmost
  1244.     CASE 15: Response = 1019
  1245.     CASE 59 TO 68
  1246.       Response = 4038
  1247.     CASE 72: Response = 187
  1248.     CASE 71 TO 73
  1249.       Response = 191
  1250.     CASE 75: Response = 182
  1251.     CASE 77: Response = 181
  1252.     CASE 80: Response = 180
  1253.     CASE 79 TO 81
  1254.       Response = 184
  1255.     CASE 84 TO 93
  1256.       Response = 16301
  1257.     CASE 94 TO 103
  1258.       Response = 8099
  1259.     CASE 115 TO 116
  1260.       Response = 398
  1261.     CASE 117: Response = 402
  1262.     CASE 118: Response = 403
  1263.     CASE 119: Response = 399
  1264.     CASE 127: Response = 390
  1265.     CASE 132: Response = 388
  1266.     CASE 133 TO 134
  1267.       Response = 3974
  1268.     CASE 135 TO 136
  1269.       Response = 16260
  1270.     CASE 137 TO 138
  1271.       Response = 8066
  1272.     END SELECT
  1273.     IF Response THEN
  1274.       Response = Response + Rightmost
  1275.       EXIT DO
  1276.     END IF
  1277.       END SELECT
  1278.     END IF
  1279.  
  1280.     IF Mouse AND MCursorVis THEN
  1281.       Regs.AX = 3
  1282.       CALL zzBasicInt(&H33)
  1283.       SELECT CASE Regs.BX
  1284.       CASE 1 TO 3
  1285.     Response = 2048 + Regs.BX
  1286.     nowtime! = TIMER
  1287.     DO
  1288.       Regs.AX = 3
  1289.       CALL zzBasicInt(&H33)
  1290.       IF Regs.BX = 0 THEN EXIT DO
  1291.     LOOP UNTIL TIMER - nowtime! > .3
  1292.     IF Regs.BX = Response - 2048 THEN
  1293.       Response = Response + 3
  1294.     ELSE
  1295.       IF Regs.BX = 0 AND Response = 2049 AND DClick THEN
  1296.         nowtime! = TIMER
  1297.         DO
  1298.           Regs.AX = 3
  1299.           CALL zzBasicInt(&H33)
  1300.           IF Regs.BX = 1 THEN EXIT DO
  1301.         LOOP UNTIL TIMER - nowtime! > .3
  1302.         IF Regs.BX = 1 THEN
  1303.           Response = 2048
  1304.           CALL ziExhaust
  1305.         END IF
  1306.       END IF
  1307.       IF Regs.BX = 3 THEN
  1308.         Response = 2051
  1309.       END IF
  1310.     END IF
  1311.       END SELECT
  1312.       IF Response THEN
  1313.     MXloc = Regs.CX
  1314.     MYloc = Regs.DX
  1315.     EXIT DO
  1316.       END IF
  1317.     END IF
  1318.  
  1319.   LOOP UNTIL WatchFor! < TIMER
  1320.   HResponse = Response \ 256
  1321.   LResponse = Response MOD 256
  1322.  
  1323. END SUB
  1324.  
  1325. '<p>
  1326. '++++++++++++++++++++++++
  1327. SUB zsAlignGCursor
  1328.  
  1329.   row = CSRLIN
  1330.   col = POS(0)
  1331.   GXloc = (col - 1) * ((Xmax + 1) \ Cols)
  1332.   GYloc = (row - 1) * ((((Ymax + 1) \ Rows) * Rows + 1) \ Rows)
  1333.   CALL zsLocateGCursor(GXloc, GYloc)
  1334.  
  1335. END SUB
  1336.  
  1337. '<p>
  1338. '++++++++++++++++++++++++
  1339. SUB zsAlignTCursor
  1340.  
  1341.   GXloc = POINT(0)
  1342.   GYloc = POINT(1)
  1343.   A = (Xmax + 1) / Cols
  1344.   B = (Ymax + 1) / Rows
  1345.   col = (GXloc + A - 1) \ A + 1
  1346.   row = (GYloc + B - 1) \ B + 1
  1347.   LOCATE row, col
  1348.   CALL zsAlignGCursor
  1349.  
  1350. END SUB
  1351.  
  1352. '<p>
  1353. '++++++++++++++++++++++++
  1354. SUB zsLocateGCursor (XCoord, YCoord)
  1355.  
  1356.   GXloc = XCoord
  1357.   GYloc = YCoord
  1358.   PSET (GXloc, GYloc), POINT(GXloc, GYloc)
  1359.  
  1360. END SUB
  1361.  
  1362. '<p>
  1363. '++++++++++++++++++++++++
  1364. SUB zsPastel (XCoord, YCoord, Wide, Deep, colour1, colour2)
  1365.  
  1366.   CALL ziSetMCursorVis(10)
  1367.  
  1368.   IF Deep < 2 THEN
  1369.     A = Wide / XYratio!
  1370.   ELSE
  1371.     A = Deep
  1372.   END IF
  1373.  
  1374.   LINE (XCoord, YCoord)-(XCoord + Wide - 1, YCoord + A - 1), colour1, BF
  1375.   FOR B = XCoord TO XCoord + Wide - 1 STEP 2
  1376.     LINE (B, YCoord)-(B, YCoord + A - 1), colour2, , &H5555
  1377.   NEXT
  1378.   FOR B = XCoord + 1 TO XCoord + Wide - 1 STEP 2
  1379.     LINE (B, YCoord)-(B, YCoord + A - 1), colour2, , &HAAAA
  1380.   NEXT
  1381.  
  1382.   CALL ziSetMCursorVis(11)
  1383.  
  1384. END SUB
  1385.  
  1386. '<p>
  1387. '++++++++++++++++++++++++
  1388. SUB zsSetScrnMode (Mode, HiRows, HiCols)
  1389.  
  1390.   CALL ziSetMCursorVis(10)
  1391.  
  1392.   ScrnMode = Mode
  1393.   SELECT CASE Mode
  1394.   CASE 9
  1395.     SCREEN 9
  1396.     IF HiRows THEN
  1397.       Rows = 43
  1398.     ELSE
  1399.       Rows = 25
  1400.     END IF
  1401.     Xmax = 639
  1402.     Ymax = 349
  1403.   CASE 12
  1404.     SCREEN 12
  1405.     IF HiRows THEN
  1406.       Rows = 60
  1407.     ELSE
  1408.       Rows = 30
  1409.     END IF
  1410.     Xmax = 639
  1411.     Ymax = 479
  1412.   CASE 13
  1413.     SCREEN 13
  1414.     Rows = 25
  1415.     Cols = 40
  1416.     Xmax = 319
  1417.     Ymax = 199
  1418.   CASE ELSE
  1419.     RETURN
  1420.   END SELECT
  1421.  
  1422.   IF Mode <> 13 THEN
  1423.     IF HiCols THEN
  1424.       Cols = 80
  1425.     ELSE
  1426.       Cols = 40
  1427.     END IF
  1428.   END IF
  1429.   WIDTH Cols, Rows
  1430.   CLS
  1431.   IF Mode = 9 THEN COLOR fg, 0
  1432.  
  1433.   LINE (0, 0)-(Xmax, Ymax), bg, BF
  1434.   LOCATE 1, 1, 0
  1435.   PSET (0, 0), bg
  1436.   XYratio! = .75 * (Xmax + 1) / (Ymax + 1)
  1437.  
  1438.   CALL ziSetMCursorVis(11)
  1439.  
  1440. END SUB
  1441.  
  1442. '<p>
  1443. '++++++++++++++++++++++++
  1444. SUB zsSubstitute (XCoord, YCoord, Wide, Deep, colour1, colour2)
  1445.  
  1446.   CALL ziSetMCursorVis(10)
  1447.  
  1448.   IF Deep < 2 THEN
  1449.     A = Wide / XYratio!
  1450.   ELSE
  1451.     A = Deep
  1452.   END IF
  1453.   FOR B = XCoord TO XCoord + Wide - 1
  1454.     FOR C = YCoord TO YCoord + A - 1
  1455.       IF POINT(B, C) = colour1 THEN
  1456.     PSET (B, C), colour2
  1457.       END IF
  1458.     NEXT
  1459.   NEXT
  1460.  
  1461.   CALL ziSetMCursorVis(11)
  1462.  
  1463. END SUB
  1464.  
  1465. '<p>
  1466. '++++++++++++++++++++++++
  1467. SUB zzAlphaSort (SortData$())
  1468.  
  1469.  DIM SortPointers(SortCount, 2)
  1470.  
  1471.  FOR i = 2 TO SortCount
  1472.   j = 1
  1473.  
  1474.   DO
  1475.    k = j
  1476.    IF SortData$(i) < SortData$(j) THEN
  1477.     j = SortPointers(j, 1)
  1478.    ELSE
  1479.     j = SortPointers(j, 2)
  1480.    END IF
  1481.   LOOP WHILE j <> 0
  1482.  
  1483.   IF SortData$(i) < SortData$(k) THEN
  1484.    SortPointers(k, 1) = i
  1485.   ELSE
  1486.    SortPointers(k, 2) = i
  1487.   END IF
  1488.  NEXT
  1489.  
  1490.  SortPointers(0, 1) = 1
  1491.  
  1492.  
  1493.  FOR i = 1 TO SortCount
  1494.   j = 0
  1495.   DO WHILE SortPointers(j, 1) <> 0
  1496.    k = j
  1497.    j = SortPointers(j, 1)
  1498.   LOOP
  1499.   SortPointers(k, 1) = SortPointers(j, 2)
  1500.  
  1501.   SWAP SortData$(i), SortData$(j)
  1502.   SWAP SortPointers(i, 1), SortPointers(j, 1)
  1503.   SWAP SortPointers(i, 2), SortPointers(j, 2)
  1504.  
  1505.   FOR k = 0 TO SortCount
  1506.    FOR l = 1 TO 2
  1507.     IF SortPointers(k, l) = i THEN SortPointers(k, l) = j
  1508.    NEXT
  1509.   NEXT
  1510.  NEXT
  1511.  
  1512. END SUB
  1513.  
  1514. '<p>
  1515. '++++++++++++++++++++++++
  1516. SUB zzBasicInt (IntType) STATIC
  1517.  
  1518.   DIM ASM(54)
  1519.   DEF SEG = VARSEG(ASM(0))
  1520.  
  1521.   IF ASM(1) = 0 THEN
  1522.     Module$ = "BASICINT.OVL"
  1523.     CALL zzInPath(Module$)
  1524.     IF Module$ = "" THEN
  1525.       Module$ = "BASICINT.OVL"
  1526.       ERROR 255
  1527.     ELSE
  1528.       BLOAD Module$, VARPTR(ASM(0))
  1529.     END IF
  1530.   END IF
  1531.  
  1532.   CALL ABSOLUTE(Regs, IntType, VARPTR(ASM(0)))
  1533.  
  1534.   DEF SEG
  1535.  
  1536. END SUB
  1537.  
  1538. '<p>
  1539. '++++++++++++++++++++++++
  1540. SUB zzChangeDir (Directory$)
  1541.  DIM str AS STRING * 65
  1542.  
  1543.  str = LTRIM$(RTRIM$(UCASE$(Directory$))) + CHR$(0)
  1544.  IF MID$(str, 2, 1) = ":" THEN
  1545.   curdrive$ = MID$(str, 1, 1)
  1546.   str = MID$(str, 3)
  1547.  ELSE
  1548.   Regs.AX = &H1900
  1549.   CALL zzBasicInt(&H21)
  1550.   curdrive$ = CHR$(65 + (Regs.AX AND 255))
  1551.  END IF
  1552.  IF MID$(str, 1, 1) = CHR$(0) THEN
  1553.   GOSUB zzChangeDirAA
  1554.   EXIT SUB
  1555.  END IF
  1556.  str = curdrive$ + ":" + str
  1557.  Regs.AX = &H3B00
  1558.  Regs.DS = VARSEG(str)
  1559.  Regs.DX = VARPTR(str)
  1560.  CALL zzBasicInt(&H21)
  1561.  IF (Regs.FL AND 256) = 256 THEN
  1562.   Directory$ = ""
  1563.  ELSE
  1564.   GOSUB zzChangeDirAA
  1565.  END IF
  1566.  EXIT SUB
  1567.  
  1568. zzChangeDirAA:
  1569.   Regs.AX = &H4700
  1570.   Regs.DX = ASC(curdrive$) - 64
  1571.   Regs.DS = VARSEG(str)
  1572.   Regs.SI = VARPTR(str)
  1573.   CALL zzBasicInt(&H21)
  1574.   i = INSTR(str, CHR$(0))
  1575.   Directory$ = curdrive$ + ":\" + MID$(str, 1, i - 1)
  1576.   RETURN
  1577. END SUB
  1578.  
  1579. '<p>
  1580. '++++++++++++++++++++++++
  1581. SUB zzChangeDrive (Drive$)
  1582.  
  1583.  CALL zzCritOff
  1584.  GOSUB zzChangeDriveProcess
  1585.  CALL zzCritOn
  1586.  
  1587.  EXIT SUB
  1588.  
  1589. zzChangeDriveProcess:
  1590.  
  1591.  Drive$ = LTRIM$(RTRIM$(UCASE$(Drive$)))
  1592.  IF LEN(Drive$) = 0 THEN
  1593.   Regs.AX = &H1900
  1594.   CALL zzBasicInt(&H21)
  1595.   Drive$ = CHR$(65 + (Regs.AX AND 255)) + ":"
  1596.   RETURN
  1597.  END IF
  1598.  
  1599.  IF LEN(Drive$) = 1 THEN Drive$ = Drive$ + ":"
  1600.  IF LEN(Drive$) > 2 THEN Drive$ = "?"
  1601.  
  1602.  IF MID$(Drive$, 2, 1) = ":" THEN
  1603.   drv = ASC(Drive$)
  1604.   Drive$ = "?"
  1605.   IF drv < 65 THEN RETURN
  1606.   IF drv > 90 THEN RETURN
  1607.   drv = drv - 65
  1608.  
  1609. ' establish whether this is a shared drive
  1610.  
  1611.   Regs.AX = &H440E
  1612.   Regs.BX = drv + 1
  1613.   CALL zzBasicInt(&H21)
  1614.   IF (Regs.FL AND 256) = 256 THEN
  1615.    Regs.AX = 0
  1616.   END IF
  1617.   Regs.AX = Regs.AX AND 255
  1618.   IF Regs.AX <> 0 THEN
  1619.    IF Regs.AX <> drv + 1 THEN
  1620.     drv = Regs.AX - 1
  1621.    END IF
  1622.   END IF
  1623.  
  1624. ' establish whether this is a valid drive
  1625.  
  1626.   Regs.AX = &H1C00
  1627.   Regs.DX = drv + 1
  1628.   CALL zzBasicInt(&H21)
  1629.   IF (Regs.AX AND 255) = 255 THEN RETURN
  1630.  
  1631. ' now change to it
  1632.  
  1633.   Regs.AX = &HE00
  1634.   Regs.DX = drv
  1635.   CALL zzBasicInt(&H21)
  1636.  
  1637.   Drive$ = CHR$(65 + drv) + ":"
  1638.  
  1639.  
  1640.  ELSE
  1641.   Drive$ = "?"
  1642.  END IF
  1643.  RETURN
  1644.  
  1645. END SUB
  1646.  
  1647. SUB zzCritOff
  1648.  
  1649.  Regs.AX = &H2524
  1650.  Regs.DS = VARSEG(IRET)
  1651.  Regs.DX = VARPTR(IRET)
  1652.  CALL zzBasicInt(&H21)
  1653.  CritCount = CritCount + 1
  1654.  
  1655. END SUB
  1656.  
  1657. SUB zzCritOn
  1658.  
  1659.  CritCount = CritCount - 1
  1660.  IF CritCount = 0 THEN
  1661.   Regs.AX = &H2524
  1662.   Regs.DS = CritSeg
  1663.   Regs.DX = CritPtr
  1664.   CALL zzBasicInt(&H21)
  1665.  END IF
  1666.  
  1667. END SUB
  1668.  
  1669. '<p>
  1670. '++++++++++++++++++++++++
  1671. SUB zzFileSelectBox (Pattern$)
  1672.  
  1673. DIM Devices(26)  ';valid devices have a non-zero value
  1674. DIM validDevs(27)
  1675.  
  1676. DIM parts$(11) ';ten deep is allowed
  1677. DIM Dirs$(200) ';lots of subdirectories
  1678. DIM Files$(200) ';lots of files
  1679. DIM str AS STRING * 65
  1680.  
  1681.  CALL zzCritOff
  1682.  GOSUB zzFileSelectBoxProcess
  1683.  CALL zzCritOn
  1684.  
  1685.  EXIT SUB
  1686.  
  1687. zzFileSelectBoxProcess:
  1688.  
  1689. ' create the screen
  1690.  
  1691.   IF screendone = 0 THEN
  1692.    bg = 7: fg = 15
  1693.    CALL zsSetScrnMode(9, 1, 1)
  1694.    fg = 0
  1695.    CALL ziPublishHere(3, 34, "Select a File", 1, 3)
  1696.    Stuff$ = "(Please Wait)"
  1697.    fg = 14
  1698.    GOSUB zzFileSelectBoxDD
  1699.  
  1700. ' print the headers
  1701.  
  1702.    fg = 8
  1703.    CALL ziPublishHere(42, 17, "Use left & right arrow keys to change columns", 0, 1)
  1704.   END IF
  1705.   screendone = 1
  1706.  
  1707.   fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
  1708.   LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  1709.  
  1710.  
  1711.   IF NoDriveSelection = 0 THEN
  1712.    dev = 0: GOSUB zzFileSelectBoxAA
  1713.  
  1714. ' find the DTA
  1715.  
  1716.    Regs.AX = &H2F00
  1717.    CALL zzBasicInt(&H21)
  1718.    DTAseg = Regs.ES
  1719.    DTAptr = Regs.BX
  1720.  
  1721. ' establish the existing devices
  1722.  
  1723.    MaxDevs = 0
  1724.    FOR i = 1 TO 26
  1725.     Devices(i) = 0
  1726.     validDevs(i) = 0
  1727.     Regs.AX = &H440E
  1728.     Regs.BX = i
  1729.     CALL zzBasicInt(&H21)
  1730.     IF (Regs.FL AND 256) = 256 THEN
  1731.      Regs.AX = 0
  1732.     END IF
  1733.     Regs.AX = Regs.AX AND 255
  1734.     IF (Regs.AX = 0) OR (Regs.AX = i) THEN
  1735.      Regs.AX = &H1C00
  1736.      Regs.DX = i
  1737.      CALL zzBasicInt(&H21)
  1738.      IF (Regs.AX AND 255) <> 255 THEN
  1739.       MaxDevs = MaxDevs + 1
  1740.       Devices(i) = MaxDevs '; set the crossreference
  1741.       validDevs(MaxDevs) = i
  1742.      END IF
  1743.     END IF
  1744.    NEXT
  1745.  
  1746. ' print the valid drives as a list
  1747.  
  1748.    fg = 0
  1749.    FOR i = 1 TO MaxDevs
  1750.     x$ = CHR$(64 + validDevs(i)) + ":"
  1751.     CALL ziPublishHere(10 + i + i, 7, x$, 1, 0)
  1752.    NEXT
  1753.   END IF
  1754.   LINE (GXloc - 16, GYloc + 8)-(GXloc, 319), 7, BF 'clear rest of list
  1755.  
  1756.  
  1757.   NoDriveSelection = 0
  1758.  
  1759.   fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  1760.   LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  1761.  
  1762. ' carve off any 'wildcard' from the specified input parameter
  1763.  
  1764.   Pattern$ = UCASE$(LTRIM$(RTRIM$(Pattern$)))
  1765.   str = Pattern$
  1766.   IF INSTR(str, "?") + INSTR(str, "*") = 0 THEN
  1767.    base$ = Pattern$
  1768.    wild$ = "*.*"
  1769.   ELSE
  1770.    IF MID$(str, 2, 1) = ":" THEN
  1771.     start = 3
  1772.    ELSE
  1773.     start = 1
  1774.    END IF
  1775.    DO
  1776.     i = INSTR(start, str, "\")
  1777.     IF i <> 0 THEN
  1778.      start = i + 1
  1779.     END IF
  1780.    LOOP UNTIL i = 0
  1781.    base$ = MID$(str, 1, start - 1)
  1782.    wild$ = MID$(RTRIM$(str), start)
  1783.   END IF
  1784.  
  1785.   CALL zzValidate(base$)
  1786.   IF base$ = "?" THEN
  1787.    base$ = ""
  1788.    CALL zzChangeDir(base$)
  1789.   END IF
  1790.  
  1791.  
  1792.   IF MID$(base$, LEN(base$)) = "\" THEN
  1793.    basex$ = MID$(base$, 1, LEN(base$) - 1)
  1794.   ELSE
  1795.    basex$ = base$
  1796.   END IF
  1797.  
  1798.  
  1799.  
  1800. ' validate the "wildcard" portion
  1801.  
  1802. ' (make sure no more than one ".")
  1803.  
  1804.   i = INSTR(wild$, ".")
  1805.   IF i <> 0 THEN
  1806.    x$ = wild$
  1807.    MID$(x$, i, 1) = "+"
  1808.    IF INSTR(x$, ".") THEN
  1809.     wild$ = "*.*"
  1810.     i = 2
  1811.    END IF
  1812.   END IF
  1813.  
  1814. ' (divide it into its two component parts)
  1815.  
  1816.   IF i < 2 THEN
  1817.    wildl$ = wild$
  1818.    wildr$ = ""
  1819.   ELSE
  1820.    wildl$ = MID$(wild$, 1, i - 1)
  1821.    wildr$ = MID$(wild$, i + 1)
  1822.   END IF
  1823.   IF LEN(wildl$) > 8 OR LEN(wildr$) > 3 THEN
  1824.    wild$ = "*.*"
  1825.    wildl$ = "*"
  1826.    wildr$ = "*"
  1827.   END IF
  1828.  
  1829. ' (make sure no more than one TRAILING "*" in left part)
  1830.  
  1831.   i = INSTR(wildl$, "*")
  1832.   IF i <> 0 THEN
  1833.    IF i <> LEN(wildl$) THEN
  1834.     wild$ = "*.*"
  1835.     wildl$ = "*"
  1836.     wildr$ = "*"
  1837.    END IF
  1838.   END IF
  1839.  
  1840. ' (make sure no more than one TRAILING "*" in right part)
  1841.  
  1842.   i = INSTR(wildr$, "*")
  1843.   IF i <> 0 THEN
  1844.    IF i <> LEN(wildr$) THEN
  1845.     wild$ = "*.*"
  1846.     wildl$ = "*"
  1847.     wildr$ = "*"
  1848.    END IF
  1849.   END IF
  1850.  
  1851.   i = 39 - LEN(wild$) \ 2
  1852.   x$ = "[" + wild$ + "]"
  1853.   CALL ziPublishHere(7, i, x$, 0, 0)
  1854.  
  1855. ' determine the specified drive
  1856.  
  1857.   dev = Devices(ASC(base$) - 64)
  1858.   GOSUB zzFileSelectBoxAA
  1859.  
  1860. ' create the tree
  1861.  
  1862.   FOR i = 0 TO 11
  1863.    parts$(i) = ""
  1864.   NEXT
  1865.   x$ = basex$ + "\"
  1866.  
  1867.   levels = 0
  1868.   DO
  1869.    i = INSTR(x$, "\")
  1870.    IF i <> 0 THEN
  1871.     parts$(levels) = MID$(x$, 1, i - 1)
  1872.     levels = levels + 1
  1873.     x$ = MID$(x$, i + 1)
  1874.    END IF
  1875.   LOOP UNTIL i = 0
  1876.   parts$(0) = parts$(0) + "\"
  1877.   levels = levels - 1
  1878.  
  1879.   CALL ziPublishHere(12, 15, parts$(0), 0, 0)
  1880.  
  1881.   IF levels > 0 THEN
  1882.    FOR i = 1 TO levels
  1883.     x$ = SPACE$(i + i) + CHR$(179)
  1884.     CALL ziPublishHere(11 + i + i, 13, x$, 0, 0)
  1885.     x$ = SPACE$(i + i) + CHR$(192) + CHR$(196) + parts$(i)
  1886.     CALL ziPublishHere(12 + i + i, 13, x$, 0, 0)
  1887.    NEXT
  1888.   END IF
  1889.  
  1890.   oldtree = 255
  1891.   tree = levels
  1892.   GOSUB zzFileSelectBoxHH
  1893.  
  1894.  
  1895. ' test for subdirectories present
  1896.  
  1897.   olddline = 0
  1898.   x$ = basex$ + "\*.*"
  1899.   CALL zzSearchD(x$)
  1900.  
  1901.   IF Directories <> 0 THEN
  1902.    fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  1903.    FromDir = 1
  1904.    GOSUB zzFileSelectBoxEE
  1905.   END IF
  1906.  
  1907. ' test for files present
  1908.  
  1909.   x$ = basex$ + "\" + wild$
  1910.   CALL zzSearchF(x$)
  1911.  
  1912.   IF FileNames <> 0 THEN
  1913.    fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  1914.    FromFile = 1
  1915.    GOSUB zzFileSelectBoxFF
  1916.   END IF
  1917.  
  1918. ' determine where to start
  1919.  
  1920.   IF FileNames = 0 THEN
  1921.    IF Directories = 0 THEN
  1922.     fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  1923.     Stuff$ = basex$ + "\"
  1924.     GOSUB zzFileSelectBoxDD
  1925.     Column = 2
  1926.    ELSE
  1927.     fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  1928.     dline = 1
  1929.     GOSUB zzFileSelectBoxBB
  1930.     Stuff$ = basex$ + "\" + Directories$(FromDir)
  1931.     GOSUB zzFileSelectBoxDD
  1932.     Column = 4
  1933.    END IF
  1934.  
  1935.   ELSE
  1936.    fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  1937.    fline = 1
  1938.    GOSUB zzFileSelectBoxCC
  1939.    Column = 3
  1940.   END IF
  1941.  
  1942.  
  1943. ' determine what to do, based on keystroke
  1944.  
  1945.   DO
  1946.    stroke$ = "X"
  1947.    DO
  1948.     stroke$ = INKEY$
  1949.    LOOP UNTIL LEN(stroke$) = 0
  1950.    DO
  1951.     stroke$ = INKEY$
  1952.    LOOP WHILE LEN(stroke$) = 0
  1953.    IF LEN(stroke$) = 1 THEN
  1954.     stroke$ = UCASE$(stroke$)
  1955.     SELECT CASE ASC(stroke$)
  1956.     CASE 27   'ESC
  1957.      Pattern$ = "?"
  1958.      RETURN
  1959.     CASE 13   'Enter
  1960.      SELECT CASE Column
  1961.      CASE 1    'enactivate new drive
  1962.       x$ = CHR$(validDevs(dev) + 64) + ":"
  1963.       Pattern$ = x$ + "\" + wild$
  1964.       LINE (112, 88)-(383, 319), 7, BF  'clear the "tree" area
  1965.  
  1966.  
  1967.       GOSUB zzFileSelectBoxII
  1968.       GOTO zzFileSelectBoxProcess
  1969.  
  1970.      CASE 2    'choose new directory
  1971.       IF tree <> levels THEN
  1972.        base$ = ""
  1973.        FOR i = 0 TO tree
  1974.     base$ = base$ + parts$(i)
  1975.     IF MID$(base$, LEN(base$)) <> "\" THEN
  1976.      base$ = base$ + "\"
  1977.     END IF
  1978.        NEXT
  1979.        IF MID$(base$, LEN(base$)) <> "\" THEN
  1980.     base$ = base$ + "\"
  1981.        END IF
  1982.        Pattern$ = base$ + wild$
  1983.        NoDriveSelection = 1
  1984.        GOSUB zzFileSelectBoxII
  1985.        GOTO zzFileSelectBoxProcess
  1986.       END IF
  1987.  
  1988.  
  1989.      CASE 3    'exit with chosen filename
  1990.       Pattern$ = Stuff$
  1991.       RETURN
  1992.  
  1993.      CASE 4    'choose new subdirectory
  1994.       Pattern$ = basex$ + "\" + Directories$(FromDir + dline - 1)
  1995.       Pattern$ = Pattern$ + "\" + wild$
  1996.       NoDriveSelection = 1
  1997.       GOSUB zzFileSelectBoxII
  1998.       GOTO zzFileSelectBoxProcess
  1999.  
  2000.  
  2001.      END SELECT
  2002.  
  2003.     CASE ASC("A") TO ASC("Z")
  2004.      SELECT CASE Column
  2005.      CASE 1
  2006.       i = ASC(stroke$) - 64
  2007.       IF Devices(i) <> 0 THEN
  2008.        dev = Devices(i)
  2009.        GOSUB zzFileSelectBoxAA
  2010.       END IF
  2011.      CASE 3
  2012.       i = FileNames
  2013.       x$ = MID$(FileNames$(i), 1, 1)
  2014.       IF x$ >= stroke$ THEN
  2015.        i = 0
  2016.        DO
  2017.     i = i + 1
  2018.     x$ = MID$(FileNames$(i), 1, 1)
  2019.        LOOP WHILE x$ < stroke$
  2020.       END IF
  2021.       FromFile = i
  2022.       GOSUB zzFileSelectBoxFF
  2023.       fline = 1: GOSUB zzFileSelectBoxCC
  2024.  
  2025.      CASE 4
  2026.       i = Directories
  2027.       x$ = MID$(Directories$(i), 1, 1)
  2028.       IF x$ >= stroke$ THEN
  2029.        i = 0
  2030.        DO
  2031.     i = i + 1
  2032.     x$ = MID$(Directories$(i), 1, 1)
  2033.        LOOP WHILE x$ < stroke$
  2034.       END IF
  2035.       FromDir = i
  2036.       GOSUB zzFileSelectBoxEE
  2037.       dline = 1: GOSUB zzFileSelectBoxBB
  2038.  
  2039.      END SELECT
  2040.     END SELECT
  2041.    ELSE
  2042.     SELECT CASE MID$(stroke$, 2)
  2043.     CASE "I"    'Page UP
  2044.      SELECT CASE Column
  2045.      CASE 3
  2046.       OldFromFile = FromFile
  2047.       IF FromFile + fline > 31 THEN
  2048.        FromFile = FromFile + fline - 31
  2049.       ELSE
  2050.        FromFile = 1
  2051.       END IF
  2052.       IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  2053.       fline = 1: GOSUB zzFileSelectBoxCC
  2054.      CASE 4
  2055.       OldFromDir = FromDir
  2056.       IF FromDir + dline > 31 THEN
  2057.        FromDir = FromDir + dline - 31
  2058.       ELSE
  2059.        FromDir = 1
  2060.       END IF
  2061.       IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2062.       dline = 1: GOSUB zzFileSelectBoxBB
  2063.      END SELECT
  2064.     CASE "Q"    'Page DN
  2065.      SELECT CASE Column
  2066.      CASE 3
  2067.       OldFromFile = FromFile
  2068.       IF FromFile + fline + 30 < FileNames THEN
  2069.        FromFile = FromFile + fline + 29
  2070.        IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  2071.        fline = 1: GOSUB zzFileSelectBoxCC
  2072.       END IF
  2073.      CASE 4
  2074.       OldFromDir = FromDir
  2075.       IF FromDir + dline + 30 < Directories THEN
  2076.        FromDir = FromDir + dline + 29
  2077.        IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2078.        dline = 1: GOSUB zzFileSelectBoxBB
  2079.       END IF
  2080.      END SELECT
  2081.     CASE "G"    'HOME
  2082.      SELECT CASE Column
  2083.      CASE 3
  2084.       IF FromFile <> 1 THEN
  2085.        FromFile = 1
  2086.        GOSUB zzFileSelectBoxFF
  2087.       END IF
  2088.       fline = 1: GOSUB zzFileSelectBoxCC
  2089.      CASE 4
  2090.       IF FromDir <> 1 THEN
  2091.        FromDir = 1
  2092.        GOSUB zzFileSelectBoxEE
  2093.       END IF
  2094.       dline = 1: GOSUB zzFileSelectBoxBB
  2095.      END SELECT
  2096.     CASE "O"    'END
  2097.      SELECT CASE Column
  2098.      CASE 3
  2099.       OldFromFile = FromFile
  2100.       FromFile = FileNames - 29
  2101.       IF FromFile < 1 THEN
  2102.        FromFile = 1
  2103.       END IF
  2104.       IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  2105.       fline = 1: GOSUB zzFileSelectBoxCC
  2106.      CASE 4
  2107.       OldFromDir = FromDir
  2108.       FromDir = Directories - 29
  2109.       IF FromDir < 1 THEN
  2110.        FromDir = 1
  2111.       END IF
  2112.       IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2113.       dline = 1: GOSUB zzFileSelectBoxBB
  2114.      END SELECT
  2115.     CASE "H"    'UP
  2116.      SELECT CASE Column
  2117.      CASE 1     'drives
  2118.       IF dev > 1 THEN
  2119.        dev = dev - 1
  2120.        GOSUB zzFileSelectBoxAA
  2121.       END IF
  2122.      CASE 2     'tree
  2123.       IF tree > 0 THEN
  2124.        tree = tree - 1
  2125.        GOSUB zzFileSelectBoxHH
  2126.       END IF
  2127.      CASE 3     'files
  2128.       i = FromFile + fline - 2
  2129.       IF i > 0 THEN
  2130.        IF fline > 1 THEN
  2131.     fline = fline - 1
  2132.     GOSUB zzFileSelectBoxCC
  2133.        ELSE
  2134.     OldFromFile = FromFile
  2135.     FromFile = FromFile - 30
  2136.     fline = fline + 29
  2137.     IF FromFile < 1 THEN
  2138.      fline = fline + FromFile - 1
  2139.      FromFile = 1
  2140.     END IF
  2141.     IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
  2142.     GOSUB zzFileSelectBoxCC
  2143.        END IF
  2144.       END IF
  2145.      CASE 4     'subdirs
  2146.       i = FromDir + dline - 2
  2147.       IF i > 0 THEN
  2148.        IF dline > 1 THEN
  2149.     dline = dline - 1
  2150.     GOSUB zzFileSelectBoxBB
  2151.        ELSE
  2152.     OldFromDir = FromDir
  2153.     FromDir = FromDir - 30
  2154.     dline = dline + 29
  2155.     IF FromDir < 1 THEN
  2156.      dline = dline + FromDir - 1
  2157.      FromDir = 1
  2158.     END IF
  2159.     IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
  2160.     GOSUB zzFileSelectBoxBB
  2161.        END IF
  2162.       END IF
  2163.      END SELECT
  2164.  
  2165.     CASE "P"   'DOWN
  2166.      SELECT CASE Column
  2167.      CASE 1     'drives
  2168.       IF dev < MaxDevs THEN
  2169.        dev = dev + 1
  2170.        GOSUB zzFileSelectBoxAA
  2171.       END IF
  2172.      CASE 2     'tree
  2173.       IF tree < levels THEN
  2174.        tree = tree + 1
  2175.        GOSUB zzFileSelectBoxHH
  2176.       END IF
  2177.      CASE 3     'files
  2178.       i = FromFile + fline
  2179.       IF i <= FileNames THEN
  2180.        IF fline < 30 THEN
  2181.     fline = fline + 1
  2182.     GOSUB zzFileSelectBoxCC
  2183.        ELSE
  2184.     FromFile = i: GOSUB zzFileSelectBoxFF
  2185.     fline = 1: GOSUB zzFileSelectBoxCC
  2186.        END IF
  2187.       END IF
  2188.      CASE 4     'subdirs
  2189.       i = FromDir + dline
  2190.       IF i <= Directories THEN
  2191.        IF dline < 30 THEN
  2192.     dline = dline + 1
  2193.     GOSUB zzFileSelectBoxBB
  2194.        ELSE
  2195.     FromDir = i: GOSUB zzFileSelectBoxEE
  2196.     dline = 1: GOSUB zzFileSelectBoxBB
  2197.        END IF
  2198.       END IF
  2199.      END SELECT
  2200.     CASE "K"   'LEFT
  2201.      SELECT CASE Column
  2202.      CASE 2     'from TREE to DRIVES
  2203.       tree = levels
  2204.       GOSUB zzFileSelectBoxHH
  2205.       fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2206.       fg = 4: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
  2207.       LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  2208.       Column = 1
  2209.      CASE 3     'from FILES to TREE
  2210.       fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
  2211.       fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  2212.       Column = 2
  2213.      CASE 4     'from SUBDIRS to ?
  2214.       dline = 0: GOSUB zzFileSelectBoxBB
  2215.       fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 4
  2216.       IF FileNames = 0 THEN
  2217.        CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2218.        Column = 2
  2219.       ELSE
  2220.        CALL ziPublishHere(8, 51, "Files", 2, 1)
  2221.        Column = 3
  2222.       END IF
  2223.       fg = 0
  2224.      END SELECT
  2225.  
  2226.     CASE "M"   'RIGHT
  2227.      SELECT CASE Column
  2228.      CASE 1     'from DRIVES to TREE
  2229.       dev = Devices(ASC(base$) - 64)
  2230.       GOSUB zzFileSelectBoxAA     'return to original drive
  2231.       fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1)
  2232.       fg = 15: LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
  2233.       fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  2234.       Column = 2
  2235.      CASE 2     'from TREE to ?
  2236.       tree = levels
  2237.       GOSUB zzFileSelectBoxHH
  2238.       IF FileNames = 0 THEN
  2239.        IF Directories <> 0 THEN
  2240.     fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2241.     fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  2242.     dline = 1: GOSUB zzFileSelectBoxBB
  2243.     Column = 4
  2244.        END IF
  2245.       ELSE
  2246.        fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
  2247.        fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
  2248.        Column = 3
  2249.       END IF
  2250.      CASE 3     'from FILES to SUBDIRS (if possible)
  2251.       IF Directories <> 0 THEN
  2252.        fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
  2253.        fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
  2254.        dline = 1: GOSUB zzFileSelectBoxBB
  2255.        Column = 4
  2256.       END IF
  2257.      END SELECT
  2258.     END SELECT
  2259.    END IF
  2260.  
  2261.   LOOP
  2262.  
  2263. '   ╔════════════════╗
  2264. '   ║      AA        ╟─────────────────────────────────────────────┐
  2265. '   ╚╤═══════════════╝                                             │
  2266. '    │         change the cursor bar on "dev"                      │
  2267. '    │                                                             │
  2268. '    │         input: dev   output: olddev                         │
  2269. '    └─────────────────────────────────────────────────────────────┘
  2270. zzFileSelectBoxAA:
  2271.  IF dev <> olddev THEN
  2272.   FromRow = 10 + olddev + olddev
  2273.   ToRow = FromRow
  2274.   FromCol = 5
  2275.   ToCol = 10
  2276.   swap1 = bg: swap2 = fg
  2277.   IF olddev > 0 THEN
  2278.    GOSUB zzFileSelectBoxGG
  2279.   END IF
  2280.   FromRow = 10 + dev + dev
  2281.   ToRow = FromRow
  2282.   olddev = dev
  2283.   IF olddev > 0 THEN
  2284.    GOSUB zzFileSelectBoxGG
  2285.   END IF
  2286.  END IF
  2287.  RETURN
  2288.  
  2289.  
  2290.  
  2291. '   ╔════════════════╗
  2292. '   ║      BB        ╟─────────────────────────────────────────────┐
  2293. '   ╚╤═══════════════╝                                             │
  2294. '    │         change the cursor bar on "dline"                    │
  2295. '    │                                                             │
  2296. '    │         input: dline   output: olddline                     │
  2297. '    └─────────────────────────────────────────────────────────────┘
  2298. zzFileSelectBoxBB:
  2299.  IF dline <> olddline THEN
  2300.   FromRow = 10 + olddline
  2301.   ToRow = FromRow
  2302.   FromCol = 67
  2303.   ToCol = 78
  2304.   swap1 = bg: swap2 = fg
  2305.   IF olddline > 0 THEN GOSUB zzFileSelectBoxGG
  2306.   FromRow = 10 + dline
  2307.   ToRow = FromRow
  2308.   olddline = dline
  2309.   IF dline > 0 THEN GOSUB zzFileSelectBoxGG
  2310.  END IF
  2311.  RETURN
  2312.  
  2313.  
  2314.  
  2315. '   ╔════════════════╗
  2316. '   ║      CC        ╟─────────────────────────────────────────────┐
  2317. '   ╚╤═══════════════╝                                             │
  2318. '    │         change the cursor bar on "fline"                    │
  2319. '    │                                                             │
  2320. '    │         input: fline   output: oldfline                     │
  2321. '    └─────────────────────────────────────────────────────────────┘
  2322. zzFileSelectBoxCC:
  2323.  IF fline <> oldfline THEN
  2324.   FromRow = 10 + oldfline
  2325.   ToRow = FromRow
  2326.   FromCol = 51
  2327.   ToCol = 62
  2328.   swap1 = bg: swap2 = fg
  2329.   IF oldfline > 0 THEN
  2330.    GOSUB zzFileSelectBoxGG
  2331.   END IF
  2332.   FromRow = 10 + fline
  2333.   ToRow = FromRow
  2334.   oldfline = fline
  2335.   GOSUB zzFileSelectBoxGG
  2336.   Stuff$ = basex$ + "\" + FileNames$(FromFile + fline - 1)
  2337.   GOSUB zzFileSelectBoxDD
  2338.  END IF
  2339.  RETURN
  2340.  
  2341.  
  2342. '   ╔════════════════╗
  2343. '   ║      DD        ╟─────────────────────────────────────────────┐
  2344. '   ╚╤═══════════════╝                                             │
  2345. '    │     Determine middle of line for publishing "Stuff$"        │
  2346. '    │                                                             │
  2347. '    │                                                             │
  2348. '    └─────────────────────────────────────────────────────────────┘
  2349. zzFileSelectBoxDD:
  2350.  LINE (38, 26)-(601, 46), 3, BF
  2351.  LINE (38, 26)-(601, 46), 8, B
  2352.  CALL ziPublishHere(5, 40 - LEN(Stuff$) \ 2, Stuff$, 1, 2)
  2353.  
  2354.  RETURN
  2355.  
  2356.  
  2357.  
  2358. '   ╔════════════════╗
  2359. '   ║      EE        ╟─────────────────────────────────────────────┐
  2360. '   ╚╤═══════════════╝                                             │
  2361. '    │         Show 30 subdirectories                              │
  2362. '    │                                                             │
  2363. '    │   input: FromDir                                            │
  2364. '    │                                                             │
  2365. '    │                                                             │
  2366. '    └─────────────────────────────────────────────────────────────┘
  2367. zzFileSelectBoxEE:
  2368.  
  2369.  LINE (512, 80)-(Xmax - 11, 319), 7, BF
  2370.  IF FromDir > Directories THEN RETURN
  2371.  IF FromDir > 1 THEN
  2372.   fg = 4: CALL ziPublishHere(11, 65, CHR$(24), 0, 0): fg = 0
  2373.  END IF
  2374.  IF FromDir + 30 <= Directories THEN
  2375.   fg = 4: CALL ziPublishHere(40, 65, CHR$(25), 0, 0): fg = 0
  2376.   j = FromDir + 29
  2377.  ELSE
  2378.   j = Directories
  2379.  END IF
  2380.  
  2381.  FOR i = FromDir TO j
  2382.   k = INSTR(Directories$(i), ".")
  2383.   IF k = 0 THEN
  2384.    x$ = Directories$(i)
  2385.   ELSE
  2386.    x$ = MID$(Directories$(i), 1, k - 1) + SPACE$(8)
  2387.    x$ = MID$(x$, 1, 9) + MID$(Directories$(i), k + 1)
  2388.   END IF
  2389.   CALL ziPublishHere(11 + i - FromDir, 67, x$, 0, 1)
  2390.  NEXT
  2391.  olddline = 0
  2392.  
  2393.  RETURN
  2394.  
  2395.  
  2396. '   ╔════════════════╗
  2397. '   ║      FF        ╟─────────────────────────────────────────────┐
  2398. '   ╚╤═══════════════╝                                             │
  2399. '    │         Show 30 filenames                                   │
  2400. '    │                                                             │
  2401. '    │   input: FromFile                                           │
  2402. '    │                                                             │
  2403. '    │                                                             │
  2404. '    └─────────────────────────────────────────────────────────────┘
  2405. zzFileSelectBoxFF:
  2406.  
  2407.  LINE (384, 80)-(495, 319), 7, BF
  2408.  IF FromFile > FileNames THEN RETURN
  2409.  IF FromFile > 1 THEN
  2410.   fg = 4: CALL ziPublishHere(11, 49, CHR$(24), 0, 0): fg = 0
  2411.  END IF
  2412.  IF FromFile + 30 <= FileNames THEN
  2413.   fg = 4: CALL ziPublishHere(40, 49, CHR$(25), 0, 0): fg = 0
  2414.   j = FromFile + 29
  2415.  ELSE
  2416.   j = FileNames
  2417.  END IF
  2418.  
  2419.  FOR i = FromFile TO j
  2420.   k = INSTR(FileNames$(i), ".")
  2421.   IF k = 0 THEN
  2422.    x$ = FileNames$(i)
  2423.   ELSE
  2424.    x$ = MID$(FileNames$(i), 1, k - 1) + SPACE$(8)
  2425.    x$ = MID$(x$, 1, 9) + MID$(FileNames$(i), k + 1)
  2426.   END IF
  2427.   CALL ziPublishHere(11 + i - FromFile, 51, x$, 0, 0)
  2428.  NEXT
  2429.  oldfline = 0
  2430.  
  2431.  RETURN
  2432.  
  2433.  
  2434. '   ╔════════════════╗
  2435. '   ║      GG        ╟─────────────────────────────────────────────┐
  2436. '   ╚╤═══════════════╝                                             │
  2437. '    │         Swap the colours (swap1 and swap2) of a region      │
  2438. '    │                                                             │
  2439. '    │  input: FromCol, FromRow, ToCol, ToRow, swap1, swap2        │
  2440. '    │                                                             │
  2441. '    │                                                             │
  2442. '    └─────────────────────────────────────────────────────────────┘
  2443. zzFileSelectBoxGG:
  2444.  fx = FromCol * 8 - 8
  2445.  fy = FromRow * 8 - 8
  2446.  tx = ToCol * 8 - 1
  2447.  ty = ToRow * 8 - 1
  2448.  FOR ix = fx TO tx
  2449.   FOR iy = fy TO ty
  2450.    SELECT CASE POINT(ix, iy)
  2451.    CASE swap1
  2452.     PSET (ix, iy), swap2
  2453.    CASE swap2
  2454.     PSET (ix, iy), swap1
  2455.    END SELECT
  2456.   NEXT
  2457.  NEXT
  2458.  RETURN
  2459.  
  2460. '   ╔════════════════╗
  2461. '   ║      HH        ╟─────────────────────────────────────────────┐
  2462. '   ╚╤═══════════════╝                                             │
  2463. '    │         change the cursor bar on "tree"                     │
  2464. '    │                                                             │
  2465. '    │         input: tree   output: oldtree                       │
  2466. '    └─────────────────────────────────────────────────────────────┘
  2467. zzFileSelectBoxHH:
  2468.  IF tree <> oldtree THEN
  2469.   FromRow = 12 + oldtree + oldtree
  2470.   ToRow = FromRow
  2471.   FromCol = 15 + oldtree + oldtree
  2472.   ToCol = FromCol + 11
  2473.   swap1 = bg: swap2 = fg
  2474.   IF oldtree <> 255 THEN
  2475.    GOSUB zzFileSelectBoxGG
  2476.   END IF
  2477.   FromRow = 12 + tree + tree
  2478.   ToRow = FromRow
  2479.   FromCol = 15 + tree + tree
  2480.   ToCol = FromCol + 11
  2481.   oldtree = tree
  2482.   GOSUB zzFileSelectBoxGG
  2483.  END IF
  2484.  RETURN
  2485.  
  2486.  
  2487. '   ╔════════════════╗
  2488. '   ║      II        ╟─────────────────────────────────────────────┐
  2489. '   ╚╤═══════════════╝                                             │
  2490. '    │         clear screen areas when changing directory          │
  2491. '    │                                                             │
  2492. '    │                                                             │
  2493. '    └─────────────────────────────────────────────────────────────┘
  2494. zzFileSelectBoxII:
  2495.  oldtree = 255
  2496.  oldfline = 0
  2497.  olddline = 0
  2498.  LINE (112, 16 * tree + 80)-(383, 319), 7, BF
  2499.  LINE (384, 56)-(495, 319), 7, BF
  2500.  LINE (504, 56)-(Xmax - 11, 319), 7, BF
  2501.  Stuff$ = "(Please Wait)"
  2502.  fg = 14: GOSUB zzFileSelectBoxDD: fg = 0
  2503.  RETURN
  2504.  
  2505. END SUB
  2506.  
  2507. '<p>
  2508. '++++++++++++++++++++++++
  2509. SUB zzInPath (Field$)
  2510.  
  2511.   x$ = ".;" + ENVIRON$("PATH")
  2512.   IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
  2513.   i = 1
  2514.   DO
  2515.     j = INSTR(i, x$, ";")
  2516.     IF j THEN
  2517.       y$ = UCASE$(MID$(x$, i, j - i))
  2518.       i = j + 1
  2519.       IF RIGHT$(y$, 1) <> "\" THEN y$ = y$ + "\"
  2520.       F$ = y$ + Field$
  2521.       Bad = 0
  2522.       OPEN "I", 1, F$
  2523.       IF Bad = 0 THEN
  2524.     CLOSE 1
  2525.     EXIT DO
  2526.       END IF
  2527.       F$ = ""
  2528.     END IF
  2529.   LOOP WHILE j
  2530.   Bad = 0
  2531.   Field$ = F$
  2532.  
  2533. END SUB
  2534.  
  2535. '<p>
  2536. '++++++++++++++++++++++++
  2537. SUB zzSearchD (Pattern$)
  2538.  
  2539. DIM str AS STRING * 65
  2540.  
  2541.  CALL zzCritOff
  2542.  GOSUB zzSearchDProcess
  2543.  CALL zzCritOn
  2544.  
  2545.  EXIT SUB
  2546.  
  2547. zzSearchDProcess:
  2548.   upperbound = UBOUND(Directories$)
  2549.   str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
  2550.   Pattern$ = "?"
  2551.  
  2552. ' clear the Directories$ array
  2553.  
  2554.  FOR i = 1 TO 500
  2555.   Directories$(i) = ""
  2556.  NEXT
  2557.  Directories = 0
  2558.  
  2559. ' locate the DTA
  2560.  
  2561.  Regs.AX = &H2F00
  2562.  CALL zzBasicInt(&H21)
  2563.  DTAseg = Regs.ES
  2564.  DTAptr = Regs.BX
  2565.  
  2566. ' confirm that the drive (if specified) is valid
  2567.  
  2568.  IF MID$(str, 2, 1) = ":" THEN
  2569.   i = ASC(str)
  2570.   IF i < 65 THEN RETURN
  2571.   IF i > 90 THEN RETURN
  2572.   Regs.AX = &H440E
  2573.   Regs.BX = i - 64
  2574.   CALL zzBasicInt(&H21)
  2575.   IF (Regs.FL AND 256) <> 256 THEN
  2576.    j = Regs.AX AND 255
  2577.    IF (j <> 0) AND (j <> i - 64) THEN
  2578.     i = j + 64
  2579.    END IF
  2580.   END IF
  2581.   Regs.AX = &H1C00
  2582.   Regs.DX = i - 64
  2583.   CALL zzBasicInt(&H21)
  2584.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2585.  END IF
  2586.  
  2587.  x$ = RTRIM$(str)
  2588.  IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  2589.   x$ = x$ + "*.*"
  2590.  END IF
  2591.  IF (MID$(x$, LEN(x$)) = "\") THEN
  2592.   x$ = x$ + "*.*"
  2593.  END IF
  2594.  
  2595.  IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  2596.   x$ = x$ + "\*.*"
  2597.  END IF
  2598.  
  2599. ' initiate the search
  2600.  
  2601.  Pattern$ = x$
  2602.  str = x$ + CHR$(0)
  2603.  Regs.AX = &H4E00
  2604.  Regs.CX = &H10
  2605.  Regs.DS = VARSEG(str)
  2606.  Regs.DX = VARPTR(str)
  2607.  CALL zzBasicInt(&H21)
  2608.  
  2609.  DO WHILE (Regs.FL AND 256) = 0
  2610.   DEF SEG = DTAseg
  2611.  
  2612. ' pull the name (letter by letter) from the DTA
  2613.  
  2614.   IF (PEEK(DTAptr + &H15) AND &H10) = &H10 THEN
  2615.    Name$ = ""
  2616.    i = &H1E
  2617.    DO
  2618.     j = PEEK(DTAptr + i)
  2619.     IF j <> 0 THEN
  2620.      Name$ = Name$ + CHR$(j)
  2621.     END IF
  2622.     i = i + 1
  2623.    LOOP UNTIL j = 0
  2624.  
  2625. ' omit "." and ".."
  2626.  
  2627.    IF MID$(Name$, 1, 1) <> "." THEN
  2628.     Directories = Directories + 1
  2629.     IF Directories > upperbound THEN RETURN
  2630.     Directories$(Directories) = Name$
  2631.    END IF
  2632.   END IF
  2633.  
  2634. ' keep going until all matches are found
  2635.  
  2636.   Regs.AX = &H4F00
  2637.   CALL zzBasicInt(&H21)
  2638.  LOOP
  2639.  
  2640. ' now find the first byte of the directory pattern itself
  2641.  
  2642.  IF MID$(str, 2, 1) = ":" THEN
  2643.   start = 3
  2644.  ELSE
  2645.   start = 1
  2646.  END IF
  2647.  DO
  2648.   i = INSTR(start, str, "\")
  2649.   IF i <> 0 THEN
  2650.    start = i + 1
  2651.   END IF
  2652.  LOOP UNTIL i = 0
  2653.  x$ = MID$(str, 1, start - 1)
  2654.  CALL zzValidate(x$)
  2655.  IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
  2656.  i = INSTR(str, CHR$(0))
  2657.  
  2658.  Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))
  2659.  
  2660.  IF Directories <> 0 THEN
  2661.   SortCount = Directories
  2662.   CALL zzAlphaSort(Directories$())
  2663.  END IF
  2664.  RETURN
  2665. END SUB
  2666.  
  2667. '<p>
  2668. '++++++++++++++++++++++++
  2669. SUB zzSearchF (Pattern$)
  2670.  
  2671. DIM str AS STRING * 65
  2672.  
  2673.  CALL zzCritOff
  2674.  GOSUB zzSearchFProcess
  2675.  CALL zzCritOn
  2676.  
  2677.  EXIT SUB
  2678.  
  2679. zzSearchFProcess:
  2680.  upperbound = UBOUND(FileNames$)
  2681.  str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
  2682.  Pattern$ = "?"
  2683.  
  2684. ' clear the FileNames$ array
  2685.  
  2686.  FOR i = 1 TO 500
  2687.   FileNames$(i) = ""
  2688.  NEXT
  2689.  FileNames = 0
  2690.  
  2691. ' locate the DTA
  2692.  
  2693.  Regs.AX = &H2F00
  2694.  CALL zzBasicInt(&H21)
  2695.  DTAseg = Regs.ES
  2696.  DTAptr = Regs.BX
  2697.  
  2698. ' confirm that the drive (if specified) is valid
  2699.  
  2700.  IF MID$(str, 2, 1) = ":" THEN
  2701.   i = ASC(str)
  2702.   IF i < 65 THEN RETURN
  2703.   IF i > 90 THEN RETURN
  2704.   Regs.AX = &H440E
  2705.   Regs.BX = i - 64
  2706.   CALL zzBasicInt(&H21)
  2707.   IF (Regs.FL AND 256) <> 256 THEN
  2708.    j = Regs.AX AND 255
  2709.    IF (j <> 0) AND (j <> i - 64) THEN
  2710.     i = j + 64
  2711.    END IF
  2712.   END IF
  2713.   Regs.AX = &H1C00
  2714.   Regs.DX = i - 64
  2715.   CALL zzBasicInt(&H21)
  2716.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2717.  END IF
  2718.  
  2719.  x$ = RTRIM$(str)
  2720.  IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  2721.   x$ = x$ + "*.*"
  2722.  END IF
  2723.  IF (MID$(x$, LEN(x$)) = "\") THEN
  2724.   x$ = x$ + "*.*"
  2725.  END IF
  2726.  
  2727.  IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  2728.   x$ = x$ + "\*.*"
  2729.  END IF
  2730.  
  2731. ' initiate the search
  2732.  
  2733.  Pattern$ = x$
  2734.  str = x$ + CHR$(0)
  2735.  Regs.AX = &H4E00
  2736.  Regs.CX = &H27
  2737.  Regs.DS = VARSEG(str)
  2738.  Regs.DX = VARPTR(str)
  2739.  CALL zzBasicInt(&H21)
  2740.  
  2741.  DO WHILE (Regs.FL AND 256) = 0
  2742.   DEF SEG = DTAseg
  2743.  
  2744. ' pull the name (letter by letter) from the DTA
  2745.  
  2746.   Name$ = ""
  2747.   i = &H1E
  2748.   DO
  2749.    j = PEEK(DTAptr + i)
  2750.    IF j <> 0 THEN
  2751.     Name$ = Name$ + CHR$(j)
  2752.    END IF
  2753.    i = i + 1
  2754.   LOOP UNTIL j = 0
  2755.  
  2756.   FileNames = FileNames + 1
  2757.   IF FileNames > upperbound THEN RETURN
  2758.   FileNames$(FileNames) = Name$
  2759.  
  2760.   Regs.AX = &H4F00
  2761.   CALL zzBasicInt(&H21)
  2762.  LOOP
  2763.  
  2764.  
  2765. ' now find the first byte of the file pattern itself
  2766.  
  2767.  IF MID$(str, 2, 1) = ":" THEN
  2768.   start = 3
  2769.  ELSE
  2770.   start = 1
  2771.  END IF
  2772.  DO
  2773.   i = INSTR(start, str, "\")
  2774.   IF i <> 0 THEN
  2775.    start = i + 1
  2776.   END IF
  2777.  LOOP UNTIL i = 0
  2778.  x$ = MID$(str, 1, start - 1)
  2779.  CALL zzValidate(x$)
  2780.  IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
  2781.  i = INSTR(str, CHR$(0))
  2782.  
  2783.  Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))
  2784.  
  2785.  IF FileNames <> 0 THEN
  2786.   SortCount = FileNames
  2787.   CALL zzAlphaSort(FileNames$())
  2788.  END IF
  2789.  RETURN
  2790. END SUB
  2791.  
  2792. '<p>
  2793. '++++++++++++++++++++++++
  2794. SUB zzValidate (Directory$)
  2795.  
  2796. DIM str AS STRING * 65
  2797.  
  2798.  CALL zzCritOff
  2799.  GOSUB zzValidateProcess
  2800.  CALL zzCritOn
  2801.  
  2802.  EXIT SUB
  2803.  
  2804. zzValidateProcess:
  2805.  
  2806.  Candpath$ = LTRIM$(RTRIM$(UCASE$(Directory$)))
  2807.  IF MID$(Candpath$, LEN(Candpath$)) = "\" THEN
  2808.   IF LEN(Candpath$) > 1 THEN
  2809.    IF MID$(Candpath$, 2) <> ":\" THEN
  2810.     Candpath$ = MID$(Candpath$, 1, LEN(Candpath$) - 1)
  2811.    END IF
  2812.   END IF
  2813.  END IF
  2814.  
  2815.  Directory$ = "?"
  2816.  
  2817. ' check that any named drive is valid
  2818.  
  2819.  IF MID$(Candpath$, 2, 1) = ":" THEN
  2820.   i = ASC(MID$(Candpath$, 1, 1))
  2821.   IF i < 65 THEN RETURN
  2822.   IF i > 90 THEN RETURN
  2823.   Regs.AX = &H440E
  2824.   Regs.BX = i - 64
  2825.   CALL zzBasicInt(&H21)
  2826.   IF (Regs.FL AND 256) <> 256 THEN
  2827.    j = Regs.AX AND 255
  2828.    IF (j <> 0) AND (j <> i - 64) THEN
  2829.     i = j + 64
  2830.    END IF
  2831.   END IF
  2832.   Regs.AX = &H1C00
  2833.   Regs.DX = i - 64
  2834.   CALL zzBasicInt(&H21)
  2835.   IF (Regs.AX AND 255) = 255 THEN RETURN
  2836.  END IF
  2837.  
  2838. ' handle special case of root directory
  2839.  
  2840.  IF Candpath$ = "\" THEN
  2841.   Directory$ = ""
  2842.   CALL zzChangeDrive(Directory$)
  2843.   Directory$ = Directory$ + "\"
  2844.   RETURN
  2845.  END IF
  2846.  IF MID$(Candpath$, 2) = ":\" THEN
  2847.   Directory$ = Candpath$
  2848.   RETURN
  2849.  END IF
  2850.  
  2851. ' handle special case of NO directory
  2852.  
  2853.  IF Candpath$ = "" THEN
  2854.   CALL zzChangeDir(Candpath$)
  2855.   Directory$ = Candpath$
  2856.   RETURN
  2857.  END IF
  2858.  IF MID$(Candpath$, 2) = ":" THEN
  2859.   Regs.AX = &H4700
  2860.   Regs.DX = ASC(MID$(Candpath$, 1, 1)) - 64
  2861.   Regs.DS = VARSEG(str)
  2862.   Regs.SI = VARPTR(str)
  2863.   CALL zzBasicInt(&H21)
  2864.   i = INSTR(str, CHR$(0))
  2865.   Directory$ = Candpath$ + "\" + MID$(str, 1, i - 1)
  2866.   RETURN
  2867.  END IF
  2868.  
  2869.  str = Candpath$ + CHR$(0)
  2870.  IF INSTR(str, "*") + INSTR(str, "?") > 0 THEN RETURN
  2871.  
  2872.  
  2873. ' initiate the search
  2874.  
  2875.  Regs.AX = &H4E00
  2876.  Regs.CX = &H10
  2877.  Regs.DS = VARSEG(str)
  2878.  Regs.DX = VARPTR(str)
  2879.  CALL zzBasicInt(&H21)
  2880.  
  2881. ' abandon if not a valid directory
  2882.  
  2883.  IF (Regs.FL AND 256) <> 0 THEN RETURN
  2884. ' locate the DTA
  2885.  
  2886.  Regs.AX = &H2F00
  2887.  CALL zzBasicInt(&H21)
  2888.  DTAseg = Regs.ES
  2889.  DTAptr = Regs.BX
  2890.  
  2891.  DEF SEG = DTAseg
  2892.  attr = PEEK(DTAptr + &H15)
  2893.  IF (attr AND &H10) = 0 THEN RETURN
  2894.  
  2895. ' establish the status quo so that we can change back
  2896.  
  2897.  olddrv$ = ""
  2898.  CALL zzChangeDrive(olddrv$)
  2899.  
  2900.  IF MID$(str, 2, 1) = ":" THEN
  2901.   newdrv$ = MID$(str, 1, 2)
  2902.  ELSE
  2903.   newdrv$ = olddrv$
  2904.  END IF
  2905.  
  2906.  CALL zzChangeDrive(newdrv$)    'change to new drive
  2907.  olddir$ = ""
  2908.  CALL zzChangeDir(olddir$)      'find the current directory on new drive
  2909.  CALL zzChangeDir(str)          'change to the desired directory
  2910.  CALL zzChangeDir(olddir$)      'change back to the current directory
  2911.  CALL zzChangeDrive(olddrv$)    'change back to old drive
  2912.  IF Root = 0 THEN
  2913.   Directory$ = RTRIM$(str)
  2914.  ELSE
  2915.   Directory$ = MID$(str, 1, 2) + "\"
  2916.  END IF
  2917.  RETURN
  2918.  
  2919. END SUB
  2920.  
  2921.