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