home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD 1 / SuperCD_1.iso / pcplus / wilf / showbmp.bas < prev   
BASIC Source File  |  1996-10-14  |  34KB  |  1,601 lines
  1. DEFINT A-Z
  2. DECLARE SUB ziDragging ()
  3. ' Return if mouse active and still dragging, or else exhausted
  4.  
  5. DECLARE SUB ziDrawBank (FromButton, ToButton)
  6. ' Draw a bank of buttons (using Bank array)
  7.  
  8. DECLARE SUB ziExhaust ()
  9. ' Return when no keystrokes and no mouse buttons
  10.  
  11. DECLARE SUB ziLoadFont (Font$)
  12. ' Load a specified font
  13.  
  14. DECLARE SUB ziLocateMCursor (Xcoord, YCoord)
  15. ' Locate mouse cursor to a named point
  16.  
  17. DECLARE SUB ziMouseOnButton (FromButton, ToButton)
  18. ' Sets FoundButton
  19.  
  20. DECLARE SUB ziPublish (PrintString$, Size, Italic)
  21. ' Print a string
  22. '   Size   = magnitude (per 8 pixels)
  23. '   Italic = +1 to make italic
  24. '          = +2 to make overprint (no background)
  25.  
  26. DECLARE SUB ziRadio (Button, FromButton, ToButton)
  27. ' Set one button in a Bank, resetting the rest
  28.  
  29. DECLARE SUB ziReadField (Min, Max, Permitted$)
  30. ' Read a field at the current TCursor location
  31. '   Permitted$ contains:
  32. '     * - any characters
  33. '     . - allow one full-stop (as decimal)
  34. '     A - auto-enter (when filled)
  35. '     C - capitalise letters
  36. '     E - ESC allowed to finish (skip) field
  37. '     J - justify (especially for numeric)
  38. '     N - numerics
  39. '     P - password-type display
  40. '     S - space
  41. '     X - alphabetic
  42. '     Y - Y or N (upper or lower)
  43.  
  44. DECLARE SUB ziSetMCursorVis (Status)
  45. ' Set visibility of mouse cursor
  46. '   Status = 0 for OFF
  47. '            1 for ON
  48. '            2 for ENQUIRE (set MCursorVis)
  49. '           10 for TEMPORARILY OFF
  50. '           11 for RESTORED (set MCursorVis)
  51.  
  52. DECLARE SUB ziWander (Timeout!)
  53. ' Timeout  = in seconds (0 = none)
  54. ' Response =   0 = (0:00) timed out
  55. '              n = (0:n)  displacement into Allowed$
  56.  
  57. ' key           &h01xx  &h02xx  &h04xx  &h08xx  &h10xx  &h20xx  &h40xx
  58. '                plain   CTRL    shift   Mouse    Fn   CTRL-Fn  shift-Fn
  59.  
  60. ' Enter      0    *       *       -      double    -      -       -
  61. ' (left)     1    *       *       -      left     F1     ^F1     +F1
  62. ' (right)    2    *       *       -      right    F2     ^F2     +F2
  63. ' (up)       3    *       -       -      both     F3     ^F3     +F3
  64. ' (down)     4    *       -       -    leftdrag   F4     ^F4     +F4
  65.  
  66. ' Backspace  5    *       *       -    rightdrag  F5     ^F5     +F5
  67. ' Home       6    *       *       -    bothdrag   F6     ^F6     +F6
  68. ' End        7    *       *       -       -       F7     ^F7     +F7
  69.  
  70. ' PgUP       8    *       *       -       -       F8     ^F8     +F8
  71. ' PgDN       9    *       *       -       -       F9     ^F9     +F9
  72.  
  73. ' Tab       10    *       -       *       -       F10    ^F10    +F10
  74. ' Escape    11    *       -       -       -       F11    ^F11    +F11
  75. '           12    -       -       -       -       F12    ^F12    +F12
  76.  
  77. ' Allowed$  = other allowed strokes
  78. ' (Note:  DClick is a flag permitting Double-clicks of mouse - slower!)
  79.  
  80. DEFINT A-Z
  81. DECLARE SUB zsAlignGCursor ()
  82. ' Align graphic cursor to same as text cursor
  83. '  - sets Row, Col, GXloc, GYloc
  84.  
  85. DECLARE SUB zsAlignTCursor ()
  86. ' Align text cursor to same as graphic cursor
  87. '  - sets Row, Col, GXloc, GYloc
  88.  
  89. DECLARE SUB zsLocateGCursor (Xcoord, YCoord)
  90. ' Locate graphic cursor to a named point
  91.  
  92. DECLARE SUB zsPastel (Xcoord, YCoord, Wide, Deep, Colour1, Colour2)
  93. ' Colour the defined oblong with a pastel mix of two colours
  94. '  Deep = 0 or 1 - square
  95. '       = n      - Y-pixel depth
  96.  
  97. DECLARE SUB zsSetScrnMode (Mode, HiRows, HiCols)
  98. ' Mode = 9 or 12
  99. ' HiRows = 1 to make high number of rows
  100. ' HiCols = 1 to make high number of cols (80)
  101. ' Set SCREEN parameters and blank the screen
  102. '  - sets ScrnMode, Xmax, Ymax, Rows, Cols, XYRatio!
  103. '  - uses FG and optionally BG (colours)
  104.  
  105. DECLARE SUB zsSubstitute (Xcoord, YCoord, Wide, Deep, Colour1, Colour2)
  106. ' Substitute one colour with another within the defined oblong
  107. '  Deep = 0 or 1 - square
  108. '       = n      - Y-pixel depth
  109.  
  110. DECLARE SUB zzBasicInt (IntType)
  111. ' Execute interrupt (params in REGS.AX etc)
  112.  
  113. DECLARE SUB zzInPath (Field$)
  114. ' Return full path to a file (in same string)
  115.  
  116. '================================================
  117. '/  UK copyright (c) 1996 by Future Publishing
  118. '/
  119. '/
  120. '/
  121. '/
  122. '================================================
  123. TYPE REGISTERS
  124.   AX AS INTEGER
  125.   BX AS INTEGER
  126.   CX AS INTEGER
  127.   DX AS INTEGER
  128.   DS AS INTEGER
  129.   SI AS INTEGER
  130.   ES AS INTEGER
  131.   DI AS INTEGER
  132.   FL AS INTEGER
  133. END TYPE
  134.  
  135. TYPE Buttons
  136.   Xloc AS INTEGER
  137.   Yloc AS INTEGER
  138.   Wide AS INTEGER
  139.   Deep AS INTEGER
  140. '  0 = checkbutton
  141. '  1 = square sculptured
  142. '  n = Y-pixels deep
  143.   State AS INTEGER
  144. '  0 = off
  145. '  1 = on
  146.   Active AS INTEGER
  147. '  0 = inactive
  148. '  1 = active
  149. END TYPE
  150.  
  151. CONST Pi! = 3.14159
  152. CONST Ex! = 2.71828
  153. CONST DegToRad! = .0174533
  154. CONST RadToDeg! = 57.2958
  155.  
  156. CONST ziNoShift = &H1
  157. CONST ziCTRL = &H2
  158. CONST ziShift = &H4
  159. CONST ziMouse = &H8
  160. CONST ziFn = &H10
  161. CONST ziCTRLFn = &H20
  162. CONST ziShiftFn = &H40
  163.  
  164. CONST ziL = 1
  165. CONST ziR = 2
  166. CONST ziUp = 3
  167. CONST ziDn = 4
  168. CONST ziBS = 5
  169. CONST ziHome = 6
  170. CONST ziEnd = 7
  171. CONST ziPgUp = 8
  172. CONST ziPgDn = 9
  173. CONST ziTab = 10
  174. CONST ziEsc = 11
  175.  
  176. CONST ziDbl = 0
  177. CONST ziBoth = 3
  178. CONST ziLDrag = 4
  179. CONST ziRDrag = 5
  180. CONST ziBothDrag = 6
  181.  
  182. DIM SHARED regs AS REGISTERS
  183. DIM SHARED Bank(20) AS Buttons
  184. DIM SHARED bad, Module$
  185. DIM SHARED Mouse, MCursorVis, MXloc, MYloc
  186. DIM SHARED DClick
  187. DIM SHARED ScrnMode, BG, FG, TCursor
  188. DIM SHARED Xmax, Ymax, GXloc, GYloc, XYratio!
  189. DIM SHARED Rows, Cols, Row, Col
  190. DIM SHARED Allowed$, Field$
  191. DIM SHARED FoundButton
  192. DIM SHARED Font(255, 7)
  193. DIM SHARED Response, HResponse, LResponse
  194.  
  195. '++++++++++++++++++++++++
  196. RANDOMIZE TIMER
  197. ON ERROR GOTO RESUMENEXT
  198. RESUMENEXT:
  199.   IF ERR = 255 THEN
  200.     CLS
  201.     BEEP
  202.     PRINT "Cannot find module "; Module$
  203.     SLEEP
  204.     SYSTEM
  205.   END IF
  206.   IF ERR THEN
  207.     bad = ERR
  208.     RESUME NEXT
  209.   END IF
  210. '++++++++++++++++++++++++
  211. ' Test for presence of a mouse
  212. Mouse = 0
  213. regs.AX = 0
  214. CALL zzBasicInt(&H33)
  215. IF regs.AX THEN
  216.   Mouse = 1
  217.   CALL ziSetMCursorVis(0)
  218. END IF
  219. '++++++++++++++++++++++++
  220. ' Load the ASCII font
  221. CALL ziLoadFont("Ascii8x8")
  222. '/==================================/'
  223. '/  End of Standard Piecrust code   /'
  224. '/==================================/'
  225.  
  226. '/********************************************************************
  227. '/********************************************************************
  228.  
  229. TYPE WINHeader
  230.   MustBeBM AS STRING * 2
  231.   MustBeFileSize AS LONG
  232.   dummy6 AS STRING * 4
  233.   ImageOffset AS LONG
  234.   HeaderSize AS LONG
  235.  
  236. '/ if HeaderSize = 40 this is a WIN type BMP
  237.  
  238.   WINXPixels AS LONG
  239.   WINYPixels AS LONG
  240.   WINdummy26 AS STRING * 2
  241.   WINBitCount AS INTEGER
  242.   WINCompression AS LONG
  243.   WINdummy34 AS STRING * 12
  244.   WINColoursUsed AS LONG
  245. END TYPE
  246. DIM BMP AS WINHeader
  247.  
  248. '/ if HeaderSize = 12 this is an OS/2 type BMP
  249.        
  250. TYPE OS2Header
  251.   OS2dummy0 AS STRING * 18
  252.   OS2XPixels AS INTEGER
  253.   OS2YPixels AS INTEGER
  254.   OS2dummy22 AS STRING * 2
  255.   OS2BitCount AS INTEGER
  256. END TYPE
  257. DIM OS2 AS OS2Header
  258.  
  259. DIM FileName AS STRING * 50
  260. DIM Block AS STRING * 256
  261.  
  262. DIM Memory AS STRING * 768
  263.  
  264.  
  265.  
  266. '/*****************************
  267. '/  This is the "main" program, running the MENU
  268.  
  269.  DO
  270.   NewFile = 0
  271.   DO
  272.    SCREEN 0
  273.    SCREEN 13
  274.    GOSUB OpenFile
  275.    CLS
  276.   LOOP WHILE bad <> 0
  277.   DO
  278.    GOSUB MenuProcess
  279.   LOOP UNTIL NewFile = 1
  280.  
  281.  LOOP
  282.  
  283.  
  284. '/********************************************************************
  285. '/********************************************************************
  286.  
  287. '/*****************************
  288. '/       Subroutines
  289. '/*****************************
  290.  
  291. '/*****************************
  292. '/  Colour BIOS call
  293. '/
  294. '/  Input: regs.AX
  295.  
  296. ColourBIOS:
  297.  
  298.   regs.BX = 0
  299.   regs.CX = 256
  300.   regs.ES = VARSEG(Memory)
  301.   regs.DX = VARPTR(Memory)
  302.   CALL zzBasicInt(&H10)
  303.  
  304.   RETURN
  305.  
  306.  
  307. '/*****************************
  308. '/ Handle a COMPRESSED Image
  309.  
  310. Compressed:
  311.  
  312.   RowDisp = 0
  313.   ColDisp = 0
  314.   Offset! = ImageLoc!
  315.  
  316. '/  ImageStart = 0 if on even boundary
  317.  
  318.   ImageStart = ImageLoc! AND 1
  319.  
  320.   Brake = 0
  321.   DO
  322.  
  323.    GOSUB ReadBlock
  324.    IF IntegerValue = 0 THEN
  325.     Offset! = Offset! + 1
  326.     GOSUB ReadBlock
  327.     SELECT CASE IntegerValue
  328.  
  329. '/   new row
  330.     CASE 0
  331.      RowDisp = RowDisp + 1
  332.      ColDisp = 0
  333.  
  334. '/   end of image
  335.     CASE 1
  336.      Brake = 1
  337.  
  338. '/   position delta
  339.     CASE 2
  340.      Offset! = Offset! + 1
  341.      GOSUB ReadBlock
  342.      ColDisp = ColDisp + IntegerValue
  343.      Offset! = Offset! + 1
  344.      GOSUB ReadBlock
  345.      RowDisp = RowDisp - IntegerValue
  346.  
  347. '/   string quoted
  348.     CASE ELSE
  349.      StartString! = Offset! + 1
  350.      StringLength = IntegerValue
  351.      FOR i = 0 TO StringLength - 1
  352.      
  353.       Xfactor = Xmargin + ColDisp
  354.       Yfactor = 199 - Ymargin - RowDisp
  355.      
  356.       IF MaxColours = 256 THEN
  357.  
  358.        Offset! = i + StartString!
  359.        GOSUB ReadBlock
  360.        ColourFactor = IntegerValue
  361.  
  362.       ELSE
  363.  
  364.        Offset! = i \ 2 + StartString!
  365.        GOSUB ReadBlock
  366.        IF i MOD 2 = 0 THEN
  367.         ColourFactor = IntegerValue \ 16
  368.        ELSE
  369.         ColourFactor = IntegerValue MOD 16
  370.        END IF
  371.       END IF
  372.       
  373.       GOSUB PixelPaint
  374.       ColDisp = ColDisp + 1
  375.  
  376.      NEXT
  377.     
  378.     END SELECT
  379.  
  380.  
  381.    ELSE
  382.  
  383. '/  if not zero, this is a "repeat" function
  384.  
  385.     RepeatValue = IntegerValue
  386.     Offset! = Offset! + 1
  387.     GOSUB ReadBlock
  388.     IF MaxColours = 256 THEN
  389.      Colour1 = IntegerValue
  390.      Colour2 = IntegerValue
  391.     ELSE
  392.      Colour1 = IntegerValue \ 16
  393.      Colour2 = IntegerValue MOD 16
  394.     END IF
  395.  
  396.     Repeat1 = (RepeatValue + 1) \ 2
  397.     Repeat2 = RepeatValue \ 2
  398.     FOR i = 1 TO Repeat1
  399.      
  400.      Xfactor = Xmargin + ColDisp
  401.      Yfactor = 199 - Ymargin - RowDisp
  402.      ColourFactor = Colour1
  403.      GOSUB PixelPaint
  404.      IF Repeat2 >= i THEN
  405.       ColDisp = ColDisp + 1
  406.       Xfactor = Xfactor + 1
  407.       ColourFactor = Colour2
  408.       GOSUB PixelPaint
  409.      END IF
  410.      ColDisp = ColDisp + 1
  411.     NEXT
  412.   
  413.    END IF
  414.  
  415.  
  416. '/  make sure we are at an "even" boundary
  417.  
  418.    Offset! = Offset! + 1
  419.    i = Offset! AND 1
  420.    IF i <> ImageStart THEN Offset! = Offset! + 1
  421.  
  422.   LOOP UNTIL Brake = 1
  423.  
  424.  
  425.   RETURN
  426.  
  427.  
  428. '/*****************************
  429. '/  Colour displayer
  430.  
  431. Displayer:
  432.   CLS
  433.   FOR i = 0 TO 239
  434.    j = (i \ 15) * 16
  435.    FOR k = 0 TO 191
  436.     PSET (i, k), j + (k \ 12)
  437.    NEXT
  438.   NEXT
  439.   RETURN
  440.  
  441. '/*****************************
  442. '/  Fade
  443.  
  444. Fade:
  445.  
  446.   FOR i = 62 TO 0 STEP -2
  447.    x$ = CHR$(i)
  448.    FOR j = 1 TO 768
  449.     Y$ = MID$(Memory, j, 1)
  450.     IF ASC(Y$) > i THEN
  451.      MID$(Memory, j, 1) = x$
  452.     END IF
  453.    NEXT
  454.    regs.AX = &H1012
  455.    GOSUB ColourBIOS
  456.    FOR k = 1 TO 1000: NEXT
  457.   NEXT
  458.   RETURN
  459.  
  460.  
  461. '/*****************************
  462. '/ Fetch colours from table
  463.  
  464. FetchColours:
  465.  
  466.    GET #1, 1, Block
  467.    CurrentRec = 1
  468.  
  469.    GOSUB SetColours
  470.    RETURN
  471.  
  472.  
  473.  
  474. '/*****************************
  475. '/  Intervention by pressing ESC key
  476.  
  477. Intervene:
  478.  
  479.   bad = 0
  480.   x$ = INKEY$
  481.   IF LEN(x$) = 1 THEN
  482.    IF ASC(x$) = 27 THEN
  483.     bad = 1
  484.     RETURN
  485.    END IF
  486.   END IF
  487.   RETURN
  488.  
  489.  
  490. '/*****************************
  491. '/ Menu
  492.  
  493. MenuProcess:
  494.  
  495.   SCREEN 0
  496.   SCREEN 13
  497.   PRINT "                ShowBMP"
  498.   PRINT
  499.   PRINT "Current file: "; FileName
  500.   PRINT "Size:"; LOF(1)
  501.   PRINT "RLE compression ";
  502.   IF Compression = 0 THEN
  503.    PRINT "not used"
  504.   ELSE
  505.    PRINT "used"
  506.   END IF
  507.   PRINT MaxColours; "Colour image  "; Xpixels; "x"; Ypixels
  508.   PRINT
  509.   PRINT
  510.   PRINT "        1. Select a new file"
  511.   IF ReverseHorizontal = 0 THEN
  512.    PRINT "        2. Flip Horizontal"
  513.   ELSE
  514.    PRINT "        2. Reset Horizontal"
  515.   END IF
  516.   IF ReverseVertical = 0 THEN
  517.    PRINT "        3. Flip Vertical"
  518.   ELSE
  519.    PRINT "        3. Reset Vertical"
  520.   END IF
  521.   IF GreyScaling = 0 THEN
  522.    PRINT "        4. Render in Grey"
  523.   ELSE
  524.    PRINT "        4. Render in Colour"
  525.   END IF
  526.   PRINT "        5. Display Colour scheme"
  527.   PRINT "        6. Display Image"
  528.   PRINT "        7. Display then Fade"
  529.   PRINT "        8. Exit"
  530.   PRINT
  531.   PRINT
  532.  
  533.   PRINT "       ";
  534.   IF ReverseHorizontal = 0 THEN
  535.    PRINT "Normal ";
  536.   ELSE
  537.    PRINT "Flipped ";
  538.   END IF
  539.   PRINT "horizontal"
  540.  
  541.   PRINT "       ";
  542.   IF ReverseVertical = 0 THEN
  543.    PRINT "Normal ";
  544.   ELSE
  545.    PRINT "Flipped ";
  546.   END IF
  547.   PRINT "vertical"
  548.  
  549.   PRINT "       ";
  550.   PRINT "Rendered in ";
  551.   IF GreyScaling = 0 THEN
  552.    PRINT "colour"
  553.   ELSE
  554.    PRINT "shades of grey"
  555.   END IF
  556.  
  557.   GOSUB SleeperSound
  558.  
  559.   x$ = "X"
  560.   WHILE LEN(x$) > 0: x$ = INKEY$: WEND
  561.   WHILE LEN(x$) = 0
  562.    WHILE LEN(x$) = 0: x$ = INKEY$: WEND
  563.  
  564. '/ convert Fx to x
  565.  
  566.    IF LEN(x$) = 2 THEN
  567.     i = ASC(MID$(x$, 2, 1))
  568.     IF i > 58 AND i < 67 THEN
  569.      x$ = CHR$(i - 10)
  570.     END IF
  571.    END IF
  572.   
  573.    SELECT CASE x$
  574.    CASE CHR$(27)
  575.     NewFile = 1
  576.    CASE "1"
  577.     NewFile = 1
  578.    CASE "2"
  579.     ReverseHorizontal = 1 - ReverseHorizontal
  580.    CASE "3"
  581.     ReverseVertical = 1 - ReverseVertical
  582.    CASE "4"
  583.     GreyScaling = 1 - GreyScaling
  584.    CASE "5"
  585.     GOSUB FetchColours
  586.     GOSUB Displayer
  587.     GOSUB Sleeper
  588.    CASE "6"
  589.     GOSUB FetchColours
  590.     GOSUB ShowPicture
  591.     GOSUB Sleeper
  592.    CASE "7"
  593.     GOSUB FetchColours
  594.     GOSUB ShowPicture
  595.     GOSUB Sleeper
  596.     GOSUB Fade
  597.    CASE "8"
  598.     SCREEN 0
  599.     SCREEN 13
  600.     LOCATE 12
  601.     PRINT SPC(12); "PROGRAM END"
  602.     SLEEP (2)
  603.     CLS
  604.     SYSTEM
  605.    CASE ELSE
  606.     x$ = ""
  607.    END SELECT
  608.   WEND
  609.  
  610.  
  611.   RETURN
  612.  
  613.   
  614.  
  615. '/*****************************
  616. '/ Open a File
  617.  
  618. OpenFile:
  619.   CLOSE #1
  620.   bad = 0
  621.   INPUT "Which file"; FileName
  622.   FileName = UCASE$(FileName)
  623.  
  624.   IF FileName = SPACE$(50) THEN SYSTEM
  625.  
  626.   OPEN FileName FOR INPUT AS #1
  627.   IF bad <> 0 THEN
  628.    PRINT
  629.    PRINT "Cannot find "; FileName
  630.    GOSUB Proceed
  631.    RETURN
  632.   END IF
  633.   CLOSE #1
  634.   SCREEN 0
  635.   SCREEN 13
  636.   OPEN FileName FOR RANDOM AS #1 LEN = 256
  637.   GET #1, 1, BMP
  638.   PRINT FileName
  639.   PRINT "File size"; LOF(1)
  640.  
  641.   IF BMP.MustBeBM <> "BM" THEN
  642.    bad = 1
  643.    PRINT "This is not a BMP file"
  644.   ELSE
  645.    IF BMP.MustBeFileSize <> LOF(1) THEN
  646.     bad = 1
  647.     PRINT "File size is not correct"
  648.    ELSE
  649.     ImageLoc! = BMP.ImageOffset
  650.     BMPtype = BMP.HeaderSize
  651.  
  652.     SELECT CASE BMPtype
  653.     CASE 12
  654.      PRINT "This is an OS/2-type BMP file"
  655.      GET #1, 1, OS2
  656.      MapOffset = 26
  657.      ColourDisp = 3
  658.      Compression = 0
  659.      Xpixels = OS2.OS2XPixels
  660.      Ypixels = OS2.OS2YPixels
  661.      BitCount = OS2.OS2BitCount
  662.      ColoursUsed = 0
  663.     CASE 40
  664.      PRINT "This is a WINDOWS-type BMP file"
  665.      MapOffset = 54
  666.      ColourDisp = 4
  667.      Xpixels = BMP.WINXPixels
  668.      Ypixels = BMP.WINYPixels
  669.      BitCount = BMP.WINBitCount
  670.      ColoursUsed = BMP.WINColoursUsed
  671.      IF BMP.WINCompression <> 0 THEN
  672.       PRINT "RLE used"
  673.       Compression = 1
  674.      ELSE
  675.       PRINT "RLE not used"
  676.       Compression = 0
  677.      END IF
  678.     CASE ELSE
  679.      bad = 1
  680.      PRINT "This is an unknown type of BMP file"
  681.     END SELECT
  682.    END IF
  683.   END IF
  684.   IF bad = 0 THEN
  685.    SELECT CASE BitCount
  686.    CASE 1
  687.     MaxColours = 2
  688.    CASE 4
  689.     MaxColours = 16
  690.    CASE 8
  691.     MaxColours = 256
  692.    CASE ELSE
  693.     bad = 0
  694.     PRINT "More than 256 colours not supported"
  695.    END SELECT
  696.   END IF
  697.  
  698.   IF bad > 0 THEN
  699.    PRINT "I cannot proceed with this file"
  700.    GOSUB Proceed
  701.   END IF
  702.  
  703.   ReverseHorizontal = 0
  704.   ReverseVertical = 0
  705.   GreyScaling = 0
  706.  
  707.   RETURN
  708.  
  709.  
  710. '/*****************************
  711. '/  PixelPaint
  712. '/
  713. '/ Xfactor, Yfactor, Colourfactor
  714.  
  715. PixelPaint:
  716.   
  717.   IF ReverseHorizontal = 0 THEN
  718.    Xfactor2 = Xfactor
  719.   ELSE
  720.    Xfactor2 = 320 - Xfactor
  721.   END IF
  722.   IF ReverseVertical = 0 THEN
  723.    Yfactor2 = Yfactor
  724.   ELSE
  725.    Yfactor2 = 200 - Yfactor
  726.   END IF
  727.   PSET (Xfactor2, Yfactor2), ColourFactor
  728.   RETURN
  729.  
  730.  
  731. '/*****************************
  732. '/  Proceed
  733.  
  734. Proceed:
  735.  
  736.   LOCATE 23, 30
  737.   PRINT "Press a key to proceed";
  738.   GOSUB Sleeper
  739.   LOCATE 24, 30
  740.   PRINT SPACE$(23);
  741.   RETURN
  742.  
  743. '/*****************************
  744. '/  Read a particular record from the file
  745. '/
  746. '/  input:   offset!
  747. '/  output:  IntegerValue       - value at the desired offset
  748. '/           disp               - displacement within block
  749. '/           Block              - current block
  750.  
  751. ReadBlock:
  752.  
  753.   RecWanted = 1 + Offset! \ 256
  754.   IF CurrentRec <> RecWanted THEN
  755.     GET #1, RecWanted, Block
  756.     CurrentRec = RecWanted
  757.   END IF
  758.  
  759.   disp = Offset! MOD 256 + 1
  760.   IntegerValue = ASC(MID$(Block, disp, 1))
  761.  
  762.   RETURN
  763.  
  764.  
  765. '/*****************************
  766. '/  set colours
  767. '/
  768. '/ this method will work both for "quads" used by Windows BMP format
  769. '/  and for "triples" used by OS/2 BMP format.
  770.  
  771. SetColours:
  772.  
  773. '/  fetch existing colours
  774.  
  775.   regs.AX = &H1017
  776.   GOSUB ColourBIOS
  777.  
  778. '/ fetch colour table from the file
  779.  
  780.   FOR ColourNumber = 0 TO MaxColours - 1
  781.    Offset! = MapOffset + ColourNumber * ColourDisp
  782.    GOSUB ReadBlock
  783.    GreySum = IntegerValue * 11
  784.    BlueVal$ = CHR$(IntegerValue \ 4)
  785.    Offset! = Offset! + 1
  786.    GOSUB ReadBlock
  787.    GreySum = GreySum + IntegerValue * 59
  788.    GreenVal$ = CHR$(IntegerValue \ 4)
  789.    Offset! = Offset! + 1
  790.    GOSUB ReadBlock
  791.    GreySum = GreySum + IntegerValue * 30
  792.    RedVal$ = CHR$(IntegerValue \ 4)
  793.    IF GreyScaling = 1 THEN
  794.     x$ = CHR$(GreySum \ 400)
  795.     Vals$ = x$ + x$ + x$
  796.    ELSE
  797.     Vals$ = RedVal$ + GreenVal$ + BlueVal$
  798.    END IF
  799.    MID$(Memory, ColourNumber * 3 + 1, 3) = Vals$
  800.   NEXT
  801.  
  802. '/  store new values
  803.  
  804.   regs.AX = &H1012
  805.   GOSUB ColourBIOS
  806.   RETURN
  807.  
  808.  
  809. '/*****************************
  810. '/  Show a Picture
  811.  
  812. ShowPicture:
  813.  
  814.   CLS
  815.  
  816.   RedCounter# = 0
  817.   GreenCounter# = 0
  818.   BlueCounter# = 0
  819.   PixelCounter# = 0
  820.  
  821.   Xmax = (Xpixels + 320 - ABS(Xpixels - 320)) / 2
  822.   Xmargin = (320 - Xmax) / 2
  823.   Ymax = (Ypixels + 200 - ABS(Ypixels - 200)) / 2
  824.   Ymargin = (200 - Ymax) / 2
  825.  
  826.   IF Compression = 0 THEN
  827.    GOSUB Uncompressed
  828.   ELSE
  829.    GOSUB Compressed
  830.   END IF
  831.   RETURN
  832.  
  833.  
  834. '/*****************************
  835. '/  Sleeper
  836.  
  837. Sleeper:
  838.   GOSUB SleeperSound
  839.   x$ = "X"
  840.   WHILE LEN(x$) > 0: x$ = INKEY$: WEND
  841.   WHILE LEN(x$) = 0: x$ = INKEY$: WEND
  842.  
  843.   RETURN
  844.  
  845.  
  846.  
  847. '/*****************************
  848. '/  Sleeper Sound
  849.  
  850. SleeperSound:
  851.   FOR i = 300 TO 380 STEP 8
  852.    SOUND i, 1
  853.   NEXT
  854.  
  855.   RETURN
  856.  
  857.  
  858.  
  859. '/*****************************
  860. '/ Handle an UNCOMPRESSED Image
  861.  
  862. Uncompressed:
  863.  
  864. '/  calculate length of bitmap pertaining to one row
  865.  
  866.   i = 32 / BitCount
  867.   OneRow! = 4 * ((Xpixels + i - 1) \ i)
  868.  
  869.   FOR j = 0 TO Ymax - 1
  870.    ThisRow! = j * OneRow!
  871.    Stepping = 8 / BitCount
  872.    FOR i = 0 TO Xmax - 1 STEP Stepping
  873.     Offset! = ImageLoc! + i / Stepping + ThisRow!
  874.     GOSUB ReadBlock
  875.     Repeat = 0
  876.     Yfactor = Ymargin + Ypixels - j - 1
  877.  
  878.     RepeatFactor = 256 / MaxColours
  879.     DO
  880.      k = (IntegerValue \ RepeatFactor) MOD MaxColours
  881.  
  882.      PixelCounter# = PixelCounter# + 1
  883.      x$ = MID$(Memory, k * 3 + 1, 1)
  884.      RedCounter# = RedCounter# + ASC(x$)
  885.      x$ = MID$(Memory, k * 3 + 2, 1)
  886.      GreenCounter# = GreenCounter# + ASC(x$)
  887.      x$ = MID$(Memory, k * 3 + 3, 1)
  888.      BlueCounter# = BlueCounter# + ASC(x$)
  889.  
  890.      Xfactor = Xmargin + i + Repeat
  891.      ColourFactor = k
  892.      GOSUB PixelPaint
  893.  
  894.      Repeat = Repeat + 1
  895.      RepeatFactor = RepeatFactor / MaxColours
  896.      IF i + Repeat = Xmax THEN EXIT FOR
  897.     LOOP UNTIL Repeat = Stepping
  898.    NEXT
  899.    GOSUB Intervene
  900.    IF bad > 0 THEN EXIT FOR
  901.   NEXT
  902.   sum# = (RedCounter# + GreenCounter# + BlueCounter#) / 100
  903.  
  904.   RedPortion! = RedCounter# / sum#
  905.   GreenPortion! = GreenCounter# / sum#
  906.   BluePortion! = BlueCounter# / sum#
  907.  
  908.   Intensity! = RedPortion! * 30 + GreenPortion! * 59 + BluePortion! * 11
  909.   Intensity! = Intensity! / 63
  910.  
  911.   RETURN
  912.  
  913. '++++++++++++++++++++++++
  914. SUB ziDragging
  915.  
  916.   IF Mouse AND MCursorVis THEN
  917.     SELECT CASE Response
  918.     CASE 2052 TO 2054
  919.       regs.AX = 3
  920.       CALL zzBasicInt(&H33)
  921.       IF regs.BX = Response - 2051 THEN
  922.         EXIT SUB
  923.       END IF
  924.     END SELECT
  925.   END IF
  926.   CALL ziExhaust
  927.  
  928. END SUB
  929.  
  930. '++++++++++++++++++++++++
  931. SUB ziDrawBank (FromButton, ToButton)
  932.  
  933.   CALL ziSetMCursorVis(10)
  934.  
  935.   FOR i = FromButton TO ToButton
  936.  
  937.     IF Bank(i).Active THEN
  938.  
  939.       IF Bank(i).State THEN
  940.         Colour1 = 8
  941.       ELSE
  942.         Colour1 = 15
  943.       END IF
  944.       Colour2 = Colour1 XOR 7
  945.  
  946.       Xcoord = Bank(i).Xloc
  947.       YCoord = Bank(i).Yloc
  948.       XWidth = Bank(i).Wide
  949.       YDepth = Bank(i).Deep
  950.       X2Coord = Xcoord + XWidth
  951.  
  952.       IF YDepth THEN
  953.         IF YDepth = 1 THEN
  954.           Y2Coord = YCoord + XWidth / XYratio!
  955.         ELSE
  956.           Y2Coord = YCoord + YDepth
  957.         END IF
  958.         LINE (Xcoord, YCoord)-(X2Coord - 1, YCoord), Colour1
  959.         LINE (Xcoord, YCoord)-(Xcoord, Y2Coord - 1), Colour1
  960.         LINE (Xcoord + 1, Y2Coord)-(X2Coord, Y2Coord), Colour2
  961.         LINE (X2Coord, YCoord)-(X2Coord, Y2Coord), Colour2
  962.       ELSE
  963.         a = XWidth \ 2
  964.         b = a / XYratio!
  965.         c = Xcoord + a
  966.         d = YCoord + b
  967.  
  968.         LINE (Xcoord, YCoord)-(c + a, d + b), 7, BF
  969.  
  970.         CIRCLE (c, d), a, 8
  971.         CIRCLE (c, d), a - 1, 8
  972.         PAINT (c, d), 7, 7
  973.         IF Bank(i).State THEN
  974.           CIRCLE (c, d), XWidth \ 3, 8
  975.           PAINT (c, d), 8, 8
  976.         END IF
  977.       END IF
  978.     END IF
  979.  
  980.   NEXT
  981.  
  982.   CALL ziSetMCursorVis(11)
  983.  
  984. END SUB
  985.  
  986. '++++++++++++++++++++++++
  987. SUB ziExhaust
  988.  
  989.   DO
  990.     x$ = INKEY$
  991.   LOOP WHILE LEN(x$)
  992.  
  993.   IF Mouse AND MCursorVis THEN
  994.     DO
  995.       regs.AX = 3
  996.       CALL zzBasicInt(&H33)
  997.     LOOP WHILE (regs.BX AND 3)
  998.   END IF
  999.   Response = 0
  1000. END SUB
  1001.  
  1002. '++++++++++++++++++++++++
  1003. SUB ziLoadFont (Font$)
  1004.  
  1005.   DEF SEG = VARSEG(Font(0, 0))
  1006.  
  1007.   Module$ = Font$ + ".OVL"
  1008.   CALL zzInPath(Module$)
  1009.   IF Module$ = "" THEN
  1010.     Module$ = Font$ + ".OVL"
  1011.     ERROR 255
  1012.   ELSE
  1013.     BLOAD Module$, VARPTR(Font(0, 0))
  1014.   END IF
  1015.  
  1016.   DEF SEG
  1017.  
  1018. END SUB
  1019.  
  1020. '++++++++++++++++++++++++
  1021. SUB ziLocateMCursor (Xcoord, YCoord)
  1022.  
  1023.   IF Mouse THEN
  1024.     MXloc = Xcoord
  1025.     MYloc = YCoord
  1026.     regs.AX = 4
  1027.     regs.CX = Xcoord
  1028.     regs.DX = YCoord
  1029.     CALL zzBasicInt(&H33)
  1030.     CALL ziSetMCursorVis(1)
  1031.   END IF
  1032.  
  1033. END SUB
  1034.  
  1035. '++++++++++++++++++++++++
  1036. SUB ziMouseOnButton (FromButton, ToButton)
  1037.  
  1038.   FoundButton = 0
  1039.   FOR i = FromButton TO ToButton
  1040.     IF Bank(i).Active THEN
  1041.       IF Bank(i).Deep < 2 THEN
  1042.         j = Bank(i).Wide / XYratio!
  1043.       ELSE
  1044.         j = Bank(i).Deep
  1045.       END IF
  1046.       IF MXloc > Bank(i).Xloc THEN
  1047.         IF MXloc < Bank(i).Xloc + Bank(i).Wide THEN
  1048.           IF MYloc > Bank(i).Yloc THEN
  1049.             IF MYloc < Bank(i).Yloc + j THEN
  1050.               FoundButton = i
  1051.               EXIT SUB
  1052.             END IF
  1053.           END IF
  1054.         END IF
  1055.       END IF
  1056.     ELSE
  1057.       EXIT SUB
  1058.     END IF
  1059.   NEXT
  1060.  
  1061. END SUB
  1062.  
  1063. '++++++++++++++++++++++++
  1064. SUB ziPublish (PrintString$, Size, Italic)
  1065.  
  1066.   CALL ziSetMCursorVis(10)
  1067.  
  1068.   xx = POINT(0)
  1069.   yy = POINT(1)
  1070.   IF Size THEN
  1071.     Scale = Size
  1072.   ELSE
  1073.     Scale = 1
  1074.   END IF
  1075.  
  1076.   LenString = LEN(PrintString$)
  1077.  
  1078.   ExpScale = 8 * Scale
  1079.   limxx = xx + ExpScale * LenString - 1
  1080.   limyy = yy + ExpScale - 1
  1081.  
  1082.   IF Italic AND 1 THEN
  1083.     limxx = limxx + 4 * Scale
  1084.   END IF
  1085.  
  1086.  
  1087.   IF Italic AND 2 THEN
  1088.   ELSE
  1089.     LINE (xx, yy)-(limxx, limyy), BG, BF
  1090.   END IF
  1091.  
  1092.  
  1093.   FOR a = 0 TO LenString - 1
  1094.     x = ASC(MID$(PrintString$, a + 1, 1))
  1095.     b = xx + ExpScale * a
  1096.     FOR Y = 0 TO 7
  1097.       c = Font(x, Y)
  1098.       d = Y * Scale
  1099.       e = yy + d
  1100.       IF Italic AND 1 THEN
  1101.         f = b + 4 * Scale - (d + Scale - 1) \ 2 - 1
  1102.       ELSE
  1103.         f = b
  1104.       END IF
  1105.       g = 128
  1106.       DO
  1107.         IF c AND g THEN
  1108.           FOR h = 0 TO Scale - 1
  1109.             FOR i = 0 TO Scale - 1
  1110.               PSET (f + h, e + i), FG
  1111.             NEXT
  1112.           NEXT
  1113.         END IF
  1114.         f = f + Scale
  1115.         g = g \ 2
  1116.       LOOP UNTIL g = 0
  1117.     NEXT
  1118.   NEXT
  1119.   CALL zsLocateGCursor(limxx + 1, yy)
  1120.  
  1121.   CALL ziSetMCursorVis(11)
  1122.  
  1123. END SUB
  1124.  
  1125. '++++++++++++++++++++++++
  1126. SUB ziRadio (Button, FromButton, ToButton)
  1127.  
  1128.   IF Button >= FromButton THEN
  1129.     IF Button <= ToButton THEN
  1130.       FOR a = FromButton TO ToButton
  1131.         Bank(a).State = 0
  1132.       NEXT
  1133.     END IF
  1134.   END IF
  1135.  
  1136.   Bank(Button).State = 1
  1137.   CALL ziDrawBank(FromButton, ToButton)
  1138.  
  1139. END SUB
  1140.  
  1141. '++++++++++++++++++++++++
  1142. SUB ziReadField (Min, Max, Permitted$)
  1143.  
  1144.   CALL ziSetMCursorVis(10)
  1145.  
  1146.   atRow = CSRLIN
  1147.   atCol = POS(x)
  1148.   Field$ = ""
  1149.   PRINT CHR$(219); SPACE$(Max);
  1150.   Rules$ = UCASE$(Permitted$)
  1151.  
  1152.   Brake = 1
  1153.   WHILE Brake
  1154.     x$ = ""
  1155.     WHILE LEN(x$) = 0
  1156.       x$ = INKEY$
  1157.     WEND
  1158.     IF INSTR(Rules$, "C") THEN x$ = UCASE$(x$)
  1159.     oldLen = LEN(Field$)
  1160.     Good = 0
  1161.     IF INSTR(Rules$, ".") THEN
  1162.       IF x$ = "." THEN
  1163.         IF INSTR(Field$, ".") = 0 THEN
  1164.           Good = 1
  1165.         END IF
  1166.       END IF
  1167.     END IF
  1168.     IF INSTR(Rules$, "N") THEN
  1169.       IF INSTR("0123456789", x$) THEN
  1170.         Good = 1
  1171.       END IF
  1172.     END IF
  1173.     IF INSTR(Rules$, "S") THEN
  1174.       IF x$ = " " THEN
  1175.         Good = 1
  1176.       END IF
  1177.     END IF
  1178.     IF INSTR(Rules$, "X") THEN
  1179.       IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(x$)) THEN
  1180.         Good = 1
  1181.       END IF
  1182.     END IF
  1183.     IF INSTR(Rules$, "Y") THEN
  1184.       IF INSTR("YyNy", x$) THEN
  1185.         Good = 1
  1186.       END IF
  1187.     END IF
  1188.     IF Good THEN
  1189.       Field$ = Field$ + x$
  1190.       IF INSTR(Field$, ".") THEN
  1191.         NewMax = Max + 1
  1192.       ELSE
  1193.         NewMax = Max
  1194.       END IF
  1195.       Field$ = MID$(Field$, 1, NewMax)
  1196.     END IF
  1197.  
  1198.     ' handle Bkspace
  1199.     IF ASC(x$) = 8 AND LEN(Field$) THEN
  1200.       Field$ = MID$(Field$, 1, LEN(Field$) - 1)
  1201.     END IF
  1202.  
  1203.     Signif$ = Field$ + "X"
  1204.     WHILE INSTR(" 0", MID$(Signif$, 1, 1))
  1205.       Signif$ = MID$(Signif$, 2)
  1206.     WEND
  1207.     IF INSTR(Signif$, ".") THEN
  1208.       SignifLen = LEN(Signif$) - 2
  1209.     ELSE
  1210.       SignifLen = LEN(Signif$) - 1
  1211.     END IF
  1212.  
  1213.     ' handle Enter
  1214.     IF ASC(x$) = 13 AND SignifLen >= Min THEN
  1215.       oldLen = LEN(Field$) + 1
  1216.       Brake = 0
  1217.     END IF
  1218.  
  1219.     ' handle Esc
  1220.     IF ASC(x$) = 27 THEN
  1221.       LOCATE atRow, atCol
  1222.       PRINT CHR$(219); SPACE$(Max);
  1223.       Field$ = ""
  1224.       IF INSTR(Rules$, "E") THEN
  1225.         RETURN
  1226.       END IF
  1227.     END IF
  1228.  
  1229.     ' reprint if change, or beep if no change
  1230.     IF oldLen = LEN(Field$) THEN
  1231.       BEEP
  1232.     ELSE
  1233.       LOCATE atRow, atCol
  1234.       IF INSTR(Rules$, "P") THEN
  1235.         PRINT STRING$(LEN(Field$), 254); CHR$(219); " ";
  1236.       ELSE
  1237.         PRINT Field$; CHR$(219); " ";
  1238.       END IF
  1239.     END IF
  1240.  
  1241.     ' check for auto-Enter
  1242.     IF INSTR(Rules$, "A") THEN
  1243.       IF SignifLen = Max THEN
  1244.         Brake = 0
  1245.       END IF
  1246.     END IF
  1247.   WEND
  1248.  
  1249.   ' justify if required
  1250.   IF INSTR(Rules$, "J") THEN
  1251.     WHILE MID$(Field$, 1, 1) = "0"
  1252.       Field$ = MID$(Field$, 2)
  1253.     WEND
  1254.     Field$ = RIGHT$(SPACE$(NewMax) + Field$, NewMax)
  1255.   END IF
  1256.  
  1257.   ' reprint, deleting the cursor
  1258.   LOCATE atRow, atCol
  1259.   IF INSTR(Rules$, "P") THEN
  1260.     PRINT STRING$(LEN(Field$), 254); " ";
  1261.   ELSE
  1262.     PRINT Field$; " ";
  1263.   END IF
  1264.  
  1265.   CALL ziSetMCursorVis(11)
  1266.  
  1267. END SUB
  1268.  
  1269. '++++++++++++++++++++++++
  1270. SUB ziSetMCursorVis (Status) STATIC
  1271.  
  1272.   IF Mouse THEN
  1273.     SELECT CASE Status
  1274.     CASE 0
  1275.       IF MCursorVis THEN
  1276.        regs.AX = 2
  1277.        CALL zzBasicInt(&H33)
  1278.       END IF
  1279.     CASE 1
  1280.       regs.AX = 1
  1281.       CALL zzBasicInt(&H33)
  1282.     CASE 10
  1283.       regs.AX = &H2A
  1284.       CALL zzBasicInt(&H33)
  1285.       IF regs.AX = 0 THEN
  1286.         TempFlag = 1
  1287.         regs.AX = 2
  1288.         CALL zzBasicInt(&H33)
  1289.       ELSE
  1290.         TempFlag = 0
  1291.       END IF
  1292.     CASE 11
  1293.       IF TempFlag THEN
  1294.         regs.AX = 1
  1295.         CALL zzBasicInt(&H33)
  1296.       END IF
  1297.     END SELECT
  1298.     regs.AX = &H2A
  1299.     CALL zzBasicInt(&H33)
  1300.     IF regs.AX = 0 THEN
  1301.       MCursorVis = 1
  1302.     ELSE
  1303.       MCursorVis = 0
  1304.     END IF
  1305.   END IF
  1306. END SUB
  1307.  
  1308. '++++++++++++++++++++++++
  1309. SUB ziWander (Timeout!)
  1310.  
  1311.   IF Timeout! = 0 THEN
  1312.     WatchFor! = TIMER + 3600
  1313.   ELSE
  1314.     WatchFor! = TIMER + Timeout!
  1315.   END IF
  1316.  
  1317.   Response = 0
  1318.  
  1319.   DO
  1320.     x$ = INKEY$
  1321.     IF LEN(x$) THEN
  1322.       SELECT CASE LEN(x$)
  1323.       CASE 1
  1324.         a = INSTR(Allowed$, x$)
  1325.         IF a THEN
  1326.           Response = a
  1327.           EXIT DO
  1328.         END IF
  1329.         SELECT CASE ASC(x$)
  1330.         CASE 8: Response = 261
  1331.         CASE 9: Response = 266
  1332.         CASE 10: Response = 512
  1333.         CASE 13: Response = 256
  1334.         CASE 27: Response = 267
  1335.         CASE 127: Response = 517
  1336.         END SELECT
  1337.         IF Response THEN
  1338.           EXIT DO
  1339.         END IF
  1340.       CASE 2
  1341.         Rightmost = ASC(RIGHT$(x$, 1))
  1342.         SELECT CASE Rightmost
  1343.         CASE 15: Response = 1019
  1344.         CASE 59 TO 68
  1345.           Response = 4038
  1346.         CASE 72: Response = 187
  1347.         CASE 71 TO 73
  1348.           Response = 191
  1349.         CASE 75: Response = 182
  1350.         CASE 77: Response = 181
  1351.         CASE 80: Response = 180
  1352.         CASE 79 TO 81
  1353.           Response = 184
  1354.         CASE 84 TO 93
  1355.           Response = 16301
  1356.         CASE 94 TO 103
  1357.           Response = 8099
  1358.         CASE 115 TO 116
  1359.           Response = 398
  1360.         CASE 117: Response = 402
  1361.         CASE 118: Response = 403
  1362.         CASE 119: Response = 399
  1363.         CASE 127: Response = 390
  1364.         CASE 132: Response = 388
  1365.         CASE 133 TO 134
  1366.           Response = 3974
  1367.         CASE 135 TO 136
  1368.           Response = 16260
  1369.         CASE 137 TO 138
  1370.           Response = 8066
  1371.         END SELECT
  1372.         IF Response THEN
  1373.           Response = Response + Rightmost
  1374.           EXIT DO
  1375.         END IF
  1376.       END SELECT
  1377.     END IF
  1378.  
  1379.     IF Mouse AND MCursorVis THEN
  1380.       regs.AX = 3
  1381.       CALL zzBasicInt(&H33)
  1382.       SELECT CASE regs.BX
  1383.       CASE 1 TO 3
  1384.         Response = 2048 + regs.BX
  1385.         nowtime! = TIMER
  1386.         DO
  1387.           regs.AX = 3
  1388.           CALL zzBasicInt(&H33)
  1389.           IF regs.BX = 0 THEN EXIT DO
  1390.         LOOP UNTIL TIMER - nowtime! > .3
  1391.         IF regs.BX = Response - 2048 THEN
  1392.           Response = Response + 3
  1393.         ELSE
  1394.           IF regs.BX = 0 AND Response = 2049 AND DClick THEN
  1395.             nowtime! = TIMER
  1396.             DO
  1397.               regs.AX = 3
  1398.               CALL zzBasicInt(&H33)
  1399.               IF regs.BX = 1 THEN EXIT DO
  1400.             LOOP UNTIL TIMER - nowtime! > .3
  1401.             IF regs.BX = 1 THEN
  1402.               Response = 2048
  1403.               CALL ziExhaust
  1404.             END IF
  1405.           END IF
  1406.           IF regs.BX = 3 THEN
  1407.             Response = 2051
  1408.           END IF
  1409.         END IF
  1410.       END SELECT
  1411.       IF Response THEN
  1412.         MXloc = regs.CX
  1413.         MYloc = regs.DX
  1414.         EXIT DO
  1415.       END IF
  1416.     END IF
  1417.  
  1418.   LOOP UNTIL WatchFor! < TIMER
  1419.   HResponse = Response \ 256
  1420.   LResponse = Response MOD 256
  1421.  
  1422. END SUB
  1423.  
  1424. '++++++++++++++++++++++++
  1425. SUB zsAlignGCursor
  1426.  
  1427.   Row = CSRLIN
  1428.   Col = POS(0)
  1429.   GXloc = (Col - 1) * ((Xmax + 1) \ Cols)
  1430.   GYloc = (Row - 1) * (((Ymax \ Rows) * Rows + 1) \ Rows)
  1431.   CALL zsLocateGCursor(GXloc, GYloc)
  1432.  
  1433. END SUB
  1434.  
  1435. '++++++++++++++++++++++++
  1436. SUB zsAlignTCursor
  1437.  
  1438.   GXloc = POINT(0)
  1439.   GYloc = POINT(1)
  1440.   a = (Xmax + 1) / Cols
  1441.   b = (Ymax + 1) / Rows
  1442.   Col = (GXloc + a - 1) \ a + 1
  1443.   Row = (GYloc + b - 1) \ b + 1
  1444.   LOCATE Row, Col
  1445.   CALL zsAlignGCursor
  1446.  
  1447. END SUB
  1448.  
  1449. '++++++++++++++++++++++++
  1450. SUB zsLocateGCursor (Xcoord, YCoord)
  1451.  
  1452.   GXloc = Xcoord
  1453.   GYloc = YCoord
  1454.   PSET (GXloc, GYloc), POINT(GXloc, GYloc)
  1455.  
  1456. END SUB
  1457.  
  1458. '++++++++++++++++++++++++
  1459. SUB zsPastel (Xcoord, YCoord, Wide, Deep, Colour1, Colour2)
  1460.  
  1461.   CALL ziSetMCursorVis(10)
  1462.  
  1463.   IF Deep < 2 THEN
  1464.     a = Wide / XYratio!
  1465.   ELSE
  1466.     a = Deep
  1467.   END IF
  1468.  
  1469.   LINE (Xcoord, YCoord)-(Xcoord + Wide - 1, YCoord + a - 1), Colour1, BF
  1470.   FOR b = Xcoord TO Xcoord + Wide - 1 STEP 2
  1471.     LINE (b, YCoord)-(b, YCoord + a - 1), Colour2, , &H5555
  1472.   NEXT
  1473.   FOR b = Xcoord + 1 TO Xcoord + Wide - 1 STEP 2
  1474.     LINE (b, YCoord)-(b, YCoord + a - 1), Colour2, , &HAAAA
  1475.   NEXT
  1476.  
  1477.   CALL ziSetMCursorVis(11)
  1478.  
  1479. END SUB
  1480.  
  1481. '++++++++++++++++++++++++
  1482. SUB zsSetScrnMode (Mode, HiRows, HiCols)
  1483.  
  1484.   CALL ziSetMCursorVis(10)
  1485.  
  1486.   ScrnMode = Mode
  1487.   IF Mode = 9 THEN
  1488.     SCREEN 9
  1489.     IF HiRows THEN
  1490.       Rows = 43
  1491.     ELSE
  1492.       Rows = 25
  1493.     END IF
  1494.     Xmax = 639
  1495.     Ymax = 349
  1496.   END IF
  1497.   IF Mode = 12 THEN
  1498.     SCREEN 12
  1499.     IF HiRows THEN
  1500.       Rows = 60
  1501.     ELSE
  1502.       Rows = 30
  1503.     END IF
  1504.     Xmax = 639
  1505.     Ymax = 479
  1506.   END IF
  1507.  
  1508.   IF HiCols THEN
  1509.     Cols = 80
  1510.   ELSE
  1511.     Cols = 40
  1512.   END IF
  1513.   WIDTH Cols, Rows
  1514.   CLS
  1515.   IF Mode = 9 THEN
  1516.     COLOR FG, BG
  1517.   ELSE
  1518.     COLOR FG
  1519.   END IF
  1520.   LINE (0, 0)-(Xmax, Ymax), BG, BF
  1521.   LOCATE 1, 1, 0
  1522.   PSET (0, 0), BG
  1523.   XYratio! = .75 * (Xmax + 1) / (Ymax + 1)
  1524.  
  1525.   CALL ziSetMCursorVis(11)
  1526.  
  1527. END SUB
  1528.  
  1529. '++++++++++++++++++++++++
  1530. SUB zsSubstitute (Xcoord, YCoord, Wide, Deep, Colour1, Colour2)
  1531.  
  1532.   CALL ziSetMCursorVis(10)
  1533.  
  1534.   IF Deep < 2 THEN
  1535.     a = Wide / XYratio!
  1536.   ELSE
  1537.     a = Deep
  1538.   END IF
  1539.   FOR b = Xcoord TO Xcoord + Wide - 1
  1540.     FOR c = YCoord TO YCoord + a - 1
  1541.       IF POINT(b, c) = Colour1 THEN
  1542.         PSET (b, c), Colour2
  1543.       END IF
  1544.     NEXT
  1545.   NEXT
  1546.  
  1547.   CALL ziSetMCursorVis(11)
  1548.  
  1549. END SUB
  1550.  
  1551. '++++++++++++++++++++++++
  1552. SUB zzBasicInt (IntType) STATIC
  1553.  
  1554.   DIM ASM(54)
  1555.   DEF SEG = VARSEG(ASM(0))
  1556.  
  1557.   IF ASM(1) = 0 THEN
  1558.     Module$ = "BASICINT.OVL"
  1559.     CALL zzInPath(Module$)
  1560.     IF Module$ = "" THEN
  1561.       Module$ = "BASICINT.OVL"
  1562.       ERROR 255
  1563.     ELSE
  1564.       BLOAD Module$, VARPTR(ASM(0))
  1565.     END IF
  1566.   END IF
  1567.  
  1568.   CALL ABSOLUTE(regs, IntType, VARPTR(ASM(0)))
  1569.  
  1570.   DEF SEG
  1571.  
  1572. END SUB
  1573.  
  1574. '++++++++++++++++++++++++
  1575. SUB zzInPath (Field$)
  1576.  
  1577.   x$ = ".;" + ENVIRON$("PATH")
  1578.   IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
  1579.   i = 1
  1580.   DO
  1581.     j = INSTR(i, x$, ";")
  1582.     IF j THEN
  1583.       Y$ = UCASE$(MID$(x$, i, j - i))
  1584.       i = j + 1
  1585.       IF RIGHT$(Y$, 1) <> "\" THEN Y$ = Y$ + "\"
  1586.       f$ = Y$ + Field$
  1587.       bad = 0
  1588.       OPEN "I", 1, f$
  1589.       IF bad = 0 THEN
  1590.         CLOSE 1
  1591.         EXIT DO
  1592.       END IF
  1593.       f$ = ""
  1594.     END IF
  1595.   LOOP WHILE j
  1596.   bad = 0
  1597.   Field$ = f$
  1598.  
  1599. END SUB
  1600.  
  1601.