home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / msdos / c / playfli / menulib.bas next >
BASIC Source File  |  1994-06-28  |  7KB  |  386 lines
  1. DECLARE SUB Writedot (x%, y%, c%)
  2. DECLARE SUB Setvesa (Mode%)
  3. DECLARE SUB Delay (Times!)
  4. DECLARE FUNCTION Mouseinit% ()
  5. DECLARE FUNCTION Getvect& (Interrup%)
  6. DECLARE FUNCTION Findnext% (Buf AS ANY)
  7. DECLARE FUNCTION Findfirst% (Filename$, Attr%, Buf AS ANY)
  8. DECLARE FUNCTION Offp% (Pntr&)
  9. DECLARE FUNCTION Segp% (Pntr&)
  10. DECLARE FUNCTION Ptr& (Array%())
  11. DECLARE FUNCTION Long2int% (Number&)
  12. DECLARE FUNCTION Sbinit% (Port%, Irq%, Dmach%, Version%)
  13. DECLARE FUNCTION Dmastat% (Dmach%)
  14. DECLARE FUNCTION Int2Long& (Integ%)
  15. DECLARE FUNCTION Dosread% (Pnt&, Size%, Handle%)
  16. DECLARE FUNCTION Doswrite% (Pnt&, Size%, Handle%)
  17. '$INCLUDE: 'qb.bi'
  18. '$INCLUDE: 'modex.bi'
  19. DEFINT A-Z
  20. CONST Vesa640x400 = &H100
  21. CONST Vesa640x480 = &H101
  22. CONST Vesa800x600 = &H103
  23. CONST Vesa1024x768 = &H105
  24. CONST True = -1
  25. CONST False = 0
  26.  
  27. TYPE Filefind
  28.     Internal AS STRING * 21
  29.     Attr AS STRING * 1
  30.     Ftime AS INTEGER
  31.     Fdate AS INTEGER
  32.     Size AS LONG
  33.     Namext AS STRING * 13
  34. END TYPE
  35. DIM SHARED Inregs AS RegTypeX
  36. DIM SHARED Outregs AS RegTypeX
  37. DIM SHARED Curpage AS INTEGER
  38. DIM SHARED Memloc AS INTEGER
  39. DIM SHARED Ytable(0 TO 767) AS INTEGER
  40. DIM SHARED Ptable(0 TO 767) AS INTEGER
  41.  
  42. DEFINT A-Z
  43.  
  44. SUB Delay (Times!)
  45. Start! = TIMER
  46. DO WHILE TIMER - Start! < Times!: LOOP
  47. END SUB
  48.  
  49. FUNCTION Dmastat (Dmach)
  50. Addr = Dmach * 2
  51. tmp = 0
  52. DEF SEG = VARSEG(tmp)
  53. d = VARPTR(tmp)
  54. POKE (d), INP(Addr)
  55. POKE (d + 1), INP(Addr)
  56. Dmastat = tmp
  57.  
  58. END FUNCTION
  59.  
  60. FUNCTION Dosread% (Pnt&, Size%, Handle%)
  61. Dseg = Segp(Pnt&)
  62. Doff = Offp(Pnt&)
  63. Inregs.ax = &H3F00
  64. Inregs.bx = Handle
  65. Inregs.cx = Size
  66. Inregs.ds = Dseg
  67. Inregs.dx = Doff
  68. CALL INTERRUPTX(&H21, Inregs, Outregs)
  69. Dosread = Outregs.ax
  70.  
  71. END FUNCTION
  72.  
  73. FUNCTION Doswrite% (Pnt&, Size%, Handle%)
  74. Dseg = Segp(Pnt&)
  75. Doff = Offp(Pnt&)
  76.  
  77. Inregs.ax = &H4000
  78. Inregs.bx = Handle
  79. Inregs.cx = Size
  80. Inregs.ds = Dseg
  81. Inregs.dx = Doff
  82. CALL INTERRUPTX(&H21, Inregs, Outregs)
  83. Doswrite = Outregs.ax
  84.  
  85. END FUNCTION
  86.  
  87. FUNCTION Findfirst (Filename$, Attr%, Buf AS Filefind)
  88. Asciiz$ = Filename$ + CHR$(0)
  89. Inregs.ax = &H1A00
  90. Inregs.ds = VARSEG(Buf)
  91. Inregs.dx = VARPTR(Buf)
  92. CALL INTERRUPTX(&H21, Inregs, Outregs)
  93. Inregs.ax = &H4E00
  94. Inregs.cx = Attr%
  95. Inregs.ds = VARSEG(Asciiz$)
  96. Inregs.dx = SADD(Asciiz$)
  97. CALL INTERRUPTX(&H21, Inregs, Outregs)
  98. IF (Outregs.flags AND &H1) = &H1 THEN
  99.     Findfirst = 0
  100. ELSE
  101.     Buf.Namext = LEFT$(Buf.Namext, INSTR(Buf.Namext, CHR$(0)))
  102.  
  103.     Findfirst = -1
  104. END IF
  105.  
  106. END FUNCTION
  107.  
  108. FUNCTION Findnext (Buf AS Filefind)
  109. Asciiz$ = Filename$ + CHR$(0)
  110. Inregs.ax = &H1A00
  111. Inregs.ds = VARSEG(Buf)
  112. Inregs.dx = VARPTR(Buf)
  113. CALL INTERRUPTX(&H21, Inregs, Outregs)
  114. Inregs.ax = &H4F00
  115. CALL INTERRUPTX(&H21, Inregs, Outregs)
  116. IF (Outregs.flags AND &H1) = &H1 THEN
  117.     Findnext = 0
  118. ELSE
  119.     Buf.Namext = LEFT$(Buf.Namext, INSTR(Buf.Namext, CHR$(0)))
  120.     Findnext = -1
  121. END IF
  122.  
  123. END FUNCTION
  124.  
  125. FUNCTION Getvect& (Interrup%)
  126. Inregs.ax = &H3500 OR Interrup
  127. CALL INTERRUPTX(&H21, Inregs, Outregs)
  128. Vseg = Outregs.es
  129. Voff = Outregs.bx
  130. tmp& = 0
  131. DEF SEG = VARSEG(Vseg)
  132. v = VARPTR(Vseg)
  133. a = PEEK(v)
  134. b = PEEK(v + 1)
  135. DEF SEG = VARSEG(Voff)
  136. v = VARPTR(Voff)
  137. c = PEEK(v)
  138. d = PEEK(v + 1)
  139. DEF SEG = VARSEG(tmp&)
  140. v = VARPTR(tmp&)
  141. POKE (v), c
  142. POKE (v + 1), d
  143. POKE (v + 2), a
  144. POKE (v + 3), b
  145. Getvect& = tmp&
  146. END FUNCTION
  147.  
  148. SUB Hidemouse
  149. Inregs.ax = &H2
  150. CALL INTERRUPTX(&H33, Inregs, Outregs)
  151.  
  152. END SUB
  153.  
  154. FUNCTION Int2Long& (Integ%)
  155. DEF SEG = VARSEG(Integ)
  156. v = VARPTR(Integ)
  157. a = PEEK(v)
  158. b = PEEK(v + 1)
  159. DEF SEG = VARSEG(Int2Long&)
  160. v = VARPTR(Int2Long&)
  161. POKE (v), a
  162. POKE (v + 1), b
  163.  
  164. END FUNCTION
  165.  
  166. FUNCTION Long2int (Number&)
  167. Long2int = VAL("&H" + HEX$(Number& AND &HFFFF&))
  168. END FUNCTION
  169.  
  170. SUB MaxMousex (Minx, Maxx)
  171. Inregs.ax = &H7
  172. Inregs.cx = Minx
  173. Inregs.dx = Maxx
  174. CALL INTERRUPTX(&H33, Inregs, Outregs)
  175.  
  176. END SUB
  177.  
  178. SUB MaxMousey (Miny, Maxy)
  179. Inregs.ax = &H8
  180. Inregs.cx = Miny
  181. Inregs.dx = Maxy
  182. CALL INTERRUPTX(&H33, Inregs, Outregs)
  183.  
  184. END SUB
  185.  
  186. FUNCTION Mouseinit%
  187. IF Getvect(&H33) = 0 THEN
  188.     Mouseinit = 0
  189.     EXIT FUNCTION
  190. END IF
  191. Inregs.ax = &H0
  192. CALL INTERRUPTX(&H33, Inregs, Outregs)
  193. IF NOT Outregs.ax THEN
  194.     Mouseinit = 0
  195. ELSE
  196.     Mouseinit = -1
  197. END IF
  198.  
  199. END FUNCTION
  200.  
  201. SUB Mousestat (x, y, b)
  202. Inregs.ax = &H3
  203. CALL INTERRUPTX(&H33, Inregs, Outregs)
  204. x = Outregs.cx
  205. y = Outregs.dx
  206. b = Outregs.bx
  207.  
  208. END SUB
  209.  
  210. FUNCTION Offp (Pntr&)
  211. tmp = 0
  212. DEF SEG = VARSEG(Pntr&)
  213. v = VARPTR(Pntr&)
  214. a = PEEK(v)
  215. b = PEEK(v + 1)
  216.  
  217. DEF SEG = VARSEG(tmp)
  218. v = VARPTR(tmp)
  219. POKE (v), a
  220. POKE (v + 1), b
  221. Offp = tmp
  222.  
  223. END FUNCTION
  224.  
  225. SUB Outsb (Baseport, Writeval)
  226. WHILE (INP(Baseport + &HC) AND &H80) <> 0: WEND
  227. OUT (Baseport + &HC), Writeval
  228.  
  229. END SUB
  230.  
  231. FUNCTION Ptr& (Array())
  232. tmp& = 0
  233. Vseg = VARSEG(Array(1))
  234. v = VARPTR(Array(1))
  235.  
  236.  
  237. DEF SEG = VARSEG(Vseg)
  238. r = VARPTR(Vseg)
  239. a = PEEK(r)
  240. b = PEEK(r + 1)
  241.  
  242. DEF SEG = VARSEG(tmp&)
  243. r = VARPTR(tmp&)
  244. POKE (r + 2), a
  245. POKE (r + 3), b
  246.  
  247. DEF SEG = VARSEG(v)
  248. r = VARPTR(v)
  249. a = PEEK(r)
  250. b = PEEK(r + 1)
  251.  
  252. DEF SEG = VARSEG(tmp&)
  253. r = VARPTR(tmp&)
  254. POKE (r), a
  255. POKE (r + 1), b
  256.  
  257. Ptr& = tmp&
  258.  
  259.  
  260. END FUNCTION
  261.  
  262. SUB ResetSb (Baseport)
  263. OUT Baseport + &H6, &H1
  264. Delay .1
  265. OUT Baseport + &H6, &H0
  266. WHILE (INP(Baseport + &HC) AND &H80) = 0: WEND
  267.  
  268.  
  269.  
  270. END SUB
  271.  
  272. FUNCTION Sbinit% (Port, Irq, Dmach, Version)
  273. Evrstr$ = ENVIRON$("BLASTER")
  274. Port = 0
  275. IF LEN(Evrstr$) = 0 THEN
  276.     FOR i = &H210 TO &H270 STEP &H10
  277.         OUT i + &H6, &H1
  278.         OUT i + &H6, &H0
  279.         IF INP(i + &HC) = &HAA THEN
  280.             Port = &H220
  281.             Irq = 7
  282.             Dmach = 1
  283.             Version = 1
  284.         END IF
  285.     NEXT i
  286.     IF Port = 0 THEN
  287.         Sbinit% = 0
  288.     ELSE
  289.         Sbinit% = -1
  290.     END IF
  291.    
  292.     EXIT FUNCTION
  293. END IF
  294. Aloc = INSTR(Evrstr$, "A")
  295. Iloc = INSTR(Evrstr$, "I")
  296. Dloc = INSTR(Evrstr$, "D")
  297. Tloc = INSTR(Evrstr$, "T")
  298. IF Aloc <> 0 THEN Port = VAL("&H" + MID$(Evrstr$, Aloc + 1, 3))
  299. IF Iloc <> 0 THEN Irq = VAL(MID$(Evrstr$, Iloc + 1, 1))
  300. IF Dloc <> 0 THEN Dmach = VAL(MID$(Evrstr$, Dloc + 1, 1))
  301. IF Tloc <> 0 THEN Version = VAL(MID$(Evrstr$, Tloc + 1, 1))
  302. Sbinit% = -1
  303.  
  304.  
  305. END FUNCTION
  306.  
  307. FUNCTION Segp% (Pntr&)
  308. tmp = 0
  309. DEF SEG = VARSEG(Pntr&)
  310. v = VARPTR(Pntr&)
  311. a = PEEK(v + 2)
  312. b = PEEK(v + 3)
  313.  
  314. DEF SEG = VARSEG(tmp)
  315. v = VARPTR(tmp)
  316. POKE (v), a
  317. POKE (v + 1), b
  318. Segp = tmp
  319. END FUNCTION
  320.  
  321. SUB Setvesa (Mode)
  322. SELECT CASE Mode
  323.     CASE &H100
  324.         Mult& = 640
  325.         y = 400
  326.     CASE &H101
  327.         Mult& = 640
  328.         y = 480
  329.     CASE &H103
  330.         Mult& = 800
  331.         y = 600
  332.     CASE &H105
  333.         Mult& = 1024
  334.         y = 768
  335. END SELECT
  336.  
  337. Memloc2& = 0
  338. Curpage = 0
  339. FOR yt = 0 TO y
  340.     Ytable(yt) = VAL("&H" + HEX$(Memloc2&))
  341.     Ptable(yt) = Curpage
  342.     Memloc2& = Memloc2& + Mult&
  343.     IF Memloc2& > 65535 THEN
  344.         Curpage = Curpage + 1
  345.         Memloc2& = Memloc2& - 65536
  346.     END IF
  347. NEXT yt
  348. Curpage = 0
  349.  
  350.  
  351.  
  352. Inregs.ax = &H4F02
  353. Inregs.bx = Mode
  354. CALL INTERRUPTX(&H10, Inregs, Outregs)
  355.  
  356. END SUB
  357.  
  358. SUB Showmouse
  359. Inregs.ax = &H1
  360. CALL INTERRUPTX(&H33, Inregs, Outregs)
  361.  
  362. END SUB
  363.  
  364. SUB Writedot (x%, y%, c%)
  365. Memloc = Ytable(y) + x
  366. Npage = Ptable(y)
  367. IF Npage <> Curpage THEN
  368.     Inregs.ax = &H4F05
  369.     Inregs.bx = 0
  370.     Inregs.dx = Npage
  371.     CALL INTERRUPTX(&H10, Inregs, Outregs)
  372.     Curpage = Npage
  373. END IF
  374. IF (Ytable(y) < 0) AND (Memloc >= 0) THEN
  375.     Curpage = Curpage + 1
  376.     Inregs.ax = &H4F05
  377.     Inregs.bx = 0
  378.     Inregs.dx = Curpage
  379.     CALL INTERRUPTX(&H10, Inregs, Outregs)
  380. END IF
  381. POKE (Memloc), c
  382.  
  383.  
  384. END SUB
  385.  
  386.