QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 

 Return to Index  

Kaleidoscope Doodler -- Call absolute version

July 5 2008 at 9:05 AM
qbguy  (no login)


Response to Kaleidoscope Doodler -- Call Interrupt Version

 
DECLARE SUB INTERRUPTQB (intnum AS INTEGER, InReg AS ANY, OutReg AS ANY)
DECLARE SUB SOLIDCIRCLE (X!, Y!, RAD!)
SCREEN 12
' Kaleidoscope doodler -- drag mouse to draw, right click to clear screen
' ESCAPE quits
TYPE RegType
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
END TYPE
DIM REGS AS RegType
DIM SHARED COLOUR
X = 0
Y = 0
Z = 0
D = (640 - 480) / 2

LOOP1:
'SHOW MOUSE
REGS.AX = 1
CALL INTERRUPTQB(&H33, REGS, REGS)

IF INKEY$ = CHR$(27) THEN END

'LIMIT MOUSE
REGS.AX = 3
CALL INTERRUPTQB(&H33, REGS, REGS)
X = REGS.CX
Y = REGS.DX
Z = REGS.BX

IF Z = 0 THEN GOTO LOOP1

'HIDE MOUSE
REGS.AX = 2
CALL INTERRUPTQB(&H33, REGS, REGS)

IF Z = 1 THEN GOTO DRAW1
CLS
DRAW1:
COLOUR = INT(RND(1) * 15) + 1
CALL SOLIDCIRCLE(X, Y, 3)
CALL SOLIDCIRCLE(X, 480 - Y, 3)
CALL SOLIDCIRCLE(640 - X, Y, 3)
CALL SOLIDCIRCLE(640 - X, 480 - Y, 3)
CALL SOLIDCIRCLE(Y + D, X - D, 3)
CALL SOLIDCIRCLE(480 - Y + D, X - D, 3)
CALL SOLIDCIRCLE(Y + D, 480 - X + D, 3)
CALL SOLIDCIRCLE(480 - Y + D, 480 - X + D, 3)
GOTO LOOP1

SUB INTERRUPTQB (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
'standard INTERRUPTQB call compatibility with QBasic
'some static variables
STATIC a() AS LONG, bReady AS INTEGER
'If assembler array not created, create it
IF NOT bReady THEN
'don't change anything
I = 50: DIM a(1 TO I) AS LONG
a(1) = &H53EC8B55: a(2) = &H1E575651: a(3) = &H5E8B9C06: a(4) = &HA078B0E
a(5) = &HC70774E4: a(6) = &HE9FFFF07: a(7) = &HEC8300A1: a(8) = &HB3F88A0A
a(9) = &HE85E89CD: a(10) = &HCBEA46C7: a(11) = &H74253C90: a(12) = &H75263C04
a(13) = &HEA46C714: a(14) = &H46C701E8: a(15) = &HC7CB00EC: a(16) = &H2C2EE46
a(17) = &HF046C7: a(18) = &H85E8B90: a(19) = &H5E8B37FF: a(20) = &HE37FF06
a(21) = &H50008FB8: a(22) = &HE85E8D16: a(23) = &H8BDA8C53: a(24) = &H378B0A5E
a(25) = &H8E0C5E8B: a(26) = &H10448B1F: a(27) = &H75FFFF3D: a(28) = &H50C28B02
a(29) = &H3D12448B: a(30) = &H275FFFF: a(31) = &HC08EC28B: a(32) = &H5C8B048B
a(33) = &H44C8B02: a(34) = &H8B06548B: a(35) = &H748B0C7C: a(36) = &H9CCB1F0A
a(37) = &H83EC8B55: a(38) = &H1E5620C5: a(39) = &H89E476C5: a(40) = &H25C8904
a(41) = &H89044C89: a(42) = &H7C890654: a(43) = &H12448C0C: a(44) = &H8F10448F
a(45) = &H448F0A44: a(46) = &HE448F08: a(47) = &H9D0EC483: a(48) = &H5E5F1F07
a(49) = &HCA5D5B59: a(50) = &H9165000A
'Checksum, can be ommited
S1 = 0: S2 = 0: p = VARPTR(a(1)): DEF SEG = VARSEG(a(1))
FOR I = 0 TO 199
S1 = (S1 + PEEK(p + I)) MOD 255: S2 = (S2 + S1) MOD 255
NEXT I
IF S1 OR S2 THEN ERROR 2: intnum = -1: EXIT SUB ' Checksum Error
'End of the checksum
bReady = -1
END IF
'This is where we call our assembler INTERRUPTQB calling function
DEF SEG = VARSEG(a(1))
CALL ABSOLUTE(intnum, VARSEG(InReg), VARPTR(InReg), VARSEG(OutReg), VARPTR(OutReg), 0)
END SUB

SUB SOLIDCIRCLE (X, Y, RAD)
CIRCLE (X, Y), RAD, COLOUR
PAINT (X, Y), COLOUR
END SUB

 
 Respond to this message   
Response TitleAuthorDate
 *Instead of VARSEG(...), VARPTR(...), you can do SEG ... and it's a simple LDS SI, (param) Jul 5, 2008
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement